X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/88cb06568fc329c9d4220abe74722a82c2d7fc80..2fc6697323fd6cc950d808347b89ac3483d311e1:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index d0b4b526a1..3e8a522a07 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1,11 +1,11 @@ /* Keyboard and mouse input; editor command loop. - Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -33,7 +33,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "commands.h" #include "buffer.h" #include "disptab.h" +#include "dispextern.h" #include "keyboard.h" +#include "intervals.h" +#include "blockinput.h" #include #include @@ -47,6 +50,16 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ extern int errno; +/* Variables for blockinput.h: */ + +/* Non-zero if interrupt input is blocked right now. */ +int interrupt_input_blocked; + +/* Nonzero means an input interrupt has arrived + during the current critical section. */ +int interrupt_input_pending; + + #ifdef HAVE_X_WINDOWS extern Lisp_Object Vmouse_grabbed; @@ -78,10 +91,13 @@ int recent_keys_index; /* Index for storing next element into recent_keys */ int total_keys; /* Total number of elements stored into recent_keys */ Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */ -/* Buffer holding the key that invoked the current command. */ -Lisp_Object *this_command_keys; -int this_command_key_count; /* Size in use. */ -int this_command_keys_size; /* Size allocated. */ +/* Vector holding the key sequence that invoked the current command. + It is reused for each command, and it may be longer than the current + sequence; this_command_key_count indicates how many elements + actually mean something. + It's easier to staticpro a single Lisp_Object than an array. */ +Lisp_Object this_command_keys; +int this_command_key_count; extern int minbuf_level; @@ -148,8 +164,23 @@ Lisp_Object last_nonmenu_event; /* Last input character read for any purpose. */ Lisp_Object last_input_char; -/* If not Qnil, an object to be read as the next command input. */ -Lisp_Object unread_command_char; +/* If not Qnil, a list of objects to be read as subsequent command input. */ +Lisp_Object unread_command_events; + +/* If not -1, an event to be read as subsequent command input. */ +int unread_command_char; + +/* If not Qnil, this is a switch-frame event which we decided to put + off until the end of a key sequence. This should be read as the + next command input, after any unread_command_events. + + read_key_sequence uses this to delay switch-frame events until the + end of the key sequence; Fread_char uses it to put off switch-frame + events until a non-ASCII event is acceptable as input. */ +Lisp_Object unread_switch_frame; + +/* A mask of extra modifier bits to put into every keyboard char. */ +int extra_keyboard_modifiers; /* Char to use as prefix when a meta character is typed in. This is bound on entry to minibuffer in case ESC is changed there. */ @@ -189,11 +220,15 @@ Lisp_Object this_command; #ifdef MULTI_FRAME /* The frame in which the last input event occurred, or Qmacro if the - last event came from a macro. - command_loop_1 will select this frame before running the - command bound to an event sequence, and read_key_sequence will - toss the existing prefix if the user starts typing at a - new frame. */ + last event came from a macro. We use this to determine when to + generate switch-frame events. This may be cleared by functions + like Fselect_frame, to make sure that a switch-frame event is + generated by the next character. */ +Lisp_Object internal_last_event_frame; + +/* A user-visible version of the above, intended to allow users to + figure out where the last event came from, if the event doesn't + carry that information itself (i.e. if it was a character). */ Lisp_Object Vlast_event_frame; #endif @@ -218,13 +253,27 @@ Lisp_Object Vkeyboard_translate_table; /* Keymap mapping ASCII function key sequences onto their preferred forms. */ extern Lisp_Object Vfunction_key_map; +/* Non-nil means deactivate the mark at end of this command. */ +Lisp_Object Vdeactivate_mark; + +/* Menu bar specified in Lucid Emacs fashion. */ + +Lisp_Object Vlucid_menu_bar_dirty_flag; +Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook; + +/* Hooks to run before and after each command. */ +Lisp_Object Qpre_command_hook, Qpost_command_hook; +Lisp_Object Vpre_command_hook, Vpost_command_hook; + /* File in which we write all commands we read. */ FILE *dribble; /* Nonzero if input is available. */ int input_pending; -/* Nonzero if should obey 0200 bit in input chars as "Meta". */ +/* 1 if should obey 0200 bit in input chars as "Meta", 2 if should + keep 0200 bit in input chars. 0 to ignore the 0200 bit. */ + int meta_key; extern char *pending_malloc_warning; @@ -232,6 +281,34 @@ 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. + + 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, + internal_last_event_frame or the event itself points to the frame. + So that's all fine. + + But while the event is sitting in the queue, it's completely + unprotected. Suppose the user types one command which will run for + a while and then delete a frame, and then types another event at + the frame that will be deleted, before the command gets around to + it. Suppose there are no references to this frame elsewhere in + Emacs, and a GC occurs before the second event is dequeued. Now we + have an event referring to a freed frame, which will crash Emacs + when it is dequeued. + + 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. + + 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; + /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the @@ -241,20 +318,24 @@ static struct input_event *kbd_fetch_ptr; /* Pointer to next place to store character in kbd_buffer. This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next character should go in kbd_buffer[0]. */ +#ifdef __STDC__ +volatile +#endif static struct input_event *kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_write_count. When we dequeue a non-hook event, we increment kbd_read_count. We say that - there is input available iff the two counters are equal. + there is input available iff the two counters are not equal. Why not just have a flag set and cleared by the enqueuing and dequeuing functions? Such a flag could be screwed up by interrupts at inopportune times. */ -/* If this flag is non-zero, mouse movement events will appear in the - input stream. If is zero, mouse movement will be ignored. */ -int do_mouse_tracking; +/* If this flag is non-zero, we check mouse_moved to see when the + mouse moves, and motion events will appear in the input stream. If + it is zero, mouse motion is ignored. */ +static int do_mouse_tracking; /* The window system handling code should set this if the mouse has moved since the last call to the mouse_position_hook. Calling that @@ -274,31 +355,43 @@ int mouse_moved; /* Symbols to head events. */ Lisp_Object Qmouse_movement; - -Lisp_Object Qvscrollbar_part; -Lisp_Object Qvslider_part; -Lisp_Object Qvthumbup_part; -Lisp_Object Qvthumbdown_part; - -Lisp_Object Qhscrollbar_part; -Lisp_Object Qhslider_part; -Lisp_Object Qhthumbleft_part; -Lisp_Object Qhthumbright_part; +Lisp_Object Qscroll_bar_movement; +Lisp_Object Qswitch_frame; /* Symbols to denote kinds of events. */ Lisp_Object Qfunction_key; Lisp_Object Qmouse_click; /* Lisp_Object Qmouse_movement; - also an event header */ -Lisp_Object Qscrollbar_click; /* Properties of event headers. */ Lisp_Object Qevent_kind; Lisp_Object Qevent_symbol_elements; -/* Symbols to use for non-text mouse positions. */ +Lisp_Object Qmenu_enable; + +/* An event header symbol HEAD may have a property named + Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); + BASE is the base, unmodified version of HEAD, and MODIFIERS is the + mask of modifiers applied to it. If present, this is used to help + speed up parse_modifiers. */ +Lisp_Object Qevent_symbol_element_mask; + +/* An unmodified event header BASE may have a property named + Qmodifier_cache, which is an alist mapping modifier masks onto + modified versions of BASE. If present, this helps speed up + apply_modifiers. */ +Lisp_Object Qmodifier_cache; + +/* Symbols to use for parts of windows. */ Lisp_Object Qmode_line; Lisp_Object Qvertical_line; +Lisp_Object Qvertical_scroll_bar; +Lisp_Object Qmenu_bar; + +extern Lisp_Object Qmenu_enable; +Lisp_Object recursive_edit_unwind (), command_loop (); +Lisp_Object Fthis_command_keys (); /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt happens. */ @@ -350,8 +443,8 @@ static int echo_keystrokes; static int immediate_echo; /* The text we're echoing in the modeline - partial key sequences, - usually. '\0'-terminated. */ -static char echobuf[100]; + usually. '\0'-terminated. This really shouldn't have a fixed size. */ +static char echobuf[300]; /* Where to append more text to echobuf if we want to. */ static char *echoptr; @@ -369,8 +462,9 @@ echo_prompt (str) int len = strlen (str); if (len > sizeof echobuf - 4) len = sizeof echobuf - 4; - bcopy (str, echobuf, len + 1); + bcopy (str, echobuf, len); echoptr = echobuf + len; + *echoptr = '\0'; echo (); } @@ -399,7 +493,7 @@ echo_char (c) if (ptr - echobuf > sizeof echobuf - 6) return; - ptr = push_key_description (c, ptr); + ptr = push_key_description (XINT (c), ptr); } else if (XTYPE (c) == Lisp_Symbol) { @@ -410,7 +504,7 @@ echo_char (c) ptr += name->size; } - if (echoptr == echobuf && c == help_char) + if (echoptr == echobuf && EQ (c, help_char)) { strcpy (ptr, " (Type ? for further options)"); ptr += strlen (ptr); @@ -430,6 +524,9 @@ echo_dash () { if (!immediate_echo && echoptr == echobuf) return; + /* Do nothing if not echoing at all. */ + if (echoptr == 0) + return; /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ @@ -450,7 +547,7 @@ echo () immediate_echo = 1; for (i = 0; i < this_command_key_count; i++) - echo_char (this_command_keys[i]); + echo_char (XVECTOR (this_command_keys)->contents[i]); echo_dash (); } @@ -487,7 +584,7 @@ echo_truncate (len) int len; { echobuf[len] = '\0'; - echoptr = echobuf + strlen (echobuf); + echoptr = echobuf + len; } @@ -496,15 +593,20 @@ static void add_command_key (key) Lisp_Object key; { - if (this_command_key_count == this_command_keys_size) + int size = XVECTOR (this_command_keys)->size; + + if (this_command_key_count >= size) { - this_command_keys_size *= 2; - this_command_keys - = (Lisp_Object *) xrealloc (this_command_keys, - (this_command_keys_size - * sizeof (Lisp_Object))); + Lisp_Object new_keys = Fmake_vector (make_number (size * 2), Qnil); + + bcopy (XVECTOR (this_command_keys)->contents, + XVECTOR (new_keys)->contents, + size * sizeof (Lisp_Object)); + + this_command_keys = new_keys; } - this_command_keys[this_command_key_count++] = key; + + XVECTOR (this_command_keys)->contents[this_command_key_count++] = key; } Lisp_Object @@ -523,8 +625,7 @@ recursive_edit_1 () if (EQ (val, Qt)) Fsignal (Qquit, Qnil); - unbind_to (count); - return Qnil; + return unbind_to (count, Qnil); } /* When an auto-save happens, record the "time", and don't do again soon. */ @@ -533,8 +634,6 @@ record_auto_save () last_auto_save = num_nonmacro_input_chars; } -Lisp_Object recursive_edit_unwind (), command_loop (); - DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "", "Invoke the editor command loop recursively.\n\ To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\ @@ -758,15 +857,18 @@ static int read_key_sequence (); Lisp_Object command_loop_1 () { - Lisp_Object cmd; + Lisp_Object cmd, tem; int lose; int nonundocount; Lisp_Object keybuf[30]; int i; int no_redisplay; int no_direct; + int prev_modiff; + struct buffer *prev_buffer; Vprefix_arg = Qnil; + Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); @@ -797,6 +899,8 @@ command_loop_1 () no_direct = 0; + Vdeactivate_mark = Qnil; + /* If minibuffer on and echo area in use, wait 2 sec and redraw minibufer. */ @@ -807,14 +911,14 @@ command_loop_1 () int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, Qt); Fsit_for (make_number (2), Qnil, Qnil); - unbind_to (count); + unbind_to (count, Qnil); echo_area_glyphs = 0; no_direct = 1; if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; - unread_command_char = make_number (quit_char); + unread_command_events = Fcons (make_number (quit_char), Qnil); } } @@ -823,18 +927,54 @@ command_loop_1 () /* Since we can free the most stuff here. */ #endif /* C_ALLOCA */ +#if 0 +#ifdef MULTI_FRAME + /* Select the frame that the last event came from. Usually, + switch-frame events will take care of this, but if some lisp + code swallows a switch-frame event, we'll fix things up here. + Is this a good idea? */ + if (XTYPE (internal_last_event_frame) == Lisp_Frame + && XFRAME (internal_last_event_frame) != selected_frame) + Fselect_frame (internal_last_event_frame, Qnil); +#endif +#endif + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (! NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + +#ifdef MULTI_FRAME + for (tem = Vframe_list; CONSP (tem); tem = XCONS (tem)->cdr) + { + struct frame *f = XFRAME (XCONS (tem)->car); + struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); + + /* If the user has switched buffers or windows, we need to + recompute to reflect the new bindings. But we'll + recompute when update_mode_lines is set too; that means + that people can use force-mode-line-update to request + that the menu bar be recomputed. The adverse effect on + the rest of the redisplay algorithm is about the same as + windows_or_buffers_changed anyway. */ + if (windows_or_buffers_changed + || update_mode_lines + || (XFASTINT (w->last_modified) < MODIFF + && (XFASTINT (w->last_modified) + <= XBUFFER (w->buffer)->save_modified))) + { + struct buffer *prev = current_buffer; + current_buffer = XBUFFER (w->buffer); + FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (); + current_buffer = prev; + } + } +#endif /* MULTI_FRAME */ + /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), 0); ++num_input_keys; -#ifdef MULTI_FRAME - /* Select the frame that the key sequence came from. */ - if (XTYPE (Vlast_event_frame) == Lisp_Frame - && XFRAME (Vlast_event_frame) != selected_frame) - Fselect_frame (Vlast_event_frame, Qnil); -#endif - /* Now we have read a key sequence of length I, or else I is 0 and we found end of file. */ @@ -843,6 +983,11 @@ command_loop_1 () last_command_char = keybuf[i - 1]; + /* If the previous command tried to force a specific window-start, + forget about that, in case this command moves point far away + from that position. */ + XWINDOW (selected_window)->force_start = Qnil; + cmd = read_key_sequence_cmd; if (!NILP (Vexecuting_macro)) { @@ -858,8 +1003,15 @@ command_loop_1 () cases identified below that set no_redisplay to 1. */ no_redisplay = 0; + prev_buffer = current_buffer; + prev_modiff = MODIFF; + /* Execute the command. */ + this_command = cmd; + if (!NILP (Vpre_command_hook)) + call1 (Vrun_hooks, Qpre_command_hook); + if (NILP (cmd)) { /* nil means key is undefined. */ @@ -867,10 +1019,10 @@ command_loop_1 () defining_kbd_macro = 0; update_mode_lines = 1; Vprefix_arg = Qnil; + } else { - this_command = cmd; if (NILP (Vprefix_arg) && ! no_direct) { /* Recognize some common commands in common situations and @@ -881,10 +1033,10 @@ command_loop_1 () = window_display_table (XWINDOW (selected_window)); lose = FETCH_CHAR (point); SET_PT (point + 1); - if (((dp == 0 && lose >= 040 && lose < 0177) - || - (dp && (XTYPE (dp->contents[lose]) != Lisp_String - || XSTRING (dp->contents[lose])->size == sizeof (GLYPH)))) + if ((dp + ? (XTYPE (DISP_CHAR_VECTOR (dp, lose)) != Lisp_Vector + && XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1) + : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) @@ -902,10 +1054,10 @@ command_loop_1 () = window_display_table (XWINDOW (selected_window)); SET_PT (point - 1); lose = FETCH_CHAR (point); - if (((dp == 0 && lose >= 040 && lose < 0177) - || - (dp && (XTYPE (dp->contents[lose]) != Lisp_String - || XSTRING (dp->contents[lose])->size == sizeof (GLYPH)))) + if ((dp + ? (XTYPE (DISP_CHAR_VECTOR (dp, lose)) != Lisp_Vector + && XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1) + : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) @@ -942,7 +1094,7 @@ command_loop_1 () || !EQ (current_buffer->selective_display, Qnil) || detect_input_pending () || !NILP (Vexecuting_macro); - if (internal_self_insert (c, 0)) + if (internal_self_insert (XINT (c), 0)) { lose = 1; nonundocount = 0; @@ -952,13 +1104,24 @@ command_loop_1 () { struct Lisp_Vector *dp = window_display_table (XWINDOW (selected_window)); + int lose = XINT (c); - if (dp == 0 || XTYPE (dp->contents[c]) != Lisp_String) - no_redisplay = direct_output_for_insert (c); - else if (XSTRING (dp->contents[c])->size - == sizeof (GLYPH)) - no_redisplay = - direct_output_for_insert (*(GLYPH *)XSTRING (dp->contents[c])->data); + if (dp) + { + Lisp_Object obj = DISP_CHAR_VECTOR (dp, lose); + + if (XTYPE (obj) == Lisp_Vector + && XVECTOR (obj)->size == 1 + && (XTYPE (obj = XVECTOR (obj)->contents[0]) + == Lisp_Int)) + no_redisplay = + direct_output_for_insert (XINT (obj)); + } + else + { + if (lose >= 0x20 && lose <= 0x7e) + no_redisplay = direct_output_for_insert (lose); + } } goto directly_done; } @@ -974,6 +1137,9 @@ command_loop_1 () } directly_done: ; + if (!NILP (Vpost_command_hook)) + call1 (Vrun_hooks, Qpost_command_hook); + /* If there is a prefix argument, 1) We don't want last_command to be ``universal-argument'' (that would be dumb), so don't set last_command, @@ -989,6 +1155,17 @@ command_loop_1 () cancel_echoing (); this_command_key_count = 0; } + + if (!NILP (current_buffer->mark_active)) + { + if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) + { + current_buffer->mark_active = Qnil; + call1 (Vrun_hooks, intern ("deactivate-mark-hook")); + } + else if (current_buffer != prev_buffer || MODIFF != prev_modiff) + call1 (Vrun_hooks, intern ("activate-mark-hook")); + } } } @@ -1007,12 +1184,9 @@ int polling_for_input; SIGTYPE input_poll_signal () { -#ifdef HAVE_X_WINDOWS - extern int x_input_blocked; - if (x_input_blocked == 0) -#endif - if (!waiting_for_input) - read_avail_input (0); + if (interrupt_input_blocked == 0 + && !waiting_for_input) + read_avail_input (0); signal (SIGALRM, input_poll_signal); alarm (polling_period); } @@ -1071,8 +1245,9 @@ static Lisp_Object kbd_buffer_get_event (); PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence. - If we use a mouse menu to read the input, we store 1 into *USED_MOUSE_MENU. - Otherwise we store 0 there. */ + If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1 + if we used a mouse menu to read the input, or zero otherwise. If + USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. */ Lisp_Object read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) @@ -1086,10 +1261,21 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) int count; jmp_buf save_jump; - if (!NILP (unread_command_char)) + if (CONSP (unread_command_events)) + { + c = XCONS (unread_command_events)->car; + unread_command_events = XCONS (unread_command_events)->cdr; + + if (this_command_key_count == 0) + goto reread_first; + else + goto reread; + } + + if (unread_command_char != -1) { - c = unread_command_char; - unread_command_char = Qnil; + XSET (c, Lisp_Int, unread_command_char); + unread_command_char = -1; if (this_command_key_count == 0) goto reread_first; @@ -1099,29 +1285,50 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (!NILP (Vexecuting_macro)) { +#ifdef MULTI_FRAME /* We set this to Qmacro; since that's not a frame, nobody will try to switch frames on us, and the selected window will remain unchanged. Since this event came from a macro, it would be misleading to - leave Vlast_event_frame set to whereever the last real event - came from. Normally, command_loop_1 selects - Vlast_event_frame after each command is read, but events read - from a macro should never cause a new frame to be selected. */ - Vlast_event_frame = Qmacro; + leave internal_last_event_frame set to whereever the last + real event came from. Normally, a switch-frame event selects + internal_last_event_frame after each command is read, but + events read from a macro should never cause a new frame to be + selected. */ + Vlast_event_frame = internal_last_event_frame = Qmacro; +#endif - if (executing_macro_index >= Flength (Vexecuting_macro)) + /* Exit the macro if we are at the end. + Also, some things replace the macro with t + to force an early exit. */ + if (EQ (Vexecuting_macro, Qt) + || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro))) { XSET (c, Lisp_Int, -1); return c; } c = Faref (Vexecuting_macro, make_number (executing_macro_index)); + if (XTYPE (Vexecuting_macro) == Lisp_String + && (XINT (c) & 0x80)) + XFASTINT (c) = CHAR_META | (XINT (c) & ~0x80); + executing_macro_index++; goto from_macro; } + if (!NILP (unread_switch_frame)) + { + c = unread_switch_frame; + unread_switch_frame = Qnil; + + /* This event should make it into this_command_keys, and get echoed + again, so we go to reread_first, rather than reread. */ + goto reread_first; + } + /* Save outer setjmp data, in case called recursively. */ save_getcjmp (save_jump); @@ -1134,8 +1341,13 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) { XSET (c, Lisp_Int, quit_char); #ifdef MULTI_FRAME - XSET (Vlast_event_frame, Lisp_Frame, selected_frame); + XSET (internal_last_event_frame, Lisp_Frame, selected_frame); + Vlast_event_frame = internal_last_event_frame; #endif + /* If we report the quit char as an event, + don't do so more than once. */ + if (!NILP (Vinhibit_quit)) + Vquit_flag = Qnil; goto non_reread; } @@ -1158,7 +1370,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ - if (XTYPE (prev_event) == Lisp_Cons) + if (EVENT_HAS_PARAMETERS (prev_event)) echo (); else { @@ -1242,6 +1454,39 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (noninteractive && XTYPE (c) == Lisp_Int && XINT (c) < 0) Fkill_emacs (make_number (1)); + if (XTYPE (c) == Lisp_Int) + { + /* Add in any extra modifiers, where appropriate. */ + if ((extra_keyboard_modifiers & CHAR_CTL) + || ((extra_keyboard_modifiers & 0177) < ' ' + && (extra_keyboard_modifiers & 0177) != 0)) + { + /* If it's already a control character, don't mess with it. */ + if ((c & 0177) == 0) + ; + + /* Making ? a control character should result in DEL. */ + else if ((c & 0177) == '?') + c |= 0177; + + /* ASCII control chars are made from letters (both cases), + as well as the non-letters within 0100...0137. */ + else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) + c = (c & (037 | ~0177)); + else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) + c = (c & (037 | ~0177)); + + /* Anything else must get its high control bit set. */ + else + c = c | ctrl_modifier; + } + + /* Transfer any other modifier bits directly from + extra_keyboard_modifiers to c. Ignore the actual character code + in the low 16 bits of extra_keyboard_modifiers. */ + c |= (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL); + } + non_reread: restore_getcjmp (save_jump); @@ -1254,15 +1499,12 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (XTYPE (c) == Lisp_Int) { /* If kbd_buffer_get_event gave us an EOF, return that. */ - if (XINT (c) < 0) + if (XINT (c) == -1) return c; - /* Strip the high bits, and maybe the meta bit too. */ - XSETINT (c, c & (meta_key ? 0377 : 0177)); - if (XTYPE (Vkeyboard_translate_table) == Lisp_String - && XSTRING (Vkeyboard_translate_table)->size > XINT (c)) - XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[c]); + && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c)) + XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]); } total_keys++; @@ -1276,7 +1518,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (dribble) { if (XTYPE (c) == Lisp_Int) - putc (c, dribble); + putc (XINT (c), dribble); else { Lisp_Object dribblee = c; @@ -1284,11 +1526,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* If it's a structured event, take the event header. */ dribblee = EVENT_HEAD (dribblee); - if (XTYPE (c) == Lisp_Symbol) + if (XTYPE (dribblee) == Lisp_Symbol) { putc ('<', dribble); - fwrite (XSYMBOL (c)->name->data, sizeof (char), - XSYMBOL (c)->name->size, + fwrite (XSYMBOL (dribblee)->name->data, sizeof (char), + XSYMBOL (dribblee)->name->size, dribble); putc ('>', dribble); } @@ -1303,10 +1545,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) from_macro: reread_first: - echo_char (c); - /* Record this character as part of the current key. */ - add_command_key (c); + /* Record this character as part of the current key. + Don't record mouse motion; it should never matter. */ + if (! (EVENT_HAS_PARAMETERS (c) + && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) + { + echo_char (c); + add_command_key (c); + } /* Re-reading in the middle of a command */ reread: @@ -1327,7 +1574,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); cancel_echoing (); - c = read_char (0); + c = read_char (0, 0, 0, Qnil, 0); /* Remove the help from the frame */ unbind_to (count, Qnil); redisplay (); @@ -1411,10 +1658,10 @@ tracking_off (old_value) } DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, - "Evaluate BODY with mouse movement and button release events enabled.\n\ -Within a `track-mouse', mouse motion and button releases generate input\n\ -events that you can read with `read-event'.\n\ -Normally, these occurrences don't generate events.") + "Evaluate BODY with mouse movement events enabled.\n\ +Within a `track-mouse' form, mouse motion generates input events that\n\ +you can read with `read-event'.\n\ +Normally, mouse motion is ignored.") (args) Lisp_Object args; { @@ -1443,17 +1690,25 @@ kbd_buffer_store_event (event) { register int c = XFASTINT (event->code) & 0377; - if (c == quit_char - || ((c == (0200 | quit_char)) && !meta_key)) + if (c == quit_char) { extern SIGTYPE interrupt_signal (); #ifdef MULTI_FRAME /* If this results in a quit_char being returned to Emacs as - input, set last-event-frame properly. If this doesn't + input, set Vlast_event_frame properly. If this doesn't get returned to Emacs as an event, the next event read will set Vlast_event_frame again, so this is safe to do. */ - Vlast_event_frame = FRAME_FOCUS_FRAME (event->frame); + { + Lisp_Object focus = + FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window)); + + if (NILP (focus)) + internal_last_event_frame = event->frame_or_window; + else + internal_last_event_frame = focus; + Vlast_event_frame = internal_last_event_frame; + } #endif last_event_timestamp = event->timestamp; @@ -1482,11 +1737,14 @@ kbd_buffer_store_event (event) kbd_store_ptr->kind = event->kind; kbd_store_ptr->code = event->code; kbd_store_ptr->part = event->part; - kbd_store_ptr->frame = event->frame; + kbd_store_ptr->frame_or_window = event->frame_or_window; kbd_store_ptr->modifiers = event->modifiers; kbd_store_ptr->x = event->x; kbd_store_ptr->y = event->y; kbd_store_ptr->timestamp = event->timestamp; + (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr + - kbd_buffer] + = event->frame_or_window); kbd_store_ptr++; } @@ -1495,6 +1753,7 @@ kbd_buffer_store_event (event) static Lisp_Object make_lispy_event (); static Lisp_Object make_lispy_movement (); static Lisp_Object modify_event_symbol (); +static Lisp_Object make_lispy_switch_frame (); static Lisp_Object kbd_buffer_get_event () @@ -1509,6 +1768,7 @@ kbd_buffer_get_event () return obj; } + retry: /* Wait until there is input available. */ for (;;) { @@ -1550,44 +1810,134 @@ kbd_buffer_get_event () mouse movement enabled and available. */ if (kbd_fetch_ptr != kbd_store_ptr) { - if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr = kbd_buffer; + struct input_event *event; + + event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) + ? kbd_fetch_ptr + : kbd_buffer); + + last_event_timestamp = event->timestamp; + + obj = Qnil; + + /* These two kinds of events get special handling + and don't actually appear to the command loop. */ + if (event->kind == selection_request_event) + { +#ifdef HAVE_X11 + x_handle_selection_request (event); + kbd_fetch_ptr = event + 1; + goto retry; +#else + /* We're getting selection request events, but we don't have + a window system. */ + abort (); +#endif + } + + if (event->kind == selection_clear_event) + { +#ifdef HAVE_X11 + x_handle_selection_clear (event); + kbd_fetch_ptr = event + 1; + goto retry; +#else + /* We're getting selection request events, but we don't have + a window system. */ + abort (); +#endif + } #ifdef MULTI_FRAME - XSET (Vlast_event_frame, Lisp_Frame, - XFRAME (FRAME_FOCUS_FRAME (kbd_fetch_ptr->frame))); + /* 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 = event->frame_or_window; + Lisp_Object focus; + + if (XTYPE (frame) == Lisp_Window) + frame = WINDOW_FRAME (XWINDOW (frame)); + + focus = FRAME_FOCUS_FRAME (XFRAME (frame)); + if (! NILP (focus)) + frame = focus; + + if (! EQ (frame, internal_last_event_frame) + && XFRAME (frame) != selected_frame) + obj = make_lispy_switch_frame (frame); + internal_last_event_frame = frame; + } #endif - last_event_timestamp = kbd_fetch_ptr->timestamp; - obj = make_lispy_event (kbd_fetch_ptr); - kbd_fetch_ptr->kind = no_event; - kbd_fetch_ptr++; - if (XTYPE (obj) == Lisp_Int) - XSET (obj, Lisp_Int, XINT (obj) & (meta_key ? 0377 : 0177)); + /* If we didn't decide to make a switch-frame event, go ahead + and build a real event from the queue entry. */ + if (NILP (obj)) + { + obj = make_lispy_event (event); + + /* Wipe out this event, to catch bugs. */ + event->kind = no_event; + (XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] + = Qnil); + + kbd_fetch_ptr = event + 1; + } } else if (do_mouse_tracking && mouse_moved) { - FRAME_PTR frame; + FRAME_PTR f; + Lisp_Object bar_window; + enum scroll_bar_part part; Lisp_Object x, y; unsigned long time; - (*mouse_position_hook) (&frame, &x, &y, &time); + (*mouse_position_hook) (&f, &bar_window, &part, &x, &y, &time); + + obj = Qnil; + #ifdef MULTI_FRAME - XSET (Vlast_event_frame, Lisp_Frame, frame); + /* Decide if we should generate a switch-frame event. Don't + generate switch-frame events for motion outside of all Emacs + frames. */ + if (f) + { + Lisp_Object frame = FRAME_FOCUS_FRAME (f); + + if (NILP (frame)) + XSET (frame, Lisp_Frame, f); + + if (! EQ (frame, internal_last_event_frame) + && XFRAME (frame) != selected_frame) + obj = make_lispy_switch_frame (internal_last_event_frame); + internal_last_event_frame = frame; + } #endif - obj = make_lispy_movement (frame, x, y, time); - } + /* If we didn't decide to make a switch-frame event, go ahead and + return a mouse-motion event. */ + if (NILP (obj)) + obj = make_lispy_movement (f, bar_window, part, x, y, time); + } else /* We were promised by the above while loop that there was something for us to read! */ abort (); + /* If something gave back nil as the Lispy event, + it means the event was discarded, so try again. */ + if (NILP (obj)) + goto retry; + input_pending = readable_events (); +#ifdef MULTI_FRAME + Vlast_event_frame = internal_last_event_frame; +#endif + return (obj); } + /* Caches for modify_event_symbol. */ static Lisp_Object func_key_syms; static Lisp_Object mouse_syms; @@ -1598,6 +1948,23 @@ static char *lispy_function_keys[] = { /* X Keysym value */ + 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */ + "backspace", + "tab", + "linefeed", + "clear", + 0, + "return", + 0, 0, + 0, 0, 0, /* 0xff10 */ + "pause", + 0, 0, 0, 0, 0, 0, 0, + "escape", + 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */ + "home", /* 0xff50 */ /* IsCursorKey */ "left", "up", @@ -1661,11 +2028,15 @@ static char *lispy_function_keys[] = 0, 0, "kp-equal", /* 0xffbd */ "f1", /* 0xffbe */ /* IsFunctionKey */ - "f2", "f3", "f4", - "f5", "f6", "f7", "f8", "f9", "f10", "f11", "f12", - "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20", - "f21", "f22", "f23", "f24", "f25", "f26", "f27", "f28", - "f29", "f30", "f31", "f32", "f33", "f34", "f35" /* 0xffe0 */ + "f2", + "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */ + "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18", + "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */ + "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34", + "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */ + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */ + 0, 0, 0, 0, 0, 0, 0, "delete" }; static char *lispy_mouse_names[] = @@ -1673,15 +2044,27 @@ static char *lispy_mouse_names[] = "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5" }; -/* make_lispy_event stores the down-going location of the currently - depressed buttons in button_down_locations. */ -struct mouse_position { - Lisp_Object window; - Lisp_Object buffer_pos; - Lisp_Object x, y; - Lisp_Object timestamp; +/* Scroll bar parts. */ +Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; + +/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */ +Lisp_Object *scroll_bar_parts[] = { + &Qabove_handle, &Qhandle, &Qbelow_handle }; -static struct mouse_position button_down_location[NUM_MOUSE_BUTTONS]; + + +/* A vector, indexed by button number, giving the down-going location + of currently depressed buttons, both scroll bar and non-scroll bar. + + The elements have the form + (BUTTON-NUMBER MODIFIER-MASK . REST) + where REST is the cdr of a position as it would be reported in the event. + + The make_lispy_event function stores positions here to tell the + difference between click and drag events, and to store the starting + location to be included in drag events. */ + +static Lisp_Object button_down_location; /* Given a struct input_event, build the lisp event which represents it. If EVENT is 0, build a mouse movement event from the mouse @@ -1703,8 +2086,21 @@ make_lispy_event (event) { /* A simple keystroke. */ case ascii_keystroke: - return event->code; - break; + { + int c = XFASTINT (event->code); + /* Include the bits for control and shift + only if the basic ASCII code can't indicate them. */ + if ((event->modifiers & ctrl_modifier) + && c >= 040) + c |= ctrl_modifier; + if (XFASTINT (event->code) < 040 + && (event->modifiers & shift_modifier)) + c |= shift_modifier; + c |= (event->modifiers + & (meta_modifier | alt_modifier + | hyper_modifier | super_modifier)); + return c; + } /* A function key. The symbol may need to have modifier prefixes tacked onto it. */ @@ -1719,273 +2115,295 @@ make_lispy_event (event) /* A mouse click. Figure out where it is, decide whether it's a press, click or drag, and build the appropriate structure. */ case mouse_click: + case scroll_bar_click: { - int part; - Lisp_Object window; - Lisp_Object posn; - struct mouse_position *loc; + int button = XFASTINT (event->code); + Lisp_Object position; + Lisp_Object *start_pos_ptr; + Lisp_Object start_pos; - if (event->code < 0 || event->code >= NUM_MOUSE_BUTTONS) + if (button < 0 || button >= NUM_MOUSE_BUTTONS) abort (); - /* Where did this mouse click occur? */ - window = window_from_coordinates (event->frame, - XINT (event->x), XINT (event->y), - &part); - if (XTYPE (window) != Lisp_Window) - posn = Qnil; - else + /* Build the position as appropriate for this mouse click. */ + if (event->kind == mouse_click) { - XSETINT (event->x, (XINT (event->x) - - XINT (XWINDOW (window)->left))); - XSETINT (event->y, (XINT (event->y) - - XINT (XWINDOW (window)->top))); - if (part == 1) - posn = Qmode_line; - else if (part == 2) - posn = Qvertical_line; + int part; + FRAME_PTR f = XFRAME (event->frame_or_window); + Lisp_Object window + = window_from_coordinates (f, XINT (event->x), XINT (event->y), + &part); + Lisp_Object posn; + + if (XINT (event->y) < FRAME_MENU_BAR_LINES (f)) + { + int hpos; + Lisp_Object items; + items = FRAME_MENU_BAR_ITEMS (f); + for (; CONSP (items); items = XCONS (items)->cdr) + { + Lisp_Object pos, string; + pos = Fcdr (Fcdr (Fcar (items))); + string = Fcar (Fcdr (Fcar (items))); + if (XINT (event->x) > XINT (pos) + && XINT (event->x) <= XINT (pos) + XSTRING (string)->size) + break; + } + position + = Fcons (event->frame_or_window, + Fcons (Qmenu_bar, + Fcons (Fcons (event->x, event->y), + Fcons (make_number (event->timestamp), + Qnil)))); + + if (CONSP (items)) + return Fcons (Fcar (Fcar (items)), + Fcons (position, Qnil)); + else + return Fcons (Qnil, Fcons (position, Qnil)); + } + else if (XTYPE (window) != Lisp_Window) + posn = Qnil; else - XSET (posn, Lisp_Int, - buffer_posn_from_coords (XWINDOW (window), - XINT (event->x), - XINT (event->y))); + { + XSETINT (event->x, + (XINT (event->x) - XINT (XWINDOW (window)->left))); + XSETINT (event->y, + (XINT (event->y) - XINT (XWINDOW (window)->top))); + + if (part == 1) + posn = Qmode_line; + else if (part == 2) + posn = Qvertical_line; + else + XSET (posn, Lisp_Int, + buffer_posn_from_coords (XWINDOW (window), + XINT (event->x), + XINT (event->y))); + } + + position + = Fcons (window, + Fcons (posn, + Fcons (Fcons (event->x, event->y), + Fcons (make_number (event->timestamp), + Qnil)))); } - - /* If this is a button press, squirrel away the location, so we - can decide later whether it was a click or a drag. */ - loc = button_down_location + event->code; - if (event->modifiers & down_modifier) + else { - loc->window = window; - loc->buffer_pos = posn; - loc->x = event->x; - loc->y = event->y; - loc->timestamp = event->timestamp; + Lisp_Object window = event->frame_or_window; + Lisp_Object portion_whole = Fcons (event->x, event->y); + Lisp_Object part = *scroll_bar_parts[(int) event->part]; + + position = + Fcons (window, + Fcons (Qvertical_scroll_bar, + Fcons (portion_whole, + Fcons (make_number (event->timestamp), + Fcons (part, + Qnil))))); } + start_pos_ptr = &XVECTOR (button_down_location)->contents[button]; + + start_pos = *start_pos_ptr; + *start_pos_ptr = Qnil; + + /* If this is a button press, squirrel away the location, so + we can decide later whether it was a click or a drag. */ + if (event->modifiers & down_modifier) + *start_pos_ptr = Fcopy_alist (position); + /* Now we're releasing a button - check the co-ordinates to - see if this was a click or a drag. */ + see if this was a click or a drag. */ else if (event->modifiers & up_modifier) { + /* If we did not see a down before this up, + ignore the up. Probably this happened because + the down event chose a menu item. + It would be an annoyance to treat the release + of the button that chose the menu item + as a separate event. */ + + if (XTYPE (start_pos) != Lisp_Cons) + return Qnil; + event->modifiers &= ~up_modifier; - event->modifiers |= ((event->x == loc->x && event->y == loc->y) - ? click_modifier - : drag_modifier); +#if 0 /* Formerly we treated an up with no down as a click event. */ + if (XTYPE (start_pos) != Lisp_Cons) + event->modifiers |= click_modifier; + else +#endif + { + /* The third element of every position should be the (x,y) + pair. */ + Lisp_Object down = Fnth (make_number (2), start_pos); + + event->modifiers |= ((EQ (event->x, XCONS (down)->car) + && EQ (event->y, XCONS (down)->cdr)) + ? click_modifier + : drag_modifier); + } } else /* Every mouse event should either have the down_modifier or - the up_modifier set. */ + the up_modifier set. */ abort (); - - /* Build the event. */ { - Lisp_Object head, start, end; - - /* Build the components of the event. */ - head = modify_event_symbol (XFASTINT (event->code) - 1, - event->modifiers, - Qmouse_click, - lispy_mouse_names, &mouse_syms, - (sizeof (lispy_mouse_names) - / sizeof (lispy_mouse_names[0]))); - end = Fcons (window, - Fcons (posn, - Fcons (Fcons (event->x, event->y), - Fcons (make_number (event->timestamp), - Qnil)))); - if (event->modifiers & drag_modifier) - start = Fcons (loc->window, - Fcons (loc->buffer_pos, - Fcons (Fcons (loc->x, loc->y), - Fcons (make_number (loc->timestamp), - Qnil)))); - - /* Assemble the pieces. */ + /* Get the symbol we should use for the mouse click. */ + Lisp_Object head + = modify_event_symbol (button, + event->modifiers, + Qmouse_click, + lispy_mouse_names, &mouse_syms, + (sizeof (lispy_mouse_names) + / sizeof (lispy_mouse_names[0]))); + if (event->modifiers & drag_modifier) return Fcons (head, - Fcons (start, - Fcons (end, + Fcons (start_pos, + Fcons (position, Qnil))); else return Fcons (head, - Fcons (end, + Fcons (position, Qnil)); } } - /* A scrollbar click. Build a list containing the relevant - information. */ - case scrollbar_click: - { - Lisp_Object button - = modify_event_symbol (XFASTINT (event->code) - 1, - event->modifiers, - Qmouse_click, - lispy_mouse_names, &mouse_syms, - (sizeof (lispy_mouse_names) - / sizeof (lispy_mouse_names[0]))); - return Fcons (event->part, - Fcons (FRAME_SELECTED_WINDOW (event->frame), - Fcons (button, - Fcons (Fcons (event->x, event->y), - Fcons (make_number - (event->timestamp), - Qnil))))); - } - /* The 'kind' field of the event is something we don't recognize. */ default: - abort(); + abort (); } } static Lisp_Object -make_lispy_movement (frame, x, y, time) +make_lispy_movement (frame, bar_window, part, x, y, time) FRAME_PTR frame; + Lisp_Object bar_window; + enum scroll_bar_part part; Lisp_Object x, y; unsigned long time; { - Lisp_Object window; - int ix, iy; - Lisp_Object posn; - int part; - - ix = XINT (x); - iy = XINT (y); - window = (frame - ? window_from_coordinates (frame, ix, iy, &part) - : Qnil); - if (XTYPE (window) != Lisp_Window) - posn = Qnil; - else + /* Is it a scroll bar movement? */ + if (frame && ! NILP (bar_window)) { - ix -= XINT (XWINDOW (window)->left); - iy -= XINT (XWINDOW (window)->top); - if (part == 1) - posn = Qmode_line; - else if (part == 2) - posn = Qvertical_line; - else - XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window), - ix, iy)); + Lisp_Object part_sym = *scroll_bar_parts[(int) part]; + + return Fcons (Qscroll_bar_movement, + (Fcons (Fcons (bar_window, + Fcons (Qvertical_scroll_bar, + Fcons (Fcons (x, y), + Fcons (make_number (time), + Fcons (part_sym, + Qnil))))), + Qnil))); } - XSETINT (x, ix); - XSETINT (y, iy); - return Fcons (Qmouse_movement, - Fcons (Fcons (window, - Fcons (posn, - Fcons (Fcons (x, y), - Fcons (make_number (time), - Qnil)))), - Qnil)); -} - + /* Or is it an ordinary mouse movement? */ + else + { + int area; + Lisp_Object window = + (frame + ? window_from_coordinates (frame, XINT (x), XINT (y), &area) + : Qnil); + Lisp_Object posn; + + if (XTYPE (window) == Lisp_Window) + { + XSETINT (x, XINT (x) - XINT (XWINDOW (window)->left)); + XSETINT (y, XINT (y) - XINT (XWINDOW (window)->top)); + if (area == 1) + posn = Qmode_line; + else if (area == 2) + posn = Qvertical_line; + else + XSET (posn, Lisp_Int, + buffer_posn_from_coords (XWINDOW (window), + XINT (x), XINT (y))); + } + else + { + window = Qnil; + posn = Qnil; + } -/* Place the written representation of MODIFIERS in BUF, '\0'-terminated, - and return its length. */ + return Fcons (Qmouse_movement, + Fcons (Fcons (window, + Fcons (posn, + Fcons (Fcons (x, y), + Fcons (make_number (time), + Qnil)))), + Qnil)); + } +} -static int -format_modifiers (modifiers, buf) - int modifiers; - char *buf; +/* Construct a switch frame event. */ +static Lisp_Object +make_lispy_switch_frame (frame) + Lisp_Object frame; { - char *p = buf; - - /* Only the event queue may use the `up' modifier; it should always - be turned into a click or drag event before presented to lisp code. */ - if (modifiers & up_modifier) - abort (); - - if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; } - if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } - if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; } - if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } - if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } - if (modifiers & super_modifier) { strcpy (p, "super-"); p += 6; } - if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; } - if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; } - /* The click modifier is denoted by the absence of other modifiers. */ - *p = '\0'; - - return p - buf; + return Fcons (Qswitch_frame, Fcons (frame, Qnil)); } + +/* Manipulating modifiers. */ +/* Parse the name of SYMBOL, and return the set of modifiers it contains. -/* Given a symbol whose name begins with modifiers ("C-", "M-", etc), - return a symbol with the modifiers placed in the canonical order. - Canonical order is alphabetical, except for down and drag, which - always come last. The 'click' modifier is never written out. - - Fdefine_key calls this to make sure that (for example) C-M-foo - and M-C-foo end up being equivalent in the keymap. */ + If MODIFIER_END is non-zero, set *MODIFIER_END to the position in + SYMBOL's name of the end of the modifiers; the string from this + position is the unmodified symbol name. -Lisp_Object -reorder_modifiers (symbol) + This doesn't use any caches. */ +static int +parse_modifiers_uncached (symbol, modifier_end) Lisp_Object symbol; + int *modifier_end; { struct Lisp_String *name; int i; int modifiers; - int not_canonical; CHECK_SYMBOL (symbol, 1); modifiers = 0; name = XSYMBOL (symbol)->name; - /* Special case for things with only one modifier, which is - (hopefully) the vast majority of cases. */ - if (! (name->size >= 4 && name->data[1] == '-' && name->data[3] == '-')) - return symbol; - for (i = 0; i+1 < name->data[i]; ) + for (i = 0; i+2 <= name->size; ) switch (name->data[i]) { - case 'A': - if (name->data[i] != '-') goto no_more_modifiers; - not_canonical |= (modifiers & ~(alt_modifier - 1)); - modifiers |= alt_modifier; +#define SINGLE_LETTER_MOD(bit) \ + if (name->data[i+1] != '-') \ + goto no_more_modifiers; \ + modifiers |= bit; \ i += 2; + + case 'A': + SINGLE_LETTER_MOD (alt_modifier); break; case 'C': - if (name->data[i] != '-') goto no_more_modifiers; - not_canonical |= (modifiers & ~(ctrl_modifier - 1)); - modifiers |= ctrl_modifier; - i += 2; + SINGLE_LETTER_MOD (ctrl_modifier); break; case 'H': - if (name->data[i] != '-') goto no_more_modifiers; - not_canonical |= (modifiers & ~(hyper_modifier - 1)); - modifiers |= hyper_modifier; - i += 2; + SINGLE_LETTER_MOD (hyper_modifier); break; case 'M': - if (name->data[i] != '-') goto no_more_modifiers; - not_canonical |= (modifiers & ~(meta_modifier - 1)); - modifiers |= meta_modifier; - i += 2; + SINGLE_LETTER_MOD (meta_modifier); break; case 'S': - if (name->data[i] != '-') goto no_more_modifiers; - not_canonical |= (modifiers & ~(shift_modifier - 1)); - modifiers |= shift_modifier; - i += 2; + SINGLE_LETTER_MOD (shift_modifier); break; case 's': - if (i + 6 > name->size - || strncmp (name->data + i, "super-", 6)) - goto no_more_modifiers; - not_canonical |= (modifiers & ~(super_modifier - 1)); - modifiers |= super_modifier; - i += 6; + SINGLE_LETTER_MOD (super_modifier); break; case 'd': @@ -1993,13 +2411,11 @@ reorder_modifiers (symbol) goto no_more_modifiers; if (! strncmp (name->data + i, "drag-", 5)) { - not_canonical |= (modifiers & ~(drag_modifier - 1)); modifiers |= drag_modifier; i += 5; } else if (! strncmp (name->data + i, "down-", 5)) { - not_canonical |= (modifiers & ~(down_modifier - 1)); modifiers |= down_modifier; i += 5; } @@ -2009,47 +2425,250 @@ reorder_modifiers (symbol) default: goto no_more_modifiers; + +#undef SINGLE_LETTER_MOD } no_more_modifiers: - if (!not_canonical) - return symbol; + /* Should we include the `click' modifier? */ + if (! (modifiers & (down_modifier | drag_modifier)) + && i + 7 == name->size + && strncmp (name->data + i, "mouse-", 6) == 0 + && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9')) + modifiers |= click_modifier; + + if (modifier_end) + *modifier_end = i; + + return modifiers; +} + + +/* Return a symbol whose name is the modifier prefixes for MODIFIERS + prepended to the string BASE[0..BASE_LEN-1]. + This doesn't use any caches. */ +static Lisp_Object +apply_modifiers_uncached (modifiers, base, base_len) + int modifiers; + char *base; + int base_len; +{ + /* Since BASE could contain nulls, we can't use intern here; we have + to use Fintern, which expects a genuine Lisp_String, and keeps a + reference to it. */ + char *new_mods = + (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-")); + int mod_len; - /* The modifiers were out of order, so find a new symbol with the - mods in order. Since the symbol name could contain nulls, we can't - use intern here; we have to use Fintern, which expects a genuine - Lisp_String, and keeps a reference to it. */ { - char *new_mods = (char *) alloca (sizeof ("A-C-H-M-S-super-U-down-drag-")); - int len = format_modifiers (modifiers, new_mods); - Lisp_Object new_name = make_uninit_string (len + name->size - i); + char *p = new_mods; + + /* Only the event queue may use the `up' modifier; it should always + be turned into a click or drag event before presented to lisp code. */ + if (modifiers & up_modifier) + abort (); + + if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; } + if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } + if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; } + if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } + if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } + if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; } + if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; } + if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; } + /* The click modifier is denoted by the absence of other modifiers. */ + + *p = '\0'; + + mod_len = p - new_mods; + } - bcopy (new_mods, XSTRING (new_name)->data, len); - bcopy (name->data + i, XSTRING (new_name)->data + len, name->size - i); + { + Lisp_Object new_name = make_uninit_string (mod_len + base_len); + + bcopy (new_mods, XSTRING (new_name)->data, mod_len); + bcopy (base, XSTRING (new_name)->data + mod_len, base_len); return Fintern (new_name, Qnil); } } -/* For handling events, we often want to produce a symbol whose name - is a series of modifier key prefixes ("M-", "C-", etcetera) attached - to some base, like the name of a function key or mouse button. - modify_event_symbol produces symbols of this sort. +static char *modifier_names[] = +{ + "up", 0, 0, 0, 0, 0, 0, "down", + "drag", "click", 0, 0, 0, 0, 0, 0, + 0, 0, "alt", "super", "hyper", "shift", "control", "meta" +}; +#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0])) - NAME_TABLE should point to an array of strings, such that NAME_TABLE[i] - is the name of the i'th symbol. TABLE_SIZE is the number of elements - in the table. +static Lisp_Object modifier_symbols; - SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will - persist between calls to modify_event_symbol that it can use to - store a cache of the symbols it's generated for this NAME_TABLE - before. +/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */ +static Lisp_Object +lispy_modifier_list (modifiers) + int modifiers; +{ + Lisp_Object modifier_list; + int i; - SYMBOL_NUM is the number of the base name we want from NAME_TABLE. - - MODIFIERS is a set of modifier bits (as given in struct input_events) - whose prefixes should be applied to the symbol name. + modifier_list = Qnil; + for (i = 0; (1<contents[i], + modifier_list); + + return modifier_list; +} + + +/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK), + where UNMODIFIED is the unmodified form of SYMBOL, + MASK is the set of modifiers present in SYMBOL's name. + This is similar to parse_modifiers_uncached, but uses the cache in + SYMBOL's Qevent_symbol_element_mask property, and maintains the + Qevent_symbol_elements property. */ +static Lisp_Object +parse_modifiers (symbol) + Lisp_Object symbol; +{ + Lisp_Object elements = Fget (symbol, Qevent_symbol_element_mask); + + if (CONSP (elements)) + return elements; + else + { + int end; + int modifiers = parse_modifiers_uncached (symbol, &end); + Lisp_Object unmodified + = Fintern (make_string (XSYMBOL (symbol)->name->data + end, + XSYMBOL (symbol)->name->size - end), + Qnil); + Lisp_Object mask; + + if (modifiers & ~((1<cdr; + else + { + /* We have to create the symbol ourselves. */ + new_symbol = apply_modifiers_uncached (modifiers, + XSYMBOL (base)->name->data, + XSYMBOL (base)->name->size); + + /* Add the new symbol to the base's cache. */ + entry = Fcons (index, new_symbol); + Fput (base, Qmodifier_cache, Fcons (entry, cache)); + + /* We have the parsing info now for free, so add it to the caches. */ + XFASTINT (index) = modifiers; + Fput (new_symbol, Qevent_symbol_element_mask, + Fcons (base, Fcons (index, Qnil))); + Fput (new_symbol, Qevent_symbol_elements, + Fcons (base, lispy_modifier_list (modifiers))); + } + + /* Make sure this symbol is of the same kind as BASE. + + You'd think we could just set this once and for all when we + intern the symbol above, but reorder_modifiers may call us when + BASE's property isn't set right; we can't assume that just + because it has a Qmodifier_cache property it must have its + Qevent_kind set right as well. */ + if (NILP (Fget (new_symbol, Qevent_kind))) + { + Lisp_Object kind = Fget (base, Qevent_kind); + + if (! NILP (kind)) + Fput (new_symbol, Qevent_kind, kind); + } + + return new_symbol; +} + + +/* Given a symbol whose name begins with modifiers ("C-", "M-", etc), + return a symbol with the modifiers placed in the canonical order. + Canonical order is alphabetical, except for down and drag, which + always come last. The 'click' modifier is never written out. + + Fdefine_key calls this to make sure that (for example) C-M-foo + and M-C-foo end up being equivalent in the keymap. */ + +Lisp_Object +reorder_modifiers (symbol) + Lisp_Object symbol; +{ + /* It's hopefully okay to write the code this way, since everything + will soon be in caches, and no consing will be done at all. */ + Lisp_Object parsed = parse_modifiers (symbol); + + return apply_modifiers (XCONS (XCONS (parsed)->cdr)->car, + XCONS (parsed)->car); +} + + +/* For handling events, we often want to produce a symbol whose name + is a series of modifier key prefixes ("M-", "C-", etcetera) attached + to some base, like the name of a function key or mouse button. + modify_event_symbol produces symbols of this sort. + + NAME_TABLE should point to an array of strings, such that NAME_TABLE[i] + is the name of the i'th symbol. TABLE_SIZE is the number of elements + in the table. + + SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will + persist between calls to modify_event_symbol that it can use to + store a cache of the symbols it's generated for this NAME_TABLE + before. + + SYMBOL_NUM is the number of the base name we want from NAME_TABLE. + + MODIFIERS is a set of modifier bits (as given in struct input_events) + whose prefixes should be applied to the symbol name. SYMBOL_KIND is the value to be placed in the event_kind property of the returned symbol. @@ -2058,14 +2677,6 @@ reorder_modifiers (symbol) `event-symbol-elements' propery, which lists the modifiers present in the symbol's name. */ -static char *modifier_names[] = -{ - "up", "alt", "ctrl", "hyper", "meta", "shift", "super", "down", "drag", - "click" -}; - -static Lisp_Object modifier_symbols; - static Lisp_Object modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, symbol_table, table_size) @@ -2077,104 +2688,43 @@ modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, int table_size; { Lisp_Object *slot; - Lisp_Object unmodified; - Lisp_Object temp; /* Is this a request for a valid symbol? */ if (symbol_num < 0 || symbol_num >= table_size) abort (); - /* If *symbol_table doesn't seem to be initialized property, fix that. - + /* If *symbol_table doesn't seem to be initialized properly, fix that. *symbol_table should be a lisp vector TABLE_SIZE elements long, - where the Nth element is an alist for modified versions of - name_table[N]; the alist maps modifier masks onto the modified - symbols. The click modifier is always omitted from the mask; it - is indicated implicitly on a mouse event by the absence of the - down_ and drag_ modifiers. */ + where the Nth element is the symbol for NAME_TABLE[N], or nil if + we've never used that symbol before. */ if (XTYPE (*symbol_table) != Lisp_Vector || XVECTOR (*symbol_table)->size != table_size) { - XFASTINT (temp) = table_size; - *symbol_table = Fmake_vector (temp, Qnil); + Lisp_Object size; + + XFASTINT (size) = table_size; + *symbol_table = Fmake_vector (size, Qnil); } slot = & XVECTOR (*symbol_table)->contents[symbol_num]; - /* Have we already modified this symbol? */ - XFASTINT (temp) = modifiers & ~(click_modifier); - temp = Fassq (temp, *slot); - if (CONSP (temp)) - return (XCONS (temp)->cdr); - - /* We don't have an entry for the symbol; we have to build it. */ - - /* Make sure there's an assoc for the unmodified symbol. - Any non-empty alist should contain an entry for the unmodified symbol. */ - XFASTINT (temp) = 0; - + /* Have we already used this symbol before? */ if (NILP (*slot)) { - unmodified = intern (name_table [symbol_num]); - *slot = Fcons (Fcons (temp, unmodified), Qnil); - Fput (unmodified, Qevent_kind, symbol_kind); - Fput (unmodified, Qevent_symbol_elements, Fcons (unmodified, Qnil)); - } - else - { - temp = Fassq (temp, *slot); - if (NILP (temp)) - abort (); - unmodified = XCONS (temp)->cdr; + /* No; let's create it. */ + *slot = intern (name_table[symbol_num]); + + /* Fill in the cache entries for this symbol; this also + builds the Qevent_symbol_elements property, which the user + cares about. */ + apply_modifiers (modifiers & click_modifier, *slot); + Fput (*slot, Qevent_kind, symbol_kind); } - /* Create a modified version of the symbol, and add it to the alist. */ - { - Lisp_Object modified; - char *modified_name - = (char *) alloca (sizeof ("A-C-H-M-S-super-U-down-drag") - + strlen (name_table [symbol_num])); - - strcpy (modified_name + format_modifiers (modifiers, modified_name), - name_table [symbol_num]); - - modified = intern (modified_name); - XFASTINT (temp) = modifiers & ~click_modifier; - *slot = Fcons (Fcons (temp, modified), *slot); - Fput (modified, Qevent_kind, symbol_kind); - - { - Lisp_Object modifier_list; - int i; - - modifier_list = Qnil; - for (i = 0; (1<contents[i], - modifier_list); - - Fput (modified, Qevent_symbol_elements, - Fcons (unmodified, modifier_list)); - } - - return modified; - } -} - -DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0, - "Return non-nil iff OBJECT is a representation of a mouse event.\n\ -A mouse event is a list of five elements whose car is a symbol of the\n\ -form mouse-. I hope this is a temporary hack.") - (object) - Lisp_Object object; -{ - if (EVENT_HAS_PARAMETERS (object) - && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)), - Qmouse_click)) - return Qt; - else - return Qnil; + /* Apply modifiers to that symbol. */ + return apply_modifiers (modifiers, *slot); } + /* Store into *addr a value nonzero if terminal input chars are available. Serves the purpose of ioctl (0, FIONREAD, addr) @@ -2253,6 +2803,9 @@ read_avail_input (expected) /* Formerly simply reported no input, but that sometimes led to a failure of Emacs to terminate. SIGHUP seems appropriate if we can't reach the terminal. */ + /* ??? Is it really right to send the signal just to this process + rather than to the whole process group? + Perhaps on systems with FIONREAD Emacs is alone in its group. */ kill (getpid (), SIGHUP); if (nread == 0) return 0; @@ -2298,8 +2851,18 @@ read_avail_input (expected) for (i = 0; i < nread; i++) { buf[i].kind = ascii_keystroke; - XSET (buf[i].code, Lisp_Int, cbuf[i]); - buf[i].frame = selected_frame; + buf[i].modifiers = 0; + if (meta_key == 1 && (cbuf[i] & 0x80)) + buf[i].modifiers = meta_modifier; + if (meta_key != 2) + cbuf[i] &= ~0x80; + + XSET (buf[i].code, Lisp_Int, cbuf[i]); +#ifdef MULTI_FRAME + XSET (buf[i].frame_or_window, Lisp_Frame, selected_frame); +#else + buf[i].frame_or_window = Qnil; +#endif } } @@ -2365,6 +2928,22 @@ input_available_signal (signo) errno = old_errno; } #endif /* SIGIO */ + +/* Send ourselves a SIGIO. + + This function exists so that the UNBLOCK_INPUT macro in + blockinput.h can have some way to take care of input we put off + dealing with, without assuming that every file which uses + UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */ +void +reinvoke_input_signal () +{ +#ifdef SIGIO + kill (0, SIGIO); +#endif +} + + /* Return the prompt-string of a sparse keymap. This is the first element which is a string. @@ -2385,17 +2964,159 @@ map_prompt (map) return Qnil; } +static Lisp_Object menu_bar_item (); +static Lisp_Object menu_bar_one_keymap (); + +/* Return a list of menu items for a menu bar, appropriate + to the current buffer. + The elements have the form (KEY STRING . nil). */ + +Lisp_Object +menu_bar_items () +{ + /* The number of keymaps we're scanning right now, and the number of + keymaps we have allocated space for. */ + int nmaps; + + /* maps[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 *maps; + + Lisp_Object def, tem; + + Lisp_Object result; + + int mapno; + + /* Build our list of keymaps. + If we recognize a function key and replace its escape sequence in + keybuf with its symbol, or if the sequence starts with a mouse + click and we need to switch buffers, we jump back here to rebuild + the initial keymaps from the current buffer. */ + { + Lisp_Object *tmaps; + + nmaps = current_minor_maps (0, &tmaps) + 2; + maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0])); + bcopy (tmaps, maps, (nmaps - 2) * sizeof (maps[0])); +#ifdef USE_TEXT_PROPERTIES + maps[nmaps-2] = get_local_map (PT, current_buffer); +#else + maps[nmaps-2] = current_buffer->local_map; +#endif + maps[nmaps-1] = global_map; + } + + /* Look up in each map the dummy prefix key `menu-bar'. */ + + result = Qnil; + + for (mapno = 0; mapno < nmaps; mapno++) + { + if (! NILP (maps[mapno])) + def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1)); + else + def = Qnil; + + tem = Fkeymapp (def); + if (!NILP (tem)) + result = menu_bar_one_keymap (def, result); + } + + return Fnreverse (result); +} + +/* Scan one map KEYMAP, accumulating any menu items it defines + that have not yet been seen in RESULT. Return the updated RESULT. */ + +static Lisp_Object +menu_bar_one_keymap (keymap, result) + Lisp_Object keymap, result; +{ + Lisp_Object tail, item, key, binding, item_string, table; + + /* Loop over all keymap entries that have menu strings. */ + for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) + { + item = XCONS (tail)->car; + if (XTYPE (item) == Lisp_Cons) + { + key = XCONS (item)->car; + binding = XCONS (item)->cdr; + if (XTYPE (binding) == Lisp_Cons) + { + item_string = XCONS (binding)->car; + if (XTYPE (item_string) == Lisp_String) + result = menu_bar_item (key, item_string, + Fcdr (binding), result); + } + } + else if (XTYPE (item) == Lisp_Vector) + { + /* Loop over the char values represented in the vector. */ + int len = XVECTOR (item)->size; + int c; + for (c = 0; c < len; c++) + { + Lisp_Object character; + XFASTINT (character) = c; + binding = XVECTOR (item)->contents[c]; + if (XTYPE (binding) == Lisp_Cons) + { + item_string = XCONS (binding)->car; + if (XTYPE (item_string) == Lisp_String) + result = menu_bar_item (key, item_string, + Fcdr (binding), result); + } + } + } + } + + return result; +} + +static Lisp_Object +menu_bar_item (key, item_string, def, result) + Lisp_Object key, item_string, def, result; +{ + Lisp_Object tem, elt; + Lisp_Object enabled; + + /* See if this entry is enabled. */ + enabled = Qt; + + if (XTYPE (def) == Lisp_Symbol) + { + /* No property, or nil, means enable. + Otherwise, enable if value is not nil. */ + tem = Fget (def, Qmenu_enable); + if (!NILP (tem)) + enabled = Feval (tem); + } + + /* Add an entry for this key and string + if there is none yet. */ + elt = Fassq (key, result); + if (!NILP (enabled) && NILP (elt)) + result = Fcons (Fcons (key, Fcons (item_string, Qnil)), result); + + return result; +} + static int echo_flag; static int echo_now; /* Read a character like read_char but optionally prompt based on maps - in the array MAPS. NMAPS is the length of MAPS. + in the array MAPS. NMAPS is the length of MAPS. Return nil if we + decided not to read a character, because there are no menu items in + MAPS. PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence. - If we use a mouse menu to read the input, we store 1 into *USED_MOUSE_MENU. - Otherwise we store 0 there. + If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1 + if we used a mouse menu to read the input, or zero otherwise. If + USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. The prompting is done based on the prompt-string of the map and the strings associated with various map elements. */ @@ -2415,7 +3136,8 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) int idx = -1; Lisp_Object rest, vector; - *used_mouse_menu = 0; + if (used_mouse_menu) + *used_mouse_menu = 0; /* Use local over global Menu maps */ @@ -2431,14 +3153,14 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) } /* If we don't have any menus, just read a character normally. */ - if (NILP (name)) + if (mapno >= nmaps) return Qnil; -#ifdef HAVE_X_WINDOW -#ifndef NO_X_MENU +#ifdef HAVE_X_WINDOWS +#ifdef HAVE_X_MENU /* If we got to this point via a mouse click, use a real menu for mouse selection. */ - if (XTYPE (prev_event) == Lisp_Cons) + if (EVENT_HAS_PARAMETERS (prev_event)) { /* Display the menu and get the selection. */ Lisp_Object *realmaps @@ -2452,13 +3174,23 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) realmaps[nmaps1++] = maps[mapno]; value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps)); + if (CONSP (value)) + { + /* If we got more than one event, put all but the first + onto this list to be read later. + Return just the first event now. */ + unread_command_events + = nconc2 (XCONS (value)->cdr, unread_command_events); + value = XCONS (value)->car; + } if (NILP (value)) XSET (value, Lisp_Int, quit_char); - *used_mouse_menu = 1; + if (used_mouse_menu) + *used_mouse_menu = 1; return value; } -#endif /* not NO_X_MENU */ -#endif /* HAVE_X_WINDOW */ +#endif /* HAVE_X_MENU */ +#endif /* HAVE_X_WINDOWS */ /* Prompt string always starts with map's prompt, and a space. */ strcpy (menu, XSTRING (name)->data); @@ -2571,9 +3303,9 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) else ch = XINT (obj); - if (obj != menu_prompt_more_char + if (! EQ (obj, menu_prompt_more_char) && (XTYPE (menu_prompt_more_char) != Lisp_Int - || obj != make_number (Ctl (XINT (menu_prompt_more_char))))) + || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) return obj; } } @@ -2609,25 +3341,24 @@ follow_key (key, nmaps, current, defs, next) /* If KEY is a meta ASCII character, treat it like meta-prefix-char followed by the corresponding non-meta character. */ - if (XTYPE (key) == Lisp_Int - && XINT (key) >= 0200) + if (XTYPE (key) == Lisp_Int && (XINT (key) & CHAR_META)) { for (i = 0; i < nmaps; i++) if (! NILP (current[i])) { - next[i] = get_keyelt (access_keymap (current[i], - meta_prefix_char)); + next[i] = + get_keyelt (access_keymap (current[i], meta_prefix_char, 1)); /* Note that since we pass the resulting bindings through get_keymap_1, non-prefix bindings for meta-prefix-char disappear. */ - next[i] = get_keymap_1 (next[i], 0); + next[i] = get_keymap_1 (next[i], 0, 1); } else next[i] = Qnil; current = next; - XSET (key, Lisp_Int, XFASTINT (key) & 0177); + XSET (key, Lisp_Int, XFASTINT (key) & ~CHAR_META); } first_binding = nmaps; @@ -2635,7 +3366,7 @@ follow_key (key, nmaps, current, defs, next) { if (! NILP (current[i])) { - defs[i] = get_keyelt (access_keymap (current[i], key)); + defs[i] = get_keyelt (access_keymap (current[i], key, 1)); if (! NILP (defs[i])) first_binding = i; } @@ -2648,16 +3379,20 @@ follow_key (key, nmaps, current, defs, next) lower-case letter, return the bindings for the lower-case letter. */ if (first_binding == nmaps && XTYPE (key) == Lisp_Int - && UPPERCASEP (XINT (key))) + && (UPPERCASEP (XINT (key) & 0x3ffff) + || (XINT (key) & shift_modifier))) { - XSETINT (key, DOWNCASE (XINT (key))); + if (XINT (key) & shift_modifier) + XSETINT (key, XINT (key) & ~shift_modifier); + else + XSETINT (key, DOWNCASE (XINT (key))); first_binding = nmaps; for (i = nmaps - 1; i >= 0; i--) { if (! NILP (current[i])) { - defs[i] = get_keyelt (access_keymap (current[i], key)); + defs[i] = get_keyelt (access_keymap (current[i], key, 1)); if (! NILP (defs[i])) first_binding = i; } @@ -2665,88 +3400,123 @@ follow_key (key, nmaps, current, defs, next) defs[i] = Qnil; } } - + /* Given the set of bindings we've found, produce the next set of maps. */ - for (i = 0; i < nmaps; i++) - next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0); + if (first_binding < nmaps) + for (i = 0; i < nmaps; i++) + next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1); return first_binding; } -/* Read a sequence of keys that ends with a non prefix character - according to the keymaps in KEYMAPS[0..nmaps-1]. Keymaps appearing - earlier in KEYMAPS take precidence over those appearing later. - - Store the sequence in KEYBUF, a buffer of size BUFSIZE. Prompt - with PROMPT. Echo starting immediately unless `prompt' is 0. +/* Read a sequence of keys that ends with a non prefix character, + storing it in KEYBUF, a buffer of size BUFSIZE. + Prompt with PROMPT. Return the length of the key sequence stored. - If the user switches frames in the midst of a key sequence, we - throw away any prefix we have read so far, and start afresh. For - mouse clicks, we look up the click in the keymap of the buffer - clicked on, throwing away any prefix if it is not the same buffer - we used to be reading from. */ + Echo starting immediately unless `prompt' is 0. + + Where a key sequence ends depends on the currently active keymaps. + These include any minor mode keymaps active in the current buffer, + the current buffer's local map, and the global map. + + If a key sequence has no other bindings, we check Vfunction_key_map + to see if some trailing subsequence might be the beginning of a + function key's sequence. If so, we try to read the whole function + key, and substitute its symbolic name into the key sequence. + + We ignore unbound `down-' mouse clicks. We turn unbound `drag-' + events into similar click events, if that would make them bound. + + If we get a mouse click in a mode line, vertical divider, or other + non-text area, we treat the click as if it were prefixed by the + symbol denoting that area - `mode-line', `vertical-line', or + whatever. + + If the sequence starts with a mouse click, we read the key sequence + with respect to the buffer clicked on, not the current buffer. + + If the user switches frames in the midst of a key sequence, we put + off the switch-frame event until later; the next call to + read_char will return it. */ static int read_key_sequence (keybuf, bufsize, prompt) Lisp_Object *keybuf; int bufsize; - Lisp_Object prompt; + char *prompt; { + int count = specpdl_ptr - specpdl; + /* How many keys there are in the current key sequence. */ int t; - /* The buffer that the most recently read event was typed at. This - helps us read mouse clicks according to the buffer clicked in, - and notice when the mouse has moved from one frame to another. */ - struct buffer *last_event_buffer = current_buffer; - /* 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 = this_command_key_count; + 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; - /* 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; - /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in the current keymaps. */ Lisp_Object *defs; - /* The index 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.*/ + /* 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; + + /* 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; - /* If mock_input > t, then KEYBUF[t] should be read as the next + /* If t < mock_input, then KEYBUF[t] should be read as the next input key. We use this to recover after recognizing a function key. Once we realize that a suffix of the current key sequence is actually a function key's escape sequence, we replace the suffix with the function key's binding from Vfunction_key_map. Now keybuf - contains a new and different key sequence, so the echo area and - the submaps and defs arrays are wrong. In this situation, we set - mock_input to t, set t to 0, and jump to restart; the loop will - read keys from keybuf up until mock_input, which rebuilds the - state, and then it will resume reading characters from the keyboard. */ + contains a new and different key sequence, so the echo area, + this_command_keys, and the submaps and defs arrays are wrong. In + this situation, we set mock_input to t, set t to 0, and jump to + 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; /* If the sequence is unbound in submaps[], then - keymap[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map, - and fkey_map is its binding. If mock_input is in use, these - might be > t, indicating that all function key scanning should - hold off until t reaches them. */ + keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map, + and fkey_map is its binding. + These might be > t, indicating that all function key scanning + 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 = Vfunction_key_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 = Qnil; + + + /* If there is no function key map, turn off function key scanning. */ + if (NILP (Fkeymapp (Vfunction_key_map))) + fkey_start = fkey_end = bufsize + 1; + + /* We need to save the current buffer in case we switch buffers to + find the right binding for a mouse click. Note that we can't use + save_excursion_{save,restore} here, because they save point as + well as the current buffer; we don't want to save point, because + redisplay may change it, to accomodate a Fset_window_start or + something. */ + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + last_nonmenu_event = Qnil; if (INTERACTIVE) @@ -2757,17 +3527,24 @@ read_key_sequence (keybuf, bufsize, prompt) /* This doesn't put in a dash if the echo buffer is empty, so you don't always see a dash hanging out in the minibuffer. */ echo_dash (); - echo_start = echo_length (); } - /* If there is no function key map, turn off function key scanning. */ - if (NILP (Fkeymapp (Vfunction_key_map))) - fkey_start = fkey_end = bufsize + 1; - - restart: - t = 0; - this_command_key_count = keys_start; - + /* Record the initial state of the echo area and this_command_keys; + we will need to restore them if we replay a key sequence. */ + if (INTERACTIVE) + echo_start = echo_length (); + keys_start = this_command_key_count; + + /* 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, + keybuf[0..mock_input] holds the sequence we should reread. */ + replay_sequence: + + /* Build our list of keymaps. + If we recognize a function key and replace its escape sequence in + keybuf with its symbol, or if the sequence starts with a mouse + click and we need to switch buffers, we jump back here to rebuild + the initial keymaps from the current buffer. */ { Lisp_Object *maps; @@ -2779,7 +3556,11 @@ read_key_sequence (keybuf, bufsize, prompt) nmaps_allocated = nmaps; } bcopy (maps, submaps, (nmaps - 2) * sizeof (submaps[0])); - submaps[nmaps-2] = last_event_buffer->keymap; +#ifdef USE_TEXT_PROPERTIES + submaps[nmaps-2] = get_local_map (PT, current_buffer); +#else + submaps[nmaps-2] = current_buffer->local_map; +#endif submaps[nmaps-1] = global_map; } @@ -2788,16 +3569,58 @@ read_key_sequence (keybuf, bufsize, prompt) if (! NILP (submaps[first_binding])) break; + /* We jump here when a function key substitution has forced us to + reprocess the current key sequence. keybuf[0..mock_input] is the + sequence we want to reread. */ + t = 0; + + /* These are no-ops the first time through, but if we restart, they + revert the echo area and this_command_keys to their original state. */ + this_command_key_count = keys_start; + if (INTERACTIVE) + echo_truncate (echo_start); + + /* If the best binding for the current key sequence is a keymap, + or we may be looking at a function key's escape sequence, keep + on reading. */ while ((first_binding < nmaps && ! NILP (submaps[first_binding])) || (first_binding >= nmaps && fkey_start < t)) { Lisp_Object key; int used_mouse_menu = 0; + /* Where the last real key started. If we need to throw away a + key that has expanded into more than one element of keybuf + (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; + + /* 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; + if (t >= bufsize) error ("key sequence too long"); - /* Are we re-reading a key sequence, as indicated by mock_input? */ + if (INTERACTIVE) + echo_local_start = echo_length (); + keys_local_start = this_command_key_count; + local_first_binding = first_binding; + + replay_key: + /* These are no-ops, unless we throw away a keystroke below and + jumped back up to replay_key; in that case, these restore the + variables to their original state, allowing us to replay the + loop. */ + if (INTERACTIVE) + echo_truncate (echo_local_start); + this_command_key_count = keys_local_start; + first_binding = local_first_binding; + + /* Does mock_input indicate that we are re-reading a key sequence? */ if (t < mock_input) { key = keybuf[t]; @@ -2808,72 +3631,206 @@ read_key_sequence (keybuf, bufsize, prompt) /* If not, we should actually read a character. */ else { - struct buffer *buf; + last_real_key_start = t; key = read_char (!prompt, nmaps, submaps, last_nonmenu_event, &used_mouse_menu); - /* The above routines return -1 at the end of a macro. + /* read_char returns -1 at the end of a macro. Emacs 18 handles this by returning immediately with a zero, so that's what we'll do. */ - if (XTYPE (key) == Lisp_Int && XINT (key) < 0) - return 0; - - Vquit_flag = Qnil; - -#ifdef MULTI_FRAME - /* What buffer was this event typed/moused at? */ - if (used_mouse_menu) - /* Never change last_event_buffer for using a menu. */ - buf = last_event_buffer; - else if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol) + if (XTYPE (key) == Lisp_Int && XINT (key) == -1) { - buf = ((XTYPE (Vlast_event_frame) == Lisp_Frame) - ? (XBUFFER - (XWINDOW - (FRAME_SELECTED_WINDOW - (XFRAME (Vlast_event_frame)))->buffer)) - : last_event_buffer); + t = 0; + goto done; } - else if (EVENT_HAS_PARAMETERS (key)) - { - Lisp_Object window = POSN_WINDOW (EVENT_START (key)); - - if (NILP (window)) - abort (); + + Vquit_flag = Qnil; - buf = XBUFFER (XWINDOW (window)->buffer); - } - else - abort (); + /* Clicks in non-text areas get prefixed by the symbol + in their CHAR-ADDRESS field. For example, a click on + the mode line is prefixed by the symbol `mode-line'. - /* If this event came to a different buffer than the one - we're currently in, switch buffers and start a new key - sequence, starting with key. */ - if (buf != last_event_buffer) + Furthermore, key sequences beginning with mouse clicks + are read using the keymaps of the buffer clicked on, not + the current buffer. So we may have to switch the buffer + here. */ + if (EVENT_HAS_PARAMETERS (key)) { - last_event_buffer = buf; - Fselect_frame (Vlast_event_frame, Qnil); + Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key)); + + if (EQ (kind, Qmouse_click)) + { + Lisp_Object window = POSN_WINDOW (EVENT_START (key)); + Lisp_Object posn = POSN_BUFFER_POSN (EVENT_START (key)); + + /* Key sequences beginning with mouse clicks are + read using the keymaps in the buffer clicked on, + not the current buffer. If we're at the + beginning of a key sequence, switch buffers. */ + if (t == 0 + && XTYPE (window) == Lisp_Window + && XTYPE (XWINDOW (window)->buffer) == Lisp_Buffer + && XBUFFER (XWINDOW (window)->buffer) != current_buffer) + { + if (XTYPE (posn) == Lisp_Symbol) + { + if (t + 1 >= bufsize) + error ("key sequence too long"); + keybuf[t] = posn; + keybuf[t+1] = key; + mock_input = t + 2; + } + else + { + keybuf[t] = key; + mock_input = t + 1; + } - /* Arrange to read key as the next event. */ - keybuf[0] = key; - mock_input = 1; + set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); + goto replay_sequence; + } + else if (XTYPE (posn) == Lisp_Symbol) + { + if (t + 1 >= bufsize) + error ("key sequence too long"); + keybuf[t] = posn; + keybuf[t+1] = key; + mock_input = t + 2; - /* Truncate the key sequence in the echo area. */ - if (INTERACTIVE) - echo_truncate (echo_start); + goto replay_key; + } + } + else if (EQ (kind, Qswitch_frame)) + { + /* If we're at the beginning of a key sequence, go + ahead and return this event. If we're in the + midst of a key sequence, delay it until the end. */ + if (t > 0) + { + delayed_switch_frame = key; + goto replay_key; + } + } + else + { + Lisp_Object posn = POSN_BUFFER_POSN (EVENT_START (key)); - goto restart; + /* Handle menu-bar events: + insert the dummy prefix char `menu-bar'. */ + if (EQ (posn, Qmenu_bar)) + { + if (t + 1 >= bufsize) + error ("key sequence too long"); + /* Run the Lucid hook. */ + call1 (Vrun_hooks, Qactivate_menubar_hook); + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (! NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + keybuf[t] = posn; + keybuf[t+1] = key; + mock_input = t + 2; + goto replay_sequence; + } + } } -#endif } + /* We have finally decided that KEY is something we might want + to look up. */ first_binding = (follow_key (key, nmaps - first_binding, submaps + first_binding, defs + first_binding, submaps + first_binding) + first_binding); + + /* If KEY wasn't bound, we'll try some fallbacks. */ + if (first_binding >= nmaps) + { + Lisp_Object head = EVENT_HEAD (key); + + if (XTYPE (head) == Lisp_Symbol) + { + Lisp_Object breakdown = parse_modifiers (head); + int modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car); + + /* We drop unbound `down-' events altogether. */ + if (modifiers & down_modifier) + { + /* Dispose of this event by simply jumping back to + replay_key, to get another event. + + Note that if this event came from mock input, + then just jumping back to replay_key will just + hand it to us again. So we have to wipe out any + mock input. + + We could delete keybuf[t] and shift everything + after that to the left by one spot, but we'd also + have to fix up any variable that points into + keybuf, and shifting isn't really necessary + anyway. + + Adding prefixes for non-textual mouse clicks + creates two characters of mock input, and both + must be thrown away. If we're only looking at + the prefix now, we can just jump back to + replay_key. On the other hand, if we've already + processed the prefix, and now the actual click + itself is giving us trouble, then we've lost the + state of the keymaps we want to backtrack to, and + we need to replay the whole sequence to rebuild + it. + + Beyond that, only function key expansion could + create more than two keys, but that should never + generate mouse events, so it's okay to zero + mock_input in that case too. + + Isn't this just the most wonderful code ever? */ + if (t == last_real_key_start) + { + mock_input = 0; + goto replay_key; + } + else + { + mock_input = last_real_key_start; + goto replay_sequence; + } + } + + /* We turn unbound `drag-' events into `click-' + events, if the click would be bound. */ + else if (modifiers & drag_modifier) + { + Lisp_Object new_head = + apply_modifiers (modifiers & ~drag_modifier, + XCONS (breakdown)->car); + Lisp_Object new_click = + Fcons (new_head, Fcons (EVENT_START (key), Qnil)); + + /* Look for a binding for this new key. follow_key + promises that it didn't munge submaps the + last time we called it, since key was unbound. */ + first_binding = + (follow_key (new_click, + nmaps - local_first_binding, + submaps + local_first_binding, + defs + local_first_binding, + submaps + local_first_binding) + + local_first_binding); + + /* If that click is bound, go for it. */ + if (first_binding < nmaps) + key = new_click; + /* Otherwise, we'll leave key set to the drag event. */ + } + } + } + keybuf[t++] = key; /* Normally, last_nonmenu_event gets the previous key we read. But when a mouse popup menu is being used, @@ -2885,7 +3842,7 @@ read_key_sequence (keybuf, bufsize, prompt) /* If the sequence is unbound, see if we can hang a function key off the end of it. We only want to scan real keyboard input for function key sequences, so if mock_input says that we're - re-scanning after expanding a function key, don't examine it. */ + re-reading old events, don't examine it. */ if (first_binding >= nmaps && t >= mock_input) { @@ -2894,19 +3851,26 @@ read_key_sequence (keybuf, bufsize, prompt) /* Scan from fkey_end until we find a bound suffix. */ while (fkey_end < t) { + Lisp_Object key; + + key = keybuf[fkey_end++]; /* Look up meta-characters by prefixing them with meta_prefix_char. I hate this. */ - if (keybuf[fkey_end] & 0x80) - fkey_next = - get_keymap_1 (get_keyelt - (access_keymap (fkey_map, meta_prefix_char)), - 0); + if (XTYPE (key) == Lisp_Int && XINT (key) & meta_modifier) + { + fkey_next = + get_keymap_1 + (get_keyelt + (access_keymap + (fkey_map, meta_prefix_char, 1)), + 0, 1); + XFASTINT (key) = XFASTINT (key) & ~meta_modifier; + } else fkey_next = fkey_map; fkey_next = - get_keyelt (access_keymap - (fkey_next, keybuf[fkey_end++] & 0x7f)); + get_keyelt (access_keymap (fkey_next, key, 1)); /* If keybuf[fkey_start..fkey_end] is bound in the function key map and it's a suffix of the current @@ -2926,14 +3890,10 @@ read_key_sequence (keybuf, bufsize, prompt) mock_input = t; fkey_start = fkey_end = t; - /* Truncate the key sequence in the echo area. */ - if (INTERACTIVE) - echo_truncate (echo_start); - - goto restart; + goto replay_sequence; } - fkey_map = get_keymap_1 (fkey_next, 0); + fkey_map = get_keymap_1 (fkey_next, 0, 1); /* If we no longer have a bound suffix, try a new positions for fkey_start. */ @@ -2950,6 +3910,9 @@ read_key_sequence (keybuf, bufsize, prompt) ? defs[first_binding] : Qnil); + done: + unread_switch_frame = delayed_switch_frame; + unbind_to (count, Qnil); return t; } @@ -2962,10 +3925,30 @@ First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\ Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\ as a continuation of the previous key.\n\ \n\ -If Emacs is running on multiple frames, switching between frames in\n\ -the midst of a keystroke will toss any prefix typed so far. A C-g\n\ -typed while in this function is treated like any other character, and\n\ -`quit-flag' is not set.") +A C-g typed while in this function is treated like any other character,\n\ +and `quit-flag' is not set.\n\ +\n\ +If the key sequence starts with a mouse click, then the sequence is read\n\ +using the keymaps of the buffer of the window clicked in, not the buffer\n\ +of the selected window as normal.\n\ +\n\ +`read-key-sequence' drops unbound button-down events, since you normally\n\ +only care about the click or drag events which follow them. If a drag\n\ +event is unbound, but the corresponding click event would be bound,\n\ +`read-key-sequence' turns the drag event into a click event at the\n\ +drag's starting position. This means that you don't have to distinguish\n\ +between click and drag events unless you want to.\n\ +\n\ +`read-key-sequence' prefixes mouse events on mode lines, the vertical\n\ +lines separating windows, and scroll bars with imaginary keys\n\ +`mode-line', `vertical-line', and `vertical-scroll-bar'.\n\ +\n\ +If the user switches frames in the middle of a key sequence, the\n\ +frame-switch event is put off until after the current key sequence.\n\ +\n\ +`read-key-sequence' checks `function-key-map' for function key\n\ +sequences, where they wouldn't conflict with ordinary bindings. See\n\ +`function-key-map' for more details.") (prompt, continue_echo) Lisp_Object prompt, continue_echo; { @@ -2985,10 +3968,10 @@ typed while in this function is treated like any other character, and\n\ this_command_key_count = 0; i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), - NILP (prompt) ? 0 : XSTRING (prompt)->data); + NILP (prompt) ? 0 : XSTRING (prompt)->data); UNGCPRO; - return make_array (i, keybuf); + return make_event_array (i, keybuf); } DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0, @@ -3125,7 +4108,7 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ UNGCPRO; - function = Fintern (function, Vobarray); + function = Fintern (function, Qnil); Vprefix_arg = prefixarg; this_command = function; @@ -3154,14 +4137,14 @@ DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, Actually, the value is nil only if we can be sure that no input is available.") () { - if (!NILP (unread_command_char)) + if (!NILP (unread_command_events) || unread_command_char != -1) return (Qt); return detect_input_pending () ? Qt : Qnil; } DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, - "Return vector of last 100 chars read from terminal.") + "Return vector of last 100 events, not counting those from keyboard macros.") () { Lisp_Object *keys = XVECTOR (recent_keys)->contents; @@ -3183,10 +4166,12 @@ DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, } DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0, - "Return string of the keystrokes that invoked this command.") + "Return the key sequence that invoked this command.\n\ +The value is a string or a vector.") () { - return make_array (this_command_key_count, this_command_keys); + return make_event_array (this_command_key_count, + XVECTOR (this_command_keys)->contents); } DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, @@ -3200,7 +4185,8 @@ DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, "FOpen dribble file: ", - "Start writing all keyboard characters to FILE.") + "Start writing all keyboard characters to a dribble file called FILE.\n\ +If FILE is nil, close any open dribble file.") (file) Lisp_Object file; { @@ -3225,11 +4211,16 @@ Also cancel any kbd macro being defined.") defining_kbd_macro = 0; update_mode_lines++; - unread_command_char = Qnil; + unread_command_events = Qnil; + unread_command_char = -1; discard_tty_input (); - kbd_fetch_ptr = kbd_store_ptr; + /* Without the cast, GCC complains that this assignment loses the + volatile qualifier of kbd_store_ptr. Is there anything wrong + with that? */ + kbd_fetch_ptr = (struct input_event *) kbd_store_ptr; + Ffillarray (kbd_buffer_frame_or_window, Qnil); input_pending = 0; return Qnil; @@ -3239,36 +4230,33 @@ DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "", "Stop Emacs and return to superior process. You can resume later.\n\ On systems that don't have job control, run a subshell instead.\n\n\ If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\ -to be read as terminal input by Emacs's superior shell.\n\ -Before suspending, if `suspend-hook' is bound and value is non-nil\n\ -call the value as a function of no args. Don't suspend if it returns non-nil.\n\ -Otherwise, suspend normally and after resumption call\n\ +to be read as terminal input by Emacs's parent, after suspension.\n\ +\n\ +Before suspending, call the functions in `suspend-hook' with no args.\n\ +If any of them returns nil, don't call the rest and don't suspend.\n\ +Otherwise, suspend normally and after resumption run the normal hook\n\ `suspend-resume-hook' if that is bound and non-nil.\n\ \n\ Some operating systems cannot stop the Emacs process and resume it later.\n\ -On such systems, Emacs will start a subshell and wait for it to exit.") +On such systems, Emacs starts a subshell instead of suspending.") (stuffstring) Lisp_Object stuffstring; { - register Lisp_Object tem; + Lisp_Object tem; int count = specpdl_ptr - specpdl; int old_height, old_width; int width, height; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; extern init_sys_modes (); if (!NILP (stuffstring)) CHECK_STRING (stuffstring, 0); - GCPRO1 (stuffstring); - /* Call value of suspend-hook - if it is bound and value is non-nil. */ + /* Run the functions in suspend-hook. */ if (!NILP (Vrun_hooks)) - { - tem = call1 (Vrun_hooks, intern ("suspend-hook")); - if (!EQ (tem, Qnil)) return Qnil; - } + call1 (Vrun_hooks, intern ("suspend-hook")); + GCPRO1 (stuffstring); get_frame_size (&old_width, &old_height); reset_sys_modes (); /* sys_suspend can get an error if it tries to fork a subshell @@ -3285,8 +4273,7 @@ On such systems, Emacs will start a subshell and wait for it to exit.") if (width != old_width || height != old_height) change_frame_size (0, height, width, 0, 0); - /* Call value of suspend-resume-hook - if it is bound and value is non-nil. */ + /* Run suspend-resume-hook. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("suspend-resume-hook")); @@ -3322,6 +4309,10 @@ stuff_buffered_input (stuffstring) kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ascii_keystroke) stuff_char (XINT (kbd_fetch_ptr->code)); + kbd_fetch_ptr->kind = no_event; + (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr + - kbd_buffer] + = Qnil); kbd_fetch_ptr++; } input_pending = 0; @@ -3375,7 +4366,6 @@ interrupt_signal () char c; /* Must preserve main program's value of errno. */ int old_errno = errno; - extern Lisp_Object Vwindow_system; #ifdef USG /* USG systems forget handlers when they are used; @@ -3465,7 +4455,14 @@ quit_throw_to_read_char () clear_waiting_for_input (); input_pending = 0; - unread_command_char = Qnil; + unread_command_events = Qnil; + unread_command_char = -1; + +#ifdef POLL_FOR_INPUT + /* May be > 1 if in recursive minibuffer. */ + if (poll_suppress_count == 0) + abort (); +#endif _longjmp (getcjmp, 1); } @@ -3476,8 +4473,9 @@ First arg INTERRUPT non-nil means use input interrupts;\n\ nil means use CBREAK mode.\n\ Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\ (no effect except in CBREAK mode).\n\ -Third arg META non-nil means accept 8-bit input (for a Meta key).\n\ - Otherwise, the top bit is ignored, on the assumption it is parity.\n\ +Third arg META t means accept 8-bit input (for a Meta key).\n\ + META nil means ignore the top bit, on the assumption it is parity.\n\ + Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\ Optional fourth arg QUIT if non-nil specifies character to use for quitting.") (interrupt, flow, meta, quit) Lisp_Object interrupt, flow, meta, quit; @@ -3504,7 +4502,12 @@ Optional fourth arg QUIT if non-nil specifies character to use for quitting.") interrupt_input = 1; #endif flow_control = !NILP (flow); - meta_key = !NILP (meta); + if (NILP (meta)) + meta_key = 0; + else if (EQ (meta, Qt)) + meta_key = 1; + else + meta_key = 2; if (!NILP (quit)) /* Don't let this value be out of range. */ quit_char = XINT (quit) & (meta_key ? 0377 : 0177); @@ -3512,18 +4515,40 @@ Optional fourth arg QUIT if non-nil specifies character to use for quitting.") init_sys_modes (); return Qnil; } + +DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0, + "Return information about the way Emacs currently reads keyboard input.\n\ +The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\ + INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\ + nil, Emacs is using CBREAK mode.\n\ + FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\ + terminal; this does not apply if Emacs uses interrupt-driven input.\n\ + META is non-nil if Emacs is accepting 8-bit input; otherwise, Emacs\n\ + clears the eighth bit of every input character.\n\ + QUIT is the character Emacs currently uses to quit.\n\ +The elements of this list correspond to the arguments of\n\ +set-input-mode.") + () +{ + Lisp_Object val[4]; + + val[0] = interrupt_input ? Qt : Qnil; + val[1] = flow_control ? Qt : Qnil; + val[2] = meta_key ? Qt : Qnil; + XSETINT (val[3], quit_char); + + return Flist (val, sizeof (val) / sizeof (val[0])); +} + init_keyboard () { - this_command_keys_size = 40; - this_command_keys = - (Lisp_Object *) xmalloc (this_command_keys_size * sizeof (Lisp_Object)); - /* This is correct before outermost invocation of the editor loop */ command_loop_level = -1; immediate_quit = 0; quit_char = Ctl ('g'); - unread_command_char = Qnil; + unread_command_events = Qnil; + unread_command_char = -1; total_keys = 0; recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; @@ -3531,10 +4556,26 @@ init_keyboard () do_mouse_tracking = 0; input_pending = 0; +#ifdef MULTI_FRAME + /* This means that command_loop_1 won't try to select anything the first + time through. */ + internal_last_event_frame = Qnil; + Vlast_event_frame = internal_last_event_frame; +#endif + + /* If we're running a dumped Emacs, we need to clear out + kbd_buffer_frame_or_window, in case some events got into it + before we dumped. + + If we're running an undumped Emacs, it hasn't been initialized by + syms_of_keyboard yet. */ + if (initialized) + Ffillarray (kbd_buffer_frame_or_window, Qnil); + if (!noninteractive) { signal (SIGINT, interrupt_signal); -#ifdef HAVE_TERMIO +#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) /* For systems with SysV TERMIO, C-g is set up for both SIGINT and SIGQUIT and we can't tell which one it will give us. */ signal (SIGQUIT, interrupt_signal); @@ -3580,15 +4621,9 @@ struct event_head { }; struct event_head head_table[] = { - &Qmouse_movement, "mouse-movement", &Qmouse_movement, - &Qvscrollbar_part, "vscrollbar-part", &Qscrollbar_click, - &Qvslider_part, "vslider-part", &Qscrollbar_click, - &Qvthumbup_part, "vthumbup-part", &Qscrollbar_click, - &Qvthumbdown_part, "vthumbdown-part", &Qscrollbar_click, - &Qhscrollbar_part, "hscrollbar-part", &Qscrollbar_click, - &Qhslider_part, "hslider-part", &Qscrollbar_click, - &Qhthumbleft_part, "hthumbleft-part", &Qscrollbar_click, - &Qhthumbright_part,"hthumbright-part", &Qscrollbar_click + &Qmouse_movement, "mouse-movement", &Qmouse_movement, + &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement, + &Qswitch_frame, "switch-frame", &Qswitch_frame, }; syms_of_keyboard () @@ -3605,22 +4640,49 @@ syms_of_keyboard () Qdisabled = intern ("disabled"); staticpro (&Qdisabled); + Qpre_command_hook = intern ("pre-command-hook"); + staticpro (&Qpre_command_hook); + + Qpost_command_hook = intern ("post-command-hook"); + staticpro (&Qpost_command_hook); + Qfunction_key = intern ("function-key"); staticpro (&Qfunction_key); - Qmouse_movement = intern ("mouse-click"); + Qmouse_click = intern ("mouse-click"); staticpro (&Qmouse_click); - Qmouse_movement = intern ("scrollbar-click"); - staticpro (&Qmouse_movement); + + Qmenu_enable = intern ("menu-enable"); + staticpro (&Qmenu_enable); Qmode_line = intern ("mode-line"); staticpro (&Qmode_line); Qvertical_line = intern ("vertical-line"); staticpro (&Qvertical_line); - - Qevent_kind = intern ("event-type"); + Qvertical_scroll_bar = intern ("vertical-scroll-bar"); + staticpro (&Qvertical_scroll_bar); + Qmenu_bar = intern ("menu-bar"); + staticpro (&Qmenu_bar); + + Qabove_handle = intern ("above-handle"); + staticpro (&Qabove_handle); + Qhandle = intern ("handle"); + staticpro (&Qhandle); + Qbelow_handle = intern ("below-handle"); + staticpro (&Qbelow_handle); + + Qevent_kind = intern ("event-kind"); staticpro (&Qevent_kind); Qevent_symbol_elements = intern ("event-symbol-elements"); staticpro (&Qevent_symbol_elements); + Qevent_symbol_element_mask = intern ("event-symbol-element-mask"); + staticpro (&Qevent_symbol_element_mask); + Qmodifier_cache = intern ("modifier-cache"); + staticpro (&Qmodifier_cache); + + Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar"); + staticpro (&Qrecompute_lucid_menubar); + Qactivate_menubar_hook = intern ("activate-menubar-hook"); + staticpro (&Qactivate_menubar_hook); { struct event_head *p; @@ -3636,12 +4698,8 @@ syms_of_keyboard () } } - { - int i; - - for (i = 0; i < NUM_MOUSE_BUTTONS; i++) - staticpro (&button_down_location[i].window); - } + button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil); + staticpro (&button_down_location); { int i; @@ -3649,23 +4707,33 @@ syms_of_keyboard () modifier_symbols = Fmake_vector (make_number (len), Qnil); for (i = 0; i < len; i++) - XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]); + if (modifier_names[i]) + XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]); staticpro (&modifier_symbols); } recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil); staticpro (&recent_keys); + this_command_keys = Fmake_vector (make_number (40), Qnil); + staticpro (&this_command_keys); + + kbd_buffer_frame_or_window + = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); + staticpro (&kbd_buffer_frame_or_window); + func_key_syms = Qnil; staticpro (&func_key_syms); mouse_syms = Qnil; staticpro (&mouse_syms); + unread_switch_frame = Qnil; + staticpro (&unread_switch_frame); + defsubr (&Sread_key_sequence); defsubr (&Srecursive_edit); defsubr (&Strack_mouse); - defsubr (&Smouse_click_p); defsubr (&Sinput_pending_p); defsubr (&Scommand_execute); defsubr (&Srecent_keys); @@ -3678,6 +4746,7 @@ syms_of_keyboard () defsubr (&Sdiscard_input); defsubr (&Sopen_dribble_file); defsubr (&Sset_input_mode); + defsubr (&Scurrent_input_mode); defsubr (&Sexecute_extended_command); DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook, @@ -3685,19 +4754,28 @@ syms_of_keyboard () \(has a non-nil `disabled' property)."); DEFVAR_LISP ("last-command-char", &last_command_char, - "Last terminal input key that was part of a command."); + "Last input event that was part of a command."); + + DEFVAR_LISP ("last-command-event", &last_command_char, + "Last input event that was part of a command."); DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event, - "Last terminal input key in a command, except for mouse menus.\n\ + "Last input event in a command, except for mouse menu events.\n\ Mouse menus give back keys that don't look like mouse events;\n\ this variable holds the actual mouse event that led to the menu,\n\ so that you can determine whether the command was run by mouse or not."); DEFVAR_LISP ("last-input-char", &last_input_char, - "Last terminal input key."); + "Last input event."); + + DEFVAR_LISP ("last-input-event", &last_input_char, + "Last input event."); + + DEFVAR_LISP ("unread-command-events", &unread_command_events, + "List of objects to be read as next command input events."); - DEFVAR_LISP ("unread-command-char", &unread_command_char, - "Object to be read as next input from input stream, or nil if none."); + DEFVAR_INT ("unread-command-char", &unread_command_char, + "If not -1, an object to be read as next command input event."); DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char, "Meta-prefix character code. Meta-foo as command input\n\ @@ -3787,6 +4865,38 @@ Otherwise, menu prompting uses the echo area."); "Character to see next line of menu prompt.\n\ Type this character while in a menu prompt to rotate around the lines of it."); XSET (menu_prompt_more_char, Lisp_Int, ' '); + + DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers, + "A mask of additional modifier keys to use with every keyboard character.\n\ +Emacs applies the modifiers of the character stored here to each keyboard\n\ +character it reads. For example, after evaluating the expression\n\ + (setq extra-keyboard-modifiers ?\C-x)\n\ +all input characters will have the control modifier applied to them.\n\ +\n\ +Note that the character ?\C-@, equivalent to the integer zero, does\n\ +not count as a control character; rather, it counts as a character\n\ +with no modifiers; thus, setting extra_keyboard_modifiers to zero\n\ +cancels any modification."); + extra_keyboard_modifiers = 0; + + DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark, + "If an editing command sets this to t, deactivate the mark afterward.\n\ +The command loop sets this to nil before each command,\n\ +and tests the value when the command returns.\n\ +Buffer modification stores t in this variable."); + Vdeactivate_mark = Qnil; + + DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook, + "Normal hook run before each command is executed."); + Vpre_command_hook = Qnil; + + DEFVAR_LISP ("post-command-hook", &Vpost_command_hook, + "Normal hook run before each command is executed."); + Vpost_command_hook = Qnil; + + DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag, + "t means menu bar, specified Lucid style, needs to be recomputed."); + Vlucid_menu_bar_dirty_flag = Qnil; } keys_of_keyboard ()