annotate src/event-stream.c @ 788:026c5bf9c134

[xemacs-hg @ 2002-03-21 07:29:57 by ben] chartab.c: Fix bugs in implementation and doc strings. config.h.in: Add foo_checking_assert_at_line() macros. Not clear whether these are actually useful, though; I'll take them out if not. symsinit.h, emacs.c: Some improvements to the timeline. Rearrange a bit the init calls. Add call for reinit_vars_of_object_mswindows() and declare in symsinit.h. event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, events.c, events.h: Introduce new event methods for printing, comparing, and hashing magic events, to avoid event-type-specific stuff that had crept into events.c. (And was crashing, since the channel in MS Windows magic events may be nil.) Implement the methods in event-{tty,gtk,Xt,mswindows}.c. Make wrapping functions event_stream_{compare,hash,format}_magic_event() to check if everything's OK and call the actual callback. Fix events.c to use the new methods. Add a new event-stream-operation EVENT_STREAM_NOTHING -- event stream not actually required to be able to do anything, just be open. (#### This event-stream-operation stuff needs to be rethought.) Fixed describe_event() in event-Xt.c to print its output to a stream, not always to stderr, so it can be used elsewhere. (e.g. in print-event when a magic event is encountered?) lisp.h, lrecord.h: Define new assert_at_line(), for use in asserts inside of inline functions. The assert will report the line and file of the inline function, which is almost certainly not what you want as it's useless. what you want to see is where the pseudo-macro was called from. So, when error-checking is on, we pass in the line and file into the macros, for accurate printout using assert_at_line(). Happens only when error-checking is defined so doesn't slow down non-error-checking builds. Fix XCHAR, XINT, XCHAR_OR_INT, XFOO, and wrap_foo() in this fashion. lstream.c, lstream.h: Add resizing_buffer_to_lisp_string(). objects-gtk.c: Fix typo. objects-msw.c: Implement a smarter way of determining whether a font matches a charset. Formerly we just looked at the "script" element of the font spec, converted it to a code page, and compared it with the code page derived from the charset. Now, as well as doing this, we ask the font for the list of unicode ranges it supports, see what range the charset falls into (#### bogus! need to do this char-by-char), and see if any of the font's supported ranges include the charset's range. also do some caching in Vfont_signature_data of previous inquiries. charset.h, text.c, mule-charset.c: New fun; extracted out of Fmake_char() and declare prototype in charset.h. text.h: introduce assert_by_line() to make REP_BYTES_BY_FIRST_BYTE report the file and line more accurately in an assertion failure. unicode.c: make non-static (used in objects-msw.c), declare in charset.h. mule\mule-category.el: Start implementing a category API compatible with FSF. Not there yet. We need improvements to char-tables. mule\mule-charset.el: Copy translation table code from FSF 21.1 and fix up. Eventually we'll have them in XEmacs. (used in ccl) Not here quite yet, and we need some improvements to char-tables. mule\cyril-util.el, mule\cyrillic.el, mule\devan-util.el, mule\ethio-util.el, mule\korea-util.el, mule\mule-tty-init.el, mule\tibet-util.el, mule\viet-util.el, mule\vietnamese.el: Fix numerous compilation warnings. Fix up code related to translation tables and other types of char-tables. menubar-items.el: Move the frame commands from the View menu to the File menu, to be consistent with how most other programs do things. Move less-used revert/recover items to a submenu. Make "recover" not prompt for a file, but recover the current buffer. TODO.ben-mule-21-5: Create bug list for latest problems.
author ben
date Thu, 21 Mar 2002 07:31:30 +0000
parents 943eaba38521
children e38acbeb1cae
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* The portable interface to event streams.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
5 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
26 /* Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
27
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
28 Created 1991 by Jamie Zawinski.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
29 A great deal of work over the ages by Ben Wing (Mule-ization for 19.12,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30 device abstraction for 19.12/19.13, async timers for 19.14,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 rewriting of focus code for 19.12, pre-idle hook for 19.12,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 redoing of signal and quit handling for 19.9 and 19.12,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
33 misc-user events to clean up menu/scrollbar handling for 19.11,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
34 function-key-map/key-translation-map/keyboard-translate-table for
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35 19.13/19.14, open-dribble-file for 19.13, much other cleanup).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
36 focus-follows-mouse from Chuck Thompson, 1995.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
37 XIM stuff by Martin Buchholz, c. 1996?.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
38 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
39
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 * DANGER!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 * If you ever change ANYTHING in this file, you MUST run the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 * testcases at the end to make sure that you haven't changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 * the semantics of recent-keys, last-input-char, or keyboard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 * macros. You'd be surprised how easy it is to break this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 /* TODO:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 This stuff is way too hard to maintain - needs rework.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 The command builder should deal only with key and button events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Other command events should be able to come in the MIDDLE of a key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 sequence, without disturbing the key sequence composition, or the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 command builder structure representing it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Someone should rethink universal-argument and figure out how an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 arbitrary command can influence the next command (universal-argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 or universal-coding-system-argument) or the next key (hyperify).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 Both C-h and Help in the middle of a key sequence should trigger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 prefix-help-command. help-char is stupid. Maybe we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 keymap-of-last-resort?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 After prefix-help is run, one should be able to CONTINUE TYPING,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 instead of RETYPING, the key sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 #include "blocktype.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 #include "commands.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 #include "insdel.h" /* for buffer_reset_changes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 #include "keymap.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 #include "macros.h" /* for defining_keyboard_macro */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
86 #include "menubar.h" /* #### for evil kludges. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #include "process.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 #include "sysdep.h" /* init_poll_for_quit() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 #include "syssignal.h" /* SIGCHLD, etc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 #include "systime.h" /* to set Vlast_input_time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 #include "file-coding.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 #include <errno.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 /* The number of keystrokes between auto-saves. */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
100 static Fixnum auto_save_interval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Lisp_Object Qundefined_keystroke_sequence;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
103 Lisp_Object Qinvalid_key_binding;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Lisp_Object Qcommand_event_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 /* Hooks to run before and after each command. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Lisp_Object Vpre_command_hook, Vpost_command_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Lisp_Object Qpre_command_hook, Qpost_command_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
111 /* See simple.el */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
112 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
113
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 /* Hook run when XEmacs is about to be idle. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 /* Control gratuitous keyboard focus throwing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 int focus_follows_mouse;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
120 /* When true, modifier keys are sticky. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121 int modifier_keys_are_sticky;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
122 /* Modifier keys are sticky for this many milliseconds. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
123 Lisp_Object Vmodifier_keys_sticky_time;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
124
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
125 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
126 post_command_idle_delay, Vdeferred_action_list, and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
127 Vdeferred_action_function, but we don't because that stuff is crap,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
128 and we're smarter than them, and their momas are fat. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
130 /* FSF Emacs 20.7 also defines Vinput_method_function,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
131 Qinput_method_exit_on_first_char and Qinput_method_use_echo_area.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
132 I don't know this should be imported or not. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 /* Non-nil disable property on a command means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 do not execute it; call disabled-command-hook's value instead. */
733
b1f74adcc1ff [xemacs-hg @ 2002-01-22 20:40:00 by janv]
janv
parents: 707
diff changeset
136 Lisp_Object Qdisabled;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 EXFUN (Fnext_command_event, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 static void pre_command_hook (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 static void post_command_hook (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 /* Last keyboard or mouse input event read as a command. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Lisp_Object Vlast_command_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 /* The nearest ASCII equivalent of the above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Lisp_Object Vlast_command_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 /* Last keyboard or mouse event read for any purpose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Lisp_Object Vlast_input_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 /* The nearest ASCII equivalent of the above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Lisp_Object Vlast_input_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Lisp_Object Vcurrent_mouse_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* This is fbound in cmdloop.el, see the commentary there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Lisp_Object Qcancel_mode_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 /* If not Qnil, event objects to be read as the next command input */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 Lisp_Object Vunread_command_events;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 Lisp_Object Vunread_command_event; /* obsoleteness support */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 static Lisp_Object Qunread_command_events, Qunread_command_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 /* Previous command, represented by a Lisp object.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 Does not include prefix commands and arg setting commands. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Lisp_Object Vlast_command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
170 /* Contents of this-command-properties for the last command. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
171 Lisp_Object Vlast_command_properties;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
172
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 /* If a command sets this, the value goes into
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
174 last-command for the next command. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Lisp_Object Vthis_command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 /* If a command sets this, the value goes into
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
178 last-command-properties for the next command. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
179 Lisp_Object Vthis_command_properties;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
180
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* The value of point when the last command was executed. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 593
diff changeset
182 Charbpos last_point_position;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 /* The frame that was current when the last command was started. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Lisp_Object Vlast_selected_frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 /* The buffer that was current when the last command was started. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Lisp_Object last_point_position_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 /* A (16bit . 16bit) representation of the time of the last-command-event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Lisp_Object Vlast_input_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 /* A (16bit 16bit usec) representation of the time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 of the last-command-event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Lisp_Object Vlast_command_event_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 /* Character to recognize as the help char. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Lisp_Object Vhelp_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 /* Form to execute when help char is typed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Lisp_Object Vhelp_form;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 /* Command to run when the help character follows a prefix key. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 Lisp_Object Vprefix_help_command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 may have happened. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 volatile int something_happened;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 /* Hash table to translate keysyms through */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 Lisp_Object Vkeyboard_translate_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Lisp_Object Vretry_undefined_key_binding_unshifted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object Qretry_undefined_key_binding_unshifted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
217 #ifdef MULE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 /* If composed input is undefined, use self-insert-char */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Lisp_Object Vcomposed_character_default_binding;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
220 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* Console that corresponds to our controlling terminal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object Vcontrolling_terminal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 /* An event (actually an event chain linked through event_next) or Qnil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Lisp_Object Vthis_command_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Lisp_Object Vthis_command_keys_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 /* #### kludge! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Lisp_Object Qauto_show_make_point_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 /* File in which we write all commands we read; an lstream */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 static Lisp_Object Vdribble_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 /* Recent keys ring location; a vector of events or nil-s */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 Lisp_Object Vrecent_keys_ring;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 int recent_keys_ring_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 int recent_keys_ring_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 /* Boolean specifying whether keystrokes should be added to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 recent-keys. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 int inhibit_input_event_recording;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
245 Lisp_Object Qself_insert_defer_undo;
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
246
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 /* this is in keymap.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 extern Lisp_Object Fmake_keymap (Lisp_Object name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 #ifdef DEBUG_XEMACS
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
251 Fixnum debug_emacs_events;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 external_debugging_print_event (char *event_description, Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 write_c_string ("(", Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 write_c_string (event_description, Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 write_c_string (") ", Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 print_internal (event, Qexternal_debugging_output, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 write_c_string ("\n", Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 if (debug_emacs_events) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 external_debugging_print_event (event_description, event); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 #define DEBUG_PRINT_EMACS_EVENT(string, event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 /* The callback routines for the window system or terminal driver */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 struct event_stream *event_stream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 static void echo_key_event (struct command_builder *, Lisp_Object event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 static void maybe_kbd_translate (Lisp_Object event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 /* This structure is basically a typeahead queue: things like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 wait-reading-process-output will delay the execution of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 keyboard and mouse events by pushing them here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Chained through event_next()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 command_event_queue_tail is a pointer to the last-added element.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 static Lisp_Object command_event_queue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 static Lisp_Object command_event_queue_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 /* Nonzero means echo unfinished commands after this many seconds of pause. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 static Lisp_Object Vecho_keystrokes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 /* The number of keystrokes since the last auto-save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 static int keystrokes_since_auto_save;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 /* Used by the C-g signal handler so that it will never "hard quit"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 when waiting for an event. Otherwise holding down C-g could
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 cause a suspension back to the shell, which is generally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 undesirable. (#### This doesn't fully work.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 int emacs_is_blocking;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 /* Handlers which run during sit-for, sleep-for and accept-process-output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 are not allowed to recursively call these routines. We record here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 if we are in that situation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 static Lisp_Object recursive_sit_for;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 /* Command-builder object */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 #define XCOMMAND_BUILDER(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 XRECORD (x, command_builder, struct command_builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
315 #define wrap_command_builder(p) wrap_record (p, command_builder)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
318 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
319
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
320 static Lisp_Object Vcommand_builder_free_list;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 mark_command_builder (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 struct command_builder *builder = XCOMMAND_BUILDER (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 mark_object (builder->current_events);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 mark_object (builder->most_current_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 mark_object (builder->last_non_munged_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 mark_object (builder->munge_me[0].first_mungeable_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 mark_object (builder->munge_me[1].first_mungeable_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 return builder->console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 finalize_command_builder (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 if (!for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
339 struct command_builder *b = (struct command_builder *) header;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
340 if (b->echo_buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
341 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
342 xfree (b->echo_buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
343 b->echo_buf = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
344 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 mark_command_builder, internal_object_printer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 finalize_command_builder, 0, 0, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 struct command_builder);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
352
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 reset_command_builder_event_chain (struct command_builder *builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 builder->current_events = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 builder->most_current_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 builder->last_non_munged_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 builder->munge_me[0].first_mungeable_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 builder->munge_me[1].first_mungeable_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 Lisp_Object
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
364 allocate_command_builder (Lisp_Object console, int with_echo_buf)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
366 Lisp_Object builder_obj =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
367 allocate_managed_lcrecord (Vcommand_builder_free_list);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
368 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 builder->console = console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 reset_command_builder_event_chain (builder);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
372 if (with_echo_buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
373 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
374 /* #### This badly needs to be turned into a Dynarr */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
375 builder->echo_buf_length = 300; /* #### Kludge */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
376 builder->echo_buf = xnew_array (Intbyte, builder->echo_buf_length);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
377 builder->echo_buf[0] = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
378 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
379 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
380 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
381 builder->echo_buf_length = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
382 builder->echo_buf = NULL;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
383 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 builder->echo_buf_index = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 builder->self_insert_countdown = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 return builder_obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
390 /* Copy or clone COLLAPSING (copy to NEW_BUILDINGS if non-zero,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
391 otherwise clone); but don't copy the echo-buf stuff. (The calling
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
392 routines don't need it and will reset it, and we would rather avoid
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
393 malloc.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
394
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
395 static Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
396 copy_command_builder (struct command_builder *collapsing,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
397 struct command_builder *new_buildings)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
398 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
399 if (!new_buildings)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
400 new_buildings = XCOMMAND_BUILDER (allocate_command_builder (Qnil, 0));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
401
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
402 new_buildings->self_insert_countdown = collapsing->self_insert_countdown;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
403
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
404 deallocate_event_chain (new_buildings->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
405 new_buildings->current_events =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
406 copy_event_chain (collapsing->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
407
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
408 new_buildings->most_current_event =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
409 transfer_event_chain_pointer (collapsing->most_current_event,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
410 collapsing->current_events,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
411 new_buildings->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
412 new_buildings->last_non_munged_event =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
413 transfer_event_chain_pointer (collapsing->last_non_munged_event,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
414 collapsing->current_events,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
415 new_buildings->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
416 new_buildings->munge_me[0].first_mungeable_event =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
417 transfer_event_chain_pointer (collapsing->munge_me[0].
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
418 first_mungeable_event,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
419 collapsing->current_events,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
420 new_buildings->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
421 new_buildings->munge_me[1].first_mungeable_event =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
422 transfer_event_chain_pointer (collapsing->munge_me[1].
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
423 first_mungeable_event,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
424 collapsing->current_events,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
425 new_buildings->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
426
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
427 return wrap_command_builder (new_buildings);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
428 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
429
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
430 static void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
431 free_command_builder (struct command_builder *builder)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
432 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
433 if (builder->echo_buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
434 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
435 xfree (builder->echo_buf);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
436 builder->echo_buf = NULL;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
437 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
438 free_managed_lcrecord (Vcommand_builder_free_list,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
439 wrap_command_builder (builder));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
440 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
441
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 command_builder_append_event (struct command_builder *builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 assert (EVENTP (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
448 event = Fcopy_event (event, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 if (EVENTP (builder->most_current_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 XSET_EVENT_NEXT (builder->most_current_event, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 builder->current_events = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 builder->most_current_event = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 if (NILP (builder->munge_me[0].first_mungeable_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 builder->munge_me[0].first_mungeable_event = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 if (NILP (builder->munge_me[1].first_mungeable_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 builder->munge_me[1].first_mungeable_event = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 /* Low-level interfaces onto event methods */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 enum event_stream_operation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 EVENT_STREAM_PROCESS,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 EVENT_STREAM_TIMEOUT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 EVENT_STREAM_CONSOLE,
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
471 EVENT_STREAM_READ,
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
472 EVENT_STREAM_NOTHING,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 check_event_stream_ok (enum event_stream_operation op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 if (!event_stream && noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 switch (op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 case EVENT_STREAM_PROCESS:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
483 invalid_operation ("Can't start subprocesses in -batch mode",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
484 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 case EVENT_STREAM_TIMEOUT:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
486 invalid_operation ("Can't add timeouts in -batch mode", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 case EVENT_STREAM_CONSOLE:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
488 invalid_operation ("Can't add consoles in -batch mode", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 case EVENT_STREAM_READ:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
490 invalid_operation ("Can't read events in -batch mode", Qunbound);
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
491 case EVENT_STREAM_NOTHING:
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
492 break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 else if (!event_stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
499 invalid_operation
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
500 ("event-stream callbacks not initialized (internal error?)",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
501 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 event_stream_event_pending_p (int user)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 return event_stream && event_stream->event_pending_p (user);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
511 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
512 event_stream_force_event_pending (struct frame *f)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 if (event_stream->force_event_pending)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 event_stream->force_event_pending (f);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
519 maybe_read_quit_event (Lisp_Event *event)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 /* A C-g that came from `sigint_happened' will always come from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 controlling terminal. If that doesn't exist, however, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 user manually sent us a SIGINT, and we pretend the C-g came from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 the selected console. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 struct console *con;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 if (CONSOLEP (Vcontrolling_terminal) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 con = XCONSOLE (Vcontrolling_terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 con = XCONSOLE (Fselected_console ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 if (sigint_happened)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 int ch = CONSOLE_QUIT_CHAR (con);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 sigint_happened = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 character_to_event (ch, event, con, 1, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
539 event->channel = wrap_console (con);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
546 event_stream_next_event (Lisp_Event *event)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 Lisp_Object event_obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 check_event_stream_ok (EVENT_STREAM_READ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 XSETEVENT (event_obj, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 zero_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 /* If C-g was pressed, treat it as a character to be read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 Note that if C-g was pressed while we were blocking,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 the SIGINT signal handler will be called. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 set Vquit_flag and write a byte on our "fake pipe",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 which will unblock us. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (maybe_read_quit_event (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 /* If a longjmp() happens in the callback, we're screwed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 Let's hope it doesn't. I think the code here is fairly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 clean and doesn't do this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 emacs_is_blocking = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 event_stream->next_event_cb (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 emacs_is_blocking = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 /* timeout events have more info set later, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 print the event out in next_event_internal(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 if (event->event_type != timeout_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 maybe_kbd_translate (event_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
582 event_stream_handle_magic_event (Lisp_Event *event)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 check_event_stream_ok (EVENT_STREAM_READ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 event_stream->handle_magic_event_cb (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
588 void
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
589 event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
590 {
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
591 check_event_stream_ok (EVENT_STREAM_NOTHING);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
592 event_stream->format_magic_event_cb (event, pstream);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
593 }
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
594
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
595 int
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
596 event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
597 {
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
598 check_event_stream_ok (EVENT_STREAM_NOTHING);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
599 return event_stream->compare_magic_event_cb (e1, e2);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
600 }
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
601
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
602 Hashcode
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
603 event_stream_hash_magic_event (Lisp_Event *e)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
604 {
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
605 check_event_stream_ok (EVENT_STREAM_NOTHING);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
606 return event_stream->hash_magic_event_cb (e);
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
607 }
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
608
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 event_stream_add_timeout (EMACS_TIME timeout)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 return event_stream->add_timeout_cb (timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 event_stream_remove_timeout (int id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 event_stream->remove_timeout_cb (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 event_stream_select_console (struct console *con)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 check_event_stream_ok (EVENT_STREAM_CONSOLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 if (!con->input_enabled)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 event_stream->select_console_cb (con);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 con->input_enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 event_stream_unselect_console (struct console *con)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 check_event_stream_ok (EVENT_STREAM_CONSOLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 if (con->input_enabled)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 event_stream->unselect_console_cb (con);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 con->input_enabled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
646 event_stream_select_process (Lisp_Process *proc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 check_event_stream_ok (EVENT_STREAM_PROCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 if (!get_process_selected_p (proc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 event_stream->select_process_cb (proc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 set_process_selected_p (proc, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
657 event_stream_unselect_process (Lisp_Process *proc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 check_event_stream_ok (EVENT_STREAM_PROCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 if (get_process_selected_p (proc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 event_stream->unselect_process_cb (proc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 set_process_selected_p (proc, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 USID
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
668 event_stream_create_stream_pair (void *inhandle, void *outhandle,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
669 Lisp_Object *instream, Lisp_Object *outstream, int flags)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 check_event_stream_ok (EVENT_STREAM_PROCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 return event_stream->create_stream_pair_cb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (inhandle, outhandle, instream, outstream, flags);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 USID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 check_event_stream_ok (EVENT_STREAM_PROCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 return event_stream->delete_stream_pair_cb (instream, outstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 event_stream_quit_p (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 if (event_stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 event_stream->quit_p_cb ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
690 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 event_stream_current_event_timestamp (struct console *c)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 if (event_stream && event_stream->current_event_timestamp_cb)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694 return event_stream->current_event_timestamp_cb (c);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
695 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
696 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
697 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* Character prompting */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 echo_key_event (struct command_builder *command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 char buf[255];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 Bytecount buf_index = command_builder->echo_buf_index;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 593
diff changeset
711 Intbyte *e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Bytecount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 if (buf_index < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 buf_index = 0; /* We're echoing now */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 clear_echo_area (selected_frame (), Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 format_event_object (buf, XEVENT (event), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 len = strlen (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 if (len + buf_index + 4 > command_builder->echo_buf_length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 e = command_builder->echo_buf + buf_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 memcpy (e, buf, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 e += len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 e[0] = ' ';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 e[1] = '-';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 e[2] = ' ';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 e[3] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 command_builder->echo_buf_index = buf_index + len + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 regenerate_echo_keys_from_this_command_keys (struct command_builder *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 builder->echo_buf_index = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 echo_key_event (builder, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 double echo_keystrokes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 /* Message turns off echoing unless more keystrokes turn it on again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 echo_keystrokes = extract_float (Vecho_keystrokes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 echo_keystrokes = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 if (minibuf_level == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 && echo_keystrokes > 0.0
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
766 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
767 && !x_kludge_lw_menu_active ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
768 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
769 )
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 if (!no_snooze)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 doesn't work. See check_quit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 /* input came in, so don't echo. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 /* not echo_buf_index. That doesn't include
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 the terminating " - ". */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 strlen ((char *) command_builder->echo_buf),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 Qcommand);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 reset_key_echo (struct command_builder *command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 int remove_echo_area_echo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794
757
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
795 if (command_builder)
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
796 command_builder->echo_buf_index = -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 if (remove_echo_area_echo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 clear_echo_area (f, Qcommand, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 /* random junk */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 maybe_kbd_translate (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 int did_translate = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 if (XEVENT_TYPE (event) != key_press_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 if (!HASH_TABLEP (Vkeyboard_translate_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 c = event_to_character (XEVENT (event), 0, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 if (c != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 if (!NILP (traduit) && SYMBOLP (traduit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 XEVENT (event)->event.key.keysym = traduit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 XEVENT (event)->event.key.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 did_translate = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 else if (CHARP (traduit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
833 Lisp_Event ev2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 /* This used to call Fcharacter_to_event() directly into EVENT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 but that can eradicate timestamps and other such stuff.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 This way is safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 zero_event (&ev2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 character_to_event (XCHAR (traduit), &ev2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 did_translate = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 if (!did_translate)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 Vkeyboard_translate_table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 if (!NILP (traduit) && SYMBOLP (traduit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 XEVENT (event)->event.key.keysym = traduit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 did_translate = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
856 else if (CHARP (traduit))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
857 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858 Lisp_Event ev2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
859
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
860 zero_event (&ev2);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
861 character_to_event (XCHAR (traduit), &ev2,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
862 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
863 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864 XEVENT (event)->event.key.modifiers |= ev2.event.key.modifiers;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865 did_translate = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
866 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 if (did_translate)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 keystrokes_since_auto_save is equivalent to the difference between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 num_nonmacro_input_chars and last_auto_save. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
879 /* When an auto-save happens, record the number of keystrokes, and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
880 don't do again soon. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 record_auto_save (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 keystrokes_since_auto_save = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* Make an auto save happen as soon as possible at command level. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 force_auto_save_soon (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 maybe_do_auto_save (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 keystrokes_since_auto_save++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 if (auto_save_interval > 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 !detect_input_pending ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 Fdo_auto_save (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 record_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 print_help (Lisp_Object object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 Fprinc (object, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 execute_help_form (struct command_builder *command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 Lisp_Object help = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 Bytecount buf_index = command_builder->echo_buf_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 Lisp_Object echo = ((buf_index <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 ? Qnil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 : make_string (command_builder->echo_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 buf_index));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 GCPRO2 (echo, help);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 record_unwind_protect (save_window_excursion_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 Fcurrent_window_configuration (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 reset_key_echo (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 help = Feval (Vhelp_form);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 if (STRINGP (help))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 internal_with_output_to_temp_buffer (build_string ("*Help*"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 print_help, help, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 Fnext_command_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 /* Remove the help from the frame */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
942 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 /* Hmmmm. Tricky. The unbind restores an old window configuration,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 apparently bypassing any setting of windows_structure_changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 So we need to set it so that things get redrawn properly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 /* #### This is massive overkill. Look at doing it better once the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 new redisplay is fully in place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 Lisp_Object frmcons, devcons, concons;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 struct frame *f = XFRAME (XCAR (frmcons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 /* Discard next key if it is a space */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 reset_key_echo (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Fnext_command_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 command_builder->echo_buf_index = buf_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 if (buf_index > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 memcpy (command_builder->echo_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 /* input pending */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 detect_input_pending (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 /* Always call the event_pending_p hook even if there's an unread
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 character, because that might do some needed ^G detection (on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 systems without SIGIO, for example).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 if (event_stream_event_pending_p (1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 if (!NILP (command_event_queue))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 EVENT_CHAIN_LOOP (event, command_event_queue)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 if (XEVENT_TYPE (event) != eval_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 && XEVENT_TYPE (event) != magic_eval_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 Return t if command input is currently available with no waiting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 Actually, the value is nil only if we can be sure that no input is available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 return detect_input_pending () ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 /* timeouts */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1016 /* NOTE: "Low-level" or "interval" timeouts are one-shot timeouts that
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1017 measure single intervals. "High-level timeouts" or "wakeups" are
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1018 the objects generated by `add-timeout' or `add-async-timout' --
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1019 they can fire repeatedly (and in fact can have a different initial
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1020 time and resignal time). Given the nature of both setitimer() and
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1021 select() -- i.e. all we get is a single one-shot timer -- we have
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1022 to decompose all high-level timeouts into a series of intervals or
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1023 low-level timeouts.
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1024
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1025 Low-level timeouts are of two varieties: synchronous and asynchronous.
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1026 The former are handled at the window-system level, the latter in
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1027 signal.c.
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1028 */
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1029
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1030 /**** Low-level timeout helper functions. ****
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 These functions maintain a sorted list of one-shot timeouts (where
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1033 the timeouts are in absolute time so we never lose any time as a
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1034 result of the delay between noting an interval and firing the next
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1035 one). They are intended for use by functions that need to convert
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1036 a list of absolute timeouts into a series of intervals to wait
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1037 for. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 used to indicate an absence of a timer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 static int low_level_timeout_id_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 static struct low_level_timeout_blocktype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 Blocktype_declare (struct low_level_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 } *the_low_level_timeout_blocktype;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 a unique ID identifying the timeout. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 add_low_level_timeout (struct low_level_timeout **timeout_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 EMACS_TIME thyme)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 struct low_level_timeout *tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 struct low_level_timeout *t, **tt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 /* Allocate a new time struct. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 tm->next = NULL;
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1062 /* Don't just use ++low_level_timeout_id_tick, for the (admittedly
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1063 rare) case in which numbers wrap around. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 if (low_level_timeout_id_tick == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 low_level_timeout_id_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 tm->id = low_level_timeout_id_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 tm->time = thyme;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 /* Add it to the queue. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 tt = timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 t = *tt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 tt = &t->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 t = *tt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 tm->next = t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 *tt = tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 return tm->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 If the timeout is not there, do nothing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 struct low_level_timeout *t, *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 /* find it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 prev = t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 if (!t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 return; /* couldn't find it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 if (!prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 *timeout_list = t->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 else prev->next = t->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 Blocktype_free (the_low_level_timeout_blocktype, t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 /* If there are timeouts on TIMEOUT_LIST, store the relative time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 interval to the first timeout on the list into INTERVAL and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 return 1. Otherwise, return 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 EMACS_TIME *interval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 if (!timeout_list) /* no timer events; block indefinitely */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 EMACS_TIME current_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 /* The time to block is the difference between the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (earliest) timer on the queue and the current time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 If that is negative, then the timer will fire immediately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 but we still have to call select(), with a zero-valued
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 timeout: user events must have precedence over timer events. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 EMACS_GET_TIME (current_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 EMACS_SUB_TIME (*interval, timeout_list->time,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 current_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 EMACS_SET_SECS_USECS (*interval, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 timeout into TIME_OUT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 pop_low_level_timeout (struct low_level_timeout **timeout_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 EMACS_TIME *time_out)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 struct low_level_timeout *tm = *timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 assert (tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 id = tm->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 if (time_out)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 *time_out = tm->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 *timeout_list = tm->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 Blocktype_free (the_low_level_timeout_blocktype, tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 return id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1157 /**** High-level timeout functions. **** */
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1158
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1159 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1160 used to indicate an absence of a timer. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 static int timeout_id_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 static Lisp_Object Vtimeout_free_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 mark_timeout (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1170 Lisp_Timeout *tm = XTIMEOUT (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 mark_object (tm->function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 return tm->object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 /* Should never, ever be called. (except by an external debugger) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1179 const Lisp_Timeout *t = XTIMEOUT (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 char buf[64];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 (unsigned long) t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 static const struct lrecord_description timeout_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1188 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1189 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 mark_timeout, print_timeout,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1195 0, 0, 0, timeout_description, Lisp_Timeout);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 /* Generate a timeout and return its ID. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 event_stream_generate_wakeup (unsigned int milliseconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 unsigned int vanilliseconds,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 Lisp_Object function, Lisp_Object object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 int async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1206 Lisp_Timeout *timeout = XTIMEOUT (op);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 EMACS_TIME current_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 EMACS_TIME interval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1210 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1211 in which numbers wrap around. */
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1212 if (timeout_id_tick == 0)
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1213 timeout_id_tick++;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 timeout->id = timeout_id_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 timeout->resignal_msecs = vanilliseconds;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 timeout->function = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 timeout->object = object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 EMACS_GET_TIME (current_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 1000 * (milliseconds % 1000));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 if (async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 timeout->interval_id =
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1227 signal_add_async_interval_timeout (timeout->next_signal_time);
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1228 pending_async_timeout_list =
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1229 noseeum_cons (op, pending_async_timeout_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 timeout->interval_id =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 event_stream_add_timeout (timeout->next_signal_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 return timeout->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 as necessary and return the timeout's ID and function and object slots.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 This should be called as a result of receiving notice that a timeout
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 identifies this particular firing of the timeout. INTERVAL-ID's and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 timeout ID's are in separate number spaces and bear no relation to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 each other. The INTERVAL-ID is all that the event callback routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 work with: they work only with one-shot intervals, not with timeouts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 that may fire repeatedly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1254 int
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 event_stream_resignal_wakeup (int interval_id, int async_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 Lisp_Object *function, Lisp_Object *object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Lisp_Object op = Qnil, rest;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1259 Lisp_Timeout *timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 Lisp_Object *timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 GCPRO1 (op); /* just in case ... because it's removed from the list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 for awhile. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 /* Find the timeout on the list of pending ones. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 LIST_LOOP (rest, *timeout_list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 timeout = XTIMEOUT (XCAR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 if (timeout->interval_id == interval_id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 assert (!NILP (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 op = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 timeout = XTIMEOUT (op);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 /* We make sure to snarf the data out of the timeout object before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 we free it with free_managed_lcrecord(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 id = timeout->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 *function = timeout->function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 *object = timeout->object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 /* Remove this one from the list of pending timeouts */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 /* If this timeout wants to be resignalled, do it now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 if (timeout->resignal_msecs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 EMACS_TIME current_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 EMACS_TIME interval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 /* Determine the time that the next resignalling should occur.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 We do that by adding the interval time to the last signalled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 time until we get a time that's current.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (This way, it doesn't matter if the timeout was signalled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 exactly when we asked for it, or at some time later.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 EMACS_GET_TIME (current_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 1000 * (timeout->resignal_msecs % 1000));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 interval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 if (async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 timeout->interval_id =
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1313 signal_add_async_interval_timeout (timeout->next_signal_time);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 timeout->interval_id =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 event_stream_add_timeout (timeout->next_signal_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 /* Add back onto the list. Note that the effect of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 is to move frequently-hit timeouts to the front of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 list, which is a good thing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 *timeout_list = noseeum_cons (op, *timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 free_managed_lcrecord (Vtimeout_free_list, op);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 return id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 event_stream_disable_wakeup (int id, int async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1332 Lisp_Timeout *timeout = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 Lisp_Object *timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 if (async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 timeout_list = &pending_async_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 timeout_list = &pending_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 /* Find the timeout on the list of pending ones, if it's still there. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 LIST_LOOP (rest, *timeout_list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 timeout = XTIMEOUT (XCAR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 if (timeout->id == id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 /* If we found it, remove it from the list and disable the pending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 one-shot. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 if (!NILP (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 Lisp_Object op = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 *timeout_list =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 delq_no_quit_and_free_cons (op, *timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 if (async_p)
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
1357 signal_remove_async_interval_timeout (timeout->interval_id);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 event_stream_remove_timeout (timeout->interval_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 free_managed_lcrecord (Vtimeout_free_list, op);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 event_stream_wakeup_pending_p (int id, int async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1367 Lisp_Timeout *timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 Lisp_Object timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 int found = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 if (async_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 timeout_list = pending_async_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 timeout_list = pending_timeout_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 /* Find the element on the list of pending ones, if it's still there. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 LIST_LOOP (rest, timeout_list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 timeout = XTIMEOUT (XCAR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 if (timeout->id == id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 found = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 return found;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 /**** Lisp-level timeout functions. ****/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 double fsecs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 CHECK_INT_OR_FLOAT (secs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 fsecs = XFLOATINT (secs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 long fsecs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 CHECK_INT (secs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 fsecs = XINT (secs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 if (fsecs < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
1408 invalid_argument ("timeout is negative", secs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 if (!allow_0 && fsecs == 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
1410 invalid_argument ("timeout is non-positive", secs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
1412 invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 ("timeout would exceed 32 bits when represented in milliseconds", secs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 return (unsigned long) (1000 * fsecs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 Add a timeout, to be signaled after the timeout period has elapsed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 SECS is a number of seconds, expressed as an integer or a float.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 FUNCTION will be called after that many seconds have elapsed, with one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 then after this timeout expires, `add-timeout' will automatically be called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 again with RESIGNAL as the first argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 This function returns an object which is the id number of this particular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 timeout. You can pass that object to `disable-timeout' to turn off the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 timeout before it has been signalled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 NOTE: Id numbers as returned by this function are in a distinct namespace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 from those returned by `add-async-timeout'. This means that the same id
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 number could refer to a pending synchronous timeout and a different pending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 asynchronous timeout, and that you cannot pass an id from `add-timeout'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 to `disable-async-timeout', or vice-versa.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 The number of seconds may be expressed as a floating-point number, in which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 case some fractional part of a second will be used. Caveat: the usable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 timeout granularity will vary from system to system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 Adding a timeout causes a timeout event to be returned by `next-event', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 the function will be invoked by `dispatch-event,' so if emacs is in a tight
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 loop, the function will not be invoked until the next call to sit-for or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 until the return to top-level (the same is true of process filters).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 If you need to have a timeout executed even when XEmacs is in the midst of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 running Lisp code, use `add-async-timeout'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 WARNING: if you are thinking of calling add-timeout from inside of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 callback function as a way of resignalling a timeout, think again. There
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 is a race condition. That's why the RESIGNAL argument exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 (secs, function, object, resignal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 unsigned long msecs2 = (NILP (resignal) ? 0 :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 lisp_number_to_milliseconds (resignal, 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 Lisp_Object lid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 lid = make_int (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 if (id != XINT (lid)) abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 return lid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 Disable a timeout from signalling any more.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 ID should be a timeout id number as returned by `add-timeout'. If ID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 corresponds to a one-shot timeout that has already signalled, nothing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 will happen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 It will not work to call this function on an id number returned by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 `add-async-timeout'. Use `disable-async-timeout' for that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 (id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 CHECK_INT (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 event_stream_disable_wakeup (XINT (id), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 Add an asynchronous timeout, to be signaled after an interval has elapsed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 SECS is a number of seconds, expressed as an integer or a float.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 FUNCTION will be called after that many seconds have elapsed, with one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 then after this timeout expires, `add-async-timeout' will automatically be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 called again with RESIGNAL as the first argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 This function returns an object which is the id number of this particular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 timeout. You can pass that object to `disable-async-timeout' to turn off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 the timeout before it has been signalled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 NOTE: Id numbers as returned by this function are in a distinct namespace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 from those returned by `add-timeout'. This means that the same id number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 could refer to a pending synchronous timeout and a different pending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 asynchronous timeout, and that you cannot pass an id from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 `add-async-timeout' to `disable-timeout', or vice-versa.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 The number of seconds may be expressed as a floating-point number, in which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 case some fractional part of a second will be used. Caveat: the usable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 timeout granularity will vary from system to system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 Adding an asynchronous timeout causes the function to be invoked as soon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 as the timeout occurs, even if XEmacs is in the midst of executing some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 other code. (This is unlike the synchronous timeouts added with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 `add-timeout', where the timeout will only be signalled when XEmacs is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 waiting for events, i.e. the next return to top-level or invocation of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 `sit-for' or related functions.) This means that the function that is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 called *must* not signal an error or change any global state (e.g. switch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 buffers or windows) except when locking code is in place to make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 that race conditions don't occur in the interaction between the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 asynchronous timeout function and other code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 Under most circumstances, you should use `add-timeout' instead, as it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 much safer. Asynchronous timeouts should only be used when such behavior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 is really necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 asynchronous timeouts will get called immediately. (Multiple occurrences
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 of the same asynchronous timeout are not queued, however.) While the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 callback function of an asynchronous timeout is invoked, `inhibit-quit'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 is automatically bound to non-nil, and thus other asynchronous timeouts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 will be blocked unless the callback function explicitly sets `inhibit-quit'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 callback function as a way of resignalling a timeout, think again. There
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 is a race condition. That's why the RESIGNAL argument exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 (secs, function, object, resignal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 unsigned long msecs2 = (NILP (resignal) ? 0 :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 lisp_number_to_milliseconds (resignal, 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 Lisp_Object lid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 lid = make_int (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 if (id != XINT (lid)) abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 return lid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 Disable an asynchronous timeout from signalling any more.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 ID should be a timeout id number as returned by `add-async-timeout'. If ID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 corresponds to a one-shot timeout that has already signalled, nothing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 will happen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 It will not work to call this function on an id number returned by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 `add-timeout'. Use `disable-timeout' for that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 (id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 CHECK_INT (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 event_stream_disable_wakeup (XINT (id), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 /* enqueuing and dequeuing events */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 /* Add an event to the back of the command-event queue: it will be the next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 event read after all pending events. This only works on keyboard,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 mouse-click, misc-user, and eval events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 enqueue_command_event (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 dequeue_command_event (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 return dequeue_event (&command_event_queue, &command_event_queue_tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 /* put the event on the typeahead queue, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 the event is the quit char, in which case the `QUIT'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 which will occur on the next trip through this loop is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 all the processing we should do - leaving it on the queue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 would cause the quit to be processed twice.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 enqueue_command_event_1 (Lisp_Object event_to_copy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 /* do not call check_quit() here. Vquit_flag was set in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 next_event_internal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 if (NILP (Vquit_flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 XEVENT (event)->event_type = magic_eval_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 /* channel for magic_eval events is nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 XEVENT (event)->event.magic_eval.internal_function = fun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 XEVENT (event)->event.magic_eval.object = object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 enqueue_command_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 Add an eval event to the back of the eval event queue.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 When this event is dispatched, FUNCTION (which should be a function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 of one argument) will be called with OBJECT as its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 See `next-event' for a description of event types and how events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 are received.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 (function, object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 XEVENT (event)->event_type = eval_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 /* channel for eval events is nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 XEVENT (event)->event.eval.function = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 XEVENT (event)->event.eval.object = object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 enqueue_command_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 Lisp_Object object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 XEVENT (event)->event_type = misc_user_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 XEVENT (event)->channel = channel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 XEVENT (event)->event.misc.function = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 XEVENT (event)->event.misc.object = object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 XEVENT (event)->event.misc.button = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 XEVENT (event)->event.misc.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 XEVENT (event)->event.misc.x = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 XEVENT (event)->event.misc.y = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 enqueue_command_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 Lisp_Object object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 int button, int modifiers, int x, int y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 XEVENT (event)->event_type = misc_user_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 XEVENT (event)->channel = channel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 XEVENT (event)->event.misc.function = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 XEVENT (event)->event.misc.object = object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 XEVENT (event)->event.misc.button = button;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 XEVENT (event)->event.misc.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 XEVENT (event)->event.misc.x = x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 XEVENT (event)->event.misc.y = y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 enqueue_command_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 /* focus-event handling */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 Ben's capsule lecture on focus:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 In FSFmacs `select-frame' never changes the window-manager frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 focus. All it does is change the "selected frame". This is similar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 to what happens when we call `select-device' or `select-console'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 Whenever an event comes in (including a keyboard event), its frame is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 selected; therefore, evaluating `select-frame' in *scratch* won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 cause any effects because the next received event (in the same frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 will cause a switch back to the frame displaying *scratch*.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 Whenever a focus-change event is received from the window manager, it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 generates a `switch-frame' event, which causes the Lisp function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 `handle-switch-frame' to get run. This basically just runs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 `select-frame' (see below, however).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 In FSFmacs, if you want to have an operation run when a frame is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 selected, you supply an event binding for `switch-frame' (and then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 maybe call `handle-switch-frame', or something ...).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 In XEmacs, we *do* change the window-manager frame focus as a result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 of `select-frame', but not until the next time an event is received,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 so that a function that momentarily changes the selected frame won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 cause WM focus flashing. (#### There's something not quite right here;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 this is causing the wrong-cursor-focus problems that you occasionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 see. But the general idea is correct.) This approach is winning for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 people who use the explicit-focus model, but is trickier to implement.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 We also don't make the `switch-frame' event visible but instead have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 `select-frame-hook', which is a better approach.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 There is the problem of surrogate minibuffers, where when we enter the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 minibuffer, you essentially want to temporarily switch the WM focus to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 the frame with the minibuffer, and switch it back when you exit the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 FSFmacs solves this with the crockish `redirect-frame-focus', which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 says "for keyboard events received from FRAME, act like they're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 coming from FOCUS-FRAME". I think what this means is that, when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 a keyboard event comes in and the event manager is about to select the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 event's frame, if that frame has its focus redirected, the redirected-to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 frame is selected instead. That way, if you're in a minibufferless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 frame and enter the minibuffer, then all Lisp functions that run see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 the selected frame as the minibuffer's frame rather than the minibufferless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 frame you came from, so that (e.g.) your typing actually appears in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 the minibuffer's frame and things behave sanely.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 There's also some weird logic that switches the redirected frame focus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 from one frame to another if Lisp code explicitly calls `select-frame'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 \(but not if `handle-switch-frame' is called), and saves and restores
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 the frame focus in window configurations, etc. etc. All of this logic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 is heavily #if 0'd, with lots of comments saying "No, this approach
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 doesn't seem to work, so I'm trying this ... is it reasonable?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 Well, I'm not sure ..." that are a red flag indicating crockishness.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 Because of our way of doing things, we can avoid all this crock.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 Keyboard events never cause a select-frame (who cares what frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 they're associated with? They come from a console, only). We change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 the actual WM focus to a surrogate minibuffer frame, so we don't have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 to do any internal redirection. In order to get the focus back,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 I took the approach in minibuf.el of just checking to see if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 frame we moved to is still the selected frame, and move back to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 old one if so. Conceivably we might have to do the weird "tracking"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 that FSFmacs does when `select-frame' is called, but I don't think
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 so. If the selected frame moved from the minibuffer frame, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 we just leave it there, figuring that someone knows what they're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 doing. Because we don't have any redirection recorded anywhere,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 it's safe to do this, and we don't end up with unwanted redirection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 run_select_frame_hook (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 run_hook (Qselect_frame_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 run_deselect_frame_hook (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 run_hook (Qdeselect_frame_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 /* When select-frame is called and focus_follows_mouse is false, we want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 to tell the window system that the focus should be changed to point to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 the new frame. However,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 sometimes Lisp functions will temporarily change the selected frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 (e.g. to call a function that operates on the selected frame),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 and it's annoying if this focus-change happens exactly when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 select-frame is called, because then you get some flickering of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 window-manager border and perhaps other undesirable results. We
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 really only want to change the focus when we're about to retrieve
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 an event from the user. To do this, we keep track of the frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 where the window-manager focus lies on, and just before waiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 for user events, check the currently selected frame and change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 the focus as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 On the other hand, if focus_follows_mouse is true, we need to switch the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 selected frame back to the frame with window manager focus just before we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 execute the next command in Fcommand_loop_1, just as the selected buffer is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 reverted after a set-buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 Both cases are handled by this function. It must be called as appropriate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 from these two places, depending on the value of focus_follows_mouse. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 investigate_frame_change (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 Lisp_Object devcons, concons;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 /* if the selected frame was changed, change the window-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 focus to the new frame. We don't do it when select-frame was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 called, to avoid flickering and other unwanted side effects when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 the frame is just changed temporarily. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 DEVICE_LOOP_NO_BREAK (devcons, concons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 struct device *d = XDEVICE (XCAR (devcons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 but that can cause us to end up in an infinite loop focusing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 between two frames. It seems that since the call to `select-frame'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 value, we need to do so too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (!NILP (sel_frame) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 /* At this point, we know that the frame has been changed. Now, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 * focus_follows_mouse is not set, we finish off the frame change,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 * so that user events will now come from the new frame. Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 * if focus_follows_mouse is set, no gratuitous frame changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 * should take place. Set the focus back to the frame which was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 * originally selected for user input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 if (!focus_follows_mouse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 /* prevent us from issuing the same request more than once */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 Lisp_Object old_frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 /* #### Do we really want to check OUGHT ??
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 * It seems to make sense, though I have never seen us
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 * get here and have it be non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 /* #### Can old_frame ever be NIL? play it safe.. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 if (!NILP (old_frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 /* Fselect_frame is not really the right thing: it frobs the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 * buffer stack. But there's no easy way to do the right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 * thing, and this code already had this problem anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 Fselect_frame (old_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 cleanup_after_missed_defocusing (Lisp_Object frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 Fselect_frame (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 Lisp_Object frame = Fcar (frame_inp_and_dev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 struct device *d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 if (!DEVICE_LIVE_P (XDEVICE (device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 d = XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 /* Any received focus-change notifications render invalid any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 pending focus-change requests. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 if (in_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 Lisp_Object focus_frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 if (!FRAME_LIVE_P (XFRAME (frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 /* Mark the minibuffer as changed to make sure it gets updated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 properly if the echo area is active. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 MARK_WINDOWS_CHANGED (w);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1882 if (FRAMEP (focus_frame) && FRAME_LIVE_P (XFRAME (focus_frame))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1883 && !EQ (frame, focus_frame))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 /* Oops, we missed a focus-out event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 if (!EQ (frame, focus_frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 redisplay_redraw_cursor (XFRAME (frame), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 /* We ignore the frame reported in the event. If it's different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 from where we think the focus was, oh well -- we messed up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 Nonetheless, we pretend we were right, for sensible behavior. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 if (!NILP (frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 if (FRAME_LIVE_P (XFRAME (frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 redisplay_redraw_cursor (XFRAME (frame), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 /* Called from the window-system-specific code when we receive a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 notification that the focus lies on a particular frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 for focus-in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 Lisp_Object frame = Fcar (frame_inp_and_dev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 struct device *d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 if (!DEVICE_LIVE_P (XDEVICE (device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 d = XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 if (in_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 Lisp_Object focus_frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 if (!FRAME_LIVE_P (XFRAME (frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 /* Oops, we missed a focus-out event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 Fselect_frame (focus_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 /* Do an unwind-protect in case an error occurs in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 the deselect-frame-hook */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 record_unwind_protect (cleanup_after_missed_defocusing, frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 run_deselect_frame_hook ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
1949 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 /* the cleanup method changed the focus frame to nil, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 we need to reflect this */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 focus_frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 Fselect_frame (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 if (!EQ (frame, focus_frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 run_select_frame_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 /* We ignore the frame reported in the event. If it's different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 from where we think the focus was, oh well -- we messed up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 Nonetheless, we pretend we were right, for sensible behavior. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 if (!NILP (frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 run_deselect_frame_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 /* retrieving the next event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 static int in_single_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 /* #### These functions don't currently do anything. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 single_console_state (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 in_single_console = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 any_console_state (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 in_single_console = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 in_single_console_state (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 return in_single_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 /* the number of keyboard characters read. callint.c wants this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 Charcount num_input_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 next_event_internal (Lisp_Object target_event, int allow_queued)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 /* QUIT; This is incorrect - the caller must do this because some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 callers (ie, Fnext_event()) do not want to QUIT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 assert (NILP (XEVENT_NEXT (target_event)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 GCPRO1 (target_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 /* When focus_follows_mouse is nil, if a frame change took place, we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 * to actually switch window manager focus to the selected window now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 if (!focus_follows_mouse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 investigate_frame_change ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 if (allow_queued && !NILP (command_event_queue))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 Lisp_Object event = dequeue_command_event ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 Fcopy_event (event, target_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 Fdeallocate_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
2028 Lisp_Event *e = XEVENT (target_event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 /* The command_event_queue was empty. Wait for an event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 event_stream_next_event (e);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 /* If this was a timeout, then we need to extract some data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 out of the returned closure and might need to resignal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 if (e->event_type == timeout_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 Lisp_Object tristan, isolde;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 e->event.timeout.id_number =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 &tristan, &isolde);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 e->event.timeout.function = tristan;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 e->event.timeout.object = isolde;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 /* next_event_internal() doesn't print out timeout events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 because of the extra info we just set. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 /* If we read a ^G, then set quit-flag but do not discard the ^G.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 The callers of next_event_internal() will do one of two things:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 -- set Vquit_flag to Qnil. (next-event does this.) This will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 cause the ^G to be treated as a normal keystroke.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 -- not change Vquit_flag but attempt to enqueue the ^G, at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 which point it will be discarded. The next time QUIT is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 called, it will notice that Vquit_flag was set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 if (e->event_type == key_press_event &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 event_matches_key_specifier_p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 Vquit_flag = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 run_pre_idle_hook (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 if (!NILP (Vpre_idle_hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 && !detect_input_pending ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 safe_run_hook_trapping_errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 ("Error in `pre-idle-hook' (setting hook to nil)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 Qpre_idle_hook, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 static void push_this_command_keys (Lisp_Object event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 static void push_recent_keys (Lisp_Object event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 static void dribble_out_event (Lisp_Object event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 static void execute_internal_event (Lisp_Object event);
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
2085 static int is_scrollbar_event (Lisp_Object event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 Return the next available event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 Pass this object to `dispatch-event' to handle it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 In most cases, you will want to use `next-command-event', which returns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 the next available "user" event (i.e. keypress, button-press,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 button-release, or menu selection) instead of this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 If EVENT is non-nil, it should be an event object and will be filled in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 and returned; otherwise a new event object will be created and returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 If PROMPT is non-nil, it should be a string and will be displayed in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 echo area while this function is waiting for an event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 The next available event will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 -- any events in `unread-command-events' or `unread-command-event'; else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 -- the next event in the currently executing keyboard macro, if any; else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2103 -- an event queued by `enqueue-eval-event', if any, or any similar event
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2104 queued internally, such as a misc-user event. (For example, when an item
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2105 is selected from a menu or from a `question'-type dialog box, the item's
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2106 callback is not immediately executed, but instead a misc-user event
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2107 is generated and placed onto this queue; when it is dispatched, the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2108 callback is executed.) Else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 -- the next available event from the window system or terminal driver.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 In the last case, this function will block until an event is available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 The returned event will be one of the following types:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 -- a key-press event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 -- a button-press or button-release event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 -- a misc-user-event, meaning the user selected an item on a menu or used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 the scrollbar.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 -- a process event, meaning that output from a subprocess is available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 -- a timeout event, meaning that a timeout has elapsed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 -- an eval event, which simply causes a function to be executed when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 event is dispatched. Eval events are generated by `enqueue-eval-event'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 or by certain other conditions happening.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 -- a magic event, indicating that some window-system-specific event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 happened (such as a focus-change notification) that must be handled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 synchronously with other events. `dispatch-event' knows what to do with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 these events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 (event, prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 /* #### We start out using the selected console before an event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 is received, for echoing the partially completed command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 This is most definitely wrong -- there needs to be a separate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 echo area for each console! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 struct console *con = XCONSOLE (Vselected_console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 struct command_builder *command_builder =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 XCOMMAND_BUILDER (con->command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 int store_this_key = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 /* DO NOT do QUIT anywhere within this function or the functions it calls.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 We want to read the ^G as an event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 #ifdef LWLIB_MENUBARS_LUCID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 * #### Fix the menu code so this isn't necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 * We cannot allow the lwmenu code to be reentered, because the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 * code is not written to be reentrant and will crash. Therefore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 * paths from the menu callbacks back into the menu code have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 * be blocked. Fnext_event is the normal path into the menu code,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 * so we signal an error here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 if (in_menu_callback)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2157 invalid_operation ("Attempt to call next-event inside menu callback",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2158 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 #endif /* LWLIB_MENUBARS_LUCID */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 if (NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 if (!NILP (prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 Bytecount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 CHECK_STRING (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 len = XSTRING_LENGTH (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 if (command_builder->echo_buf_length < len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 len = command_builder->echo_buf_length - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 command_builder->echo_buf[len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 command_builder->echo_buf_index = len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 command_builder->echo_buf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 Qnil, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 command_builder->echo_buf_index,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 Qcommand);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 start_over_and_avoid_hosage:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 /* If there is something in unread-command-events, simply return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 But do some error checking to make sure the user hasn't put something
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 in the unread-command-events that they shouldn't have.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 This does not update this-command-keys and recent-keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 if (!NILP (Vunread_command_events))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 if (!CONSP (Vunread_command_events))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 Vunread_command_events = Qnil;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2196 signal_error_1 (Qwrong_type_argument,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 list3 (Qconsp, Vunread_command_events,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 Qunread_command_events));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 Lisp_Object e = XCAR (Vunread_command_events);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 Vunread_command_events = XCDR (Vunread_command_events);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 if (!EVENTP (e) || !command_event_p (e))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2205 signal_error_1 (Qwrong_type_argument,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 list3 (Qcommand_event_p, e, Qunread_command_events));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 if (!EQ (e, event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 Fcopy_event (e, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 /* Do similar for unread-command-event (obsoleteness support). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 else if (!NILP (Vunread_command_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 Lisp_Object e = Vunread_command_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 Vunread_command_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 if (!EVENTP (e) || !command_event_p (e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2222 signal_error_1 (Qwrong_type_argument,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 list3 (Qeventp, e, Qunread_command_event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 if (!EQ (e, event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 Fcopy_event (e, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 /* If we're executing a keyboard macro, take the next event from that,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 and update this-command-keys and recent-keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 Note that the unread-command-events take precedence over kbd macros.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 if (!NILP (Vexecuting_macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 pop_kbd_macro_event (event); /* This throws past us at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 end-of-macro. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 store_this_key = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 /* Otherwise, read a real event, possibly from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 command_event_queue, and update this-command-keys and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 recent-keys. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 run_pre_idle_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 next_event_internal (event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 Vquit_flag = Qnil; /* Read C-g as an event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 store_this_key = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 status_notify (); /* Notice process change */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 #ifdef C_ALLOCA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 alloca (0); /* Cause a garbage collection now */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 /* Since we can free the most stuff here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 * (since this is typically called from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 * the command-loop top-level). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 #endif /* C_ALLOCA */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 if (object_dead_p (XEVENT (event)->channel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 /* event_console_or_selected may crash if the channel is dead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 Best just to eat it and get the next event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 goto start_over_and_avoid_hosage;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 /* OK, now we can stop the selected-console kludge and use the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 actual console from the event. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 con = event_console_or_selected (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 command_builder = XCOMMAND_BUILDER (con->command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 goto RETURN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 case button_release_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 case misc_user_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 /* don't echo menu accelerator keys */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 reset_key_echo (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 goto EXECUTE_KEY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 case button_press_event: /* key or mouse input can trigger prompting */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 goto STORE_AND_EXECUTE_KEY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 case key_press_event: /* any key input can trigger autosave */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 maybe_do_auto_save ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 num_input_chars++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 STORE_AND_EXECUTE_KEY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 if (store_this_key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 echo_key_event (command_builder, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 EXECUTE_KEY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 /* Store the last-input-event. The semantics of this is that it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 the thing most recently returned by next-command-event. It need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 not have come from the keyboard or a keyboard macro, it may have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 come from unread-command-events. It's always a command-event (a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 key, click, or menu selection), never a motion or process event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 if (!EVENTP (Vlast_input_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 Vlast_input_event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 Vlast_input_event = Fmake_event (Qnil, Qnil);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
2312 invalid_state ("Someone deallocated last-input-event!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 if (! EQ (event, Vlast_input_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 Fcopy_event (event, Vlast_input_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 /* last-input-char and last-input-time are derived from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 last-input-event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 Note that last-input-char will never have its high-bit set, in an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 effort to sidestep the ambiguity between M-x and oslash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 Vlast_input_char = Fevent_to_character (Vlast_input_event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 EMACS_TIME t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 EMACS_GET_TIME (t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 if (!CONSP (Vlast_input_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 Vlast_input_time = Fcons (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 if (!CONSP (Vlast_command_event_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 XCAR (Vlast_command_event_time) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 XCAR (XCDR (Vlast_command_event_time)) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 XCAR (XCDR (XCDR (Vlast_command_event_time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 = make_int (EMACS_USECS (t));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 /* If this key came from the keyboard or from a keyboard macro, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 it goes into the recent-keys and this-command-keys vectors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 If this key came from the keyboard, and we're defining a keyboard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 macro, then it goes into the macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 if (store_this_key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 {
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
2347 if (!is_scrollbar_event (event)) /* #### not quite right, see
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
2348 comment in execute_command_event */
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
2349 push_this_command_keys (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 if (!inhibit_input_event_recording)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 push_recent_keys (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 dribble_out_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 if (!EVENTP (command_builder->current_events))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 finalize_kbd_macro_chars (con);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 store_kbd_macro_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 /* If this is the help char and there is a help form, then execute the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 help form and swallow this character. This is the only place where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 calling Fnext_event() can cause arbitrary lisp code to run. Note
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 that execute_help_form() calls Fnext_command_event(), which calls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 this function, as well as Fdispatch_event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 if (!NILP (Vhelp_form) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 execute_help_form (command_builder, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 RETURN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 Return the next available "user" event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 Pass this object to `dispatch-event' to handle it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 If EVENT is non-nil, it should be an event object and will be filled in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 and returned; otherwise a new event object will be created and returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 If PROMPT is non-nil, it should be a string and will be displayed in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 echo area while this function is waiting for an event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 The event returned will be a keyboard, mouse press, or mouse release event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 If there are non-command events available (mouse motion, sub-process output,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 etc) then these will be executed (with `dispatch-event') and discarded. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 function is provided as a convenience; it is roughly equivalent to the lisp code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 (while (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 (next-event event prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 (not (or (key-press-event-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (button-press-event-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 (button-release-event-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (misc-user-event-p event))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 (dispatch-event event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 but it also makes a provision for displaying keystrokes in the echo area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 (event, prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 maybe_echo_keys (XCOMMAND_BUILDER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 (XCONSOLE (Vselected_console)->
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 command_builder), 0); /* #### This sucks bigtime */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 event = Fnext_event (event, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 if (command_event_p (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2419 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2420 Dispatch any pending "magic" events.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2421
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2422 This function is useful for forcing the redisplay of native
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2423 widgets. Normally these are redisplayed through a native window-system
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2424 event encoded as magic event, rather than by the redisplay code. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2425 function does not call redisplay or do any of the other things that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2426 `next-event' does.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2427 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2428 ())
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2429 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2430 /* This function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2431 Lisp_Object event = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2432 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2433 GCPRO1 (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2434 event = Fmake_event (Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2435
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2436 /* Make sure that there will be something in the native event queue
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2437 so that externally managed things (e.g. widgets) get some CPU
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2438 time. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2439 event_stream_force_event_pending (selected_frame ());
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2440
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2441 while (event_stream_event_pending_p (0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2442 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2443 QUIT; /* next_event_internal() does not QUIT. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2444
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2445 /* We're a generator of the command_event_queue, so we can't be a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2446 consumer as well. Also, we have no reason to consult the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2447 command_event_queue; there are only user and eval-events there,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2448 and we'd just have to put them back anyway.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2449 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2450 next_event_internal (event, 0); /* blocks */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2451 /* See the comment in accept-process-output about Vquit_flag */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2452 if (XEVENT_TYPE (event) == magic_event ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2453 XEVENT_TYPE (event) == timeout_event ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2454 XEVENT_TYPE (event) == process_event ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2455 XEVENT_TYPE (event) == pointer_motion_event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2456 execute_internal_event (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2457 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2458 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2459 enqueue_command_event_1 (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2460 break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2461 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2462 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2463
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2464 Fdeallocate_event (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2465 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2466 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2467 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2468
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 reset_current_events (struct command_builder *command_builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 Lisp_Object event = command_builder->current_events;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 reset_command_builder_event_chain (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 if (EVENTP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 deallocate_event_chain (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 Discard any pending "user" events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 Also cancel any kbd macro being defined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 A user event is a key press, button press, button release, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 "misc-user" event (menu selection or scrollbar action).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 /* This throws away user-input on the queue, but doesn't process any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 events. Calling dispatch_event() here leads to a race condition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 Lisp_Object head = Qnil, tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 Lisp_Object oiq = Vinhibit_quit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 /* #### not correct here with Vselected_console? Should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 discard-input take a console argument, or maybe map over
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 all consoles? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 struct console *con = XCONSOLE (Vselected_console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 GCPRO2 (event, oiq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 Vinhibit_quit = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 /* If a macro was being defined then we have to mark the modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 has changed to ensure that it gets updated correctly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 if (!NILP (con->defining_kbd_macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 con->defining_kbd_macro = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 while (!NILP (command_event_queue)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 || event_stream_event_pending_p (1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 /* This will take stuff off the command_event_queue, or read it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 from the event_stream, but it will not block.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 next_event_internal (event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 It is vitally important that we reset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 Vquit_flag here. Otherwise, if we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 reading from a TTY console,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 maybe_read_quit_event() will notice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 that C-g has been set and send us
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 another C-g. That will cause us
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 to get right back here, and read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 another C-g, ad infinitum ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 /* If the event is a user event, ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 if (!command_event_p (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 /* Otherwise, chain the event onto our list of events not to ignore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 and keep reading until the queue is empty. This does not mean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 that if a subprocess is generating an infinite amount of output,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 we will never terminate (*provided* that the behavior of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 next_event_cb() is correct -- see the comment in events.h),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 because this loop ends as soon as there are no more user events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 on the command_event_queue or event_stream.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 /* Now tack our chain of events back on to the front of the queue.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 Actually, since the queue is now drained, we can just replace it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 The effect of this will be that we have deleted all user events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 from the input stream without changing the relative ordering of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 any other events. (Some events may have been taken from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 event_stream and added to the command_event_queue, however.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 At this time, the command_event_queue will contain only eval_events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 command_event_queue = head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 command_event_queue_tail = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 Fdeallocate_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 Vinhibit_quit = oiq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 /* pausing until an action occurs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 /* This is used in accept-process-output, sleep-for and sit-for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 Before running any process_events in these routines, we set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 recursive_sit_for to Qt, and use this unwind protect to reset it to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 cause it to return immediately.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 All of these routines install timeouts, so we clear the installed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 timeout as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 Note: It's very easy to break the desired behaviors of these
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 3 routines. If you make any changes to anything in this area, run
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 the regression tests at the bottom of the file. -- dmoore */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 sit_for_unwind (Lisp_Object timeout_id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 if (!NILP(timeout_id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 Fdisable_timeout (timeout_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 recursive_sit_for = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 Allow any pending output from subprocesses to be read by Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 It is read into the process' buffers or given to their filter functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 Non-nil arg PROCESS means do not return until some output has been received
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 from PROCESS. Nil arg PROCESS means do not return until some output has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 been received from any process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 If the second arg is non-nil, it is the maximum number of seconds to wait:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 this function will return after that much time even if no input has arrived
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 from PROCESS. This argument may be a float, meaning wait some fractional
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 part of a second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 If the third arg is non-nil, it is a number of milliseconds that is added
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 to the second arg. (This exists only for compatibility.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 Return non-nil iff we received any output before the timeout expired.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 (process, timeout_secs, timeout_msecs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 Lisp_Object event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 int timeout_id = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 int timeout_enabled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 int done = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 struct buffer *old_buffer = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 /* We preserve the current buffer but nothing else. If a focus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 change alters the selected window then the top level event loop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 will eventually alter current_buffer to match. In the mean time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 we don't want to mess up whatever called this function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 if (!NILP (process))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 CHECK_PROCESS (process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 GCPRO2 (event, process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 unsigned long msecs = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 if (!NILP (timeout_secs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 if (!NILP (timeout_msecs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 CHECK_NATNUM (timeout_msecs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 msecs += XINT (timeout_msecs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 if (msecs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 timeout_enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 record_unwind_protect (sit_for_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 timeout_enabled ? make_int (timeout_id) : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 recursive_sit_for = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 while (!done &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 ((NILP (process) && timeout_enabled) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 (NILP (process) && event_stream_event_pending_p (0)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 (!NILP (process))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 /* Calling detect_input_pending() is the wrong thing here, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 that considers the Vunread_command_events and command_event_queue.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 We don't need to look at the command_event_queue because we are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 only interested in process events, which don't go on that. In
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 fact, we can't read from it anyway, because we put stuff on it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 Note that event_stream->event_pending_p must be called in such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 a way that it says whether any events *of any kind* are ready,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 not just user events, or (accept-process-output nil) will fail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 to dispatch any process events that may be on the queue. It is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 not clear to me that this is important, because the top-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 loop will process it, and I don't think that there is ever a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 time when one calls accept-process-output with a nil argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 and really need the processes to be handled. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 /* If our timeout has arrived, we move along. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 timeout_enabled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 done = 1; /* We're done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 continue; /* Don't call next_event_internal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 QUIT; /* next_event_internal() does not QUIT, so check for ^G
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 before reading output from the process - this makes it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 less likely that the filter will actually be aborted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 next_event_internal (event, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 /* If C-g was pressed while we were waiting, Vquit_flag got
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 set and next_event_internal() also returns C-g. When
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 we enqueue the C-g below, it will get discarded. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 next time through, QUIT will be called and will signal a quit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 case process_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 if (NILP (process) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 EQ (XEVENT (event)->event.process.process, process))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 done = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 /* RMS's version always returns nil when proc is nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 and only returns t if input ever arrived on proc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 result = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 case timeout_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 /* We execute the event even if it's ours, and notice that it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 happened above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 case pointer_motion_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 case magic_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 enqueue_command_event_1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
2725 unbind_to_1 (count, timeout_enabled ? make_int (timeout_id) : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 Fdeallocate_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 current_buffer = old_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2734 Pause, without updating display, for SECONDS seconds.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2735 SECONDS may be a float, allowing pauses for fractional parts of a second.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 It is recommended that you never call sleep-for from inside of a process
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2738 filter function or timer event (either synchronous or asynchronous).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 (seconds))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 Lisp_Object event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 record_unwind_protect (sit_for_unwind, make_int (id));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 recursive_sit_for = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 /* If our timeout has arrived, we move along. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 if (!event_stream_wakeup_pending_p (id, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 QUIT; /* next_event_internal() does not QUIT, so check for ^G
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 before reading output from the process - this makes it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 less likely that the filter will actually be aborted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 /* We're a generator of the command_event_queue, so we can't be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 consumer as well. We don't care about command and eval-events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 next_event_internal (event, 0); /* blocks */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 /* See the comment in accept-process-output about Vquit_flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 case timeout_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 /* We execute the event even if it's ours, and notice that it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 happened above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 case process_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 case pointer_motion_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 case magic_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 enqueue_command_event_1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 DONE_LABEL:
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
2794 unbind_to_1 (count, make_int (id));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 Fdeallocate_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2801 Perform redisplay, then wait SECONDS seconds or until user input is available.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2802 SECONDS may be a float, meaning a fractional part of a second.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2803 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 Redisplay is preempted as always if user input arrives, and does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 happen if input is available before it starts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 Value is t if waited the full time with no input arriving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 If sit-for is called from within a process filter function or timer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 event (either synchronous or asynchronous) it will return immediately.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 (seconds, nodisplay))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 Lisp_Object event, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 int id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 /* The unread-command-events count as pending input */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 /* If the command-builder already has user-input on it (not eval events)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 then that means we're done too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 if (!NILP (command_event_queue))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 EVENT_CHAIN_LOOP (event, command_event_queue)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 if (command_event_p (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 /* If we're in a macro, or noninteractive, or early in temacs, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 don't wait. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 if (noninteractive || !NILP (Vexecuting_macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 /* Recursive call from a filter function or timeout handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 if (!NILP(recursive_sit_for))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 run_pre_idle_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 /* Otherwise, start reading events from the event_stream.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 Do this loop at least once even if (sit-for 0) so that we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 redisplay when no input pending.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 events get processed. The old (pre-19.12) code special-cased this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 and didn't generate a wakeup, but the resulting behavior was less than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 the E-Lisp universe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 record_unwind_protect (sit_for_unwind, make_int (id));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 recursive_sit_for = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 /* If there is no user input pending, then redisplay.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 run_pre_idle_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 redisplay ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 /* If our timeout has arrived, we move along. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 if (!event_stream_wakeup_pending_p (id, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 result = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 QUIT; /* next_event_internal() does not QUIT, so check for ^G
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 before reading output from the process - this makes it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 less likely that the filter will actually be aborted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 /* We're a generator of the command_event_queue, so we can't be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 consumer as well. In fact, we know there's nothing on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 command_event_queue that we didn't just put there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 next_event_internal (event, 0); /* blocks */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 /* See the comment in accept-process-output about Vquit_flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 if (command_event_p (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 QUIT; /* If the command was C-g check it here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 so that we abort out of the sit-for,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 not the next command. sleep-for and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 accept-process-output continue looping
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 so they check QUIT again implicitly.*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 case eval_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 /* eval-events get delayed until later. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 enqueue_command_event (Fcopy_event (event, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 case timeout_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 /* We execute the event even if it's ours, and notice that it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 happened above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 DONE_LABEL:
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
2931 unbind_to_1 (count, make_int (id));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 /* Put back the event (if any) that made Fsit_for() exit before the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 timeout. Note that it is being added to the back of the queue, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 would be inappropriate if there were any user events on the queue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 already: we would be misordering them. But we know that there are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 no user-events on the queue, or else we would not have reached this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 point at all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 if (NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 enqueue_command_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 Fdeallocate_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2949 /* This handy little function is used by select-x.c to wait for replies
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2950 from processes that aren't really processes (e.g. the X server) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 while (!(*predicate) (predicate_arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 QUIT; /* next_event_internal() does not QUIT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 /* We're a generator of the command_event_queue, so we can't be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 consumer as well. Also, we have no reason to consult the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 command_event_queue; there are only user and eval-events there,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 and we'd just have to put them back anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 next_event_internal (event, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 /* See the comment in accept-process-output about Vquit_flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 if (command_event_p (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 || (XEVENT_TYPE (event) == eval_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 || (XEVENT_TYPE (event) == magic_eval_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 enqueue_command_event_1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 /* dispatching events; command builder */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 execute_internal_event (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 /* events on dead channels get silently eaten */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 if (object_dead_p (XEVENT (event)->channel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 case empty_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 case eval_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 call1 (XEVENT (event)->event.eval.function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 XEVENT (event)->event.eval.object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 case magic_eval_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 (XEVENT (event)->event.magic_eval.internal_function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 (XEVENT (event)->event.magic_eval.object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 case pointer_motion_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 if (!NILP (Vmouse_motion_handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 call1 (Vmouse_motion_handler, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 case process_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 Lisp_Object p = XEVENT (event)->event.process.process;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 Charcount readstatus;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 assert (PROCESSP (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 while ((readstatus = read_process_output (p)) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 if (readstatus > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 ; /* this clauses never gets executed but allows the #ifdefs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 to work cleanly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 #ifdef EWOULDBLOCK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 else if (readstatus == -1 && errno == EWOULDBLOCK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 #endif /* EWOULDBLOCK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 #ifdef EAGAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 else if (readstatus == -1 && errno == EAGAIN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 #endif /* EAGAIN */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 else if ((readstatus == 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 /* Note that we cannot distinguish between no input
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 available now and a closed pipe.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 With luck, a closed pipe will be accompanied by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 subprocess termination and SIGCHLD. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 (!network_connection_p (p) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 When connected to ToolTalk (i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 connected_via_filedesc_p()), it's not possible to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 reliably determine whether there is a message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 waiting for ToolTalk to receive. ToolTalk expects
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 to have tt_message_receive() called exactly once
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 every time the file descriptor becomes active, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 the filter function forces this by returning 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 Emacs must not interpret this as a closed pipe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 connected_via_filedesc_p (XPROCESS (p))))
535
c69610198c35 [xemacs-hg @ 2001-05-14 04:52:02 by martinb]
martinb
parents: 516
diff changeset
3054
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 /* On some OSs with ptys, when the process on one end of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 a pty exits, the other end gets an error reading with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 errno = EIO instead of getting an EOF (0 bytes read).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 Therefore, if we get an error reading and errno =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 EIO, just continue, because the child process has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 exited and should clean itself up soon (e.g. when we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 get a SIGCHLD). */
535
c69610198c35 [xemacs-hg @ 2001-05-14 04:52:02 by martinb]
martinb
parents: 516
diff changeset
3062 #ifdef EIO
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 || (readstatus == -1 && errno == EIO)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 #endif
535
c69610198c35 [xemacs-hg @ 2001-05-14 04:52:02 by martinb]
martinb
parents: 516
diff changeset
3065
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 /* Currently, we rely on SIGCHLD to indicate that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 process has terminated. Unfortunately, on some systems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 the SIGCHLD gets missed some of the time. So we put an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 additional check in status_notify() to see whether a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 process has terminated. We must tell status_notify()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 to enable that check, and we do so now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 kick_status_notify ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 /* Deactivate network connection */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 Lisp_Object status = Fprocess_status (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 if (EQ (status, Qopen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 /* In case somebody changes the theory of whether to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 return open as opposed to run for network connection
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 "processes"... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 || EQ (status, Qrun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 update_process_status (p, Qexit, 256, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 deactivate_process (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 /* We must call status_notify here to allow the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 event_stream->unselect_process_cb to be run if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 Otherwise, dead fds may be selected for, and we will get a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 continuous stream of process events for them. Since we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 return until all process events have been flushed, we would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 get stuck here, processing events on a process whose status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 was 'exit. Call this after dispatch-event, or the fds will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 have been closed before we read the last data from them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 It's safe for the filter to signal an error because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 status_notify() will be called on return to top-level.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 status_notify ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 case timeout_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
3106 Lisp_Event *e = XEVENT (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 if (!NILP (e->event.timeout.function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 call1 (e->event.timeout.function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 e->event.timeout.object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 case magic_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 event_stream_handle_magic_event (XEVENT (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 Lisp_Object first_before_suffix =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 event_chain_find_previous (Vthis_command_keys, suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 if (NILP (first_before_suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 Vthis_command_keys = chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 XSET_EVENT_NEXT (first_before_suffix, chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 deallocate_event_chain (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 Vthis_command_keys_tail = event_chain_tail (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 command_builder_replace_suffix (struct command_builder *builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 Lisp_Object suffix, Lisp_Object chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 Lisp_Object first_before_suffix =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 event_chain_find_previous (builder->current_events, suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 if (NILP (first_before_suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 builder->current_events = chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 XSET_EVENT_NEXT (first_before_suffix, chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 deallocate_event_chain (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 builder->most_current_event = event_chain_tail (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 command_builder_find_leaf_1 (struct command_builder *builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 Lisp_Object event0 = builder->current_events;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 if (NILP (event0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 return event_binding (event0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 /* See if we can do function-key-map or key-translation-map translation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 on the current events in the command builder. If so, do this, and
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3166 return the resulting binding, if any.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3167
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3168 DID_MUNGE must be initialized before calling this function. If munging
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3169 happened, DID_MUNGE will be non-zero; otherwise, it will be left alone.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3170 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 munge_keymap_translate (struct command_builder *builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 enum munge_me_out_the_door munge,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3175 int has_normal_binding_p, int *did_munge)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 Lisp_Object suffix;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 if (NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 if (KEYMAPP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 if (NILP (builder->last_non_munged_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 && !has_normal_binding_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 builder->last_non_munged_event = builder->most_current_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 builder->last_non_munged_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 if (!KEYMAPP (result) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 !VECTORP (result) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 !STRINGP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 GCPRO1 (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 result = call1 (result, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 if (NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 if (KEYMAPP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 if (VECTORP (result) || STRINGP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 Lisp_Object tempev;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3214 int n;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 /* If the first_mungeable_event of the other munger is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 within the events we're munging, then it will point to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 deallocated events afterwards, which is bad -- so make it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 point at the beginning of the munged events. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 EVENT_CHAIN_LOOP (tempev, suffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 Lisp_Object *mungeable_event =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 &builder->munge_me[1 - munge].first_mungeable_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 if (EQ (tempev, *mungeable_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 *mungeable_event = new_chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3231 /* Now munge the current event chain in the command builder. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 n = event_chain_count (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 command_builder_replace_suffix (builder, suffix, new_chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 builder->munge_me[munge].first_mungeable_event = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3235
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3236 *did_munge = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 result = command_builder_find_leaf_1 (builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3242 signal_error (Qinvalid_key_binding,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3243 (munge == MUNGE_ME_FUNCTION_KEY ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3244 "Invalid binding in function-key-map" :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3245 "Invalid binding in key-translation-map"),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3246 result);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3252 /* Same as command_builder_find_leaf() below but no Russian C-x
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3253 processing and no defaulting to self-insert-command.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3255
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 static Lisp_Object
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3257 command_builder_find_leaf_no_mule_processing (struct command_builder *builder,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3258 int allow_misc_user_events_p,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3259 int *did_munge)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 Lisp_Object evee = builder->current_events;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 if (XEVENT_TYPE (evee) == misc_user_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 return list2 (XEVENT (evee)->event.eval.function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 XEVENT (evee)->event.eval.object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3274 /* if we're currently in a menu accelerator, check there for further
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3275 events */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3276 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3277 /* #### this horribly-written crap can mess with global state, which
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3278 this function should not do. i'm not fixing it now. someone
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3279 needs to go and rewrite that shit correctly. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3281 if (x_kludge_lw_menu_active ())
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 return command_builder_operate_menu_accelerator (builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 result = command_builder_find_menu_accelerator (builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 if (NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 result = command_builder_find_leaf_1 (builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 if (NILP (result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 result = command_builder_find_menu_accelerator (builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 /* Check to see if we have a potential function-key-map match. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 if (NILP (result))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3302 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3303 did_munge);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3304
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 /* Check to see if we have a potential key-translation-map match. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 Lisp_Object key_translate_result =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3309 !NILP (result), did_munge);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 if (!NILP (key_translate_result))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3311 result = key_translate_result;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 /* If we didn't find a binding, and the last event in the sequence is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 a shifted character, then try again with the lowercase version. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 && !NILP (Vretry_undefined_key_binding_unshifted))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 Lisp_Object terminal = builder->most_current_event;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3326 struct key_data *key = &XEVENT (terminal)->event.key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 Emchar c = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3328 if ((key->modifiers & XEMACS_MOD_SHIFT)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 || (CHAR_OR_CHAR_INTP (key->keysym)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3330 && ((c = XCHAR_OR_CHAR_INT (key->keysym)),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3331 c >= 'A' && c <= 'Z')))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3333 Lisp_Object neubauten = copy_command_builder (builder, 0);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3334 struct command_builder *neub = XCOMMAND_BUILDER (neubauten);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3335 struct gcpro gcpro1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3336
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3337 GCPRO1 (neubauten);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3338 terminal = event_chain_tail (neub->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3339 key = &XEVENT (terminal)->event.key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3341 if (key->modifiers & XEMACS_MOD_SHIFT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3342 key->modifiers &= (~ XEMACS_MOD_SHIFT);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 key->keysym = make_char (c + 'a' - 'A');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3346 result =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3347 command_builder_find_leaf_no_mule_processing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3348 (neub, allow_misc_user_events_p, did_munge);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3349
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 if (!NILP (result))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3351 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3352 copy_command_builder (neub, builder);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3353 *did_munge = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3354 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3355 free_command_builder (neub);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3356 UNGCPRO;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3357 if (!NILP (result))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 /* help-char is `auto-bound' in every keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 if (!NILP (Vprefix_help_command) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 Vhelp_char))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 return Vprefix_help_command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3368 return Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3369 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3370
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3371 /* Compare the current state of the command builder against the local and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3372 global keymaps, and return the binding. If there is no match, try again,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3373 case-insensitively. The return value will be one of:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3374 -- nil (there is no binding)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3375 -- a keymap (part of a command has been specified)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3376 -- a command (anything that satisfies `commandp'; this includes
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3377 some symbols, lists, subrs, strings, vectors, and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3378 compiled-function objects)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3379
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3380 This may "munge" the current event chain in the command builder;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3381 i.e. the sequence might be mutated into a different sequence,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3382 which we then pretend is what the user actually typed instead of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3383 the passed-in sequence. This happens as a result of:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3384
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3385 -- key-translation-map changes
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3386 -- function-key-map changes
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3387 -- retry-undefined-key-binding-unshifted (q.v.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3388 -- "Russian C-x problem" changes (see definition of struct key_data,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3389 events.h)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3390
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3391 DID_MUNGE must be initialized before calling this function. If munging
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3392 happened, DID_MUNGE will be non-zero; otherwise, it will be left alone.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3393 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3394
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3395 static Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3396 command_builder_find_leaf (struct command_builder *builder,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3397 int allow_misc_user_events_p,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3398 int *did_munge)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3399 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3400 Lisp_Object result =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3401 command_builder_find_leaf_no_mule_processing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3402 (builder, allow_misc_user_events_p, did_munge);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3403
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3404 if (!NILP (result))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3405 return result;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3406
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3407 #ifdef MULE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3408 /* #### Do Russian C-x processing here */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3409
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 && !NILP (Vcomposed_character_default_binding))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3414 Lisp_Object keysym =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3415 XEVENT (builder->most_current_event)->event.key.keysym;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 return Vcomposed_character_default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3419 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3424 /* Like command_builder_find_leaf but update this-command-keys and the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3425 echo area as necessary when the current event chain was munged. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3426
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3427 static Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3428 command_builder_find_leaf_and_update_global_state (struct command_builder *
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3429 builder,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3430 int
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3431 allow_misc_user_events_p)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3432 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3433 int did_munge = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3434 int orig_length = event_chain_count (builder->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3435 Lisp_Object result = command_builder_find_leaf (builder,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3436 allow_misc_user_events_p,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3437 &did_munge);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3438
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3439 if (did_munge)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3440 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3441 int tck_length = event_chain_count (Vthis_command_keys);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3442
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3443 /* We just assume that the events we just replaced are
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3444 sitting in copied form at the end of this-command-keys.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3445 If the user did weird things with `dispatch-event' this
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3446 may not be the case, but at least we make sure we won't
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3447 crash. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3448
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3449 if (tck_length >= orig_length)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3450 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3451 Lisp_Object new_chain =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3452 copy_event_chain (builder->current_events);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3453 this_command_keys_replace_suffix
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3454 (event_chain_nth (Vthis_command_keys, tck_length - orig_length),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3455 new_chain);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3456
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3457 regenerate_echo_keys_from_this_command_keys (builder);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3458 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3459 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3460
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3461 if (NILP (result))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3462 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3463 /* If we read extra events attempting to match a function key but end
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3464 up failing, then we release those events back to the command loop
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3465 and fail on the original lookup. The released events will then be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3466 reprocessed in the context of the first part having failed. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3467 if (!NILP (builder->last_non_munged_event))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3468 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3469 Lisp_Object event0 = builder->last_non_munged_event;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3470
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3471 /* Put the commands back on the event queue. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3472 enqueue_event_chain (XEVENT_NEXT (event0),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3473 &command_event_queue,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3474 &command_event_queue_tail);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3475
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3476 /* Then remove them from the command builder. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3477 XSET_EVENT_NEXT (event0, Qnil);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3478 builder->most_current_event = event0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3479 builder->last_non_munged_event = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3480 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3481 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3482
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3483 return result;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3484 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 /* Every time a command-event (a key, button, or menu selection) is read by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 and in Vthis_command_keys. (Eval-events are not stored there.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 Every time a command is invoked, Vlast_command_event is set to the last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 event in the sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 This means that Vthis_command_keys is really about "input read since the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 last command was executed" rather than about "what keys invoked this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 command." This is a little counterintuitive, but that's the way it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 has always worked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 As an extra kink, the function read-key-sequence resets/updates the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 last-command-event and this-command-keys. It doesn't append to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 command-keys as read-char does. Such are the pitfalls of having to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 maintain compatibility with a program for which the only specification
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 is the code itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 (We could implement recent_keys_ring and Vthis_command_keys as the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 data structure.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 Return a vector of recent keyboard or mouse button events read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 If NUMBER is non-nil, not more than NUMBER events will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 Change number of events stored using `set-recent-keys-ring-size'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 This copies the event objects into a new vector; it is safe to keep and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 modify them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 int nwanted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 int start, nkeys, i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 GCPRO1 (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 if (NILP (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 nwanted = recent_keys_ring_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 CHECK_NATNUM (number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 nwanted = XINT (number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 /* Create the keys ring vector, if none present. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 if (NILP (Vrecent_keys_ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 /* And return nothing in particular. */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3537 RETURN_UNGCPRO (make_vector (0, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 /* This means the vector has not yet wrapped */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 nkeys = recent_keys_ring_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 start = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 nkeys = recent_keys_ring_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 if (nwanted < nkeys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 start += nkeys - nwanted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 if (start >= recent_keys_ring_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 start -= recent_keys_ring_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 nkeys = nwanted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 nwanted = nkeys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 val = make_vector (nwanted, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 for (i = 0, j = start; i < nkeys; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 if (NILP (e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 if (++j >= recent_keys_ring_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 j = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 The maximum number of events `recent-keys' can return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 return make_int (recent_keys_ring_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 Set the maximum number of events to be stored internally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 (size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 Lisp_Object new_vector = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 int i, j, nkeys, start, min;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 CHECK_INT (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 if (XINT (size) <= 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
3598 invalid_argument ("Recent keys ring size must be positive", size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 if (XINT (size) == recent_keys_ring_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 return size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3602 GCPRO1 (new_vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 new_vector = make_vector (XINT (size), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 if (NILP (Vrecent_keys_ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 Vrecent_keys_ring = new_vector;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3608 RETURN_UNGCPRO (size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 /* This means the vector has not yet wrapped */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 nkeys = recent_keys_ring_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 start = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 nkeys = recent_keys_ring_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 if (XINT (size) > nkeys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 min = nkeys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 min = XINT (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 for (i = 0, j = start; i < min; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 if (++j >= recent_keys_ring_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 j = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 recent_keys_ring_size = XINT (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 Vrecent_keys_ring = new_vector;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 return size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 /* Vthis_command_keys having value Qnil means that the next time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 push_this_command_keys is called, it should start over.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 The times at which the command-keys are reset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 (instead of merely being augmented) are pretty counterintuitive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 (More specifically:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 -- We do not reset this-command-keys when we finish reading a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 command. This is because some commands (e.g. C-u) act
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 like command prefixes; they signal this by setting prefix-arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 to non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 -- Therefore, we reset this-command-keys when we finish
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 executing a command, unless prefix-arg is set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 -- However, if we ever do a non-local exit out of a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 loop (e.g. an error in a command), we need to reset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 this-command-keys. We do this by calling reset_this_command_keys()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 from cmdloop.c, whenever an error causes an invocation of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 default error handler, and whenever there's a throw to top-level.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 {
757
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3665 if (!NILP (console))
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3666 {
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3667 /* console is nil if we just deleted the console as a result of C-x 5
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3668 0. Unfortunately things are currently in a messy situation where
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3669 some stuff is console-local and other stuff isn't, so we need to
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3670 do everything that's not console-local. */
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3671 struct command_builder *command_builder =
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3672 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3673
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3674 reset_key_echo (command_builder, clear_echo_area_p);
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3675 reset_current_events (command_builder);
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3676 }
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3677 else
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
3678 reset_key_echo (0, clear_echo_area_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 deallocate_event_chain (Vthis_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 Vthis_command_keys = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 Vthis_command_keys_tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 push_this_command_keys (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 Lisp_Object new = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 Fcopy_event (event, new);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 /* The following two functions are used in call-interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 for the @ and e specifications. We used to just use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 but FSF does it more generally so we follow their lead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 extract_this_command_keys_nth_mouse_event (int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 if (EVENTP (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 && (XEVENT_TYPE (event) == button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 || XEVENT_TYPE (event) == button_release_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 || XEVENT_TYPE (event) == misc_user_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 if (!n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 /* must copy to avoid an abort() in next_event_internal() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 if (!NILP (XEVENT_NEXT (event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 return Fcopy_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 n--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 int len = XVECTOR_LENGTH (vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 Lisp_Object event = XVECTOR_DATA (vector)[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 if (EVENTP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 switch (XEVENT_TYPE (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 case button_press_event :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 case button_release_event :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 case misc_user_event :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 if (n == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 return event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 n--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 push_recent_keys (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 Lisp_Object e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 if (NILP (Vrecent_keys_ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 if (NILP (e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 e = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 Fcopy_event (event, e);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 if (++recent_keys_ring_index == recent_keys_ring_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 recent_keys_ring_index = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 current_events_into_vector (struct command_builder *command_builder)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 Lisp_Object vector;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 int n = event_chain_count (command_builder->current_events);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 /* Copy the vector and the events in it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 /* No need to copy the events, since they're already copies, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 nobody other than the command-builder has pointers to them */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 vector = make_vector (n, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 EVENT_CHAIN_LOOP (event, command_builder->current_events)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 XVECTOR_DATA (vector)[n++] = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 reset_command_builder_event_chain (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 return vector;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 Given the current state of the command builder and a new command event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 that has just been dispatched:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 -- add the event to the event chain forming the current command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 (doing meta-translation as necessary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 -- return the binding of this event chain; this will be one of:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 -- nil (there is no binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 -- a keymap (part of a command has been specified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 -- a command (anything that satisfies `commandp'; this includes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 some symbols, lists, subrs, strings, vectors, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 compiled-function objects)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 lookup_command_event (struct command_builder *command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 Lisp_Object event, int allow_misc_user_events_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 /* Clear output from previous command execution */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 if (!EQ (Qcommand, echo_area_status (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 /* but don't let mouse-up clear what mouse-down just printed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 && (XEVENT (event)->event_type != button_release_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 clear_echo_area (f, Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 /* Add the given event to the command builder.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 Lisp_Object recent = command_builder->most_current_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 if (EVENTP (recent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
3828 Lisp_Event *e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 DoubleThink the recent-keys and this-command-keys as well. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 /* Modify the previous most-recently-pushed event on the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 builder to be a copy of this one with the meta-bit set instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 pushing a new event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 Fcopy_event (event, recent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 e = XEVENT (recent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 if (e->event_type == key_press_event)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3839 e->event.key.modifiers |= XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 else if (e->event_type == button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 || e->event_type == button_release_event)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3842 e->event.button.modifiers |= XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 int tckn = event_chain_count (Vthis_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 if (tckn >= 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 /* ??? very strange if it's < 2. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 this_command_keys_replace_suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 (event_chain_nth (Vthis_command_keys, tckn - 2),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 Fcopy_event (recent, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 regenerate_echo_keys_from_this_command_keys (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3858 command_builder_append_event (command_builder, event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3862 Lisp_Object leaf =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3863 command_builder_find_leaf_and_update_global_state
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3864 (command_builder,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3865 allow_misc_user_events_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 GCPRO1 (leaf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 if (KEYMAPP (leaf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3871 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3872 if (!x_kludge_lw_menu_active ())
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3873 #else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3874 if (1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3875 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 if (STRINGP (prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 /* Append keymap prompt to key echo buffer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 int buf_index = command_builder->echo_buf_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 Bytecount len = XSTRING_LENGTH (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 if (len + buf_index + 1 <= command_builder->echo_buf_length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 593
diff changeset
3886 Intbyte *echo = command_builder->echo_buf + buf_index;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 memcpy (echo, XSTRING_DATA (prompt), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 echo[len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890 maybe_echo_keys (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 maybe_echo_keys (command_builder, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3895 else if (!NILP (Vquit_flag))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3896 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3897 Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3898 Lisp_Event *e = XEVENT (quit_event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3899 /* if quit happened during menu acceleration, pretend we read it */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3900 struct console *con = XCONSOLE (Fselected_console ());
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3901 int ch = CONSOLE_QUIT_CHAR (con);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3902
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3903 character_to_event (ch, e, con, 1, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
3904 e->channel = wrap_console (con);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3905
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3906 enqueue_command_event (quit_event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3907 Vquit_flag = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3908 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 else if (!NILP (leaf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 if (EQ (Qcommand, echo_area_status (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 && command_builder->echo_buf_index > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 /* If we had been echoing keys, echo the last one (without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 the trailing dash) and redisplay before executing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 command. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 maybe_echo_keys (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 Fsit_for (Qzero, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 RETURN_UNGCPRO (leaf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3927 static int
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3928 is_scrollbar_event (Lisp_Object event)
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3929 {
516
8a4db099aa97 [xemacs-hg @ 2001-05-07 14:55:13 by yoshiki]
yoshiki
parents: 502
diff changeset
3930 #ifdef HAVE_SCROLLBARS
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3931 Lisp_Object fun;
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3932
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3933 if (XEVENT (event)->event_type != misc_user_event)
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3934 return 0;
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3935 fun = XEVENT (event)->event.misc.function;
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3936
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3937 return (EQ (fun, Qscrollbar_line_up) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3938 EQ (fun, Qscrollbar_line_down) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3939 EQ (fun, Qscrollbar_page_up) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3940 EQ (fun, Qscrollbar_page_down) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3941 EQ (fun, Qscrollbar_to_top) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3942 EQ (fun, Qscrollbar_to_bottom) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3943 EQ (fun, Qscrollbar_vertical_drag) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3944 EQ (fun, Qscrollbar_char_left) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3945 EQ (fun, Qscrollbar_char_right) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3946 EQ (fun, Qscrollbar_page_left) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3947 EQ (fun, Qscrollbar_page_right) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3948 EQ (fun, Qscrollbar_to_left) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3949 EQ (fun, Qscrollbar_to_right) ||
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3950 EQ (fun, Qscrollbar_horizontal_drag));
516
8a4db099aa97 [xemacs-hg @ 2001-05-07 14:55:13 by yoshiki]
yoshiki
parents: 502
diff changeset
3951 #else
8a4db099aa97 [xemacs-hg @ 2001-05-07 14:55:13 by yoshiki]
yoshiki
parents: 502
diff changeset
3952 return 0;
8a4db099aa97 [xemacs-hg @ 2001-05-07 14:55:13 by yoshiki]
yoshiki
parents: 502
diff changeset
3953 #endif /* HAVE_SCROLLBARS */
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3954 }
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3955
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 execute_command_event (struct command_builder *command_builder,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 struct console *con = XCONSOLE (command_builder->console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 GCPRO1 (event); /* event may be freshly created */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3965
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3966 /* #### This call to is_scrollbar_event() isn't quite right, but
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3967 fixing properly it requires more work than can go into 21.4.
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3968 (We really need to split out menu, scrollbar, dialog, and other
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3969 types of events from misc-user, and put the remaining ones in a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3970 new `user-eval' type that behaves like an eval event but is a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3971 user event and thus has all of its semantics -- e.g. being
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3972 delayed during `accept-process-output' and similar wait states.)
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3973
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3974 The real issue here is that "user events" and "command events"
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3975 are not the same thing, but are very much confused in
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3976 event-stream.c. User events are, essentially, any event that
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3977 should be delayed by accept-process-output, should terminate a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3978 sit-for, etc. -- basically, any event that needs to be processed
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3979 synchronously with key and mouse events. Command events are
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3980 those that participate in command building; scrollbar events
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3981 clearly don't belong because they should be transparent in a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3982 sequence like C-x @ h <scrollbar-drag> x, which used to cause a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3983 crash before checks similar to the is_scrollbar_event() call were
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3984 added. Do other events belong with scrollbar events? I'm not
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3985 sure; we need to categorize all misc-user events and see what
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3986 their semantics are.
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3987
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3988 (You might ask, why do scrollbar events need to be user events?
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3989 That's a good question. The answer seems to be that they can
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3990 change point, and having this happen asynchronously would be a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3991 very bad idea. According to the "proper" functioning of
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3992 scrollbars, this should not happen, but XEmacs does not allow
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3993 point to go outside of the window.)
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3994
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3995 Scrollbar events and similar non-command events should obviously
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3996 not be recorded in this-command-keys, so we need to check for
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3997 this in next-event.
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3998
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
3999 #### We call reset_current_events() twice in this function --
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4000 #### here, and later as a result of reset_this_command_keys().
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4001 #### This is almost certainly wrong; need to figure out what's
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4002 #### correct.
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4003
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4004 #### We need to figure out what's really correct w.r.t. scrollbar
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4005 #### events. With these new fixes in, it actually works to do
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4006 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4007 #### (starts over at 5). We really need to be special-casing
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4008 #### scrollbar events at a lower level, and not really passing
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4009 #### them through the command builder at all. (e.g. do scrollbar
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4010 #### events belong in macros??? doubtful; probably only the
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4011 #### point movement, if any, belongs, special-cased as a
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4012 #### pseudo-issued M-x goto-char command). #### Need more work
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4013 #### here. Do this when separating out scrollbar events.
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4014 */
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4015
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4016 if (!is_scrollbar_event (event))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4017 reset_current_events (command_builder);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 switch (XEVENT (event)->event_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 case key_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 Vcurrent_mouse_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 case button_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 case button_release_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 case misc_user_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 default: break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 /* Store the last-command-event. The semantics of this is that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 is the last event most recently involved in command-lookup. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 if (!EVENTP (Vlast_command_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 Vlast_command_event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 if (XEVENT (Vlast_command_event)->event_type == dead_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 Vlast_command_event = Fmake_event (Qnil, Qnil);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4039 invalid_state ("Someone deallocated the last-command-event!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 if (! EQ (event, Vlast_command_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 Fcopy_event (event, Vlast_command_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 /* Note that last-command-char will never have its high-bit set, in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 an effort to sidestep the ambiguity between M-x and oslash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 Vlast_command_char = Fevent_to_character (Vlast_command_event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 /* Actually call the command, with all sorts of hair to preserve or clear
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 the echo-area and region as appropriate and call the pre- and post-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 command-hooks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 int old_kbd_macro = con->kbd_macro_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 struct window *w = XWINDOW (Fselected_window (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 /* We're executing a new command, so the old value is irrelevant. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 zmacs_region_stays = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 /* If the previous command tried to force a specific window-start,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 reset the flag in case this command moves point far away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 that position. Also, reset the window's buffer's change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 information so that we don't trigger an incremental update. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 if (w->force_start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 w->force_start = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 buffer_reset_changes (XBUFFER (w->buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 pre_command_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 if (XEVENT (event)->event_type == misc_user_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 call1 (XEVENT (event)->event.eval.function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 XEVENT (event)->event.eval.object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 Fcommand_execute (Vthis_command, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082 post_command_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083
757
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
4084 /* Console might have been deleted by command */
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
4085 if (CONSOLE_LIVE_P (con) && !NILP (con->prefix_arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 /* Commands that set the prefix arg don't update last-command, don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 reset the echoing state, and don't go into keyboard macros unless
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4089 followed by another command. Also don't quit here. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4090 int speccount = specpdl_depth ();
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4091 specbind (Qinhibit_quit, Qt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 maybe_echo_keys (command_builder, 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4093 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095 /* If we're recording a keyboard macro, and the last command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 executed set a prefix argument, then decrement the pointer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 the "last character really in the macro" to be just before this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 command. This is so that the ^U in "^U ^X )" doesn't go onto
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 the end of macro. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 if (!NILP (con->defining_kbd_macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 con->kbd_macro_end = old_kbd_macro;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 /* Start a new command next time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 Vlast_command = Vthis_command;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4107 Vlast_command_properties = Vthis_command_properties;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4108 Vthis_command_properties = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4109
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 so we don't either */
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4112
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 462
diff changeset
4113 if (!is_scrollbar_event (event))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4114 reset_this_command_keys (CONSOLE_LIVE_P (con) ? wrap_console (con)
757
516c347c4479 [xemacs-hg @ 2002-02-22 17:13:59 by michaels]
michaels
parents: 733
diff changeset
4115 : Qnil, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 /* Run the pre command hook. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 pre_command_hook (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127 last_point_position = BUF_PT (current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 XSETBUFFER (last_point_position_buffer, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 safe_run_hook_trapping_errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 ("Error in `pre-command-hook' (setting hook to nil)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 Qpre_command_hook, 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4133
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4134 /* This is a kludge, but necessary; see simple.el */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4135 call0 (Qhandle_pre_motion_command);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 /* Run the post command hook. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141 post_command_hook (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 /* Turn off region highlighting unless this command requested that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 it be left on, or we're in the minibuffer. We don't turn it off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 when we're in the minibuffer so that things like M-x write-region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 still work!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 This could be done via a function on the post-command-hook, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 we don't want the user to accidentally remove it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153 Lisp_Object win = Fselected_window (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 /* If the last command deleted the frame, `win' might be nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 It seems safest to do nothing in this case. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4157 /* Note: Someone added the following comment and put #if 0's around
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4158 this code, not realizing that doing this invites a crash in the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4159 line after. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
4160 /* #### This doesn't really fix the problem,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 if delete-frame is called by some hook */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 if (NILP (win))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4164
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4165 /* This is a kludge, but necessary; see simple.el */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4166 call0 (Qhandle_post_motion_command);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 if (! zmacs_region_stays
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 && (!MINI_WINDOW_P (XWINDOW (win))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 zmacs_deactivate_region ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 zmacs_update_region ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 safe_run_hook_trapping_errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 ("Error in `post-command-hook' (setting hook to nil)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 Qpost_command_hook, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 /* #### Kludge!!! This is necessary to make sure that things
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 are properly positioned even if post-command-hook moves point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 #### There should be a cleaner way of handling this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 call0 (Qauto_show_make_point_visible);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4187 Given an event object EVENT as returned by `next-event', execute it.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 Key-press, button-press, and button-release events get accumulated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 until a complete key sequence (see `read-key-sequence') is reached,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 at which point the sequence is looked up in the current keymaps and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 acted upon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 Mouse motion events cause the low-level handling function stored in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195 `mouse-motion-handler' to be called. (There are very few circumstances
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 under which you should change this handler. Use `mode-motion-hook'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 instead.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 Menu, timeout, and eval events cause the associated function or handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 to be called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 Process events cause the subprocess's output to be read and acted upon
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 appropriately (see `start-process').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 Magic events are handled as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 struct command_builder *command_builder;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
4211 Lisp_Event *ev;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 Lisp_Object console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 Lisp_Object channel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 ev = XEVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218 /* events on dead channels get silently eaten */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219 channel = EVENT_CHANNEL (ev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220 if (object_dead_p (channel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 /* Some events don't have channels (e.g. eval events). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224 console = CDFW_CONSOLE (channel);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4225 if (NILP (console))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226 console = Vselected_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4227 else if (!EQ (console, Vselected_console))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 Fselect_console (console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4231 switch (XEVENT (event)->event_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4232 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233 case button_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234 case button_release_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235 case key_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 if (KEYMAPP (leaf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240 /* Incomplete key sequence */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242 if (NILP (leaf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 /* At this point, we know that the sequence is not bound to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 command. Normally, we beep and print a message informing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 user of this. But we do not beep or print a message when:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 o the last event in this sequence is a mouse-up event; or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 o the last event in this sequence is a mouse-down event and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 there is a binding for the mouse-up version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 That is, if the sequence ``C-x button1'' is typed, and is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 bound to a command, but the sequence ``C-x button1up'' is bound
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 to a command, we do not complain about the ``C-x button1''
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 bound to a command, then we complain about the ``C-x button1''
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 sequence, but later will *not* complain about the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 ``C-x button1up'' sequence, which would be redundant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 This is pretty hairy, but I think it's the most intuitive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 behavior.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 Lisp_Object terminal = command_builder->most_current_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 if (XEVENT_TYPE (terminal) == button_press_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 int no_bitching;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 /* Temporarily pretend the last event was an "up" instead of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 "down", and look up its binding. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 XEVENT_TYPE (terminal) = button_release_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 /* If the "up" version is bound, don't complain. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 no_bitching
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4273 = !NILP (command_builder_find_leaf_and_update_global_state
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4274 (command_builder, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 /* Undo the temporary changes we just made. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 XEVENT_TYPE (terminal) = button_press_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 if (no_bitching)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 /* Pretend this press was not seen (treat as a prefix) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 if (EQ (command_builder->current_events, terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 reset_current_events (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 Lisp_Object eve;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 if (EQ (XEVENT_NEXT (eve), terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 Fdeallocate_event (command_builder->
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 most_current_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 XSET_EVENT_NEXT (eve, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 command_builder->most_current_event = eve;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 maybe_echo_keys (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 /* Complain that the typed sequence is not defined, if this is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 kind of sequence that warrants a complaint. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304 XCONSOLE (console)->defining_kbd_macro = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 XCONSOLE (console)->prefix_arg = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 /* Don't complain about undefined button-release events */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 if (XEVENT_TYPE (terminal) != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 Lisp_Object keys = current_events_into_vector (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 /* Run the pre-command-hook before barfing about an undefined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 key. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 Vthis_command = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 GCPRO1 (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 pre_command_hook ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 /* The post-command-hook doesn't run. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 /* Reset the command builder for reading the next sequence. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 reset_this_command_keys (console, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 else /* key sequence is bound to a command */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 {
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4326 int magic_undo = 0;
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4327 int magic_undo_count = 20;
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4328
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 Vthis_command = leaf;
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4330
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 /* Don't push an undo boundary if the command set the prefix arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 or if we are executing a keyboard macro, or if in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 minibuffer. If the command we are about to execute is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 self-insert, it's tricky: up to 20 consecutive self-inserts may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 be done without an undo boundary. This counter is reset as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 soon as a command other than self-insert-command is executed.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4337
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4338 Programmers can also use the `self-insert-defer-undo'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4339 property to install that behavior on functions other
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4340 than `self-insert-command', or to change the magic
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4341 number 20 to something else. #### DOCUMENT THIS! */
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4342
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4343 if (SYMBOLP (leaf))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4344 {
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4345 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4346 if (NATNUMP (prop))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4347 magic_undo = 1, magic_undo_count = XINT (prop);
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4348 else if (!NILP (prop))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4349 magic_undo = 1;
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4350 else if (EQ (leaf, Qself_insert_command))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4351 magic_undo = 1;
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4352 }
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4353
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4354 if (!magic_undo)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 command_builder->self_insert_countdown = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 if (NILP (XCONSOLE (console)->prefix_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4357 && NILP (Vexecuting_macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 && command_builder->self_insert_countdown == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 Fundo_boundary ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4361 if (magic_undo)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 if (--command_builder->self_insert_countdown < 0)
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4364 command_builder->self_insert_countdown = magic_undo_count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 execute_command_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 (command_builder,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4368 internal_equal (event, command_builder->most_current_event, 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 ? event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 /* Use the translated event that was most recently seen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 This way, last-command-event becomes f1 instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 the P from ESC O P. But we must copy it, else we'll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 lose when the command-builder events are deallocated. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4374 : Fcopy_event (command_builder->most_current_event, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 case misc_user_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 /* Jamie said:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 We could just always use the menu item entry, whatever it is, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 this might break some Lisp code that expects `this-command' to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 always contain a symbol. So only store it if this is a simple
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 `call-interactively' sort of menu item.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 But this is bogus. `this-command' could be a string or vector
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 anyway (for keyboard macros). There's even one instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 (in pending-del.el) of `this-command' getting set to a cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390 (a lambda expression). So in the `eval' case I'll just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391 convert it into a lambda expression.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394 && SYMBOLP (XEVENT (event)->event.eval.object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395 Vthis_command = XEVENT (event)->event.eval.object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 Vthis_command =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399 else if (SYMBOLP (XEVENT (event)->event.eval.function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 /* A scrollbar command or the like. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 Vthis_command = XEVENT (event)->event.eval.function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4403 /* Huh? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404 Vthis_command = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4406 /* clear the echo area */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4407 reset_key_echo (command_builder, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4409 command_builder->self_insert_countdown = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4410 if (NILP (XCONSOLE (console)->prefix_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4411 && NILP (Vexecuting_macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4412 && !EQ (minibuf_window, Fselected_window (Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413 Fundo_boundary ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 execute_command_event (command_builder, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4419 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4420 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427 Read a sequence of keystrokes or mouse clicks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 Returns a vector of the event objects read. The vector and the event
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4429 objects it contains are freshly created (and so will not be side-effected
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430 by subsequent calls to this function).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 The sequence read is sufficient to specify a non-prefix command starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 from the current local and global keymaps. A C-g typed while in this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434 function is treated like any other character, and `quit-flag' is not set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436 First arg PROMPT is a prompt string. If nil, do not prompt specially.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4437
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4438 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4439 continuation of the previous key.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4440
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4441 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4442 last event to lower case. (Normally any upper case event is converted
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4443 to lower case if the original event is undefined and the lower case
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4444 equivalent is defined.) This argument is provided mostly for FSF
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4445 compatibility; the equivalent effect can be achieved more generally by
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4446 binding `retry-undefined-key-binding-unshifted' to nil around the call
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4447 to `read-key-sequence'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449 If the user selects a menu item while we are prompting for a key-sequence,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 the returned value will be a vector of a single menu-selection event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451 An error will be signalled if you pass this value to `lookup-key' or a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4452 related function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4454 `read-key-sequence' checks `function-key-map' for function key
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4455 sequences, where they wouldn't conflict with ordinary bindings.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4456 See `function-key-map' for more details.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 (prompt, continue_echo, dont_downcase_last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4462 Probably not -- see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4463 comment in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4464 next-event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4465 struct command_builder *command_builder =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4466 XCOMMAND_BUILDER (con->command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4470 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4471 GCPRO1 (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4472
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
4473 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4474 if (!NILP (prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475 CHECK_STRING (prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4477 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4479 if (NILP (continue_echo))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4480 reset_this_command_keys (wrap_console (con), 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4482 specbind (Qinhibit_quit, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4484 if (!NILP (dont_downcase_last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4485 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4487 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4489 Fnext_event (event, prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490 /* restore the selected-console damage */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4491 con = event_console_or_selected (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 command_builder = XCOMMAND_BUILDER (con->command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4493 if (! command_event_p (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4494 execute_internal_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4495 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4496 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4497 if (XEVENT (event)->event_type == misc_user_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498 reset_current_events (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 result = lookup_command_event (command_builder, event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500 if (!KEYMAPP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4501 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502 result = current_events_into_vector (command_builder);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 reset_key_echo (command_builder, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4504 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506 prompt = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4507 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4508 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4510 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 Fdeallocate_event (event);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4512 RETURN_UNGCPRO (unbind_to_1 (speccount, result));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516 Return a vector of the keyboard or mouse button events that were used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4517 to invoke this command. This copies the vector and the events; it is safe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4518 to keep and modify them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4522 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4523 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4524 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4526 if (NILP (Vthis_command_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4527 return make_vector (0, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4529 len = event_chain_count (Vthis_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4531 result = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4532 len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4533 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4534 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4535 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4536 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 Used for complicated reasons in `universal-argument-other-key'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4541 `universal-argument-other-key' rereads the event just typed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4542 It then gets translated through `function-key-map'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4543 The translated event gets included in the echo area and in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4544 the value of `this-command-keys' in addition to the raw original event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4545 That is not right.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4547 Calling this function directs the translated event to replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4548 the original event, so that only one version of the event actually
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
4549 appears in the echo area and in the value of `this-command-keys'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4550 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4551 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4552 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4553 /* #### I don't understand this at all, so currently it does nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4554 If there is ever a problem, maybe someone should investigate. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4555 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4559 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4560 dribble_out_event (Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4561 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4562 if (NILP (Vdribble_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4563 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4565 if (XEVENT (event)->event_type == key_press_event &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4566 !XEVENT (event)->event.key.modifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4567 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4568 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4569 if (CHARP (XEVENT (event)->event.key.keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4571 Emchar ch = XCHAR (keysym);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 593
diff changeset
4572 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4573 Bytecount len = set_charptr_emchar (str, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4574 Lstream_write (XLSTREAM (Vdribble_file), str, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4576 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4577 /* one-char key events are printed with just the key name */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4578 Fprinc (keysym, Vdribble_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4579 else if (EQ (keysym, Qreturn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4580 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4581 else if (EQ (keysym, Qspace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4582 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4583 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4584 Fprinc (event, Vdribble_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4585 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4586 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4587 Fprinc (event, Vdribble_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4588 Lstream_flush (XLSTREAM (Vdribble_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4591 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4592 "FOpen dribble file: ", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4593 Start writing all keyboard characters to a dribble file called FILENAME.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4594 If FILENAME is nil, close any open dribble file.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4595 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4596 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4597 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4598 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4599 /* XEmacs change: always close existing dribble file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4600 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4601 if (!NILP (Vdribble_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4602 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4603 Lstream_close (XLSTREAM (Vdribble_file));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4604 Vdribble_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4605 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4606 if (!NILP (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4607 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4608 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4609
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4610 filename = Fexpand_file_name (filename, Qnil);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4611 fd = qxe_open (XSTRING_DATA (filename),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4612 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4613 CREAT_MODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4614 if (fd < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4615 report_file_error ("Unable to create dribble file", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4616 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4617 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4618 Vdribble_file =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4619 make_coding_output_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4620 (XLSTREAM (Vdribble_file),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4621 Qescape_quoted, CODING_ENCODE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4622 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4624 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4625 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4627
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4628
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4629 DEFUN ("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4630 Return the current event timestamp of the window system associated with CONSOLE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4631 CONSOLE defaults to the selected console if omitted.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4632 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4633 (console))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4634 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4635 struct console *c = decode_console (console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4636 int tiempo = event_stream_current_event_timestamp (c);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4637
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4638 /* This junk is so that timestamps don't get to be negative, but contain
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4639 as many bits as this particular emacs will allow.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4640 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4641 return make_int (((1L << (VALBITS - 1)) - 1) & tiempo);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4642 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4643
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4644
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4645 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4646 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4647 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4649 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4650 syms_of_event_stream (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4651 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4652 INIT_LRECORD_IMPLEMENTATION (command_builder);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4653 INIT_LRECORD_IMPLEMENTATION (timeout);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4654
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4655 DEFSYMBOL (Qdisabled);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4656 DEFSYMBOL (Qcommand_event_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4657
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4658 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4659 DEFERROR_STANDARD (Qinvalid_key_binding, Qinvalid_state);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4661 DEFSUBR (Frecent_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4662 DEFSUBR (Frecent_keys_ring_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4663 DEFSUBR (Fset_recent_keys_ring_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4664 DEFSUBR (Finput_pending_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4665 DEFSUBR (Fenqueue_eval_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4666 DEFSUBR (Fnext_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4667 DEFSUBR (Fnext_command_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4668 DEFSUBR (Fdiscard_input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4669 DEFSUBR (Fsit_for);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4670 DEFSUBR (Fsleep_for);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4671 DEFSUBR (Faccept_process_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4672 DEFSUBR (Fadd_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4673 DEFSUBR (Fdisable_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4674 DEFSUBR (Fadd_async_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4675 DEFSUBR (Fdisable_async_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4676 DEFSUBR (Fdispatch_event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4677 DEFSUBR (Fdispatch_non_command_events);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4678 DEFSUBR (Fread_key_sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4679 DEFSUBR (Fthis_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4680 DEFSUBR (Freset_this_command_lengths);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4681 DEFSUBR (Fopen_dribble_file);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4682 DEFSUBR (Fcurrent_event_timestamp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4683
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4684 DEFSYMBOL (Qpre_command_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4685 DEFSYMBOL (Qpost_command_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4686 DEFSYMBOL (Qunread_command_events);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4687 DEFSYMBOL (Qunread_command_event);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4688 DEFSYMBOL (Qpre_idle_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4689 DEFSYMBOL (Qhandle_pre_motion_command);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4690 DEFSYMBOL (Qhandle_post_motion_command);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4691 DEFSYMBOL (Qretry_undefined_key_binding_unshifted);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4692 DEFSYMBOL (Qauto_show_make_point_visible);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4693
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4694 DEFSYMBOL (Qself_insert_defer_undo);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 535
diff changeset
4695 DEFSYMBOL (Qcancel_mode_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4698 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4699 reinit_vars_of_event_stream (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4700 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4701 recent_keys_ring_index = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4702 recent_keys_ring_size = 100;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4703 num_input_chars = 0;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
4704 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4705 &lrecord_timeout);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4706 staticpro_nodump (&Vtimeout_free_list);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4707 Vcommand_builder_free_list =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4708 make_lcrecord_list (sizeof (struct command_builder),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4709 &lrecord_command_builder);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4710 staticpro_nodump (&Vcommand_builder_free_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4711 the_low_level_timeout_blocktype =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4712 Blocktype_new (struct low_level_timeout_blocktype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4713 something_happened = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4714 recursive_sit_for = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4717 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4718 vars_of_event_stream (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4719 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4720 reinit_vars_of_event_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4721 Vrecent_keys_ring = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4722 staticpro (&Vrecent_keys_ring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4724 Vthis_command_keys = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4725 staticpro (&Vthis_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4726 Vthis_command_keys_tail = Qnil;
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
4727 dump_add_root_object (&Vthis_command_keys_tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4729 command_event_queue = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4730 staticpro (&command_event_queue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4731 command_event_queue_tail = Qnil;
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
4732 dump_add_root_object (&command_event_queue_tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4734 Vlast_selected_frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4735 staticpro (&Vlast_selected_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4737 pending_timeout_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4738 staticpro (&pending_timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4740 pending_async_timeout_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4741 staticpro (&pending_async_timeout_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4743 last_point_position_buffer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4744 staticpro (&last_point_position_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4746 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4747 *Nonzero means echo unfinished commands after this many seconds of pause.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4748 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4749 Vecho_keystrokes = make_int (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4751 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4752 *Number of keyboard input characters between auto-saves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4753 Zero means disable autosaving due to number of characters typed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4754 See also the variable `auto-save-timeout'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4755 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4756 auto_save_interval = 300;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4758 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4759 Function or functions to run before every command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4760 This may examine the `this-command' variable to find out what command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4761 is about to be run, or may change it to cause a different command to run.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4762 Function on this hook must be careful to avoid signalling errors!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4763 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4764 Vpre_command_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4766 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4767 Function or functions to run after every command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4768 This may examine the `this-command' variable to find out what command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4769 was just executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4770 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4771 Vpost_command_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4773 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4774 Normal hook run when XEmacs it about to be idle.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4775 This occurs whenever it is going to block, waiting for an event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4776 This generally happens as a result of a call to `next-event',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4777 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4778 or `x-get-selection'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4779 Errors running the hook are caught and ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4780 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4781 Vpre_idle_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4783 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4784 *Variable to control XEmacs behavior with respect to focus changing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4785 If this variable is set to t, then XEmacs will not gratuitously change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4786 the keyboard focus. XEmacs cannot in general detect when this mode is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4787 used by the window manager, so it is up to the user to set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4788 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4789 focus_follows_mouse = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4791 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4792 Last keyboard or mouse button event that was part of a command. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4793 variable is off limits: you may not set its value or modify the event that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4794 is its value, as it is destructively modified by `read-key-sequence'. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4795 you want to keep a pointer to this value, you must use `copy-event'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4796 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4797 Vlast_command_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4799 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4800 If the value of `last-command-event' is a keyboard event, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4801 this is the nearest ASCII equivalent to it. This is the value that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4802 `self-insert-command' will put in the buffer. Remember that there is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4803 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4804 of keyboard events is much larger, so writing code that examines this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4805 variable to determine what key has been typed is bad practice, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4806 you are certain that it will be one of a small set of characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4807 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4808 Vlast_command_char = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4810 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4811 Last keyboard or mouse button event received. This variable is off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4812 limits: you may not set its value or modify the event that is its value, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4813 it is destructively modified by `next-event'. If you want to keep a pointer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4814 to this value, you must use `copy-event'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4815 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4816 Vlast_input_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4818 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4819 The mouse-button event which invoked this command, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4820 This is usually what `(interactive "e")' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4821 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4822 Vcurrent_mouse_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4824 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4825 If the value of `last-input-event' is a keyboard event, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4826 this is the nearest ASCII equivalent to it. Remember that there is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4827 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4828 of keyboard events is much larger, so writing code that examines this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4829 variable to determine what key has been typed is bad practice, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4830 you are certain that it will be one of a small set of characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4831 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4832 Vlast_input_char = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4834 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4835 The time (in seconds since Jan 1, 1970) of the last-command-event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4836 represented as a cons of two 16-bit integers. This is destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4837 modified, so copy it if you want to keep it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4838 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4839 Vlast_input_time = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4841 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4842 The time (in seconds since Jan 1, 1970) of the last-command-event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4843 represented as a list of three integers. The first integer contains
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4844 the most significant 16 bits of the number of seconds, and the second
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4845 integer contains the least significant 16 bits. The third integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4846 contains the remainder number of microseconds, if the current system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4847 supports microsecond clock resolution. This list is destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4848 modified, so copy it if you want to keep it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4849 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4850 Vlast_command_event_time = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4852 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4853 List of event objects to be read as next command input events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4854 This can be used to simulate the receipt of events from the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4855 Normally this is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4856 Events are removed from the front of this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4857 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4858 Vunread_command_events = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4860 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4861 Obsolete. Use `unread-command-events' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4862 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4863 Vunread_command_event = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4865 DEFVAR_LISP ("last-command", &Vlast_command /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4866 The last command executed. Normally a symbol with a function definition,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4867 but can be whatever was found in the keymap, or whatever the variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4868 `this-command' was set to by that command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4869 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4870 Vlast_command = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4872 DEFVAR_LISP ("this-command", &Vthis_command /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4873 The command now being executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4874 The command can set this variable; whatever is put here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4875 will be in `last-command' during the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4876 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4877 Vthis_command = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4878
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4879 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4880 Value of `this-command-properties' for the last command.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4881 Used by commands to help synchronize consecutive commands, in preference
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4882 to looking at `last-command' directly.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4883 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4884 Vlast_command_properties = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4885
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4886 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4887 Properties set by the current command.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4888 At the beginning of each command, the current value of this variable is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4889 copied to `last-command-properties', and then it is set to nil. Use `putf'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4890 to add properties to this variable. Commands should use this to communicate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4891 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4892 in preference to looking at and/or setting `this-command'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4893 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4894 Vthis_command_properties = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4895
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4896 DEFVAR_LISP ("help-char", &Vhelp_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4897 Character to recognize as meaning Help.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4898 When it is read, do `(eval help-form)', and display result if it's a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4899 If the value of `help-form' is nil, this char can be read normally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4900 This can be any form recognized as a single key specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4901 The help-char cannot be a negative number in XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4902 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4903 Vhelp_char = make_char (8); /* C-h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4905 DEFVAR_LISP ("help-form", &Vhelp_form /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4906 Form to execute when character help-char is read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4907 If the form returns a string, that string is displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4908 If `help-form' is nil, the help char is not recognized.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4909 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4910 Vhelp_form = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4912 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4913 Command to run when `help-char' character follows a prefix key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4914 This command is used only when there is no actual binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4915 for that character after that prefix key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4916 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4917 Vprefix_help_command = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4919 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4920 Hash table used as translate table for keyboard input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4921 Use `keyboard-translate' to portably add entries to this table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4922 Each key-press event is looked up in this table as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4924 -- If an entry maps a symbol to a symbol, then a key-press event whose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4925 keysym is the former symbol (with any modifiers at all) gets its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4926 keysym changed and its modifiers left alone. This is useful for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4927 dealing with non-standard X keyboards, such as the grievous damage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4928 that Sun has inflicted upon the world.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4929 -- If an entry maps a symbol to a character, then a key-press event
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4930 whose keysym is the former symbol (with any modifiers at all) gets
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4931 changed into a key-press event matching the latter character, and the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4932 resulting modifiers are the union of the original and new modifiers.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4933 -- If an entry maps a character to a character, then a key-press event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4934 matching the former character gets converted to a key-press event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4935 matching the latter character. This is useful on ASCII terminals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4936 for (e.g.) making C-\\ look like C-s, to get around flow-control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4937 problems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4938 -- If an entry maps a character to a symbol, then a key-press event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4939 matching the character gets converted to a key-press event whose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4940 keysym is the given symbol and which has no modifiers.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4941
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4942 Here's an example: This makes typing parens and braces easier by rerouting
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4943 their positions to eliminate the need to use the Shift key.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4944
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4945 (keyboard-translate ?[ ?()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4946 (keyboard-translate ?] ?))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4947 (keyboard-translate ?{ ?[)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4948 (keyboard-translate ?} ?])
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4949 (keyboard-translate 'f11 ?{)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4950 (keyboard-translate 'f12 ?})
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4951 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4953 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4954 &Vretry_undefined_key_binding_unshifted /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4955 If a key-sequence which ends with a shifted keystroke is undefined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4956 and this variable is non-nil then the command lookup is retried again
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4957 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4958 If lookup still fails, a normal error is signalled. In general,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4959 you should *bind* this, not set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4960 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4961 Vretry_undefined_key_binding_unshifted = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4962
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4963 DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4964 *Non-nil makes modifier keys sticky.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4965 This means that you can release the modifier key before pressing down
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4966 the key that you wish to be modified. Although this is non-standard
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4967 behavior, it is recommended because it reduces the strain on your hand,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4968 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4969
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4970 Modifier keys are sticky within the inverval specified by
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4971 `modifier-keys-sticky-time'.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4972 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4973 modifier_keys_are_sticky = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4974
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4975 DEFVAR_LISP ("modifier-keys-sticky-time", &Vmodifier_keys_sticky_time /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4976 *Modifier keys are sticky within this many milliseconds.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4977 If you don't want modifier keys sticking to be bounded, set this to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4978 non-integer value.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4979
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4980 This variable has no effect when `modifier-keys-are-sticky' is nil.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4981 Currently only implemented under X Window System.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4982 */ );
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4983 Vmodifier_keys_sticky_time = make_int (500);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4984
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4985 #ifdef MULE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4986 DEFVAR_LISP ("composed-character-default-binding",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4987 &Vcomposed_character_default_binding /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4988 The default keybinding to use for key events from composed input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4989 Window systems frequently have ways to allow the user to compose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4990 single characters in a language using multiple keystrokes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4991 XEmacs sees these as single character keypress events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4992 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4993 Vcomposed_character_default_binding = Qself_insert_command;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
4994 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4996 Vcontrolling_terminal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4997 staticpro (&Vcontrolling_terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4999 Vdribble_file = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5000 staticpro (&Vdribble_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5002 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5003 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5004 If non-zero, display debug information about Emacs events that XEmacs sees.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5005 Information is displayed on stderr.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5007 Before the event, the source of the event is displayed in parentheses,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5008 and is one of the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5010 \(real) A real event from the window system or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5011 terminal driver, as far as XEmacs can tell.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5013 \(keyboard macro) An event generated from a keyboard macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5015 \(unread-command-events) An event taken from `unread-command-events'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5017 \(unread-command-event) An event taken from `unread-command-event'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5019 \(command event queue) An event taken from an internal queue.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5020 Events end up on this queue when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5021 `enqueue-eval-event' is called or when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5022 user or eval events are received while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5023 XEmacs is blocking (e.g. in `sit-for',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5024 `sleep-for', or `accept-process-output',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5025 or while waiting for the reply to an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5026 X selection).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5028 \(->keyboard-translate-table) The result of an event translated through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5029 keyboard-translate-table. Note that in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5030 this case, two events are printed even
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5031 though only one is really generated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5033 \(SIGINT) A faked C-g resulting when XEmacs receives
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5034 a SIGINT (e.g. C-c was pressed in XEmacs'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5035 controlling terminal or the signal was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5036 explicitly sent to the XEmacs process).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5037 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5038 debug_emacs_events = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5039 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5041 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5042 Non-nil inhibits recording of input-events to recent-keys ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5043 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5044 inhibit_input_event_recording = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 757
diff changeset
5045
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5046 Vkeyboard_translate_table =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5047 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5048 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5050 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5051 init_event_stream (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5052 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5053 if (initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5055 #ifdef HAVE_UNIXOID_EVENT_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5056 init_event_unixoid ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5057 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5058 #ifdef HAVE_X_WINDOWS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5059 if (!strcmp (display_use, "x"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5060 init_event_Xt_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5061 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5062 #endif
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
5063 #ifdef HAVE_GTK
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
5064 if (!strcmp (display_use, "gtk"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
5065 init_event_gtk_late ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
5066 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
5067 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5068 #ifdef HAVE_MS_WINDOWS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5069 if (!strcmp (display_use, "mswindows"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5070 init_event_mswindows_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5071 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5072 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5074 /* For TTY's, use the Xt event loop if we can; it allows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5075 us to later open an X connection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5076 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5077 || (defined (HAVE_MSG_SELECT) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5078 && !defined (DEBUG_TTY_EVENT_STREAM)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5079 init_event_mswindows_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5080 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5081 init_event_Xt_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5082 #elif defined (HAVE_TTY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5083 init_event_tty_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5084 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5086 init_interrupts_late ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5088 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5091 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5092 useful testcases for v18/v19 compatibility:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5094 (defun foo ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5095 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5096 (setq unread-command-event (character-to-event ?A (allocate-event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5097 (setq x (list (read-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5098 ; (read-key-sequence "") ; try it with and without this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5099 last-command-char last-input-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5100 (recent-keys) (this-command-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5101 (global-set-key "\^Q" 'foo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5103 without the read-key-sequence:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5104 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q])
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5105 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5106 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5108 with the read-key-sequence:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5109 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b])
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5110 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5111 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5113 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5115 ;(setq x (list (read-char) quit-flag))^J^G
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5116 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5117 ;for BOTH, x should get set to (7 t), but no result should be printed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5118 ;; #### According to the doc of quit-flag, second test should return
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5119 ;; (?\^G nil). Accidentaly XEmacs returns correct value. However,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5120 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5122 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5123 ;in *scratch*, type (sit-for 20)^J
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5124 ;wait a couple of seconds, move cursor to foo, type "a"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5125 ;a should be inserted in foo. Cursor highlighting should not change in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5126 ;the meantime.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5128 ;do it with sleep-for. move cursor into foo, then back into *scratch*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5129 ;before typing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5130 ;repeat also with (accept-process-output nil 20)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5132 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5134 (defun tst ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5135 (list (condition-case c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5136 (sleep-for 20)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5137 (quit c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5138 (read-char)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5139
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5140 (tst)^Ja^G ==> ((quit) ?a) with no signal
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5141 (tst)^J^Ga ==> ((quit) ?a) with no signal
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5142 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5144 ; with sit-for only do the 2nd test.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5145 ; Do all 3 tests with (accept-process-output nil 20)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5147 Do this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5148 (setq enable-recursive-minibuffers t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5149 minibuffer-max-depth nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5150 ESC ESC ESC ESC - there are now two minibuffers active
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5151 C-g C-g C-g - there should be active 0, not 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5152 Similarly:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5153 C-x C-f ~ / ? - wait for "Making completion list..." to display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5154 C-g - wait for "Quit" to display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5155 C-g - minibuffer should not be active
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5156 however C-g before "Quit" is displayed should leave minibuffer active.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5158 ;do it all in both v18 and v19 and make sure all results are the same.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5159 ;all of these cases matter a lot, but some in quite subtle ways.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5160 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5162 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5163 Additional test cases for accept-process-output, sleep-for, sit-for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5164 Be sure you do all of the above checking for C-g and focus, too!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5166 ; Make sure that timer handlers are run during, not after sit-for:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5167 (defun timer-check ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5168 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5169 (sit-for 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5170 (message "after sit-for"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5172 ; The first message should appear after 2 seconds, and the final message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5173 ; 3 seconds after that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5174 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5178 ; Make sure that process filters are run during, not after sit-for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5179 (defun fubar ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5180 (message "sit-for = %s" (sit-for 30)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5181 (add-hook 'post-command-hook 'fubar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5183 ; Now type M-x shell RET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5184 ; wait for the shell prompt then send: ls RET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5185 ; the output of ls should fill immediately, and not wait 30 seconds.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5187 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5191 ; Make sure that recursive invocations return immediately:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5192 (defmacro test-diff-time (start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5193 `(+ (* (- (car ,end) (car ,start)) 65536.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5194 (- (cadr ,end) (cadr ,start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5195 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5197 (defun testee (ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5198 (sit-for 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5200 (defun test-them ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5201 (let ((start (current-time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5202 end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5203 (add-timeout 2 'testee nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5204 (sit-for 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5205 (add-timeout 2 'testee nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5206 (sleep-for 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5207 (add-timeout 2 'testee nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5208 (accept-process-output nil 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5209 (setq end (current-time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5210 (test-diff-time start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5212 (test-them) should sit for 15 seconds.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5213 Repeat with testee set to sleep-for and accept-process-output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5214 These should each delay 36 seconds.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5216 */