key frobbing related changes

This doesn't make any of the incredibly radical changes suggested earlier. However, it does change things so that 'SPC is accepted as an alias for space in key specifications, and so that XEmacs prints out consistent names for all keys, i.e. C-h c SPC prints "space ..." The syntax for key combinations is unaltered. It also fixes a couple of crashes. It introduces the use of portable use of stpcpy. XEmacs maintainers are encouraged to use it. It fixes a bug in the test suite. (Sorry, Hrvoje, this is not the long-promised overhaul). All the QK* symbols like QKdelete are renamed to Qdelete. There was never really any point to having a separate naming convention. These are, after all, just ordinary symbols. There is a chance I messed up events-msw.c. I saw the XXX's in that file, and tried to fix those. Completely untested. 1999-09-14 Martin Buchholz <martin(a)xemacs.org&gt; * keymap.c (Fsingle_key_description): Fix 2 crashes: (single-key-description '(meta . meta)) (single-key-description (list 10000 'meta)) The following now correctly generates an error: (single-key-description '(1 2 3)) * tests/automated/test-harness.el (test-harness-from-buffer): Make Check-Error-Message more robust. * tests/automated/lisp-tests.el: Added tests for single-key-description. * general.c (syms_of_general): * lisp.h: * keymap.c (describe_map): * keymap.c (define_key_alternate_name): * keymap.c (define_key_check_and_coerce_keysym): * events.h (struct misc_user_data): * events.h (struct button_data): Order struct members by size. Delete #ifdef emacs. As if this could be used independently. * events.c (syms_of_events): * events.c (Fevent_modifiers): * events.c (Fevent_live_p): Fix docstring. * events.c (Feventp): Fix docstring. * events.c (format_event_object): De-obfuscate. Don't translate space into SPC, etc. * events.c (key_sequence_to_event_chain): * events.c (character_to_event): * events.c (Fmake_event): * events.c (print_event): * event-msw.c (syms_of_event_mswindows): * event-msw.c (mswindows_key_to_emacs_keysym): * event-Xt.c (quit_char_predicate): * event-Xt.c (x_keysym_to_emacs_keysym): Delete the KEYSYM macro. It was just an alias for intern, and didn't provide any additional abstraction. Move some more global symbols into general.c. Make lots of variables static. * configure.in: * config.h.in: * sysdep.c (stpcpy): Use new function stpcpy, together with configure support. Implementation of fallback courtesy of glibc. Index: configure =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/configure,v retrieving revision 1.110.2.39 diff -u -w -r1.110.2.39 configure --- configure 1999/09/03 04:23:13 1.110.2.39 +++ configure 1999/09/15 04:03:06 ＠＠ -8872,7 +8872,7 ＠＠ fi -for ac_func in cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf +for ac_func in cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf stpcpy strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 echo "configure:8879: checking for $ac_func" >&5 Index: configure.in =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/configure.in,v retrieving revision 1.111.2.42 diff -u -w -r1.111.2.42 configure.in --- configure.in 1999/09/03 04:23:58 1.111.2.42 +++ configure.in 1999/09/15 04:03:09 ＠＠ -3117,7 +3117,7 ＠＠ XE_COMPUTE_RUNPATH() fi -AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf) +AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf stpcpy strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf) dnl realpath is buggy on linux, decosf and aix4 Index: src/config.h.in =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.49.2.12 diff -u -w -r1.49.2.12 config.h.in --- config.h.in 1999/08/27 03:46:43 1.49.2.12 +++ config.h.in 1999/09/15 04:03:10 ＠＠ -294,6 +294,7 ＠＠ #undef HAVE_SIGPROCMASK #undef HAVE_SIGSETJMP #undef HAVE_SNPRINTF +#undef HAVE_STPCPY #undef HAVE_STRCASECMP #undef HAVE_STRERROR #undef HAVE_TZSET Index: src/event-Xt.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.41.2.12 diff -u -w -r1.41.2.12 event-Xt.c --- event-Xt.c 1999/08/24 08:38:40 1.41.2.12 +++ event-Xt.c 1999/09/15 04:03:12 ＠＠ -697,13 +697,13 ＠＠ /* These would be handled correctly by the default case, but by special-casing them here we don't garbage a string or call intern(). */ - case XK_BackSpace: return QKbackspace; - case XK_Tab: return QKtab; - case XK_Linefeed: return QKlinefeed; - case XK_Return: return QKreturn; - case XK_Escape: return QKescape; - case XK_space: return QKspace; - case XK_Delete: return QKdelete; + case XK_BackSpace: return Qbackspace; + case XK_Tab: return Qtab; + case XK_Linefeed: return Qlinefeed; + case XK_Return: return Qreturn; + case XK_Escape: return Qescape; + case XK_space: return Qspace; + case XK_Delete: return Qdelete; case 0: return Qnil; default: if (simple_p) return Qnil; ＠＠ -717,28 +717,31 ＠＠ in recent X11 releases. Snarfed from X11/keysymdef.h Probably we should add some stuff here for X11R6. */ + { + char *key_name; + char key_buf[64]; switch (keysym) { - case 0xFF95: return KEYSYM ("kp-home"); - case 0xFF96: return KEYSYM ("kp-left"); - case 0xFF97: return KEYSYM ("kp-up"); - case 0xFF98: return KEYSYM ("kp-right"); - case 0xFF99: return KEYSYM ("kp-down"); - case 0xFF9A: return KEYSYM ("kp-prior"); - case 0xFF9B: return KEYSYM ("kp-next"); - case 0xFF9C: return KEYSYM ("kp-end"); - case 0xFF9D: return KEYSYM ("kp-begin"); - case 0xFF9E: return KEYSYM ("kp-insert"); - case 0xFF9F: return KEYSYM ("kp-delete"); + case 0xFF95: key_name = "kp-home"; break; + case 0xFF96: key_name = "kp-left"; break; + case 0xFF97: key_name = "kp-up"; break; + case 0xFF98: key_name = "kp-right"; break; + case 0xFF99: key_name = "kp-down"; break; + case 0xFF9A: key_name = "kp-prior"; break; + case 0xFF9B: key_name = "kp-next"; break; + case 0xFF9C: key_name = "kp-end"; break; + case 0xFF9D: key_name = "kp-begin"; break; + case 0xFF9E: key_name = "kp-insert"; break; + case 0xFF9F: key_name = "kp-delete"; break; - case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */ - case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */ + case 0x1005FF10: key_name = "SunF36"; break; /* labeled F11 */ + case 0x1005FF11: key_name = "SunF37"; break; /* labeled F12 */ default: - { - char buf [64]; - sprintf (buf, "unknown-keysym-0x%X", (int) keysym); - return KEYSYM (buf); + sprintf (key_buf, "unknown-keysym-0x%X", (int) keysym); + key_name = key_buf; + break; } + return intern (key_name); } /* If it's got a one-character name, that's good enough. */ if (!name[1]) ＠＠ -761,9 +764,9 ＠＠ } } *s2 = 0; - return KEYSYM (buf); + return intern (buf); } - return KEYSYM (name); + return intern (name); } } ＠＠ -2507,13 +2510,13 ＠＠ if (CHAR_OR_CHAR_INTP (keysym)) c = XCHAR_OR_CHAR_INT (keysym); /* Highly doubtful that these are the quit character, but... */ - else if (EQ (keysym, QKbackspace)) c = '\b'; - else if (EQ (keysym, QKtab)) c = '\t'; - else if (EQ (keysym, QKlinefeed)) c = '\n'; - else if (EQ (keysym, QKreturn)) c = '\r'; - else if (EQ (keysym, QKescape)) c = 27; - else if (EQ (keysym, QKspace)) c = ' '; - else if (EQ (keysym, QKdelete)) c = 127; + else if (EQ (keysym, Qbackspace)) c = '\b'; + else if (EQ (keysym, Qtab)) c = '\t'; + else if (EQ (keysym, Qlinefeed)) c = '\n'; + else if (EQ (keysym, Qreturn)) c = '\r'; + else if (EQ (keysym, Qescape)) c = 27; + else if (EQ (keysym, Qspace)) c = ' '; + else if (EQ (keysym, Qdelete)) c = 127; else return 0; if (event->xkey.state & xd->MetaMask) c |= 0x80; Index: src/event-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.38.2.19 diff -u -w -r1.38.2.19 event-msw.c --- event-msw.c 1999/08/08 13:50:08 1.38.2.19 +++ event-msw.c 1999/09/15 04:03:14 ＠＠ -123,6 +123,51 ＠＠ static Lisp_Object mswindows_u_dispatch_event_queue, mswindows_u_dispatch_event_queue_tail; static Lisp_Object mswindows_s_dispatch_event_queue, mswindows_s_dispatch_event_queue_tail; +/* Keysyms */ +static Lisp_Object Qclear; +static Lisp_Object Qprior; +static Lisp_Object Qnext; +static Lisp_Object Qend; +static Lisp_Object Qhome; +static Lisp_Object Qleft; +static Lisp_Object Qup; +static Lisp_Object Qright; +static Lisp_Object Qdown; +static Lisp_Object Qselect; +static Lisp_Object Qprint; +static Lisp_Object Qexecute; +static Lisp_Object Qprint; +static Lisp_Object Qinsert; +static Lisp_Object Qhelp; +static Lisp_Object Qlwin; +static Lisp_Object Qrwin; +static Lisp_Object Qmenu; +static Lisp_Object Qf1; +static Lisp_Object Qf2; +static Lisp_Object Qf3; +static Lisp_Object Qf4; +static Lisp_Object Qf5; +static Lisp_Object Qf6; +static Lisp_Object Qf7; +static Lisp_Object Qf8; +static Lisp_Object Qf9; +static Lisp_Object Qf10; +static Lisp_Object Qf11; +static Lisp_Object Qf12; +static Lisp_Object Qf13; +static Lisp_Object Qf14; +static Lisp_Object Qf15; +static Lisp_Object Qf16; +static Lisp_Object Qf17; +static Lisp_Object Qf18; +static Lisp_Object Qf19; +static Lisp_Object Qf20; +static Lisp_Object Qf21; +static Lisp_Object Qf22; +static Lisp_Object Qf23; +static Lisp_Object Qf24; + + /* The number of things we can wait on */ #define MAX_WAITABLE (MAXIMUM_WAIT_OBJECTS - 1) ＠＠ -2454,66 +2499,63 ＠＠ * Only returns non-Qnil for keys that don't generate WM_CHAR messages * or whose ASCII codes (like space) xemacs doesn't like. * Virtual key values are defined in winresrc.h - * XXX I'm not sure that KEYSYM("name") is the best thing to use here. */ Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods) { switch (mswindows_key) { /* First the predefined ones */ - case VK_BACK: return QKbackspace; - case VK_TAB: return QKtab; - case '\n': return QKlinefeed; /* No VK_LINEFEED in winresrc.h */ - case VK_RETURN: return QKreturn; - case VK_ESCAPE: return QKescape; - case VK_SPACE: return QKspace; - case VK_DELETE: return QKdelete; + case VK_BACK: return Qbackspace; + case VK_TAB: return Qtab; + case '\n': return Qlinefeed; /* No VK_LINEFEED in winresrc.h */ + case VK_RETURN: return Qreturn; + case VK_ESCAPE: return Qescape; + case VK_SPACE: return Qspace; + case VK_DELETE: return Qdelete; /* The rest */ - case VK_CLEAR: return KEYSYM ("clear"); /* Should do ^L ? */ - case VK_PRIOR: return KEYSYM ("prior"); - case VK_NEXT: return KEYSYM ("next"); - case VK_END: return KEYSYM ("end"); - case VK_HOME: return KEYSYM ("home"); - case VK_LEFT: return KEYSYM ("left"); - case VK_UP: return KEYSYM ("up"); - case VK_RIGHT: return KEYSYM ("right"); - case VK_DOWN: return KEYSYM ("down"); - case VK_SELECT: return KEYSYM ("select"); - case VK_PRINT: return KEYSYM ("print"); - case VK_EXECUTE: return KEYSYM ("execute"); - case VK_SNAPSHOT: return KEYSYM ("print"); - case VK_INSERT: return KEYSYM ("insert"); - case VK_HELP: return KEYSYM ("help"); -#if 0 /* XXX What are these supposed to do? */ - case VK_LWIN return KEYSYM (""); - case VK_RWIN return KEYSYM (""); -#endif - case VK_APPS: return KEYSYM ("menu"); - case VK_F1: return KEYSYM ("f1"); - case VK_F2: return KEYSYM ("f2"); - case VK_F3: return KEYSYM ("f3"); - case VK_F4: return KEYSYM ("f4"); - case VK_F5: return KEYSYM ("f5"); - case VK_F6: return KEYSYM ("f6"); - case VK_F7: return KEYSYM ("f7"); - case VK_F8: return KEYSYM ("f8"); - case VK_F9: return KEYSYM ("f9"); - case VK_F10: return KEYSYM ("f10"); - case VK_F11: return KEYSYM ("f11"); - case VK_F12: return KEYSYM ("f12"); - case VK_F13: return KEYSYM ("f13"); - case VK_F14: return KEYSYM ("f14"); - case VK_F15: return KEYSYM ("f15"); - case VK_F16: return KEYSYM ("f16"); - case VK_F17: return KEYSYM ("f17"); - case VK_F18: return KEYSYM ("f18"); - case VK_F19: return KEYSYM ("f19"); - case VK_F20: return KEYSYM ("f20"); - case VK_F21: return KEYSYM ("f21"); - case VK_F22: return KEYSYM ("f22"); - case VK_F23: return KEYSYM ("f23"); - case VK_F24: return KEYSYM ("f24"); + case VK_CLEAR: return Qclear; /* Should do ^L ? */ + case VK_PRIOR: return Qprior; + case VK_NEXT: return Qnext; + case VK_END: return Qend; + case VK_HOME: return Qhome; + case VK_LEFT: return Qleft; + case VK_UP: return Qup; + case VK_RIGHT: return Qright; + case VK_DOWN: return Qdown; + case VK_SELECT: return Qselect; + case VK_PRINT: return Qprint; + case VK_EXECUTE: return Qexecute; + case VK_SNAPSHOT: return Qprint; + case VK_INSERT: return Qinsert; + case VK_HELP: return Qhelp; + case VK_LWIN: return Qlwin; + case VK_RWIN: return Qrwin; + case VK_APPS: return Qmenu; + case VK_F1: return Qf1; + case VK_F2: return Qf2; + case VK_F3: return Qf3; + case VK_F4: return Qf4; + case VK_F5: return Qf5; + case VK_F6: return Qf6; + case VK_F7: return Qf7; + case VK_F8: return Qf8; + case VK_F9: return Qf9; + case VK_F10: return Qf10; + case VK_F11: return Qf11; + case VK_F12: return Qf12; + case VK_F13: return Qf13; + case VK_F14: return Qf14; + case VK_F15: return Qf15; + case VK_F16: return Qf16; + case VK_F17: return Qf17; + case VK_F18: return Qf18; + case VK_F19: return Qf19; + case VK_F20: return Qf20; + case VK_F21: return Qf21; + case VK_F22: return Qf22; + case VK_F23: return Qf23; + case VK_F24: return Qf24; } return Qnil; } ＠＠ -3004,6 +3046,48 ＠＠ void syms_of_event_mswindows (void) { + defsymbol (&Qclear, "clear"); + defsymbol (&Qprior, "prior"); + defsymbol (&Qnext, "next"); + defsymbol (&Qend, "end"); + defsymbol (&Qhome, "home"); + defsymbol (&Qleft, "left"); + defsymbol (&Qup, "up"); + defsymbol (&Qright, "right"); + defsymbol (&Qdown, "down"); + defsymbol (&Qselect, "select"); + defsymbol (&Qprint, "print"); + defsymbol (&Qexecute, "execute"); + defsymbol (&Qprint, "print"); + defsymbol (&Qinsert, "insert"); + defsymbol (&Qhelp, "help"); + defsymbol (&Qlwin, "lwin"); + defsymbol (&Qrwin, "rwin"); + defsymbol (&Qmenu, "menu"); + defsymbol (&Qf1, "f1"); + defsymbol (&Qf2, "f2"); + defsymbol (&Qf3, "f3"); + defsymbol (&Qf4, "f4"); + defsymbol (&Qf5, "f5"); + defsymbol (&Qf6, "f6"); + defsymbol (&Qf7, "f7"); + defsymbol (&Qf8, "f8"); + defsymbol (&Qf9, "f9"); + defsymbol (&Qf10, "f10"); + defsymbol (&Qf11, "f11"); + defsymbol (&Qf12, "f12"); + defsymbol (&Qf13, "f13"); + defsymbol (&Qf14, "f14"); + defsymbol (&Qf15, "f15"); + defsymbol (&Qf16, "f16"); + defsymbol (&Qf17, "f17"); + defsymbol (&Qf18, "f18"); + defsymbol (&Qf19, "f19"); + defsymbol (&Qf20, "f20"); + defsymbol (&Qf21, "f21"); + defsymbol (&Qf22, "f22"); + defsymbol (&Qf23, "f23"); + defsymbol (&Qf24, "f24"); } void Index: src/events.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/events.c,v retrieving revision 1.41.2.5 diff -u -w -r1.41.2.5 events.c --- events.c 1999/09/14 06:50:58 1.41.2.5 +++ events.c 1999/09/15 04:03:16 ＠＠ -174,10 +174,9 ＠＠ case pointer_motion_event: { char buf[64]; - Lisp_Object Vx, Vy; - Vx = Fevent_x_pixel (obj); + Lisp_Object Vx = Fevent_x_pixel (obj); + Lisp_Object Vy = Fevent_y_pixel (obj); assert (INTP (Vx)); - Vy = Fevent_y_pixel (obj); assert (INTP (Vy)); sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy)); write_c_string (buf, printcharfun); ＠＠ -543,7 +542,7 ＠＠ } else if (EQ (keyword, Qmodifiers)) { - int modifiers = 0; + unsigned int modifiers = 0; Lisp_Object sym; EXTERNAL_LIST_LOOP_2 (sym, value) ＠＠ -943,9 +942,6 ＠＠  -Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape, - QKspace, QKdelete; - int command_event_p (Lisp_Object event) { ＠＠ -997,17 +993,17 ＠＠ { switch (c) { - case 'I': k = QKtab; m &= ~MOD_CONTROL; break; - case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break; - case 'M': k = QKreturn; m &= ~MOD_CONTROL; break; - case '[': k = QKescape; m &= ~MOD_CONTROL; break; + case 'I': k = Qtab; m &= ~MOD_CONTROL; break; + case 'J': k = Qlinefeed; m &= ~MOD_CONTROL; break; + case 'M': k = Qreturn; m &= ~MOD_CONTROL; break; + case '[': k = Qescape; m &= ~MOD_CONTROL; break; default: #if defined(HAVE_TTY) if (do_backspace_mapping && CHARP (con->tty_erase_char) && c - '＠' == XCHAR (con->tty_erase_char)) { - k = QKbackspace; + k = Qbackspace; m &= ~MOD_CONTROL; } #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ ＠＠ -1018,12 +1014,12 ＠＠ #if defined(HAVE_TTY) else if (do_backspace_mapping && CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) - k = QKbackspace; + k = Qbackspace; #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ else if (c == 127) - k = QKdelete; + k = Qdelete; else if (c == ' ') - k = QKspace; + k = Qspace; event->event_type = key_press_event; event->timestamp = 0; /* #### */ ＠＠ -1218,56 +1214,88 ＠＠ return head; } +static char * +event_modifiers_pcpy (char *buf, unsigned int modifiers, int brief) +{ + if (brief) + { + if (modifiers & MOD_CONTROL) buf = stpcpy (buf, "C-"); + if (modifiers & MOD_META) buf = stpcpy (buf, "M-"); + if (modifiers & MOD_SUPER) buf = stpcpy (buf, "S-"); + if (modifiers & MOD_HYPER) buf = stpcpy (buf, "H-"); + if (modifiers & MOD_ALT) buf = stpcpy (buf, "A-"); + if (modifiers & MOD_SHIFT) buf = stpcpy (buf, "Sh-"); + } + else + { + if (modifiers & MOD_CONTROL) buf = stpcpy (buf, "control-"); + if (modifiers & MOD_META) buf = stpcpy (buf, "meta-"); + if (modifiers & MOD_SUPER) buf = stpcpy (buf, "super-"); + if (modifiers & MOD_HYPER) buf = stpcpy (buf, "hyper-"); + if (modifiers & MOD_ALT) buf = stpcpy (buf, "alt-"); + if (modifiers & MOD_SHIFT) buf = stpcpy (buf, "shift-"); + } + return buf; +} + void format_event_object (char *buf, struct Lisp_Event *event, int brief) { - int mouse_p = 0; - int mod = 0; - Lisp_Object key; - switch (event->event_type) { case key_press_event: { - mod = event->event.key.modifiers; - key = event->event.key.keysym; + unsigned int modifiers = event->event.key.modifiers; + Lisp_Object key = event->event.key.keysym; /* Hack. */ if (! brief && CHARP (key) && - mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) + modifiers & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) { int k = XCHAR (key); if (k >= 'a' && k <= 'z') key = make_char (k - ('a' - 'A')); else if (k >= 'A' && k <= 'Z') - mod |= MOD_SHIFT; + modifiers |= MOD_SHIFT; } - break; + buf = event_modifiers_pcpy (buf, modifiers, brief); + + if (CHARP (key)) + { + buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key)); + *buf = '\0'; + } + else if (SYMBOLP (key)) + { + struct Lisp_String *name = XSYMBOL (key)->name; + memcpy (buf, string_data (name), string_length (name) + 1); } + return; + } case button_release_event: - mouse_p++; - /* Fall through */ case button_press_event: { - mouse_p++; - mod = event->event.button.modifiers; - key = make_char (event->event.button.button + '0'); - break; + buf = event_modifiers_pcpy (buf, event->event.button.modifiers, brief); + buf = stpcpy (buf, "button"); + *buf++ = '0' + event->event.button.button; + if (event->event_type == button_release_event) + strcpy (buf, "up"); + else + *buf = '\0'; + return; } case magic_event: - { - CONST char *name = NULL; - #ifdef HAVE_X_WINDOWS { + CONST char *name = NULL; Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); if (CONSOLE_X_P (XCONSOLE (console))) name = x_event_name (event->event.magic.underlying_x_event.type); + strcpy (buf, name ? name : "???"); } +#else + strcpy (buf, "???"); #endif /* HAVE_X_WINDOWS */ - if (name) strcpy (buf, name); - else strcpy (buf, "???"); return; - } case magic_eval_event: strcpy (buf, "magic-eval"); return; case pointer_motion_event: strcpy (buf, "motion"); return; case misc_user_event: strcpy (buf, "misc-user"); return; ＠＠ -1279,62 +1307,10 ＠＠ default: abort (); } -#define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0) -#define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0) - if (mod & MOD_CONTROL) modprint ("control-", "C-"); - if (mod & MOD_META) modprint ("meta-", "M-"); - if (mod & MOD_SUPER) modprint ("super-", "S-"); - if (mod & MOD_HYPER) modprint ("hyper-", "H-"); - if (mod & MOD_ALT) modprint ("alt-", "A-"); - if (mod & MOD_SHIFT) modprint ("shift-", "Sh-"); - if (mouse_p) - { - modprint1 ("button"); - --mouse_p; } -#undef modprint -#undef modprint1 - - if (CHARP (key)) - { - buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key)); - *buf = 0; - } - else if (SYMBOLP (key)) - { - CONST char *str = 0; - if (brief) - { - if (EQ (key, QKlinefeed)) str = "LFD"; - else if (EQ (key, QKtab)) str = "TAB"; - else if (EQ (key, QKreturn)) str = "RET"; - else if (EQ (key, QKescape)) str = "ESC"; - else if (EQ (key, QKdelete)) str = "DEL"; - else if (EQ (key, QKspace)) str = "SPC"; - else if (EQ (key, QKbackspace)) str = "BS"; - } - if (str) - { - int i = strlen (str); - memcpy (buf, str, i+1); - str += i; - } - else - { - struct Lisp_String *name = XSYMBOL (key)->name; - memcpy (buf, string_data (name), string_length (name) + 1); - str += string_length (name); - } - } - else - abort (); - if (mouse_p) - strncpy (buf, "up", 4); -} - DEFUN ("eventp", Feventp, 1, 1, 0, /* -True if OBJECT is an event object. +Return t if OBJECT is an event object. */ (object)) { ＠＠ -1342,7 +1318,7 ＠＠ } DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /* -True if OBJECT is an event object that has not been deallocated. +Return t if OBJECT is an event object that has not been deallocated. */ (object)) { ＠＠ -1541,14 +1517,14 ＠＠ */ (event)) { - int mod = XINT (Fevent_modifier_bits (event)); + unsigned int modifiers = XINT (Fevent_modifier_bits (event)); Lisp_Object result = Qnil; - if (mod & MOD_SHIFT) result = Fcons (Qshift, result); - if (mod & MOD_ALT) result = Fcons (Qalt, result); - if (mod & MOD_HYPER) result = Fcons (Qhyper, result); - if (mod & MOD_SUPER) result = Fcons (Qsuper, result); - if (mod & MOD_META) result = Fcons (Qmeta, result); - if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result); + if (modifiers & MOD_SHIFT) result = Fcons (Qshift, result); + if (modifiers & MOD_ALT) result = Fcons (Qalt, result); + if (modifiers & MOD_HYPER) result = Fcons (Qhyper, result); + if (modifiers & MOD_SUPER) result = Fcons (Qsuper, result); + if (modifiers & MOD_META) result = Fcons (Qmeta, result); + if (modifiers & MOD_CONTROL) result = Fcons (Qcontrol, result); return result; } ＠＠ -2229,14 +2205,6 ＠＠ defsymbol (&Qbutton_release, "button-release"); defsymbol (&Qmisc_user, "misc-user"); defsymbol (&Qascii_character, "ascii-character"); - - defsymbol (&QKbackspace, "backspace"); - defsymbol (&QKtab, "tab"); - defsymbol (&QKlinefeed, "linefeed"); - defsymbol (&QKreturn, "return"); - defsymbol (&QKescape, "escape"); - defsymbol (&QKspace, "space"); - defsymbol (&QKdelete, "delete"); } void Index: src/events.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/events.h,v retrieving revision 1.20.2.4 diff -u -w -r1.20.2.4 events.h --- events.h 1999/08/29 17:37:00 1.20.2.4 +++ events.h 1999/09/15 04:03:16 ＠＠ -181,8 +181,8 ＠＠ button_press_event button_release_event button What button went down or up. - modifiers Bucky-bits on that button: shift, control, meta, etc. x, y Where it was at the button-state-change (in pixels). + modifiers Bucky-bits on that button: shift, control, meta, etc. pointer_motion_event x, y Where it was after it moved (in pixels). ＠＠ -374,8 +374,8 ＠＠ struct button_data { int button; - unsigned char modifiers; int x, y; + unsigned char modifiers; }; struct motion_data ＠＠ -408,8 +408,8 ＠＠ Lisp_Object function; Lisp_Object object; int button; - unsigned char modifiers; int x, y; + unsigned char modifiers; }; struct magic_eval_data ＠＠ -531,19 +531,17 ＠＠ EXFUN (Fevent_window, 1); EXFUN (Fmake_event, 2); -extern Lisp_Object QKbackspace, QKdelete, QKescape, QKlinefeed, QKreturn; -extern Lisp_Object QKspace, QKtab, Qmouse_event_p, Vcharacter_set_property; +extern Lisp_Object Qbackspace, Qdelete, Qescape, Qlinefeed, Qreturn; +extern Lisp_Object Qspace, Qtab; +extern Lisp_Object Qmouse_event_p, Vcharacter_set_property; extern Lisp_Object Qcancel_mode_internal; +extern Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; /* Note: under X Windows, MOD_ALT is generated by the Alt key if there are both Alt and Meta keys. If there are no Meta keys, then Alt generates MOD_META instead. */ -#ifdef emacs -/* Maybe this should be trickier */ -#define KEYSYM(x) (intern (x)) - /* from events.c */ void format_event_object (char *buf, struct Lisp_Event *e, int brief); void character_to_event (Emchar c, struct Lisp_Event *event, ＠＠ -659,7 +657,5 ＠＠ /* Define this if you want the tty event stream to be used when the first console is tty, even if HAVE_X_WINDOWS is defined */ /* #define DEBUG_TTY_EVENT_STREAM */ - -#endif /* emacs */ #endif /* _XEMACS_EVENTS_H_ */ Index: src/keymap.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/keymap.c,v retrieving revision 1.27.2.7 diff -u -w -r1.27.2.7 keymap.c --- keymap.c 1999/09/14 06:51:01 1.27.2.7 +++ keymap.c 1999/09/15 04:03:19 ＠＠ -231,20 +231,19 ＠＠ int mice_only_p, Lisp_Object buffer); -Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; -Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3; -Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7; -Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up; -Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up; +static Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3; +static Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7; +static Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up; +static Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up; -Lisp_Object Qmenu_selection; +static Lisp_Object Qmenu_selection; /* Emacs compatibility */ -Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4, - Qdown_mouse_5; -Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5; +static Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3; +static Lisp_Object Qdown_mouse_4, Qdown_mouse_5; +static Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5; /* Kludge kludge kludge */ -Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS; +static Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;  /************************************************************************/ ＠＠ -1281,14 +1280,14 ＠＠ } else { - signal_simple_error ("Unknown keysym specifier", - *keysym); + signal_simple_error ("Unknown keysym specifier", *keysym); } if (SYMBOLP (*keysym)) { - char *name = (char *) - string_data (XSYMBOL (*keysym)->name); + struct Lisp_String *symbol_name = XSYMBOL (*keysym)->name; + Bufbyte *name = string_data (symbol_name); + Bytecount len = string_length (symbol_name); /* FSFmacs uses symbols with the printed representation of keysyms in their names, like 'M-x, and we use the syntax '(meta x). So, to avoid ＠＠ -1303,79 +1302,39 ＠＠ name-p, but that would interfere with various tricks we do to sanitize the Sun keyboards, and would make it trickier to conditionalize a .emacs file for multiple X servers. - */ - if (((int) strlen (name) >= 2 && name[1] == '-') -#if 1 - || - /* Ok, this is a bit more dubious - prevent people from doing things - like (global-set-key 'RET 'something) because that will have the - same problem as above. (Gag!) Maybe we should just silently - accept these as aliases for the "real" names? - */ - (string_length (XSYMBOL (*keysym)->name) <= 3 && - (!strcmp (name, "LFD") || - !strcmp (name, "TAB") || - !strcmp (name, "RET") || - !strcmp (name, "ESC") || - !strcmp (name, "DEL") || - !strcmp (name, "SPC") || - !strcmp (name, "BS"))) -#endif /* unused */ - ) - signal_simple_error - ("Invalid (FSF Emacs) key format (see doc of define-key)", - *keysym); - /* #### Ok, this is a bit more dubious - make people not lose if they - do things like (global-set-key 'RET 'something) because that would - otherwise have the same problem as above. (Gag!) We silently - accept these as aliases for the "real" names. + #### Actually, we should accept 'M-x, and silently convert to (meta x). + #### Especially, given that we print "M-x" in response to C-h c M-x. */ - else if (!strncmp(name, "kp_", 3)) { + if ((len >= 3 && name[1] == '-')) + signal_simple_error + ("Invalid key format (see doc of define-key)", *keysym); + else if (!strncmp (name, "kp_", 3)) + { /* Likewise, the obsolete keysym binding of kp_.* should not lose. */ - char temp[50]; - - strncpy(temp, name, sizeof (temp)); - temp[sizeof (temp) - 1] = '\0'; - temp[2] = '-'; - *keysym = Fintern_soft(make_string((Bufbyte *)temp, - strlen(temp)), - Qnil); - } else if (EQ (*keysym, QLFD)) - *keysym = QKlinefeed; - else if (EQ (*keysym, QTAB)) - *keysym = QKtab; - else if (EQ (*keysym, QRET)) - *keysym = QKreturn; - else if (EQ (*keysym, QESC)) - *keysym = QKescape; - else if (EQ (*keysym, QDEL)) - *keysym = QKdelete; - else if (EQ (*keysym, QSPC)) - *keysym = QKspace; - else if (EQ (*keysym, QBS)) - *keysym = QKbackspace; + Bufbyte *buf = (Bufbyte *) alloca (len); + memcpy (buf, name, len); + buf[2] = '-'; + *keysym = Fintern (make_string (buf, len), Qnil); + } + else if (EQ (*keysym, QLFD)) *keysym = Qlinefeed; + else if (EQ (*keysym, QTAB)) *keysym = Qtab; + else if (EQ (*keysym, QRET)) *keysym = Qreturn; + else if (EQ (*keysym, QESC)) *keysym = Qescape; + else if (EQ (*keysym, QDEL)) *keysym = Qdelete; + else if (EQ (*keysym, QSPC)) *keysym = Qspace; + else if (EQ (*keysym, QBS)) *keysym = Qbackspace; /* Emacs compatibility */ - else if (EQ(*keysym, Qdown_mouse_1)) - *keysym = Qbutton1; - else if (EQ(*keysym, Qdown_mouse_2)) - *keysym = Qbutton2; - else if (EQ(*keysym, Qdown_mouse_3)) - *keysym = Qbutton3; - else if (EQ(*keysym, Qdown_mouse_4)) - *keysym = Qbutton4; - else if (EQ(*keysym, Qdown_mouse_5)) - *keysym = Qbutton5; - else if (EQ(*keysym, Qmouse_1)) - *keysym = Qbutton1up; - else if (EQ(*keysym, Qmouse_2)) - *keysym = Qbutton2up; - else if (EQ(*keysym, Qmouse_3)) - *keysym = Qbutton3up; - else if (EQ(*keysym, Qmouse_4)) - *keysym = Qbutton4up; - else if (EQ(*keysym, Qmouse_5)) - *keysym = Qbutton5up; + else if (EQ (*keysym, Qdown_mouse_1)) *keysym = Qbutton1; + else if (EQ (*keysym, Qdown_mouse_2)) *keysym = Qbutton2; + else if (EQ (*keysym, Qdown_mouse_3)) *keysym = Qbutton3; + else if (EQ (*keysym, Qdown_mouse_4)) *keysym = Qbutton4; + else if (EQ (*keysym, Qdown_mouse_5)) *keysym = Qbutton5; + else if (EQ (*keysym, Qmouse_1)) *keysym = Qbutton1up; + else if (EQ (*keysym, Qmouse_2)) *keysym = Qbutton2up; + else if (EQ (*keysym, Qmouse_3)) *keysym = Qbutton3up; + else if (EQ (*keysym, Qmouse_4)) *keysym = Qbutton4up; + else if (EQ (*keysym, Qmouse_5)) *keysym = Qbutton5up; } } ＠＠ -1638,39 +1597,39 ＠＠ returned_value->modifiers = 0; if (modifiers_sans_meta == MOD_CONTROL) { - if EQ (keysym, QKspace) + if EQ (keysym, Qspace) MACROLET (make_char ('＠'), modifiers); else if (!CHARP (keysym)) return; else switch (XCHAR (keysym)) { case '＠': /* c-＠ => c-space */ - MACROLET (QKspace, modifiers); + MACROLET (Qspace, modifiers); case 'h': /* c-h => backspace */ - MACROLET (QKbackspace, modifiers_sans_control); + MACROLET (Qbackspace, modifiers_sans_control); case 'i': /* c-i => tab */ - MACROLET (QKtab, modifiers_sans_control); + MACROLET (Qtab, modifiers_sans_control); case 'j': /* c-j => linefeed */ - MACROLET (QKlinefeed, modifiers_sans_control); + MACROLET (Qlinefeed, modifiers_sans_control); case 'm': /* c-m => return */ - MACROLET (QKreturn, modifiers_sans_control); + MACROLET (Qreturn, modifiers_sans_control); case '[': /* c-[ => escape */ - MACROLET (QKescape, modifiers_sans_control); + MACROLET (Qescape, modifiers_sans_control); default: return; } } else if (modifiers_sans_meta != 0) return; - else if (EQ (keysym, QKbackspace)) /* backspace => c-h */ + else if (EQ (keysym, Qbackspace)) /* backspace => c-h */ MACROLET (make_char ('h'), (modifiers | MOD_CONTROL)); - else if (EQ (keysym, QKtab)) /* tab => c-i */ + else if (EQ (keysym, Qtab)) /* tab => c-i */ MACROLET (make_char ('i'), (modifiers | MOD_CONTROL)); - else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */ + else if (EQ (keysym, Qlinefeed)) /* linefeed => c-j */ MACROLET (make_char ('j'), (modifiers | MOD_CONTROL)); - else if (EQ (keysym, QKreturn)) /* return => c-m */ + else if (EQ (keysym, Qreturn)) /* return => c-m */ MACROLET (make_char ('m'), (modifiers | MOD_CONTROL)); - else if (EQ (keysym, QKescape)) /* escape => c-[ */ + else if (EQ (keysym, Qescape)) /* escape => c-[ */ MACROLET (make_char ('['), (modifiers | MOD_CONTROL)); else return; ＠＠ -3208,38 +3167,39 ＠＠ if (EVENTP (key) || CHAR_OR_CHAR_INTP (key)) { char buf [255]; - if (!EVENTP (key)) + Lisp_Event *ep, event; + if (EVENTP (key)) + ep = XEVENT (key); + else { - struct Lisp_Event event; event.event_type = empty_event; CHECK_CHAR_COERCE_INT (key); character_to_event (XCHAR (key), &event, XCONSOLE (Vselected_console), 0, 1); - format_event_object (buf, &event, 1); + ep = &event; } - else - format_event_object (buf, XEVENT (key), 1); + format_event_object (buf, ep, 1); return build_string (buf); } - - if (CONSP (key)) + else if (CONSP (key)) { char buf[255]; char *bufp = buf; - Lisp_Object rest; - buf[0] = 0; - LIST_LOOP (rest, key) + Lisp_Object keysym, tail; + int len; + EXTERNAL_LIST_LOOP_4 (keysym, key, tail, len) { - Lisp_Object keysym = XCAR (rest); - if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2; - else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2; - else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2; - else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2; - else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2; - else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2; - else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3; - else if (CHAR_OR_CHAR_INTP (keysym)) + if (EQ (keysym, Qcontrol)) bufp = stpcpy (bufp, "C-"); + else if (EQ (keysym, Qctrl)) bufp = stpcpy (bufp, "C-"); + else if (EQ (keysym, Qmeta)) bufp = stpcpy (bufp, "M-"); + else if (EQ (keysym, Qsuper)) bufp = stpcpy (bufp, "S-"); + else if (EQ (keysym, Qhyper)) bufp = stpcpy (bufp, "H-"); + else if (EQ (keysym, Qalt)) bufp = stpcpy (bufp, "A-"); + else if (EQ (keysym, Qshift)) bufp = stpcpy (bufp, "Sh-"); + else { + if (CHAR_OR_CHAR_INTP (keysym)) + { bufp += set_charptr_emchar ((Bufbyte *) bufp, XCHAR_OR_CHAR_INT (keysym)); *bufp = 0; ＠＠ -3247,26 +3207,18 ＠＠ else { CHECK_SYMBOL (keysym); -#if 0 /* This is bogus */ - if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD"); - else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB"); - else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET"); - else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC"); - else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL"); - else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC"); - else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS"); - else -#endif strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name)); - if (!NILP (XCDR (rest))) - signal_simple_error ("Invalid key description", - key); } + if (!NILP (XCDR (tail))) + goto invalid_key_description; + } + if (len > 10) /* Avoid buffer overrun! */ + goto invalid_key_description; } return build_string (buf); } - return Fsingle_key_description - (wrong_type_argument (intern ("char-or-event-p"), key)); + invalid_key_description: + signal_simple_error ("Invalid key description", key); } DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /* ＠＠ -4135,23 +4087,6 ＠＠ Emchar c = (CHAR_OR_CHAR_INTP (code) ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1); /* Calling Fsingle_key_description() would cons more */ -#if 0 /* This is bogus */ - if (EQ (keysym, QKlinefeed)) - buffer_insert_c_string (buf, "LFD"); - else if (EQ (keysym, QKtab)) - buffer_insert_c_string (buf, "TAB"); - else if (EQ (keysym, QKreturn)) - buffer_insert_c_string (buf, "RET"); - else if (EQ (keysym, QKescape)) - buffer_insert_c_string (buf, "ESC"); - else if (EQ (keysym, QKdelete)) - buffer_insert_c_string (buf, "DEL"); - else if (EQ (keysym, QKspace)) - buffer_insert_c_string (buf, "SPC"); - else if (EQ (keysym, QKbackspace)) - buffer_insert_c_string (buf, "BS"); - else -#endif if (c >= printable_min) buffer_insert_emacs_char (buf, c); else buffer_insert1 (buf, Fsymbol_name (keysym)); Index: src/lisp.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.38.2.21 diff -u -w -r1.38.2.21 lisp.h --- lisp.h 1999/09/14 06:51:01 1.38.2.21 +++ lisp.h 1999/09/15 04:03:21 ＠＠ -2545,6 +2545,11 ＠＠ /* Defined in syntax.c */ int scan_words (struct buffer *, int, int); + +/* Defined in sysdep.c */ +#ifndef HAVE_STPCPY +char * stpcpy (char *, CONST char *); +#endif /* Defined in undo.c */ Lisp_Object truncate_undo_list (Lisp_Object, int, int); Index: src/sysdep.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/sysdep.c,v retrieving revision 1.32.2.7 diff -u -w -r1.32.2.7 sysdep.c --- sysdep.c 1999/07/05 05:56:44 1.32.2.7 +++ sysdep.c 1999/09/15 04:03:24 ＠＠ -3968,6 +3968,99 ＠＠ if (*us1++ == '\0') return (0); - return (cm[*us1] - cm[*--us2]); + return cm[*us1] - cm[*--us2]; } #endif /* !HAVE_STRCASECMP */ + +#ifndef HAVE_STPCPY /* From glibc 2.1.1 */ +/* Copy SRC to DEST, returning the address of the terminating '\0' in DEST. */ +char * +stpcpy (char *dest, CONST char *src) +{ + REGISTER char *d = dest; + REGISTER const char *s = src; + + do + *d++ = *s; + while (*s++ != '\0'); + + return d - 1; +} +#endif /* !HAVE_STPCPY */ + +#if 0 /* currently unused */ +#ifndef HAVE_STPNCPY /* From glibc 2.1.1 */ +/* Copy no more than N characters of SRC to DEST, returning the address of + the terminating '\0' in DEST, if any, or else DEST + N. */ +char * +stpncpy (char *dest, CONST char *src, size_t n) +{ + char c; + char *s = dest; + + if (n >= 4) + { + size_t n4 = n >> 2; + + for (;;) + { + c = *src++; + *dest++ = c; + if (c == '\0') + break; + c = *src++; + *dest++ = c; + if (c == '\0') + break; + c = *src++; + *dest++ = c; + if (c == '\0') + break; + c = *src++; + *dest++ = c; + if (c == '\0') + break; + if (--n4 == 0) + goto last_chars; + } + n -= dest - s; + goto zero_fill; + } + + last_chars: + n &= 3; + if (n == 0) + return dest; + + for (;;) + { + c = *src++; + --n; + *dest++ = c; + if (c == '\0') + break; + if (n == 0) + return dest; + } + + zero_fill: + while (n-- > 0) + dest[n] = '\0'; + + return dest - 1; +} +#endif /* !HAVE_STPNCPY */ + + +#ifndef HAVE_MEMPCPY /* In glibc 2.1.1, our own simple implementation */ +/* Copy memory to memory until the specified number of bytes + has been copied, return pointer to following byte. + Overlap is NOT handled correctly. */ +void * +mempcpy (void *dest, CONST void *src, size_t len) +{ + memcpy (dest, src, len); + return (void *) ((char *) dest + len); +} +#endif /* !HAVE_MEMPCPY */ +#endif /* unused */ Index: src/general.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/general.c,v retrieving revision 1.13.2.6 diff -u -w -r1.13.2.6 general.c --- general.c 1999/09/14 09:26:02 1.13.2.6 +++ general.c 1999/09/15 04:03:29 ＠＠ -34,10 +34,12 ＠＠ Lisp_Object Qactually_requested; Lisp_Object Qafter; Lisp_Object Qall; +Lisp_Object Qalt; Lisp_Object Qand; Lisp_Object Qassoc; Lisp_Object Qat; Lisp_Object Qautodetect; +Lisp_Object Qbackspace; Lisp_Object Qbad_variable; Lisp_Object Qbefore; Lisp_Object Qbinary; ＠＠ -56,7 +58,9 ＠＠ Lisp_Object Qcolumns; Lisp_Object Qcommand; Lisp_Object Qconsole; +Lisp_Object Qcontrol; Lisp_Object Qcritical; +Lisp_Object Qctrl; Lisp_Object Qcursor; Lisp_Object Qdata; Lisp_Object Qdead; ＠＠ -73,6 +77,7 ＠＠ Lisp_Object Qeql; Lisp_Object Qequal; Lisp_Object Qeval; +Lisp_Object Qescape; Lisp_Object Qextents; Lisp_Object Qface; Lisp_Object Qfont; ＠＠ -86,6 +91,7 ＠＠ Lisp_Object Qheight; Lisp_Object Qhighlight; Lisp_Object Qhorizontal; +Lisp_Object Qhyper; Lisp_Object Qicon; Lisp_Object Qid; Lisp_Object Qimage; ＠＠ -97,6 +103,7 ＠＠ Lisp_Object Qkey_assoc; Lisp_Object Qkeymap; Lisp_Object Qleft; +Lisp_Object Qlinefeed; Lisp_Object Qlist; Lisp_Object Qmagic; Lisp_Object Qmalloc_overhead; ＠＠ -104,6 +111,7 ＠＠ Lisp_Object Qmax; Lisp_Object Qmemory; Lisp_Object Qmessage; +Lisp_Object Qmeta; Lisp_Object Qminus; Lisp_Object Qmodifiers; Lisp_Object Qmotion; ＠＠ -136,6 +144,7 ＠＠ Lisp_Object Qright; Lisp_Object Qsearch; Lisp_Object Qselected; +Lisp_Object Qshift; Lisp_Object Qsignal; Lisp_Object Qsimple; Lisp_Object Qsize; ＠＠ -143,8 +152,10 ＠＠ Lisp_Object Qspecifier; Lisp_Object Qstream; Lisp_Object Qstring; +Lisp_Object Qsuper; Lisp_Object Qsymbol; Lisp_Object Qsyntax; +Lisp_Object Qtab; Lisp_Object Qtest; Lisp_Object Qtext; Lisp_Object Qtimeout; ＠＠ -172,10 +183,12 ＠＠ defsymbol (&Qactually_requested, "actually-requested"); defsymbol (&Qafter, "after"); defsymbol (&Qall, "all"); + defsymbol (&Qalt, "alt"); defsymbol (&Qand, "and"); defsymbol (&Qassoc, "assoc"); defsymbol (&Qat, "at"); defsymbol (&Qautodetect, "autodetect"); + defsymbol (&Qbackspace, "backspace"); defsymbol (&Qbad_variable, "bad-variable"); defsymbol (&Qbefore, "before"); defsymbol (&Qbinary, "binary"); ＠＠ -194,7 +207,9 ＠＠ defsymbol (&Qcolumns, "columns"); defsymbol (&Qcommand, "command"); defsymbol (&Qconsole, "console"); + defsymbol (&Qcontrol, "control"); defsymbol (&Qcritical, "critical"); + defsymbol (&Qctrl, "ctrl"); defsymbol (&Qcursor, "cursor"); defsymbol (&Qdata, "data"); defsymbol (&Qdead, "dead"); ＠＠ -210,6 +225,7 ＠＠ defsymbol (&Qeq, "eq"); defsymbol (&Qeql, "eql"); defsymbol (&Qequal, "equal"); + defsymbol (&Qescape, "escape"); defsymbol (&Qeval, "eval"); defsymbol (&Qextents, "extents"); defsymbol (&Qface, "face"); ＠＠ -224,6 +240,7 ＠＠ defsymbol (&Qheight, "height"); defsymbol (&Qhighlight, "highlight"); defsymbol (&Qhorizontal, "horizontal"); + defsymbol (&Qhyper, "hyper"); defsymbol (&Qicon, "icon"); defsymbol (&Qid, "id"); defsymbol (&Qimage, "image"); ＠＠ -235,6 +252,7 ＠＠ defsymbol (&Qkey_assoc, "key-assoc"); defsymbol (&Qkeymap, "keymap"); defsymbol (&Qleft, "left"); + defsymbol (&Qlinefeed, "linefeed"); defsymbol (&Qlist, "list"); defsymbol (&Qmagic, "magic"); defsymbol (&Qmalloc_overhead, "malloc-overhead"); ＠＠ -242,6 +260,7 ＠＠ defsymbol (&Qmax, "max"); defsymbol (&Qmemory, "memory"); defsymbol (&Qmessage, "message"); + defsymbol (&Qmeta, "meta"); defsymbol (&Qminus, "-"); defsymbol (&Qmodifiers, "modifiers"); defsymbol (&Qmotion, "motion"); ＠＠ -274,6 +293,7 ＠＠ defsymbol (&Qright, "right"); defsymbol (&Qsearch, "search"); defsymbol (&Qselected, "selected"); + defsymbol (&Qshift, "shift"); defsymbol (&Qsignal, "signal"); defsymbol (&Qsimple, "simple"); defsymbol (&Qsize, "size"); ＠＠ -281,8 +301,10 ＠＠ defsymbol (&Qspecifier, "specifier"); defsymbol (&Qstream, "stream"); defsymbol (&Qstring, "string"); + defsymbol (&Qsuper, "super"); defsymbol (&Qsymbol, "symbol"); defsymbol (&Qsyntax, "syntax"); + defsymbol (&Qtab, "tab"); defsymbol (&Qtest, "test"); defsymbol (&Qtext, "text"); defsymbol (&Qtimeout, "timeout"); Index: tests/automated/lisp-tests.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/automated/Attic/lisp-tests.el,v retrieving revision 1.1.2.6 diff -u -w -r1.1.2.6 lisp-tests.el --- lisp-tests.el 1999/06/04 12:53:49 1.1.2.6 +++ lisp-tests.el 1999/09/15 04:03:30 ＠＠ -802,3 +802,23 ＠＠ (Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))) (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar"))) (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))) + +;;----------------------------------------------------- +;; Test single-key-description +;;----------------------------------------------------- +(Check-Error malformed-list (single-key-description '(meta . meta))) +(macrolet ((testit (key-description) + `(Check-Error-Message + error "Invalid key description" + (single-key-description ,key-description)))) + (testit '(foo bar)) + (testit '(1 2 3)) + (testit '(x meta)) + (testit (let ((x '(meta))) (setcdr x x))) + (testit 3.0)) + +(Assert (equal "C-a" (single-key-description 1))) +(Assert (equal "7" (single-key-description 55))) +(Assert (equal "7" (single-key-description ?7))) +(Assert (equal "M-x" (single-key-description '(meta x)))) +(Assert (equal "M-H-C-Sh-x" (single-key-description '(meta hyper control shift x)))) Index: tests/automated/test-harness.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/automated/Attic/test-harness.el,v retrieving revision 1.1.2.3 diff -u -w -r1.1.2.3 test-harness.el --- test-harness.el 1999/05/10 07:13:47 1.1.2.3 +++ test-harness.el 1999/09/15 04:03:30 ＠＠ -173,7 +173,7 ＠＠ (incf no-error-failures)) (,expected-error (let ((error-message (second error-info))) - (if (string-match ,expected-error-regexp error-message) + (if (and (stringp error-message) (string-match ,expected-error-regexp error-message)) (progn (princ (format "PASS: %S ==> error %S %S, as expected\n" ,quoted-body error-message ',expected-error))