comparison src/event-stream.c @ 185:3d6bfa290dbd r20-3b19

Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents bfd6434d15b3
children b405438285a2
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
31 * If you ever change ANYTHING in this file, you MUST run the 31 * If you ever change ANYTHING in this file, you MUST run the
32 * testcases at the end to make sure that you haven't changed 32 * testcases at the end to make sure that you haven't changed
33 * the semantics of recent-keys, last-input-char, or keyboard 33 * the semantics of recent-keys, last-input-char, or keyboard
34 * macros. You'd be surprised how easy it is to break this. 34 * macros. You'd be surprised how easy it is to break this.
35 * 35 *
36 */
37
38 /* TODO:
39 This stuff is way too hard to maintain - needs rework.
40
41 (global-set-key "\C-p" global-map) causes a crash - need recursion check.
42
43 C-x @ h <scrollbar-drag> x causes a crash.
44
45 The command builder should deal only with key and button events.
46 Other command events should be able to come in the MIDDLE of a key
47 sequence, without disturbing the key sequence composition, or the
48 command builder structure representing it.
49
50 Someone should rethink univeral-argument and figure out how an
51 arbitrary command can influence the next command (universal-argument
52 or univeral-coding-system-argument) or the next key (hyperify).
53
54 Both C-h and Help in the middle of a key sequence should trigger
55 prefix-help-command. help-char is stupid. Maybe we need
56 keymap-of-last-resort?
57
58 After prefix-help is run, one should be able to CONTINUE TYPING,
59 instead of RETYPING, the key sequence.
36 */ 60 */
37 61
38 #include <config.h> 62 #include <config.h>
39 #include "lisp.h" 63 #include "lisp.h"
40 64
151 Lisp_Object Vlast_selected_frame; 175 Lisp_Object Vlast_selected_frame;
152 176
153 /* The buffer that was current when the last command was started. */ 177 /* The buffer that was current when the last command was started. */
154 Lisp_Object last_point_position_buffer; 178 Lisp_Object last_point_position_buffer;
155 179
156 /* A (16bit . 16bit) representation of the time of the last-command-event. 180 /* A (16bit . 16bit) representation of the time of the last-command-event. */
157 */
158 Lisp_Object Vlast_input_time; 181 Lisp_Object Vlast_input_time;
159 182
160 /* Character to recognize as the help char. */ 183 /* Character to recognize as the help char. */
161 Lisp_Object Vhelp_char; 184 Lisp_Object Vhelp_char;
162 185
163 /* Form to execute when help char is typed. */ 186 /* Form to execute when help char is typed. */
164 Lisp_Object Vhelp_form; 187 Lisp_Object Vhelp_form;
188
189 /* Command to run when the help character follows a prefix key. */
190 Lisp_Object Vprefix_help_command;
165 191
166 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress) 192 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
167 may have happened. */ 193 may have happened. */
168 volatile int something_happened; 194 volatile int something_happened;
169
170 /* Command to run when the help character follows a prefix key. */
171 Lisp_Object Vprefix_help_command;
172 195
173 /* Hash table to translate keysyms through */ 196 /* Hash table to translate keysyms through */
174 Lisp_Object Vkeyboard_translate_table; 197 Lisp_Object Vkeyboard_translate_table;
175 198
176 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */ 199 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
228 /* this is in keymap.c */ 251 /* this is in keymap.c */
229 extern Lisp_Object Fmake_keymap (Lisp_Object name); 252 extern Lisp_Object Fmake_keymap (Lisp_Object name);
230 253
231 #ifdef DEBUG_XEMACS 254 #ifdef DEBUG_XEMACS
232 int debug_emacs_events; 255 int debug_emacs_events;
256
257 static void
258 external_debugging_print_event (char *event_description, Lisp_Object event)
259 {
260 write_c_string ("(", Qexternal_debugging_output);
261 write_c_string (event_description, Qexternal_debugging_output);
262 write_c_string (") ", Qexternal_debugging_output);
263 print_internal (event, Qexternal_debugging_output, 1);
264 write_c_string ("\n", Qexternal_debugging_output);
265 }
266 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
267 if (debug_emacs_events) \
268 external_debugging_print_event (event_description, event); \
269 } while (0)
270 #else
271 #define DEBUG_PRINT_EMACS_EVENT(string, event)
233 #endif 272 #endif
234 273
235 274
236 /* The callback routines for the window system or terminal driver */ 275 /* The callback routines for the window system or terminal driver */
237 struct event_stream *event_stream; 276 struct event_stream *event_stream;
238 277
239 /* This structure is what we use to excapsulate the state of a command sequence 278 /* This structure is what we use to encapsulate the state of a command sequence
240 being composed; key events are executed by adding themselves to the command 279 being composed; key events are executed by adding themselves to the command
241 builder; if the command builder is then complete (does not still represent 280 builder; if the command builder is then complete (does not still represent
242 a prefix key sequence) it executes the corresponding command. 281 a prefix key sequence) it executes the corresponding command.
243 */ 282 */
244 struct command_builder 283 struct command_builder
254 * keymap-lookup sequence. Subsequent events are threaded via 293 * keymap-lookup sequence. Subsequent events are threaded via
255 * the event's next slot */ 294 * the event's next slot */
256 Lisp_Object current_events; 295 Lisp_Object current_events;
257 /* Last elt of above */ 296 /* Last elt of above */
258 Lisp_Object most_current_event; 297 Lisp_Object most_current_event;
259 /* Last elt before function map code took over. 298 /* Last elt before function map code took over. What this means is:
260 What this means is: All prefixes up to (but not including) 299 All prefixes up to (but not including) this event have non-nil
261 this event have non-nil bindings, but the prefix including 300 bindings, but the prefix including this event has a nil binding.
262 this event has a nil binding. Any events in the chain after 301 Any events in the chain after this one were read solely because
263 this one were read solely because we're part of a possible 302 we're part of a possible function key. If we end up with
264 function key. If we end up with something that's not part 303 something that's not part of a possible function key, we have to
265 of a possible function key, we have to unread all of those 304 unread all of those events. */
266 events. */
267 Lisp_Object last_non_munged_event; 305 Lisp_Object last_non_munged_event;
268 /* One set of values for function-key-map, one for key-translation-map */ 306 /* One set of values for function-key-map, one for key-translation-map */
269 struct munging_key_translation 307 struct munging_key_translation
270 { 308 {
271 /* First event that can begin a possible function key sequence 309 /* First event that can begin a possible function key sequence
272 (to be translated according to function-key-map). Normally 310 (to be translated according to function-key-map). Normally
273 this is the first event in the chain. However, once we've 311 this is the first event in the chain. However, once we've
274 translated a sequence through function-key-map, this will 312 translated a sequence through function-key-map, this will point
275 point to the first event after the translated sequence: 313 to the first event after the translated sequence: we don't ever
276 we don't ever want to translate any events twice through 314 want to translate any events twice through function-key-map, or
277 function-key-map, or things could get really screwed up 315 things could get really screwed up (e.g. if the user created a
278 (e.g. if the user created a translation loop). If this 316 translation loop). If this is nil, then the next-read event is
279 is nil, then the next-read event is the first that can 317 the first that can begin a function key sequence. */
280 begin a function key sequence. */ 318 Lisp_Object first_mungeable_event;
281 Lisp_Object first_mungeable_event; 319 } munge_me[2];
282 } munge_me[2];
283 320
284 Bufbyte *echo_buf; 321 Bufbyte *echo_buf;
285 Bytecount echo_buf_length; /* size of echo_buf */ 322 Bytecount echo_buf_length; /* size of echo_buf */
286 Bytecount echo_buf_index; /* index into echo_buf 323 Bytecount echo_buf_index; /* index into echo_buf
287 * -1 before doing echoing for new cmd */ 324 * -1 before doing echoing for new cmd */
359 } 396 }
360 397
361 static void 398 static void
362 finalize_command_builder (void *header, int for_disksave) 399 finalize_command_builder (void *header, int for_disksave)
363 { 400 {
364 struct command_builder *c = (struct command_builder *) header;
365
366 if (!for_disksave) 401 if (!for_disksave)
367 { 402 {
368 xfree (c->echo_buf); 403 xfree (((struct command_builder *) header)->echo_buf);
369 c->echo_buf = 0; 404 ((struct command_builder *) header)->echo_buf = 0;
370 } 405 }
371 } 406 }
372 407
373 static void 408 static void
374 reset_command_builder_event_chain (struct command_builder *builder) 409 reset_command_builder_event_chain (struct command_builder *builder)
384 Lisp_Object 419 Lisp_Object
385 allocate_command_builder (Lisp_Object console) 420 allocate_command_builder (Lisp_Object console)
386 { 421 {
387 Lisp_Object builder_obj = Qnil; 422 Lisp_Object builder_obj = Qnil;
388 struct command_builder *builder = 423 struct command_builder *builder =
389 alloc_lcrecord (sizeof (struct command_builder), 424 alloc_lcrecord_type (struct command_builder, lrecord_command_builder);
390 lrecord_command_builder);
391 425
392 builder->console = console; 426 builder->console = console;
393 reset_command_builder_event_chain (builder); 427 reset_command_builder_event_chain (builder);
394 builder->echo_buf_length = 300; /* #### Kludge */ 428 builder->echo_buf_length = 300; /* #### Kludge */
395 builder->echo_buf = 429 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
396 (Bufbyte *) xmalloc (builder->echo_buf_length);
397 builder->echo_buf[0] = 0; 430 builder->echo_buf[0] = 0;
398 builder->echo_buf_index = -1; 431 builder->echo_buf_index = -1;
399 builder->echo_buf_index = -1; 432 builder->echo_buf_index = -1;
400 builder->self_insert_countdown = 0; 433 builder->self_insert_countdown = 0;
401 434
508 the SIGINT signal handler will be called. It will 541 the SIGINT signal handler will be called. It will
509 set Vquit_flag and write a byte on our "fake pipe", 542 set Vquit_flag and write a byte on our "fake pipe",
510 which will unblock us. */ 543 which will unblock us. */
511 if (maybe_read_quit_event (event)) 544 if (maybe_read_quit_event (event))
512 { 545 {
513 #ifdef DEBUG_XEMACS 546 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
514 if (debug_emacs_events)
515 {
516 write_c_string ("(SIGINT) ",
517 Qexternal_debugging_output);
518 print_internal (event_obj, Qexternal_debugging_output, 1);
519 write_c_string ("\n", Qexternal_debugging_output);
520 }
521 #endif
522 return; 547 return;
523 } 548 }
524 549
525 /* If a longjmp() happens in the callback, we're screwed. 550 /* If a longjmp() happens in the callback, we're screwed.
526 Let's hope it doesn't. I think the code here is fairly 551 Let's hope it doesn't. I think the code here is fairly
536 init_poll_for_quit (); 561 init_poll_for_quit ();
537 #endif 562 #endif
538 emacs_is_blocking = 0; 563 emacs_is_blocking = 0;
539 564
540 #ifdef DEBUG_XEMACS 565 #ifdef DEBUG_XEMACS
541 if (debug_emacs_events) 566 /* timeout events have more info set later, so
542 { 567 print the event out in next_event_internal(). */
543 write_c_string ("(real) ", 568 if (event->event_type != timeout_event)
544 Qexternal_debugging_output); 569 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
545 /* timeout events have more info set later, so
546 print the event out in next_event_internal(). */
547 if (event->event_type != timeout_event)
548 {
549 print_internal (event_obj, Qexternal_debugging_output, 1);
550 write_c_string ("\n", Qexternal_debugging_output);
551 }
552 }
553 #endif 570 #endif
554 maybe_kbd_translate (event_obj); 571 maybe_kbd_translate (event_obj);
555 } 572 }
556 573
557 void 574 void
775 did_translate = 1; 792 did_translate = 1;
776 } 793 }
777 } 794 }
778 795
779 #ifdef DEBUG_XEMACS 796 #ifdef DEBUG_XEMACS
780 if (did_translate && debug_emacs_events) 797 if (did_translate)
781 { 798 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
782 write_c_string ("(->keyboard-translate-table) ",
783 Qexternal_debugging_output);
784 print_internal (event, Qexternal_debugging_output, 1);
785 write_c_string ("\n", Qexternal_debugging_output);
786 }
787 #endif 799 #endif
788 } 800 }
789 801
790 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and 802 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
791 keystrokes_since_auto_save is equivalent to the difference between 803 keystrokes_since_auto_save is equivalent to the difference between
1153 int id; 1165 int id;
1154 1166
1155 GCPRO1 (op); /* just in case ... because it's removed from the list 1167 GCPRO1 (op); /* just in case ... because it's removed from the list
1156 for awhile. */ 1168 for awhile. */
1157 1169
1158 if (async_p) 1170 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1159 timeout_list = &pending_async_timeout_list;
1160 else
1161 timeout_list = &pending_timeout_list;
1162 1171
1163 /* Find the timeout on the list of pending ones. */ 1172 /* Find the timeout on the list of pending ones. */
1164 LIST_LOOP (rest, *timeout_list) 1173 LIST_LOOP (rest, *timeout_list)
1165 { 1174 {
1166 timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); 1175 timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
1532 } 1541 }
1533 1542
1534 void 1543 void
1535 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object) 1544 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1536 { 1545 {
1537 Lisp_Object event; 1546 Lisp_Object event = Fmake_event ();
1538
1539 event = Fmake_event ();
1540 1547
1541 XEVENT (event)->event_type = magic_eval_event; 1548 XEVENT (event)->event_type = magic_eval_event;
1542 /* channel for magic_eval events is nil */ 1549 /* channel for magic_eval events is nil */
1543 XEVENT (event)->event.magic_eval.internal_function = fun; 1550 XEVENT (event)->event.magic_eval.internal_function = fun;
1544 XEVENT (event)->event.magic_eval.object = object; 1551 XEVENT (event)->event.magic_eval.object = object;
1552 See `next-event' for a description of event types and how events 1559 See `next-event' for a description of event types and how events
1553 are received. 1560 are received.
1554 */ 1561 */
1555 (function, object)) 1562 (function, object))
1556 { 1563 {
1557 Lisp_Object event; 1564 Lisp_Object event = Fmake_event ();
1558
1559 event = Fmake_event ();
1560 1565
1561 XEVENT (event)->event_type = eval_event; 1566 XEVENT (event)->event_type = eval_event;
1562 /* channel for eval events is nil */ 1567 /* channel for eval events is nil */
1563 XEVENT (event)->event.eval.function = function; 1568 XEVENT (event)->event.eval.function = function;
1564 XEVENT (event)->event.eval.object = object; 1569 XEVENT (event)->event.eval.object = object;
1569 1574
1570 Lisp_Object 1575 Lisp_Object
1571 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, 1576 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1572 Lisp_Object object) 1577 Lisp_Object object)
1573 { 1578 {
1574 Lisp_Object event; 1579 Lisp_Object event = Fmake_event ();
1575
1576 event = Fmake_event ();
1577 1580
1578 XEVENT (event)->event_type = misc_user_event; 1581 XEVENT (event)->event_type = misc_user_event;
1579 XEVENT (event)->channel = channel; 1582 XEVENT (event)->channel = channel;
1580 XEVENT (event)->event.eval.function = function; 1583 XEVENT (event)->event.eval.function = function;
1581 XEVENT (event)->event.eval.object = object; 1584 XEVENT (event)->event.eval.object = object;
1882 in_single_console_state (void) 1885 in_single_console_state (void)
1883 { 1886 {
1884 return in_single_console; 1887 return in_single_console;
1885 } 1888 }
1886 1889
1887 /* the number of keyboard characters read. callint.c wants this. 1890 /* the number of keyboard characters read. callint.c wants this. */
1888 */
1889 Charcount num_input_chars; 1891 Charcount num_input_chars;
1890 1892
1891 static void 1893 static void
1892 next_event_internal (Lisp_Object target_event, int allow_queued) 1894 next_event_internal (Lisp_Object target_event, int allow_queued)
1893 { 1895 {
1903 if (allow_queued && !NILP (command_event_queue)) 1905 if (allow_queued && !NILP (command_event_queue))
1904 { 1906 {
1905 Lisp_Object event = dequeue_command_event (); 1907 Lisp_Object event = dequeue_command_event ();
1906 Fcopy_event (event, target_event); 1908 Fcopy_event (event, target_event);
1907 Fdeallocate_event (event); 1909 Fdeallocate_event (event);
1908 #ifdef DEBUG_XEMACS 1910 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
1909 if (debug_emacs_events)
1910 {
1911 write_c_string ("(command event queue) ",
1912 Qexternal_debugging_output);
1913 print_internal (target_event, Qexternal_debugging_output, 1);
1914 write_c_string ("\n", Qexternal_debugging_output);
1915 }
1916 #endif
1917 } 1911 }
1918 else 1912 else
1919 { 1913 {
1920 struct Lisp_Event *e = XEVENT (target_event); 1914 struct Lisp_Event *e = XEVENT (target_event);
1921 1915
1932 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0, 1926 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
1933 &tristan, &isolde); 1927 &tristan, &isolde);
1934 1928
1935 e->event.timeout.function = tristan; 1929 e->event.timeout.function = tristan;
1936 e->event.timeout.object = isolde; 1930 e->event.timeout.object = isolde;
1937 #ifdef DEBUG_XEMACS
1938 /* next_event_internal() doesn't print out timeout events 1931 /* next_event_internal() doesn't print out timeout events
1939 because of the extra info we just set. */ 1932 because of the extra info we just set. */
1940 if (debug_emacs_events) 1933 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
1941 {
1942 print_internal (target_event, Qexternal_debugging_output, 1);
1943 write_c_string ("\n", Qexternal_debugging_output);
1944 }
1945 #endif
1946 } 1934 }
1947 1935
1948 /* If we read a ^G, then set quit-flag but do not discard the ^G. 1936 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1949 The callers of next_event_internal() will do one of two things: 1937 The callers of next_event_internal() will do one of two things:
1950 1938
1983 1971
1984 DEFUN ("next-event", Fnext_event, 0, 2, 0, /* 1972 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
1985 Return the next available event. 1973 Return the next available event.
1986 Pass this object to `dispatch-event' to handle it. 1974 Pass this object to `dispatch-event' to handle it.
1987 In most cases, you will want to use `next-command-event', which returns 1975 In most cases, you will want to use `next-command-event', which returns
1988 the next available \"user\" event (i.e. keypress, button-press, 1976 the next available "user" event (i.e. keypress, button-press,
1989 button-release, or menu selection) instead of this function. 1977 button-release, or menu selection) instead of this function.
1990 1978
1991 If EVENT is non-nil, it should be an event object and will be filled in 1979 If EVENT is non-nil, it should be an event object and will be filled in
1992 and returned; otherwise a new event object will be created and returned. 1980 and returned; otherwise a new event object will be created and returned.
1993 If PROMPT is non-nil, it should be a string and will be displayed in the 1981 If PROMPT is non-nil, it should be a string and will be displayed in the
2012 -- a timeout event, meaning that a timeout has elapsed. 2000 -- a timeout event, meaning that a timeout has elapsed.
2013 -- an eval event, which simply causes a function to be executed when the 2001 -- an eval event, which simply causes a function to be executed when the
2014 event is dispatched. Eval events are generated by `enqueue-eval-event' 2002 event is dispatched. Eval events are generated by `enqueue-eval-event'
2015 or by certain other conditions happening. 2003 or by certain other conditions happening.
2016 -- a magic event, indicating that some window-system-specific event 2004 -- a magic event, indicating that some window-system-specific event
2017 happened (such as an focus-change notification) that must be handled 2005 happened (such as a focus-change notification) that must be handled
2018 synchronously with other events. `dispatch-event' knows what to do with 2006 synchronously with other events. `dispatch-event' knows what to do with
2019 these events. 2007 these events.
2020 */ 2008 */
2021 (event, prompt)) 2009 (event, prompt))
2022 { 2010 {
2099 signal_error (Qwrong_type_argument, 2087 signal_error (Qwrong_type_argument,
2100 list3 (Qcommand_event_p, e, Qunread_command_events)); 2088 list3 (Qcommand_event_p, e, Qunread_command_events));
2101 redisplay (); 2089 redisplay ();
2102 if (!EQ (e, event)) 2090 if (!EQ (e, event))
2103 Fcopy_event (e, event); 2091 Fcopy_event (e, event);
2104 #ifdef DEBUG_XEMACS 2092 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2105 if (debug_emacs_events) 2093 }
2106 { 2094 }
2107 write_c_string ("(unread-command-events) ", 2095
2108 Qexternal_debugging_output); 2096 /* Do similar for unread-command-event (obsoleteness support). */
2109 print_internal (event, Qexternal_debugging_output, 1);
2110 write_c_string ("\n", Qexternal_debugging_output);
2111 }
2112 #endif
2113 }
2114 }
2115
2116 /* Do similar for unread-command-event (obsoleteness support).
2117 */
2118 else if (!NILP (Vunread_command_event)) 2097 else if (!NILP (Vunread_command_event))
2119 { 2098 {
2120 Lisp_Object e = Vunread_command_event; 2099 Lisp_Object e = Vunread_command_event;
2121 Vunread_command_event = Qnil; 2100 Vunread_command_event = Qnil;
2122 2101
2126 list3 (Qeventp, e, Qunread_command_event)); 2105 list3 (Qeventp, e, Qunread_command_event));
2127 } 2106 }
2128 if (!EQ (e, event)) 2107 if (!EQ (e, event))
2129 Fcopy_event (e, event); 2108 Fcopy_event (e, event);
2130 redisplay (); 2109 redisplay ();
2131 #ifdef DEBUG_XEMACS 2110 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2132 if (debug_emacs_events)
2133 {
2134 write_c_string ("(unread-command-event) ",
2135 Qexternal_debugging_output);
2136 print_internal (event, Qexternal_debugging_output, 1);
2137 write_c_string ("\n", Qexternal_debugging_output);
2138 }
2139 #endif
2140 } 2111 }
2141 2112
2142 /* If we're executing a keyboard macro, take the next event from that, 2113 /* If we're executing a keyboard macro, take the next event from that,
2143 and update this-command-keys and recent-keys. 2114 and update this-command-keys and recent-keys.
2144 Note that the unread-command-events take precedence over kbd macros. 2115 Note that the unread-command-events take precedence over kbd macros.
2149 { 2120 {
2150 redisplay (); 2121 redisplay ();
2151 pop_kbd_macro_event (event); /* This throws past us at 2122 pop_kbd_macro_event (event); /* This throws past us at
2152 end-of-macro. */ 2123 end-of-macro. */
2153 store_this_key = 1; 2124 store_this_key = 1;
2154 #ifdef DEBUG_XEMACS 2125 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2155 if (debug_emacs_events)
2156 {
2157 write_c_string ("(keyboard macro) ",
2158 Qexternal_debugging_output);
2159 print_internal (event, Qexternal_debugging_output, 1);
2160 write_c_string ("\n", Qexternal_debugging_output);
2161 }
2162 #endif
2163 } 2126 }
2164 /* Otherwise, read a real event, possibly from the 2127 /* Otherwise, read a real event, possibly from the
2165 command_event_queue, and update this-command-keys and 2128 command_event_queue, and update this-command-keys and
2166 recent-keys. */ 2129 recent-keys. */
2167 else 2130 else
2243 { 2206 {
2244 EMACS_TIME t; 2207 EMACS_TIME t;
2245 EMACS_GET_TIME (t); 2208 EMACS_GET_TIME (t);
2246 if (!CONSP (Vlast_input_time)) 2209 if (!CONSP (Vlast_input_time))
2247 Vlast_input_time = Fcons (Qnil, Qnil); 2210 Vlast_input_time = Fcons (Qnil, Qnil);
2248 XCAR (Vlast_input_time) 2211 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2249 = make_int ((EMACS_SECS (t) >> 16) & 0xffff); 2212 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2250 XCDR (Vlast_input_time)
2251 = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2252 } 2213 }
2253 2214
2254 /* If this key came from the keyboard or from a keyboard macro, then 2215 /* If this key came from the keyboard or from a keyboard macro, then
2255 it goes into the recent-keys and this-command-keys vectors. 2216 it goes into the recent-keys and this-command-keys vectors.
2256 If this key came from the keyboard, and we're defining a keyboard 2217 If this key came from the keyboard, and we're defining a keyboard
2282 UNGCPRO; 2243 UNGCPRO;
2283 return event; 2244 return event;
2284 } 2245 }
2285 2246
2286 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /* 2247 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2287 Return the next available \"user\" event. 2248 Return the next available "user" event.
2288 Pass this object to `dispatch-event' to handle it. 2249 Pass this object to `dispatch-event' to handle it.
2289 2250
2290 If EVENT is non-nil, it should be an event object and will be filled in 2251 If EVENT is non-nil, it should be an event object and will be filled in
2291 and returned; otherwise a new event object will be created and returned. 2252 and returned; otherwise a new event object will be created and returned.
2292 If PROMPT is non-nil, it should be a string and will be displayed in the 2253 If PROMPT is non-nil, it should be a string and will be displayed in the
2334 if (EVENTP (event)) 2295 if (EVENTP (event))
2335 deallocate_event_chain (event); 2296 deallocate_event_chain (event);
2336 } 2297 }
2337 2298
2338 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* 2299 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2339 Discard any pending \"user\" events. 2300 Discard any pending "user" events.
2340 Also cancel any kbd macro being defined. 2301 Also cancel any kbd macro being defined.
2341 A user event is a key press, button press, button release, or 2302 A user event is a key press, button press, button release, or
2342 \"other-user\" event (menu selection or scrollbar action). 2303 "misc-user" event (menu selection or scrollbar action).
2343 */ 2304 */
2344 ()) 2305 ())
2345 { 2306 {
2346 /* This throws away user-input on the queue, but doesn't process any 2307 /* This throws away user-input on the queue, but doesn't process any
2347 events. Calling dispatch_event() here leads to a race condition. 2308 events. Calling dispatch_event() here leads to a race condition.
3025 static void 2986 static void
3026 menu_move_up (void) 2987 menu_move_up (void)
3027 { 2988 {
3028 widget_value *current, *prev; 2989 widget_value *current, *prev;
3029 widget_value *entries; 2990 widget_value *entries;
3030 2991
3031 current = lw_get_entries (False); 2992 current = lw_get_entries (False);
3032 entries = lw_get_entries (True); 2993 entries = lw_get_entries (True);
3033 prev = NULL; 2994 prev = NULL;
3034 if (current != entries) 2995 if (current != entries)
3035 { 2996 {
3067 static void 3028 static void
3068 menu_move_down (void) 3029 menu_move_down (void)
3069 { 3030 {
3070 widget_value *current; 3031 widget_value *current;
3071 widget_value *new; 3032 widget_value *new;
3072 3033
3073 current = lw_get_entries (False); 3034 current = lw_get_entries (False);
3074 new = current; 3035 new = current;
3075 3036
3076 while (new->next) 3037 while (new->next)
3077 { 3038 {
3078 new = new->next; 3039 new = new->next;
3079 if (new->name /*&& new->enabled*/) break; 3040 if (new->name /*&& new->enabled*/) break;
3080 } 3041 }
3081 3042
3082 if (new==current||!(new->name/*||new->enabled*/)) 3043 if (new==current||!(new->name/*||new->enabled*/))
3083 { 3044 {
3084 new = lw_get_entries (True); 3045 new = lw_get_entries (True);
3085 while (new!=current) 3046 while (new!=current)
3086 { 3047 {
3091 { 3052 {
3092 lw_pop_menu (); 3053 lw_pop_menu ();
3093 return; 3054 return;
3094 } 3055 }
3095 } 3056 }
3096 3057
3097 lw_set_item (new); 3058 lw_set_item (new);
3098 } 3059 }
3099 3060
3100 static void 3061 static void
3101 menu_move_left (void) 3062 menu_move_left (void)
3102 { 3063 {
3103 int level = lw_menu_level (); 3064 int level = lw_menu_level ();
3104 int l = level; 3065 int l = level;
3105 widget_value *current; 3066 widget_value *current;
3106 3067
3107 while (level >= 3) 3068 while (level >= 3)
3108 { 3069 {
3109 --level; 3070 --level;
3110 lw_pop_menu (); 3071 lw_pop_menu ();
3111 } 3072 }
3119 menu_move_right (void) 3080 menu_move_right (void)
3120 { 3081 {
3121 int level = lw_menu_level (); 3082 int level = lw_menu_level ();
3122 int l = level; 3083 int l = level;
3123 widget_value *current; 3084 widget_value *current;
3124 3085
3125 while (level >= 3) 3086 while (level >= 3)
3126 { 3087 {
3127 --level; 3088 --level;
3128 lw_pop_menu (); 3089 lw_pop_menu ();
3129 } 3090 }
3136 static void 3097 static void
3137 menu_select_item (widget_value *val) 3098 menu_select_item (widget_value *val)
3138 { 3099 {
3139 if (val == NULL) 3100 if (val == NULL)
3140 val = lw_get_entries (False); 3101 val = lw_get_entries (False);
3141 3102
3142 /* is match a submenu? */ 3103 /* is match a submenu? */
3143 3104
3144 if (val->contents) 3105 if (val->contents)
3145 { 3106 {
3146 /* enter the submenu */ 3107 /* enter the submenu */
3147 3108
3148 lw_set_item (val); 3109 lw_set_item (val);
3149 lw_push_menu (val->contents); 3110 lw_push_menu (val->contents);
3150 } 3111 }
3151 else 3112 else
3152 { 3113 {
3159 3120
3160 static Lisp_Object 3121 static Lisp_Object
3161 command_builder_operate_menu_accelerator (struct command_builder *builder) 3122 command_builder_operate_menu_accelerator (struct command_builder *builder)
3162 { 3123 {
3163 /* this function can GC */ 3124 /* this function can GC */
3164 3125
3165 struct console *con = XCONSOLE (Vselected_console); 3126 struct console *con = XCONSOLE (Vselected_console);
3166 Lisp_Object evee = builder->most_current_event; 3127 Lisp_Object evee = builder->most_current_event;
3167 Lisp_Object binding; 3128 Lisp_Object binding;
3168 widget_value *entries; 3129 widget_value *entries;
3169 3130
3170 extern int lw_menu_accelerate; /* lwlib.c */ 3131 extern int lw_menu_accelerate; /* lwlib.c */
3171 3132
3172 #if 0 3133 #if 0
3173 { 3134 {
3174 int i; 3135 int i;
3175 Lisp_Object t; 3136 Lisp_Object t;
3176 char buf[50]; 3137 char buf[50];
3177 3138
3178 t = builder->current_events; 3139 t = builder->current_events;
3179 i = 0; 3140 i = 0;
3180 while (!NILP (t)) 3141 while (!NILP (t))
3181 { 3142 {
3182 i++; 3143 i++;
3186 write_c_string ("\n", Qexternal_debugging_output); 3147 write_c_string ("\n", Qexternal_debugging_output);
3187 t = XEVENT_NEXT (t); 3148 t = XEVENT_NEXT (t);
3188 } 3149 }
3189 } 3150 }
3190 #endif 3151 #endif
3191 3152
3192 /* menu accelerator keys don't go into keyboard macros */ 3153 /* menu accelerator keys don't go into keyboard macros */
3193 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) 3154 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3194 con->kbd_macro_ptr = con->kbd_macro_end; 3155 con->kbd_macro_ptr = con->kbd_macro_end;
3195 3156
3196 /* don't echo menu accelerator keys */ 3157 /* don't echo menu accelerator keys */
3197 /*reset_key_echo (builder, 1);*/ 3158 /*reset_key_echo (builder, 1);*/
3198 3159
3199 if (!lw_menu_accelerate) 3160 if (!lw_menu_accelerate)
3200 { 3161 {
3201 /* `convert' mouse display to keyboard display 3162 /* `convert' mouse display to keyboard display
3202 by entering the open submenu 3163 by entering the open submenu
3203 */ 3164 */
3206 { 3167 {
3207 lw_push_menu (entries->contents); 3168 lw_push_menu (entries->contents);
3208 lw_display_menu (CurrentTime); 3169 lw_display_menu (CurrentTime);
3209 } 3170 }
3210 } 3171 }
3211 3172
3212 /* compare event to the current menu accelerators */ 3173 /* compare event to the current menu accelerators */
3213 3174
3214 entries=lw_get_entries (True); 3175 entries=lw_get_entries (True);
3215 3176
3216 while (entries) 3177 while (entries)
3217 { 3178 {
3218 Lisp_Object accel; 3179 Lisp_Object accel;
3219 VOID_TO_LISP (accel, entries->accel); 3180 VOID_TO_LISP (accel, entries->accel);
3220 if (entries->name && !NILP (accel)) 3181 if (entries->name && !NILP (accel))
3221 { 3182 {
3222 if (event_matches_key_specifier_p (XEVENT (evee), accel)) 3183 if (event_matches_key_specifier_p (XEVENT (evee), accel))
3223 { 3184 {
3224 /* a match! */ 3185 /* a match! */
3225 3186
3226 menu_select_item (entries); 3187 menu_select_item (entries);
3227 3188
3228 if (lw_menu_active) lw_display_menu (CurrentTime); 3189 if (lw_menu_active) lw_display_menu (CurrentTime);
3229 3190
3230 reset_this_command_keys (Vselected_console, 1); 3191 reset_this_command_keys (Vselected_console, 1);
3231 /*reset_command_builder_event_chain (builder);*/ 3192 /*reset_command_builder_event_chain (builder);*/
3232 return Vmenu_accelerator_map; 3193 return Vmenu_accelerator_map;
3233 } 3194 }
3234 } 3195 }
3235 entries = entries->next; 3196 entries = entries->next;
3236 } 3197 }
3237 3198
3238 /* try to look up event in menu-accelerator-map */ 3199 /* try to look up event in menu-accelerator-map */
3239 3200
3240 binding = event_binding_in (evee, Vmenu_accelerator_map, 1); 3201 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
3241 3202
3242 if (NILP (binding)) 3203 if (NILP (binding))
3243 { 3204 {
3244 /* beep at user for undefined key */ 3205 /* beep at user for undefined key */
3245 return Qnil; 3206 return Qnil;
3246 } 3207 }
3293 else if (EQ (binding, Qmenu_select)) 3254 else if (EQ (binding, Qmenu_select))
3294 menu_select_item (NULL); 3255 menu_select_item (NULL);
3295 else if (EQ (binding, Qmenu_escape)) 3256 else if (EQ (binding, Qmenu_escape))
3296 { 3257 {
3297 int level = lw_menu_level (); 3258 int level = lw_menu_level ();
3298 3259
3299 if (level > 2) 3260 if (level > 2)
3300 { 3261 {
3301 lw_pop_menu (); 3262 lw_pop_menu ();
3302 lw_display_menu (CurrentTime); 3263 lw_display_menu (CurrentTime);
3303 } 3264 }
3321 reset_this_command_keys (Vselected_console, 1); 3282 reset_this_command_keys (Vselected_console, 1);
3322 /*reset_command_builder_event_chain (builder);*/ 3283 /*reset_command_builder_event_chain (builder);*/
3323 return binding; 3284 return binding;
3324 } 3285 }
3325 } 3286 }
3326 3287
3327 if (lw_menu_active) lw_display_menu (CurrentTime); 3288 if (lw_menu_active) lw_display_menu (CurrentTime);
3328 3289
3329 reset_this_command_keys (Vselected_console, 1); 3290 reset_this_command_keys (Vselected_console, 1);
3330 /*reset_command_builder_event_chain (builder);*/ 3291 /*reset_command_builder_event_chain (builder);*/
3331 3292
3332 return Vmenu_accelerator_map; 3293 return Vmenu_accelerator_map;
3333 } 3294 }
3334 3295
3335 static Lisp_Object 3296 static Lisp_Object
3336 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) 3297 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
3337 { 3298 {
3338 Vmenu_accelerator_prefix = Qnil; 3299 Vmenu_accelerator_prefix = Qnil;
3339 Vmenu_accelerator_modifiers = Qnil; 3300 Vmenu_accelerator_modifiers = Qnil;
3340 Vmenu_accelerator_enabled = Qnil; 3301 Vmenu_accelerator_enabled = Qnil;
3341 if (!NILP (errordata)) 3302 if (!NILP (errordata))
3342 { 3303 {
3343 Lisp_Object args[2]; 3304 Lisp_Object args[2];
3344 3305
3345 args[0] = build_string ("Error in menu accelerators (setting to nil)"); 3306 args[0] = build_string ("Error in menu accelerators (setting to nil)");
3346 /* #### This should call 3307 /* #### This should call
3347 (with-output-to-string (display-error errordata)) 3308 (with-output-to-string (display-error errordata))
3348 but that stuff is all in Lisp currently. */ 3309 but that stuff is all in Lisp currently. */
3349 args[1] = errordata; 3310 args[1] = errordata;
3350 warn_when_safe_lispobj 3311 warn_when_safe_lispobj
3351 (Qerror, Qwarning, 3312 (Qerror, Qwarning,
3352 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", 3313 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
3353 Qnil, -1, 2, args)); 3314 Qnil, -1, 2, args));
3354 } 3315 }
3355 3316
3356 return Qnil; 3317 return Qnil;
3357 } 3318 }
3358 3319
3359 static Lisp_Object 3320 static Lisp_Object
3360 menu_accelerator_safe_compare (Lisp_Object event0) 3321 menu_accelerator_safe_compare (Lisp_Object event0)
3396 /* this function can GC */ 3357 /* this function can GC */
3397 Lisp_Object event0 = builder->current_events; 3358 Lisp_Object event0 = builder->current_events;
3398 struct console *con = XCONSOLE (Vselected_console); 3359 struct console *con = XCONSOLE (Vselected_console);
3399 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); 3360 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3400 Widget menubar_widget; 3361 Widget menubar_widget;
3401 3362
3402 /* compare entries in event0 against the menu prefix */ 3363 /* compare entries in event0 against the menu prefix */
3403 3364
3404 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || 3365 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
3405 XEVENT (event0)->event_type != key_press_event) 3366 XEVENT (event0)->event_type != key_press_event)
3406 return Qnil; 3367 return Qnil;
3407 3368
3408 if (!NILP (Vmenu_accelerator_prefix)) 3369 if (!NILP (Vmenu_accelerator_prefix))
3409 { 3370 {
3410 event0 = condition_case_1 (Qerror, 3371 event0 = condition_case_1 (Qerror,
3411 menu_accelerator_safe_compare, 3372 menu_accelerator_safe_compare,
3412 event0, 3373 event0,
3413 menu_accelerator_junk_on_error, 3374 menu_accelerator_junk_on_error,
3414 Qnil); 3375 Qnil);
3415 } 3376 }
3416 3377
3417 if (NILP (event0)) 3378 if (NILP (event0))
3418 return Qnil; 3379 return Qnil;
3419 3380
3420 menubar_widget = FRAME_X_MENUBAR_WIDGET (f); 3381 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3421 if (menubar_widget 3382 if (menubar_widget
3422 && CONSP (Vmenu_accelerator_modifiers)) 3383 && CONSP (Vmenu_accelerator_modifiers))
3423 { 3384 {
3424 Lisp_Object fake; 3385 Lisp_Object fake;
3425 Lisp_Object last; 3386 Lisp_Object last = Qnil;
3426 struct gcpro gcpro1; 3387 struct gcpro gcpro1;
3427 Lisp_Object matchp; 3388 Lisp_Object matchp;
3428 3389
3429 widget_value *val; 3390 widget_value *val;
3430 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; 3391 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3431 3392
3432 val = lw_get_all_values (id); 3393 val = lw_get_all_values (id);
3433 if (val) 3394 if (val)
3434 { 3395 {
3435 val = val->contents; 3396 val = val->contents;
3436 3397
3437 fake = Fcopy_sequence (Vmenu_accelerator_modifiers); 3398 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
3438 last = fake; 3399 last = fake;
3439 3400
3440 while (!NILP (Fcdr (last))) 3401 while (!NILP (Fcdr (last)))
3441 last = Fcdr (last); 3402 last = Fcdr (last);
3442 3403
3443 Fsetcdr (last, Fcons (Qnil, Qnil)); 3404 Fsetcdr (last, Fcons (Qnil, Qnil));
3444 last = Fcdr (last); 3405 last = Fcdr (last);
3445 } 3406 }
3446 3407
3447 fake = Fcons (Qnil, fake); 3408 fake = Fcons (Qnil, fake);
3448 3409
3449 GCPRO1 (fake); 3410 GCPRO1 (fake);
3450 3411
3451 while (val) 3412 while (val)
3452 { 3413 {
3453 Lisp_Object accel; 3414 Lisp_Object accel;
3462 menu_accelerator_junk_on_error, 3423 menu_accelerator_junk_on_error,
3463 Qnil); 3424 Qnil);
3464 if (!NILP (matchp)) 3425 if (!NILP (matchp))
3465 { 3426 {
3466 /* we found one! */ 3427 /* we found one! */
3467 3428
3468 lw_set_menu (menubar_widget, val); 3429 lw_set_menu (menubar_widget, val);
3469 /* yah - yet another hack. 3430 /* yah - yet another hack.
3470 pretend emacs timestamp is the same as an X timestamp, 3431 pretend emacs timestamp is the same as an X timestamp,
3471 which for the moment it is. (read events.h) 3432 which for the moment it is. (read events.h)
3472 */ 3433 */
3473 lw_map_menu (XEVENT (event0)->timestamp); 3434 lw_map_menu (XEVENT (event0)->timestamp);
3474 3435
3475 if (val->contents) 3436 if (val->contents)
3476 lw_push_menu (val->contents); 3437 lw_push_menu (val->contents);
3477 3438
3478 lw_display_menu (CurrentTime); 3439 lw_display_menu (CurrentTime);
3479 3440
3480 /* menu accelerator keys don't go into keyboard macros */ 3441 /* menu accelerator keys don't go into keyboard macros */
3481 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) 3442 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3482 con->kbd_macro_ptr = con->kbd_macro_end; 3443 con->kbd_macro_ptr = con->kbd_macro_end;
3483 3444
3484 /* don't echo menu accelerator keys */ 3445 /* don't echo menu accelerator keys */
3485 /*reset_key_echo (builder, 1);*/ 3446 /*reset_key_echo (builder, 1);*/
3486 reset_this_command_keys (Vselected_console, 1); 3447 reset_this_command_keys (Vselected_console, 1);
3487 UNGCPRO; 3448 UNGCPRO;
3488 3449
3489 return Vmenu_accelerator_map; 3450 return Vmenu_accelerator_map;
3490 } 3451 }
3491 } 3452 }
3492 3453
3493 val = val->next; 3454 val = val->next;
3494 } 3455 }
3495 3456
3496 UNGCPRO; 3457 UNGCPRO;
3497 } 3458 }
3498 return Qnil; 3459 return Qnil;
3499 } 3460 }
3500 3461
3507 { 3468 {
3508 struct console *con = XCONSOLE (Vselected_console); 3469 struct console *con = XCONSOLE (Vselected_console);
3509 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); 3470 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3510 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; 3471 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3511 widget_value *val = lw_get_all_values (id); 3472 widget_value *val = lw_get_all_values (id);
3512 3473
3513 val = val->contents; 3474 val = val->contents;
3514 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); 3475 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
3515 lw_map_menu (CurrentTime); 3476 lw_map_menu (CurrentTime);
3516 3477
3517 lw_display_menu (CurrentTime); 3478 lw_display_menu (CurrentTime);
3518 3479
3519 /* menu accelerator keys don't go into keyboard macros */ 3480 /* menu accelerator keys don't go into keyboard macros */
3520 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) 3481 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3521 con->kbd_macro_ptr = con->kbd_macro_end; 3482 con->kbd_macro_ptr = con->kbd_macro_end;
3522 3483
3523 return Qnil; 3484 return Qnil;
3524 } 3485 }
3525 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */ 3486 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
3526 3487
3527 /* See if we can do function-key-map or key-translation-map translation 3488 /* See if we can do function-key-map or key-translation-map translation
3537 3498
3538 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event) 3499 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3539 { 3500 {
3540 Lisp_Object result = munging_key_map_event_binding (suffix, munge); 3501 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3541 3502
3542 if (!NILP (result)) 3503 if (NILP (result))
3543 { 3504 continue;
3544 if (KEYMAPP (result)) 3505
3506 if (KEYMAPP (result))
3507 {
3508 if (NILP (builder->last_non_munged_event)
3509 && !has_normal_binding_p)
3510 builder->last_non_munged_event = builder->most_current_event;
3511 }
3512 else
3513 builder->last_non_munged_event = Qnil;
3514
3515 if (!KEYMAPP (result) &&
3516 !VECTORP (result) &&
3517 !STRINGP (result))
3518 {
3519 struct gcpro gcpro1;
3520 GCPRO1 (suffix);
3521 result = call1 (result, Qnil);
3522 UNGCPRO;
3523 if (NILP (result))
3524 return Qnil;
3525 }
3526
3527 if (KEYMAPP (result))
3528 return result;
3529
3530 if (VECTORP (result) || STRINGP (result))
3531 {
3532 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3533 Lisp_Object tempev;
3534 int n, tckn;
3535
3536 /* If the first_mungeable_event of the other munger is
3537 within the events we're munging, then it will point to
3538 deallocated events afterwards, which is bad -- so make it
3539 point at the beginning of the munged events. */
3540 EVENT_CHAIN_LOOP (tempev, suffix)
3545 { 3541 {
3546 if (NILP (builder->last_non_munged_event) 3542 Lisp_Object *mungeable_event =
3547 && !has_normal_binding_p) 3543 &builder->munge_me[1 - munge].first_mungeable_event;
3548 builder->last_non_munged_event = 3544 if (EQ (tempev, *mungeable_event))
3549 builder->most_current_event; 3545 {
3546 *mungeable_event = new_chain;
3547 break;
3548 }
3550 } 3549 }
3551 else 3550
3552 builder->last_non_munged_event = Qnil; 3551 n = event_chain_count (suffix);
3553 3552 command_builder_replace_suffix (builder, suffix, new_chain);
3554 if (!KEYMAPP (result) && !VECTORP (result) 3553 builder->munge_me[munge].first_mungeable_event = Qnil;
3555 && !STRINGP (result)) 3554 /* Now hork this-command-keys as well. */
3556 { 3555
3557 struct gcpro gcpro1; 3556 /* We just assume that the events we just replaced are
3558 GCPRO1 (suffix); 3557 sitting in copied form at the end of this-command-keys.
3559 result = call1 (result, Qnil); 3558 If the user did weird things with `dispatch-event' this
3560 UNGCPRO; 3559 may not be the case, but at least we make sure we won't
3561 } 3560 crash. */
3562 3561 new_chain = copy_event_chain (new_chain);
3563 if (KEYMAPP (result)) 3562 tckn = event_chain_count (Vthis_command_keys);
3564 return result; 3563 if (tckn >= n)
3565
3566 if (VECTORP (result) || STRINGP (result))
3567 { 3564 {
3568 Lisp_Object new_chain = 3565 this_command_keys_replace_suffix
3569 key_sequence_to_event_chain (result); 3566 (event_chain_nth (Vthis_command_keys, tckn - n),
3570 Lisp_Object tempev; 3567 new_chain);
3571 int n, tckn;
3572
3573 /* If the first_mungeable_event of the other munger
3574 is within the events we're munging, then it will
3575 point to deallocated events afterwards, which is
3576 bad -- so make it point at the beginning of the
3577 munged events. */
3578 EVENT_CHAIN_LOOP (tempev, suffix)
3579 {
3580 if (EQ (tempev, builder->munge_me[1 - munge].
3581 first_mungeable_event))
3582 {
3583 builder->munge_me[1 - munge].first_mungeable_event =
3584 new_chain;
3585 break;
3586 }
3587 }
3588
3589 n = event_chain_count (suffix);
3590 command_builder_replace_suffix (builder, suffix, new_chain);
3591 builder->munge_me[munge].first_mungeable_event = Qnil;
3592 /* Now hork this-command-keys as well. */
3593
3594 /* We just assume that the events we just replaced
3595 are sitting in copied form at the end of this-command-keys.
3596 If the user did weird things with `dispatch-event'
3597 this may not be the case, but at least we make
3598 sure we won't crash. */
3599 new_chain = copy_event_chain (new_chain);
3600 tckn = event_chain_count (Vthis_command_keys);
3601 if (tckn >= n)
3602 {
3603 this_command_keys_replace_suffix
3604 (event_chain_nth (Vthis_command_keys, tckn - n),
3605 new_chain);
3606 }
3607
3608 result = command_builder_find_leaf_1 (builder);
3609 return result;
3610 } 3568 }
3611 3569
3612 if (munge == MUNGE_ME_FUNCTION_KEY) 3570 result = command_builder_find_leaf_1 (builder);
3613 signal_simple_error ("Invalid binding in function-key-map", 3571 return result;
3614 result); 3572 }
3615 else 3573
3616 signal_simple_error ("Invalid binding in key-translation-map", 3574 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3617 result); 3575 "Invalid binding in function-key-map" :
3618 } 3576 "Invalid binding in key-translation-map"),
3577 result);
3619 } 3578 }
3620 3579
3621 return Qnil; 3580 return Qnil;
3622 } 3581 }
3623 3582
3636 { 3595 {
3637 /* This function can GC */ 3596 /* This function can GC */
3638 Lisp_Object result; 3597 Lisp_Object result;
3639 Lisp_Object evee = builder->current_events; 3598 Lisp_Object evee = builder->current_events;
3640 3599
3641 if (allow_misc_user_events_p
3642 && (NILP (XEVENT_NEXT (evee)))
3643 && (XEVENT_TYPE (evee) == misc_user_event))
3644 {
3645 Lisp_Object fn = XEVENT (evee)->event.eval.function;
3646 Lisp_Object arg = XEVENT (evee)->event.eval.object;
3647 return list2 (fn, arg);
3648 }
3649
3650
3651 if (XEVENT_TYPE (evee) == misc_user_event) 3600 if (XEVENT_TYPE (evee) == misc_user_event)
3652 return Qnil; 3601 {
3602 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3603 return list2 (XEVENT (evee)->event.eval.function,
3604 XEVENT (evee)->event.eval.object);
3605 else
3606 return Qnil;
3607 }
3653 3608
3654 /* if we're currently in a menu accelerator, check there for further events */ 3609 /* if we're currently in a menu accelerator, check there for further events */
3655 #if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS) 3610 #if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS)
3656 if (lw_menu_active) 3611 if (lw_menu_active)
3657 { 3612 {
3658 result = command_builder_operate_menu_accelerator (builder); 3613 return command_builder_operate_menu_accelerator (builder);
3659 return result;
3660 } 3614 }
3661 else 3615 else
3662 { 3616 {
3663 result=Qnil; 3617 result = Qnil;
3664 if (EQ (Vmenu_accelerator_enabled, Qmenu_force)) 3618 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3665 result = command_builder_find_menu_accelerator (builder); 3619 result = command_builder_find_menu_accelerator (builder);
3666 if (NILP (result)) 3620 if (NILP (result))
3667 #endif 3621 #endif
3668 result = command_builder_find_leaf_1 (builder); 3622 result = command_builder_find_leaf_1 (builder);
4166 } 4120 }
4167 else 4121 else
4168 maybe_echo_keys (command_builder, 0); 4122 maybe_echo_keys (command_builder, 0);
4169 } 4123 }
4170 else if (!NILP (Vquit_flag)) { 4124 else if (!NILP (Vquit_flag)) {
4171 Lisp_Object event = Fmake_event(); 4125 Lisp_Object quit_event = Fmake_event();
4172 struct Lisp_Event *e = XEVENT (event); 4126 struct Lisp_Event *e = XEVENT (quit_event);
4173 struct console *con;
4174 int ch;
4175
4176 /* if quit happened during menu acceleration, pretend we read it */ 4127 /* if quit happened during menu acceleration, pretend we read it */
4177 con = XCONSOLE (Fselected_console ()); 4128 struct console *con = XCONSOLE (Fselected_console ());
4178 4129 int ch = CONSOLE_QUIT_CHAR (con);
4179 ch = CONSOLE_QUIT_CHAR (con); 4130
4180
4181 character_to_event (ch, e, con, 1); 4131 character_to_event (ch, e, con, 1);
4182 e->channel = make_console (con); 4132 e->channel = make_console (con);
4183 4133
4184 enqueue_command_event (event); 4134 enqueue_command_event (quit_event);
4185 Vquit_flag = Qnil; 4135 Vquit_flag = Qnil;
4186 } 4136 }
4187 } 4137 }
4188 else if (!NILP (leaf)) 4138 else if (!NILP (leaf))
4189 { 4139 {
4211 struct gcpro gcpro1; 4161 struct gcpro gcpro1;
4212 4162
4213 GCPRO1 (event); /* event may be freshly created */ 4163 GCPRO1 (event); /* event may be freshly created */
4214 reset_current_events (command_builder); 4164 reset_current_events (command_builder);
4215 4165
4216 if (XEVENT (event)->event_type == key_press_event) 4166 switch (XEVENT (event)->event_type)
4217 Vcurrent_mouse_event = Qnil; 4167 {
4218 else if (XEVENT (event)->event_type == button_press_event 4168 case key_press_event:
4219 || XEVENT (event)->event_type == button_release_event 4169 Vcurrent_mouse_event = Qnil;
4220 || XEVENT (event)->event_type == misc_user_event) 4170 break;
4221 Vcurrent_mouse_event = Fcopy_event (event, Qnil); 4171 case button_press_event:
4222 4172 case button_release_event:
4223 /* Store the last-command-event. The semantics of this is that it is 4173 case misc_user_event:
4224 the last event most recently involved in command-lookup. 4174 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
4225 */ 4175 break;
4176 default: break;
4177 }
4178
4179 /* Store the last-command-event. The semantics of this is that it
4180 is the last event most recently involved in command-lookup. */
4226 if (!EVENTP (Vlast_command_event)) 4181 if (!EVENTP (Vlast_command_event))
4227 Vlast_command_event = Fmake_event (); 4182 Vlast_command_event = Fmake_event ();
4228 if (XEVENT (Vlast_command_event)->event_type == dead_event) 4183 if (XEVENT (Vlast_command_event)->event_type == dead_event)
4229 { 4184 {
4230 Vlast_command_event = Fmake_event (); 4185 Vlast_command_event = Fmake_event ();
4233 4188
4234 if (! EQ (event, Vlast_command_event)) 4189 if (! EQ (event, Vlast_command_event))
4235 Fcopy_event (event, Vlast_command_event); 4190 Fcopy_event (event, Vlast_command_event);
4236 4191
4237 /* Note that last-command-char will never have its high-bit set, in 4192 /* Note that last-command-char will never have its high-bit set, in
4238 an effort to sidestep the ambiguity between M-x and oslash. 4193 an effort to sidestep the ambiguity between M-x and oslash. */
4239 */
4240 Vlast_command_char = Fevent_to_character (Vlast_command_event, 4194 Vlast_command_char = Fevent_to_character (Vlast_command_event,
4241 Qnil, Qnil, Qnil); 4195 Qnil, Qnil, Qnil);
4242 4196
4243 /* Actually call the command, with all sorts of hair to preserve or clear 4197 /* Actually call the command, with all sorts of hair to preserve or clear
4244 the echo-area and region as appropriate and call the pre- and post- 4198 the echo-area and region as appropriate and call the pre- and post-
4245 command-hooks. 4199 command-hooks. */
4246 */
4247 { 4200 {
4248 int old_kbd_macro = con->kbd_macro_end; 4201 int old_kbd_macro = con->kbd_macro_end;
4249 struct window *w; 4202 struct window *w = XWINDOW (Fselected_window (Qnil));
4250
4251 w = XWINDOW (Fselected_window (Qnil));
4252 4203
4253 /* We're executing a new command, so the old value is irrelevant. */ 4204 /* We're executing a new command, so the old value is irrelevant. */
4254 zmacs_region_stays = 0; 4205 zmacs_region_stays = 0;
4255 4206
4256 /* If the previous command tried to force a specific window-start, 4207 /* If the previous command tried to force a specific window-start,
4270 call1 (XEVENT (event)->event.eval.function, 4221 call1 (XEVENT (event)->event.eval.function,
4271 XEVENT (event)->event.eval.object); 4222 XEVENT (event)->event.eval.object);
4272 } 4223 }
4273 else 4224 else
4274 { 4225 {
4275 #if 0
4276 call3 (Qcommand_execute, Vthis_command, Qnil, Qnil);
4277 #else
4278 Fcommand_execute (Vthis_command, Qnil, Qnil); 4226 Fcommand_execute (Vthis_command, Qnil, Qnil);
4227 }
4228
4229 post_command_hook ();
4230
4231 #if 0 /* #### here was an attempted fix that didn't work */
4232 if (XEVENT (event)->event_type == misc_user_event)
4233 ;
4234 else
4279 #endif 4235 #endif
4280 } 4236 if (!NILP (con->prefix_arg))
4281
4282 post_command_hook ();
4283
4284 if (!NILP (con->prefix_arg))
4285 { 4237 {
4286 /* Commands that set the prefix arg don't update last-command, don't 4238 /* Commands that set the prefix arg don't update last-command, don't
4287 reset the echoing state, and don't go into keyboard macros unless 4239 reset the echoing state, and don't go into keyboard macros unless
4288 followed by another command. 4240 followed by another command. */
4289 */
4290 maybe_echo_keys (command_builder, 0); 4241 maybe_echo_keys (command_builder, 0);
4291 4242
4292 /* If we're recording a keyboard macro, and the last command 4243 /* If we're recording a keyboard macro, and the last command
4293 executed set a prefix argument, then decrement the pointer to 4244 executed set a prefix argument, then decrement the pointer to
4294 the "last character really in the macro" to be just before this 4245 the "last character really in the macro" to be just before this
4295 command. This is so that the ^U in "^U ^X )" doesn't go onto 4246 command. This is so that the ^U in "^U ^X )" doesn't go onto
4296 the end of macro. 4247 the end of macro. */
4297 */
4298 if (!NILP (con->defining_kbd_macro)) 4248 if (!NILP (con->defining_kbd_macro))
4299 con->kbd_macro_end = old_kbd_macro; 4249 con->kbd_macro_end = old_kbd_macro;
4300 } 4250 }
4301 else 4251 else
4302 { 4252 {
4447 { 4397 {
4448 case button_press_event: 4398 case button_press_event:
4449 case button_release_event: 4399 case button_release_event:
4450 case key_press_event: 4400 case key_press_event:
4451 { 4401 {
4452 Lisp_Object leaf; 4402 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4453 4403
4454 leaf = lookup_command_event (command_builder, event, 1);
4455 if (KEYMAPP (leaf)) 4404 if (KEYMAPP (leaf))
4456 /* Incomplete key sequence */ 4405 /* Incomplete key sequence */
4457 break; 4406 break;
4458 if (NILP (leaf)) 4407 if (NILP (leaf))
4459 { 4408 {
4484 /* Temporarily pretend the last event was an "up" instead of a 4433 /* Temporarily pretend the last event was an "up" instead of a
4485 "down", and look up its binding. */ 4434 "down", and look up its binding. */
4486 XEVENT_TYPE (terminal) = button_release_event; 4435 XEVENT_TYPE (terminal) = button_release_event;
4487 /* If the "up" version is bound, don't complain. */ 4436 /* If the "up" version is bound, don't complain. */
4488 no_bitching 4437 no_bitching
4489 = !NILP (command_builder_find_leaf 4438 = !NILP (command_builder_find_leaf (command_builder, 0));
4490 (command_builder, 0));
4491 /* Undo the temporary changes we just made. */ 4439 /* Undo the temporary changes we just made. */
4492 XEVENT_TYPE (terminal) = button_press_event; 4440 XEVENT_TYPE (terminal) = button_press_event;
4493 if (no_bitching) 4441 if (no_bitching)
4494 { 4442 {
4495 /* Pretend this press was not seen (treat as a prefix) */ 4443 /* Pretend this press was not seen (treat as a prefix) */
4514 break; 4462 break;
4515 } 4463 }
4516 } 4464 }
4517 4465
4518 /* Complain that the typed sequence is not defined, if this is the 4466 /* Complain that the typed sequence is not defined, if this is the
4519 kind of sequence that warrants a complaint. 4467 kind of sequence that warrants a complaint. */
4520 */
4521 XCONSOLE (console)->defining_kbd_macro = Qnil; 4468 XCONSOLE (console)->defining_kbd_macro = Qnil;
4522 XCONSOLE (console)->prefix_arg = Qnil; 4469 XCONSOLE (console)->prefix_arg = Qnil;
4523 /* Don't complain about undefined button-release events */ 4470 /* Don't complain about undefined button-release events */
4524 if (XEVENT_TYPE (terminal) != button_release_event) 4471 if (XEVENT_TYPE (terminal) != button_release_event)
4525 { 4472 {
4526 Lisp_Object keys = 4473 Lisp_Object keys = current_events_into_vector (command_builder);
4527 current_events_into_vector (command_builder);
4528 struct gcpro gcpro1; 4474 struct gcpro gcpro1;
4529 4475
4530 /* Run the pre-command-hook before barfing about an undefined 4476 /* Run the pre-command-hook before barfing about an undefined
4531 key. */ 4477 key. */
4532 Vthis_command = Qnil; 4478 Vthis_command = Qnil;
4608 /* Huh? */ 4554 /* Huh? */
4609 Vthis_command = Qnil; 4555 Vthis_command = Qnil;
4610 4556
4611 /* clear the echo area */ 4557 /* clear the echo area */
4612 reset_key_echo (command_builder, 1); 4558 reset_key_echo (command_builder, 1);
4613 4559
4614 command_builder->self_insert_countdown = 0; 4560 command_builder->self_insert_countdown = 0;
4615 if (NILP (XCONSOLE (console)->prefix_arg) 4561 if (NILP (XCONSOLE (console)->prefix_arg)
4616 && NILP (Vexecuting_macro) 4562 && NILP (Vexecuting_macro)
4617 && !EQ (minibuf_window, Fselected_window (Qnil))) 4563 && !EQ (minibuf_window, Fselected_window (Qnil)))
4618 Fundo_boundary (); 4564 Fundo_boundary ();
4884 defsymbol (&Qauto_show_make_point_visible, 4830 defsymbol (&Qauto_show_make_point_visible,
4885 "auto-show-make-point-visible"); 4831 "auto-show-make-point-visible");
4886 4832
4887 defsymbol (&Qmenu_force, "menu-force"); 4833 defsymbol (&Qmenu_force, "menu-force");
4888 defsymbol (&Qmenu_fallback, "menu-fallback"); 4834 defsymbol (&Qmenu_fallback, "menu-fallback");
4889 4835
4890 defsymbol (&Qmenu_quit, "menu-quit"); 4836 defsymbol (&Qmenu_quit, "menu-quit");
4891 defsymbol (&Qmenu_up, "menu-up"); 4837 defsymbol (&Qmenu_up, "menu-up");
4892 defsymbol (&Qmenu_down, "menu-down"); 4838 defsymbol (&Qmenu_down, "menu-down");
4893 defsymbol (&Qmenu_left, "menu-left"); 4839 defsymbol (&Qmenu_left, "menu-left");
4894 defsymbol (&Qmenu_right, "menu-right"); 4840 defsymbol (&Qmenu_right, "menu-right");
5054 */ ); 5000 */ );
5055 Vlast_input_event = Qnil; 5001 Vlast_input_event = Qnil;
5056 5002
5057 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /* 5003 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
5058 The mouse-button event which invoked this command, or nil. 5004 The mouse-button event which invoked this command, or nil.
5059 This is usually what `(interactive \"e\")' returns. 5005 This is usually what `(interactive "e")' returns.
5060 */ ); 5006 */ );
5061 Vcurrent_mouse_event = Qnil; 5007 Vcurrent_mouse_event = Qnil;
5062 5008
5063 DEFVAR_LISP ("last-input-char", &Vlast_input_char /* 5009 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
5064 If the value of `last-input-event' is a keyboard event, then 5010 If the value of `last-input-event' is a keyboard event, then
5226 menu to become active. 5172 menu to become active.
5227 5173
5228 See also menu-accelerator-enabled and menu-accelerator-prefix. 5174 See also menu-accelerator-enabled and menu-accelerator-prefix.
5229 */ ); 5175 */ );
5230 Vmenu_accelerator_modifiers = list1 (Qmeta); 5176 Vmenu_accelerator_modifiers = list1 (Qmeta);
5231 5177
5232 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* 5178 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
5233 Whether menu accelerator keys can cause the menubar to become active. 5179 Whether menu accelerator keys can cause the menubar to become active.
5234 If 'menu-force or 'menu-fallback, then menu accelerator keys can 5180 If 'menu-force or 'menu-fallback, then menu accelerator keys can
5235 be used to activate the top level menu. Once the menubar becomes active, the 5181 be used to activate the top level menu. Once the menubar becomes active, the
5236 accelerator keys can be used regardless of the value of this variable. 5182 accelerator keys can be used regardless of the value of this variable.
5237 5183
5238 menu-force is used to indicate that the menu accelerator key takes 5184 menu-force is used to indicate that the menu accelerator key takes
5239 precedence over bindings in the current keymap(s). menu-fallback means 5185 precedence over bindings in the current keymap(s). menu-fallback means
5240 that bindings in the current keymap take precedence over menu accelerator keys. 5186 that bindings in the current keymap take precedence over menu accelerator keys.
5241 Thus a top level menu with an accelerator of \"T\" would be activated on a 5187 Thus a top level menu with an accelerator of "T" would be activated on a
5242 keypress of Meta-t if menu-accelerator-enabled is menu-force. 5188 keypress of Meta-t if menu-accelerator-enabled is menu-force.
5243 However, if menu-accelerator-enabled is menu-fallback, then 5189 However, if menu-accelerator-enabled is menu-fallback, then
5244 Meta-t will not activate the menubar and will instead run the function 5190 Meta-t will not activate the menubar and will instead run the function
5245 transpose-words, to which it is normally bound. 5191 transpose-words, to which it is normally bound.
5246 5192