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