Mercurial > hg > xemacs-beta
annotate src/event-stream.c @ 4903:70089046adef
fix compile problems in intl-encap* under VS6
-------------------- ChangeLog entries follow: --------------------
lib-src/ChangeLog addition:
2010-01-30 Ben Wing <ben@xemacs.org>
* make-mswin-unicode.pl:
Make it possible to specify an overridden prototype in cases where
either Cygwin or Visual Studio has errors in their headers that
can be corrected by falling back to a less qualified type (typically
without const).
src/ChangeLog addition:
2010-01-30 Ben Wing <ben@xemacs.org>
* intl-auto-encap-win32.c:
* intl-auto-encap-win32.c (qxeExtractAssociatedIcon):
* intl-auto-encap-win32.c (qxeExtractIconEx):
* intl-auto-encap-win32.c (qxeCreateMDIWindow):
* intl-auto-encap-win32.c (qxeCreateWindowStation):
* intl-auto-encap-win32.c (qxeDdeCreateStringHandle):
* intl-auto-encap-win32.c (qxeAbortSystemShutdown):
* intl-auto-encap-win32.c (qxeRegConnectRegistry):
* intl-auto-encap-win32.c (qxeGetICMProfile):
* intl-auto-encap-win32.h:
Rebuild.
* intl-encap-win32.c:
* intl-encap-win32.c (qxeUpdateICMRegKey):
Delete manual definitions of functions with former errors in
Cygwin headers but no longer. Use "override" with some functions
where Cygwin or VS6 accidentally omits a const declaration or
includes an extra one. Use "no" on SendMessageTimeout, which
has an error in the VS6 prototype (you could manually fix this
with an ifdef to split the Cygwin vs. VS6 calls, if we ever
actually used this function).
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 30 Jan 2010 20:34:23 -0600 |
| parents | 2fd201d73a92 |
| children | 8b63e21b0436 e0db3c197671 |
| rev | line source |
|---|---|
| 428 | 1 /* The portable interface to event streams. |
| 2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1268 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 24 /* Synched up with: Not in FSF. */ | |
| 25 | |
| 442 | 26 /* Authorship: |
| 27 | |
| 28 Created 1991 by Jamie Zawinski. | |
| 29 A great deal of work over the ages by Ben Wing (Mule-ization for 19.12, | |
| 30 device abstraction for 19.12/19.13, async timers for 19.14, | |
| 31 rewriting of focus code for 19.12, pre-idle hook for 19.12, | |
| 32 redoing of signal and quit handling for 19.9 and 19.12, | |
| 33 misc-user events to clean up menu/scrollbar handling for 19.11, | |
| 34 function-key-map/key-translation-map/keyboard-translate-table for | |
| 35 19.13/19.14, open-dribble-file for 19.13, much other cleanup). | |
| 36 focus-follows-mouse from Chuck Thompson, 1995. | |
| 37 XIM stuff by Martin Buchholz, c. 1996?. | |
| 38 */ | |
| 39 | |
| 428 | 40 /* This file has been Mule-ized. */ |
| 41 | |
| 42 /* | |
| 43 * DANGER!! | |
| 44 * | |
| 45 * If you ever change ANYTHING in this file, you MUST run the | |
| 46 * testcases at the end to make sure that you haven't changed | |
| 47 * the semantics of recent-keys, last-input-char, or keyboard | |
| 48 * macros. You'd be surprised how easy it is to break this. | |
| 49 * | |
| 50 */ | |
| 51 | |
| 52 /* TODO: | |
| 1204 | 53 [This stuff is way too hard to maintain - needs rework.] |
| 54 I don't think it's that bad in the main. I've done a fair amount of | |
| 55 cleanup work over the ages; the only stuff that's probably still somewhat | |
| 56 messy is the command-builder handling, which is that way because it's | |
| 57 trying to be "compatible" with pseudo-standards established by Emacs | |
| 58 v18. | |
| 428 | 59 |
| 60 The command builder should deal only with key and button events. | |
| 61 Other command events should be able to come in the MIDDLE of a key | |
| 62 sequence, without disturbing the key sequence composition, or the | |
| 63 command builder structure representing it. | |
| 64 | |
| 65 Someone should rethink universal-argument and figure out how an | |
| 66 arbitrary command can influence the next command (universal-argument | |
| 67 or universal-coding-system-argument) or the next key (hyperify). | |
| 68 | |
| 69 Both C-h and Help in the middle of a key sequence should trigger | |
| 70 prefix-help-command. help-char is stupid. Maybe we need | |
| 71 keymap-of-last-resort? | |
| 72 | |
| 73 After prefix-help is run, one should be able to CONTINUE TYPING, | |
| 74 instead of RETYPING, the key sequence. | |
| 75 */ | |
| 76 | |
| 77 #include <config.h> | |
| 78 #include "lisp.h" | |
| 79 | |
| 80 #include "blocktype.h" | |
| 81 #include "buffer.h" | |
| 82 #include "commands.h" | |
| 872 | 83 #include "device-impl.h" |
| 428 | 84 #include "elhash.h" |
| 85 #include "events.h" | |
| 872 | 86 #include "frame-impl.h" |
| 428 | 87 #include "insdel.h" /* for buffer_reset_changes */ |
| 88 #include "keymap.h" | |
| 89 #include "lstream.h" | |
| 90 #include "macros.h" /* for defining_keyboard_macro */ | |
| 442 | 91 #include "menubar.h" /* #### for evil kludges. */ |
| 428 | 92 #include "process.h" |
| 1292 | 93 #include "profile.h" |
| 872 | 94 #include "window-impl.h" |
| 428 | 95 |
| 96 #include "sysdep.h" /* init_poll_for_quit() */ | |
| 97 #include "syssignal.h" /* SIGCHLD, etc. */ | |
| 98 #include "sysfile.h" | |
| 99 #include "systime.h" /* to set Vlast_input_time */ | |
| 100 | |
| 101 #include "file-coding.h" | |
| 102 | |
| 103 #include <errno.h> | |
| 104 | |
| 105 /* The number of keystrokes between auto-saves. */ | |
| 458 | 106 static Fixnum auto_save_interval; |
| 428 | 107 |
| 108 Lisp_Object Qundefined_keystroke_sequence; | |
| 563 | 109 Lisp_Object Qinvalid_key_binding; |
| 428 | 110 |
| 111 Lisp_Object Qcommand_event_p; | |
| 112 | |
| 113 /* Hooks to run before and after each command. */ | |
| 114 Lisp_Object Vpre_command_hook, Vpost_command_hook; | |
| 115 Lisp_Object Qpre_command_hook, Qpost_command_hook; | |
| 116 | |
| 442 | 117 /* See simple.el */ |
| 118 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command; | |
| 119 | |
| 428 | 120 /* Hook run when XEmacs is about to be idle. */ |
| 121 Lisp_Object Qpre_idle_hook, Vpre_idle_hook; | |
| 122 | |
| 123 /* Control gratuitous keyboard focus throwing. */ | |
| 124 int focus_follows_mouse; | |
| 125 | |
| 444 | 126 /* When true, modifier keys are sticky. */ |
| 442 | 127 int modifier_keys_are_sticky; |
| 444 | 128 /* Modifier keys are sticky for this many milliseconds. */ |
| 129 Lisp_Object Vmodifier_keys_sticky_time; | |
| 130 | |
| 2828 | 131 /* If true, "Russian C-x processing" is enabled. */ |
| 132 int try_alternate_layouts_for_commands; | |
| 133 | |
| 444 | 134 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook, |
| 135 post_command_idle_delay, Vdeferred_action_list, and | |
| 136 Vdeferred_action_function, but we don't because that stuff is crap, | |
| 1315 | 137 and we're smarter than them, and their mommas are fat. */ |
| 444 | 138 |
| 139 /* FSF Emacs 20.7 also defines Vinput_method_function, | |
| 140 Qinput_method_exit_on_first_char and Qinput_method_use_echo_area. | |
| 1315 | 141 I don't know whether this should be imported or not. */ |
| 428 | 142 |
| 143 /* Non-nil disable property on a command means | |
| 144 do not execute it; call disabled-command-hook's value instead. */ | |
| 733 | 145 Lisp_Object Qdisabled; |
| 428 | 146 |
| 147 /* Last keyboard or mouse input event read as a command. */ | |
| 148 Lisp_Object Vlast_command_event; | |
| 149 | |
| 150 /* The nearest ASCII equivalent of the above. */ | |
| 151 Lisp_Object Vlast_command_char; | |
| 152 | |
| 153 /* Last keyboard or mouse event read for any purpose. */ | |
| 154 Lisp_Object Vlast_input_event; | |
| 155 | |
| 156 /* The nearest ASCII equivalent of the above. */ | |
| 157 Lisp_Object Vlast_input_char; | |
| 158 | |
| 159 Lisp_Object Vcurrent_mouse_event; | |
| 160 | |
| 161 /* This is fbound in cmdloop.el, see the commentary there */ | |
| 162 Lisp_Object Qcancel_mode_internal; | |
| 163 | |
| 164 /* If not Qnil, event objects to be read as the next command input */ | |
| 165 Lisp_Object Vunread_command_events; | |
| 166 Lisp_Object Vunread_command_event; /* obsoleteness support */ | |
| 167 | |
| 168 static Lisp_Object Qunread_command_events, Qunread_command_event; | |
| 169 | |
| 170 /* Previous command, represented by a Lisp object. | |
| 442 | 171 Does not include prefix commands and arg setting commands. */ |
| 428 | 172 Lisp_Object Vlast_command; |
| 173 | |
| 442 | 174 /* Contents of this-command-properties for the last command. */ |
| 175 Lisp_Object Vlast_command_properties; | |
| 176 | |
| 428 | 177 /* If a command sets this, the value goes into |
| 442 | 178 last-command for the next command. */ |
| 428 | 179 Lisp_Object Vthis_command; |
| 180 | |
| 442 | 181 /* If a command sets this, the value goes into |
| 182 last-command-properties for the next command. */ | |
| 183 Lisp_Object Vthis_command_properties; | |
| 184 | |
| 428 | 185 /* The value of point when the last command was executed. */ |
| 665 | 186 Charbpos last_point_position; |
| 428 | 187 |
| 188 /* The frame that was current when the last command was started. */ | |
| 189 Lisp_Object Vlast_selected_frame; | |
| 190 | |
| 191 /* The buffer that was current when the last command was started. */ | |
| 192 Lisp_Object last_point_position_buffer; | |
| 193 | |
| 194 /* A (16bit . 16bit) representation of the time of the last-command-event. */ | |
| 195 Lisp_Object Vlast_input_time; | |
| 196 | |
| 197 /* A (16bit 16bit usec) representation of the time | |
| 198 of the last-command-event. */ | |
| 199 Lisp_Object Vlast_command_event_time; | |
| 200 | |
| 201 /* Character to recognize as the help char. */ | |
| 202 Lisp_Object Vhelp_char; | |
| 203 | |
| 204 /* Form to execute when help char is typed. */ | |
| 205 Lisp_Object Vhelp_form; | |
| 206 | |
| 207 /* Command to run when the help character follows a prefix key. */ | |
| 208 Lisp_Object Vprefix_help_command; | |
| 209 | |
| 210 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress) | |
| 211 may have happened. */ | |
| 212 volatile int something_happened; | |
| 213 | |
| 214 /* Hash table to translate keysyms through */ | |
| 215 Lisp_Object Vkeyboard_translate_table; | |
| 216 | |
| 217 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */ | |
| 218 Lisp_Object Vretry_undefined_key_binding_unshifted; | |
| 219 Lisp_Object Qretry_undefined_key_binding_unshifted; | |
| 220 | |
| 221 /* Console that corresponds to our controlling terminal */ | |
| 222 Lisp_Object Vcontrolling_terminal; | |
| 223 | |
| 224 /* An event (actually an event chain linked through event_next) or Qnil. | |
| 225 */ | |
| 226 Lisp_Object Vthis_command_keys; | |
| 227 Lisp_Object Vthis_command_keys_tail; | |
| 228 | |
| 229 /* #### kludge! */ | |
| 230 Lisp_Object Qauto_show_make_point_visible; | |
| 231 | |
| 232 /* File in which we write all commands we read; an lstream */ | |
| 233 static Lisp_Object Vdribble_file; | |
| 234 | |
| 235 /* Recent keys ring location; a vector of events or nil-s */ | |
| 236 Lisp_Object Vrecent_keys_ring; | |
| 237 int recent_keys_ring_size; | |
| 238 int recent_keys_ring_index; | |
| 239 | |
| 240 /* Boolean specifying whether keystrokes should be added to | |
| 241 recent-keys. */ | |
| 242 int inhibit_input_event_recording; | |
| 243 | |
| 430 | 244 Lisp_Object Qself_insert_defer_undo; |
| 245 | |
| 1268 | 246 int in_modal_loop; |
| 247 | |
| 248 /* the number of keyboard characters read. callint.c wants this. */ | |
| 249 Charcount num_input_chars; | |
| 428 | 250 |
| 1292 | 251 static Lisp_Object Qnext_event, Qdispatch_event, QSnext_event_internal; |
| 252 static Lisp_Object QSexecute_internal_event; | |
| 253 | |
| 428 | 254 #ifdef DEBUG_XEMACS |
| 458 | 255 Fixnum debug_emacs_events; |
| 428 | 256 |
| 257 static void | |
|
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
258 external_debugging_print_event (const char *event_description, Lisp_Object event) |
| 428 | 259 { |
| 826 | 260 write_c_string (Qexternal_debugging_output, "("); |
| 261 write_c_string (Qexternal_debugging_output, event_description); | |
| 262 write_c_string (Qexternal_debugging_output, ") "); | |
| 428 | 263 print_internal (event, Qexternal_debugging_output, 1); |
| 826 | 264 write_c_string (Qexternal_debugging_output, "\n"); |
| 428 | 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) | |
| 272 #endif | |
| 273 | |
| 274 | |
| 275 /* The callback routines for the window system or terminal driver */ | |
| 276 struct event_stream *event_stream; | |
| 277 | |
| 2367 | 278 |
| 279 /* | |
| 280 | |
| 281 See also | |
| 282 | |
| 283 (Info-goto-node "(internals)Event Stream Callback Routines") | |
| 284 */ | |
| 1204 | 285 |
| 428 | 286 static Lisp_Object command_event_queue; |
| 287 static Lisp_Object command_event_queue_tail; | |
| 288 | |
| 1204 | 289 Lisp_Object dispatch_event_queue; |
| 290 static Lisp_Object dispatch_event_queue_tail; | |
| 291 | |
| 428 | 292 /* Nonzero means echo unfinished commands after this many seconds of pause. */ |
| 293 static Lisp_Object Vecho_keystrokes; | |
| 294 | |
| 295 /* The number of keystrokes since the last auto-save. */ | |
| 296 static int keystrokes_since_auto_save; | |
| 297 | |
| 298 /* Used by the C-g signal handler so that it will never "hard quit" | |
| 299 when waiting for an event. Otherwise holding down C-g could | |
| 300 cause a suspension back to the shell, which is generally | |
| 301 undesirable. (#### This doesn't fully work.) */ | |
| 302 | |
| 303 int emacs_is_blocking; | |
| 304 | |
| 305 /* Handlers which run during sit-for, sleep-for and accept-process-output | |
| 306 are not allowed to recursively call these routines. We record here | |
| 307 if we are in that situation. */ | |
| 308 | |
| 1268 | 309 static int recursive_sit_for; |
| 310 | |
| 311 static void pre_command_hook (void); | |
| 312 static void post_command_hook (void); | |
| 313 static void maybe_kbd_translate (Lisp_Object event); | |
| 314 static void push_this_command_keys (Lisp_Object event); | |
| 315 static void push_recent_keys (Lisp_Object event); | |
| 316 static void dribble_out_event (Lisp_Object event); | |
| 317 static void execute_internal_event (Lisp_Object event); | |
| 318 static int is_scrollbar_event (Lisp_Object event); | |
| 428 | 319 |
| 320 | |
| 321 /**********************************************************************/ | |
| 322 /* Command-builder object */ | |
| 323 /**********************************************************************/ | |
| 324 | |
| 325 #define XCOMMAND_BUILDER(x) \ | |
| 326 XRECORD (x, command_builder, struct command_builder) | |
| 771 | 327 #define wrap_command_builder(p) wrap_record (p, command_builder) |
| 428 | 328 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder) |
| 329 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) | |
| 771 | 330 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) |
| 331 | |
| 3263 | 332 #ifndef NEW_GC |
| 771 | 333 static Lisp_Object Vcommand_builder_free_list; |
| 3263 | 334 #endif /* not NEW_GC */ |
| 428 | 335 |
| 1204 | 336 static const struct memory_description command_builder_description [] = { |
| 934 | 337 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, |
| 338 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) }, | |
| 339 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) }, | |
| 340 { XD_LISP_OBJECT, offsetof (struct command_builder, console) }, | |
| 1204 | 341 { XD_LISP_OBJECT_ARRAY, offsetof (struct command_builder, first_mungeable_event), 2 }, |
| 934 | 342 { XD_END } |
| 343 }; | |
| 344 | |
| 428 | 345 static Lisp_Object |
| 346 mark_command_builder (Lisp_Object obj) | |
| 347 { | |
| 348 struct command_builder *builder = XCOMMAND_BUILDER (obj); | |
| 349 mark_object (builder->current_events); | |
| 350 mark_object (builder->most_current_event); | |
| 351 mark_object (builder->last_non_munged_event); | |
| 1204 | 352 mark_object (builder->first_mungeable_event[0]); |
| 353 mark_object (builder->first_mungeable_event[1]); | |
| 428 | 354 return builder->console; |
| 355 } | |
| 356 | |
| 357 static void | |
| 358 finalize_command_builder (void *header, int for_disksave) | |
| 359 { | |
| 360 if (!for_disksave) | |
| 361 { | |
| 771 | 362 struct command_builder *b = (struct command_builder *) header; |
| 363 if (b->echo_buf) | |
| 364 { | |
| 1726 | 365 xfree (b->echo_buf, Ibyte *); |
| 771 | 366 b->echo_buf = 0; |
| 367 } | |
| 428 | 368 } |
| 369 } | |
| 370 | |
| 934 | 371 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, |
| 372 0, /*dumpable-flag*/ | |
| 373 mark_command_builder, internal_object_printer, | |
| 374 finalize_command_builder, 0, 0, | |
| 375 command_builder_description, | |
| 376 struct command_builder); | |
| 771 | 377 |
| 428 | 378 static void |
| 379 reset_command_builder_event_chain (struct command_builder *builder) | |
| 380 { | |
| 381 builder->current_events = Qnil; | |
| 382 builder->most_current_event = Qnil; | |
| 383 builder->last_non_munged_event = Qnil; | |
| 1204 | 384 builder->first_mungeable_event[0] = Qnil; |
| 385 builder->first_mungeable_event[1] = Qnil; | |
| 428 | 386 } |
| 387 | |
| 388 Lisp_Object | |
| 771 | 389 allocate_command_builder (Lisp_Object console, int with_echo_buf) |
| 428 | 390 { |
| 771 | 391 Lisp_Object builder_obj = |
| 3263 | 392 #ifdef NEW_GC |
| 2720 | 393 wrap_pointer_1 (alloc_lrecord_type (struct command_builder, |
| 394 &lrecord_command_builder)); | |
| 3263 | 395 #else /* not NEW_GC */ |
| 1204 | 396 alloc_managed_lcrecord (Vcommand_builder_free_list); |
| 3263 | 397 #endif /* not NEW_GC */ |
| 771 | 398 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); |
| 428 | 399 |
| 400 builder->console = console; | |
| 401 reset_command_builder_event_chain (builder); | |
| 771 | 402 if (with_echo_buf) |
| 403 { | |
| 404 /* #### This badly needs to be turned into a Dynarr */ | |
| 405 builder->echo_buf_length = 300; /* #### Kludge */ | |
| 867 | 406 builder->echo_buf = xnew_array (Ibyte, builder->echo_buf_length); |
| 771 | 407 builder->echo_buf[0] = 0; |
| 408 } | |
| 409 else | |
| 410 { | |
| 411 builder->echo_buf_length = 0; | |
| 412 builder->echo_buf = NULL; | |
| 413 } | |
| 428 | 414 builder->echo_buf_index = -1; |
| 415 builder->self_insert_countdown = 0; | |
| 416 | |
| 417 return builder_obj; | |
| 418 } | |
| 419 | |
| 771 | 420 /* Copy or clone COLLAPSING (copy to NEW_BUILDINGS if non-zero, |
| 421 otherwise clone); but don't copy the echo-buf stuff. (The calling | |
| 422 routines don't need it and will reset it, and we would rather avoid | |
| 423 malloc.) */ | |
| 424 | |
| 425 static Lisp_Object | |
| 426 copy_command_builder (struct command_builder *collapsing, | |
| 427 struct command_builder *new_buildings) | |
| 428 { | |
| 429 if (!new_buildings) | |
| 430 new_buildings = XCOMMAND_BUILDER (allocate_command_builder (Qnil, 0)); | |
| 431 | |
| 3358 | 432 new_buildings->console = collapsing->console; |
| 433 | |
| 771 | 434 new_buildings->self_insert_countdown = collapsing->self_insert_countdown; |
| 435 | |
| 436 deallocate_event_chain (new_buildings->current_events); | |
| 437 new_buildings->current_events = | |
| 438 copy_event_chain (collapsing->current_events); | |
| 439 | |
| 440 new_buildings->most_current_event = | |
| 441 transfer_event_chain_pointer (collapsing->most_current_event, | |
| 442 collapsing->current_events, | |
| 443 new_buildings->current_events); | |
| 444 new_buildings->last_non_munged_event = | |
| 445 transfer_event_chain_pointer (collapsing->last_non_munged_event, | |
| 446 collapsing->current_events, | |
| 447 new_buildings->current_events); | |
| 1204 | 448 new_buildings->first_mungeable_event[0] = |
| 449 transfer_event_chain_pointer (collapsing->first_mungeable_event[0], | |
| 771 | 450 collapsing->current_events, |
| 451 new_buildings->current_events); | |
| 1204 | 452 new_buildings->first_mungeable_event[1] = |
| 453 transfer_event_chain_pointer (collapsing->first_mungeable_event[1], | |
| 771 | 454 collapsing->current_events, |
| 455 new_buildings->current_events); | |
| 456 | |
| 457 return wrap_command_builder (new_buildings); | |
| 458 } | |
| 459 | |
| 460 static void | |
| 461 free_command_builder (struct command_builder *builder) | |
| 462 { | |
| 463 if (builder->echo_buf) | |
| 464 { | |
| 1726 | 465 xfree (builder->echo_buf, Ibyte *); |
| 771 | 466 builder->echo_buf = NULL; |
| 467 } | |
| 3263 | 468 #ifdef NEW_GC |
| 2720 | 469 free_lrecord (wrap_command_builder (builder)); |
| 3263 | 470 #else /* not NEW_GC */ |
| 771 | 471 free_managed_lcrecord (Vcommand_builder_free_list, |
| 472 wrap_command_builder (builder)); | |
| 3263 | 473 #endif /* not NEW_GC */ |
| 771 | 474 } |
| 475 | |
| 428 | 476 static void |
| 477 command_builder_append_event (struct command_builder *builder, | |
| 478 Lisp_Object event) | |
| 479 { | |
| 480 assert (EVENTP (event)); | |
| 481 | |
| 771 | 482 event = Fcopy_event (event, Qnil); |
| 428 | 483 if (EVENTP (builder->most_current_event)) |
| 484 XSET_EVENT_NEXT (builder->most_current_event, event); | |
| 485 else | |
| 486 builder->current_events = event; | |
| 487 | |
| 488 builder->most_current_event = event; | |
| 1204 | 489 if (NILP (builder->first_mungeable_event[0])) |
| 490 builder->first_mungeable_event[0] = event; | |
| 491 if (NILP (builder->first_mungeable_event[1])) | |
| 492 builder->first_mungeable_event[1] = event; | |
| 428 | 493 } |
| 494 | |
| 495 | |
| 496 /**********************************************************************/ | |
| 497 /* Low-level interfaces onto event methods */ | |
| 498 /**********************************************************************/ | |
| 499 | |
| 500 static void | |
| 1268 | 501 check_event_stream_ok (void) |
| 428 | 502 { |
| 503 if (!event_stream && noninteractive) | |
| 814 | 504 /* See comment in init_event_stream() */ |
| 505 init_event_stream (); | |
| 506 else assert (event_stream); | |
| 428 | 507 } |
| 508 | |
| 509 void | |
| 440 | 510 event_stream_handle_magic_event (Lisp_Event *event) |
| 428 | 511 { |
| 1268 | 512 check_event_stream_ok (); |
| 428 | 513 event_stream->handle_magic_event_cb (event); |
| 514 } | |
| 515 | |
| 788 | 516 void |
| 517 event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream) | |
| 518 { | |
| 1268 | 519 check_event_stream_ok (); |
| 788 | 520 event_stream->format_magic_event_cb (event, pstream); |
| 521 } | |
| 522 | |
| 523 int | |
| 524 event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) | |
| 525 { | |
| 1268 | 526 check_event_stream_ok (); |
| 788 | 527 return event_stream->compare_magic_event_cb (e1, e2); |
| 528 } | |
| 529 | |
| 530 Hashcode | |
| 531 event_stream_hash_magic_event (Lisp_Event *e) | |
| 532 { | |
| 1268 | 533 check_event_stream_ok (); |
| 788 | 534 return event_stream->hash_magic_event_cb (e); |
| 535 } | |
| 536 | |
| 428 | 537 static int |
| 538 event_stream_add_timeout (EMACS_TIME timeout) | |
| 539 { | |
| 1268 | 540 check_event_stream_ok (); |
| 428 | 541 return event_stream->add_timeout_cb (timeout); |
| 542 } | |
| 543 | |
| 544 static void | |
| 545 event_stream_remove_timeout (int id) | |
| 546 { | |
| 1268 | 547 check_event_stream_ok (); |
| 428 | 548 event_stream->remove_timeout_cb (id); |
| 549 } | |
| 550 | |
| 551 void | |
| 552 event_stream_select_console (struct console *con) | |
| 553 { | |
| 1268 | 554 check_event_stream_ok (); |
| 428 | 555 if (!con->input_enabled) |
| 556 { | |
| 557 event_stream->select_console_cb (con); | |
| 558 con->input_enabled = 1; | |
| 559 } | |
| 560 } | |
| 561 | |
| 562 void | |
| 563 event_stream_unselect_console (struct console *con) | |
| 564 { | |
| 1268 | 565 check_event_stream_ok (); |
| 428 | 566 if (con->input_enabled) |
| 567 { | |
| 568 event_stream->unselect_console_cb (con); | |
| 569 con->input_enabled = 0; | |
| 570 } | |
| 571 } | |
| 572 | |
| 573 void | |
| 853 | 574 event_stream_select_process (Lisp_Process *proc, int doin, int doerr) |
| 428 | 575 { |
| 853 | 576 int cur_in, cur_err; |
| 577 | |
| 1268 | 578 check_event_stream_ok (); |
| 853 | 579 |
| 580 cur_in = get_process_selected_p (proc, 0); | |
| 581 if (cur_in) | |
| 582 doin = 0; | |
| 583 | |
| 584 if (!process_has_separate_stderr (wrap_process (proc))) | |
| 428 | 585 { |
| 853 | 586 doerr = 0; |
| 587 cur_err = 0; | |
| 588 } | |
| 589 else | |
| 590 { | |
| 591 cur_err = get_process_selected_p (proc, 1); | |
| 592 if (cur_err) | |
| 593 doerr = 0; | |
| 594 } | |
| 595 | |
| 596 if (doin || doerr) | |
| 597 { | |
| 598 event_stream->select_process_cb (proc, doin, doerr); | |
| 599 set_process_selected_p (proc, cur_in || doin, cur_err || doerr); | |
| 428 | 600 } |
| 601 } | |
| 602 | |
| 603 void | |
| 853 | 604 event_stream_unselect_process (Lisp_Process *proc, int doin, int doerr) |
| 428 | 605 { |
| 853 | 606 int cur_in, cur_err; |
| 607 | |
| 1268 | 608 check_event_stream_ok (); |
| 853 | 609 |
| 610 cur_in = get_process_selected_p (proc, 0); | |
| 611 if (!cur_in) | |
| 612 doin = 0; | |
| 613 | |
| 614 if (!process_has_separate_stderr (wrap_process (proc))) | |
| 428 | 615 { |
| 853 | 616 doerr = 0; |
| 617 cur_err = 0; | |
| 618 } | |
| 619 else | |
| 620 { | |
| 621 cur_err = get_process_selected_p (proc, 1); | |
| 622 if (!cur_err) | |
| 623 doerr = 0; | |
| 624 } | |
| 625 | |
| 626 if (doin || doerr) | |
| 627 { | |
| 628 event_stream->unselect_process_cb (proc, doin, doerr); | |
| 629 set_process_selected_p (proc, cur_in && !doin, cur_err && !doerr); | |
| 428 | 630 } |
| 631 } | |
| 632 | |
| 853 | 633 void |
| 634 event_stream_create_io_streams (void *inhandle, void *outhandle, | |
| 635 void *errhandle, Lisp_Object *instream, | |
| 636 Lisp_Object *outstream, | |
| 637 Lisp_Object *errstream, | |
| 638 USID *in_usid, | |
| 639 USID *err_usid, | |
| 640 int flags) | |
| 428 | 641 { |
| 1268 | 642 check_event_stream_ok (); |
| 853 | 643 event_stream->create_io_streams_cb |
| 644 (inhandle, outhandle, errhandle, instream, outstream, errstream, | |
| 645 in_usid, err_usid, flags); | |
| 428 | 646 } |
| 647 | |
| 853 | 648 void |
| 649 event_stream_delete_io_streams (Lisp_Object instream, | |
| 650 Lisp_Object outstream, | |
| 651 Lisp_Object errstream, | |
| 652 USID *in_usid, | |
| 653 USID *err_usid) | |
| 428 | 654 { |
| 1268 | 655 check_event_stream_ok (); |
| 853 | 656 event_stream->delete_io_streams_cb (instream, outstream, errstream, |
| 657 in_usid, err_usid); | |
| 428 | 658 } |
| 659 | |
| 442 | 660 static int |
| 661 event_stream_current_event_timestamp (struct console *c) | |
| 662 { | |
| 663 if (event_stream && event_stream->current_event_timestamp_cb) | |
| 664 return event_stream->current_event_timestamp_cb (c); | |
| 665 else | |
| 666 return 0; | |
| 667 } | |
| 428 | 668 |
| 669 | |
| 670 /**********************************************************************/ | |
| 671 /* Character prompting */ | |
| 672 /**********************************************************************/ | |
| 673 | |
| 674 static void | |
| 675 echo_key_event (struct command_builder *command_builder, | |
| 676 Lisp_Object event) | |
| 677 { | |
| 678 /* This function can GC */ | |
| 793 | 679 DECLARE_EISTRING_MALLOC (buf); |
| 428 | 680 Bytecount buf_index = command_builder->echo_buf_index; |
| 867 | 681 Ibyte *e; |
| 428 | 682 Bytecount len; |
| 683 | |
| 684 if (buf_index < 0) | |
| 685 { | |
| 686 buf_index = 0; /* We're echoing now */ | |
| 687 clear_echo_area (selected_frame (), Qnil, 0); | |
| 688 } | |
| 689 | |
| 934 | 690 format_event_object (buf, event, 1); |
| 793 | 691 len = eilen (buf); |
| 428 | 692 |
| 693 if (len + buf_index + 4 > command_builder->echo_buf_length) | |
| 793 | 694 { |
| 695 eifree (buf); | |
| 696 return; | |
| 697 } | |
| 428 | 698 e = command_builder->echo_buf + buf_index; |
| 793 | 699 memcpy (e, eidata (buf), len); |
| 428 | 700 e += len; |
| 793 | 701 eifree (buf); |
| 428 | 702 |
| 703 e[0] = ' '; | |
| 704 e[1] = '-'; | |
| 705 e[2] = ' '; | |
| 706 e[3] = 0; | |
| 707 | |
| 708 command_builder->echo_buf_index = buf_index + len + 1; | |
| 709 } | |
| 710 | |
| 711 static void | |
| 712 regenerate_echo_keys_from_this_command_keys (struct command_builder * | |
| 713 builder) | |
| 714 { | |
| 715 Lisp_Object event; | |
| 716 | |
| 717 builder->echo_buf_index = 0; | |
| 718 | |
| 719 EVENT_CHAIN_LOOP (event, Vthis_command_keys) | |
| 720 echo_key_event (builder, event); | |
| 721 } | |
| 722 | |
| 723 static void | |
| 724 maybe_echo_keys (struct command_builder *command_builder, int no_snooze) | |
| 725 { | |
| 726 /* This function can GC */ | |
| 727 double echo_keystrokes; | |
| 728 struct frame *f = selected_frame (); | |
| 853 | 729 int depth = begin_dont_check_for_quit (); |
| 730 | |
| 428 | 731 /* Message turns off echoing unless more keystrokes turn it on again. */ |
| 732 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f))) | |
| 853 | 733 goto done; |
| 428 | 734 |
| 735 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes)) | |
| 736 echo_keystrokes = extract_float (Vecho_keystrokes); | |
| 737 else | |
| 738 echo_keystrokes = 0; | |
| 739 | |
| 740 if (minibuf_level == 0 | |
| 741 && echo_keystrokes > 0.0 | |
| 442 | 742 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) |
| 743 && !x_kludge_lw_menu_active () | |
| 744 #endif | |
| 745 ) | |
| 428 | 746 { |
| 747 if (!no_snooze) | |
| 748 { | |
| 749 if (NILP (Fsit_for (Vecho_keystrokes, Qnil))) | |
| 750 /* input came in, so don't echo. */ | |
| 853 | 751 goto done; |
| 428 | 752 } |
| 753 | |
| 754 echo_area_message (f, command_builder->echo_buf, Qnil, 0, | |
| 755 /* not echo_buf_index. That doesn't include | |
| 756 the terminating " - ". */ | |
| 757 strlen ((char *) command_builder->echo_buf), | |
| 758 Qcommand); | |
| 759 } | |
| 853 | 760 |
| 761 done: | |
| 762 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ | |
| 763 unbind_to (depth); | |
| 428 | 764 } |
| 765 | |
| 766 static void | |
| 767 reset_key_echo (struct command_builder *command_builder, | |
| 768 int remove_echo_area_echo) | |
| 769 { | |
| 770 /* This function can GC */ | |
| 771 struct frame *f = selected_frame (); | |
| 772 | |
| 757 | 773 if (command_builder) |
| 774 command_builder->echo_buf_index = -1; | |
| 428 | 775 |
| 776 if (remove_echo_area_echo) | |
| 777 clear_echo_area (f, Qcommand, 0); | |
| 778 } | |
| 779 | |
| 780 | |
| 781 /**********************************************************************/ | |
| 782 /* random junk */ | |
| 783 /**********************************************************************/ | |
| 784 | |
| 785 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and | |
| 786 keystrokes_since_auto_save is equivalent to the difference between | |
| 787 num_nonmacro_input_chars and last_auto_save. */ | |
| 788 | |
| 444 | 789 /* When an auto-save happens, record the number of keystrokes, and |
| 790 don't do again soon. */ | |
| 428 | 791 |
| 792 void | |
| 793 record_auto_save (void) | |
| 794 { | |
| 795 keystrokes_since_auto_save = 0; | |
| 796 } | |
| 797 | |
| 798 /* Make an auto save happen as soon as possible at command level. */ | |
| 799 | |
| 800 void | |
| 801 force_auto_save_soon (void) | |
| 802 { | |
| 803 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20); | |
| 804 } | |
| 805 | |
| 806 static void | |
| 807 maybe_do_auto_save (void) | |
| 808 { | |
| 809 /* This function can call lisp */ | |
| 810 keystrokes_since_auto_save++; | |
| 811 if (auto_save_interval > 0 && | |
| 812 keystrokes_since_auto_save > max (auto_save_interval, 20) && | |
| 1268 | 813 !detect_input_pending (1)) |
| 428 | 814 { |
| 815 Fdo_auto_save (Qnil, Qnil); | |
| 816 record_auto_save (); | |
| 817 } | |
| 818 } | |
| 819 | |
| 820 static Lisp_Object | |
| 821 print_help (Lisp_Object object) | |
| 822 { | |
| 823 Fprinc (object, Qnil); | |
| 824 return Qnil; | |
| 825 } | |
| 826 | |
| 827 static void | |
| 828 execute_help_form (struct command_builder *command_builder, | |
| 829 Lisp_Object event) | |
| 830 { | |
| 831 /* This function can GC */ | |
| 832 Lisp_Object help = Qnil; | |
| 833 int speccount = specpdl_depth (); | |
| 834 Bytecount buf_index = command_builder->echo_buf_index; | |
| 835 Lisp_Object echo = ((buf_index <= 0) | |
| 836 ? Qnil | |
| 837 : make_string (command_builder->echo_buf, | |
| 838 buf_index)); | |
| 839 struct gcpro gcpro1, gcpro2; | |
| 840 GCPRO2 (echo, help); | |
| 841 | |
|
4775
1d61580e0cf7
Remove Fsave_window_excursion from window.c, it's overridden by Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4718
diff
changeset
|
842 record_unwind_protect (Feval, |
|
1d61580e0cf7
Remove Fsave_window_excursion from window.c, it's overridden by Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4718
diff
changeset
|
843 list2 (Qset_window_configuration, |
|
1d61580e0cf7
Remove Fsave_window_excursion from window.c, it's overridden by Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4718
diff
changeset
|
844 call0 (Qcurrent_window_configuration))); |
| 428 | 845 reset_key_echo (command_builder, 1); |
| 846 | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4528
diff
changeset
|
847 help = IGNORE_MULTIPLE_VALUES (Feval (Vhelp_form)); |
| 428 | 848 if (STRINGP (help)) |
| 849 internal_with_output_to_temp_buffer (build_string ("*Help*"), | |
| 850 print_help, help, Qnil); | |
| 851 Fnext_command_event (event, Qnil); | |
| 852 /* Remove the help from the frame */ | |
| 771 | 853 unbind_to (speccount); |
| 428 | 854 /* Hmmmm. Tricky. The unbind restores an old window configuration, |
| 855 apparently bypassing any setting of windows_structure_changed. | |
| 856 So we need to set it so that things get redrawn properly. */ | |
| 857 /* #### This is massive overkill. Look at doing it better once the | |
| 858 new redisplay is fully in place. */ | |
| 859 { | |
| 860 Lisp_Object frmcons, devcons, concons; | |
| 861 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
| 862 { | |
| 863 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 864 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); | |
| 865 } | |
| 866 } | |
| 867 | |
| 868 redisplay (); | |
| 1204 | 869 if (event_matches_key_specifier_p (event, make_char (' '))) |
| 428 | 870 { |
| 871 /* Discard next key if it is a space */ | |
| 872 reset_key_echo (command_builder, 1); | |
| 873 Fnext_command_event (event, Qnil); | |
| 874 } | |
| 875 | |
| 876 command_builder->echo_buf_index = buf_index; | |
| 877 if (buf_index > 0) | |
| 878 memcpy (command_builder->echo_buf, | |
| 879 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */ | |
| 880 UNGCPRO; | |
| 881 } | |
| 882 | |
| 883 | |
| 884 /**********************************************************************/ | |
| 885 /* timeouts */ | |
| 886 /**********************************************************************/ | |
| 887 | |
| 593 | 888 /* NOTE: "Low-level" or "interval" timeouts are one-shot timeouts that |
| 889 measure single intervals. "High-level timeouts" or "wakeups" are | |
| 890 the objects generated by `add-timeout' or `add-async-timout' -- | |
| 891 they can fire repeatedly (and in fact can have a different initial | |
| 892 time and resignal time). Given the nature of both setitimer() and | |
| 893 select() -- i.e. all we get is a single one-shot timer -- we have | |
| 894 to decompose all high-level timeouts into a series of intervals or | |
| 895 low-level timeouts. | |
| 896 | |
| 897 Low-level timeouts are of two varieties: synchronous and asynchronous. | |
| 898 The former are handled at the window-system level, the latter in | |
| 899 signal.c. | |
| 900 */ | |
| 901 | |
| 902 /**** Low-level timeout helper functions. **** | |
| 428 | 903 |
| 904 These functions maintain a sorted list of one-shot timeouts (where | |
| 593 | 905 the timeouts are in absolute time so we never lose any time as a |
| 906 result of the delay between noting an interval and firing the next | |
| 907 one). They are intended for use by functions that need to convert | |
| 908 a list of absolute timeouts into a series of intervals to wait | |
| 909 for. */ | |
| 428 | 910 |
| 911 /* We ensure that 0 is never a valid ID, so that a value of 0 can be | |
| 912 used to indicate an absence of a timer. */ | |
| 913 static int low_level_timeout_id_tick; | |
| 914 | |
| 915 static struct low_level_timeout_blocktype | |
| 916 { | |
| 917 Blocktype_declare (struct low_level_timeout); | |
| 918 } *the_low_level_timeout_blocktype; | |
| 919 | |
| 920 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return | |
| 921 a unique ID identifying the timeout. */ | |
| 922 | |
| 923 int | |
| 924 add_low_level_timeout (struct low_level_timeout **timeout_list, | |
| 925 EMACS_TIME thyme) | |
| 926 { | |
| 927 struct low_level_timeout *tm; | |
| 928 struct low_level_timeout *t, **tt; | |
| 929 | |
| 930 /* Allocate a new time struct. */ | |
| 931 | |
| 932 tm = Blocktype_alloc (the_low_level_timeout_blocktype); | |
| 933 tm->next = NULL; | |
| 593 | 934 /* Don't just use ++low_level_timeout_id_tick, for the (admittedly |
| 935 rare) case in which numbers wrap around. */ | |
| 428 | 936 if (low_level_timeout_id_tick == 0) |
| 937 low_level_timeout_id_tick++; | |
| 938 tm->id = low_level_timeout_id_tick++; | |
| 939 tm->time = thyme; | |
| 940 | |
| 941 /* Add it to the queue. */ | |
| 942 | |
| 943 tt = timeout_list; | |
| 944 t = *tt; | |
| 945 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time)) | |
| 946 { | |
| 947 tt = &t->next; | |
| 948 t = *tt; | |
| 949 } | |
| 950 tm->next = t; | |
| 951 *tt = tm; | |
| 952 | |
| 953 return tm->id; | |
| 954 } | |
| 955 | |
| 956 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST. | |
| 957 If the timeout is not there, do nothing. */ | |
| 958 | |
| 959 void | |
| 960 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id) | |
| 961 { | |
| 962 struct low_level_timeout *t, *prev; | |
| 963 | |
| 964 /* find it */ | |
| 965 | |
| 966 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next) | |
| 967 prev = t; | |
| 968 | |
| 969 if (!t) | |
| 970 return; /* couldn't find it */ | |
| 971 | |
| 972 if (!prev) | |
| 973 *timeout_list = t->next; | |
| 974 else prev->next = t->next; | |
| 975 | |
| 976 Blocktype_free (the_low_level_timeout_blocktype, t); | |
| 977 } | |
| 978 | |
| 979 /* If there are timeouts on TIMEOUT_LIST, store the relative time | |
| 980 interval to the first timeout on the list into INTERVAL and | |
| 981 return 1. Otherwise, return 0. */ | |
| 982 | |
| 983 int | |
| 984 get_low_level_timeout_interval (struct low_level_timeout *timeout_list, | |
| 985 EMACS_TIME *interval) | |
| 986 { | |
| 987 if (!timeout_list) /* no timer events; block indefinitely */ | |
| 988 return 0; | |
| 989 else | |
| 990 { | |
| 991 EMACS_TIME current_time; | |
| 992 | |
| 993 /* The time to block is the difference between the first | |
| 994 (earliest) timer on the queue and the current time. | |
| 995 If that is negative, then the timer will fire immediately | |
| 996 but we still have to call select(), with a zero-valued | |
| 997 timeout: user events must have precedence over timer events. */ | |
| 998 EMACS_GET_TIME (current_time); | |
| 999 if (EMACS_TIME_GREATER (timeout_list->time, current_time)) | |
| 1000 EMACS_SUB_TIME (*interval, timeout_list->time, | |
| 1001 current_time); | |
| 1002 else | |
| 1003 EMACS_SET_SECS_USECS (*interval, 0, 0); | |
| 1004 return 1; | |
| 1005 } | |
| 1006 } | |
| 1007 | |
| 1008 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return | |
| 1009 its ID. Also, if TIME_OUT is not 0, store the absolute time of the | |
| 1010 timeout into TIME_OUT. */ | |
| 1011 | |
| 1012 int | |
| 1013 pop_low_level_timeout (struct low_level_timeout **timeout_list, | |
| 1014 EMACS_TIME *time_out) | |
| 1015 { | |
| 1016 struct low_level_timeout *tm = *timeout_list; | |
| 1017 int id; | |
| 1018 | |
| 1019 assert (tm); | |
| 1020 id = tm->id; | |
| 1021 if (time_out) | |
| 1022 *time_out = tm->time; | |
| 1023 *timeout_list = tm->next; | |
| 1024 Blocktype_free (the_low_level_timeout_blocktype, tm); | |
| 1025 return id; | |
| 1026 } | |
| 1027 | |
| 1028 | |
| 593 | 1029 /**** High-level timeout functions. **** */ |
| 1030 | |
| 1031 /* We ensure that 0 is never a valid ID, so that a value of 0 can be | |
| 1032 used to indicate an absence of a timer. */ | |
| 428 | 1033 static int timeout_id_tick; |
| 1034 | |
| 1035 static Lisp_Object pending_timeout_list, pending_async_timeout_list; | |
| 1036 | |
| 3263 | 1037 #ifndef NEW_GC |
| 428 | 1038 static Lisp_Object Vtimeout_free_list; |
| 3263 | 1039 #endif /* not NEW_GC */ |
| 428 | 1040 |
| 1041 static Lisp_Object | |
| 1042 mark_timeout (Lisp_Object obj) | |
| 1043 { | |
| 440 | 1044 Lisp_Timeout *tm = XTIMEOUT (obj); |
| 428 | 1045 mark_object (tm->function); |
| 1046 return tm->object; | |
| 1047 } | |
| 1048 | |
| 1204 | 1049 static const struct memory_description timeout_description[] = { |
| 440 | 1050 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) }, |
| 1051 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) }, | |
| 428 | 1052 { XD_END } |
| 1053 }; | |
| 1054 | |
| 934 | 1055 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, |
| 1056 1, /*dumpable-flag*/ | |
| 1057 mark_timeout, internal_object_printer, | |
| 1058 0, 0, 0, timeout_description, Lisp_Timeout); | |
| 428 | 1059 |
| 1060 /* Generate a timeout and return its ID. */ | |
| 1061 | |
| 1062 int | |
| 1063 event_stream_generate_wakeup (unsigned int milliseconds, | |
| 1064 unsigned int vanilliseconds, | |
| 1065 Lisp_Object function, Lisp_Object object, | |
| 1066 int async_p) | |
| 1067 { | |
| 3263 | 1068 #ifdef NEW_GC |
| 2720 | 1069 Lisp_Object op = |
| 1070 wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout)); | |
| 3263 | 1071 #else /* not NEW_GC */ |
| 1204 | 1072 Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list); |
| 3263 | 1073 #endif /* not NEW_GC */ |
| 440 | 1074 Lisp_Timeout *timeout = XTIMEOUT (op); |
| 428 | 1075 EMACS_TIME current_time; |
| 1076 EMACS_TIME interval; | |
| 1077 | |
| 593 | 1078 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case |
| 1079 in which numbers wrap around. */ | |
| 1080 if (timeout_id_tick == 0) | |
| 1081 timeout_id_tick++; | |
| 428 | 1082 timeout->id = timeout_id_tick++; |
| 1083 timeout->resignal_msecs = vanilliseconds; | |
| 1084 timeout->function = function; | |
| 1085 timeout->object = object; | |
| 1086 | |
| 1087 EMACS_GET_TIME (current_time); | |
| 1088 EMACS_SET_SECS_USECS (interval, milliseconds / 1000, | |
| 1089 1000 * (milliseconds % 1000)); | |
| 1090 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval); | |
| 1091 | |
| 1092 if (async_p) | |
| 1093 { | |
| 1094 timeout->interval_id = | |
| 593 | 1095 signal_add_async_interval_timeout (timeout->next_signal_time); |
| 1096 pending_async_timeout_list = | |
| 1097 noseeum_cons (op, pending_async_timeout_list); | |
| 428 | 1098 } |
| 1099 else | |
| 1100 { | |
| 1101 timeout->interval_id = | |
| 1102 event_stream_add_timeout (timeout->next_signal_time); | |
| 1103 pending_timeout_list = noseeum_cons (op, pending_timeout_list); | |
| 1104 } | |
| 1105 return timeout->id; | |
| 1106 } | |
| 1107 | |
| 1108 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout | |
| 1109 as necessary and return the timeout's ID and function and object slots. | |
| 1110 | |
| 1111 This should be called as a result of receiving notice that a timeout | |
| 1112 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that | |
| 1113 identifies this particular firing of the timeout. INTERVAL-ID's and | |
| 1114 timeout ID's are in separate number spaces and bear no relation to | |
| 1115 each other. The INTERVAL-ID is all that the event callback routines | |
| 1116 work with: they work only with one-shot intervals, not with timeouts | |
| 1117 that may fire repeatedly. | |
| 1118 | |
| 1119 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all. | |
| 1120 */ | |
| 1121 | |
| 593 | 1122 int |
| 428 | 1123 event_stream_resignal_wakeup (int interval_id, int async_p, |
| 1124 Lisp_Object *function, Lisp_Object *object) | |
| 1125 { | |
| 1126 Lisp_Object op = Qnil, rest; | |
| 440 | 1127 Lisp_Timeout *timeout; |
| 428 | 1128 Lisp_Object *timeout_list; |
| 1129 struct gcpro gcpro1; | |
| 1130 int id; | |
| 1131 | |
| 1132 GCPRO1 (op); /* just in case ... because it's removed from the list | |
| 1133 for awhile. */ | |
| 1134 | |
| 1135 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list; | |
| 1136 | |
| 1137 /* Find the timeout on the list of pending ones. */ | |
| 1138 LIST_LOOP (rest, *timeout_list) | |
| 1139 { | |
| 1140 timeout = XTIMEOUT (XCAR (rest)); | |
| 1141 if (timeout->interval_id == interval_id) | |
| 1142 break; | |
| 1143 } | |
| 1144 | |
| 1145 assert (!NILP (rest)); | |
| 1146 op = XCAR (rest); | |
| 1147 timeout = XTIMEOUT (op); | |
| 1148 /* We make sure to snarf the data out of the timeout object before | |
| 1149 we free it with free_managed_lcrecord(). */ | |
| 1150 id = timeout->id; | |
| 1151 *function = timeout->function; | |
| 1152 *object = timeout->object; | |
| 1153 | |
| 1154 /* Remove this one from the list of pending timeouts */ | |
| 1155 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list); | |
| 1156 | |
| 1157 /* If this timeout wants to be resignalled, do it now. */ | |
| 1158 if (timeout->resignal_msecs) | |
| 1159 { | |
| 1160 EMACS_TIME current_time; | |
| 1161 EMACS_TIME interval; | |
| 1162 | |
| 1163 /* Determine the time that the next resignalling should occur. | |
| 1164 We do that by adding the interval time to the last signalled | |
| 1165 time until we get a time that's current. | |
| 1166 | |
| 1167 (This way, it doesn't matter if the timeout was signalled | |
| 1168 exactly when we asked for it, or at some time later.) | |
| 1169 */ | |
| 1170 EMACS_GET_TIME (current_time); | |
| 1171 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000, | |
| 1172 1000 * (timeout->resignal_msecs % 1000)); | |
| 1173 do | |
| 1174 { | |
| 1175 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time, | |
| 1176 interval); | |
| 1177 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time)); | |
| 1178 | |
| 1179 if (async_p) | |
| 1180 timeout->interval_id = | |
| 593 | 1181 signal_add_async_interval_timeout (timeout->next_signal_time); |
| 428 | 1182 else |
| 1183 timeout->interval_id = | |
| 1184 event_stream_add_timeout (timeout->next_signal_time); | |
| 1185 /* Add back onto the list. Note that the effect of this | |
| 1186 is to move frequently-hit timeouts to the front of the | |
| 1187 list, which is a good thing. */ | |
| 1188 *timeout_list = noseeum_cons (op, *timeout_list); | |
| 1189 } | |
| 1190 else | |
| 3263 | 1191 #ifdef NEW_GC |
| 2720 | 1192 free_lrecord (op); |
| 3263 | 1193 #else /* not NEW_GC */ |
| 428 | 1194 free_managed_lcrecord (Vtimeout_free_list, op); |
| 3263 | 1195 #endif /* not NEW_GC */ |
| 428 | 1196 |
| 1197 UNGCPRO; | |
| 1198 return id; | |
| 1199 } | |
| 1200 | |
| 1201 void | |
| 1202 event_stream_disable_wakeup (int id, int async_p) | |
| 1203 { | |
| 440 | 1204 Lisp_Timeout *timeout = 0; |
| 428 | 1205 Lisp_Object rest; |
| 1206 Lisp_Object *timeout_list; | |
| 1207 | |
| 1208 if (async_p) | |
| 1209 timeout_list = &pending_async_timeout_list; | |
| 1210 else | |
| 1211 timeout_list = &pending_timeout_list; | |
| 1212 | |
| 1213 /* Find the timeout on the list of pending ones, if it's still there. */ | |
| 1214 LIST_LOOP (rest, *timeout_list) | |
| 1215 { | |
| 1216 timeout = XTIMEOUT (XCAR (rest)); | |
| 1217 if (timeout->id == id) | |
| 1218 break; | |
| 1219 } | |
| 1220 | |
| 1221 /* If we found it, remove it from the list and disable the pending | |
| 1222 one-shot. */ | |
| 1223 if (!NILP (rest)) | |
| 1224 { | |
| 1225 Lisp_Object op = XCAR (rest); | |
| 1226 *timeout_list = | |
| 1227 delq_no_quit_and_free_cons (op, *timeout_list); | |
| 1228 if (async_p) | |
| 593 | 1229 signal_remove_async_interval_timeout (timeout->interval_id); |
| 428 | 1230 else |
| 1231 event_stream_remove_timeout (timeout->interval_id); | |
| 3263 | 1232 #ifdef NEW_GC |
| 2720 | 1233 free_lrecord (op); |
| 3263 | 1234 #else /* not NEW_GC */ |
| 428 | 1235 free_managed_lcrecord (Vtimeout_free_list, op); |
| 3263 | 1236 #endif /* not NEW_GC */ |
| 428 | 1237 } |
| 1238 } | |
| 1239 | |
| 1240 static int | |
| 1241 event_stream_wakeup_pending_p (int id, int async_p) | |
| 1242 { | |
| 440 | 1243 Lisp_Timeout *timeout; |
| 428 | 1244 Lisp_Object rest; |
| 1245 Lisp_Object timeout_list; | |
| 1246 int found = 0; | |
| 1247 | |
| 1248 | |
| 1249 if (async_p) | |
| 1250 timeout_list = pending_async_timeout_list; | |
| 1251 else | |
| 1252 timeout_list = pending_timeout_list; | |
| 1253 | |
| 1254 /* Find the element on the list of pending ones, if it's still there. */ | |
| 1255 LIST_LOOP (rest, timeout_list) | |
| 1256 { | |
| 1257 timeout = XTIMEOUT (XCAR (rest)); | |
| 1258 if (timeout->id == id) | |
| 1259 { | |
| 1260 found = 1; | |
| 1261 break; | |
| 1262 } | |
| 1263 } | |
| 1264 | |
| 1265 return found; | |
| 1266 } | |
| 1267 | |
| 1268 | |
| 1269 /**** Lisp-level timeout functions. ****/ | |
| 1270 | |
| 1271 static unsigned long | |
| 1272 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0) | |
| 1273 { | |
| 1274 double fsecs; | |
| 1275 CHECK_INT_OR_FLOAT (secs); | |
| 1276 fsecs = XFLOATINT (secs); | |
| 1277 if (fsecs < 0) | |
| 563 | 1278 invalid_argument ("timeout is negative", secs); |
| 428 | 1279 if (!allow_0 && fsecs == 0) |
| 563 | 1280 invalid_argument ("timeout is non-positive", secs); |
| 428 | 1281 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000)) |
| 563 | 1282 invalid_argument |
| 428 | 1283 ("timeout would exceed 32 bits when represented in milliseconds", secs); |
| 1284 | |
| 1285 return (unsigned long) (1000 * fsecs); | |
| 1286 } | |
| 1287 | |
| 1288 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /* | |
| 1289 Add a timeout, to be signaled after the timeout period has elapsed. | |
| 1290 SECS is a number of seconds, expressed as an integer or a float. | |
| 1291 FUNCTION will be called after that many seconds have elapsed, with one | |
| 1292 argument, the given OBJECT. If the optional RESIGNAL argument is provided, | |
| 1293 then after this timeout expires, `add-timeout' will automatically be called | |
| 1294 again with RESIGNAL as the first argument. | |
| 1295 | |
| 1296 This function returns an object which is the id number of this particular | |
| 1297 timeout. You can pass that object to `disable-timeout' to turn off the | |
| 1298 timeout before it has been signalled. | |
| 1299 | |
| 1300 NOTE: Id numbers as returned by this function are in a distinct namespace | |
| 1301 from those returned by `add-async-timeout'. This means that the same id | |
| 1302 number could refer to a pending synchronous timeout and a different pending | |
| 1303 asynchronous timeout, and that you cannot pass an id from `add-timeout' | |
| 1304 to `disable-async-timeout', or vice-versa. | |
| 1305 | |
| 1306 The number of seconds may be expressed as a floating-point number, in which | |
| 1307 case some fractional part of a second will be used. Caveat: the usable | |
| 1308 timeout granularity will vary from system to system. | |
| 1309 | |
| 1310 Adding a timeout causes a timeout event to be returned by `next-event', and | |
| 1311 the function will be invoked by `dispatch-event,' so if emacs is in a tight | |
| 1312 loop, the function will not be invoked until the next call to sit-for or | |
| 1313 until the return to top-level (the same is true of process filters). | |
| 1314 | |
| 1315 If you need to have a timeout executed even when XEmacs is in the midst of | |
| 1316 running Lisp code, use `add-async-timeout'. | |
| 1317 | |
| 1318 WARNING: if you are thinking of calling add-timeout from inside of a | |
| 1319 callback function as a way of resignalling a timeout, think again. There | |
| 1320 is a race condition. That's why the RESIGNAL argument exists. | |
| 1321 */ | |
| 1322 (secs, function, object, resignal)) | |
| 1323 { | |
| 1324 unsigned long msecs = lisp_number_to_milliseconds (secs, 0); | |
| 1325 unsigned long msecs2 = (NILP (resignal) ? 0 : | |
| 1326 lisp_number_to_milliseconds (resignal, 0)); | |
| 1327 int id; | |
| 1328 Lisp_Object lid; | |
| 1329 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0); | |
| 1330 lid = make_int (id); | |
| 2500 | 1331 if (id != XINT (lid)) ABORT (); |
| 428 | 1332 return lid; |
| 1333 } | |
| 1334 | |
| 1335 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /* | |
| 1336 Disable a timeout from signalling any more. | |
| 1337 ID should be a timeout id number as returned by `add-timeout'. If ID | |
| 1338 corresponds to a one-shot timeout that has already signalled, nothing | |
| 1339 will happen. | |
| 1340 | |
| 1341 It will not work to call this function on an id number returned by | |
| 1342 `add-async-timeout'. Use `disable-async-timeout' for that. | |
| 1343 */ | |
| 1344 (id)) | |
| 1345 { | |
| 1346 CHECK_INT (id); | |
| 1347 event_stream_disable_wakeup (XINT (id), 0); | |
| 1348 return Qnil; | |
| 1349 } | |
| 1350 | |
| 1351 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /* | |
| 1352 Add an asynchronous timeout, to be signaled after an interval has elapsed. | |
| 1353 SECS is a number of seconds, expressed as an integer or a float. | |
| 1354 FUNCTION will be called after that many seconds have elapsed, with one | |
| 1355 argument, the given OBJECT. If the optional RESIGNAL argument is provided, | |
| 1356 then after this timeout expires, `add-async-timeout' will automatically be | |
| 1357 called again with RESIGNAL as the first argument. | |
| 1358 | |
| 1359 This function returns an object which is the id number of this particular | |
| 1360 timeout. You can pass that object to `disable-async-timeout' to turn off | |
| 1361 the timeout before it has been signalled. | |
| 1362 | |
| 1363 NOTE: Id numbers as returned by this function are in a distinct namespace | |
| 1364 from those returned by `add-timeout'. This means that the same id number | |
| 1365 could refer to a pending synchronous timeout and a different pending | |
| 1366 asynchronous timeout, and that you cannot pass an id from | |
| 1367 `add-async-timeout' to `disable-timeout', or vice-versa. | |
| 1368 | |
| 1369 The number of seconds may be expressed as a floating-point number, in which | |
| 1370 case some fractional part of a second will be used. Caveat: the usable | |
| 1371 timeout granularity will vary from system to system. | |
| 1372 | |
| 1373 Adding an asynchronous timeout causes the function to be invoked as soon | |
| 1374 as the timeout occurs, even if XEmacs is in the midst of executing some | |
| 1375 other code. (This is unlike the synchronous timeouts added with | |
| 1376 `add-timeout', where the timeout will only be signalled when XEmacs is | |
| 1377 waiting for events, i.e. the next return to top-level or invocation of | |
| 1378 `sit-for' or related functions.) This means that the function that is | |
| 1379 called *must* not signal an error or change any global state (e.g. switch | |
| 1380 buffers or windows) except when locking code is in place to make sure | |
| 1381 that race conditions don't occur in the interaction between the | |
| 1382 asynchronous timeout function and other code. | |
| 1383 | |
| 1384 Under most circumstances, you should use `add-timeout' instead, as it is | |
| 1385 much safer. Asynchronous timeouts should only be used when such behavior | |
| 1386 is really necessary. | |
| 1387 | |
| 1388 Asynchronous timeouts are blocked and will not occur when `inhibit-quit' | |
| 1389 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending | |
| 1390 asynchronous timeouts will get called immediately. (Multiple occurrences | |
| 1391 of the same asynchronous timeout are not queued, however.) While the | |
| 1392 callback function of an asynchronous timeout is invoked, `inhibit-quit' | |
| 1393 is automatically bound to non-nil, and thus other asynchronous timeouts | |
| 1394 will be blocked unless the callback function explicitly sets `inhibit-quit' | |
| 1395 to nil. | |
| 1396 | |
| 1397 WARNING: if you are thinking of calling `add-async-timeout' from inside of a | |
| 1398 callback function as a way of resignalling a timeout, think again. There | |
| 1399 is a race condition. That's why the RESIGNAL argument exists. | |
| 1400 */ | |
| 1401 (secs, function, object, resignal)) | |
| 1402 { | |
| 1403 unsigned long msecs = lisp_number_to_milliseconds (secs, 0); | |
| 1404 unsigned long msecs2 = (NILP (resignal) ? 0 : | |
| 1405 lisp_number_to_milliseconds (resignal, 0)); | |
| 1406 int id; | |
| 1407 Lisp_Object lid; | |
| 1408 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1); | |
| 1409 lid = make_int (id); | |
| 2500 | 1410 if (id != XINT (lid)) ABORT (); |
| 428 | 1411 return lid; |
| 1412 } | |
| 1413 | |
| 1414 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /* | |
| 1415 Disable an asynchronous timeout from signalling any more. | |
| 1416 ID should be a timeout id number as returned by `add-async-timeout'. If ID | |
| 1417 corresponds to a one-shot timeout that has already signalled, nothing | |
| 1418 will happen. | |
| 1419 | |
| 1420 It will not work to call this function on an id number returned by | |
| 1421 `add-timeout'. Use `disable-timeout' for that. | |
| 1422 */ | |
| 1423 (id)) | |
| 1424 { | |
| 1425 CHECK_INT (id); | |
| 1426 event_stream_disable_wakeup (XINT (id), 1); | |
| 1427 return Qnil; | |
| 1428 } | |
| 1429 | |
| 1430 | |
| 1431 /**********************************************************************/ | |
| 1432 /* enqueuing and dequeuing events */ | |
| 1433 /**********************************************************************/ | |
| 1434 | |
| 1435 /* Add an event to the back of the command-event queue: it will be the next | |
| 1436 event read after all pending events. This only works on keyboard, | |
| 1437 mouse-click, misc-user, and eval events. | |
| 1438 */ | |
| 1439 static void | |
| 1440 enqueue_command_event (Lisp_Object event) | |
| 1441 { | |
| 1442 enqueue_event (event, &command_event_queue, &command_event_queue_tail); | |
| 1443 } | |
| 1444 | |
| 1445 static Lisp_Object | |
| 1446 dequeue_command_event (void) | |
| 1447 { | |
| 1448 return dequeue_event (&command_event_queue, &command_event_queue_tail); | |
| 1449 } | |
| 1450 | |
| 1204 | 1451 void |
| 1452 enqueue_dispatch_event (Lisp_Object event) | |
| 1453 { | |
| 1454 enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail); | |
| 1455 } | |
| 1456 | |
| 1457 Lisp_Object | |
| 1458 dequeue_dispatch_event (void) | |
| 1459 { | |
| 1460 return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail); | |
| 1461 } | |
| 1462 | |
| 428 | 1463 static void |
| 1464 enqueue_command_event_1 (Lisp_Object event_to_copy) | |
| 1465 { | |
| 853 | 1466 enqueue_command_event (Fcopy_event (event_to_copy, Qnil)); |
| 428 | 1467 } |
| 1468 | |
| 1469 void | |
| 1470 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object) | |
| 1471 { | |
| 1472 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 934 | 1473 XSET_EVENT_TYPE (event, magic_eval_event); |
| 1474 /* channel for magic_eval events is nil */ | |
| 1204 | 1475 XSET_EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (event, fun); |
| 1476 XSET_EVENT_MAGIC_EVAL_OBJECT (event, object); | |
| 428 | 1477 enqueue_command_event (event); |
| 1478 } | |
| 1479 | |
| 1480 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /* | |
| 1481 Add an eval event to the back of the eval event queue. | |
| 1482 When this event is dispatched, FUNCTION (which should be a function | |
| 1483 of one argument) will be called with OBJECT as its argument. | |
| 1484 See `next-event' for a description of event types and how events | |
| 1485 are received. | |
| 1486 */ | |
| 1487 (function, object)) | |
| 1488 { | |
| 1489 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 1490 | |
| 934 | 1491 XSET_EVENT_TYPE (event, eval_event); |
| 1492 /* channel for eval events is nil */ | |
| 1204 | 1493 XSET_EVENT_EVAL_FUNCTION (event, function); |
| 1494 XSET_EVENT_EVAL_OBJECT (event, object); | |
| 428 | 1495 enqueue_command_event (event); |
| 1496 | |
| 1497 return event; | |
| 1498 } | |
| 1499 | |
| 1500 Lisp_Object | |
| 1501 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, | |
| 1502 Lisp_Object object) | |
| 1503 { | |
| 1504 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 934 | 1505 XSET_EVENT_TYPE (event, misc_user_event); |
| 1506 XSET_EVENT_CHANNEL (event, channel); | |
| 1204 | 1507 XSET_EVENT_MISC_USER_FUNCTION (event, function); |
| 1508 XSET_EVENT_MISC_USER_OBJECT (event, object); | |
| 1509 XSET_EVENT_MISC_USER_BUTTON (event, 0); | |
| 1510 XSET_EVENT_MISC_USER_MODIFIERS (event, 0); | |
| 1511 XSET_EVENT_MISC_USER_X (event, -1); | |
| 1512 XSET_EVENT_MISC_USER_Y (event, -1); | |
| 428 | 1513 enqueue_command_event (event); |
| 1514 | |
| 1515 return event; | |
| 1516 } | |
| 1517 | |
| 1518 Lisp_Object | |
| 1519 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function, | |
| 1520 Lisp_Object object, | |
| 1521 int button, int modifiers, int x, int y) | |
| 1522 { | |
| 1523 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 1524 | |
| 934 | 1525 XSET_EVENT_TYPE (event, misc_user_event); |
| 1526 XSET_EVENT_CHANNEL (event, channel); | |
| 1204 | 1527 XSET_EVENT_MISC_USER_FUNCTION (event, function); |
| 1528 XSET_EVENT_MISC_USER_OBJECT (event, object); | |
| 1529 XSET_EVENT_MISC_USER_BUTTON (event, button); | |
| 1530 XSET_EVENT_MISC_USER_MODIFIERS (event, modifiers); | |
| 1531 XSET_EVENT_MISC_USER_X (event, x); | |
| 1532 XSET_EVENT_MISC_USER_Y (event, y); | |
| 428 | 1533 enqueue_command_event (event); |
| 1534 | |
| 1535 return event; | |
| 1536 } | |
| 1537 | |
| 1538 | |
| 1539 /**********************************************************************/ | |
| 1540 /* focus-event handling */ | |
| 1541 /**********************************************************************/ | |
| 1542 | |
| 1543 /* | |
| 1544 | |
| 2367 | 1545 See also |
| 1546 | |
| 1547 (Info-goto-node "(internals)Focus Handling") | |
| 428 | 1548 */ |
| 1549 | |
| 2367 | 1550 |
| 428 | 1551 static void |
| 1552 run_select_frame_hook (void) | |
| 1553 { | |
| 1554 run_hook (Qselect_frame_hook); | |
| 1555 } | |
| 1556 | |
| 1557 static void | |
| 1558 run_deselect_frame_hook (void) | |
| 1559 { | |
| 1560 run_hook (Qdeselect_frame_hook); | |
| 1561 } | |
| 1562 | |
| 1563 /* When select-frame is called and focus_follows_mouse is false, we want | |
| 1564 to tell the window system that the focus should be changed to point to | |
| 1565 the new frame. However, | |
| 1566 sometimes Lisp functions will temporarily change the selected frame | |
| 1567 (e.g. to call a function that operates on the selected frame), | |
| 1568 and it's annoying if this focus-change happens exactly when | |
| 1569 select-frame is called, because then you get some flickering of the | |
| 1570 window-manager border and perhaps other undesirable results. We | |
| 1571 really only want to change the focus when we're about to retrieve | |
| 1572 an event from the user. To do this, we keep track of the frame | |
| 1573 where the window-manager focus lies on, and just before waiting | |
| 1574 for user events, check the currently selected frame and change | |
| 1575 the focus as necessary. | |
| 1576 | |
| 1577 On the other hand, if focus_follows_mouse is true, we need to switch the | |
| 1578 selected frame back to the frame with window manager focus just before we | |
| 1579 execute the next command in Fcommand_loop_1, just as the selected buffer is | |
| 1580 reverted after a set-buffer. | |
| 1581 | |
| 1582 Both cases are handled by this function. It must be called as appropriate | |
| 1583 from these two places, depending on the value of focus_follows_mouse. */ | |
| 1584 | |
| 1585 void | |
| 1586 investigate_frame_change (void) | |
| 1587 { | |
| 1588 Lisp_Object devcons, concons; | |
| 1589 | |
| 1590 /* if the selected frame was changed, change the window-system | |
| 1591 focus to the new frame. We don't do it when select-frame was | |
| 1592 called, to avoid flickering and other unwanted side effects when | |
| 1593 the frame is just changed temporarily. */ | |
| 1594 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 1595 { | |
| 1596 struct device *d = XDEVICE (XCAR (devcons)); | |
| 1597 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d); | |
| 1598 | |
| 1599 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL, | |
| 1600 but that can cause us to end up in an infinite loop focusing | |
| 1601 between two frames. It seems that since the call to `select-frame' | |
| 1602 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS | |
| 1603 value, we need to do so too. */ | |
| 1604 if (!NILP (sel_frame) && | |
| 1605 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) && | |
| 1606 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) && | |
| 1607 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame)) | |
| 1608 { | |
| 1609 /* At this point, we know that the frame has been changed. Now, if | |
| 1610 * focus_follows_mouse is not set, we finish off the frame change, | |
| 1611 * so that user events will now come from the new frame. Otherwise, | |
| 1612 * if focus_follows_mouse is set, no gratuitous frame changing | |
| 1613 * should take place. Set the focus back to the frame which was | |
| 1614 * originally selected for user input. | |
| 1615 */ | |
| 1616 if (!focus_follows_mouse) | |
| 1617 { | |
| 1618 /* prevent us from issuing the same request more than once */ | |
| 1619 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame; | |
| 1620 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame))); | |
| 1621 } | |
| 1622 else | |
| 1623 { | |
| 1624 Lisp_Object old_frame = Qnil; | |
| 1625 | |
| 1626 /* #### Do we really want to check OUGHT ?? | |
| 1627 * It seems to make sense, though I have never seen us | |
| 1628 * get here and have it be non-nil. | |
| 1629 */ | |
| 1630 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d))) | |
| 1631 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d); | |
| 1632 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d))) | |
| 1633 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); | |
| 1634 | |
| 1635 /* #### Can old_frame ever be NIL? play it safe.. */ | |
| 1636 if (!NILP (old_frame)) | |
| 1637 { | |
| 1638 /* Fselect_frame is not really the right thing: it frobs the | |
| 1639 * buffer stack. But there's no easy way to do the right | |
| 1640 * thing, and this code already had this problem anyway. | |
| 1641 */ | |
| 1642 Fselect_frame (old_frame); | |
| 1643 } | |
| 1644 } | |
| 1645 } | |
| 1646 } | |
| 1647 } | |
| 1648 | |
| 1649 static Lisp_Object | |
| 1650 cleanup_after_missed_defocusing (Lisp_Object frame) | |
| 1651 { | |
| 1652 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame))) | |
| 1653 Fselect_frame (frame); | |
| 1654 return Qnil; | |
| 1655 } | |
| 1656 | |
| 1657 void | |
| 1658 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev) | |
| 1659 { | |
| 1660 Lisp_Object frame = Fcar (frame_inp_and_dev); | |
| 1661 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev)); | |
| 1662 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev))); | |
| 1663 struct device *d; | |
| 1664 | |
| 1665 if (!DEVICE_LIVE_P (XDEVICE (device))) | |
| 1666 return; | |
| 1667 else | |
| 1668 d = XDEVICE (device); | |
| 1669 | |
| 1670 /* Any received focus-change notifications render invalid any | |
| 1671 pending focus-change requests. */ | |
| 1672 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil; | |
| 1673 if (in_p) | |
| 1674 { | |
| 1675 Lisp_Object focus_frame; | |
| 1676 | |
| 1677 if (!FRAME_LIVE_P (XFRAME (frame))) | |
| 1678 return; | |
| 1679 else | |
| 1680 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d); | |
| 1681 | |
| 1682 /* Mark the minibuffer as changed to make sure it gets updated | |
| 1683 properly if the echo area is active. */ | |
| 1684 { | |
| 1685 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame))); | |
| 1686 MARK_WINDOWS_CHANGED (w); | |
| 1687 } | |
| 1688 | |
| 452 | 1689 if (FRAMEP (focus_frame) && FRAME_LIVE_P (XFRAME (focus_frame)) |
| 1690 && !EQ (frame, focus_frame)) | |
| 428 | 1691 { |
| 1692 /* Oops, we missed a focus-out event. */ | |
| 1693 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil; | |
| 1694 redisplay_redraw_cursor (XFRAME (focus_frame), 1); | |
| 1695 } | |
| 1696 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame; | |
| 1697 if (!EQ (frame, focus_frame)) | |
| 1698 { | |
| 1699 redisplay_redraw_cursor (XFRAME (frame), 1); | |
| 1700 } | |
| 1701 } | |
| 1702 else | |
| 1703 { | |
| 1704 /* We ignore the frame reported in the event. If it's different | |
| 1705 from where we think the focus was, oh well -- we messed up. | |
| 1706 Nonetheless, we pretend we were right, for sensible behavior. */ | |
| 1707 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d); | |
| 1708 if (!NILP (frame)) | |
| 1709 { | |
| 1710 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil; | |
| 1711 | |
| 1712 if (FRAME_LIVE_P (XFRAME (frame))) | |
| 1713 redisplay_redraw_cursor (XFRAME (frame), 1); | |
| 1714 } | |
| 1715 } | |
| 1716 } | |
| 1717 | |
| 1718 /* Called from the window-system-specific code when we receive a | |
| 1719 notification that the focus lies on a particular frame. | |
| 1720 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil | |
| 1721 for focus-in. | |
| 1722 */ | |
| 1723 void | |
| 1724 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev) | |
| 1725 { | |
| 1726 Lisp_Object frame = Fcar (frame_inp_and_dev); | |
| 1727 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev)); | |
| 1728 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev))); | |
| 1729 struct device *d; | |
| 1730 int count; | |
| 1731 | |
| 1732 if (!DEVICE_LIVE_P (XDEVICE (device))) | |
| 1733 return; | |
| 1734 else | |
| 1735 d = XDEVICE (device); | |
| 1736 | |
| 1737 if (in_p) | |
| 1738 { | |
| 1739 Lisp_Object focus_frame; | |
| 1740 | |
| 1741 if (!FRAME_LIVE_P (XFRAME (frame))) | |
| 1742 return; | |
| 1743 else | |
| 1744 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); | |
| 1745 | |
| 1746 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame; | |
| 1747 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame)) | |
| 1748 { | |
| 1749 /* Oops, we missed a focus-out event. */ | |
| 1750 Fselect_frame (focus_frame); | |
| 1751 /* Do an unwind-protect in case an error occurs in | |
| 1752 the deselect-frame-hook */ | |
| 1753 count = specpdl_depth (); | |
| 1754 record_unwind_protect (cleanup_after_missed_defocusing, frame); | |
| 1755 run_deselect_frame_hook (); | |
| 771 | 1756 unbind_to (count); |
| 428 | 1757 /* the cleanup method changed the focus frame to nil, so |
| 1758 we need to reflect this */ | |
| 1759 focus_frame = Qnil; | |
| 1760 } | |
| 1761 else | |
| 1762 Fselect_frame (frame); | |
| 1763 if (!EQ (frame, focus_frame)) | |
| 1764 run_select_frame_hook (); | |
| 1765 } | |
| 1766 else | |
| 1767 { | |
| 1768 /* We ignore the frame reported in the event. If it's different | |
| 1769 from where we think the focus was, oh well -- we messed up. | |
| 1770 Nonetheless, we pretend we were right, for sensible behavior. */ | |
| 1771 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); | |
| 1772 if (!NILP (frame)) | |
| 1773 { | |
| 1774 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil; | |
| 1775 run_deselect_frame_hook (); | |
| 1776 } | |
| 1777 } | |
| 1778 } | |
| 1779 | |
| 1780 | |
| 1781 /**********************************************************************/ | |
| 1268 | 1782 /* input pending/quit checking */ |
| 1783 /**********************************************************************/ | |
| 1784 | |
| 1785 /* If HOW_MANY is 0, return true if there are any user or non-user events | |
| 1786 pending. If HOW_MANY is > 0, return true if there are that many *user* | |
| 1787 events pending, irrespective of non-user events. */ | |
| 1788 | |
| 1789 static int | |
| 1790 event_stream_event_pending_p (int how_many) | |
| 1791 { | |
| 1792 /* #### Hmmm ... There may be some duplication in "drain queue" and | |
| 1793 "event pending". Couldn't we just drain the queue and see what's in | |
| 1794 it, and not maybe need a separate event method for this? Would this | |
| 1795 work when HOW_MANY is 0? Maybe this would be slow? */ | |
| 1796 return event_stream && event_stream->event_pending_p (how_many); | |
| 1797 } | |
| 1798 | |
| 1799 static void | |
| 1800 event_stream_force_event_pending (struct frame *f) | |
| 1801 { | |
| 1802 if (event_stream->force_event_pending_cb) | |
| 1803 event_stream->force_event_pending_cb (f); | |
| 1804 } | |
| 1805 | |
| 1806 void | |
| 1807 event_stream_drain_queue (void) | |
| 1808 { | |
| 1318 | 1809 /* This can call Lisp */ |
| 1268 | 1810 if (event_stream && event_stream->drain_queue_cb) |
| 1811 event_stream->drain_queue_cb (); | |
| 1812 } | |
| 1813 | |
| 1814 /* Return non-zero if at least HOW_MANY user events are pending. */ | |
| 1815 int | |
| 1816 detect_input_pending (int how_many) | |
| 1817 { | |
| 1318 | 1818 /* This can call Lisp */ |
| 1268 | 1819 Lisp_Object event; |
| 1820 | |
| 1821 if (!NILP (Vunread_command_event)) | |
| 1822 how_many--; | |
| 1823 | |
| 1824 how_many -= XINT (Fsafe_length (Vunread_command_events)); | |
| 1825 | |
| 1826 if (how_many <= 0) | |
| 1827 return 1; | |
| 1828 | |
| 1829 EVENT_CHAIN_LOOP (event, command_event_queue) | |
| 1830 { | |
| 1831 if (XEVENT_TYPE (event) != eval_event | |
| 1832 && XEVENT_TYPE (event) != magic_eval_event) | |
| 1833 { | |
| 1834 how_many--; | |
| 1835 if (how_many <= 0) | |
| 1836 return 1; | |
| 1837 } | |
| 1838 } | |
| 1839 | |
| 1840 return event_stream_event_pending_p (how_many); | |
| 1841 } | |
| 1842 | |
| 1843 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /* | |
| 1844 Return t if command input is currently available with no waiting. | |
| 1845 Actually, the value is nil only if we can be sure that no input is available. | |
| 1846 */ | |
| 1847 ()) | |
| 1848 { | |
| 1318 | 1849 /* This can call Lisp */ |
| 1268 | 1850 return detect_input_pending (1) ? Qt : Qnil; |
| 1851 } | |
| 1852 | |
| 1853 static int | |
| 1854 maybe_read_quit_event (Lisp_Event *event) | |
| 1855 { | |
| 1856 /* A C-g that came from `sigint_happened' will always come from the | |
| 1857 controlling terminal. If that doesn't exist, however, then the | |
| 1858 user manually sent us a SIGINT, and we pretend the C-g came from | |
| 1859 the selected console. */ | |
| 1860 struct console *con; | |
| 1861 | |
| 1862 if (CONSOLEP (Vcontrolling_terminal) && | |
| 1863 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) | |
| 1864 con = XCONSOLE (Vcontrolling_terminal); | |
| 1865 else | |
| 1866 con = XCONSOLE (Fselected_console ()); | |
| 1867 | |
| 1868 if (sigint_happened) | |
| 1869 { | |
| 1870 sigint_happened = 0; | |
| 1871 Vquit_flag = Qnil; | |
| 1872 Fcopy_event (CONSOLE_QUIT_EVENT (con), wrap_event (event)); | |
| 1873 return 1; | |
| 1874 } | |
| 1875 return 0; | |
| 1876 } | |
| 1877 | |
| 1878 struct remove_quit_p_data | |
| 1879 { | |
| 1880 int critical; | |
| 1881 }; | |
| 1882 | |
| 1883 static int | |
| 1884 remove_quit_p_event (Lisp_Object ev, void *the_data) | |
| 1885 { | |
| 1886 struct remove_quit_p_data *data = (struct remove_quit_p_data *) the_data; | |
| 1887 struct console *con = event_console_or_selected (ev); | |
| 1888 | |
| 1889 if (XEVENT_TYPE (ev) == key_press_event) | |
| 1890 { | |
| 1891 if (event_matches_key_specifier_p (ev, CONSOLE_QUIT_EVENT (con))) | |
| 1892 return 1; | |
| 1893 if (event_matches_key_specifier_p (ev, | |
| 1894 CONSOLE_CRITICAL_QUIT_EVENT (con))) | |
| 1895 { | |
| 1896 data->critical = 1; | |
| 1897 return 1; | |
| 1898 } | |
| 1899 } | |
| 1900 | |
| 1901 return 0; | |
| 1902 } | |
| 1903 | |
| 1904 void | |
| 1905 event_stream_quit_p (void) | |
| 1906 { | |
| 1318 | 1907 /* This can call Lisp */ |
| 1268 | 1908 struct remove_quit_p_data data; |
| 1909 | |
| 1910 /* Quit checking cannot happen in modal loop. Because it attempts to | |
| 1911 retrieve and dispatch events, it will cause lots of problems if we try | |
| 1912 to do this when already in the process of doing this -- deadlocking | |
| 1913 under Windows, crashes in lwlib etc. under X due to non-reentrant | |
| 1914 code. This is automatically caught, however, in | |
| 1915 event_stream_drain_queue() (checks for in_modal_loop in the | |
| 1916 event-specific code). */ | |
| 1917 | |
| 1918 /* Drain queue so we can check for pending C-g events. */ | |
| 1919 event_stream_drain_queue (); | |
| 1920 data.critical = 0; | |
| 1921 | |
| 1922 if (map_event_chain_remove (remove_quit_p_event, | |
| 1923 &dispatch_event_queue, | |
| 1924 &dispatch_event_queue_tail, | |
| 1925 &data, MECR_DEALLOCATE_EVENT)) | |
| 1926 Vquit_flag = data.critical ? Qcritical : Qt; | |
| 1927 } | |
| 1928 | |
| 1929 Lisp_Object | |
| 1930 event_stream_protect_modal_loop (const char *error_string, | |
| 1931 Lisp_Object (*bfun) (void *barg), | |
| 1932 void *barg, int flags) | |
| 1933 { | |
| 1934 Lisp_Object tmp; | |
| 1935 | |
| 1936 ++in_modal_loop; | |
| 1937 tmp = call_trapping_problems (Qevent, error_string, flags, 0, bfun, barg); | |
| 1938 --in_modal_loop; | |
| 1939 | |
| 1940 return tmp; | |
| 1941 } | |
| 1942 | |
| 1943 | |
| 1944 /**********************************************************************/ | |
| 428 | 1945 /* retrieving the next event */ |
| 1946 /**********************************************************************/ | |
| 1947 | |
| 1948 static int in_single_console; | |
| 1949 | |
| 1950 /* #### These functions don't currently do anything. */ | |
| 1951 void | |
| 1952 single_console_state (void) | |
| 1953 { | |
| 1954 in_single_console = 1; | |
| 1955 } | |
| 1956 | |
| 1957 void | |
| 1958 any_console_state (void) | |
| 1959 { | |
| 1960 in_single_console = 0; | |
| 1961 } | |
| 1962 | |
| 1963 int | |
| 1964 in_single_console_state (void) | |
| 1965 { | |
| 1966 return in_single_console; | |
| 1967 } | |
| 1968 | |
| 1268 | 1969 static void |
| 1970 event_stream_next_event (Lisp_Event *event) | |
| 1971 { | |
| 1972 Lisp_Object event_obj; | |
| 1973 | |
| 1974 check_event_stream_ok (); | |
| 1975 | |
| 1976 event_obj = wrap_event (event); | |
| 1977 zero_event (event); | |
| 1978 /* SIGINT occurs when C-g was pressed on a TTY. (SIGINT might have | |
| 1979 been sent manually by the user, but we don't care; we treat it | |
| 1980 the same.) | |
| 1981 | |
| 1982 The SIGINT signal handler sets Vquit_flag as well as sigint_happened | |
| 1983 and write a byte on our "fake pipe", which unblocks us when we are | |
| 1984 waiting for an event. */ | |
| 1985 | |
| 1986 /* If SIGINT was received after we disabled quit checking (because | |
| 1987 we want to read C-g's as characters), but before we got a chance | |
| 1988 to start reading, notice it now and treat it as a character to be | |
| 1989 read. If above callers wanted this to be QUIT, they can | |
| 1990 determine this by comparing the event against quit-char. */ | |
| 1991 | |
| 1992 if (maybe_read_quit_event (event)) | |
| 1993 { | |
| 1994 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); | |
| 1995 return; | |
| 1996 } | |
| 1997 | |
| 1998 /* If a longjmp() happens in the callback, we're screwed. | |
| 1999 Let's hope it doesn't. I think the code here is fairly | |
| 2000 clean and doesn't do this. */ | |
| 2001 emacs_is_blocking = 1; | |
| 2002 event_stream->next_event_cb (event); | |
| 2003 emacs_is_blocking = 0; | |
| 2004 | |
| 2005 /* Now check to see if C-g was pressed while we were blocking. | |
| 2006 We treat it as an event, just like above. */ | |
| 2007 if (maybe_read_quit_event (event)) | |
| 2008 { | |
| 2009 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); | |
| 2010 return; | |
| 2011 } | |
| 2012 | |
| 2013 #ifdef DEBUG_XEMACS | |
| 2014 /* timeout events have more info set later, so | |
| 2015 print the event out in next_event_internal(). */ | |
| 2016 if (event->event_type != timeout_event) | |
| 2017 DEBUG_PRINT_EMACS_EVENT ("real", event_obj); | |
| 2018 #endif | |
| 2019 maybe_kbd_translate (event_obj); | |
| 2020 } | |
| 428 | 2021 |
| 853 | 2022 /* Read an event from the window system (or tty). If ALLOW_QUEUED is |
| 2023 non-zero, read from the command-event queue first. | |
| 2024 | |
| 2025 If C-g was pressed, this function will attempt to QUIT. If you want | |
| 2026 to read C-g as an event, wrap this function with a call to | |
| 2027 begin_dont_check_for_quit(), and set Vquit_flag to Qnil just before | |
| 2028 you unbind. In this case, TARGET_EVENT will contain a C-g. | |
| 2029 | |
| 2030 Note that even if you are interested in C-g doing QUIT, a caller of you | |
| 2031 might not be. | |
| 2032 */ | |
| 2033 | |
| 428 | 2034 static void |
| 2035 next_event_internal (Lisp_Object target_event, int allow_queued) | |
| 2036 { | |
| 2037 struct gcpro gcpro1; | |
| 1292 | 2038 PROFILE_DECLARE (); |
| 2039 | |
| 853 | 2040 QUIT; |
| 428 | 2041 |
| 1292 | 2042 PROFILE_RECORD_ENTERING_SECTION (QSnext_event_internal); |
| 2043 | |
| 428 | 2044 assert (NILP (XEVENT_NEXT (target_event))); |
| 2045 | |
| 2046 GCPRO1 (target_event); | |
| 2047 | |
| 2048 /* When focus_follows_mouse is nil, if a frame change took place, we need | |
| 2049 * to actually switch window manager focus to the selected window now. | |
| 2050 */ | |
| 2051 if (!focus_follows_mouse) | |
| 2052 investigate_frame_change (); | |
| 2053 | |
| 2054 if (allow_queued && !NILP (command_event_queue)) | |
| 2055 { | |
| 2056 Lisp_Object event = dequeue_command_event (); | |
| 2057 Fcopy_event (event, target_event); | |
| 2058 Fdeallocate_event (event); | |
| 2059 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event); | |
| 2060 } | |
| 2061 else | |
| 2062 { | |
| 440 | 2063 Lisp_Event *e = XEVENT (target_event); |
| 428 | 2064 |
| 2065 /* The command_event_queue was empty. Wait for an event. */ | |
| 2066 event_stream_next_event (e); | |
| 2067 /* If this was a timeout, then we need to extract some data | |
| 2068 out of the returned closure and might need to resignal | |
| 2069 it. */ | |
| 934 | 2070 if (EVENT_TYPE (e) == timeout_event) |
| 428 | 2071 { |
| 2072 Lisp_Object tristan, isolde; | |
| 2073 | |
| 1204 | 2074 SET_EVENT_TIMEOUT_ID_NUMBER (e, |
| 2075 event_stream_resignal_wakeup (EVENT_TIMEOUT_INTERVAL_ID (e), 0, &tristan, &isolde)); | |
| 2076 | |
| 2077 SET_EVENT_TIMEOUT_FUNCTION (e, tristan); | |
| 2078 SET_EVENT_TIMEOUT_OBJECT (e, isolde); | |
| 934 | 2079 /* next_event_internal() doesn't print out timeout events |
| 2080 because of the extra info we just set. */ | |
| 428 | 2081 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event); |
| 2082 } | |
| 2083 | |
| 853 | 2084 /* If we read a ^G, then set quit-flag and try to QUIT. |
| 2085 This may be blocked (see above). | |
| 428 | 2086 */ |
| 934 | 2087 if (EVENT_TYPE (e) == key_press_event && |
| 428 | 2088 event_matches_key_specifier_p |
| 1204 | 2089 (target_event, CONSOLE_QUIT_EVENT (XCONSOLE (EVENT_CHANNEL (e))))) |
| 428 | 2090 { |
| 2091 Vquit_flag = Qt; | |
| 853 | 2092 QUIT; |
| 428 | 2093 } |
| 2094 } | |
| 2095 | |
| 2096 UNGCPRO; | |
| 1292 | 2097 |
| 2098 PROFILE_RECORD_EXITING_SECTION (QSnext_event_internal); | |
| 428 | 2099 } |
| 2100 | |
| 853 | 2101 void |
| 428 | 2102 run_pre_idle_hook (void) |
| 2103 { | |
| 1318 | 2104 /* This can call Lisp */ |
| 428 | 2105 if (!NILP (Vpre_idle_hook) |
| 1268 | 2106 && !detect_input_pending (1)) |
| 853 | 2107 safe_run_hook_trapping_problems |
| 1333 | 2108 (Qredisplay, Qpre_idle_hook, |
| 1268 | 2109 /* Quit is inhibited as a result of being within next-event so |
| 2110 we need to fix that. */ | |
| 2111 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION | UNINHIBIT_QUIT); | |
| 428 | 2112 } |
| 2113 | |
| 2114 DEFUN ("next-event", Fnext_event, 0, 2, 0, /* | |
| 2115 Return the next available event. | |
| 2116 Pass this object to `dispatch-event' to handle it. | |
| 2117 In most cases, you will want to use `next-command-event', which returns | |
| 2118 the next available "user" event (i.e. keypress, button-press, | |
| 2119 button-release, or menu selection) instead of this function. | |
| 2120 | |
| 2121 If EVENT is non-nil, it should be an event object and will be filled in | |
| 2122 and returned; otherwise a new event object will be created and returned. | |
| 2123 If PROMPT is non-nil, it should be a string and will be displayed in the | |
| 2124 echo area while this function is waiting for an event. | |
| 2125 | |
| 2126 The next available event will be | |
| 2127 | |
| 2128 -- any events in `unread-command-events' or `unread-command-event'; else | |
| 2129 -- the next event in the currently executing keyboard macro, if any; else | |
| 442 | 2130 -- an event queued by `enqueue-eval-event', if any, or any similar event |
| 2131 queued internally, such as a misc-user event. (For example, when an item | |
| 2132 is selected from a menu or from a `question'-type dialog box, the item's | |
| 2133 callback is not immediately executed, but instead a misc-user event | |
| 2134 is generated and placed onto this queue; when it is dispatched, the | |
| 2135 callback is executed.) Else | |
| 428 | 2136 -- the next available event from the window system or terminal driver. |
| 2137 | |
| 2138 In the last case, this function will block until an event is available. | |
| 2139 | |
| 2140 The returned event will be one of the following types: | |
| 2141 | |
| 2142 -- a key-press event. | |
| 2143 -- a button-press or button-release event. | |
| 2144 -- a misc-user-event, meaning the user selected an item on a menu or used | |
| 2145 the scrollbar. | |
| 2146 -- a process event, meaning that output from a subprocess is available. | |
| 2147 -- a timeout event, meaning that a timeout has elapsed. | |
| 2148 -- an eval event, which simply causes a function to be executed when the | |
| 2149 event is dispatched. Eval events are generated by `enqueue-eval-event' | |
| 2150 or by certain other conditions happening. | |
| 2151 -- a magic event, indicating that some window-system-specific event | |
| 2152 happened (such as a focus-change notification) that must be handled | |
| 2153 synchronously with other events. `dispatch-event' knows what to do with | |
| 2154 these events. | |
| 2155 */ | |
| 2156 (event, prompt)) | |
| 2157 { | |
| 2158 /* This function can call lisp */ | |
| 2159 /* #### We start out using the selected console before an event | |
| 2160 is received, for echoing the partially completed command. | |
| 2161 This is most definitely wrong -- there needs to be a separate | |
| 2162 echo area for each console! */ | |
| 2163 struct console *con = XCONSOLE (Vselected_console); | |
| 2164 struct command_builder *command_builder = | |
| 2165 XCOMMAND_BUILDER (con->command_builder); | |
| 2166 int store_this_key = 0; | |
| 2167 struct gcpro gcpro1; | |
| 853 | 2168 int depth; |
| 1292 | 2169 PROFILE_DECLARE (); |
| 428 | 2170 |
| 2171 GCPRO1 (event); | |
| 853 | 2172 |
| 1268 | 2173 /* This is not strictly necessary. Trying to retrieve an event inside of |
| 2174 a modal loop can cause major problems (see event_stream_quit_p()), but | |
| 2175 the event-specific code knows about this and will make sure we don't | |
| 2176 do anything dangerous. However, if we've gotten here, it's highly | |
| 2177 likely that some code is trying to fetch user events (e.g. in custom | |
| 2178 dialog-box code), and will almost certainly deadlock, so it's probably | |
| 2179 best to error out. #### This could cause problems because there are | |
| 2180 (potentially, at least) legitimate reasons for calling next-event | |
| 2181 inside of a modal loop, in particular if the code is trying to search | |
| 2182 for a timeout event, which will still get retrieved in such a case. | |
| 2183 However, the code to error in such a case has already been present for | |
| 2184 a long time without obvious problems so leaving it in isn't so | |
| 1279 | 2185 bad. |
| 2186 | |
| 2187 #### I used to conditionalize on in_modal_loop but that fails utterly | |
| 2188 because event-msw.c specifically calls Fnext_event() inside of a modal | |
| 2189 loop to clear the dispatch queue. --ben */ | |
| 1315 | 2190 #ifdef HAVE_MENUBARS |
| 1279 | 2191 if (in_menu_callback) |
| 2192 invalid_operation ("Attempt to call next-event inside menu callback", | |
| 1268 | 2193 Qunbound); |
| 1315 | 2194 #endif /* HAVE_MENUBARS */ |
| 1268 | 2195 |
| 1292 | 2196 PROFILE_RECORD_ENTERING_SECTION (Qnext_event); |
| 2197 | |
| 853 | 2198 depth = begin_dont_check_for_quit (); |
| 428 | 2199 |
| 2200 if (NILP (event)) | |
| 2201 event = Fmake_event (Qnil, Qnil); | |
| 2202 else | |
| 2203 CHECK_LIVE_EVENT (event); | |
| 2204 | |
| 2205 if (!NILP (prompt)) | |
| 2206 { | |
| 2207 Bytecount len; | |
| 2208 CHECK_STRING (prompt); | |
| 2209 | |
| 2210 len = XSTRING_LENGTH (prompt); | |
| 2211 if (command_builder->echo_buf_length < len) | |
| 2212 len = command_builder->echo_buf_length - 1; | |
| 2213 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len); | |
| 2214 command_builder->echo_buf[len] = 0; | |
| 2215 command_builder->echo_buf_index = len; | |
| 2216 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)), | |
| 2217 command_builder->echo_buf, | |
| 2218 Qnil, 0, | |
| 2219 command_builder->echo_buf_index, | |
| 2220 Qcommand); | |
| 2221 } | |
| 2222 | |
| 2223 start_over_and_avoid_hosage: | |
| 2224 | |
| 2225 /* If there is something in unread-command-events, simply return it. | |
| 2226 But do some error checking to make sure the user hasn't put something | |
| 2227 in the unread-command-events that they shouldn't have. | |
| 2228 This does not update this-command-keys and recent-keys. | |
| 2229 */ | |
| 2230 if (!NILP (Vunread_command_events)) | |
| 2231 { | |
| 2232 if (!CONSP (Vunread_command_events)) | |
| 2233 { | |
| 2234 Vunread_command_events = Qnil; | |
| 563 | 2235 signal_error_1 (Qwrong_type_argument, |
| 428 | 2236 list3 (Qconsp, Vunread_command_events, |
| 2237 Qunread_command_events)); | |
| 2238 } | |
| 2239 else | |
| 2240 { | |
| 2241 Lisp_Object e = XCAR (Vunread_command_events); | |
| 2242 Vunread_command_events = XCDR (Vunread_command_events); | |
| 2243 if (!EVENTP (e) || !command_event_p (e)) | |
| 563 | 2244 signal_error_1 (Qwrong_type_argument, |
| 428 | 2245 list3 (Qcommand_event_p, e, Qunread_command_events)); |
| 853 | 2246 redisplay_no_pre_idle_hook (); |
| 428 | 2247 if (!EQ (e, event)) |
| 2248 Fcopy_event (e, event); | |
| 2249 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event); | |
| 2250 } | |
| 2251 } | |
| 2252 | |
| 2253 /* Do similar for unread-command-event (obsoleteness support). */ | |
| 2254 else if (!NILP (Vunread_command_event)) | |
| 2255 { | |
| 2256 Lisp_Object e = Vunread_command_event; | |
| 2257 Vunread_command_event = Qnil; | |
| 2258 | |
| 2259 if (!EVENTP (e) || !command_event_p (e)) | |
| 2260 { | |
| 563 | 2261 signal_error_1 (Qwrong_type_argument, |
| 428 | 2262 list3 (Qeventp, e, Qunread_command_event)); |
| 2263 } | |
| 2264 if (!EQ (e, event)) | |
| 2265 Fcopy_event (e, event); | |
| 853 | 2266 redisplay_no_pre_idle_hook (); |
| 428 | 2267 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event); |
| 2268 } | |
| 2269 | |
| 2270 /* If we're executing a keyboard macro, take the next event from that, | |
| 2271 and update this-command-keys and recent-keys. | |
| 2272 Note that the unread-command-events take precedence over kbd macros. | |
| 2273 */ | |
| 2274 else | |
| 2275 { | |
| 2276 if (!NILP (Vexecuting_macro)) | |
| 2277 { | |
| 853 | 2278 redisplay_no_pre_idle_hook (); |
| 428 | 2279 pop_kbd_macro_event (event); /* This throws past us at |
| 2280 end-of-macro. */ | |
| 2281 store_this_key = 1; | |
| 2282 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event); | |
| 2283 } | |
| 2284 /* Otherwise, read a real event, possibly from the | |
| 2285 command_event_queue, and update this-command-keys and | |
| 2286 recent-keys. */ | |
| 2287 else | |
| 2288 { | |
| 2289 redisplay (); | |
| 2290 next_event_internal (event, 1); | |
| 2291 store_this_key = 1; | |
| 2292 } | |
| 2293 } | |
| 2294 | |
| 853 | 2295 /* temporarily reenable quit checking here, because arbitrary lisp |
| 2296 is executed */ | |
| 2297 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ | |
| 2298 unbind_to (depth); | |
| 428 | 2299 status_notify (); /* Notice process change */ |
| 853 | 2300 depth = begin_dont_check_for_quit (); |
| 428 | 2301 |
| 2302 /* Since we can free the most stuff here | |
| 2303 * (since this is typically called from | |
| 2304 * the command-loop top-level). */ | |
| 851 | 2305 if (need_to_check_c_alloca) |
| 2306 xemacs_c_alloca (0); /* Cause a garbage collection now */ | |
| 428 | 2307 |
| 2308 if (object_dead_p (XEVENT (event)->channel)) | |
| 2309 /* event_console_or_selected may crash if the channel is dead. | |
| 2310 Best just to eat it and get the next event. */ | |
| 2311 goto start_over_and_avoid_hosage; | |
| 2312 | |
| 2313 /* OK, now we can stop the selected-console kludge and use the | |
| 2314 actual console from the event. */ | |
| 2315 con = event_console_or_selected (event); | |
| 2316 command_builder = XCOMMAND_BUILDER (con->command_builder); | |
| 2317 | |
| 2318 switch (XEVENT_TYPE (event)) | |
| 2319 { | |
| 2320 case button_release_event: | |
| 2321 case misc_user_event: | |
| 2322 /* don't echo menu accelerator keys */ | |
| 2323 reset_key_echo (command_builder, 1); | |
| 2324 goto EXECUTE_KEY; | |
| 2325 case button_press_event: /* key or mouse input can trigger prompting */ | |
| 2326 goto STORE_AND_EXECUTE_KEY; | |
| 2327 case key_press_event: /* any key input can trigger autosave */ | |
| 2328 break; | |
| 898 | 2329 default: |
| 2330 goto RETURN; | |
| 428 | 2331 } |
| 2332 | |
| 853 | 2333 /* temporarily reenable quit checking here, because we could get stuck */ |
| 2334 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ | |
| 2335 unbind_to (depth); | |
| 428 | 2336 maybe_do_auto_save (); |
| 853 | 2337 depth = begin_dont_check_for_quit (); |
| 2338 | |
| 428 | 2339 num_input_chars++; |
| 2340 STORE_AND_EXECUTE_KEY: | |
| 2341 if (store_this_key) | |
| 2342 { | |
| 2343 echo_key_event (command_builder, event); | |
| 2344 } | |
| 2345 | |
| 2346 EXECUTE_KEY: | |
| 2347 /* Store the last-input-event. The semantics of this is that it is | |
| 2348 the thing most recently returned by next-command-event. It need | |
| 2349 not have come from the keyboard or a keyboard macro, it may have | |
| 2350 come from unread-command-events. It's always a command-event (a | |
| 2351 key, click, or menu selection), never a motion or process event. | |
| 2352 */ | |
| 2353 if (!EVENTP (Vlast_input_event)) | |
| 2354 Vlast_input_event = Fmake_event (Qnil, Qnil); | |
| 2355 if (XEVENT_TYPE (Vlast_input_event) == dead_event) | |
| 2356 { | |
| 2357 Vlast_input_event = Fmake_event (Qnil, Qnil); | |
| 563 | 2358 invalid_state ("Someone deallocated last-input-event!", Qunbound); |
| 428 | 2359 } |
| 2360 if (! EQ (event, Vlast_input_event)) | |
| 2361 Fcopy_event (event, Vlast_input_event); | |
| 2362 | |
| 2363 /* last-input-char and last-input-time are derived from | |
| 2364 last-input-event. | |
| 2365 Note that last-input-char will never have its high-bit set, in an | |
| 2366 effort to sidestep the ambiguity between M-x and oslash. | |
| 2367 */ | |
| 2862 | 2368 Vlast_input_char = Fevent_to_character (Vlast_input_event, Qnil, Qnil, Qnil); |
| 428 | 2369 { |
| 2370 EMACS_TIME t; | |
| 2371 EMACS_GET_TIME (t); | |
| 2372 if (!CONSP (Vlast_input_time)) | |
| 2373 Vlast_input_time = Fcons (Qnil, Qnil); | |
| 2374 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff); | |
| 2375 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff); | |
| 2376 if (!CONSP (Vlast_command_event_time)) | |
| 2377 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil); | |
| 2378 XCAR (Vlast_command_event_time) = | |
| 2379 make_int ((EMACS_SECS (t) >> 16) & 0xffff); | |
| 2380 XCAR (XCDR (Vlast_command_event_time)) = | |
| 2381 make_int ((EMACS_SECS (t) >> 0) & 0xffff); | |
| 2382 XCAR (XCDR (XCDR (Vlast_command_event_time))) | |
| 2383 = make_int (EMACS_USECS (t)); | |
| 2384 } | |
| 2385 /* If this key came from the keyboard or from a keyboard macro, then | |
| 2386 it goes into the recent-keys and this-command-keys vectors. | |
| 2387 If this key came from the keyboard, and we're defining a keyboard | |
| 2388 macro, then it goes into the macro. | |
| 2389 */ | |
| 2390 if (store_this_key) | |
| 2391 { | |
| 479 | 2392 if (!is_scrollbar_event (event)) /* #### not quite right, see |
| 2393 comment in execute_command_event */ | |
| 2394 push_this_command_keys (event); | |
| 428 | 2395 if (!inhibit_input_event_recording) |
| 2396 push_recent_keys (event); | |
| 2397 dribble_out_event (event); | |
| 2398 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) | |
| 2399 { | |
| 2400 if (!EVENTP (command_builder->current_events)) | |
| 2401 finalize_kbd_macro_chars (con); | |
| 2402 store_kbd_macro_event (event); | |
| 2403 } | |
| 2404 } | |
| 853 | 2405 /* If this is the help char and there is a help form, then execute |
| 2406 the help form and swallow this character. Note that | |
| 2407 execute_help_form() calls Fnext_command_event(), which calls this | |
| 2408 function, as well as Fdispatch_event. */ | |
| 428 | 2409 if (!NILP (Vhelp_form) && |
| 1204 | 2410 event_matches_key_specifier_p (event, Vhelp_char)) |
| 853 | 2411 { |
| 2412 /* temporarily reenable quit checking here, because we could get stuck */ | |
| 2413 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ | |
| 2414 unbind_to (depth); | |
| 2415 execute_help_form (command_builder, event); | |
| 2416 depth = begin_dont_check_for_quit (); | |
| 2417 } | |
| 428 | 2418 |
| 2419 RETURN: | |
| 853 | 2420 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ |
| 2421 unbind_to (depth); | |
| 2422 | |
| 1292 | 2423 PROFILE_RECORD_EXITING_SECTION (Qnext_event); |
| 2424 | |
| 428 | 2425 UNGCPRO; |
| 853 | 2426 |
| 428 | 2427 return event; |
| 2428 } | |
| 2429 | |
| 2430 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /* | |
| 2431 Return the next available "user" event. | |
| 2432 Pass this object to `dispatch-event' to handle it. | |
| 2433 | |
| 2434 If EVENT is non-nil, it should be an event object and will be filled in | |
| 2435 and returned; otherwise a new event object will be created and returned. | |
| 2436 If PROMPT is non-nil, it should be a string and will be displayed in the | |
| 2437 echo area while this function is waiting for an event. | |
| 2438 | |
| 2439 The event returned will be a keyboard, mouse press, or mouse release event. | |
| 2440 If there are non-command events available (mouse motion, sub-process output, | |
| 2441 etc) then these will be executed (with `dispatch-event') and discarded. This | |
| 2442 function is provided as a convenience; it is roughly equivalent to the lisp code | |
| 2443 | |
| 2444 (while (progn | |
| 2445 (next-event event prompt) | |
| 2446 (not (or (key-press-event-p event) | |
| 2447 (button-press-event-p event) | |
| 2448 (button-release-event-p event) | |
| 2449 (misc-user-event-p event)))) | |
| 2450 (dispatch-event event)) | |
| 2451 | |
| 2452 but it also makes a provision for displaying keystrokes in the echo area. | |
| 2453 */ | |
| 2454 (event, prompt)) | |
| 2455 { | |
| 2456 /* This function can GC */ | |
| 2457 struct gcpro gcpro1; | |
| 2458 GCPRO1 (event); | |
| 934 | 2459 |
| 428 | 2460 maybe_echo_keys (XCOMMAND_BUILDER |
| 2461 (XCONSOLE (Vselected_console)-> | |
| 2462 command_builder), 0); /* #### This sucks bigtime */ | |
| 853 | 2463 |
| 428 | 2464 for (;;) |
| 2465 { | |
| 2466 event = Fnext_event (event, prompt); | |
| 2467 if (command_event_p (event)) | |
| 2468 break; | |
| 2469 else | |
| 2470 execute_internal_event (event); | |
| 2471 } | |
| 2472 UNGCPRO; | |
| 2473 return event; | |
| 2474 } | |
| 2475 | |
| 442 | 2476 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /* |
| 2477 Dispatch any pending "magic" events. | |
| 2478 | |
| 2479 This function is useful for forcing the redisplay of native | |
| 2480 widgets. Normally these are redisplayed through a native window-system | |
| 2481 event encoded as magic event, rather than by the redisplay code. This | |
| 2482 function does not call redisplay or do any of the other things that | |
| 2483 `next-event' does. | |
| 2484 */ | |
| 2485 ()) | |
| 2486 { | |
| 2487 /* This function can GC */ | |
| 2488 Lisp_Object event = Qnil; | |
| 2489 struct gcpro gcpro1; | |
| 2490 GCPRO1 (event); | |
| 2491 event = Fmake_event (Qnil, Qnil); | |
| 2492 | |
| 2493 /* Make sure that there will be something in the native event queue | |
| 2494 so that externally managed things (e.g. widgets) get some CPU | |
| 2495 time. */ | |
| 2496 event_stream_force_event_pending (selected_frame ()); | |
| 2497 | |
| 2498 while (event_stream_event_pending_p (0)) | |
| 2499 { | |
| 2500 /* We're a generator of the command_event_queue, so we can't be a | |
| 2501 consumer as well. Also, we have no reason to consult the | |
| 2502 command_event_queue; there are only user and eval-events there, | |
| 2503 and we'd just have to put them back anyway. | |
| 2504 */ | |
| 2505 next_event_internal (event, 0); /* blocks */ | |
| 2506 if (XEVENT_TYPE (event) == magic_event || | |
| 2507 XEVENT_TYPE (event) == timeout_event || | |
| 2508 XEVENT_TYPE (event) == process_event || | |
| 2509 XEVENT_TYPE (event) == pointer_motion_event) | |
| 2510 execute_internal_event (event); | |
| 2511 else | |
| 2512 { | |
| 2513 enqueue_command_event_1 (event); | |
| 2514 break; | |
| 2515 } | |
| 2516 } | |
| 2517 | |
| 2518 Fdeallocate_event (event); | |
| 2519 UNGCPRO; | |
| 2520 return Qnil; | |
| 2521 } | |
| 2522 | |
| 428 | 2523 static void |
| 2524 reset_current_events (struct command_builder *command_builder) | |
| 2525 { | |
| 2526 Lisp_Object event = command_builder->current_events; | |
| 2527 reset_command_builder_event_chain (command_builder); | |
| 2528 if (EVENTP (event)) | |
| 2529 deallocate_event_chain (event); | |
| 2530 } | |
| 2531 | |
| 1268 | 2532 static int |
| 2286 | 2533 command_event_p_cb (Lisp_Object ev, void *UNUSED (the_data)) |
| 1268 | 2534 { |
| 2535 return command_event_p (ev); | |
| 2536 } | |
| 2537 | |
| 428 | 2538 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* |
| 2539 Discard any pending "user" events. | |
| 2540 Also cancel any kbd macro being defined. | |
| 2541 A user event is a key press, button press, button release, or | |
| 2542 "misc-user" event (menu selection or scrollbar action). | |
| 2543 */ | |
| 2544 ()) | |
| 2545 { | |
| 1318 | 2546 /* This can call Lisp */ |
| 1268 | 2547 Lisp_Object concons; |
| 2548 | |
| 2549 CONSOLE_LOOP (concons) | |
| 428 | 2550 { |
| 1268 | 2551 struct console *con = XCONSOLE (XCAR (concons)); |
| 2552 | |
| 2553 /* If a macro was being defined then we have to mark the modeline | |
| 2554 has changed to ensure that it gets updated correctly. */ | |
| 2555 if (!NILP (con->defining_kbd_macro)) | |
| 2556 MARK_MODELINE_CHANGED; | |
| 2557 con->defining_kbd_macro = Qnil; | |
| 2558 reset_current_events (XCOMMAND_BUILDER (con->command_builder)); | |
| 428 | 2559 } |
| 2560 | |
| 1268 | 2561 /* This function used to be a lot more complicated. Now, we just |
| 2562 drain the pending queue and discard all user events from the | |
| 2563 command and dispatch queues. */ | |
| 2564 event_stream_drain_queue (); | |
| 2565 | |
| 2566 map_event_chain_remove (command_event_p_cb, | |
| 2567 &dispatch_event_queue, &dispatch_event_queue_tail, | |
| 2568 0, MECR_DEALLOCATE_EVENT); | |
| 2569 map_event_chain_remove (command_event_p_cb, | |
| 2570 &command_event_queue, &command_event_queue_tail, | |
| 2571 0, MECR_DEALLOCATE_EVENT); | |
| 428 | 2572 |
| 2573 return Qnil; | |
| 2574 } | |
| 2575 | |
| 2576 | |
| 2577 /**********************************************************************/ | |
| 2578 /* pausing until an action occurs */ | |
| 2579 /**********************************************************************/ | |
| 2580 | |
| 2581 /* This is used in accept-process-output, sleep-for and sit-for. | |
| 2582 Before running any process_events in these routines, we set | |
| 1268 | 2583 recursive_sit_for to 1, and use this unwind protect to reset it to |
| 2584 Qnil upon exit. When recursive_sit_for is 1, calling sit-for will | |
| 428 | 2585 cause it to return immediately. |
| 2586 | |
| 2587 All of these routines install timeouts, so we clear the installed | |
| 2588 timeout as well. | |
| 2589 | |
| 2590 Note: It's very easy to break the desired behaviors of these | |
| 2591 3 routines. If you make any changes to anything in this area, run | |
| 2592 the regression tests at the bottom of the file. -- dmoore */ | |
| 2593 | |
| 2594 | |
| 2595 static Lisp_Object | |
| 2596 sit_for_unwind (Lisp_Object timeout_id) | |
| 2597 { | |
| 2598 if (!NILP(timeout_id)) | |
| 2599 Fdisable_timeout (timeout_id); | |
| 2600 | |
| 1268 | 2601 recursive_sit_for = 0; |
| 428 | 2602 return Qnil; |
| 2603 } | |
| 2604 | |
| 2605 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)? | |
| 2606 */ | |
| 2607 | |
| 2608 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /* | |
| 2609 Allow any pending output from subprocesses to be read by Emacs. | |
| 2610 It is read into the process' buffers or given to their filter functions. | |
| 2611 Non-nil arg PROCESS means do not return until some output has been received | |
| 2612 from PROCESS. Nil arg PROCESS means do not return until some output has | |
| 2613 been received from any process. | |
| 2614 If the second arg is non-nil, it is the maximum number of seconds to wait: | |
| 2615 this function will return after that much time even if no input has arrived | |
| 2616 from PROCESS. This argument may be a float, meaning wait some fractional | |
| 2617 part of a second. | |
| 2618 If the third arg is non-nil, it is a number of milliseconds that is added | |
| 2619 to the second arg. (This exists only for compatibility.) | |
| 2620 Return non-nil iff we received any output before the timeout expired. | |
| 2621 */ | |
| 2622 (process, timeout_secs, timeout_msecs)) | |
| 2623 { | |
| 2624 /* This function can GC */ | |
| 2625 struct gcpro gcpro1, gcpro2; | |
| 2626 Lisp_Object event = Qnil; | |
| 2627 Lisp_Object result = Qnil; | |
| 2628 int timeout_id = -1; | |
| 2629 int timeout_enabled = 0; | |
| 2630 int done = 0; | |
| 2631 struct buffer *old_buffer = current_buffer; | |
| 2632 int count; | |
| 2633 | |
| 2634 /* We preserve the current buffer but nothing else. If a focus | |
| 2635 change alters the selected window then the top level event loop | |
| 2636 will eventually alter current_buffer to match. In the mean time | |
| 2637 we don't want to mess up whatever called this function. */ | |
| 2638 | |
| 2639 if (!NILP (process)) | |
| 2640 CHECK_PROCESS (process); | |
| 2641 | |
| 2642 GCPRO2 (event, process); | |
| 2643 | |
| 2644 if (!NILP (timeout_secs) || !NILP (timeout_msecs)) | |
| 2645 { | |
| 2646 unsigned long msecs = 0; | |
| 2647 if (!NILP (timeout_secs)) | |
| 2648 msecs = lisp_number_to_milliseconds (timeout_secs, 1); | |
| 2649 if (!NILP (timeout_msecs)) | |
| 2650 { | |
| 2651 CHECK_NATNUM (timeout_msecs); | |
| 2652 msecs += XINT (timeout_msecs); | |
| 2653 } | |
| 2654 if (msecs) | |
| 2655 { | |
| 2656 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); | |
| 2657 timeout_enabled = 1; | |
| 2658 } | |
| 2659 } | |
| 2660 | |
| 2661 event = Fmake_event (Qnil, Qnil); | |
| 2662 | |
| 2663 count = specpdl_depth (); | |
| 2664 record_unwind_protect (sit_for_unwind, | |
| 2665 timeout_enabled ? make_int (timeout_id) : Qnil); | |
| 1268 | 2666 recursive_sit_for = 1; |
| 428 | 2667 |
| 2668 while (!done && | |
| 2669 ((NILP (process) && timeout_enabled) || | |
| 2670 (NILP (process) && event_stream_event_pending_p (0)) || | |
| 2671 (!NILP (process)))) | |
| 2672 /* Calling detect_input_pending() is the wrong thing here, because | |
| 2673 that considers the Vunread_command_events and command_event_queue. | |
| 2674 We don't need to look at the command_event_queue because we are | |
| 2675 only interested in process events, which don't go on that. In | |
| 2676 fact, we can't read from it anyway, because we put stuff on it. | |
| 2677 | |
| 2678 Note that event_stream->event_pending_p must be called in such | |
| 2679 a way that it says whether any events *of any kind* are ready, | |
| 2680 not just user events, or (accept-process-output nil) will fail | |
| 2681 to dispatch any process events that may be on the queue. It is | |
| 2682 not clear to me that this is important, because the top-level | |
| 2683 loop will process it, and I don't think that there is ever a | |
| 2684 time when one calls accept-process-output with a nil argument | |
| 2685 and really need the processes to be handled. */ | |
| 2686 { | |
| 2687 /* If our timeout has arrived, we move along. */ | |
| 2688 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0)) | |
| 2689 { | |
| 2690 timeout_enabled = 0; | |
| 2691 done = 1; /* We're done. */ | |
| 2692 continue; /* Don't call next_event_internal */ | |
| 2693 } | |
| 2694 | |
| 2695 next_event_internal (event, 0); | |
| 2696 switch (XEVENT_TYPE (event)) | |
| 2697 { | |
| 2698 case process_event: | |
| 2699 { | |
| 2700 if (NILP (process) || | |
| 1204 | 2701 EQ (XEVENT_PROCESS_PROCESS (event), process)) |
| 428 | 2702 { |
| 2703 done = 1; | |
| 2704 /* RMS's version always returns nil when proc is nil, | |
| 2705 and only returns t if input ever arrived on proc. */ | |
| 2706 result = Qt; | |
| 2707 } | |
| 2708 | |
| 2709 execute_internal_event (event); | |
| 2710 break; | |
| 2711 } | |
| 2712 case timeout_event: | |
| 2713 /* We execute the event even if it's ours, and notice that it's | |
| 2714 happened above. */ | |
| 2715 case pointer_motion_event: | |
| 2716 case magic_event: | |
| 2717 { | |
| 2718 execute_internal_event (event); | |
| 2719 break; | |
| 2720 } | |
| 2721 default: | |
| 2722 { | |
| 2723 enqueue_command_event_1 (event); | |
| 2724 break; | |
| 2725 } | |
| 2726 } | |
| 2727 } | |
| 2728 | |
| 771 | 2729 unbind_to_1 (count, timeout_enabled ? make_int (timeout_id) : Qnil); |
| 428 | 2730 |
| 2731 Fdeallocate_event (event); | |
| 853 | 2732 |
| 2733 status_notify (); | |
| 2734 | |
| 428 | 2735 UNGCPRO; |
| 2736 current_buffer = old_buffer; | |
| 2737 return result; | |
| 2738 } | |
| 2739 | |
| 2740 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* | |
| 444 | 2741 Pause, without updating display, for SECONDS seconds. |
| 2742 SECONDS may be a float, allowing pauses for fractional parts of a second. | |
| 428 | 2743 |
| 2744 It is recommended that you never call sleep-for from inside of a process | |
| 444 | 2745 filter function or timer event (either synchronous or asynchronous). |
| 428 | 2746 */ |
| 2747 (seconds)) | |
| 2748 { | |
| 2749 /* This function can GC */ | |
| 2750 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); | |
| 2751 int id; | |
| 2752 Lisp_Object event = Qnil; | |
| 2753 int count; | |
| 2754 struct gcpro gcpro1; | |
| 2755 | |
| 2756 GCPRO1 (event); | |
| 2757 | |
| 2758 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); | |
| 2759 event = Fmake_event (Qnil, Qnil); | |
| 2760 | |
| 2761 count = specpdl_depth (); | |
| 2762 record_unwind_protect (sit_for_unwind, make_int (id)); | |
| 1268 | 2763 recursive_sit_for = 1; |
| 428 | 2764 |
| 2765 while (1) | |
| 2766 { | |
| 2767 /* If our timeout has arrived, we move along. */ | |
| 2768 if (!event_stream_wakeup_pending_p (id, 0)) | |
| 2769 goto DONE_LABEL; | |
| 2770 | |
| 2771 /* We're a generator of the command_event_queue, so we can't be a | |
| 2772 consumer as well. We don't care about command and eval-events | |
| 2773 anyway. | |
| 2774 */ | |
| 2775 next_event_internal (event, 0); /* blocks */ | |
| 2776 switch (XEVENT_TYPE (event)) | |
| 2777 { | |
| 2778 case timeout_event: | |
| 2779 /* We execute the event even if it's ours, and notice that it's | |
| 2780 happened above. */ | |
| 2781 case process_event: | |
| 2782 case pointer_motion_event: | |
| 2783 case magic_event: | |
| 2784 { | |
| 2785 execute_internal_event (event); | |
| 2786 break; | |
| 2787 } | |
| 2788 default: | |
| 2789 { | |
| 2790 enqueue_command_event_1 (event); | |
| 2791 break; | |
| 2792 } | |
| 2793 } | |
| 2794 } | |
| 2795 DONE_LABEL: | |
| 771 | 2796 unbind_to_1 (count, make_int (id)); |
| 428 | 2797 Fdeallocate_event (event); |
| 2798 UNGCPRO; | |
| 2799 return Qnil; | |
| 2800 } | |
| 2801 | |
| 2802 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /* | |
| 444 | 2803 Perform redisplay, then wait SECONDS seconds or until user input is available. |
| 2804 SECONDS may be a float, meaning a fractional part of a second. | |
| 2805 Optional second arg NODISPLAY non-nil means don't redisplay; just wait. | |
| 428 | 2806 Redisplay is preempted as always if user input arrives, and does not |
| 2807 happen if input is available before it starts. | |
| 2808 Value is t if waited the full time with no input arriving. | |
| 2809 | |
| 2810 If sit-for is called from within a process filter function or timer | |
| 2811 event (either synchronous or asynchronous) it will return immediately. | |
| 2812 */ | |
| 2813 (seconds, nodisplay)) | |
| 2814 { | |
| 2815 /* This function can GC */ | |
| 2816 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); | |
| 2817 Lisp_Object event, result; | |
| 2818 struct gcpro gcpro1; | |
| 2819 int id; | |
| 2820 int count; | |
| 2821 | |
| 2822 /* The unread-command-events count as pending input */ | |
| 2823 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) | |
| 2824 return Qnil; | |
| 2825 | |
| 2826 /* If the command-builder already has user-input on it (not eval events) | |
| 2827 then that means we're done too. | |
| 2828 */ | |
| 2829 if (!NILP (command_event_queue)) | |
| 2830 { | |
| 2831 EVENT_CHAIN_LOOP (event, command_event_queue) | |
| 2832 { | |
| 2833 if (command_event_p (event)) | |
| 2834 return Qnil; | |
| 2835 } | |
| 2836 } | |
| 2837 | |
| 2838 /* If we're in a macro, or noninteractive, or early in temacs, then | |
| 2839 don't wait. */ | |
| 2840 if (noninteractive || !NILP (Vexecuting_macro)) | |
| 2841 return Qnil; | |
| 2842 | |
| 2843 /* Recursive call from a filter function or timeout handler. */ | |
| 1268 | 2844 if (recursive_sit_for) |
| 428 | 2845 { |
| 2846 if (!event_stream_event_pending_p (1) && NILP (nodisplay)) | |
| 2847 redisplay (); | |
| 2848 return Qnil; | |
| 2849 } | |
| 2850 | |
| 2851 | |
| 2852 /* Otherwise, start reading events from the event_stream. | |
| 2853 Do this loop at least once even if (sit-for 0) so that we | |
| 2854 redisplay when no input pending. | |
| 2855 */ | |
| 2856 GCPRO1 (event); | |
| 2857 event = Fmake_event (Qnil, Qnil); | |
| 2858 | |
| 2859 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc. | |
| 2860 events get processed. The old (pre-19.12) code special-cased this | |
| 2861 and didn't generate a wakeup, but the resulting behavior was less than | |
| 2862 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout | |
| 2863 the E-Lisp universe. */ | |
| 2864 | |
| 2865 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); | |
| 2866 | |
| 2867 count = specpdl_depth (); | |
| 2868 record_unwind_protect (sit_for_unwind, make_int (id)); | |
| 1268 | 2869 recursive_sit_for = 1; |
| 428 | 2870 |
| 2871 while (1) | |
| 2872 { | |
| 2873 /* If there is no user input pending, then redisplay. | |
| 2874 */ | |
| 2875 if (!event_stream_event_pending_p (1) && NILP (nodisplay)) | |
| 2876 redisplay (); | |
| 2877 | |
| 2878 /* If our timeout has arrived, we move along. */ | |
| 2879 if (!event_stream_wakeup_pending_p (id, 0)) | |
| 2880 { | |
| 2881 result = Qt; | |
| 2882 goto DONE_LABEL; | |
| 2883 } | |
| 2884 | |
| 2885 /* We're a generator of the command_event_queue, so we can't be a | |
| 2886 consumer as well. In fact, we know there's nothing on the | |
| 2887 command_event_queue that we didn't just put there. | |
| 2888 */ | |
| 2889 next_event_internal (event, 0); /* blocks */ | |
| 2890 | |
| 2891 if (command_event_p (event)) | |
| 2892 { | |
| 2893 result = Qnil; | |
| 2894 goto DONE_LABEL; | |
| 2895 } | |
| 2896 switch (XEVENT_TYPE (event)) | |
| 2897 { | |
| 2898 case eval_event: | |
| 2899 { | |
| 2900 /* eval-events get delayed until later. */ | |
| 2901 enqueue_command_event (Fcopy_event (event, Qnil)); | |
| 2902 break; | |
| 2903 } | |
| 2904 | |
| 2905 case timeout_event: | |
| 2906 /* We execute the event even if it's ours, and notice that it's | |
| 2907 happened above. */ | |
| 2908 default: | |
| 2909 { | |
| 2910 execute_internal_event (event); | |
| 2911 break; | |
| 2912 } | |
| 2913 } | |
| 2914 } | |
| 2915 | |
| 2916 DONE_LABEL: | |
| 771 | 2917 unbind_to_1 (count, make_int (id)); |
| 428 | 2918 |
| 2919 /* Put back the event (if any) that made Fsit_for() exit before the | |
| 2920 timeout. Note that it is being added to the back of the queue, which | |
| 2921 would be inappropriate if there were any user events on the queue | |
| 2922 already: we would be misordering them. But we know that there are | |
| 2923 no user-events on the queue, or else we would not have reached this | |
| 2924 point at all. | |
| 2925 */ | |
| 2926 if (NILP (result)) | |
| 2927 enqueue_command_event (event); | |
| 2928 else | |
| 2929 Fdeallocate_event (event); | |
| 2930 | |
| 2931 UNGCPRO; | |
| 2932 return result; | |
| 2933 } | |
| 2934 | |
| 442 | 2935 /* This handy little function is used by select-x.c to wait for replies |
| 2936 from processes that aren't really processes (e.g. the X server) */ | |
| 428 | 2937 void |
| 2938 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg) | |
| 2939 { | |
| 2940 /* This function can GC */ | |
| 2941 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 2942 struct gcpro gcpro1; | |
| 2943 GCPRO1 (event); | |
| 2944 | |
| 2945 while (!(*predicate) (predicate_arg)) | |
| 2946 { | |
| 2947 /* We're a generator of the command_event_queue, so we can't be a | |
| 2948 consumer as well. Also, we have no reason to consult the | |
| 2949 command_event_queue; there are only user and eval-events there, | |
| 2950 and we'd just have to put them back anyway. | |
| 2951 */ | |
| 2952 next_event_internal (event, 0); | |
| 2953 if (command_event_p (event) | |
| 2954 || (XEVENT_TYPE (event) == eval_event) | |
| 2955 || (XEVENT_TYPE (event) == magic_eval_event)) | |
| 2956 enqueue_command_event_1 (event); | |
| 2957 else | |
| 2958 execute_internal_event (event); | |
| 2959 } | |
| 2960 UNGCPRO; | |
| 2961 } | |
| 2962 | |
| 2963 | |
| 2964 /**********************************************************************/ | |
| 2965 /* dispatching events; command builder */ | |
| 2966 /**********************************************************************/ | |
| 2967 | |
| 2968 static void | |
| 2969 execute_internal_event (Lisp_Object event) | |
| 2970 { | |
| 1292 | 2971 PROFILE_DECLARE (); |
| 2972 | |
| 428 | 2973 /* events on dead channels get silently eaten */ |
| 2974 if (object_dead_p (XEVENT (event)->channel)) | |
| 2975 return; | |
| 2976 | |
| 1292 | 2977 PROFILE_RECORD_ENTERING_SECTION (QSexecute_internal_event); |
| 2978 | |
| 428 | 2979 /* This function can GC */ |
| 2980 switch (XEVENT_TYPE (event)) | |
| 2981 { | |
| 2982 case empty_event: | |
| 1292 | 2983 goto done; |
| 428 | 2984 |
| 2985 case eval_event: | |
| 2986 { | |
| 1204 | 2987 call1 (XEVENT_EVAL_FUNCTION (event), |
| 2988 XEVENT_EVAL_OBJECT (event)); | |
| 1292 | 2989 goto done; |
| 428 | 2990 } |
| 2991 | |
| 2992 case magic_eval_event: | |
| 2993 { | |
| 1204 | 2994 XEVENT_MAGIC_EVAL_INTERNAL_FUNCTION (event) |
| 2995 XEVENT_MAGIC_EVAL_OBJECT (event); | |
| 1292 | 2996 goto done; |
| 428 | 2997 } |
| 2998 | |
| 2999 case pointer_motion_event: | |
| 3000 { | |
| 3001 if (!NILP (Vmouse_motion_handler)) | |
| 3002 call1 (Vmouse_motion_handler, event); | |
| 1292 | 3003 goto done; |
| 428 | 3004 } |
| 3005 | |
| 3006 case process_event: | |
| 3007 { | |
| 1204 | 3008 Lisp_Object p = XEVENT_PROCESS_PROCESS (event); |
| 428 | 3009 Charcount readstatus; |
| 853 | 3010 int iter; |
| 3011 | |
| 3012 assert (PROCESSP (p)); | |
| 3013 for (iter = 0; iter < 2; iter++) | |
| 3014 { | |
| 3015 if (iter == 1 && !process_has_separate_stderr (p)) | |
| 3016 break; | |
| 3017 while ((readstatus = read_process_output (p, iter)) > 0) | |
| 3018 ; | |
| 3019 if (readstatus > 0) | |
| 3020 ; /* this clauses never gets executed but | |
| 3021 allows the #ifdefs to work cleanly. */ | |
| 428 | 3022 #ifdef EWOULDBLOCK |
| 853 | 3023 else if (readstatus == -1 && errno == EWOULDBLOCK) |
| 3024 ; | |
| 428 | 3025 #endif /* EWOULDBLOCK */ |
| 3026 #ifdef EAGAIN | |
| 853 | 3027 else if (readstatus == -1 && errno == EAGAIN) |
| 3028 ; | |
| 428 | 3029 #endif /* EAGAIN */ |
| 853 | 3030 else if ((readstatus == 0 && |
| 3031 /* Note that we cannot distinguish between no input | |
| 3032 available now and a closed pipe. | |
| 3033 With luck, a closed pipe will be accompanied by | |
| 3034 subprocess termination and SIGCHLD. */ | |
| 3035 (!network_connection_p (p) || | |
| 3036 /* | |
| 3037 When connected to ToolTalk (i.e. | |
| 3038 connected_via_filedesc_p()), it's not possible to | |
| 3039 reliably determine whether there is a message | |
| 3040 waiting for ToolTalk to receive. ToolTalk expects | |
| 3041 to have tt_message_receive() called exactly once | |
| 3042 every time the file descriptor becomes active, so | |
| 3043 the filter function forces this by returning 0. | |
| 3044 Emacs must not interpret this as a closed pipe. */ | |
| 3045 connected_via_filedesc_p (XPROCESS (p)))) | |
| 3046 | |
| 3047 /* On some OSs with ptys, when the process on one end of | |
| 3048 a pty exits, the other end gets an error reading with | |
| 3049 errno = EIO instead of getting an EOF (0 bytes read). | |
| 3050 Therefore, if we get an error reading and errno = | |
| 3051 EIO, just continue, because the child process has | |
| 3052 exited and should clean itself up soon (e.g. when we | |
| 3053 get a SIGCHLD). */ | |
| 535 | 3054 #ifdef EIO |
| 853 | 3055 || (readstatus == -1 && errno == EIO) |
| 428 | 3056 #endif |
| 535 | 3057 |
| 853 | 3058 ) |
| 3059 { | |
| 3060 /* Currently, we rely on SIGCHLD to indicate that the | |
| 3061 process has terminated. Unfortunately, on some systems | |
| 3062 the SIGCHLD gets missed some of the time. So we put an | |
| 3063 additional check in status_notify() to see whether a | |
| 3064 process has terminated. We must tell status_notify() | |
| 3065 to enable that check, and we do so now. */ | |
| 3066 kick_status_notify (); | |
| 3067 } | |
| 898 | 3068 else |
| 3069 { | |
| 3070 /* Deactivate network connection */ | |
| 3071 Lisp_Object status = Fprocess_status (p); | |
| 3072 if (EQ (status, Qopen) | |
| 3073 /* In case somebody changes the theory of whether to | |
| 3074 return open as opposed to run for network connection | |
| 3075 "processes"... */ | |
| 3076 || EQ (status, Qrun)) | |
| 3077 update_process_status (p, Qexit, 256, 0); | |
| 3078 deactivate_process (p); | |
| 3079 status_notify (); | |
| 3080 } | |
| 853 | 3081 |
| 3082 /* We must call status_notify here to allow the | |
| 3083 event_stream->unselect_process_cb to be run if appropriate. | |
| 3084 Otherwise, dead fds may be selected for, and we will get a | |
| 3085 continuous stream of process events for them. Since we don't | |
| 3086 return until all process events have been flushed, we would | |
| 3087 get stuck here, processing events on a process whose status | |
| 3025 | 3088 was `exit'. Call this after dispatch-event, or the fds will |
| 853 | 3089 have been closed before we read the last data from them. |
| 3090 It's safe for the filter to signal an error because | |
| 3091 status_notify() will be called on return to top-level. | |
| 3092 */ | |
| 3093 status_notify (); | |
| 428 | 3094 } |
| 1292 | 3095 goto done; |
| 428 | 3096 } |
| 3097 | |
| 3098 case timeout_event: | |
| 3099 { | |
| 440 | 3100 Lisp_Event *e = XEVENT (event); |
| 934 | 3101 |
| 1204 | 3102 if (!NILP (EVENT_TIMEOUT_FUNCTION (e))) |
| 3103 call1 (EVENT_TIMEOUT_FUNCTION (e), | |
| 3104 EVENT_TIMEOUT_OBJECT (e)); | |
| 1292 | 3105 goto done; |
| 428 | 3106 } |
| 3107 case magic_event: | |
| 3108 event_stream_handle_magic_event (XEVENT (event)); | |
| 1292 | 3109 goto done; |
| 428 | 3110 default: |
| 2500 | 3111 ABORT (); |
| 428 | 3112 } |
| 1292 | 3113 |
| 3114 done: | |
| 3115 PROFILE_RECORD_EXITING_SECTION (QSexecute_internal_event); | |
| 428 | 3116 } |
| 3117 | |
| 3118 | |
| 3119 | |
| 3120 static void | |
| 3121 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain) | |
| 3122 { | |
| 3123 Lisp_Object first_before_suffix = | |
| 3124 event_chain_find_previous (Vthis_command_keys, suffix); | |
| 3125 | |
| 3126 if (NILP (first_before_suffix)) | |
| 3127 Vthis_command_keys = chain; | |
| 3128 else | |
| 3129 XSET_EVENT_NEXT (first_before_suffix, chain); | |
| 3130 deallocate_event_chain (suffix); | |
| 3131 Vthis_command_keys_tail = event_chain_tail (chain); | |
| 3132 } | |
| 3133 | |
| 3134 static void | |
| 3135 command_builder_replace_suffix (struct command_builder *builder, | |
| 3136 Lisp_Object suffix, Lisp_Object chain) | |
| 3137 { | |
| 3138 Lisp_Object first_before_suffix = | |
| 3139 event_chain_find_previous (builder->current_events, suffix); | |
| 3140 | |
| 3141 if (NILP (first_before_suffix)) | |
| 3142 builder->current_events = chain; | |
| 3143 else | |
| 3144 XSET_EVENT_NEXT (first_before_suffix, chain); | |
| 3145 deallocate_event_chain (suffix); | |
| 3146 builder->most_current_event = event_chain_tail (chain); | |
| 3147 } | |
| 3148 | |
| 3149 static Lisp_Object | |
| 3150 command_builder_find_leaf_1 (struct command_builder *builder) | |
| 3151 { | |
| 3152 Lisp_Object event0 = builder->current_events; | |
| 3153 | |
| 3154 if (NILP (event0)) | |
| 3155 return Qnil; | |
| 3156 | |
| 3157 return event_binding (event0, 1); | |
| 3158 } | |
| 3159 | |
| 1268 | 3160 static void |
| 3161 maybe_kbd_translate (Lisp_Object event) | |
| 3162 { | |
| 3163 Ichar c; | |
| 3164 int did_translate = 0; | |
| 3165 | |
| 3166 if (XEVENT_TYPE (event) != key_press_event) | |
| 3167 return; | |
| 3168 if (!HASH_TABLEP (Vkeyboard_translate_table)) | |
| 3169 return; | |
| 3170 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero)) | |
| 3171 return; | |
| 3172 | |
| 2828 | 3173 c = event_to_character (event, 0, 0); |
| 1268 | 3174 if (c != -1) |
| 3175 { | |
| 3176 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table, | |
| 3177 Qnil); | |
| 3178 if (!NILP (traduit) && SYMBOLP (traduit)) | |
| 3179 { | |
| 3180 XSET_EVENT_KEY_KEYSYM (event, traduit); | |
| 3181 XSET_EVENT_KEY_MODIFIERS (event, 0); | |
| 3182 did_translate = 1; | |
| 3183 } | |
| 3184 else if (CHARP (traduit)) | |
| 3185 { | |
| 3186 /* This used to call Fcharacter_to_event() directly into EVENT, | |
| 3187 but that can eradicate timestamps and other such stuff. | |
| 3188 This way is safer. */ | |
| 3189 Lisp_Object ev2 = Fmake_event (Qnil, Qnil); | |
| 3190 | |
| 3191 character_to_event (XCHAR (traduit), XEVENT (ev2), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4775
diff
changeset
|
3192 XCONSOLE (XEVENT_CHANNEL (event)), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4775
diff
changeset
|
3193 high_bit_is_meta, 1); |
| 1268 | 3194 XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); |
| 3195 XSET_EVENT_KEY_MODIFIERS (event, XEVENT_KEY_MODIFIERS (ev2)); | |
| 3196 Fdeallocate_event (ev2); | |
| 3197 did_translate = 1; | |
| 3198 } | |
| 3199 } | |
| 3200 | |
| 3201 if (!did_translate) | |
| 3202 { | |
| 3203 Lisp_Object traduit = Fgethash (XEVENT_KEY_KEYSYM (event), | |
| 3204 Vkeyboard_translate_table, Qnil); | |
| 3205 if (!NILP (traduit) && SYMBOLP (traduit)) | |
| 3206 { | |
| 3207 XSET_EVENT_KEY_KEYSYM (event, traduit); | |
| 3208 did_translate = 1; | |
| 3209 } | |
| 3210 else if (CHARP (traduit)) | |
| 3211 { | |
| 3212 /* This used to call Fcharacter_to_event() directly into EVENT, | |
| 3213 but that can eradicate timestamps and other such stuff. | |
| 3214 This way is safer. */ | |
| 3215 Lisp_Object ev2 = Fmake_event (Qnil, Qnil); | |
| 3216 | |
| 3217 character_to_event (XCHAR (traduit), XEVENT (ev2), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4775
diff
changeset
|
3218 XCONSOLE (XEVENT_CHANNEL (event)), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4775
diff
changeset
|
3219 high_bit_is_meta, 1); |
| 1268 | 3220 XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); |
| 3221 XSET_EVENT_KEY_MODIFIERS (event, | |
| 3222 XEVENT_KEY_MODIFIERS (event) | | |
| 3223 XEVENT_KEY_MODIFIERS (ev2)); | |
| 3224 | |
| 3225 Fdeallocate_event (ev2); | |
| 3226 did_translate = 1; | |
| 3227 } | |
| 3228 } | |
| 3229 | |
| 3230 #ifdef DEBUG_XEMACS | |
| 3231 if (did_translate) | |
| 3232 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event); | |
| 3233 #endif | |
| 3234 } | |
| 3235 | |
| 428 | 3236 /* See if we can do function-key-map or key-translation-map translation |
| 3237 on the current events in the command builder. If so, do this, and | |
| 771 | 3238 return the resulting binding, if any. |
| 3239 | |
| 3240 DID_MUNGE must be initialized before calling this function. If munging | |
| 3241 happened, DID_MUNGE will be non-zero; otherwise, it will be left alone. | |
| 3242 */ | |
| 428 | 3243 |
| 3244 static Lisp_Object | |
| 3245 munge_keymap_translate (struct command_builder *builder, | |
| 3246 enum munge_me_out_the_door munge, | |
| 771 | 3247 int has_normal_binding_p, int *did_munge) |
| 428 | 3248 { |
| 3249 Lisp_Object suffix; | |
| 3250 | |
| 1204 | 3251 EVENT_CHAIN_LOOP (suffix, builder->first_mungeable_event[munge]) |
| 428 | 3252 { |
| 3253 Lisp_Object result = munging_key_map_event_binding (suffix, munge); | |
| 3254 | |
| 3255 if (NILP (result)) | |
| 3256 continue; | |
| 3257 | |
| 3258 if (KEYMAPP (result)) | |
| 3259 { | |
| 3260 if (NILP (builder->last_non_munged_event) | |
| 3261 && !has_normal_binding_p) | |
| 3262 builder->last_non_munged_event = builder->most_current_event; | |
| 3263 } | |
| 3264 else | |
| 3265 builder->last_non_munged_event = Qnil; | |
| 3266 | |
| 3267 if (!KEYMAPP (result) && | |
| 3268 !VECTORP (result) && | |
| 3269 !STRINGP (result)) | |
| 3270 { | |
| 3271 struct gcpro gcpro1; | |
| 3272 GCPRO1 (suffix); | |
| 3273 result = call1 (result, Qnil); | |
| 3274 UNGCPRO; | |
| 3275 if (NILP (result)) | |
| 3276 return Qnil; | |
| 3277 } | |
| 3278 | |
| 3279 if (KEYMAPP (result)) | |
| 3280 return result; | |
| 3281 | |
| 3282 if (VECTORP (result) || STRINGP (result)) | |
| 3283 { | |
| 3284 Lisp_Object new_chain = key_sequence_to_event_chain (result); | |
| 3285 Lisp_Object tempev; | |
| 3286 | |
| 3287 /* If the first_mungeable_event of the other munger is | |
| 3288 within the events we're munging, then it will point to | |
| 3289 deallocated events afterwards, which is bad -- so make it | |
| 3290 point at the beginning of the munged events. */ | |
| 3291 EVENT_CHAIN_LOOP (tempev, suffix) | |
| 3292 { | |
| 3293 Lisp_Object *mungeable_event = | |
| 1204 | 3294 &builder->first_mungeable_event[1 - munge]; |
| 428 | 3295 if (EQ (tempev, *mungeable_event)) |
| 3296 { | |
| 3297 *mungeable_event = new_chain; | |
| 3298 break; | |
| 3299 } | |
| 3300 } | |
| 3301 | |
| 771 | 3302 /* Now munge the current event chain in the command builder. */ |
| 428 | 3303 command_builder_replace_suffix (builder, suffix, new_chain); |
| 1204 | 3304 builder->first_mungeable_event[munge] = Qnil; |
| 771 | 3305 |
| 3306 *did_munge = 1; | |
| 428 | 3307 |
| 793 | 3308 return command_builder_find_leaf_1 (builder); |
| 428 | 3309 } |
| 3310 | |
| 563 | 3311 signal_error (Qinvalid_key_binding, |
| 3312 (munge == MUNGE_ME_FUNCTION_KEY ? | |
| 3313 "Invalid binding in function-key-map" : | |
| 3314 "Invalid binding in key-translation-map"), | |
| 3315 result); | |
| 428 | 3316 } |
| 3317 | |
| 3318 return Qnil; | |
| 3319 } | |
| 3320 | |
| 2828 | 3321 /* Same as command_builder_find_leaf() below, but without offering the |
| 3322 platform-specific event code the opportunity to give a default binding of | |
| 3323 an unseen keysym to self-insert-command, and without the fallback to | |
| 3324 other keymaps for lookups that allows someone with a Cyrillic keyboard | |
| 3325 to pretend it's Qwerty for C-x C-f, for example. */ | |
| 771 | 3326 |
| 428 | 3327 static Lisp_Object |
| 2828 | 3328 command_builder_find_leaf_no_jit_binding (struct command_builder *builder, |
| 771 | 3329 int allow_misc_user_events_p, |
| 3330 int *did_munge) | |
| 428 | 3331 { |
| 3332 /* This function can GC */ | |
| 3333 Lisp_Object result; | |
| 3334 Lisp_Object evee = builder->current_events; | |
| 3335 | |
| 3336 if (XEVENT_TYPE (evee) == misc_user_event) | |
| 3337 { | |
| 3338 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee)))) | |
| 1204 | 3339 return list2 (XEVENT_EVAL_FUNCTION (evee), |
| 3340 XEVENT_EVAL_OBJECT (evee)); | |
| 428 | 3341 else |
| 3342 return Qnil; | |
| 3343 } | |
| 3344 | |
| 442 | 3345 /* if we're currently in a menu accelerator, check there for further |
| 3346 events */ | |
| 3347 /* #### fuck me! who wrote this crap? think "abstraction", baby. */ | |
| 771 | 3348 /* #### this horribly-written crap can mess with global state, which |
| 3349 this function should not do. i'm not fixing it now. someone | |
| 3350 needs to go and rewrite that shit correctly. --ben */ | |
| 1268 | 3351 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) |
| 442 | 3352 if (x_kludge_lw_menu_active ()) |
| 428 | 3353 { |
| 3354 return command_builder_operate_menu_accelerator (builder); | |
| 3355 } | |
| 3356 else | |
| 3357 { | |
| 3358 result = Qnil; | |
| 3359 if (EQ (Vmenu_accelerator_enabled, Qmenu_force)) | |
| 3360 result = command_builder_find_menu_accelerator (builder); | |
| 3361 if (NILP (result)) | |
| 3362 #endif | |
| 3363 result = command_builder_find_leaf_1 (builder); | |
| 1268 | 3364 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) |
| 428 | 3365 if (NILP (result) |
| 3366 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback)) | |
| 3367 result = command_builder_find_menu_accelerator (builder); | |
| 3368 } | |
| 3369 #endif | |
| 3370 | |
| 3371 /* Check to see if we have a potential function-key-map match. */ | |
| 3372 if (NILP (result)) | |
| 771 | 3373 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0, |
| 3374 did_munge); | |
| 3375 | |
| 428 | 3376 /* Check to see if we have a potential key-translation-map match. */ |
| 3377 { | |
| 3378 Lisp_Object key_translate_result = | |
| 3379 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION, | |
| 771 | 3380 !NILP (result), did_munge); |
| 428 | 3381 if (!NILP (key_translate_result)) |
| 771 | 3382 result = key_translate_result; |
| 428 | 3383 } |
| 3384 | |
| 3385 if (!NILP (result)) | |
| 3386 return result; | |
| 3387 | |
| 3388 /* If key-sequence wasn't bound, we'll try some fallbacks. */ | |
| 3389 | |
| 3390 /* If we didn't find a binding, and the last event in the sequence is | |
| 3391 a shifted character, then try again with the lowercase version. */ | |
| 3392 | |
| 3393 if (XEVENT_TYPE (builder->most_current_event) == key_press_event | |
| 3394 && !NILP (Vretry_undefined_key_binding_unshifted)) | |
| 3395 { | |
| 1204 | 3396 if (event_upshifted_p (builder->most_current_event)) |
| 428 | 3397 { |
| 771 | 3398 Lisp_Object neubauten = copy_command_builder (builder, 0); |
| 3399 struct command_builder *neub = XCOMMAND_BUILDER (neubauten); | |
| 3400 struct gcpro gcpro1; | |
| 3401 | |
| 3402 GCPRO1 (neubauten); | |
| 1204 | 3403 downshift_event (event_chain_tail (neub->current_events)); |
| 771 | 3404 result = |
| 2828 | 3405 command_builder_find_leaf_no_jit_binding |
| 771 | 3406 (neub, allow_misc_user_events_p, did_munge); |
| 3407 | |
| 428 | 3408 if (!NILP (result)) |
| 771 | 3409 { |
| 3410 copy_command_builder (neub, builder); | |
| 3411 *did_munge = 1; | |
| 3412 } | |
| 3413 free_command_builder (neub); | |
| 3414 UNGCPRO; | |
| 3415 if (!NILP (result)) | |
| 428 | 3416 return result; |
| 3417 } | |
| 3418 } | |
| 3419 | |
| 3420 /* help-char is `auto-bound' in every keymap */ | |
| 3421 if (!NILP (Vprefix_help_command) && | |
| 1204 | 3422 event_matches_key_specifier_p (builder->most_current_event, Vhelp_char)) |
| 428 | 3423 return Vprefix_help_command; |
| 3424 | |
| 771 | 3425 return Qnil; |
| 3426 } | |
| 3427 | |
| 3428 /* Compare the current state of the command builder against the local and | |
| 3429 global keymaps, and return the binding. If there is no match, try again, | |
| 3430 case-insensitively. The return value will be one of: | |
| 3431 -- nil (there is no binding) | |
| 3432 -- a keymap (part of a command has been specified) | |
| 3433 -- a command (anything that satisfies `commandp'; this includes | |
| 3434 some symbols, lists, subrs, strings, vectors, and | |
| 3435 compiled-function objects) | |
| 3436 | |
| 3437 This may "munge" the current event chain in the command builder; | |
| 3438 i.e. the sequence might be mutated into a different sequence, | |
| 3439 which we then pretend is what the user actually typed instead of | |
| 3440 the passed-in sequence. This happens as a result of: | |
| 3441 | |
| 3442 -- key-translation-map changes | |
| 3443 -- function-key-map changes | |
| 3444 -- retry-undefined-key-binding-unshifted (q.v.) | |
| 3445 -- "Russian C-x problem" changes (see definition of struct key_data, | |
| 3446 events.h) | |
| 3447 | |
| 3448 DID_MUNGE must be initialized before calling this function. If munging | |
| 3449 happened, DID_MUNGE will be non-zero; otherwise, it will be left alone. | |
| 2828 | 3450 |
| 3451 (The above was Ben, I think.) | |
| 3452 | |
| 3453 It might be nice to have lookup-key call this function, directly or | |
| 3454 indirectly. Though it is arguably the right thing if lookup-key fails on | |
| 3455 a keysym that the X11 event code hasn't seen. There's no way to know if | |
| 3456 that keysym is generatable by the keyboard until it's generated, | |
| 3457 therefore there's no reasonable expectation that it be bound before it's | |
| 3458 generated--all the other default bindings depend on our knowing the | |
| 3459 keyboard layout and relying on it. And describe-key works without it, so | |
| 3460 I think we're fine. | |
| 3461 | |
| 3462 Some weirdness with this code--try this on a keyboard where X11 will | |
| 3463 produce ediaeresis with dead-diaeresis and e, but it's not produced by | |
| 3464 any other combination of keys on the keyboard; | |
| 3465 | |
| 3466 (defun ding-command () | |
| 3467 (interactive) | |
| 3468 (ding)) | |
| 3469 | |
| 3470 (define-key global-map 'ediaeresis 'ding-command) | |
| 3471 | |
| 3472 Now, pressing dead-diaeresis and then e will ding. Next; | |
| 3473 | |
| 3474 (define-key global-map 'ediaeresis 'self-insert-command) | |
| 3475 | |
| 3476 and press dead-diaeresis and then e. It'll give you "Invalid argument: | |
| 3477 typed key has no ASCII equivalent" Then; | |
| 3478 | |
| 3479 (define-key global-map 'ediaeresis nil) | |
| 3480 | |
| 3481 and press the combination again; it'll self-insert. The moral of the | |
| 3482 story is, if you want to suppress all bindings to a non-ASCII X11 key, | |
| 3483 bind it to a trivial no-op command, because the automatic mapping to | |
| 3484 self-insert-command will happen if there's no existing binding for the | |
| 3485 symbol. I can't see a way around this. -- Aidan Kehoe, 2005-05-14 */ | |
| 771 | 3486 |
| 3487 static Lisp_Object | |
| 3488 command_builder_find_leaf (struct command_builder *builder, | |
| 3489 int allow_misc_user_events_p, | |
| 3490 int *did_munge) | |
| 3491 { | |
| 3492 Lisp_Object result = | |
| 2828 | 3493 command_builder_find_leaf_no_jit_binding |
| 771 | 3494 (builder, allow_misc_user_events_p, did_munge); |
| 2828 | 3495 Lisp_Object event, console, channel, lookup_res; |
| 3496 int redolookup = 0, i; | |
| 771 | 3497 |
| 3498 if (!NILP (result)) | |
| 3499 return result; | |
| 3500 | |
| 2828 | 3501 /* If some of the events are keyboard events, and this is the first time |
| 3502 the platform event code has seen their keysyms--which will be the case | |
| 3503 the first time we see a composed keysym on X11, for example--offer it | |
| 3504 the chance to define them as a self-insert-command, and do the lookup | |
| 3505 again. | |
| 3506 | |
| 3507 This isn't Mule-specific; in a world where x-iso8859-1.el is gone, it's | |
| 3508 needed for non-Mule too. | |
| 3509 | |
| 3510 Probably this can just be limited to the checking the last | |
| 3511 keypress. */ | |
| 3512 | |
| 3513 EVENT_CHAIN_LOOP (event, builder->current_events) | |
| 3514 { | |
| 3515 /* We can ignore key release events because the preceding presses will | |
| 3516 have initiated the mapping. */ | |
| 3517 if (key_press_event != XEVENT_TYPE (event)) | |
| 3518 continue; | |
| 3519 | |
| 3520 channel = XEVENT_CHANNEL (event); | |
| 3521 if (object_dead_p (channel)) | |
| 3522 continue; | |
| 3523 | |
| 3524 console = CDFW_CONSOLE (channel); | |
| 3525 if (NILP (console)) | |
| 3526 console = Vselected_console; | |
| 3527 | |
| 3528 if (CONSOLE_LIVE_P(XCONSOLE(console))) | |
| 3529 { | |
| 3530 lookup_res = MAYBE_LISP_CONMETH(XCONSOLE(console), | |
| 3531 perhaps_init_unseen_key_defaults, | |
| 3532 (XCONSOLE(console), | |
| 3533 XEVENT_KEY_KEYSYM(event))); | |
| 3534 if (EQ(lookup_res, Qt)) | |
| 3535 { | |
| 3536 redolookup += 1; | |
| 3537 } | |
| 3538 } | |
| 3539 } | |
| 3540 | |
| 3541 if (redolookup) | |
| 428 | 3542 { |
| 2828 | 3543 result = command_builder_find_leaf_no_jit_binding |
| 3544 (builder, allow_misc_user_events_p, did_munge); | |
| 3545 if (!NILP (result)) | |
| 3546 { | |
| 3547 return result; | |
| 3548 } | |
| 3549 } | |
| 3550 | |
| 3551 /* The old composed-character-default-binding handling that used to be | |
| 3552 here was wrong--if a user wants to bind a given key to something other | |
| 3553 than self-insert-command, then they should go ahead and do it, we won't | |
| 3554 override it, and the sane thing to do with any key that has a known | |
| 3555 character correspondence is _always_ to default it to | |
| 3556 self-insert-command, nothing else. | |
| 3557 | |
| 3558 I'm adding the variable to control whether "Russian C-x processing" is | |
| 3559 used because I have a feeling that it's not always the most appropriate | |
| 3560 thing to do--in cases where people are using a non-Qwerty | |
| 3561 Roman-alphabet layout, do they really want C-x with some random letter | |
| 3562 to call `switch-to-buffer'? I can imagine that being very confusing, | |
| 3563 certainly for new users, and it might be that defaulting the value for | |
| 3564 `try-alternate-layouts-for-commands' as part of the language | |
| 3565 environment is the right thing to do, only defaulting to `t' for those | |
| 3566 languages that don't use the Roman alphabet. | |
| 3567 | |
| 3568 Much of that reasoning is tentative on my part, and feel free to change | |
| 3569 this code if you have more experience with the problem and an intuition | |
| 3570 that differs from mine. (Aidan Kehoe, 2005-05-29)*/ | |
| 3571 | |
| 3572 if (!try_alternate_layouts_for_commands) | |
| 3573 { | |
| 3574 return Qnil; | |
| 428 | 3575 } |
| 2828 | 3576 |
| 3577 if (key_press_event == XEVENT_TYPE (builder->most_current_event)) | |
| 3578 { | |
| 3579 Lisp_Object ev = builder->most_current_event, newbuilder; | |
| 3580 Ichar this_alternative; | |
| 3581 | |
| 3582 struct command_builder *newb; | |
| 3583 struct gcpro gcpro1; | |
| 3584 | |
| 3585 /* Ignore the value for CURRENT_LANGENV, because we've checked it | |
| 3586 already, above. */ | |
| 3587 for (i = KEYCHAR_CURRENT_LANGENV, ++i; i < KEYCHAR_LAST; ++i) | |
| 3588 { | |
| 3589 this_alternative = XEVENT_KEY_ALT_KEYCHARS(ev, i); | |
| 3590 | |
| 3591 if (0 == this_alternative) | |
| 3592 continue; | |
| 3593 | |
| 3594 newbuilder = copy_command_builder(builder, 0); | |
| 3595 GCPRO1(newbuilder); | |
| 3596 | |
| 3597 newb = XCOMMAND_BUILDER(newbuilder); | |
| 3598 | |
| 2830 | 3599 XSET_EVENT_KEY_KEYSYM(event_chain_tail |
| 3600 (XCOMMAND_BUILDER(newbuilder)->current_events), | |
| 2828 | 3601 make_char(this_alternative)); |
| 3602 | |
| 3603 result = command_builder_find_leaf_no_jit_binding | |
| 3604 (newb, allow_misc_user_events_p, did_munge); | |
| 3605 | |
| 3606 if (!NILP (result)) | |
| 3607 { | |
| 3608 copy_command_builder (newb, builder); | |
| 3609 *did_munge = 1; | |
| 3610 } | |
| 2830 | 3611 else if (event_upshifted_p |
| 3612 (XCOMMAND_BUILDER(newbuilder)->most_current_event) && | |
| 2828 | 3613 !NILP (Vretry_undefined_key_binding_unshifted) |
| 3614 && isascii(this_alternative)) | |
| 3615 { | |
| 2830 | 3616 downshift_event (event_chain_tail |
| 3617 (XCOMMAND_BUILDER(newbuilder)->current_events)); | |
| 3618 XSET_EVENT_KEY_KEYSYM(event_chain_tail | |
| 3619 (newb->current_events), | |
| 2828 | 3620 make_char(tolower(this_alternative))); |
| 3621 result = command_builder_find_leaf_no_jit_binding | |
| 3622 (newb, allow_misc_user_events_p, did_munge); | |
| 3623 } | |
| 3624 | |
| 3625 free_command_builder (newb); | |
| 3626 UNGCPRO; | |
| 3627 | |
| 3628 if (!NILP (result)) | |
| 3629 return result; | |
| 3630 } | |
| 3631 } | |
| 428 | 3632 |
| 3633 return Qnil; | |
| 3634 } | |
| 3635 | |
| 771 | 3636 /* Like command_builder_find_leaf but update this-command-keys and the |
| 3637 echo area as necessary when the current event chain was munged. */ | |
| 3638 | |
| 3639 static Lisp_Object | |
| 3640 command_builder_find_leaf_and_update_global_state (struct command_builder * | |
| 3641 builder, | |
| 3642 int | |
| 3643 allow_misc_user_events_p) | |
| 3644 { | |
| 3645 int did_munge = 0; | |
| 3646 int orig_length = event_chain_count (builder->current_events); | |
| 3647 Lisp_Object result = command_builder_find_leaf (builder, | |
| 3648 allow_misc_user_events_p, | |
| 3649 &did_munge); | |
| 3650 | |
| 3651 if (did_munge) | |
| 3652 { | |
| 3653 int tck_length = event_chain_count (Vthis_command_keys); | |
| 3654 | |
| 3655 /* We just assume that the events we just replaced are | |
| 3656 sitting in copied form at the end of this-command-keys. | |
| 3657 If the user did weird things with `dispatch-event' this | |
| 3658 may not be the case, but at least we make sure we won't | |
| 3659 crash. */ | |
| 3660 | |
| 3661 if (tck_length >= orig_length) | |
| 3662 { | |
| 3663 Lisp_Object new_chain = | |
| 3664 copy_event_chain (builder->current_events); | |
| 3665 this_command_keys_replace_suffix | |
| 3666 (event_chain_nth (Vthis_command_keys, tck_length - orig_length), | |
| 3667 new_chain); | |
| 3668 | |
| 3669 regenerate_echo_keys_from_this_command_keys (builder); | |
| 3670 } | |
| 3671 } | |
| 3672 | |
| 3673 if (NILP (result)) | |
| 3674 { | |
| 3675 /* If we read extra events attempting to match a function key but end | |
| 3676 up failing, then we release those events back to the command loop | |
| 3677 and fail on the original lookup. The released events will then be | |
| 3678 reprocessed in the context of the first part having failed. */ | |
| 3679 if (!NILP (builder->last_non_munged_event)) | |
| 3680 { | |
| 3681 Lisp_Object event0 = builder->last_non_munged_event; | |
| 3682 | |
| 3683 /* Put the commands back on the event queue. */ | |
| 3684 enqueue_event_chain (XEVENT_NEXT (event0), | |
| 3685 &command_event_queue, | |
| 3686 &command_event_queue_tail); | |
| 3687 | |
| 3688 /* Then remove them from the command builder. */ | |
| 3689 XSET_EVENT_NEXT (event0, Qnil); | |
| 3690 builder->most_current_event = event0; | |
| 3691 builder->last_non_munged_event = Qnil; | |
| 3692 } | |
| 3693 } | |
| 3694 | |
| 3695 return result; | |
| 3696 } | |
| 428 | 3697 |
| 3698 /* Every time a command-event (a key, button, or menu selection) is read by | |
| 3699 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event, | |
| 3700 and in Vthis_command_keys. (Eval-events are not stored there.) | |
| 3701 | |
| 3702 Every time a command is invoked, Vlast_command_event is set to the last | |
| 3703 event in the sequence. | |
| 3704 | |
| 3705 This means that Vthis_command_keys is really about "input read since the | |
| 3706 last command was executed" rather than about "what keys invoked this | |
| 3707 command." This is a little counterintuitive, but that's the way it | |
| 3708 has always worked. | |
| 3709 | |
| 3710 As an extra kink, the function read-key-sequence resets/updates the | |
| 3711 last-command-event and this-command-keys. It doesn't append to the | |
| 3712 command-keys as read-char does. Such are the pitfalls of having to | |
| 3713 maintain compatibility with a program for which the only specification | |
| 3714 is the code itself. | |
| 3715 | |
| 3716 (We could implement recent_keys_ring and Vthis_command_keys as the same | |
| 3717 data structure.) | |
| 3718 */ | |
| 3719 | |
| 3720 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /* | |
| 3721 Return a vector of recent keyboard or mouse button events read. | |
| 3722 If NUMBER is non-nil, not more than NUMBER events will be returned. | |
| 3723 Change number of events stored using `set-recent-keys-ring-size'. | |
| 3724 | |
| 3725 This copies the event objects into a new vector; it is safe to keep and | |
| 3726 modify them. | |
| 3727 */ | |
| 3728 (number)) | |
| 3729 { | |
| 3730 struct gcpro gcpro1; | |
| 3731 Lisp_Object val = Qnil; | |
| 3732 int nwanted; | |
| 3733 int start, nkeys, i, j; | |
| 3734 GCPRO1 (val); | |
| 3735 | |
| 3736 if (NILP (number)) | |
| 3737 nwanted = recent_keys_ring_size; | |
| 3738 else | |
| 3739 { | |
| 3740 CHECK_NATNUM (number); | |
| 3741 nwanted = XINT (number); | |
| 3742 } | |
| 3743 | |
| 3744 /* Create the keys ring vector, if none present. */ | |
| 3745 if (NILP (Vrecent_keys_ring)) | |
| 3746 { | |
| 3747 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil); | |
| 3748 /* And return nothing in particular. */ | |
| 446 | 3749 RETURN_UNGCPRO (make_vector (0, Qnil)); |
| 428 | 3750 } |
| 3751 | |
| 3752 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index])) | |
| 3753 /* This means the vector has not yet wrapped */ | |
| 3754 { | |
| 3755 nkeys = recent_keys_ring_index; | |
| 3756 start = 0; | |
| 3757 } | |
| 3758 else | |
| 3759 { | |
| 3760 nkeys = recent_keys_ring_size; | |
| 3761 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index); | |
| 3762 } | |
| 3763 | |
| 3764 if (nwanted < nkeys) | |
| 3765 { | |
| 3766 start += nkeys - nwanted; | |
| 3767 if (start >= recent_keys_ring_size) | |
| 3768 start -= recent_keys_ring_size; | |
| 3769 nkeys = nwanted; | |
| 3770 } | |
| 3771 else | |
| 3772 nwanted = nkeys; | |
| 3773 | |
| 3774 val = make_vector (nwanted, Qnil); | |
| 3775 | |
| 3776 for (i = 0, j = start; i < nkeys; i++) | |
| 3777 { | |
| 3778 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j]; | |
| 3779 | |
| 3780 if (NILP (e)) | |
| 2500 | 3781 ABORT (); |
| 428 | 3782 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil); |
| 3783 if (++j >= recent_keys_ring_size) | |
| 3784 j = 0; | |
| 3785 } | |
| 3786 UNGCPRO; | |
| 3787 return val; | |
| 3788 } | |
| 3789 | |
| 3790 | |
| 3791 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /* | |
| 3792 The maximum number of events `recent-keys' can return. | |
| 3793 */ | |
| 3794 ()) | |
| 3795 { | |
| 3796 return make_int (recent_keys_ring_size); | |
| 3797 } | |
| 3798 | |
| 3799 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /* | |
| 3800 Set the maximum number of events to be stored internally. | |
| 3801 */ | |
| 3802 (size)) | |
| 3803 { | |
| 3804 Lisp_Object new_vector = Qnil; | |
| 3805 int i, j, nkeys, start, min; | |
| 3806 struct gcpro gcpro1; | |
| 3807 | |
| 3808 CHECK_INT (size); | |
| 3809 if (XINT (size) <= 0) | |
| 563 | 3810 invalid_argument ("Recent keys ring size must be positive", size); |
| 428 | 3811 if (XINT (size) == recent_keys_ring_size) |
| 3812 return size; | |
| 3813 | |
| 446 | 3814 GCPRO1 (new_vector); |
| 428 | 3815 new_vector = make_vector (XINT (size), Qnil); |
| 3816 | |
| 3817 if (NILP (Vrecent_keys_ring)) | |
| 3818 { | |
| 3819 Vrecent_keys_ring = new_vector; | |
| 446 | 3820 RETURN_UNGCPRO (size); |
| 428 | 3821 } |
| 3822 | |
| 3823 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index])) | |
| 3824 /* This means the vector has not yet wrapped */ | |
| 3825 { | |
| 3826 nkeys = recent_keys_ring_index; | |
| 3827 start = 0; | |
| 3828 } | |
| 3829 else | |
| 3830 { | |
| 3831 nkeys = recent_keys_ring_size; | |
| 3832 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index); | |
| 3833 } | |
| 3834 | |
| 3835 if (XINT (size) > nkeys) | |
| 3836 min = nkeys; | |
| 3837 else | |
| 3838 min = XINT (size); | |
| 3839 | |
| 3840 for (i = 0, j = start; i < min; i++) | |
| 3841 { | |
| 3842 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j]; | |
| 3843 if (++j >= recent_keys_ring_size) | |
| 3844 j = 0; | |
| 3845 } | |
| 3846 recent_keys_ring_size = XINT (size); | |
| 3847 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0; | |
| 3848 | |
| 3849 Vrecent_keys_ring = new_vector; | |
| 3850 | |
| 3851 UNGCPRO; | |
| 3852 return size; | |
| 3853 } | |
| 3854 | |
| 3855 /* Vthis_command_keys having value Qnil means that the next time | |
| 3856 push_this_command_keys is called, it should start over. | |
| 3857 The times at which the command-keys are reset | |
| 3858 (instead of merely being augmented) are pretty counterintuitive. | |
| 3859 (More specifically: | |
| 3860 | |
| 3861 -- We do not reset this-command-keys when we finish reading a | |
| 3862 command. This is because some commands (e.g. C-u) act | |
| 3863 like command prefixes; they signal this by setting prefix-arg | |
| 3864 to non-nil. | |
| 3865 -- Therefore, we reset this-command-keys when we finish | |
| 3866 executing a command, unless prefix-arg is set. | |
| 3867 -- However, if we ever do a non-local exit out of a command | |
| 3868 loop (e.g. an error in a command), we need to reset | |
| 3869 this-command-keys. We do this by calling reset_this_command_keys() | |
| 3870 from cmdloop.c, whenever an error causes an invocation of the | |
| 3871 default error handler, and whenever there's a throw to top-level.) | |
| 3872 */ | |
| 3873 | |
| 3874 void | |
| 3875 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p) | |
| 3876 { | |
| 757 | 3877 if (!NILP (console)) |
| 3878 { | |
| 3879 /* console is nil if we just deleted the console as a result of C-x 5 | |
| 3880 0. Unfortunately things are currently in a messy situation where | |
| 3881 some stuff is console-local and other stuff isn't, so we need to | |
| 3882 do everything that's not console-local. */ | |
| 3883 struct command_builder *command_builder = | |
| 3884 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder); | |
| 3885 | |
| 3886 reset_key_echo (command_builder, clear_echo_area_p); | |
| 3887 reset_current_events (command_builder); | |
| 3888 } | |
| 3889 else | |
| 3890 reset_key_echo (0, clear_echo_area_p); | |
| 428 | 3891 |
| 3892 deallocate_event_chain (Vthis_command_keys); | |
| 3893 Vthis_command_keys = Qnil; | |
| 3894 Vthis_command_keys_tail = Qnil; | |
| 3895 } | |
| 3896 | |
| 3897 static void | |
| 3898 push_this_command_keys (Lisp_Object event) | |
| 3899 { | |
| 3025 | 3900 Lisp_Object new_ = Fmake_event (Qnil, Qnil); |
| 3901 | |
| 3902 Fcopy_event (event, new_); | |
| 3903 enqueue_event (new_, &Vthis_command_keys, &Vthis_command_keys_tail); | |
| 428 | 3904 } |
| 3905 | |
| 3906 /* The following two functions are used in call-interactively, | |
| 3907 for the @ and e specifications. We used to just use | |
| 3908 `current-mouse-event' (i.e. the last mouse event in this-command-keys), | |
| 3909 but FSF does it more generally so we follow their lead. */ | |
| 3910 | |
| 3911 Lisp_Object | |
| 3912 extract_this_command_keys_nth_mouse_event (int n) | |
| 3913 { | |
| 3914 Lisp_Object event; | |
| 3915 | |
| 3916 EVENT_CHAIN_LOOP (event, Vthis_command_keys) | |
| 3917 { | |
| 3918 if (EVENTP (event) | |
| 3919 && (XEVENT_TYPE (event) == button_press_event | |
| 3920 || XEVENT_TYPE (event) == button_release_event | |
| 3921 || XEVENT_TYPE (event) == misc_user_event)) | |
| 3922 { | |
| 3923 if (!n) | |
| 3924 { | |
| 2500 | 3925 /* must copy to avoid an ABORT() in next_event_internal() */ |
| 428 | 3926 if (!NILP (XEVENT_NEXT (event))) |
| 3927 return Fcopy_event (event, Qnil); | |
| 3928 else | |
| 3929 return event; | |
| 3930 } | |
| 3931 n--; | |
| 3932 } | |
| 3933 } | |
| 3934 | |
| 3935 return Qnil; | |
| 3936 } | |
| 3937 | |
| 3938 Lisp_Object | |
| 3939 extract_vector_nth_mouse_event (Lisp_Object vector, int n) | |
| 3940 { | |
| 3941 int i; | |
| 3942 int len = XVECTOR_LENGTH (vector); | |
| 3943 | |
| 3944 for (i = 0; i < len; i++) | |
| 3945 { | |
| 3946 Lisp_Object event = XVECTOR_DATA (vector)[i]; | |
| 3947 if (EVENTP (event)) | |
| 3948 switch (XEVENT_TYPE (event)) | |
| 3949 { | |
| 3950 case button_press_event : | |
| 3951 case button_release_event : | |
| 3952 case misc_user_event : | |
| 3953 if (n == 0) | |
| 3954 return event; | |
| 3955 n--; | |
| 3956 break; | |
| 3957 default: | |
| 3958 continue; | |
| 3959 } | |
| 3960 } | |
| 3961 | |
| 3962 return Qnil; | |
| 3963 } | |
| 3964 | |
| 3965 static void | |
| 3966 push_recent_keys (Lisp_Object event) | |
| 3967 { | |
| 3968 Lisp_Object e; | |
| 3969 | |
| 3970 if (NILP (Vrecent_keys_ring)) | |
| 3971 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil); | |
| 3972 | |
| 3973 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index]; | |
| 3974 | |
| 3975 if (NILP (e)) | |
| 3976 { | |
| 3977 e = Fmake_event (Qnil, Qnil); | |
| 3978 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e; | |
| 3979 } | |
| 3980 Fcopy_event (event, e); | |
| 3981 if (++recent_keys_ring_index == recent_keys_ring_size) | |
| 3982 recent_keys_ring_index = 0; | |
| 3983 } | |
| 3984 | |
| 3985 | |
| 3986 static Lisp_Object | |
| 3987 current_events_into_vector (struct command_builder *command_builder) | |
| 3988 { | |
| 3989 Lisp_Object vector; | |
| 3990 Lisp_Object event; | |
| 3991 int n = event_chain_count (command_builder->current_events); | |
| 3992 | |
| 3993 /* Copy the vector and the events in it. */ | |
| 3994 /* No need to copy the events, since they're already copies, and | |
| 3995 nobody other than the command-builder has pointers to them */ | |
| 3996 vector = make_vector (n, Qnil); | |
| 3997 n = 0; | |
| 3998 EVENT_CHAIN_LOOP (event, command_builder->current_events) | |
| 3999 XVECTOR_DATA (vector)[n++] = event; | |
| 4000 reset_command_builder_event_chain (command_builder); | |
| 4001 return vector; | |
| 4002 } | |
| 4003 | |
| 4004 | |
| 4005 /* | |
| 4006 Given the current state of the command builder and a new command event | |
| 4007 that has just been dispatched: | |
| 4008 | |
| 4009 -- add the event to the event chain forming the current command | |
| 4010 (doing meta-translation as necessary) | |
| 4011 -- return the binding of this event chain; this will be one of: | |
| 4012 -- nil (there is no binding) | |
| 4013 -- a keymap (part of a command has been specified) | |
| 4014 -- a command (anything that satisfies `commandp'; this includes | |
| 4015 some symbols, lists, subrs, strings, vectors, and | |
| 4016 compiled-function objects) | |
| 4017 */ | |
| 4018 static Lisp_Object | |
| 4019 lookup_command_event (struct command_builder *command_builder, | |
| 4020 Lisp_Object event, int allow_misc_user_events_p) | |
| 4021 { | |
| 4022 /* This function can GC */ | |
| 4023 struct frame *f = selected_frame (); | |
| 4024 /* Clear output from previous command execution */ | |
| 4025 if (!EQ (Qcommand, echo_area_status (f)) | |
| 4026 /* but don't let mouse-up clear what mouse-down just printed */ | |
| 4027 && (XEVENT (event)->event_type != button_release_event)) | |
| 4028 clear_echo_area (f, Qnil, 0); | |
| 4029 | |
| 4030 /* Add the given event to the command builder. | |
| 4031 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys | |
| 4032 vectors to translate "ESC x" to "M-x" (for any "x" of course). | |
| 4033 */ | |
| 4034 { | |
| 4035 Lisp_Object recent = command_builder->most_current_event; | |
| 4036 | |
| 4037 if (EVENTP (recent) | |
| 1204 | 4038 && event_matches_key_specifier_p (recent, Vmeta_prefix_char)) |
| 428 | 4039 { |
| 440 | 4040 Lisp_Event *e; |
| 428 | 4041 /* When we see a sequence like "ESC x", pretend we really saw "M-x". |
| 4042 DoubleThink the recent-keys and this-command-keys as well. */ | |
| 4043 | |
| 4044 /* Modify the previous most-recently-pushed event on the command | |
| 4045 builder to be a copy of this one with the meta-bit set instead of | |
| 4046 pushing a new event. | |
| 4047 */ | |
| 4048 Fcopy_event (event, recent); | |
| 4049 e = XEVENT (recent); | |
| 934 | 4050 if (EVENT_TYPE (e) == key_press_event) |
| 1204 | 4051 SET_EVENT_KEY_MODIFIERS (e, EVENT_KEY_MODIFIERS (e) | |
| 4052 XEMACS_MOD_META); | |
| 934 | 4053 else if (EVENT_TYPE (e) == button_press_event |
| 4054 || EVENT_TYPE (e) == button_release_event) | |
| 1204 | 4055 SET_EVENT_BUTTON_MODIFIERS (e, EVENT_BUTTON_MODIFIERS (e) | |
| 4056 XEMACS_MOD_META); | |
| 428 | 4057 else |
| 2500 | 4058 ABORT (); |
| 428 | 4059 |
| 4060 { | |
| 4061 int tckn = event_chain_count (Vthis_command_keys); | |
| 4062 if (tckn >= 2) | |
| 4063 /* ??? very strange if it's < 2. */ | |
| 4064 this_command_keys_replace_suffix | |
| 4065 (event_chain_nth (Vthis_command_keys, tckn - 2), | |
| 4066 Fcopy_event (recent, Qnil)); | |
| 4067 } | |
| 4068 | |
| 4069 regenerate_echo_keys_from_this_command_keys (command_builder); | |
| 4070 } | |
| 4071 else | |
| 771 | 4072 command_builder_append_event (command_builder, event); |
| 428 | 4073 } |
| 4074 | |
| 4075 { | |
| 771 | 4076 Lisp_Object leaf = |
| 4077 command_builder_find_leaf_and_update_global_state | |
| 4078 (command_builder, | |
| 4079 allow_misc_user_events_p); | |
| 428 | 4080 struct gcpro gcpro1; |
| 4081 GCPRO1 (leaf); | |
| 4082 | |
| 4083 if (KEYMAPP (leaf)) | |
| 4084 { | |
| 442 | 4085 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) |
| 4086 if (!x_kludge_lw_menu_active ()) | |
| 4087 #else | |
| 4088 if (1) | |
| 4089 #endif | |
| 428 | 4090 { |
| 4091 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt); | |
| 4092 if (STRINGP (prompt)) | |
| 4093 { | |
| 4094 /* Append keymap prompt to key echo buffer */ | |
| 4095 int buf_index = command_builder->echo_buf_index; | |
| 4096 Bytecount len = XSTRING_LENGTH (prompt); | |
| 4097 | |
| 4098 if (len + buf_index + 1 <= command_builder->echo_buf_length) | |
| 4099 { | |
| 867 | 4100 Ibyte *echo = command_builder->echo_buf + buf_index; |
| 428 | 4101 memcpy (echo, XSTRING_DATA (prompt), len); |
| 4102 echo[len] = 0; | |
| 4103 } | |
| 4104 maybe_echo_keys (command_builder, 1); | |
| 4105 } | |
| 4106 else | |
| 4107 maybe_echo_keys (command_builder, 0); | |
| 4108 } | |
| 853 | 4109 /* #### i don't trust this at all. --ben */ |
| 4110 #if 0 | |
| 442 | 4111 else if (!NILP (Vquit_flag)) |
| 4112 { | |
| 4113 /* if quit happened during menu acceleration, pretend we read it */ | |
| 4114 struct console *con = XCONSOLE (Fselected_console ()); | |
| 1204 | 4115 |
| 4116 enqueue_command_event (Fcopy_event (CONSOLE_QUIT_EVENT (con), | |
| 4117 Qnil)); | |
| 442 | 4118 Vquit_flag = Qnil; |
| 4119 } | |
| 853 | 4120 #endif |
| 428 | 4121 } |
| 4122 else if (!NILP (leaf)) | |
| 4123 { | |
| 4124 if (EQ (Qcommand, echo_area_status (f)) | |
| 4125 && command_builder->echo_buf_index > 0) | |
| 4126 { | |
| 4127 /* If we had been echoing keys, echo the last one (without | |
| 4128 the trailing dash) and redisplay before executing the | |
| 4129 command. */ | |
| 4130 command_builder->echo_buf[command_builder->echo_buf_index] = 0; | |
| 4131 maybe_echo_keys (command_builder, 1); | |
| 4132 Fsit_for (Qzero, Qt); | |
| 4133 } | |
| 4134 } | |
| 4135 RETURN_UNGCPRO (leaf); | |
| 4136 } | |
| 4137 } | |
| 4138 | |
| 479 | 4139 static int |
| 4140 is_scrollbar_event (Lisp_Object event) | |
| 4141 { | |
| 516 | 4142 #ifdef HAVE_SCROLLBARS |
| 479 | 4143 Lisp_Object fun; |
| 4144 | |
| 934 | 4145 if (XEVENT_TYPE (event) != misc_user_event) |
| 4146 return 0; | |
| 1204 | 4147 fun = XEVENT_MISC_USER_FUNCTION (event); |
| 479 | 4148 |
| 4149 return (EQ (fun, Qscrollbar_line_up) || | |
| 4150 EQ (fun, Qscrollbar_line_down) || | |
| 4151 EQ (fun, Qscrollbar_page_up) || | |
| 4152 EQ (fun, Qscrollbar_page_down) || | |
| 4153 EQ (fun, Qscrollbar_to_top) || | |
| 4154 EQ (fun, Qscrollbar_to_bottom) || | |
| 4155 EQ (fun, Qscrollbar_vertical_drag) || | |
| 4156 EQ (fun, Qscrollbar_char_left) || | |
| 4157 EQ (fun, Qscrollbar_char_right) || | |
| 4158 EQ (fun, Qscrollbar_page_left) || | |
| 4159 EQ (fun, Qscrollbar_page_right) || | |
| 4160 EQ (fun, Qscrollbar_to_left) || | |
| 4161 EQ (fun, Qscrollbar_to_right) || | |
| 4162 EQ (fun, Qscrollbar_horizontal_drag)); | |
| 516 | 4163 #else |
| 4164 return 0; | |
| 4165 #endif /* HAVE_SCROLLBARS */ | |
| 479 | 4166 } |
| 4167 | |
| 428 | 4168 static void |
| 4169 execute_command_event (struct command_builder *command_builder, | |
| 4170 Lisp_Object event) | |
| 4171 { | |
| 4172 /* This function can GC */ | |
| 4173 struct console *con = XCONSOLE (command_builder->console); | |
| 4174 struct gcpro gcpro1; | |
| 4175 | |
| 4176 GCPRO1 (event); /* event may be freshly created */ | |
| 444 | 4177 |
| 479 | 4178 /* #### This call to is_scrollbar_event() isn't quite right, but |
| 4179 fixing properly it requires more work than can go into 21.4. | |
| 4180 (We really need to split out menu, scrollbar, dialog, and other | |
| 4181 types of events from misc-user, and put the remaining ones in a | |
| 4182 new `user-eval' type that behaves like an eval event but is a | |
| 4183 user event and thus has all of its semantics -- e.g. being | |
| 4184 delayed during `accept-process-output' and similar wait states.) | |
| 4185 | |
| 4186 The real issue here is that "user events" and "command events" | |
| 4187 are not the same thing, but are very much confused in | |
| 4188 event-stream.c. User events are, essentially, any event that | |
| 4189 should be delayed by accept-process-output, should terminate a | |
| 4190 sit-for, etc. -- basically, any event that needs to be processed | |
| 4191 synchronously with key and mouse events. Command events are | |
| 4192 those that participate in command building; scrollbar events | |
| 4193 clearly don't belong because they should be transparent in a | |
| 4194 sequence like C-x @ h <scrollbar-drag> x, which used to cause a | |
| 4195 crash before checks similar to the is_scrollbar_event() call were | |
| 4196 added. Do other events belong with scrollbar events? I'm not | |
| 4197 sure; we need to categorize all misc-user events and see what | |
| 4198 their semantics are. | |
| 4199 | |
| 4200 (You might ask, why do scrollbar events need to be user events? | |
| 4201 That's a good question. The answer seems to be that they can | |
| 4202 change point, and having this happen asynchronously would be a | |
| 4203 very bad idea. According to the "proper" functioning of | |
| 4204 scrollbars, this should not happen, but XEmacs does not allow | |
| 4205 point to go outside of the window.) | |
| 4206 | |
| 4207 Scrollbar events and similar non-command events should obviously | |
| 4208 not be recorded in this-command-keys, so we need to check for | |
| 4209 this in next-event. | |
| 4210 | |
| 4211 #### We call reset_current_events() twice in this function -- | |
| 4212 #### here, and later as a result of reset_this_command_keys(). | |
| 4213 #### This is almost certainly wrong; need to figure out what's | |
| 4214 #### correct. | |
| 4215 | |
| 4216 #### We need to figure out what's really correct w.r.t. scrollbar | |
| 4217 #### events. With these new fixes in, it actually works to do | |
| 4218 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up | |
| 4219 #### (starts over at 5). We really need to be special-casing | |
| 4220 #### scrollbar events at a lower level, and not really passing | |
| 4221 #### them through the command builder at all. (e.g. do scrollbar | |
| 4222 #### events belong in macros??? doubtful; probably only the | |
| 4223 #### point movement, if any, belongs, special-cased as a | |
| 4224 #### pseudo-issued M-x goto-char command). #### Need more work | |
| 4225 #### here. Do this when separating out scrollbar events. | |
| 4226 */ | |
| 4227 | |
| 4228 if (!is_scrollbar_event (event)) | |
| 444 | 4229 reset_current_events (command_builder); |
| 428 | 4230 |
| 4231 switch (XEVENT (event)->event_type) | |
| 4232 { | |
| 4233 case key_press_event: | |
| 4234 Vcurrent_mouse_event = Qnil; | |
| 4235 break; | |
| 4236 case button_press_event: | |
| 4237 case button_release_event: | |
| 4238 case misc_user_event: | |
| 4239 Vcurrent_mouse_event = Fcopy_event (event, Qnil); | |
| 4240 break; | |
| 4241 default: break; | |
| 4242 } | |
| 4243 | |
| 4244 /* Store the last-command-event. The semantics of this is that it | |
| 4245 is the last event most recently involved in command-lookup. */ | |
| 4246 if (!EVENTP (Vlast_command_event)) | |
| 4247 Vlast_command_event = Fmake_event (Qnil, Qnil); | |
| 4248 if (XEVENT (Vlast_command_event)->event_type == dead_event) | |
| 4249 { | |
| 4250 Vlast_command_event = Fmake_event (Qnil, Qnil); | |
| 563 | 4251 invalid_state ("Someone deallocated the last-command-event!", Qunbound); |
| 428 | 4252 } |
| 4253 | |
| 4254 if (! EQ (event, Vlast_command_event)) | |
| 4255 Fcopy_event (event, Vlast_command_event); | |
| 4256 | |
| 4257 /* Note that last-command-char will never have its high-bit set, in | |
| 4258 an effort to sidestep the ambiguity between M-x and oslash. */ | |
| 4259 Vlast_command_char = Fevent_to_character (Vlast_command_event, | |
| 2862 | 4260 Qnil, Qnil, Qnil); |
| 428 | 4261 |
| 4262 /* Actually call the command, with all sorts of hair to preserve or clear | |
| 4263 the echo-area and region as appropriate and call the pre- and post- | |
| 4264 command-hooks. */ | |
| 4265 { | |
| 4266 int old_kbd_macro = con->kbd_macro_end; | |
| 4267 struct window *w = XWINDOW (Fselected_window (Qnil)); | |
| 4268 | |
| 4269 /* We're executing a new command, so the old value is irrelevant. */ | |
| 4270 zmacs_region_stays = 0; | |
| 4271 | |
| 4272 /* If the previous command tried to force a specific window-start, | |
| 4273 reset the flag in case this command moves point far away from | |
| 4274 that position. Also, reset the window's buffer's change | |
| 4275 information so that we don't trigger an incremental update. */ | |
| 4276 if (w->force_start) | |
| 4277 { | |
| 4278 w->force_start = 0; | |
| 4279 buffer_reset_changes (XBUFFER (w->buffer)); | |
| 4280 } | |
| 4281 | |
| 4282 pre_command_hook (); | |
| 4283 | |
| 934 | 4284 if (XEVENT_TYPE (event) == misc_user_event) |
| 4285 { | |
| 1204 | 4286 call1 (XEVENT_MISC_USER_FUNCTION (event), |
| 4287 XEVENT_MISC_USER_OBJECT (event)); | |
| 934 | 4288 } |
| 428 | 4289 else |
| 4290 { | |
| 4291 Fcommand_execute (Vthis_command, Qnil, Qnil); | |
| 4292 } | |
| 4293 | |
| 4294 post_command_hook (); | |
| 4295 | |
| 757 | 4296 /* Console might have been deleted by command */ |
| 4297 if (CONSOLE_LIVE_P (con) && !NILP (con->prefix_arg)) | |
| 428 | 4298 { |
| 4299 /* Commands that set the prefix arg don't update last-command, don't | |
| 4300 reset the echoing state, and don't go into keyboard macros unless | |
| 444 | 4301 followed by another command. Also don't quit here. */ |
| 4302 int speccount = specpdl_depth (); | |
| 4303 specbind (Qinhibit_quit, Qt); | |
| 428 | 4304 maybe_echo_keys (command_builder, 0); |
| 771 | 4305 unbind_to (speccount); |
| 428 | 4306 |
| 4307 /* If we're recording a keyboard macro, and the last command | |
| 4308 executed set a prefix argument, then decrement the pointer to | |
| 4309 the "last character really in the macro" to be just before this | |
| 4310 command. This is so that the ^U in "^U ^X )" doesn't go onto | |
| 4311 the end of macro. */ | |
| 4312 if (!NILP (con->defining_kbd_macro)) | |
| 4313 con->kbd_macro_end = old_kbd_macro; | |
| 4314 } | |
| 4315 else | |
| 4316 { | |
| 4317 /* Start a new command next time */ | |
| 4318 Vlast_command = Vthis_command; | |
| 442 | 4319 Vlast_command_properties = Vthis_command_properties; |
| 4320 Vthis_command_properties = Qnil; | |
| 4321 | |
| 428 | 4322 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes, |
| 4323 so we don't either */ | |
| 479 | 4324 |
| 4325 if (!is_scrollbar_event (event)) | |
| 771 | 4326 reset_this_command_keys (CONSOLE_LIVE_P (con) ? wrap_console (con) |
| 757 | 4327 : Qnil, 0); |
| 428 | 4328 } |
| 4329 } | |
| 4330 | |
| 4331 UNGCPRO; | |
| 4332 } | |
| 4333 | |
| 4334 /* Run the pre command hook. */ | |
| 4335 | |
| 4336 static void | |
| 4337 pre_command_hook (void) | |
| 4338 { | |
| 4339 last_point_position = BUF_PT (current_buffer); | |
| 793 | 4340 last_point_position_buffer = wrap_buffer (current_buffer); |
| 428 | 4341 /* This function can GC */ |
| 853 | 4342 safe_run_hook_trapping_problems |
| 1333 | 4343 (Qcommand, Qpre_command_hook, |
| 4344 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); | |
| 442 | 4345 |
| 4346 /* This is a kludge, but necessary; see simple.el */ | |
| 4347 call0 (Qhandle_pre_motion_command); | |
| 428 | 4348 } |
| 4349 | |
| 4350 /* Run the post command hook. */ | |
| 4351 | |
| 4352 static void | |
| 4353 post_command_hook (void) | |
| 4354 { | |
| 4355 /* This function can GC */ | |
| 4356 /* Turn off region highlighting unless this command requested that | |
| 4357 it be left on, or we're in the minibuffer. We don't turn it off | |
| 4358 when we're in the minibuffer so that things like M-x write-region | |
| 4359 still work! | |
| 4360 | |
| 4361 This could be done via a function on the post-command-hook, but | |
| 4362 we don't want the user to accidentally remove it. | |
| 4363 */ | |
| 4364 | |
| 4365 Lisp_Object win = Fselected_window (Qnil); | |
| 4366 | |
| 4367 /* If the last command deleted the frame, `win' might be nil. | |
| 4368 It seems safest to do nothing in this case. */ | |
| 442 | 4369 /* Note: Someone added the following comment and put #if 0's around |
| 4370 this code, not realizing that doing this invites a crash in the | |
| 4371 line after. */ | |
| 440 | 4372 /* #### This doesn't really fix the problem, |
| 428 | 4373 if delete-frame is called by some hook */ |
| 4374 if (NILP (win)) | |
| 4375 return; | |
| 442 | 4376 |
| 4377 /* This is a kludge, but necessary; see simple.el */ | |
| 4378 call0 (Qhandle_post_motion_command); | |
| 428 | 4379 |
| 4380 if (! zmacs_region_stays | |
| 4381 && (!MINI_WINDOW_P (XWINDOW (win)) | |
| 4382 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win))))) | |
| 4383 zmacs_deactivate_region (); | |
| 4384 else | |
| 4385 zmacs_update_region (); | |
| 4386 | |
| 853 | 4387 safe_run_hook_trapping_problems |
| 1333 | 4388 (Qcommand, Qpost_command_hook, |
|
4718
a27de91ae83c
Don't prevent display objects from being deleted for `post-command-hook'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4677
diff
changeset
|
4389 0); |
| 853 | 4390 |
| 4391 #if 0 /* FSF Emacs */ | |
| 4392 if (!NILP (current_buffer->mark_active)) | |
| 4393 { | |
| 4394 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) | |
| 4395 { | |
| 4396 current_buffer->mark_active = Qnil; | |
| 4397 run_hook (intern ("deactivate-mark-hook")); | |
| 4398 } | |
| 4399 else if (current_buffer != prev_buffer || | |
| 4400 BUF_MODIFF (current_buffer) != prev_modiff) | |
| 4401 run_hook (intern ("activate-mark-hook")); | |
| 4402 } | |
| 4403 #endif /* FSF Emacs */ | |
| 428 | 4404 |
| 4405 /* #### Kludge!!! This is necessary to make sure that things | |
| 4406 are properly positioned even if post-command-hook moves point. | |
| 4407 #### There should be a cleaner way of handling this. */ | |
| 4408 call0 (Qauto_show_make_point_visible); | |
| 4409 } | |
| 4410 | |
| 4411 | |
| 4412 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /* | |
| 444 | 4413 Given an event object EVENT as returned by `next-event', execute it. |
| 428 | 4414 |
| 4415 Key-press, button-press, and button-release events get accumulated | |
| 4416 until a complete key sequence (see `read-key-sequence') is reached, | |
| 4417 at which point the sequence is looked up in the current keymaps and | |
| 4418 acted upon. | |
| 4419 | |
| 4420 Mouse motion events cause the low-level handling function stored in | |
| 4421 `mouse-motion-handler' to be called. (There are very few circumstances | |
| 4422 under which you should change this handler. Use `mode-motion-hook' | |
| 4423 instead.) | |
| 4424 | |
| 4425 Menu, timeout, and eval events cause the associated function or handler | |
| 4426 to be called. | |
| 4427 | |
| 4428 Process events cause the subprocess's output to be read and acted upon | |
| 4429 appropriately (see `start-process'). | |
| 4430 | |
| 4431 Magic events are handled as necessary. | |
| 4432 */ | |
| 4433 (event)) | |
| 4434 { | |
| 4435 /* This function can GC */ | |
| 4436 struct command_builder *command_builder; | |
| 440 | 4437 Lisp_Event *ev; |
| 428 | 4438 Lisp_Object console; |
| 4439 Lisp_Object channel; | |
| 1292 | 4440 PROFILE_DECLARE (); |
| 428 | 4441 |
| 4442 CHECK_LIVE_EVENT (event); | |
| 4443 ev = XEVENT (event); | |
| 4444 | |
| 4445 /* events on dead channels get silently eaten */ | |
| 4446 channel = EVENT_CHANNEL (ev); | |
| 4447 if (object_dead_p (channel)) | |
| 4448 return Qnil; | |
| 4449 | |
| 1292 | 4450 PROFILE_RECORD_ENTERING_SECTION (Qdispatch_event); |
| 4451 | |
| 428 | 4452 /* Some events don't have channels (e.g. eval events). */ |
| 4453 console = CDFW_CONSOLE (channel); | |
| 4454 if (NILP (console)) | |
| 4455 console = Vselected_console; | |
| 4456 else if (!EQ (console, Vselected_console)) | |
| 4457 Fselect_console (console); | |
| 4458 | |
| 4459 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder); | |
| 934 | 4460 switch (XEVENT_TYPE (event)) |
| 428 | 4461 { |
| 4462 case button_press_event: | |
| 4463 case button_release_event: | |
| 4464 case key_press_event: | |
| 4465 { | |
| 4466 Lisp_Object leaf = lookup_command_event (command_builder, event, 1); | |
| 4467 | |
| 4468 if (KEYMAPP (leaf)) | |
| 4469 /* Incomplete key sequence */ | |
| 4470 break; | |
| 4471 if (NILP (leaf)) | |
| 4472 { | |
| 4473 /* At this point, we know that the sequence is not bound to a | |
| 4474 command. Normally, we beep and print a message informing the | |
| 4475 user of this. But we do not beep or print a message when: | |
| 4476 | |
| 4477 o the last event in this sequence is a mouse-up event; or | |
| 4478 o the last event in this sequence is a mouse-down event and | |
| 4479 there is a binding for the mouse-up version. | |
| 4480 | |
| 4481 That is, if the sequence ``C-x button1'' is typed, and is not | |
| 4482 bound to a command, but the sequence ``C-x button1up'' is bound | |
| 4483 to a command, we do not complain about the ``C-x button1'' | |
| 4484 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is | |
| 4485 bound to a command, then we complain about the ``C-x button1'' | |
| 4486 sequence, but later will *not* complain about the | |
| 4487 ``C-x button1up'' sequence, which would be redundant. | |
| 4488 | |
| 4489 This is pretty hairy, but I think it's the most intuitive | |
| 4490 behavior. | |
| 4491 */ | |
| 4492 Lisp_Object terminal = command_builder->most_current_event; | |
| 4493 | |
| 4494 if (XEVENT_TYPE (terminal) == button_press_event) | |
| 4495 { | |
| 4496 int no_bitching; | |
| 4497 /* Temporarily pretend the last event was an "up" instead of a | |
| 4498 "down", and look up its binding. */ | |
| 4499 XEVENT_TYPE (terminal) = button_release_event; | |
| 4500 /* If the "up" version is bound, don't complain. */ | |
| 4501 no_bitching | |
| 771 | 4502 = !NILP (command_builder_find_leaf_and_update_global_state |
| 4503 (command_builder, 0)); | |
| 428 | 4504 /* Undo the temporary changes we just made. */ |
| 4505 XEVENT_TYPE (terminal) = button_press_event; | |
| 4506 if (no_bitching) | |
| 4507 { | |
| 4508 /* Pretend this press was not seen (treat as a prefix) */ | |
| 4509 if (EQ (command_builder->current_events, terminal)) | |
| 4510 { | |
| 4511 reset_current_events (command_builder); | |
| 4512 } | |
| 4513 else | |
| 4514 { | |
| 4515 Lisp_Object eve; | |
| 4516 | |
| 4517 EVENT_CHAIN_LOOP (eve, command_builder->current_events) | |
| 4518 if (EQ (XEVENT_NEXT (eve), terminal)) | |
| 4519 break; | |
| 4520 | |
| 4521 Fdeallocate_event (command_builder-> | |
| 4522 most_current_event); | |
| 4523 XSET_EVENT_NEXT (eve, Qnil); | |
| 4524 command_builder->most_current_event = eve; | |
| 4525 } | |
| 4526 maybe_echo_keys (command_builder, 1); | |
| 4527 break; | |
| 4528 } | |
| 4529 } | |
| 4530 | |
| 4531 /* Complain that the typed sequence is not defined, if this is the | |
| 4532 kind of sequence that warrants a complaint. */ | |
| 4533 XCONSOLE (console)->defining_kbd_macro = Qnil; | |
| 4534 XCONSOLE (console)->prefix_arg = Qnil; | |
| 4535 /* Don't complain about undefined button-release events */ | |
| 4536 if (XEVENT_TYPE (terminal) != button_release_event) | |
| 4537 { | |
| 4538 Lisp_Object keys = current_events_into_vector (command_builder); | |
| 4539 struct gcpro gcpro1; | |
| 4540 | |
| 4541 /* Run the pre-command-hook before barfing about an undefined | |
| 4542 key. */ | |
| 4543 Vthis_command = Qnil; | |
| 4544 GCPRO1 (keys); | |
| 4545 pre_command_hook (); | |
| 4546 UNGCPRO; | |
| 4547 /* The post-command-hook doesn't run. */ | |
| 4548 Fsignal (Qundefined_keystroke_sequence, list1 (keys)); | |
| 4549 } | |
| 4550 /* Reset the command builder for reading the next sequence. */ | |
| 4551 reset_this_command_keys (console, 1); | |
| 4552 } | |
| 4553 else /* key sequence is bound to a command */ | |
| 4554 { | |
| 430 | 4555 int magic_undo = 0; |
| 4556 int magic_undo_count = 20; | |
| 4557 | |
| 428 | 4558 Vthis_command = leaf; |
| 430 | 4559 |
| 428 | 4560 /* Don't push an undo boundary if the command set the prefix arg, |
| 4561 or if we are executing a keyboard macro, or if in the | |
| 4562 minibuffer. If the command we are about to execute is | |
| 4563 self-insert, it's tricky: up to 20 consecutive self-inserts may | |
| 4564 be done without an undo boundary. This counter is reset as | |
| 4565 soon as a command other than self-insert-command is executed. | |
| 430 | 4566 |
| 442 | 4567 Programmers can also use the `self-insert-defer-undo' |
| 4568 property to install that behavior on functions other | |
| 430 | 4569 than `self-insert-command', or to change the magic |
| 442 | 4570 number 20 to something else. #### DOCUMENT THIS! */ |
| 430 | 4571 |
| 4572 if (SYMBOLP (leaf)) | |
| 4573 { | |
| 4574 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil); | |
| 4575 if (NATNUMP (prop)) | |
| 4576 magic_undo = 1, magic_undo_count = XINT (prop); | |
| 4577 else if (!NILP (prop)) | |
| 4578 magic_undo = 1; | |
| 4579 else if (EQ (leaf, Qself_insert_command)) | |
| 4580 magic_undo = 1; | |
| 4581 } | |
| 4582 | |
| 4583 if (!magic_undo) | |
| 428 | 4584 command_builder->self_insert_countdown = 0; |
| 4585 if (NILP (XCONSOLE (console)->prefix_arg) | |
| 4586 && NILP (Vexecuting_macro) | |
| 4587 && command_builder->self_insert_countdown == 0) | |
| 4588 Fundo_boundary (); | |
| 4589 | |
| 430 | 4590 if (magic_undo) |
| 428 | 4591 { |
| 4592 if (--command_builder->self_insert_countdown < 0) | |
| 430 | 4593 command_builder->self_insert_countdown = magic_undo_count; |
| 428 | 4594 } |
| 4595 execute_command_event | |
| 4596 (command_builder, | |
| 444 | 4597 internal_equal (event, command_builder->most_current_event, 0) |
| 428 | 4598 ? event |
| 4599 /* Use the translated event that was most recently seen. | |
| 4600 This way, last-command-event becomes f1 instead of | |
| 4601 the P from ESC O P. But we must copy it, else we'll | |
| 4602 lose when the command-builder events are deallocated. */ | |
| 444 | 4603 : Fcopy_event (command_builder->most_current_event, Qnil)); |
| 428 | 4604 } |
| 4605 break; | |
| 4606 } | |
| 4607 case misc_user_event: | |
| 4608 { | |
| 4609 /* Jamie said: | |
| 4610 | |
| 4611 We could just always use the menu item entry, whatever it is, but | |
| 4612 this might break some Lisp code that expects `this-command' to | |
| 4613 always contain a symbol. So only store it if this is a simple | |
| 4614 `call-interactively' sort of menu item. | |
| 4615 | |
| 4616 But this is bogus. `this-command' could be a string or vector | |
| 4617 anyway (for keyboard macros). There's even one instance | |
| 4618 (in pending-del.el) of `this-command' getting set to a cons | |
| 4619 (a lambda expression). So in the `eval' case I'll just | |
| 4620 convert it into a lambda expression. | |
| 4621 */ | |
| 1204 | 4622 if (EQ (XEVENT_MISC_USER_FUNCTION (event), Qcall_interactively) |
| 4623 && SYMBOLP (XEVENT_MISC_USER_OBJECT (event))) | |
| 4624 Vthis_command = XEVENT_MISC_USER_OBJECT (event); | |
| 4625 else if (EQ (XEVENT_MISC_USER_FUNCTION (event), Qeval)) | |
| 934 | 4626 Vthis_command = |
| 1204 | 4627 Fcons (Qlambda, Fcons (Qnil, XEVENT_MISC_USER_OBJECT (event))); |
| 4628 else if (SYMBOLP (XEVENT_MISC_USER_FUNCTION (event))) | |
| 934 | 4629 /* A scrollbar command or the like. */ |
| 1204 | 4630 Vthis_command = XEVENT_MISC_USER_FUNCTION (event); |
| 428 | 4631 else |
| 4632 /* Huh? */ | |
| 4633 Vthis_command = Qnil; | |
| 4634 | |
| 4635 /* clear the echo area */ | |
| 4636 reset_key_echo (command_builder, 1); | |
| 4637 | |
| 4638 command_builder->self_insert_countdown = 0; | |
| 4639 if (NILP (XCONSOLE (console)->prefix_arg) | |
| 4640 && NILP (Vexecuting_macro) | |
| 4641 && !EQ (minibuf_window, Fselected_window (Qnil))) | |
| 4642 Fundo_boundary (); | |
| 4643 execute_command_event (command_builder, event); | |
| 4644 break; | |
| 4645 } | |
| 4646 default: | |
| 4647 execute_internal_event (event); | |
| 4648 break; | |
| 4649 } | |
| 1292 | 4650 |
| 4651 PROFILE_RECORD_EXITING_SECTION (Qdispatch_event); | |
| 428 | 4652 return Qnil; |
| 4653 } | |
| 4654 | |
| 4655 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /* | |
| 4656 Read a sequence of keystrokes or mouse clicks. | |
| 4657 Returns a vector of the event objects read. The vector and the event | |
| 444 | 4658 objects it contains are freshly created (and so will not be side-effected |
| 428 | 4659 by subsequent calls to this function). |
| 4660 | |
| 4661 The sequence read is sufficient to specify a non-prefix command starting | |
| 4662 from the current local and global keymaps. A C-g typed while in this | |
| 4663 function is treated like any other character, and `quit-flag' is not set. | |
| 4664 | |
| 4665 First arg PROMPT is a prompt string. If nil, do not prompt specially. | |
| 444 | 4666 |
| 4667 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a | |
| 4668 continuation of the previous key. | |
| 4669 | |
| 4670 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the | |
| 4671 last event to lower case. (Normally any upper case event is converted | |
| 4672 to lower case if the original event is undefined and the lower case | |
| 4673 equivalent is defined.) This argument is provided mostly for FSF | |
| 4674 compatibility; the equivalent effect can be achieved more generally by | |
| 4675 binding `retry-undefined-key-binding-unshifted' to nil around the call | |
| 4676 to `read-key-sequence'. | |
| 428 | 4677 |
| 4678 If the user selects a menu item while we are prompting for a key-sequence, | |
| 4679 the returned value will be a vector of a single menu-selection event. | |
| 4680 An error will be signalled if you pass this value to `lookup-key' or a | |
| 4681 related function. | |
| 4682 | |
| 4683 `read-key-sequence' checks `function-key-map' for function key | |
| 444 | 4684 sequences, where they wouldn't conflict with ordinary bindings. |
| 4685 See `function-key-map' for more details. | |
| 428 | 4686 */ |
| 4687 (prompt, continue_echo, dont_downcase_last)) | |
| 4688 { | |
| 4689 /* This function can GC */ | |
| 4690 struct console *con = XCONSOLE (Vselected_console); /* #### correct? | |
| 4691 Probably not -- see | |
| 4692 comment in | |
| 4693 next-event */ | |
| 4694 struct command_builder *command_builder = | |
| 4695 XCOMMAND_BUILDER (con->command_builder); | |
| 4696 Lisp_Object result; | |
| 4697 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 4698 int speccount = specpdl_depth (); | |
| 4699 struct gcpro gcpro1; | |
| 4700 GCPRO1 (event); | |
| 4701 | |
| 707 | 4702 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); |
| 428 | 4703 if (!NILP (prompt)) |
| 4704 CHECK_STRING (prompt); | |
| 4705 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */ | |
| 4706 QUIT; | |
| 4707 | |
| 4708 if (NILP (continue_echo)) | |
| 771 | 4709 reset_this_command_keys (wrap_console (con), 1); |
| 428 | 4710 |
| 4711 if (!NILP (dont_downcase_last)) | |
| 4712 specbind (Qretry_undefined_key_binding_unshifted, Qnil); | |
| 4713 | |
| 4714 for (;;) | |
| 4715 { | |
| 4716 Fnext_event (event, prompt); | |
| 4717 /* restore the selected-console damage */ | |
| 4718 con = event_console_or_selected (event); | |
| 4719 command_builder = XCOMMAND_BUILDER (con->command_builder); | |
| 4720 if (! command_event_p (event)) | |
| 4721 execute_internal_event (event); | |
| 4722 else | |
| 4723 { | |
| 934 | 4724 if (XEVENT_TYPE (event) == misc_user_event) |
| 428 | 4725 reset_current_events (command_builder); |
| 4726 result = lookup_command_event (command_builder, event, 1); | |
| 4727 if (!KEYMAPP (result)) | |
| 4728 { | |
| 4729 result = current_events_into_vector (command_builder); | |
| 4730 reset_key_echo (command_builder, 0); | |
| 4731 break; | |
| 4732 } | |
| 4733 prompt = Qnil; | |
| 4734 } | |
| 4735 } | |
| 4736 | |
| 4737 Fdeallocate_event (event); | |
| 771 | 4738 RETURN_UNGCPRO (unbind_to_1 (speccount, result)); |
| 428 | 4739 } |
| 4740 | |
| 4741 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /* | |
| 4742 Return a vector of the keyboard or mouse button events that were used | |
| 4743 to invoke this command. This copies the vector and the events; it is safe | |
| 4744 to keep and modify them. | |
| 4745 */ | |
| 4746 ()) | |
| 4747 { | |
| 4748 Lisp_Object event; | |
| 4749 Lisp_Object result; | |
| 4750 int len; | |
| 4751 | |
| 4752 if (NILP (Vthis_command_keys)) | |
| 4753 return make_vector (0, Qnil); | |
| 4754 | |
| 4755 len = event_chain_count (Vthis_command_keys); | |
| 4756 | |
| 4757 result = make_vector (len, Qnil); | |
| 4758 len = 0; | |
| 4759 EVENT_CHAIN_LOOP (event, Vthis_command_keys) | |
| 4760 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil); | |
| 4761 return result; | |
| 4762 } | |
| 4763 | |
| 4764 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /* | |
| 4765 Used for complicated reasons in `universal-argument-other-key'. | |
| 4766 | |
| 4767 `universal-argument-other-key' rereads the event just typed. | |
| 4768 It then gets translated through `function-key-map'. | |
| 4769 The translated event gets included in the echo area and in | |
| 4770 the value of `this-command-keys' in addition to the raw original event. | |
| 4771 That is not right. | |
| 4772 | |
| 4773 Calling this function directs the translated event to replace | |
| 4774 the original event, so that only one version of the event actually | |
| 430 | 4775 appears in the echo area and in the value of `this-command-keys'. |
| 428 | 4776 */ |
| 4777 ()) | |
| 4778 { | |
| 4779 /* #### I don't understand this at all, so currently it does nothing. | |
| 4780 If there is ever a problem, maybe someone should investigate. */ | |
| 4781 return Qnil; | |
| 4782 } | |
| 4783 | |
| 4784 | |
| 4785 static void | |
| 4786 dribble_out_event (Lisp_Object event) | |
| 4787 { | |
| 4788 if (NILP (Vdribble_file)) | |
| 4789 return; | |
| 4790 | |
| 934 | 4791 if (XEVENT_TYPE (event) == key_press_event && |
| 1204 | 4792 !XEVENT_KEY_MODIFIERS (event)) |
| 934 | 4793 { |
| 1204 | 4794 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); |
| 4795 if (CHARP (XEVENT_KEY_KEYSYM (event))) | |
| 428 | 4796 { |
| 867 | 4797 Ichar ch = XCHAR (keysym); |
| 4798 Ibyte str[MAX_ICHAR_LEN]; | |
| 4799 Bytecount len = set_itext_ichar (str, ch); | |
| 428 | 4800 Lstream_write (XLSTREAM (Vdribble_file), str, len); |
| 4801 } | |
| 826 | 4802 else if (string_char_length (XSYMBOL (keysym)->name) == 1) |
| 428 | 4803 /* one-char key events are printed with just the key name */ |
| 4804 Fprinc (keysym, Vdribble_file); | |
| 4805 else if (EQ (keysym, Qreturn)) | |
| 4806 Lstream_putc (XLSTREAM (Vdribble_file), '\n'); | |
| 4807 else if (EQ (keysym, Qspace)) | |
| 4808 Lstream_putc (XLSTREAM (Vdribble_file), ' '); | |
| 4809 else | |
| 4810 Fprinc (event, Vdribble_file); | |
| 4811 } | |
| 4812 else | |
| 4813 Fprinc (event, Vdribble_file); | |
| 4814 Lstream_flush (XLSTREAM (Vdribble_file)); | |
| 4815 } | |
| 4816 | |
| 4817 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1, | |
| 4818 "FOpen dribble file: ", /* | |
| 444 | 4819 Start writing all keyboard characters to a dribble file called FILENAME. |
| 4820 If FILENAME is nil, close any open dribble file. | |
| 428 | 4821 */ |
| 444 | 4822 (filename)) |
| 428 | 4823 { |
| 4824 /* This function can GC */ | |
| 4825 /* XEmacs change: always close existing dribble file. */ | |
| 4826 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */ | |
| 4827 if (!NILP (Vdribble_file)) | |
| 4828 { | |
| 4829 Lstream_close (XLSTREAM (Vdribble_file)); | |
| 4830 Vdribble_file = Qnil; | |
| 4831 } | |
| 444 | 4832 if (!NILP (filename)) |
| 428 | 4833 { |
| 4834 int fd; | |
| 4835 | |
| 444 | 4836 filename = Fexpand_file_name (filename, Qnil); |
| 771 | 4837 fd = qxe_open (XSTRING_DATA (filename), |
| 4838 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | |
| 4839 CREAT_MODE); | |
| 428 | 4840 if (fd < 0) |
| 563 | 4841 report_file_error ("Unable to create dribble file", filename); |
| 428 | 4842 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING); |
| 4843 #ifdef MULE | |
| 4844 Vdribble_file = | |
| 771 | 4845 make_coding_output_stream |
| 4846 (XLSTREAM (Vdribble_file), | |
| 800 | 4847 Qescape_quoted, CODING_ENCODE, 0); |
| 428 | 4848 #endif |
| 4849 } | |
| 4850 return Qnil; | |
| 4851 } | |
| 4852 | |
| 4853 | |
| 442 | 4854 |
| 4855 DEFUN ("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /* | |
| 4856 Return the current event timestamp of the window system associated with CONSOLE. | |
| 4857 CONSOLE defaults to the selected console if omitted. | |
| 4858 */ | |
| 4859 (console)) | |
| 4860 { | |
| 4861 struct console *c = decode_console (console); | |
| 4862 int tiempo = event_stream_current_event_timestamp (c); | |
| 4863 | |
| 4864 /* This junk is so that timestamps don't get to be negative, but contain | |
| 4865 as many bits as this particular emacs will allow. | |
| 4866 */ | |
| 2039 | 4867 return make_int (EMACS_INT_MAX & tiempo); |
| 442 | 4868 } |
| 4869 | |
| 4870 | |
| 428 | 4871 /************************************************************************/ |
| 4872 /* initialization */ | |
| 4873 /************************************************************************/ | |
| 4874 | |
| 4875 void | |
| 4876 syms_of_event_stream (void) | |
| 4877 { | |
| 442 | 4878 INIT_LRECORD_IMPLEMENTATION (command_builder); |
| 4879 INIT_LRECORD_IMPLEMENTATION (timeout); | |
| 4880 | |
| 563 | 4881 DEFSYMBOL (Qdisabled); |
| 4882 DEFSYMBOL (Qcommand_event_p); | |
| 4883 | |
| 4884 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error); | |
| 4885 DEFERROR_STANDARD (Qinvalid_key_binding, Qinvalid_state); | |
| 428 | 4886 |
| 4887 DEFSUBR (Frecent_keys); | |
| 4888 DEFSUBR (Frecent_keys_ring_size); | |
| 4889 DEFSUBR (Fset_recent_keys_ring_size); | |
| 4890 DEFSUBR (Finput_pending_p); | |
| 4891 DEFSUBR (Fenqueue_eval_event); | |
| 4892 DEFSUBR (Fnext_event); | |
| 4893 DEFSUBR (Fnext_command_event); | |
| 4894 DEFSUBR (Fdiscard_input); | |
| 4895 DEFSUBR (Fsit_for); | |
| 4896 DEFSUBR (Fsleep_for); | |
| 4897 DEFSUBR (Faccept_process_output); | |
| 4898 DEFSUBR (Fadd_timeout); | |
| 4899 DEFSUBR (Fdisable_timeout); | |
| 4900 DEFSUBR (Fadd_async_timeout); | |
| 4901 DEFSUBR (Fdisable_async_timeout); | |
| 4902 DEFSUBR (Fdispatch_event); | |
| 442 | 4903 DEFSUBR (Fdispatch_non_command_events); |
| 428 | 4904 DEFSUBR (Fread_key_sequence); |
| 4905 DEFSUBR (Fthis_command_keys); | |
| 4906 DEFSUBR (Freset_this_command_lengths); | |
| 4907 DEFSUBR (Fopen_dribble_file); | |
| 442 | 4908 DEFSUBR (Fcurrent_event_timestamp); |
| 428 | 4909 |
| 563 | 4910 DEFSYMBOL (Qpre_command_hook); |
| 4911 DEFSYMBOL (Qpost_command_hook); | |
| 4912 DEFSYMBOL (Qunread_command_events); | |
| 4913 DEFSYMBOL (Qunread_command_event); | |
| 4914 DEFSYMBOL (Qpre_idle_hook); | |
| 4915 DEFSYMBOL (Qhandle_pre_motion_command); | |
| 4916 DEFSYMBOL (Qhandle_post_motion_command); | |
| 4917 DEFSYMBOL (Qretry_undefined_key_binding_unshifted); | |
| 4918 DEFSYMBOL (Qauto_show_make_point_visible); | |
| 4919 | |
| 4920 DEFSYMBOL (Qself_insert_defer_undo); | |
| 4921 DEFSYMBOL (Qcancel_mode_internal); | |
| 1292 | 4922 |
| 4923 DEFSYMBOL (Qnext_event); | |
| 4924 DEFSYMBOL (Qdispatch_event); | |
| 428 | 4925 } |
| 4926 | |
| 4927 void | |
| 4928 reinit_vars_of_event_stream (void) | |
| 4929 { | |
| 4930 recent_keys_ring_index = 0; | |
| 4931 recent_keys_ring_size = 100; | |
| 4932 num_input_chars = 0; | |
| 3263 | 4933 #ifndef NEW_GC |
| 440 | 4934 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout), |
| 428 | 4935 &lrecord_timeout); |
| 4936 staticpro_nodump (&Vtimeout_free_list); | |
| 771 | 4937 Vcommand_builder_free_list = |
| 4938 make_lcrecord_list (sizeof (struct command_builder), | |
| 4939 &lrecord_command_builder); | |
| 4940 staticpro_nodump (&Vcommand_builder_free_list); | |
| 3263 | 4941 #endif /* not NEW_GC */ |
| 428 | 4942 the_low_level_timeout_blocktype = |
| 4943 Blocktype_new (struct low_level_timeout_blocktype); | |
| 4944 something_happened = 0; | |
| 1268 | 4945 recursive_sit_for = 0; |
| 4946 in_modal_loop = 0; | |
| 428 | 4947 } |
| 4948 | |
| 4949 void | |
| 4950 vars_of_event_stream (void) | |
| 4951 { | |
| 4952 Vrecent_keys_ring = Qnil; | |
| 4953 staticpro (&Vrecent_keys_ring); | |
| 4954 | |
| 4955 Vthis_command_keys = Qnil; | |
| 4956 staticpro (&Vthis_command_keys); | |
| 4957 Vthis_command_keys_tail = Qnil; | |
| 1204 | 4958 dump_add_root_lisp_object (&Vthis_command_keys_tail); |
| 428 | 4959 |
| 4960 command_event_queue = Qnil; | |
| 4961 staticpro (&command_event_queue); | |
| 4962 command_event_queue_tail = Qnil; | |
| 1204 | 4963 dump_add_root_lisp_object (&command_event_queue_tail); |
| 4964 | |
| 4965 dispatch_event_queue = Qnil; | |
| 4966 staticpro (&dispatch_event_queue); | |
| 4967 dispatch_event_queue_tail = Qnil; | |
| 4968 dump_add_root_lisp_object (&dispatch_event_queue_tail); | |
| 428 | 4969 |
| 4970 Vlast_selected_frame = Qnil; | |
| 4971 staticpro (&Vlast_selected_frame); | |
| 4972 | |
| 4973 pending_timeout_list = Qnil; | |
| 4974 staticpro (&pending_timeout_list); | |
| 4975 | |
| 4976 pending_async_timeout_list = Qnil; | |
| 4977 staticpro (&pending_async_timeout_list); | |
| 4978 | |
| 4979 last_point_position_buffer = Qnil; | |
| 4980 staticpro (&last_point_position_buffer); | |
| 4981 | |
| 1292 | 4982 QSnext_event_internal = build_string ("next_event_internal()"); |
| 4983 staticpro (&QSnext_event_internal); | |
| 4984 QSexecute_internal_event = build_string ("execute_internal_event()"); | |
| 4985 staticpro (&QSexecute_internal_event); | |
| 4986 | |
| 428 | 4987 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /* |
| 4988 *Nonzero means echo unfinished commands after this many seconds of pause. | |
| 4989 */ ); | |
| 4990 Vecho_keystrokes = make_int (1); | |
| 4991 | |
| 4992 DEFVAR_INT ("auto-save-interval", &auto_save_interval /* | |
| 4993 *Number of keyboard input characters between auto-saves. | |
| 4994 Zero means disable autosaving due to number of characters typed. | |
| 4995 See also the variable `auto-save-timeout'. | |
| 4996 */ ); | |
| 4997 auto_save_interval = 300; | |
| 4998 | |
| 4999 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /* | |
| 5000 Function or functions to run before every command. | |
| 5001 This may examine the `this-command' variable to find out what command | |
| 5002 is about to be run, or may change it to cause a different command to run. | |
| 853 | 5003 Errors while running the hook are caught and turned into warnings. |
| 428 | 5004 */ ); |
| 5005 Vpre_command_hook = Qnil; | |
| 5006 | |
| 5007 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /* | |
| 5008 Function or functions to run after every command. | |
| 5009 This may examine the `this-command' variable to find out what command | |
| 5010 was just executed. | |
| 5011 */ ); | |
| 5012 Vpost_command_hook = Qnil; | |
| 5013 | |
| 5014 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /* | |
| 5015 Normal hook run when XEmacs it about to be idle. | |
| 5016 This occurs whenever it is going to block, waiting for an event. | |
| 5017 This generally happens as a result of a call to `next-event', | |
| 5018 `next-command-event', `sit-for', `sleep-for', `accept-process-output', | |
| 853 | 5019 or `get-selection'. Errors while running the hook are caught and |
| 5020 turned into warnings. | |
| 428 | 5021 */ ); |
| 5022 Vpre_idle_hook = Qnil; | |
| 5023 | |
| 5024 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /* | |
| 5025 *Variable to control XEmacs behavior with respect to focus changing. | |
| 5026 If this variable is set to t, then XEmacs will not gratuitously change | |
| 5027 the keyboard focus. XEmacs cannot in general detect when this mode is | |
| 5028 used by the window manager, so it is up to the user to set it. | |
| 5029 */ ); | |
| 5030 focus_follows_mouse = 0; | |
| 5031 | |
| 5032 DEFVAR_LISP ("last-command-event", &Vlast_command_event /* | |
| 5033 Last keyboard or mouse button event that was part of a command. This | |
| 5034 variable is off limits: you may not set its value or modify the event that | |
| 5035 is its value, as it is destructively modified by `read-key-sequence'. If | |
| 5036 you want to keep a pointer to this value, you must use `copy-event'. | |
| 5037 */ ); | |
| 5038 Vlast_command_event = Qnil; | |
| 5039 | |
| 5040 DEFVAR_LISP ("last-command-char", &Vlast_command_char /* | |
| 5041 If the value of `last-command-event' is a keyboard event, then | |
| 5042 this is the nearest ASCII equivalent to it. This is the value that | |
| 5043 `self-insert-command' will put in the buffer. Remember that there is | |
| 5044 NOT a 1:1 mapping between keyboard events and ASCII characters: the set | |
| 5045 of keyboard events is much larger, so writing code that examines this | |
| 5046 variable to determine what key has been typed is bad practice, unless | |
| 5047 you are certain that it will be one of a small set of characters. | |
| 5048 */ ); | |
| 5049 Vlast_command_char = Qnil; | |
| 5050 | |
| 5051 DEFVAR_LISP ("last-input-event", &Vlast_input_event /* | |
| 5052 Last keyboard or mouse button event received. This variable is off | |
| 5053 limits: you may not set its value or modify the event that is its value, as | |
| 5054 it is destructively modified by `next-event'. If you want to keep a pointer | |
| 5055 to this value, you must use `copy-event'. | |
| 5056 */ ); | |
| 5057 Vlast_input_event = Qnil; | |
| 5058 | |
| 5059 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /* | |
| 5060 The mouse-button event which invoked this command, or nil. | |
| 5061 This is usually what `(interactive "e")' returns. | |
| 5062 */ ); | |
| 5063 Vcurrent_mouse_event = Qnil; | |
| 5064 | |
| 5065 DEFVAR_LISP ("last-input-char", &Vlast_input_char /* | |
| 5066 If the value of `last-input-event' is a keyboard event, then | |
| 5067 this is the nearest ASCII equivalent to it. Remember that there is | |
| 5068 NOT a 1:1 mapping between keyboard events and ASCII characters: the set | |
| 5069 of keyboard events is much larger, so writing code that examines this | |
| 5070 variable to determine what key has been typed is bad practice, unless | |
| 5071 you are certain that it will be one of a small set of characters. | |
| 5072 */ ); | |
| 5073 Vlast_input_char = Qnil; | |
| 5074 | |
| 5075 DEFVAR_LISP ("last-input-time", &Vlast_input_time /* | |
| 5076 The time (in seconds since Jan 1, 1970) of the last-command-event, | |
| 5077 represented as a cons of two 16-bit integers. This is destructively | |
| 5078 modified, so copy it if you want to keep it. | |
| 5079 */ ); | |
| 5080 Vlast_input_time = Qnil; | |
| 5081 | |
| 5082 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /* | |
| 5083 The time (in seconds since Jan 1, 1970) of the last-command-event, | |
| 5084 represented as a list of three integers. The first integer contains | |
| 5085 the most significant 16 bits of the number of seconds, and the second | |
| 5086 integer contains the least significant 16 bits. The third integer | |
| 5087 contains the remainder number of microseconds, if the current system | |
| 5088 supports microsecond clock resolution. This list is destructively | |
| 5089 modified, so copy it if you want to keep it. | |
| 5090 */ ); | |
| 5091 Vlast_command_event_time = Qnil; | |
| 5092 | |
| 5093 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /* | |
| 5094 List of event objects to be read as next command input events. | |
| 5095 This can be used to simulate the receipt of events from the user. | |
| 5096 Normally this is nil. | |
| 5097 Events are removed from the front of this list. | |
| 5098 */ ); | |
| 5099 Vunread_command_events = Qnil; | |
| 5100 | |
| 5101 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /* | |
| 5102 Obsolete. Use `unread-command-events' instead. | |
| 5103 */ ); | |
| 5104 Vunread_command_event = Qnil; | |
| 5105 | |
| 5106 DEFVAR_LISP ("last-command", &Vlast_command /* | |
| 5107 The last command executed. Normally a symbol with a function definition, | |
| 5108 but can be whatever was found in the keymap, or whatever the variable | |
| 5109 `this-command' was set to by that command. | |
| 5110 */ ); | |
| 5111 Vlast_command = Qnil; | |
| 5112 | |
| 5113 DEFVAR_LISP ("this-command", &Vthis_command /* | |
| 5114 The command now being executed. | |
| 5115 The command can set this variable; whatever is put here | |
| 5116 will be in `last-command' during the following command. | |
| 5117 */ ); | |
| 5118 Vthis_command = Qnil; | |
| 5119 | |
| 442 | 5120 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /* |
| 5121 Value of `this-command-properties' for the last command. | |
| 5122 Used by commands to help synchronize consecutive commands, in preference | |
| 5123 to looking at `last-command' directly. | |
| 5124 */ ); | |
| 5125 Vlast_command_properties = Qnil; | |
| 5126 | |
| 5127 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /* | |
| 5128 Properties set by the current command. | |
| 5129 At the beginning of each command, the current value of this variable is | |
| 5130 copied to `last-command-properties', and then it is set to nil. Use `putf' | |
| 5131 to add properties to this variable. Commands should use this to communicate | |
| 5132 with pre/post-command hooks, subsequent commands, wrapping commands, etc. | |
| 5133 in preference to looking at and/or setting `this-command'. | |
| 5134 */ ); | |
| 5135 Vthis_command_properties = Qnil; | |
| 5136 | |
| 428 | 5137 DEFVAR_LISP ("help-char", &Vhelp_char /* |
| 5138 Character to recognize as meaning Help. | |
| 5139 When it is read, do `(eval help-form)', and display result if it's a string. | |
| 5140 If the value of `help-form' is nil, this char can be read normally. | |
| 5141 This can be any form recognized as a single key specifier. | |
| 5142 The help-char cannot be a negative number in XEmacs. | |
| 5143 */ ); | |
| 5144 Vhelp_char = make_char (8); /* C-h */ | |
| 5145 | |
| 5146 DEFVAR_LISP ("help-form", &Vhelp_form /* | |
| 5147 Form to execute when character help-char is read. | |
| 5148 If the form returns a string, that string is displayed. | |
| 5149 If `help-form' is nil, the help char is not recognized. | |
| 5150 */ ); | |
| 5151 Vhelp_form = Qnil; | |
| 5152 | |
| 5153 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /* | |
| 5154 Command to run when `help-char' character follows a prefix key. | |
| 5155 This command is used only when there is no actual binding | |
| 5156 for that character after that prefix key. | |
| 5157 */ ); | |
| 5158 Vprefix_help_command = Qnil; | |
| 5159 | |
| 5160 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /* | |
| 5161 Hash table used as translate table for keyboard input. | |
| 5162 Use `keyboard-translate' to portably add entries to this table. | |
| 5163 Each key-press event is looked up in this table as follows: | |
| 5164 | |
| 5165 -- If an entry maps a symbol to a symbol, then a key-press event whose | |
| 5166 keysym is the former symbol (with any modifiers at all) gets its | |
| 5167 keysym changed and its modifiers left alone. This is useful for | |
| 5168 dealing with non-standard X keyboards, such as the grievous damage | |
| 5169 that Sun has inflicted upon the world. | |
| 442 | 5170 -- If an entry maps a symbol to a character, then a key-press event |
| 5171 whose keysym is the former symbol (with any modifiers at all) gets | |
| 5172 changed into a key-press event matching the latter character, and the | |
| 5173 resulting modifiers are the union of the original and new modifiers. | |
| 428 | 5174 -- If an entry maps a character to a character, then a key-press event |
| 5175 matching the former character gets converted to a key-press event | |
| 5176 matching the latter character. This is useful on ASCII terminals | |
| 5177 for (e.g.) making C-\\ look like C-s, to get around flow-control | |
| 5178 problems. | |
| 5179 -- If an entry maps a character to a symbol, then a key-press event | |
| 5180 matching the character gets converted to a key-press event whose | |
| 5181 keysym is the given symbol and which has no modifiers. | |
| 442 | 5182 |
| 5183 Here's an example: This makes typing parens and braces easier by rerouting | |
| 5184 their positions to eliminate the need to use the Shift key. | |
| 5185 | |
| 5186 (keyboard-translate ?[ ?() | |
| 5187 (keyboard-translate ?] ?)) | |
| 5188 (keyboard-translate ?{ ?[) | |
| 5189 (keyboard-translate ?} ?]) | |
| 5190 (keyboard-translate 'f11 ?{) | |
| 5191 (keyboard-translate 'f12 ?}) | |
| 428 | 5192 */ ); |
| 5193 | |
| 5194 DEFVAR_LISP ("retry-undefined-key-binding-unshifted", | |
| 5195 &Vretry_undefined_key_binding_unshifted /* | |
| 5196 If a key-sequence which ends with a shifted keystroke is undefined | |
| 5197 and this variable is non-nil then the command lookup is retried again | |
| 5198 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.) | |
| 5199 If lookup still fails, a normal error is signalled. In general, | |
| 5200 you should *bind* this, not set it. | |
| 5201 */ ); | |
| 5202 Vretry_undefined_key_binding_unshifted = Qt; | |
| 5203 | |
| 442 | 5204 DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /* |
| 5205 *Non-nil makes modifier keys sticky. | |
| 5206 This means that you can release the modifier key before pressing down | |
| 5207 the key that you wish to be modified. Although this is non-standard | |
| 5208 behavior, it is recommended because it reduces the strain on your hand, | |
| 5209 thus reducing the incidence of the dreaded Emacs-pinky syndrome. | |
| 444 | 5210 |
| 5211 Modifier keys are sticky within the inverval specified by | |
| 5212 `modifier-keys-sticky-time'. | |
| 442 | 5213 */ ); |
| 5214 modifier_keys_are_sticky = 0; | |
| 5215 | |
| 444 | 5216 DEFVAR_LISP ("modifier-keys-sticky-time", &Vmodifier_keys_sticky_time /* |
| 5217 *Modifier keys are sticky within this many milliseconds. | |
| 5218 If you don't want modifier keys sticking to be bounded, set this to | |
| 5219 non-integer value. | |
| 5220 | |
| 5221 This variable has no effect when `modifier-keys-are-sticky' is nil. | |
| 5222 Currently only implemented under X Window System. | |
| 5223 */ ); | |
| 5224 Vmodifier_keys_sticky_time = make_int (500); | |
| 5225 | |
| 428 | 5226 Vcontrolling_terminal = Qnil; |
| 5227 staticpro (&Vcontrolling_terminal); | |
| 5228 | |
| 5229 Vdribble_file = Qnil; | |
| 5230 staticpro (&Vdribble_file); | |
| 5231 | |
| 5232 #ifdef DEBUG_XEMACS | |
| 5233 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /* | |
| 5234 If non-zero, display debug information about Emacs events that XEmacs sees. | |
| 5235 Information is displayed on stderr. | |
| 5236 | |
| 5237 Before the event, the source of the event is displayed in parentheses, | |
| 5238 and is one of the following: | |
| 5239 | |
| 5240 \(real) A real event from the window system or | |
| 5241 terminal driver, as far as XEmacs can tell. | |
| 5242 | |
| 5243 \(keyboard macro) An event generated from a keyboard macro. | |
| 5244 | |
| 5245 \(unread-command-events) An event taken from `unread-command-events'. | |
| 5246 | |
| 5247 \(unread-command-event) An event taken from `unread-command-event'. | |
| 5248 | |
| 5249 \(command event queue) An event taken from an internal queue. | |
| 5250 Events end up on this queue when | |
| 5251 `enqueue-eval-event' is called or when | |
| 5252 user or eval events are received while | |
| 5253 XEmacs is blocking (e.g. in `sit-for', | |
| 5254 `sleep-for', or `accept-process-output', | |
| 5255 or while waiting for the reply to an | |
| 5256 X selection). | |
| 5257 | |
| 5258 \(->keyboard-translate-table) The result of an event translated through | |
| 5259 keyboard-translate-table. Note that in | |
| 5260 this case, two events are printed even | |
| 5261 though only one is really generated. | |
| 5262 | |
| 5263 \(SIGINT) A faked C-g resulting when XEmacs receives | |
| 5264 a SIGINT (e.g. C-c was pressed in XEmacs' | |
| 5265 controlling terminal or the signal was | |
| 5266 explicitly sent to the XEmacs process). | |
| 5267 */ ); | |
| 5268 debug_emacs_events = 0; | |
| 5269 #endif | |
| 5270 | |
| 2828 | 5271 DEFVAR_BOOL ("inhibit-input-event-recording", |
| 5272 &inhibit_input_event_recording /* | |
| 428 | 5273 Non-nil inhibits recording of input-events to recent-keys ring. |
| 5274 */ ); | |
| 5275 inhibit_input_event_recording = 0; | |
| 771 | 5276 |
| 428 | 5277 Vkeyboard_translate_table = |
| 5278 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 2828 | 5279 |
| 5280 DEFVAR_BOOL ("try-alternate-layouts-for-commands", | |
| 5281 &try_alternate_layouts_for_commands /* | |
| 5282 Non-nil means that if looking up a command from a sequence of keys typed by | |
| 5283 the user would otherwise fail, try it again with some other keyboard | |
| 5284 layout. On X11, the only alternative to the default mapping is American | |
| 5285 QWERTY; on Windows, other mappings may be available, depending on things | |
| 5286 like the default language environment for the current user, for the system, | |
| 5287 &c. | |
| 5288 | |
| 5289 With a Russian keyboard layout on X11, for example, this means that | |
| 5290 C-Cyrillic_che C-Cyrillic_a, if you haven't given that sequence a binding | |
| 5291 yourself, will invoke `find-file.' This is because `Cyrillic_che' is | |
| 5292 physically where `x' is, and `Cyrillic_a' is where `f' is, on an American | |
| 5293 Qwerty layout, and, of course, C-x C-f is a default emacs binding for that | |
| 5294 command. | |
| 5295 */ ); | |
| 5296 try_alternate_layouts_for_commands = 1; | |
| 428 | 5297 } |
| 5298 | |
| 5299 void | |
| 5300 init_event_stream (void) | |
| 5301 { | |
| 814 | 5302 /* Normally we don't initialize the event stream when running a bare |
| 5303 temacs (the check for initialized) because it may do various things | |
| 5304 (e.g. under Xt) that we don't want any traces of in a dumped xemacs. | |
| 5305 However, sometimes we need to process events in a bare temacs (in | |
| 5306 particular, when make-docfile.el is executed); so we initialize as | |
| 5307 necessary in check_event_stream_ok(). */ | |
| 428 | 5308 if (initialized) |
| 5309 { | |
| 5310 #ifdef HAVE_UNIXOID_EVENT_LOOP | |
| 5311 init_event_unixoid (); | |
| 5312 #endif | |
| 5313 #ifdef HAVE_X_WINDOWS | |
| 5314 if (!strcmp (display_use, "x")) | |
| 5315 init_event_Xt_late (); | |
| 5316 else | |
| 5317 #endif | |
| 462 | 5318 #ifdef HAVE_GTK |
| 5319 if (!strcmp (display_use, "gtk")) | |
| 5320 init_event_gtk_late (); | |
| 5321 else | |
| 5322 #endif | |
| 428 | 5323 #ifdef HAVE_MS_WINDOWS |
| 5324 if (!strcmp (display_use, "mswindows")) | |
| 5325 init_event_mswindows_late (); | |
| 5326 else | |
| 5327 #endif | |
| 5328 { | |
| 5329 /* For TTY's, use the Xt event loop if we can; it allows | |
| 5330 us to later open an X connection. */ | |
| 5331 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \ | |
| 5332 || (defined (HAVE_MSG_SELECT) \ | |
| 5333 && !defined (DEBUG_TTY_EVENT_STREAM))) | |
| 5334 init_event_mswindows_late (); | |
| 5335 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM) | |
| 5336 init_event_Xt_late (); | |
| 5337 #elif defined (HAVE_TTY) | |
| 5338 init_event_tty_late (); | |
| 5339 #endif | |
| 5340 } | |
| 5341 init_interrupts_late (); | |
| 5342 } | |
| 5343 } | |
| 5344 | |
| 5345 | |
| 5346 /* | |
| 853 | 5347 #### this comment is at least 8 years old and some may no longer apply. |
| 5348 | |
| 428 | 5349 useful testcases for v18/v19 compatibility: |
| 5350 | |
| 5351 (defun foo () | |
| 5352 (interactive) | |
| 5353 (setq unread-command-event (character-to-event ?A (allocate-event))) | |
| 5354 (setq x (list (read-char) | |
| 5355 ; (read-key-sequence "") ; try it with and without this | |
| 5356 last-command-char last-input-char | |
| 5357 (recent-keys) (this-command-keys)))) | |
| 5358 (global-set-key "\^Q" 'foo) | |
| 5359 | |
| 5360 without the read-key-sequence: | |
| 444 | 5361 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q]) |
| 5362 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q]) | |
| 5363 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q]) | |
| 428 | 5364 |
| 5365 with the read-key-sequence: | |
| 444 | 5366 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b]) |
| 5367 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b]) | |
| 5368 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b]) | |
| 428 | 5369 |
| 5370 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag) | |
| 5371 | |
| 5372 ;(setq x (list (read-char) quit-flag))^J^G | |
| 5373 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G | |
| 5374 ;for BOTH, x should get set to (7 t), but no result should be printed. | |
| 444 | 5375 ;; #### According to the doc of quit-flag, second test should return |
| 5376 ;; (?\^G nil). Accidentaly XEmacs returns correct value. However, | |
| 5377 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test. | |
| 428 | 5378 |
| 5379 ;also do this: make two frames, one viewing "*scratch*", the other "foo". | |
| 5380 ;in *scratch*, type (sit-for 20)^J | |
| 5381 ;wait a couple of seconds, move cursor to foo, type "a" | |
| 5382 ;a should be inserted in foo. Cursor highlighting should not change in | |
| 5383 ;the meantime. | |
| 5384 | |
| 5385 ;do it with sleep-for. move cursor into foo, then back into *scratch* | |
| 5386 ;before typing. | |
| 5387 ;repeat also with (accept-process-output nil 20) | |
| 5388 | |
| 5389 ;make sure ^G aborts sit-for, sleep-for and accept-process-output: | |
| 5390 | |
| 5391 (defun tst () | |
| 5392 (list (condition-case c | |
| 5393 (sleep-for 20) | |
| 5394 (quit c)) | |
| 5395 (read-char))) | |
| 5396 | |
| 444 | 5397 (tst)^Ja^G ==> ((quit) ?a) with no signal |
| 5398 (tst)^J^Ga ==> ((quit) ?a) with no signal | |
| 5399 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer | |
| 428 | 5400 |
| 5401 ; with sit-for only do the 2nd test. | |
| 5402 ; Do all 3 tests with (accept-process-output nil 20) | |
| 5403 | |
| 5404 Do this: | |
| 5405 (setq enable-recursive-minibuffers t | |
| 5406 minibuffer-max-depth nil) | |
| 5407 ESC ESC ESC ESC - there are now two minibuffers active | |
| 5408 C-g C-g C-g - there should be active 0, not 1 | |
| 5409 Similarly: | |
| 5410 C-x C-f ~ / ? - wait for "Making completion list..." to display | |
| 5411 C-g - wait for "Quit" to display | |
| 5412 C-g - minibuffer should not be active | |
| 5413 however C-g before "Quit" is displayed should leave minibuffer active. | |
| 5414 | |
| 5415 ;do it all in both v18 and v19 and make sure all results are the same. | |
| 5416 ;all of these cases matter a lot, but some in quite subtle ways. | |
| 5417 */ | |
| 5418 | |
| 5419 /* | |
| 5420 Additional test cases for accept-process-output, sleep-for, sit-for. | |
| 5421 Be sure you do all of the above checking for C-g and focus, too! | |
| 5422 | |
| 5423 ; Make sure that timer handlers are run during, not after sit-for: | |
| 5424 (defun timer-check () | |
| 5425 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil) | |
| 5426 (sit-for 5) | |
| 5427 (message "after sit-for")) | |
| 5428 | |
| 5429 ; The first message should appear after 2 seconds, and the final message | |
| 5430 ; 3 seconds after that. | |
| 5431 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5) | |
| 5432 | |
| 5433 | |
| 5434 | |
| 5435 ; Make sure that process filters are run during, not after sit-for. | |
| 5436 (defun fubar () | |
| 5437 (message "sit-for = %s" (sit-for 30))) | |
| 5438 (add-hook 'post-command-hook 'fubar) | |
| 5439 | |
| 5440 ; Now type M-x shell RET | |
| 5441 ; wait for the shell prompt then send: ls RET | |
| 5442 ; the output of ls should fill immediately, and not wait 30 seconds. | |
| 5443 | |
| 5444 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30) | |
| 5445 | |
| 5446 | |
| 5447 | |
| 5448 ; Make sure that recursive invocations return immediately: | |
| 5449 (defmacro test-diff-time (start end) | |
| 5450 `(+ (* (- (car ,end) (car ,start)) 65536.0) | |
| 5451 (- (cadr ,end) (cadr ,start)) | |
| 5452 (/ (- (caddr ,end) (caddr ,start)) 1000000.0))) | |
| 5453 | |
| 5454 (defun testee (ignore) | |
| 5455 (sit-for 10)) | |
| 5456 | |
| 5457 (defun test-them () | |
| 5458 (let ((start (current-time)) | |
| 5459 end) | |
| 5460 (add-timeout 2 'testee nil) | |
| 5461 (sit-for 5) | |
| 5462 (add-timeout 2 'testee nil) | |
| 5463 (sleep-for 5) | |
| 5464 (add-timeout 2 'testee nil) | |
| 5465 (accept-process-output nil 5) | |
| 5466 (setq end (current-time)) | |
| 5467 (test-diff-time start end))) | |
| 5468 | |
| 5469 (test-them) should sit for 15 seconds. | |
| 5470 Repeat with testee set to sleep-for and accept-process-output. | |
| 5471 These should each delay 36 seconds. | |
| 5472 | |
| 5473 */ |