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