X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fd7b67ea6e3414b7b2ae5e67efdd6f55587bceb2..42e3337cc7a782ab8705b1dea3841a7b0dcb6224:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index 12d936ad0d..98c9250fb6 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, @@ -28,12 +28,15 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "lisp.h" #include "termhooks.h" #include "macros.h" -#include "screen.h" +#include "frame.h" #include "window.h" #include "commands.h" #include "buffer.h" #include "disptab.h" +#include "dispextern.h" #include "keyboard.h" +#include "intervals.h" +#include "blockinput.h" #include #include @@ -42,11 +45,21 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #endif #include "syssignal.h" -#include "systerm.h" +#include "systty.h" #include "systime.h" 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; @@ -76,12 +89,15 @@ Lisp_Object Qdisabled, Vdisabled_command_hook; #define NUM_RECENT_KEYS (100) 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[NUM_RECENT_KEYS]; /* Holds last 100 keystrokes */ +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; @@ -141,11 +157,30 @@ int num_input_keys; /* Last input character read as a command. */ Lisp_Object last_command_char; +/* Last input character read as a command, not counting menus + reached by the mouse. */ +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. */ @@ -161,12 +196,15 @@ static Lisp_Object Vauto_save_timeout; /* Total number of times read_char has returned. */ int num_input_chars; +/* Total number of times read_char has returned, outside of macros. */ +int num_nonmacro_input_chars; + /* Auto-save automatically when this many characters have been typed since the last time. */ static int auto_save_interval; -/* Value of num_input_chars as of last auto save. */ +/* Value of num_nonmacro_input_chars as of last auto save. */ int last_auto_save; @@ -180,35 +218,19 @@ Lisp_Object last_command; instead of the actual command. */ Lisp_Object this_command; -#ifndef HAVE_X11 -/* Window of last mouse click. */ -extern Lisp_Object Vmouse_window; - -/* List containing details of last mouse click. */ -extern Lisp_Object Vmouse_event; -#endif /* defined HAVE_X11 */ - -/* Hook to call on each mouse event after running its definition. */ -Lisp_Object Vmouse_event_function; - -/* Hook to call when mouse leaves screen. */ -Lisp_Object Vmouse_left_hook; - -/* Hook to call when a screen is mapped. */ -Lisp_Object Vmap_screen_hook; - -/* Hook to call when a screen is unmapped. */ -Lisp_Object Vunmap_screen_hook; - -/* Handler for non-grabbed (no keys depressed) mouse motion. */ -Lisp_Object Vmouse_motion_handler; - -/* The screen in which the last input event occurred. - command_loop_1 will select this screen 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 screen. */ -Lisp_Object Vlast_event_screen; +#ifdef MULTI_FRAME +/* The frame in which the last input event occurred, or Qmacro if the + 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 /* The timestamp of the last input event we received from the X server. X Windows wants this for selection ownership. */ @@ -231,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; @@ -245,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 @@ -254,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 @@ -287,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_unmodified; +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_split; +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. */ @@ -363,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; @@ -382,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 (); } @@ -405,15 +486,14 @@ echo_char (c) *ptr++ = ' '; /* If someone has passed us a composite event, use its head symbol. */ - if (EVENT_HAS_PARAMETERS (c)) - c = EVENT_HEAD (c); + c = EVENT_HEAD (c); if (XTYPE (c) == Lisp_Int) { 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) { @@ -424,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); @@ -444,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. */ @@ -464,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 (); } @@ -494,14 +577,14 @@ echo_length () /* Truncate the current echo message to its first LEN chars. This and echo_char get used by read_key_sequence when the user - switches screens while entering a key sequence. */ + switches frames while entering a key sequence. */ static void echo_truncate (len) int len; { echobuf[len] = '\0'; - echoptr = echobuf + strlen (echobuf); + echoptr = echobuf + len; } @@ -510,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 @@ -537,18 +625,15 @@ 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. */ record_auto_save () { - last_auto_save = num_input_chars; + 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\ @@ -600,10 +685,10 @@ cmd_error (data) Vexecuting_macro = Qnil; echo_area_glyphs = 0; - /* If the window system or terminal screen hasn't been initialized + /* If the window system or terminal frame hasn't been initialized yet, or we're not interactive, it's best to dump this message out to stderr and exit. */ - if (! SCREEN_MESSAGE_BUF (selected_screen) + if (! FRAME_MESSAGE_BUF (selected_frame) || noninteractive) stream = Qexternal_debugging_output; else @@ -657,9 +742,9 @@ cmd_error (data) } UNGCPRO; - /* If the window system or terminal screen hasn't been initialized + /* If the window system or terminal frame hasn't been initialized yet, or we're in -batch mode, this error should cause Emacs to exit. */ - if (! SCREEN_MESSAGE_BUF (selected_screen) + if (! FRAME_MESSAGE_BUF (selected_frame) || noninteractive) { Fterpri (stream); @@ -772,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 (); @@ -811,18 +899,26 @@ command_loop_1 () no_direct = 0; + Vdeactivate_mark = Qnil; + /* If minibuffer on and echo area in use, wait 2 sec and redraw minibufer. */ if (minibuf_level && echo_area_glyphs) { + /* Bind inhibit-quit to t so that C-g gets read in + rather than quitting back to the minibuffer. */ + int count = specpdl_ptr - specpdl; + specbind (Qinhibit_quit, Qt); Fsit_for (make_number (2), Qnil, Qnil); + 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); } } @@ -831,59 +927,69 @@ 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); + +#if 0 /* This is done in xdisp.c now. */ +#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 */ +#endif /* 0 */ + /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), 0); ++num_input_keys; -#ifdef MULTI_SCREEN - /* Select the screen that the key sequence came from. */ - if (XTYPE (Vlast_event_screen) == Lisp_Screen - && XSCREEN (Vlast_event_screen) != selected_screen) - Fselect_screen (Vlast_event_screen, Qnil); -#endif - /* Now we have read a key sequence of length I, or else I is 0 and we found end of file. */ if (i == 0) /* End of file -- happens only in */ return Qnil; /* a kbd macro, at the end. */ -#if 0 -#ifdef HAVE_X_WINDOWS - if (SCREEN_IS_X (selected_screen)) - { - if (i == -1) /* Mouse event */ - { - nonundocount = 0; - if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) && - !EQ (minibuf_window, selected_window)) - Fundo_boundary (); - - if (defining_kbd_macro) - { - /* Be nice if this worked... */ - } - Fexecute_mouse_event (read_key_sequence_cmd); - no_redisplay = 0; - goto directly_done; - } - - if (i == -2) /* Lisp Symbol */ - { - nonundocount = 0; - if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) && - !EQ (minibuf_window, selected_window)) - Fundo_boundary (); - - goto directly_done; - } - } -#endif /* HAVE_X_WINDOWS */ -#endif - 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)) { @@ -899,8 +1005,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. */ @@ -908,10 +1021,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 @@ -922,10 +1035,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) @@ -943,10 +1056,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) @@ -983,7 +1096,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; @@ -993,13 +1106,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; } @@ -1015,6 +1139,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, @@ -1030,6 +1157,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")); + } } } @@ -1048,12 +1186,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); } @@ -1106,27 +1241,43 @@ static Lisp_Object kbd_buffer_get_event (); -1 means do not do redisplay, but do do autosaving. 1 means do both. */ +/* The arguments MAPS and NMAPS are for menu prompting. + MAPS is an array of keymaps; NMAPS is the length of MAPS. + + PREV_EVENT is the previous input event, or nil if we are reading + the first event of a key sequence. + + 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) +read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) int commandflag; + int nmaps; + Lisp_Object *maps; + Lisp_Object prev_event; + int *used_mouse_menu; { register Lisp_Object c; int count; jmp_buf save_jump; - if (!NILP (unread_command_char)) + if (CONSP (unread_command_events)) { - c = unread_command_char; - unread_command_char = Qnil; + c = XCONS (unread_command_events)->car; + unread_command_events = XCONS (unread_command_events)->cdr; -#if 0 /* We're not handling mouse keys specially anymore. */ - if (!EQ (XTYPE (obj), Lisp_Int)) /* Mouse thing */ - { - num_input_chars++; - last_input_char = 0; - return obj; - } -#endif + if (this_command_key_count == 0) + goto reread_first; + else + goto reread; + } + + if (unread_command_char != -1) + { + XSET (c, Lisp_Int, unread_command_char); + unread_command_char = -1; if (this_command_key_count == 0) goto reread_first; @@ -1136,18 +1287,50 @@ read_char (commandflag) if (!NILP (Vexecuting_macro)) { - if (executing_macro_index >= Flength (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 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 + + /* 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); @@ -1159,9 +1342,14 @@ read_char (commandflag) if (_setjmp (getcjmp)) { XSET (c, Lisp_Int, quit_char); -#ifdef MULTI_SCREEN - XSET (Vlast_event_screen, Lisp_Screen, selected_screen); +#ifdef MULTI_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; } @@ -1181,16 +1369,24 @@ read_char (commandflag) { Lisp_Object tem0; - tem0 = sit_for (echo_keystrokes, 0, 1, 1); - if (EQ (tem0, Qt)) + /* 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 (EVENT_HAS_PARAMETERS (prev_event)) echo (); + else + { + tem0 = sit_for (echo_keystrokes, 0, 1, 1); + if (EQ (tem0, Qt)) + echo (); + } } /* Maybe auto save due to number of keystrokes or idle time. */ if (commandflag != 0 && auto_save_interval > 0 - && num_input_chars - last_auto_save > max (auto_save_interval, 20) + && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20) && !detect_input_pending ()) { jmp_buf temp; @@ -1199,67 +1395,100 @@ read_char (commandflag) restore_getcjmp (temp); } + /* Try reading a character via menu prompting. + Try this before the sit-for, because the sit-for + would do the wrong thing if we are supposed to do + menu prompting. */ + c = Qnil; + if (INTERACTIVE && !NILP (prev_event)) + c = read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu); + /* Slow down auto saves logarithmically in size of current buffer, and garbage collect while we're at it. */ - { - int delay_level, buffer_size; - - if (! MINI_WINDOW_P (XWINDOW (selected_window))) - last_non_minibuf_size = Z - BEG; - buffer_size = (last_non_minibuf_size >> 8) + 1; - delay_level = 0; - while (buffer_size > 64) - delay_level++, buffer_size -= buffer_size >> 2; - if (delay_level < 4) delay_level = 4; - /* delay_level is 4 for files under around 50k, 7 at 100k, - 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */ - - /* Auto save if enough time goes by without input. */ - if (commandflag != 0 - && num_input_chars > last_auto_save - && XTYPE (Vauto_save_timeout) == Lisp_Int - && XINT (Vauto_save_timeout) > 0) - { - Lisp_Object tem0; - int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4; - tem0 = sit_for (delay, 0, 1, 1); - if (EQ (tem0, Qt)) - { - jmp_buf temp; - save_getcjmp (temp); - Fdo_auto_save (Qnil, Qnil); - restore_getcjmp (temp); - - /* If we have auto-saved and there is still no input - available, garbage collect if there has been enough - consing going on to make it worthwhile. */ - if (!detect_input_pending () - && consing_since_gc > gc_cons_threshold / 2) - Fgarbage_collect (); - } - } - } + if (NILP (c)) + { + int delay_level, buffer_size; + + if (! MINI_WINDOW_P (XWINDOW (selected_window))) + last_non_minibuf_size = Z - BEG; + buffer_size = (last_non_minibuf_size >> 8) + 1; + delay_level = 0; + while (buffer_size > 64) + delay_level++, buffer_size -= buffer_size >> 2; + if (delay_level < 4) delay_level = 4; + /* delay_level is 4 for files under around 50k, 7 at 100k, + 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */ + + /* Auto save if enough time goes by without input. */ + if (commandflag != 0 + && num_nonmacro_input_chars > last_auto_save + && XTYPE (Vauto_save_timeout) == Lisp_Int + && XINT (Vauto_save_timeout) > 0) + { + Lisp_Object tem0; + int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4; + tem0 = sit_for (delay, 0, 1, 1); + if (EQ (tem0, Qt)) + { + jmp_buf temp; + save_getcjmp (temp); + Fdo_auto_save (Qnil, Qnil); + restore_getcjmp (temp); + + /* If we have auto-saved and there is still no input + available, garbage collect if there has been enough + consing going on to make it worthwhile. */ + if (!detect_input_pending () + && consing_since_gc > gc_cons_threshold / 2) + Fgarbage_collect (); + } + } + } /* Actually read a character, waiting if necessary. */ - c = kbd_buffer_get_event (); + if (NILP (c)) + c = kbd_buffer_get_event (); if (NILP (c)) abort (); /* Don't think this can happen. */ -#if 0 /* I think that all the different kinds of events should be - handled together now... */ - if (XTYPE (c) != Lisp_Int) - { - start_polling (); - return c; - } - c = XINT (obj); -#endif - /* Terminate Emacs in batch mode if at eof. */ - if (noninteractive && c < 0) + 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); @@ -1272,20 +1501,17 @@ read_char (commandflag) 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++; - recent_keys[recent_keys_index] = c; - if (++recent_keys_index >= (sizeof (recent_keys)/sizeof(recent_keys[0]))) + XVECTOR (recent_keys)->contents[recent_keys_index] = c; + if (++recent_keys_index >= NUM_RECENT_KEYS) recent_keys_index = 0; /* Write c to the dribble file. If c is a lispy event, write @@ -1294,20 +1520,19 @@ read_char (commandflag) if (dribble) { if (XTYPE (c) == Lisp_Int) - putc (c, dribble); + putc (XINT (c), dribble); else { Lisp_Object dribblee = c; /* If it's a structured event, take the event header. */ - if (EVENT_HAS_PARAMETERS (dribblee)) - dribblee = EVENT_HEAD (dribblee); + 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); } @@ -1318,12 +1543,19 @@ read_char (commandflag) store_kbd_macro_char (c); + num_nonmacro_input_chars++; + 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: @@ -1344,14 +1576,14 @@ read_char (commandflag) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); cancel_echoing (); - c = read_char (0); - /* Remove the help from the screen */ + c = read_char (0, 0, 0, Qnil, 0); + /* Remove the help from the frame */ unbind_to (count, Qnil); redisplay (); if (EQ (c, make_number (040))) { cancel_echoing (); - c = read_char (0); + c = read_char (0, 0, 0, Qnil, 0); } } @@ -1393,37 +1625,14 @@ restore_getcjmp (temp) /* Set this for debugging, to have a way to get out */ int stop_character; -extern int screen_garbaged; +extern int frame_garbaged; /* Return true iff there are any events in the queue that read-char would return. If this returns false, a read-char would block. */ static int readable_events () { - struct input_event *ep; - - if (EVENT_QUEUES_EMPTY) - return 0; - - if (do_mouse_tracking) - return 1; - - /* Mouse tracking is disabled, so we need to actually scan the - input queue to see if any events are currently readable. */ - for (ep = kbd_fetch_ptr; ep != kbd_store_ptr; ep++) - { - if (ep == kbd_buffer + KBD_BUFFER_SIZE) - ep = kbd_buffer; - - /* Skip button-up events. */ - if ((ep->kind == mouse_click || ep->kind == scrollbar_click) - && (ep->modifiers & up_modifier)) - continue; - - return 1; - } - - return 0; + return ! EVENT_QUEUES_EMPTY; } @@ -1451,10 +1660,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; { @@ -1483,15 +1692,27 @@ 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-screen 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_screen again, so this is safe to do. */ - extern SIGTYPE interrupt_signal (); - XSET (Vlast_event_screen, Lisp_Screen, event->screen); + will set Vlast_event_frame again, so this is safe to do. */ + { + 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; interrupt_signal (); return; @@ -1518,11 +1739,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->screen = event->screen; + 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++; } @@ -1531,6 +1755,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 () @@ -1545,31 +1770,10 @@ kbd_buffer_get_event () return obj; } + retry: /* Wait until there is input available. */ for (;;) { - - /* Process or toss any events that we don't want to return as - input. The fact that we remove undesirable events here - allows us to use EVENT_QUEUES_EMPTY in the rest of this loop. */ - if (! do_mouse_tracking) - while (kbd_fetch_ptr != kbd_store_ptr) - { - if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr = kbd_buffer; - - if (kbd_fetch_ptr->kind == mouse_click - || kbd_fetch_ptr->kind == scrollbar_click) - { - if ((kbd_fetch_ptr->modifiers & up_modifier) == 0) - break; - } - else - break; - - kbd_fetch_ptr++; - } - if (!EVENT_QUEUES_EMPTY) break; @@ -1608,36 +1812,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; - XSET (Vlast_event_screen, Lisp_Screen, kbd_fetch_ptr->screen); - 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)); + 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 + /* 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 + + /* 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) { - SCREEN_PTR screen; - Lisp_Object x, y, time; + FRAME_PTR f; + Lisp_Object bar_window; + enum scroll_bar_part part; + Lisp_Object x, y; + unsigned long time; - (*mouse_position_hook) (&screen, &x, &y, &time); - XSET (Vlast_event_screen, Lisp_Screen, screen); + (*mouse_position_hook) (&f, &bar_window, &part, &x, &y, &time); - obj = make_lispy_movement (screen, x, y, time); - } + obj = Qnil; + +#ifdef MULTI_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 + + /* 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; @@ -1648,6 +1950,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", @@ -1711,11 +2030,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[] = @@ -1723,9 +2046,35 @@ static char *lispy_mouse_names[] = "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5" }; +/* 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 +}; + + +/* 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 - movement buffer, which should have a movement event in it. */ + movement buffer, which should have a movement event in it. + + Note that events must be passed to this function in the order they + are received; this function stores the location of button presses + in order to build drag events when the button is released. */ static Lisp_Object make_lispy_event (event) @@ -1737,11 +2086,31 @@ make_lispy_event (event) switch (event->kind) #endif { - /* A simple keystroke. */ case ascii_keystroke: - return event->code; - break; + { + int c = XFASTINT (event->code); + /* Turn ASCII characters into control characters + when proper. */ + if (event->modifiers & ctrl_modifier) + { + if (c >= 0100 && c < 0140) + c &= ~040; + /* Include the bits for control and shift + only if the basic ASCII code can't indicate them. */ + c |= ctrl_modifier; + } + /* Set the shift modifier for a control char + made from a shifted letter. But only for letters! */ + if (XFASTINT (event->code) >= 'A' - 0100 + && XFASTINT (event->code) <= 'Z' - 0100 + && (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. */ @@ -1753,213 +2122,545 @@ make_lispy_event (event) / sizeof (lispy_function_keys[0]))); break; - /* A mouse click - build a list of the relevant information. */ + /* 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 = - window_from_coordinates (event->screen, - XINT (event->x), XINT (event->y), - &part); - Lisp_Object posn; - - if (XTYPE (window) != Lisp_Window) - posn = Qnil; - else + int button = XFASTINT (event->code); + Lisp_Object position; + Lisp_Object *start_pos_ptr; + Lisp_Object start_pos; + + if (button < 0 || button >= NUM_MOUSE_BUTTONS) + abort (); + + /* 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_split; + 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)))); + } + else + { + 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))))); } - return Fcons (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]))), - Fcons (window, - Fcons (posn, - Fcons (Fcons (event->x, event->y), - Fcons (make_number - (event->timestamp), - Qnil))))); - } + start_pos_ptr = &XVECTOR (button_down_location)->contents[button]; - /* 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 (SCREEN_SELECTED_WINDOW (event->screen), - Fcons (button, - Fcons (Fcons (event->x, event->y), - Fcons (make_number - (event->timestamp), - Qnil))))); - } + start_pos = *start_pos_ptr; + *start_pos_ptr = Qnil; - /* The 'kind' field of the event is something we don't recognize. */ - default: - abort(); + /* 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. */ + 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; +#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. */ + abort (); + + { + /* 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_pos, + Fcons (position, + Qnil))); + else + return Fcons (head, + Fcons (position, + Qnil)); + } + } + + /* The 'kind' field of the event is something we don't recognize. */ + default: + abort (); } } static Lisp_Object -make_lispy_movement (screen, x, y, time) - SCREEN_PTR screen; +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; - Lisp_Object time; -{ - Lisp_Object window; - int ix, iy; - Lisp_Object posn; - int part; - - ix = XINT (x); - iy = XINT (y); - window = (screen - ? window_from_coordinates (screen, ix, iy, &part) - : Qnil); - if (XTYPE (window) != Lisp_Window) - posn = Qnil; - else + unsigned long time; +{ + /* 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_split; - 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 (window, - Fcons (posn, - Fcons (Fcons (x, y), - Fcons (time, 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; - - if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } - if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } - if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } - if (modifiers & up_modifier) { *p++ = 'U'; *p++ = '-'; } - *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. - - 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->size && name->data[i + 1] == '-'; i += 2) + for (i = 0; i+2 <= name->size; ) switch (name->data[i]) { - case 'M': - not_canonical |= (modifiers & (meta_modifier|ctrl_modifier - |shift_modifier|up_modifier)); - modifiers |= meta_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': - not_canonical |= (modifiers & - (ctrl_modifier|shift_modifier|up_modifier)); - modifiers |= ctrl_modifier; + SINGLE_LETTER_MOD (ctrl_modifier); + break; + + case 'H': + SINGLE_LETTER_MOD (hyper_modifier); + break; + + case 'M': + SINGLE_LETTER_MOD (meta_modifier); break; case 'S': - not_canonical |= (modifiers & (shift_modifier|up_modifier)); - modifiers |= shift_modifier; + SINGLE_LETTER_MOD (shift_modifier); break; - case 'U': - not_canonical |= (modifiers & (up_modifier)); - modifiers |= up_modifier; + case 's': + SINGLE_LETTER_MOD (super_modifier); + break; + + case 'd': + if (i + 5 > name->size) + goto no_more_modifiers; + if (! strncmp (name->data + i, "drag-", 5)) + { + modifiers |= drag_modifier; + i += 5; + } + else if (! strncmp (name->data + i, "down-", 5)) + { + modifiers |= down_modifier; + i += 5; + } + else + goto no_more_modifiers; break; 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 ("C-M-S-U-")); - 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); } } +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])) + +static Lisp_Object modifier_symbols; + +/* 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; + + 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. @@ -1980,7 +2681,11 @@ reorder_modifiers (symbol) 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. */ + the returned symbol. + + The symbols we create are supposed to have an + `event-symbol-elements' propery, which lists the modifiers present + in the symbol's name. */ static Lisp_Object modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, @@ -1992,92 +2697,44 @@ modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, Lisp_Object *symbol_table; int table_size; { - Lisp_Object *slot, *unmodified_slot; + Lisp_Object *slot; /* Is this a request for a valid symbol? */ - if (symbol_num < 0 || symbol_num >= table_size - || modifiers >= NUM_MODIFIER_COMBOS) + if (symbol_num < 0 || symbol_num >= table_size) abort (); - /* If *symbol_table is not a vector of the appropriate size, - set it to one. */ + /* 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 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) - *symbol_table = Fmake_vector (make_number (table_size), Qnil); - - unmodified_slot = slot = & XVECTOR (*symbol_table)->contents[symbol_num]; - - /* If there are modifier keys, there had better be a vector in - this symbol's position of the symbol_table. */ - if (modifiers != 0) { - Lisp_Object slot_contents = *slot; - - /* If there isn't the right sort of vector there, put one in. */ - if (XTYPE (slot_contents) != Lisp_Vector - || XVECTOR (slot_contents)->size != NUM_MODIFIER_COMBOS) - { - *slot = Fmake_vector (make_number (NUM_MODIFIER_COMBOS), Qnil); + Lisp_Object size; - /* Make sure that the vector has an entry for the unmodified - symbol, so we can put it on the event_unmodified property. */ - if (! NILP (slot_contents)) - XVECTOR (*slot)->contents[0] = slot_contents; - else - XVECTOR (*slot)->contents[0] = intern (name_table [symbol_num]); - } + XFASTINT (size) = table_size; + *symbol_table = Fmake_vector (size, Qnil); } - /* If this entry has been filled in with a modified symbol vector, - point to the appropriate slot within that. */ - if (XTYPE (*slot) == Lisp_Vector) - { - unmodified_slot = & XVECTOR (*slot)->contents[0]; - slot = & XVECTOR (*slot)->contents[modifiers]; - } + slot = & XVECTOR (*symbol_table)->contents[symbol_num]; - /* Make sure we have an unmodified version of the symbol in its - proper place? */ - if (NILP (*unmodified_slot)) - { - *unmodified_slot = intern (name_table [symbol_num]); - Fput (*unmodified_slot, Qevent_kind, symbol_kind); - Fput (*unmodified_slot, Qevent_unmodified, *unmodified_slot); - } - - /* Have we already created a symbol for this combination of modifiers? */ + /* Have we already used this symbol before? */ if (NILP (*slot)) { - /* No, let's create one. */ - char *modified_name - = (char *) alloca (sizeof ("C-M-S-U-") - + strlen (name_table [symbol_num])); - - strcpy (modified_name + format_modifiers (modifiers, modified_name), - name_table [symbol_num]); + /* No; let's create it. */ + *slot = intern (name_table[symbol_num]); - *slot = intern (modified_name); + /* 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); - Fput (*slot, Qevent_unmodified, *unmodified_slot); } - - return *slot; -} - -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) @@ -2156,6 +2813,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; @@ -2201,8 +2861,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].screen = selected_screen; + 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 } } @@ -2224,6 +2894,7 @@ read_avail_input (expected) #ifdef SIGIO /* for entire page */ /* Note SIGIO has been undef'd if FIONREAD is missing. */ +SIGTYPE input_available_signal (signo) int signo; { @@ -2267,6 +2938,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. @@ -2287,58 +2974,244 @@ 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 - LOCAL and GLOBAL. + 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 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. */ Lisp_Object -read_char_menu_prompt (prompt, local, global) - int prompt; - Lisp_Object local, global; +read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) + int nmaps; + Lisp_Object *maps; + Lisp_Object prev_event; + int *used_mouse_menu; { - register Lisp_Object rest, name; - Lisp_Object hmap; + int mapno; + register Lisp_Object name; int nlength; - int width = SCREEN_WIDTH (selected_screen) - 4; - char *menu = (char *) alloca (width); + int width = FRAME_WIDTH (selected_frame) - 4; + char *menu = (char *) alloca (width + 4); + int idx = -1; + Lisp_Object rest, vector; + + if (used_mouse_menu) + *used_mouse_menu = 0; /* Use local over global Menu maps */ - if (menu_prompting) - return read_char (!prompt); - - /* We can't get prompt strings from dense keymaps. */ - if (CONSP (local) - && EQ (Fcar (local), Qkeymap) - && !(CONSP (XCONS (local)->cdr) - && XTYPE (XCONS (XCONS (local)->cdr)->car) == Lisp_Vector)) - hmap = local; - else if (CONSP (global) - && EQ (Fcar (global), Qkeymap) - && !(CONSP (XCONS (global)->cdr) - && XTYPE (XCONS (XCONS (global)->cdr)->car) == Lisp_Vector)) - hmap = global; - else - return read_char (!prompt); + if (! menu_prompting) + return Qnil; - /* Get the map's prompt string. */ - name = map_prompt (hmap); - if (NILP (name)) - return read_char (!prompt); + /* Get the menu name from the first map that has one (a prompt string). */ + for (mapno = 0; mapno < nmaps; mapno++) + { + name = map_prompt (maps[mapno]); + if (!NILP (name)) + break; + } + + /* If we don't have any menus, just read a character normally. */ + if (mapno >= nmaps) + return Qnil; + +#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 (EVENT_HAS_PARAMETERS (prev_event)) + { + /* Display the menu and get the selection. */ + Lisp_Object *realmaps + = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + Lisp_Object value; + int nmaps1 = 0; + + /* Use the maps that are not nil. */ + for (mapno = 0; mapno < nmaps; mapno++) + if (!NILP (maps[mapno])) + 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); + if (used_mouse_menu) + *used_mouse_menu = 1; + return value; + } +#endif /* HAVE_X_MENU */ +#endif /* HAVE_X_WINDOWS */ /* Prompt string always starts with map's prompt, and a space. */ strcpy (menu, XSTRING (name)->data); nlength = XSTRING (name)->size; + menu[nlength++] = ':'; menu[nlength++] = ' '; menu[nlength] = 0; - /* Start prompting at start of map. */ - rest = hmap; /* Current menu item */ + /* Start prompting at start of first map. */ + mapno = 0; + rest = maps[mapno]; /* Present the documented bindings, a line at a time. */ while (1) @@ -2348,67 +3221,104 @@ read_char_menu_prompt (prompt, local, global) Lisp_Object obj; int ch; - /* If reached end of map, start at beginning. */ - if (NILP (Fcdr (rest))) rest = hmap; - /* Loop over elements of map. */ - while (!NILP (rest) && i < width) + while (i < width) { - Lisp_Object s; + Lisp_Object s, elt; - /* Look for conses whose cadrs are strings. */ - s = Fcar_safe (Fcdr_safe (Fcar_safe (rest))); - if (XTYPE (s) != Lisp_String) - /* Ignore all other elements. */ - ; - /* If first such element, or enough room, add string to prompt. */ - else if (XSTRING (s)->size + i < width - || !notfirst) + /* If reached end of map, start at beginning of next map. */ + if (NILP (rest)) { - int thiswidth; - - /* Punctuate between strings. */ - if (notfirst) + mapno++; + /* At end of last map, wrap around to first map if just starting, + or end this line if already have something on it. */ + if (mapno == nmaps) { - strcpy (menu + i, ", "); - i += 2; + if (notfirst) + break; + else + mapno = 0; } - notfirst = 1; - - /* Add as much of string as fits. */ - thiswidth = XSTRING (s)->size; - if (thiswidth + i > width) - thiswidth = width - i; - bcopy (XSTRING (s)->data, menu + i, thiswidth); - i += thiswidth; + rest = maps[mapno]; } + + /* Look at the next element of the map. */ + if (idx >= 0) + elt = XVECTOR (vector)->contents[idx]; else + elt = Fcar_safe (rest); + + if (idx < 0 && XTYPE (elt) == Lisp_Vector) { - /* If some elts don't fit, show there are more. */ - strcpy (menu + i, "..."); - break; + /* If we found a dense table in the keymap, + advanced past it, but start scanning its contents. */ + rest = Fcdr_safe (rest); + vector = elt; + idx = 0; } + else + { + /* An ordinary element. */ + s = Fcar_safe (Fcdr_safe (elt)); + if (XTYPE (s) != Lisp_String) + /* Ignore the element if it has no prompt string. */ + ; + /* If we have room for the prompt string, add it to this line. + If this is the first on the line, always add it. */ + else if (XSTRING (s)->size + i < width + || !notfirst) + { + int thiswidth; - /* Move past this element. */ - rest = Fcdr_safe (rest); + /* Punctuate between strings. */ + if (notfirst) + { + strcpy (menu + i, ", "); + i += 2; + } + notfirst = 1; + + /* Add as much of string as fits. */ + thiswidth = XSTRING (s)->size; + if (thiswidth + i > width) + thiswidth = width - i; + bcopy (XSTRING (s)->data, menu + i, thiswidth); + i += thiswidth; + } + else + { + /* If this element does not fit, end the line now, + and save the element for the next line. */ + strcpy (menu + i, "..."); + break; + } + + /* Move past this element. */ + if (idx >= 0 && idx + 1 >= XVECTOR (rest)->size) + /* Handle reaching end of dense table. */ + idx = -1; + if (idx >= 0) + idx++; + else + rest = Fcdr_safe (rest); + } } /* Prompt with that and read response. */ message1 (menu); - obj = read_char (1); + obj = read_char (1, 0, 0, Qnil, 0); if (XTYPE (obj) != Lisp_Int) return obj; 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; } } - /* Reading key sequences. */ @@ -2426,6 +3336,9 @@ read_char_menu_prompt (prompt, local, global) case letter and there are bindings for the corresponding lower-case letter, return the bindings for the lower-case letter. + If KEY has no bindings in any of the CURRENT maps, NEXT is left + unmodified. + NEXT may == CURRENT. */ static int @@ -2438,25 +3351,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; @@ -2464,7 +3376,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; } @@ -2477,16 +3389,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; } @@ -2494,74 +3410,117 @@ 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 screens 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 screen 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; - /* current[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 *current; - /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in the current keymaps. */ Lisp_Object *defs; - /* 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 - input key. */ + /* 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, + 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 current[], keymap[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. */ + /* If the sequence is unbound in submaps[], then + 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; + + last_nonmenu_event = Qnil; + if (INTERACTIVE) { if (prompt) @@ -2570,131 +3529,366 @@ 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 of 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; nmaps = current_minor_maps (0, &maps) + 2; if (nmaps > nmaps_allocated) { - current = (Lisp_Object *) alloca (nmaps * sizeof (current[0])); + submaps = (Lisp_Object *) alloca (nmaps * sizeof (submaps[0])); defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0])); nmaps_allocated = nmaps; } - bcopy (maps, current, (nmaps - 2) * sizeof (current[0])); - current[nmaps-2] = last_event_buffer->keymap; - current[nmaps-1] = global_map; + bcopy (maps, submaps, (nmaps - 2) * sizeof (submaps[0])); +#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; } /* Find an accurate initial value for first_binding. */ for (first_binding = 0; first_binding < nmaps; first_binding++) - if (! NILP (current[first_binding])) + if (! NILP (submaps[first_binding])) break; - while ((first_binding < nmaps && ! NILP (current[first_binding])) + /* 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 reading keys stuffed into keybuf? */ + 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]; add_command_key (key); echo_char (key); } - /* Otherwise, we should actually read a character. */ + + /* If not, we should actually read a character. */ else { - struct buffer *buf; + last_real_key_start = t; - if (!prompt && INTERACTIVE) - key = read_char_menu_prompt (prompt, Qnil, Qnil); - else - key = read_char (!prompt); + 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; + if (XTYPE (key) == Lisp_Int && XINT (key) == -1) + { + t = 0; + goto done; + } Vquit_flag = Qnil; - /* What buffer was this event typed/moused at? */ - if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol) - buf = (XBUFFER - (XWINDOW - (SCREEN_SELECTED_WINDOW - (XSCREEN (Vlast_event_screen)))->buffer)); - else if (EVENT_HAS_PARAMETERS (key)) - { - Lisp_Object window = EVENT_WINDOW (key); - - if (NILP (window)) - abort (); - - 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_screen (Vlast_event_screen, Qnil); + Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key)); - /* Arrange to read key as the next event. */ - keybuf[0] = key; - mock_input = 1; + 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 go back to the original buffer once we're + done reading the key sequence. 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. We + don't want to do this at the top of the function, + because we may get input from a subprocess which + wants to change the selected window and stuff (say, + emacsclient). */ + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + + 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; + } + } } } + /* We have finally decided that KEY is something we might want + to look up. */ first_binding = (follow_key (key, nmaps - first_binding, - current + first_binding, + submaps + first_binding, defs + first_binding, - current + 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, + we don't update last_nonmenu_event; it continues to hold the mouse + event that preceded the first level of menu. */ + if (!used_mouse_menu) + last_nonmenu_event = key; /* If the sequence is unbound, see if we can hang a function key - off the end of it. Don't reread the expansion of 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-reading old events, don't examine it. */ if (first_binding >= nmaps - && t > mock_input) + && t >= mock_input) { Lisp_Object fkey_next; /* 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 (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_map, keybuf[fkey_end++])); - /* If keybuf[fkey_start..fkey_next] is bound in the + 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 - sequence (i.e. fkey_next == t), replace it with + sequence (i.e. fkey_end == t), replace it with the binding and restart with fkey_start at the end. */ if (XTYPE (fkey_next) == Lisp_Vector && fkey_end == t) @@ -2710,14 +3904,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. */ @@ -2734,6 +3924,9 @@ read_key_sequence (keybuf, bufsize, prompt) ? defs[first_binding] : Qnil); + done: + unread_switch_frame = delayed_switch_frame; + unbind_to (count, Qnil); return t; } @@ -2746,10 +3939,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 screens, switching between screens 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; { @@ -2765,14 +3978,14 @@ typed while in this function is treated like any other character, and\n\ GCPRO1 (keybuf[0]); gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0])); - if (! NILP (continue_echo)) + if (NILP (continue_echo)) 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, @@ -2843,111 +4056,6 @@ Otherwise, that is done only if an arg is read using the minibuffer.") return Qnil; } -#if 0 -DEFUN ("execute-mouse-event", Fexecute_mouse_event, Sexecute_mouse_event, - 1, 1, 0, - "Execute the definition of the mouse-click event EVENT.\n\ -The handler function is found by looking the event's key sequence up\n\ -in the buffer's local mouse map and in `global-mouse-map'.\n\ -\n\ -After running the handler, call the value of `mouse-event-function'\n\ -with EVENT as arg.") - (event) - Lisp_Object event; -{ - Lisp_Object tem; - Lisp_Object mouse_cmd; - Lisp_Object keyseq, window, screen_part, pos, time; - -#ifndef HAVE_X11 - Vmouse_event = event; -#endif - - if (EQ (event, Qnil)) - { - bitch_at_user (); - return Qnil; - } - - CHECK_CONS (event, 0); - pos = Fcar (event); - window = Fcar (Fcdr (event)); - screen_part = Fcar (Fcdr (Fcdr (event))); - keyseq = Fcar (Fcdr (Fcdr (Fcdr (event)))); - time = Fcar (Fcdr (Fcdr (Fcdr (Fcdr (event))))); - CHECK_STRING (keyseq, 0); - CHECK_WINDOW (window, 0); - - /* Look up KEYSEQ in the buffer's local mouse map, then in global one. */ - - mouse_cmd = Qnil; - - if (!NILP (XWINDOW (window)->buffer)) - { - Lisp_Object local_map; - - local_map = XBUFFER (XWINDOW (window)->buffer)->mouse_map; - tem = Fkeymapp (local_map); - if (!NILP (tem)) - mouse_cmd = Flookup_key (local_map, keyseq); - /* A number as value means the key is too long; treat as undefined. */ - if (XTYPE (mouse_cmd) == Lisp_Int) - mouse_cmd = Qnil; - } - - tem = Fkeymapp (Vglobal_mouse_map); - if (NILP (mouse_cmd) && !NILP (tem)) - mouse_cmd = Flookup_key (Vglobal_mouse_map, keyseq); - if (XTYPE (mouse_cmd) == Lisp_Int) - mouse_cmd = Qnil; - - if (NILP (mouse_cmd)) - { - /* This button/shift combination is not defined. - If it is a button-down event, ring the bell. */ -#ifdef HAVE_X11 - if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 0x18 == 0) -#else - if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 4 == 0) -#endif - bitch_at_user (); - } - else - { - SCREEN_PTR s = XSCREEN (WINDOW_SCREEN (XWINDOW (window))); - -#ifndef HAVE_X11 - Vmouse_window = s->selected_window; -#endif /* HAVE_X11 */ - /* It's defined; call the definition. */ - Vprefix_arg = Qnil; - if (!NILP (screen_part)) - { - /* For a scroll-bar click, set the prefix arg - to the number of lines down from the top the click was. - Many scroll commands want to scroll by this many lines. */ - Lisp_Object position; - Lisp_Object length; - Lisp_Object offset; - - position = Fcar (pos); - length = Fcar (Fcdr (pos)); - offset = Fcar (Fcdr (Fcdr (pos))); - - if (XINT (length) != 0) - XSET (Vprefix_arg, Lisp_Int, - (SCREEN_HEIGHT (s) * (XINT (position) + XINT (offset)) - / (XINT (length) + 2 * XINT (offset)))); - } - Fcommand_execute (mouse_cmd, Qnil); - } - - if (!NILP (Vmouse_event_function)) /* Not `event' so no need for GCPRO */ - call1 (Vmouse_event_function, Vmouse_event); - return Qnil; -} -#endif - DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, 1, 1, "P", "Read function name, then read its arguments and call it.") @@ -3014,7 +4122,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; @@ -3043,27 +4151,28 @@ 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 a vector of last 100 events read from terminal.") + "Return vector of last 100 events, not counting those from keyboard macros.") () { + Lisp_Object *keys = XVECTOR (recent_keys)->contents; Lisp_Object val; if (total_keys < NUM_RECENT_KEYS) - return Fvector (total_keys, recent_keys); + return Fvector (total_keys, keys); else { - val = Fvector (NUM_RECENT_KEYS, recent_keys); - bcopy (recent_keys + recent_keys_index, + val = Fvector (NUM_RECENT_KEYS, keys); + bcopy (keys + recent_keys_index, XVECTOR (val)->contents, (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object)); - bcopy (recent_keys, + bcopy (keys, XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index, recent_keys_index * sizeof (Lisp_Object)); return val; @@ -3071,10 +4180,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, @@ -3088,7 +4199,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; { @@ -3113,14 +4225,16 @@ Also cancel any kbd macro being defined.") defining_kbd_macro = 0; update_mode_lines++; -#if 0 - unread_command_char = make_number (-1); -#endif - 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; @@ -3130,37 +4244,34 @@ 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")); - get_screen_size (&old_width, &old_height); + 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 and the system resources aren't available for that. */ @@ -3172,12 +4283,11 @@ On such systems, Emacs will start a subshell and wait for it to exit.") /* Check if terminal/window size has changed. Note that this is not useful when we are running directly with a window system; but suspend should be disabled in that case. */ - get_screen_size (&width, &height); + get_frame_size (&width, &height); if (width != old_width || height != old_height) - change_screen_size (height, width, 0); + 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")); @@ -3213,6 +4323,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; @@ -3266,7 +4380,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; @@ -3277,7 +4390,7 @@ interrupt_signal () cancel_echoing (); - if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen)) + if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame)) { fflush (stdout); reset_sys_modes (); @@ -3356,10 +4469,14 @@ quit_throw_to_read_char () clear_waiting_for_input (); input_pending = 0; -#if 0 - unread_command_char = make_number (-1); + 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 - unread_command_char = Qnil; _longjmp (getcjmp, 1); } @@ -3370,8 +4487,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; @@ -3398,7 +4516,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); @@ -3406,29 +4529,67 @@ 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; - recent_keys_index = 0; + unread_command_events = Qnil; + unread_command_char = -1; total_keys = 0; + recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer; 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); @@ -3436,7 +4597,7 @@ init_keyboard () /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef SIGIO signal (SIGIO, input_available_signal); -#endif SIGIO +#endif /* SIGIO */ } /* Use interrupt input by default, if it works and noninterrupt input @@ -3474,15 +4635,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 () @@ -3499,22 +4654,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_split = intern ("vertical-split"); - staticpro (&Qvertical_split); - - Qevent_kind = intern ("event-type"); + Qvertical_line = intern ("vertical-line"); + staticpro (&Qvertical_line); + 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_unmodified = intern ("event-unmodified"); - staticpro (&Qevent_unmodified); + 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; @@ -3526,20 +4708,46 @@ syms_of_keyboard () *p->var = intern (p->name); staticpro (p->var); Fput (*p->var, Qevent_kind, *p->kind); - Fput (*p->var, Qevent_unmodified, *p->var); + Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil)); } } + button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil); + staticpro (&button_down_location); + + { + int i; + int len = sizeof (modifier_names) / sizeof (modifier_names[0]); + + modifier_symbols = Fmake_vector (make_number (len), Qnil); + for (i = 0; i < len; 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); @@ -3552,20 +4760,36 @@ 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, "Value is called instead of any command that is disabled\n\ -(has a non-nil `disabled' property)."); +\(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 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-char", &unread_command_char, - "Object to be read as next input from input stream, or nil if none."); + DEFVAR_LISP ("unread-command-events", &unread_command_events, + "List of objects to be read as next command input events."); + + 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\ @@ -3611,9 +4835,12 @@ Polling is automatically disabled in all other cases."); "*Number of complete keys read from the keyboard so far."); num_input_keys = 0; - DEFVAR_LISP ("last-event-screen", &Vlast_event_screen, - "*The screen in which the most recently read event occurred."); - Vlast_event_screen = Qnil; +#ifdef MULTI_FRAME + DEFVAR_LISP ("last-event-frame", &Vlast_event_frame, + "*The frame in which the most recently read event occurred.\n\ +If the last event came from a keyboard macro, this is set to `macro'."); + Vlast_event_frame = Qnil; +#endif DEFVAR_LISP ("help-char", &help_char, "Character to recognize as meaning Help.\n\ @@ -3638,40 +4865,52 @@ Each character is looked up in this string and the contents used instead.\n\ If string is of length N, character codes N and up are untranslated."); Vkeyboard_translate_table = Qnil; -#ifdef HAVE_X_WINDOWS - DEFVAR_LISP ("mouse-event-function", &Vmouse_event_function, - "Function to call for each mouse event, after the event's definition.\n\ -Called, if non-nil, with one argument, which is the event-list.\n\ -See the variable `mouse-event' for the format of this list."); - Vmouse_event_function = Qnil; - - DEFVAR_LISP ("mouse-left-hook", &Vmouse_left_hook, - "Function to call when mouse leaves window. No arguments."); - Vmouse_left_hook = Qnil; - - DEFVAR_LISP ("map-screen-hook", &Vmap_screen_hook, - "Function to call when screen is mapped. No arguments."); - Vmap_screen_hook = Qnil; - - DEFVAR_LISP ("unmap-screen-hook", &Vunmap_screen_hook, - "Function to call when screen is unmapped. No arguments."); - Vunmap_screen_hook = Qnil; - - DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler, - "Handler for motion events. No arguments."); - Vmouse_motion_handler = Qnil; -#endif - DEFVAR_BOOL ("menu-prompting", &menu_prompting, - "Non-nil means prompt with menus in echo area when appropriate.\n\ + "Non-nil means prompt with menus when appropriate.\n\ This is done when reading from a keymap that has a prompt string,\n\ -for elements that have prompt strings."); +for elements that have prompt strings.\n\ +The menu is displayed on the screen\n\ +if X menus were enabled at configuration\n\ +time and the previous event was a mouse click prefix key.\n\ +Otherwise, menu prompting uses the echo area."); menu_prompting = 1; DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char, "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 ()