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