X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59a84f8e16e2251e56e86d261f24cd209ded2946..341a09cf9d8cc8a9a0801dec78904d54d2bf99d8:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index 5ccdf319fc..13b93fb390 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -27,6 +27,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "termhooks.h" #include "macros.h" +#include "keyboard.h" #include "frame.h" #include "window.h" #include "commands.h" @@ -34,7 +35,6 @@ Boston, MA 02111-1307, USA. */ #include "charset.h" #include "disptab.h" #include "dispextern.h" -#include "keyboard.h" #include "syntax.h" #include "intervals.h" #include "blockinput.h" @@ -70,10 +70,16 @@ Boston, MA 02111-1307, USA. */ #include "w32term.h" #endif /* HAVE_NTGUI */ +#ifdef macintosh +#include "macterm.h" +#endif + /* Include systime.h after xterm.h to avoid double inclusion of time.h. */ #include "systime.h" +#ifndef USE_CRT_DLL extern int errno; +#endif /* Variables for blockinput.h: */ @@ -91,7 +97,7 @@ extern int input_fd; #ifdef HAVE_WINDOW_SYSTEM /* Make all keyboard buffers much bigger when using X windows. */ #ifdef macintosh -/* But not too big (local data > 32K error) if on macintosh */ +/* But not too big (local data > 32K error) if on macintosh. */ #define KBD_BUFFER_SIZE 512 #else #define KBD_BUFFER_SIZE 4096 @@ -245,6 +251,10 @@ Lisp_Object Vmenu_bar_final_items; If the value is non-nil and not a number, we wait 2 seconds. */ Lisp_Object Vsuggest_key_bindings; +/* How long to display an echo-area message when the minibuffer is active. + If the value is not a number, such messages don't time out. */ +Lisp_Object Vminibuffer_message_timeout; + /* Character that causes a quit. Normally C-g. If we are running on an ordinary terminal, this must be an ordinary @@ -450,12 +460,17 @@ int input_pending; int meta_key; +/* Non-zero means force key bindings update in parse_menu_item. */ + +int update_menu_bindings; + extern char *pending_malloc_warning; /* Circular buffer for pre-read keyboard input. */ + static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; -/* Vector to GCPRO the frames and windows mentioned in kbd_buffer. +/* Vector to GCPRO the Lisp objects referenced from kbd_buffer. The interrupt-level event handlers will never enqueue an event on a frame which is not in Vframe_list, and once an event is dequeued, @@ -474,14 +489,16 @@ static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; Similar things happen when an event on a scroll bar is enqueued; the window may be deleted while the event is in the queue. - So, we use this vector to protect the frame_or_window field in the - event queue. That way, they'll be dequeued as dead frames or - windows, but still valid lisp objects. + So, we use this vector to protect the Lisp_Objects in the event + queue. That way, they'll be dequeued as dead frames or windows, + but still valid Lisp objects. If kbd_buffer[i].kind != no_event, then - (XVECTOR (kbd_buffer_frame_or_window)->contents[i] - == kbd_buffer[i].frame_or_window. */ -static Lisp_Object kbd_buffer_frame_or_window; + + AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window. + AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */ + +static Lisp_Object kbd_buffer_gcpro; /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. @@ -620,9 +637,11 @@ int flow_control; point to the boundary of the region. But, if a command sets this valiable to non-nil, we suppress this point adjustment. This variable is set to nil before reading a command. */ + Lisp_Object Vdisable_point_adjustment; /* If non-nil, always disable point adjustment. */ + Lisp_Object Vglobal_disable_point_adjustment; @@ -631,21 +650,32 @@ Lisp_Object Vglobal_disable_point_adjustment; /* Function for init_keyboard to call with no args (if nonzero). */ void (*keyboard_init_hook) (); -static int read_avail_input (); -static void get_input_pending (); -static int readable_events (); +static int read_avail_input P_ ((int)); +static void get_input_pending P_ ((int *, int)); +static int readable_events P_ ((int)); +static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *, + Lisp_Object, int *)); static Lisp_Object read_char_x_menu_prompt (); -static Lisp_Object read_char_minibuf_menu_prompt (); -static Lisp_Object make_lispy_event (); +static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int, + Lisp_Object *)); +static Lisp_Object make_lispy_event P_ ((struct input_event *)); #ifdef HAVE_MOUSE -static Lisp_Object make_lispy_movement (); +static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object, + enum scroll_bar_part, + Lisp_Object, Lisp_Object, + unsigned long)); #endif -static Lisp_Object modify_event_symbol (); -static Lisp_Object make_lispy_switch_frame (); +static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object, + Lisp_Object, char **, + Lisp_Object *, unsigned)); +static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object)); +static int parse_solitary_modifier P_ ((Lisp_Object)); static int parse_solitary_modifier (); +static void save_getcjmp P_ ((jmp_buf)); static void save_getcjmp (); -static void restore_getcjmp (); +static void restore_getcjmp P_ ((jmp_buf)); static Lisp_Object apply_modifiers P_ ((int, Lisp_Object)); +static void clear_event P_ ((struct input_event *)); /* Nonzero means don't try to suspend even if the operating system seems to support it. */ @@ -917,6 +947,18 @@ This function is called by the editor initialization to begin editing.") command_loop_level++; update_mode_lines = 1; + /* This function may have been called from a debugger called from + within redisplay, for instance by Edebugging a function called + from fontification-functions. We want to allow redisplay in + the debugging session. + + The recursive edit is left with a `(throw exit ...)'. The `exit' + tag is not caught anywhere in redisplay, i.e. when we leave the + recursive edit, the original redisplay leading to the recursive + edit will be unwound. The outcome should therefore be safe. */ + specbind (Qinhibit_redisplay, Qnil); + redisplaying_p = 0; + record_unwind_protect (recursive_edit_unwind, (command_loop_level && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) @@ -1188,7 +1230,7 @@ DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "", if (display_busy_cursor_p) cancel_busy_cursor (); #endif - Fthrow (Qtop_level, Qnil); + return Fthrow (Qtop_level, Qnil); } DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "", @@ -1199,6 +1241,7 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, Fthrow (Qexit, Qnil); error ("No recursive edit is in progress"); + return Qnil; } DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "", @@ -1209,6 +1252,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, Fthrow (Qexit, Qt); error ("No recursive edit is in progress"); + return Qnil; } /* This is the actual command reading loop, @@ -1229,7 +1273,7 @@ command_loop_1 () int i; int no_direct; int prev_modiff; - struct buffer *prev_buffer; + struct buffer *prev_buffer = NULL; #ifdef MULTI_KBOARD int was_locked = single_kboard; #endif @@ -1293,18 +1337,19 @@ command_loop_1 () Vdeactivate_mark = Qnil; /* If minibuffer on and echo area in use, - wait 2 sec and redraw minibuffer. */ + wait a short time and redraw minibuffer. */ if (minibuf_level && !NILP (echo_area_buffer[0]) - && EQ (minibuf_window, echo_area_window)) + && EQ (minibuf_window, echo_area_window) + && NUMBERP (Vminibuffer_message_timeout)) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, Qt); - Fsit_for (make_number (2), Qnil, Qnil); + Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil); /* Clear the echo area. */ message2 (0, 0, 0); safe_run_hooks (Qecho_area_clear_hook); @@ -1667,6 +1712,7 @@ adjust_point_for_property (last_pt) if (check_display && PT > BEGV && PT < ZV && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil) + && display_prop_intangible_p (val) && start < PT && end > PT && (last_pt <= start || last_pt >= end)) { @@ -1695,7 +1741,7 @@ static Lisp_Object safe_run_hooks_error (data) Lisp_Object data; { - Fset (Vinhibit_quit, Qnil); + return Fset (Vinhibit_quit, Qnil); } /* If we get an error while running the hook, cause the hook variable @@ -1894,6 +1940,84 @@ make_ctrl_char (c) return c; } +/* Display help echo in the echo area. + + HELP a string means display that string, HELP nil means clear the + help echo. If HELP is a function, call it with OBJECT and POS as + arguments; the function should return a help string or nil for + none. For all other types of HELP evaluate it to obtain a string. + + WINDOW is the window in which the help was generated, if any. + It is nil if not in a window. + + If OBJECT is a buffer, POS is the position in the buffer where the + `help-echo' text property was found. + + If OBJECT is an overlay, that overlay has a `help-echo' property, + and POS is the position in the overlay's buffer under the mouse. + + If OBJECT is a string (an overlay string or a string displayed with + the `display' property). POS is the position in that string under + the mouse. + + OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help + echo overwrites a keystroke echo currently displayed in the echo + area. + + Note: this function may only be called with HELP nil or a string + from X code running asynchronously. */ + +void +show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo) + Lisp_Object help, window, object, pos; + int ok_to_overwrite_keystroke_echo; +{ + if (!NILP (help) && !STRINGP (help)) + { + if (FUNCTIONP (help)) + { + Lisp_Object args[4]; + args[0] = help; + args[1] = window; + args[2] = object; + args[3] = pos; + help = safe_call (4, args); + } + else + help = safe_eval (help); + + if (!STRINGP (help)) + return; + } + + if (STRINGP (help) || NILP (help)) + { + if (!NILP (Vshow_help_function)) + call1 (Vshow_help_function, help); + else if (/* Don't overwrite minibuffer contents. */ + !MINI_WINDOW_P (XWINDOW (selected_window)) + /* Don't overwrite a keystroke echo. */ + && (NILP (echo_message_buffer) + || ok_to_overwrite_keystroke_echo) + /* Don't overwrite a prompt. */ + && !cursor_in_echo_area) + { + if (STRINGP (help)) + { + int count = specpdl_ptr - specpdl; + specbind (Qmessage_truncate_lines, Qt); + message3_nolog (help, STRING_BYTES (XSTRING (help)), + STRING_MULTIBYTE (help)); + unbind_to (count, Qnil); + } + else + message (0); + } + + help_echo_showing_p = STRINGP (help); + } +} + /* Input of single characters from keyboard */ @@ -1934,15 +2058,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) Lisp_Object prev_event; int *used_mouse_menu; { - Lisp_Object c; + volatile Lisp_Object c; int count; jmp_buf local_getcjmp; jmp_buf save_jump; - int key_already_recorded = 0; + volatile int key_already_recorded = 0; Lisp_Object tem, save; - Lisp_Object previous_echo_area_message; - Lisp_Object also_record; - int reread; + volatile Lisp_Object previous_echo_area_message; + volatile Lisp_Object also_record; + volatile int reread; struct gcpro gcpro1, gcpro2; also_record = Qnil; @@ -2074,7 +2198,10 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* Redisplay if no pending input. */ while (!input_pending) { - redisplay (); + if (help_echo_showing_p && !EQ (selected_window, minibuf_window)) + redisplay_preserve_echo_area (); + else + redisplay (); if (!input_pending) /* Normal case: no input arrived during redisplay. */ @@ -2382,6 +2509,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* Actually read a character, waiting if necessary. */ save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); + timer_start_idle (); c = kbd_buffer_get_event (&kb, used_mouse_menu); restore_getcjmp (save_jump); @@ -2428,7 +2556,6 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) non_reread: timer_stop_idle (); - start_polling (); if (NILP (c)) @@ -2452,8 +2579,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) and loop around to read another event. */ save = Vquit_flag; Vquit_flag = Qnil; - tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0), - c, 0, 0), 1); + tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1); Vquit_flag = save; if (!NILP (tem)) @@ -2528,16 +2654,21 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (INTEGERP (c) && ! NILP (Vinput_method_function) && (unsigned) XINT (c) >= ' ' - && (unsigned) XINT (c) < 127) + && (unsigned) XINT (c) != 127 + && (unsigned) XINT (c) < 256) { previous_echo_area_message = Fcurrent_message (); Vinput_method_previous_message = previous_echo_area_message; } - /* Now wipe the echo area. */ - if (!NILP (echo_area_buffer[0])) - safe_run_hooks (Qecho_area_clear_hook); - clear_message (1, 0); + /* Now wipe the echo area, except for help events which do their + own stuff with the echo area. */ + if (!CONSP (c) || !(EQ (Qhelp_echo, XCAR (c)))) + { + if (!NILP (echo_area_buffer[0])) + safe_run_hooks (Qecho_area_clear_hook); + clear_message (1, 0); + } reread_for_input_method: from_macro: @@ -2548,7 +2679,8 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) after the first event of the key sequence. */ && NILP (prev_event) && (unsigned) XINT (c) >= ' ' - && (unsigned) XINT (c) < 127) + && (unsigned) XINT (c) != 127 + && (unsigned) XINT (c) < 256) { Lisp_Object keys; int key_count; @@ -2630,21 +2762,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) reread_first: /* Display help if not echoing. */ - if (CONSP (c) - && EQ (XCAR (c), Qhelp_echo)) - { - Lisp_Object msg = XCDR (XCDR (c)); - - if (!NILP (Vshow_help_function)) - call1 (Vshow_help_function, msg); - else if (!echoing && !MINI_WINDOW_P (XWINDOW (selected_window))) - { - if (STRINGP (msg)) - message3_nolog (msg, XSTRING (msg)->size, STRING_MULTIBYTE (msg)); - else - message (0); - } - + if (CONSP (c) && EQ (XCAR (c), Qhelp_echo)) + { + /* (help-echo FRAME HELP WINDOW OBJECT POS). */ + Lisp_Object help, object, position, window; + help = Fnth (make_number (2), c); + window = Fnth (make_number (3), c); + object = Fnth (make_number (4), c); + position = Fnth (make_number (5), c); + show_help_echo (help, window, object, position, 0); goto retry; } @@ -2765,11 +2891,46 @@ static void record_char (c) Lisp_Object c; { - total_keys++; - XVECTOR (recent_keys)->contents[recent_keys_index] = c; - if (++recent_keys_index >= NUM_RECENT_KEYS) - recent_keys_index = 0; + Lisp_Object help; + + /* Don't record `help-echo' in recent_keys unless it shows some help + message, and a different help than the previoiusly recorded + event. */ + if (CONSP (c) && EQ (XCAR (c), Qhelp_echo)) + { + Lisp_Object help; + help = Fnth (make_number (2), c); + if (STRINGP (help)) + { + int last_idx; + Lisp_Object last_c, last_help; + + last_idx = recent_keys_index - 1; + if (last_idx < 0) + last_idx = NUM_RECENT_KEYS - 1; + last_c = AREF (recent_keys, last_idx); + + if (!CONSP (last_c) + || !EQ (XCAR (last_c), Qhelp_echo) + || (last_help = Fnth (make_number (2), last_c), + !EQ (last_help, help))) + { + total_keys++; + ASET (recent_keys, recent_keys_index, c); + if (++recent_keys_index >= NUM_RECENT_KEYS) + recent_keys_index = 0; + } + } + } + else + { + total_keys++; + ASET (recent_keys, recent_keys_index, c); + if (++recent_keys_index >= NUM_RECENT_KEYS) + recent_keys_index = 0; + } + /* Write c to the dribble file. If c is a lispy event, write the event's symbol to the dribble file, in . Bleaugh. If you, dear reader, have a better idea, you've got the source. :-) */ @@ -2802,7 +2963,8 @@ record_char (c) fflush (dribble); } - store_kbd_macro_char (c); + if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c))) + store_kbd_macro_char (c); num_nonmacro_input_events++; } @@ -2861,6 +3023,7 @@ tracking_off (old_value) get_input_pending (&input_pending, 1); } } + return Qnil; } DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, @@ -3004,6 +3167,7 @@ kbd_buffer_store_event (event) { sp->kind = no_event; sp->frame_or_window = Qnil; + sp->arg = Qnil; } } return; @@ -3051,6 +3215,11 @@ kbd_buffer_store_event (event) Discard the event if it would fill the last slot. */ if (kbd_fetch_ptr - 1 != kbd_store_ptr) { + int idx; + +#if 0 /* The selection_request_event case looks bogus, and it's error + prone to assign individual members for other events, in case + the input_event structure is changed. --2000-07-13, gerd. */ struct input_event *sp = kbd_store_ptr; sp->kind = event->kind; if (event->kind == selection_request_event) @@ -3061,22 +3230,94 @@ kbd_buffer_store_event (event) bcopy (event, (char *) sp, sizeof (*event)); } else + { sp->code = event->code; sp->part = event->part; sp->frame_or_window = event->frame_or_window; + sp->arg = event->arg; sp->modifiers = event->modifiers; sp->x = event->x; sp->y = event->y; sp->timestamp = event->timestamp; } - (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr - - kbd_buffer] - = event->frame_or_window); +#else + *kbd_store_ptr = *event; +#endif - kbd_store_ptr++; + idx = 2 * (kbd_store_ptr - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, event->frame_or_window); + ASET (kbd_buffer_gcpro, idx + 1, event->arg); + ++kbd_store_ptr; } } + + +/* Generate HELP_EVENT input_events in BUFP which has room for + SIZE events. If there's not enough room in BUFP, ignore this + event. + + HELP is the help form. + + FRAME is the frame on which the help is generated. OBJECT is the + Lisp object where the help was found (a buffer, a string, an + overlay, or nil if neither from a string nor from a buffer. POS is + the position within OBJECT where the help was found. + + Value is the number of input_events generated. */ + +int +gen_help_event (bufp, size, help, frame, window, object, pos) + struct input_event *bufp; + int size; + Lisp_Object help, frame, object, window; + int pos; +{ + int nevents_stored = 0; + + if (size >= 2) + { + bufp->kind = HELP_EVENT; + bufp->frame_or_window = frame; + bufp->arg = object; + bufp->x = make_number (pos); + bufp->code = 0; + + ++bufp; + bufp->kind = HELP_EVENT; + bufp->frame_or_window = WINDOWP (window) ? window : frame; + bufp->arg = help; + bufp->code = 1; + nevents_stored = 2; + } + + return nevents_stored; +} + + +/* Store HELP_EVENTs for HELP on FRAME in the input queue. */ + +void +kbd_buffer_store_help_event (frame, help) + Lisp_Object frame, help; +{ + struct input_event event; + + event.kind = HELP_EVENT; + event.frame_or_window = frame; + event.arg = Qnil; + event.x = make_number (0); + event.code = 0; + kbd_buffer_store_event (&event); + + event.kind = HELP_EVENT; + event.frame_or_window = frame; + event.arg = help; + event.x = make_number (0); + event.code = 1; + kbd_buffer_store_event (&event); +} + /* Discard any mouse events in the event buffer by setting them to no_event. */ @@ -3099,7 +3340,49 @@ discard_mouse_events () } } } + + +/* Return non-zero if there are any real events waiting in the event + buffer, not counting `no_event's. + + If DISCARD is non-zero, discard no_event events at the front of + the input queue, possibly leaving the input queue empty if there + are no real input events. */ + +int +kbd_buffer_events_waiting (discard) + int discard; +{ + struct input_event *sp; + + for (sp = kbd_fetch_ptr; + sp != kbd_store_ptr && sp->kind == no_event; + ++sp) + { + if (sp == kbd_buffer + KBD_BUFFER_SIZE) + sp = kbd_buffer; + } + + if (discard) + kbd_fetch_ptr = sp; + + return sp != kbd_store_ptr && sp->kind != no_event; +} + +/* Clear input event EVENT. */ + +static INLINE void +clear_event (event) + struct input_event *event; +{ + int idx = 2 * (event - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, Qnil); + ASET (kbd_buffer_gcpro, idx + 1, Qnil); + event->kind = no_event; +} + + /* Read one event from the event buffer, waiting if necessary. The value is a Lisp object representing the event. The value is nil for an event that should be ignored, @@ -3236,7 +3519,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu) abort (); #endif } -#if defined (HAVE_X11) || defined (HAVE_NTGUI) +#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh) else if (event->kind == delete_window_event) { /* Make an event (delete-frame (FRAME)). */ @@ -3244,6 +3527,8 @@ kbd_buffer_get_event (kbp, used_mouse_menu) obj = Fcons (Qdelete_frame, Fcons (obj, Qnil)); kbd_fetch_ptr = event + 1; } +#endif +#if defined (HAVE_X11) || defined (HAVE_NTGUI) else if (event->kind == iconify_event) { /* Make an event (iconify-frame (FRAME)). */ @@ -3265,7 +3550,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu) XSETBUFFER (obj, current_buffer); kbd_fetch_ptr = event + 1; } -#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) +#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh) else if (event->kind == menu_bar_activate_event) { kbd_fetch_ptr = event + 1; @@ -3297,15 +3582,51 @@ kbd_buffer_get_event (kbp, used_mouse_menu) kbd_fetch_ptr = event + 1; else if (event->kind == HELP_EVENT) { - /* The car of event->frame_or_window is a frame, - the cdr is the help to display. */ - obj = Fcons (Qhelp_echo, event->frame_or_window); + /* There are always two HELP_EVENTs in the input queue. */ + Lisp_Object object, position, help, frame, window; + + xassert (event->code == 0); + frame = event->frame_or_window; + object = event->arg; + position = event->x; + clear_event (event); + + kbd_fetch_ptr = event + 1; + event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) + ? kbd_fetch_ptr + : kbd_buffer); + xassert (event->code == 1); + help = event->arg; + window = event->frame_or_window; + if (!WINDOWP (window)) + window = Qnil; + obj = Fcons (Qhelp_echo, + list5 (frame, help, window, object, position)); + clear_event (event); + kbd_fetch_ptr = event + 1; + } + else if (event->kind == FOCUS_IN_EVENT) + { + /* Notification of a FocusIn event. The frame receiving the + focus is in event->frame_or_window. Generate a + switch-frame event if necessary. */ + Lisp_Object frame, focus; + + frame = event->frame_or_window; + focus = FRAME_FOCUS_FRAME (XFRAME (frame)); + if (FRAMEP (focus)) + frame = focus; + + if (!EQ (frame, internal_last_event_frame) + && !EQ (frame, selected_frame)) + obj = make_lispy_switch_frame (frame); + internal_last_event_frame = frame; kbd_fetch_ptr = event + 1; } - /* If this event is on a different frame, return a switch-frame this - time, and leave the event in the queue for next time. */ else { + /* If this event is on a different frame, return a switch-frame this + time, and leave the event in the queue for next time. */ Lisp_Object frame; Lisp_Object focus; @@ -3329,25 +3650,25 @@ kbd_buffer_get_event (kbp, used_mouse_menu) if (NILP (obj)) { + int idx; + obj = make_lispy_event (event); + #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) /* If this was a menu selection, then set the flag to inhibit writing to last_nonmenu_event. Don't do this if the event we're returning is (menu-bar), though; that indicates the beginning of the menu sequence, and we might as well leave that as the `event with parameters' for this selection. */ - if ((event->kind == menu_bar_event - || event->kind == TOOL_BAR_EVENT) - && !(CONSP (obj) && EQ (XCAR (obj), Qmenu_bar)) - && !(CONSP (obj) && EQ (XCAR (obj), Qtool_bar)) - && used_mouse_menu) + if (used_mouse_menu + && !EQ (event->frame_or_window, event->arg) + && (event->kind == MENU_BAR_EVENT + || event->kind == TOOL_BAR_EVENT)) *used_mouse_menu = 1; #endif /* Wipe out this event, to catch bugs. */ - event->kind = no_event; - XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil; - + clear_event (event); kbd_fetch_ptr = event + 1; } } @@ -3560,7 +3881,7 @@ timer_check (do_it_now) while (CONSP (timers) || CONSP (idle_timers)) { Lisp_Object *vector; - Lisp_Object timer, idle_timer; + Lisp_Object timer = Qnil, idle_timer = Qnil; EMACS_TIME timer_time, idle_timer_time; EMACS_TIME difference, timer_difference, idle_timer_difference; @@ -3663,7 +3984,7 @@ timer_check (do_it_now) } vector = XVECTOR (chosen_timer)->contents; - /* If timer is rupe, run it if it hasn't been run. */ + /* If timer is ripe, run it if it hasn't been run. */ if (EMACS_TIME_NEG_P (difference) || (EMACS_SECS (difference) == 0 && EMACS_USECS (difference) == 0)) @@ -4233,6 +4554,14 @@ make_lispy_event (event) return lispy_c; } + case multibyte_char_keystroke: + { + Lisp_Object lispy_c; + + XSETFASTINT (lispy_c, event->code); + return lispy_c; + } + /* A function key. The symbol may need to have modifier prefixes tacked onto it. */ case non_ascii_keystroke: @@ -4304,6 +4633,8 @@ make_lispy_event (event) Lisp_Object *start_pos_ptr; Lisp_Object start_pos; + position = Qnil; + /* Build the position as appropriate for this mouse click. */ if (event->kind == mouse_click) { @@ -4409,7 +4740,7 @@ make_lispy_event (event) if (part == 1 || part == 3) { - /* Mode line or top line. Look for a string under + /* Mode line or header line. Look for a string under the mouse that may have a `local-map' property. */ Lisp_Object string; int charpos; @@ -4680,7 +5011,8 @@ make_lispy_event (event) return Qnil; pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), &column, &row, NULL, 1); - window = window_from_coordinates (f, column, row, &part, 0); + window = window_from_coordinates (f, XINT (event->x), + XINT (event->y), &part, 0); if (!WINDOWP (window)) { @@ -4692,7 +5024,8 @@ make_lispy_event (event) int pixcolumn, pixrow; column -= XINT (XWINDOW (window)->left); row -= XINT (XWINDOW (window)->top); - glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow); + glyph_to_pixel_coords (XWINDOW(window), column, row, + &pixcolumn, &pixrow); XSETINT (event->x, pixcolumn); XSETINT (event->y, pixrow); @@ -4737,7 +5070,6 @@ make_lispy_event (event) Lisp_Object window; Lisp_Object posn; Lisp_Object files; - int row, column; /* The frame_or_window field should be a cons of the frame in which the event occurred and a list of the filenames @@ -4752,9 +5084,9 @@ make_lispy_event (event) have been deleted. */ if (! FRAME_LIVE_P (f)) return Qnil; - pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), - &column, &row, NULL, 1); - window = window_from_coordinates (f, column, row, &part, 0); + + window = window_from_coordinates (f, XINT (event->x), + XINT (event->y), &part, 0); if (!WINDOWP (window)) { @@ -4808,26 +5140,27 @@ make_lispy_event (event) } #endif /* HAVE_MOUSE */ -#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) - case menu_bar_event: - /* The event value is in the cdr of the frame_or_window slot. */ - if (!CONSP (event->frame_or_window)) - abort (); - return XCDR (event->frame_or_window); +#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh) + case MENU_BAR_EVENT: + if (EQ (event->arg, event->frame_or_window)) + /* This is the prefix key. We translate this to + `(menu_bar)' because the code in keyboard.c for menu + events, which we use, relies on this. */ + return Fcons (Qmenu_bar, Qnil); + return event->arg; #endif case TOOL_BAR_EVENT: - { - Lisp_Object key; - if (!CONSP (event->frame_or_window)) - abort (); - key = XCDR (event->frame_or_window); - if (SYMBOLP (key)) - key = apply_modifiers (event->modifiers, key); - return key; - } - - case user_signal: + if (EQ (event->arg, event->frame_or_window)) + /* This is the prefix key. We translate this to + `(tool_bar)' because the code in keyboard.c for menu + events, which we use, relies on this. */ + return Fcons (Qtool_bar, Qnil); + else if (SYMBOLP (event->arg)) + return apply_modifiers (event->modifiers, event->arg); + return event->arg; + + case USER_SIGNAL_EVENT: /* A user signal. */ return *lispy_user_signals[event->code]; @@ -5251,7 +5584,7 @@ reorder_modifiers (symbol) Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes into symbol names, or a string specifying a name stem used to - contruct a symbol name or the form `STEM-N', where N is the decimal + construct a symbol name or the form `STEM-N', where N is the decimal representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is non-nil; otherwise NAME_TABLE is used. @@ -5428,7 +5761,10 @@ has the same base event type and all the specified modifiers.") else if (SYMBOLP (base)) return apply_modifiers (modifiers, base); else - error ("Invalid base event"); + { + error ("Invalid base event"); + return Qnil; + } } /* Try to recognize SYMBOL as a modifier name. @@ -5524,6 +5860,12 @@ lucid_event_type_list_p (object) if (! CONSP (object)) return 0; + if (EQ (XCAR (object), Qhelp_echo) + || EQ (XCAR (object), Qvertical_line) + || EQ (XCAR (object), Qmode_line) + || EQ (XCAR (object), Qheader_line)) + return 0; + for (tail = object; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt; @@ -5601,6 +5943,7 @@ record_asynch_buffer_change () event.kind = buffer_switch_event; event.frame_or_window = Qnil; + event.arg = Qnil; #ifdef subprocesses /* We don't need a buffer-switch event unless Emacs is waiting for input. @@ -5762,6 +6105,7 @@ read_avail_input (expected) buf[i].code = cbuf[i]; buf[i].frame_or_window = selected_frame; + buf[i].arg = Qnil; } } @@ -5863,8 +6207,8 @@ map_prompt (map) return Qnil; } -static void menu_bar_item (); -static void menu_bar_one_keymap (); +static void menu_bar_item P_ ((Lisp_Object, Lisp_Object)); +static void menu_bar_one_keymap P_ ((Lisp_Object)); /* These variables hold the vector under construction within menu_bar_items and its subroutines, and the current index @@ -5939,11 +6283,18 @@ menu_bar_items (old) } else { - /* No, so use major and minor mode keymaps. */ + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; nmaps = current_minor_maps (NULL, &tmaps); - maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0])); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); - maps[nmaps++] = get_local_map (PT, current_buffer); + if (!NILP (map)) + maps[nmaps++] = map; + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); } maps[nmaps++] = current_global_map; } @@ -5953,16 +6304,13 @@ menu_bar_items (old) result = Qnil; for (mapno = nmaps - 1; mapno >= 0; mapno--) - { - if (! NILP (maps[mapno])) - def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0), 0); - else - def = Qnil; - - tem = Fkeymapp (def); - if (!NILP (tem)) - menu_bar_one_keymap (def); - } + if (!NILP (maps[mapno])) + { + def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1), + 0, 1); + if (CONSP (def)) + menu_bar_one_keymap (def); + } /* Move to the end those items that should be at the end. */ @@ -6075,29 +6423,27 @@ menu_bar_item (key, item) &XVECTOR (menu_bar_items_vector)->contents[i], (menu_bar_items_index - i - 4) * sizeof (Lisp_Object)); menu_bar_items_index -= 4; - return; } - - /* If there's no definition for this key yet, - just ignore `undefined'. */ - return; } - GCPRO1 (key); /* Is this necessary? */ - i = parse_menu_item (item, 0, 1); - UNGCPRO; - if (!i) - return; - /* If this keymap has already contributed to this KEY, don't contribute to it a second time. */ tem = Fmemq (key, menu_bar_one_keymap_changed_items); - if (!NILP (tem)) + if (!NILP (tem) || NILP (item)) return; menu_bar_one_keymap_changed_items = Fcons (key, menu_bar_one_keymap_changed_items); + /* We add to menu_bar_one_keymap_changed_items before doing the + parse_menu_item, so that if it turns out it wasn't a menu item, + it still correctly hides any further menu item. */ + GCPRO1 (key); + i = parse_menu_item (item, 0, 1); + UNGCPRO; + if (!i) + return; + item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; /* Find any existing item for this KEY. */ @@ -6199,11 +6545,11 @@ parse_menu_item (item, notreal, inmenubar) /* Initialize optional entries. */ for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++) - XVECTOR (item_properties)->contents[i] = Qnil; - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = Qt; + AREF (item_properties, i) = Qnil; + AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt; /* Save the item here to protect it from GC. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ITEM] = item; + AREF (item_properties, ITEM_PROPERTY_ITEM) = item; item_string = XCAR (item); @@ -6212,18 +6558,17 @@ parse_menu_item (item, notreal, inmenubar) if (STRINGP (item_string)) { /* Old format menu item. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string; + AREF (item_properties, ITEM_PROPERTY_NAME) = item_string; /* Maybe help string. */ if (CONSP (item) && STRINGP (XCAR (item))) { - XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] - = XCAR (item); + AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item); start = item; item = XCDR (item); } - /* Maybee key binding cache. */ + /* Maybe key binding cache. */ if (CONSP (item) && CONSP (XCAR (item)) && (NILP (XCAR (XCAR (item))) || VECTORP (XCAR (XCAR (item))))) @@ -6233,27 +6578,25 @@ parse_menu_item (item, notreal, inmenubar) } /* This is the real definition--the function to run. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = item; + AREF (item_properties, ITEM_PROPERTY_DEF) = item; /* Get enable property, if any. */ if (SYMBOLP (item)) { tem = Fget (item, Qmenu_enable); if (!NILP (tem)) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem; + AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem; } } else if (EQ (item_string, Qmenu_item) && CONSP (item)) { /* New format menu item. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] - = XCAR (item); + AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item); start = XCDR (item); if (CONSP (start)) { /* We have a real binding. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] - = XCAR (start); + AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start); item = XCDR (start); /* Is there a cache list with key equivalences. */ @@ -6270,8 +6613,7 @@ parse_menu_item (item, notreal, inmenubar) item = XCDR (item); if (EQ (tem, QCenable)) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] - = XCAR (item); + AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item); else if (EQ (tem, QCvisible) && !notreal) { /* If got a visible property and that evaluates to nil @@ -6281,8 +6623,7 @@ parse_menu_item (item, notreal, inmenubar) return 0; } else if (EQ (tem, QChelp)) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] - = XCAR (item); + AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item); else if (EQ (tem, QCfilter)) filter = item; else if (EQ (tem, QCkey_sequence)) @@ -6297,8 +6638,7 @@ parse_menu_item (item, notreal, inmenubar) { tem = XCAR (item); if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist))) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] - = tem; + AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem; } else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) { @@ -6307,9 +6647,9 @@ parse_menu_item (item, notreal, inmenubar) type = XCAR (tem); if (EQ (type, QCtoggle) || EQ (type, QCradio)) { - XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED] + AREF (item_properties, ITEM_PROPERTY_SELECTED) = XCDR (tem); - XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE] + AREF (item_properties, ITEM_PROPERTY_TYPE) = type; } } @@ -6324,23 +6664,23 @@ parse_menu_item (item, notreal, inmenubar) /* If item string is not a string, evaluate it to get string. If we don't get a string, skip this item. */ - item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; + item_string = AREF (item_properties, ITEM_PROPERTY_NAME); if (!(STRINGP (item_string) || notreal)) { item_string = menu_item_eval_property (item_string); if (!STRINGP (item_string)) return 0; - XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string; + AREF (item_properties, ITEM_PROPERTY_NAME) = item_string; } /* If got a filter apply it on definition. */ - def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; + def = AREF (item_properties, ITEM_PROPERTY_DEF); if (!NILP (filter)) { def = menu_item_eval_property (list2 (XCAR (filter), list2 (Qquote, def))); - XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def; + AREF (item_properties, ITEM_PROPERTY_DEF) = def; } /* If we got no definition, this item is just unselectable text which @@ -6349,7 +6689,7 @@ parse_menu_item (item, notreal, inmenubar) return (inmenubar ? 0 : 1); /* Enable or disable selection of item. */ - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]; + tem = AREF (item_properties, ITEM_PROPERTY_ENABLE); if (!EQ (tem, Qt)) { if (notreal) @@ -6358,19 +6698,20 @@ parse_menu_item (item, notreal, inmenubar) tem = menu_item_eval_property (tem); if (inmenubar && NILP (tem)) return 0; /* Ignore disabled items in menu bar. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem; + AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem; } /* See if this is a separate pane or a submenu. */ - def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; - tem = get_keymap_1 (def, 0, 1); + def = AREF (item_properties, ITEM_PROPERTY_DEF); + tem = get_keymap (def, 0, 1); /* For a subkeymap, just record its details and exit. */ - if (!NILP (tem)) + if (CONSP (tem)) { - XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem; - XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem; + AREF (item_properties, ITEM_PROPERTY_MAP) = tem; + AREF (item_properties, ITEM_PROPERTY_DEF) = tem; return 1; } + /* At the top level in the menu bar, do likewise for commands also. The menu bar does not display equivalent key bindings anyway. ITEM_PROPERTY_DEF is already set up properly. */ @@ -6385,7 +6726,7 @@ parse_menu_item (item, notreal, inmenubar) XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start)); cachelist = XCAR (XCDR (start)); newcache = 1; - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; + tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ); if (!NILP (keyhint)) { XCAR (cachelist) = XCAR (keyhint); @@ -6397,6 +6738,7 @@ parse_menu_item (item, notreal, inmenubar) XCAR (cachelist) = Qt; } } + tem = XCAR (cachelist); if (!EQ (tem, Qt)) { @@ -6406,21 +6748,22 @@ parse_menu_item (item, notreal, inmenubar) if (!NILP (tem)) tem = Fkey_binding (tem, Qnil); - prefix = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; + prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ); if (CONSP (prefix)) { def = XCAR (prefix); prefix = XCDR (prefix); } else - def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; + def = AREF (item_properties, ITEM_PROPERTY_DEF); - if (NILP (XCAR (cachelist))) /* Have no saved key. */ + if (!update_menu_bindings) + chkcache = 0; + else if (NILP (XCAR (cachelist))) /* Have no saved key. */ { if (newcache /* Always check first time. */ /* Should we check everything when precomputing key bindings? */ - /* || notreal */ /* If something had no key binding before, don't recheck it because that is too slow--except if we have a list of rebound commands in Vdefine_key_rebound_commands, do @@ -6445,7 +6788,8 @@ parse_menu_item (item, notreal, inmenubar) command name has equivalent keys. Otherwise look up the specified command itself. We don't try both, because that makes lmenu menus slow. */ - if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) + if (SYMBOLP (def) + && SYMBOLP (XSYMBOL (def)->function) && ! NILP (Fget (def, Qmenu_alias))) def = XSYMBOL (def)->function; tem = Fwhere_is_internal (def, Qnil, Qt, Qnil); @@ -6489,7 +6833,7 @@ parse_menu_item (item, notreal, inmenubar) return 1; /* If we have an equivalent key binding, use that. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] = tem; + AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem; /* Include this when menu help is implemented. tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]; @@ -6503,9 +6847,9 @@ parse_menu_item (item, notreal, inmenubar) */ /* Handle radio buttons or toggle boxes. */ - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; + tem = AREF (item_properties, ITEM_PROPERTY_SELECTED); if (!NILP (tem)) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED] + AREF (item_properties, ITEM_PROPERTY_SELECTED) = menu_item_eval_property (tem); return 1; @@ -6591,11 +6935,18 @@ tool_bar_items (reuse, nitems) } else { - /* No, so use major and minor mode keymaps. */ + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; nmaps = current_minor_maps (NULL, &tmaps); - maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0])); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); - maps[nmaps++] = get_local_map (PT, current_buffer); + if (!NILP (map)) + maps[nmaps++] = map; + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); } /* Add global keymap at the end. */ @@ -6607,9 +6958,9 @@ tool_bar_items (reuse, nitems) if (!NILP (maps[i])) { Lisp_Object keymap; - - keymap = get_keyelt (access_keymap (maps[i], Qtool_bar, 1, 1), 0); - if (!NILP (Fkeymapp (keymap))) + + keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1); + if (CONSP (keymap)) { Lisp_Object tail; @@ -6726,9 +7077,9 @@ parse_tool_bar_item (key, item) extern Lisp_Object QCbutton, QCtoggle, QCradio; int i; - /* Defininition looks like `(tool-bar-item CAPTION BINDING - PROPS...)'. Rule out items that aren't lists, don't start with - `tool-bar-item' or whose rest following `tool-bar-item' is not a + /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'. + Rule out items that aren't lists, don't start with + `menu-item' or whose rest following `tool-bar-item' is not a list. */ if (!CONSP (item) || !EQ (XCAR (item), Qmenu_item) @@ -6772,6 +7123,10 @@ parse_tool_bar_item (key, item) PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item); item = XCDR (item); + /* Ignore cached key binding, if any. */ + if (CONSP (item) && CONSP (XCAR (item))) + item = XCDR (item); + /* Process the rest of the properties. */ for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item))) { @@ -6825,7 +7180,7 @@ parse_tool_bar_item (key, item) PROP (TOOL_BAR_ITEM_BINDING)))); /* See if the binding is a keymap. Give up if it is. */ - if (!NILP (get_keymap_1 (PROP (TOOL_BAR_ITEM_BINDING), 0, 1))) + if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1))) return 0; /* Enable or disable selection of item. */ @@ -7031,6 +7386,8 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) Lisp_Object rest, vector; char *menu; + vector = Qnil; + if (! menu_prompting) return Qnil; @@ -7134,7 +7491,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) /* 1 if the char to type matches the string. */ int char_matches; Lisp_Object upcased_event, downcased_event; - Lisp_Object desc; + Lisp_Object desc = Qnil; Lisp_Object s = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; @@ -7143,7 +7500,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) char_matches = (XINT (upcased_event) == XSTRING (s)->data[0] || XINT (downcased_event) == XSTRING (s)->data[0]); if (! char_matches) - desc = Fsingle_key_description (event); + desc = Fsingle_key_description (event, Qnil); tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; @@ -7237,7 +7594,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) orig_defn_macro = current_kboard->defining_kbd_macro; current_kboard->defining_kbd_macro = Qnil; do - obj = read_char (commandflag, 0, 0, Qnil, 0); + obj = read_char (commandflag, 0, 0, Qt, 0); while (BUFFERP (obj)); current_kboard->defining_kbd_macro = orig_defn_macro; @@ -7284,31 +7641,6 @@ follow_key (key, nmaps, current, defs, next) int i, first_binding; int did_meta = 0; - /* If KEY is a meta ASCII character, treat it like meta-prefix-char - followed by the corresponding non-meta character. - Put the results into DEFS, since we are going to alter that anyway. - Do not alter CURRENT or NEXT. */ - if (INTEGERP (key) && (XINT (key) & CHAR_META)) - { - for (i = 0; i < nmaps; i++) - if (! NILP (current[i])) - { - Lisp_Object def; - def = get_keyelt (access_keymap (current[i], - meta_prefix_char, 1, 0), 0); - - /* Note that since we pass the resulting bindings through - get_keymap_1, non-prefix bindings for meta-prefix-char - disappear. */ - defs[i] = get_keymap_1 (def, 0, 1); - } - else - defs[i] = Qnil; - - did_meta = 1; - XSETINT (key, XFASTINT (key) & ~CHAR_META); - } - first_binding = nmaps; for (i = nmaps - 1; i >= 0; i--) { @@ -7320,7 +7652,7 @@ follow_key (key, nmaps, current, defs, next) else map = current[i]; - defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 0); + defs[i] = access_keymap (map, key, 1, 0, 1); if (! NILP (defs[i])) first_binding = i; } @@ -7331,7 +7663,7 @@ follow_key (key, nmaps, current, defs, next) /* Given the set of bindings we've found, produce the next set of maps. */ if (first_binding < nmaps) for (i = 0; i < nmaps; i++) - next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1); + next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1); return first_binding; } @@ -7383,40 +7715,44 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, int can_return_switch_frame; int fix_current_buffer; { - int count = specpdl_ptr - specpdl; + volatile int count = specpdl_ptr - specpdl; /* How many keys there are in the current key sequence. */ - int t; + volatile int t; /* The length of the echo buffer when we started reading, and the length of this_command_keys when we started reading. */ - int echo_start; - int keys_start; + volatile int echo_start; + volatile int keys_start; /* The number of keymaps we're scanning right now, and the number of keymaps we have allocated space for. */ - int nmaps; - int nmaps_allocated = 0; + volatile int nmaps; + volatile int nmaps_allocated = 0; /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in the current keymaps. */ - Lisp_Object *defs; + Lisp_Object *volatile defs = NULL; /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1] in the current keymaps, or nil where it is not a prefix. */ - Lisp_Object *submaps; + Lisp_Object *volatile submaps = NULL; /* The local map to start out with at start of key sequence. */ - Lisp_Object orig_local_map; + volatile Lisp_Object orig_local_map; + + /* The map from the `keymap' property to start out with at start of + key sequence. */ + volatile Lisp_Object orig_keymap; /* 1 if we have already considered switching to the local-map property of the place where a mouse click occurred. */ - int localized_local_map = 0; + volatile int localized_local_map = 0; /* The index in defs[] of the first keymap that has a binding for this key sequence. In other words, the lowest i such that defs[i] is non-nil. */ - int first_binding; + volatile int first_binding; /* If t < mock_input, then KEYBUF[t] should be read as the next input key. @@ -7431,7 +7767,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, restart_sequence; the loop will read keys from keybuf up until mock_input, thus rebuilding the state; and then it will resume reading characters from the keyboard. */ - int mock_input = 0; + volatile int mock_input = 0; /* If the sequence is unbound in submaps[], then keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map, @@ -7441,24 +7777,24 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, should hold off until t reaches them. We do this when we've just recognized a function key, to avoid searching for the function key's again in Vfunction_key_map. */ - int fkey_start = 0, fkey_end = 0; - Lisp_Object fkey_map; + volatile int fkey_start = 0, fkey_end = 0; + volatile Lisp_Object fkey_map; /* Likewise, for key_translation_map. */ - int keytran_start = 0, keytran_end = 0; - Lisp_Object keytran_map; + volatile int keytran_start = 0, keytran_end = 0; + volatile Lisp_Object keytran_map; /* If we receive a ``switch-frame'' event in the middle of a key sequence, we put it off for later. While we're reading, we keep the event here. */ - Lisp_Object delayed_switch_frame; + volatile Lisp_Object delayed_switch_frame; /* See the comment below... */ #if defined (GOBBLE_FIRST_EVENT) Lisp_Object first_event; #endif - Lisp_Object original_uppercase; - int original_uppercase_position = -1; + volatile Lisp_Object original_uppercase; + volatile int original_uppercase_position = -1; /* Gets around Microsoft compiler limitations. */ int dummyflag = 0; @@ -7467,8 +7803,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* Nonzero if we seem to have got the beginning of a binding in function_key_map. */ - int function_key_possible = 0; - int key_translation_possible = 0; + volatile int function_key_possible = 0; + volatile int key_translation_possible = 0; /* Save the status of key translation before each step, so that we can restore this after downcasing. */ @@ -7493,11 +7829,11 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, keytran_map = Vkey_translation_map; /* If there is no function-key-map, turn off function key scanning. */ - if (NILP (Fkeymapp (Vfunction_key_map))) + if (!KEYMAPP (Vfunction_key_map)) fkey_start = fkey_end = bufsize + 1; /* If there is no key-translation-map, turn off scanning. */ - if (NILP (Fkeymapp (Vkey_translation_map))) + if (!KEYMAPP (Vkey_translation_map)) keytran_start = keytran_end = bufsize + 1; if (INTERACTIVE) @@ -7530,7 +7866,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, &junk); #endif /* GOBBLE_FIRST_EVENT */ - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); /* We jump here when the key sequence has been thoroughly changed, and we need to rescan it starting from the beginning. When we jump here, @@ -7566,14 +7903,21 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, } else { + int extra_maps = 2; nmaps = current_minor_maps (0, &maps); - if (nmaps + 2 > nmaps_allocated) + if (!NILP (orig_keymap)) + extra_maps = 3; + if (nmaps + extra_maps > nmaps_allocated) { - submaps = (Lisp_Object *) alloca ((nmaps+2) * sizeof (submaps[0])); - defs = (Lisp_Object *) alloca ((nmaps+2) * sizeof (defs[0])); - nmaps_allocated = nmaps + 2; + submaps = (Lisp_Object *) alloca ((nmaps+extra_maps) + * sizeof (submaps[0])); + defs = (Lisp_Object *) alloca ((nmaps+extra_maps) + * sizeof (defs[0])); + nmaps_allocated = nmaps + extra_maps; } - bcopy (maps, submaps, nmaps * sizeof (submaps[0])); + bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0])); + if (!NILP (orig_keymap)) + submaps[nmaps++] = orig_keymap; submaps[nmaps++] = orig_local_map; } submaps[nmaps++] = current_global_map; @@ -7618,13 +7962,13 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, (say, a mouse click on the mode line which is being treated as [mode-line (mouse-...)], then we backtrack to this point of keybuf. */ - int last_real_key_start; + volatile int last_real_key_start; /* These variables are analogous to echo_start and keys_start; while those allow us to restart the entire key sequence, echo_local_start and keys_local_start allow us to throw away just one key. */ - int echo_local_start, keys_local_start, local_first_binding; + volatile int echo_local_start, keys_local_start, local_first_binding; if (t >= bufsize) error ("Key sequence too long"); @@ -7692,11 +8036,13 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, interrupted_kboard->kbd_queue); } mock_input = 0; - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } #endif - key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event, + key = read_char (NILP (prompt), nmaps, + (Lisp_Object *) submaps, last_nonmenu_event, &used_mouse_menu); } @@ -7737,7 +8083,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, Fset_buffer (XWINDOW (selected_window)->buffer); } - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } @@ -7751,7 +8098,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, keybuf[t++] = key; mock_input = t; Vquit_flag = Qnil; - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } @@ -7836,8 +8184,12 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); - set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); - orig_local_map = get_local_map (PT, current_buffer); + set_buffer_internal (XBUFFER (XWINDOW + (window)->buffer) +); + orig_local_map = get_local_map (PT, current_buffer, + local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } @@ -7858,13 +8210,24 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, if (INTEGERP (pos) && XINT (pos) >= BEG && XINT (pos) <= Z) { - map_here = get_local_map (XINT (pos), current_buffer); + map_here = get_local_map (XINT (pos), + current_buffer, local_map); if (!EQ (map_here, orig_local_map)) { orig_local_map = map_here; keybuf[t] = key; mock_input = t + 1; + goto replay_sequence; + } + map_here = get_local_map (XINT (pos), + current_buffer, keymap); + if (!EQ (map_here, orig_keymap)) + { + orig_keymap = map_here; + keybuf[t] = key; + mock_input = t + 1; + goto replay_sequence; } } @@ -7890,21 +8253,23 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, reconsider the key sequence with that keymap. */ if (CONSP (POSN_STRING (EVENT_START (key)))) { - Lisp_Object string, pos, map; + Lisp_Object string, pos, map, map2; string = POSN_STRING (EVENT_START (key)); pos = XCDR (string); string = XCAR (string); - - if (XINT (pos) >= 0 - && XINT (pos) < XSTRING (string)->size - && (map = Fget_text_property (pos, Qlocal_map, - string), - !NILP (map))) - { - orig_local_map = map; - goto replay_sequence; - } + if (XINT (pos) >= 0 + && XINT (pos) < XSTRING (string)->size) + { + map = Fget_text_property (pos, Qlocal_map, string); + if (!NILP (map)) + orig_local_map = map; + map2 = Fget_text_property (pos, Qkeymap, string); + if (!NILP (map2)) + orig_keymap = map2; + if (!NILP (map) || !NILP (map2)) + goto replay_sequence; + } } goto replay_key; @@ -8109,22 +8474,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, Lisp_Object key; key = keybuf[fkey_end++]; - /* Look up meta-characters by prefixing them - with meta_prefix_char. I hate this. */ - if (INTEGERP (key) && XINT (key) & meta_modifier) - { - fkey_next - = get_keymap_1 - (get_keyelt - (access_keymap (fkey_map, meta_prefix_char, 1, 0), 0), - 0, 1); - XSETFASTINT (key, XFASTINT (key) & ~meta_modifier); - } - else - fkey_next = fkey_map; - fkey_next - = get_keyelt (access_keymap (fkey_next, key, 1, 0), 1); + = access_keymap (fkey_map, key, 1, 0, 1); /* Handle symbol with autoload definition. */ if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next)) @@ -8137,7 +8488,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, or an array. */ if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next)) && (!NILP (Farrayp (XSYMBOL (fkey_next)->function)) - || !NILP (Fkeymapp (XSYMBOL (fkey_next)->function)))) + || KEYMAPP (XSYMBOL (fkey_next)->function))) fkey_next = XSYMBOL (fkey_next)->function; #if 0 /* I didn't turn this on, because it might cause trouble @@ -8210,11 +8561,11 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, goto replay_sequence; } - fkey_map = get_keymap_1 (fkey_next, 0, 1); + fkey_map = get_keymap (fkey_next, 0, 1); /* If we no longer have a bound suffix, try a new positions for fkey_start. */ - if (NILP (fkey_map)) + if (!CONSP (fkey_map)) { fkey_end = ++fkey_start; fkey_map = Vfunction_key_map; @@ -8233,22 +8584,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, Lisp_Object key; key = keybuf[keytran_end++]; - /* Look up meta-characters by prefixing them - with meta_prefix_char. I hate this. */ - if (INTEGERP (key) && XINT (key) & meta_modifier) - { - keytran_next - = get_keymap_1 - (get_keyelt - (access_keymap (keytran_map, meta_prefix_char, 1, 0), 0), - 0, 1); - XSETFASTINT (key, XFASTINT (key) & ~meta_modifier); - } - else - keytran_next = keytran_map; - keytran_next - = get_keyelt (access_keymap (keytran_next, key, 1, 0), 1); + = access_keymap (keytran_map, key, 1, 0, 1); /* Handle symbol with autoload definition. */ if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) @@ -8261,7 +8598,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, or an array. */ if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) && (!NILP (Farrayp (XSYMBOL (keytran_next)->function)) - || !NILP (Fkeymapp (XSYMBOL (keytran_next)->function)))) + || KEYMAPP (XSYMBOL (keytran_next)->function))) keytran_next = XSYMBOL (keytran_next)->function; /* If the key translation map gives a function, not an @@ -8325,11 +8662,11 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, goto replay_sequence; } - keytran_map = get_keymap_1 (keytran_next, 0, 1); + keytran_map = get_keymap (keytran_next, 0, 1); /* If we no longer have a bound suffix, try a new positions for keytran_start. */ - if (NILP (keytran_map)) + if (!CONSP (keytran_map)) { keytran_end = ++keytran_start; keytran_map = Vkey_translation_map; @@ -8545,9 +8882,13 @@ DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0, prompt, ! NILP (dont_downcase_last), ! NILP (can_return_switch_frame), 0); +#if 0 /* The following is fine for code reading a key sequence and + then proceeding with a lenghty compuation, but it's not good + for code reading keys in a loop, like an input method. */ #ifdef HAVE_X_WINDOWS if (display_busy_cursor_p) start_busy_cursor (); +#endif #endif if (i == -1) @@ -8884,11 +9225,18 @@ current_active_maps (maps_p) } else { - /* No, so use major and minor mode keymaps. */ + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; nmaps = current_minor_maps (NULL, &tmaps); - maps = (Lisp_Object *) xmalloc ((nmaps + 2) * sizeof (maps[0])); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); - maps[nmaps++] = get_local_map (PT, current_buffer); + if (!NILP (map)) + maps[nmaps++] = map; + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); } maps[nmaps++] = current_global_map; @@ -9116,7 +9464,7 @@ Also cancel any kbd macro being defined.") discard_tty_input (); kbd_fetch_ptr = kbd_store_ptr; - Ffillarray (kbd_buffer_frame_or_window, Qnil); + Ffillarray (kbd_buffer_gcpro, Qnil); input_pending = 0; return Qnil; @@ -9200,20 +9548,25 @@ stuff_buffered_input (stuffstring) stuff_char (*p++); stuff_char ('\n'); } + /* Anything we have read ahead, put back for the shell to read. */ /* ?? What should this do when we have multiple keyboards?? Should we ignore anything that was typed in at the "wrong" kboard? */ for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++) { + int idx; + if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ascii_keystroke) stuff_char (kbd_fetch_ptr->code); + kbd_fetch_ptr->kind = no_event; - (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr - - kbd_buffer] - = Qnil); + idx = 2 * (kbd_fetch_ptr - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, Qnil); + ASET (kbd_buffer_gcpro, idx + 1, Qnil); } + input_pending = 0; #endif #endif /* BSD_SYSTEM and not BSD4_1 */ @@ -9243,16 +9596,17 @@ clear_waiting_for_input () } /* This routine is called at interrupt level in response to C-G. - If interrupt_input, this is the handler for SIGINT. - Otherwise, it is called from kbd_buffer_store_event, - in handling SIGIO or SIGTINT. + + If interrupt_input, this is the handler for SIGINT. Otherwise, it + is called from kbd_buffer_store_event, in handling SIGIO or + SIGTINT. - If `waiting_for_input' is non zero, then unless `echoing' is nonzero, - immediately throw back to read_char. + If `waiting_for_input' is non zero, then unless `echoing' is + nonzero, immediately throw back to read_char. - Otherwise it sets the Lisp variable quit-flag not-nil. - This causes eval to throw, when it gets a chance. - If quit-flag is already non-nil, it stops the job right away. */ + Otherwise it sets the Lisp variable quit-flag not-nil. This causes + eval to throw, when it gets a chance. If quit-flag is already + non-nil, it stops the job right away. */ SIGTYPE interrupt_signal (signalnum) /* If we don't have an argument, */ @@ -9594,8 +9948,7 @@ init_keyboard () recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer; - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); + kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil); #ifdef HAVE_MOUSE do_mouse_tracking = Qnil; #endif @@ -9612,11 +9965,6 @@ init_keyboard () wipe_kboard (current_kboard); init_kboard (current_kboard); - if (initialized) - Ffillarray (kbd_buffer_frame_or_window, Qnil); - - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); if (!noninteractive && !read_socket_hook && NILP (Vwindow_system)) { signal (SIGINT, interrupt_signal); @@ -9832,6 +10180,8 @@ syms_of_keyboard () Fset (Qinput_method_exit_on_first_char, Qnil); Fset (Qinput_method_use_echo_area, Qnil); + last_point_position_buffer = Qnil; + { struct event_head *p; @@ -9875,9 +10225,8 @@ syms_of_keyboard () Fset (Qextended_command_history, Qnil); staticpro (&Qextended_command_history); - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); - staticpro (&kbd_buffer_frame_or_window); + kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil); + staticpro (&kbd_buffer_gcpro); accent_key_syms = Qnil; staticpro (&accent_key_syms); @@ -10286,6 +10635,17 @@ The default value is nil, in which case, point adjustment are\n\ suppressed only after special commands that set\n\ `disable-point-adjustment' (which see) to non-nil."); Vglobal_disable_point_adjustment = Qnil; + + DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings, + "Non-nil means updating menu bindings is allowed.\n\ +A value of nil means menu bindings should not be updated.\n\ +Used during Emacs' startup."); + update_menu_bindings = 1; + + DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout, + "*How long to display an echo-area message when the minibuffer is active.\n\ +If the value is not a number, such messages don't time out."); + Vminibuffer_message_timeout = make_number (2); } void