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