518
|
1 /* Keyboard and mouse input; editor command loop.
|
|
2 Copyright (C) 1985, 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
|
|
3
|
|
4 This file is part of GNU Emacs.
|
|
5
|
|
6 GNU Emacs is free software; you can redistribute it and/or modify
|
|
7 it under the terms of the GNU General Public License as published by
|
|
8 the Free Software Foundation; either version 1, or (at your option)
|
|
9 any later version.
|
|
10
|
|
11 GNU Emacs is distributed in the hope that it will be useful,
|
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
14 GNU General Public License for more details.
|
|
15
|
|
16 You should have received a copy of the GNU General Public License
|
|
17 along with GNU Emacs; see the file COPYING. If not, write to
|
|
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
|
|
19
|
|
20 /* Allow config.h to undefine symbols found here. */
|
|
21 #include <signal.h>
|
|
22
|
|
23 #include "config.h"
|
|
24 #include <stdio.h>
|
|
25 #undef NULL
|
|
26 #include "termchar.h"
|
|
27 #include "termopts.h"
|
|
28 #include "lisp.h"
|
|
29 #include "termhooks.h"
|
|
30 #include "macros.h"
|
|
31 #include "screen.h"
|
|
32 #include "window.h"
|
|
33 #include "commands.h"
|
|
34 #include "buffer.h"
|
|
35 #include "disptab.h"
|
|
36 #include "keyboard.h"
|
|
37 #include <setjmp.h>
|
|
38 #include <errno.h>
|
|
39
|
|
40 #include "emacssignal.h"
|
|
41
|
|
42 extern int errno;
|
|
43
|
|
44 /* Get FIONREAD, if it is available. */
|
|
45 #ifdef USG
|
|
46 #include <termio.h>
|
|
47 #include <fcntl.h>
|
|
48 #else /* not USG */
|
|
49 #ifndef VMS
|
|
50 #include <sys/ioctl.h>
|
|
51 #endif /* not VMS */
|
|
52 #endif /* not USG */
|
|
53
|
|
54 /* UNIPLUS systems may have FIONREAD. */
|
|
55 #ifdef UNIPLUS
|
|
56 #include <sys.ioctl.h>
|
|
57 #endif
|
|
58
|
|
59 #ifdef HAVE_X_WINDOWS
|
|
60 extern Lisp_Object Vmouse_grabbed;
|
|
61
|
|
62 /* Make all keyboard buffers much bigger when using X windows. */
|
|
63 #define KBD_BUFFER_SIZE 4096
|
|
64 #else /* No X-windows, character input */
|
|
65 #define KBD_BUFFER_SIZE 256
|
|
66 #endif /* No X-windows */
|
|
67
|
|
68 /* Following definition copied from eval.c */
|
|
69
|
|
70 struct backtrace
|
|
71 {
|
|
72 struct backtrace *next;
|
|
73 Lisp_Object *function;
|
|
74 Lisp_Object *args; /* Points to vector of args. */
|
|
75 int nargs; /* length of vector. If nargs is UNEVALLED,
|
|
76 args points to slot holding list of
|
|
77 unevalled args */
|
|
78 char evalargs;
|
|
79 };
|
|
80
|
|
81 /* Non-nil disable property on a command means
|
|
82 do not execute it; call disabled-command-hook's value instead. */
|
|
83 Lisp_Object Qdisabled, Vdisabled_command_hook;
|
|
84
|
|
85 #define NUM_RECENT_KEYS (100)
|
|
86 int recent_keys_index; /* Index for storing next element into recent_keys */
|
|
87 int total_keys; /* Total number of elements stored into recent_keys */
|
|
88 Lisp_Object recent_keys[NUM_RECENT_KEYS]; /* Holds last 100 keystrokes */
|
|
89
|
|
90 /* Buffer holding the key that invoked the current command. */
|
|
91 Lisp_Object *this_command_keys;
|
|
92 int this_command_key_count; /* Size in use. */
|
|
93 int this_command_keys_size; /* Size allocated. */
|
|
94
|
|
95 extern int minbuf_level;
|
|
96
|
|
97 extern struct backtrace *backtrace_list;
|
|
98
|
|
99 /* Nonzero means do menu prompting. */
|
|
100 static int menu_prompting;
|
|
101
|
|
102 /* Character to see next line of menu prompt. */
|
|
103 static Lisp_Object menu_prompt_more_char;
|
|
104
|
|
105 /* For longjmp to where kbd input is being done. */
|
|
106 static jmp_buf getcjmp;
|
|
107
|
|
108 /* True while doing kbd input. */
|
|
109 int waiting_for_input;
|
|
110
|
|
111 /* True while displaying for echoing. Delays C-g throwing. */
|
|
112 static int echoing;
|
|
113
|
|
114 /* Nonzero means C-G should cause immediate error-signal. */
|
|
115 int immediate_quit;
|
|
116
|
|
117 /* Character to recognize as the help char. */
|
|
118 Lisp_Object help_char;
|
|
119
|
|
120 /* Form to execute when help char is typed. */
|
|
121 Lisp_Object Vhelp_form;
|
|
122
|
|
123 /* Character that causes a quit. Normally C-g.
|
|
124
|
|
125 If we are running on an ordinary terminal, this must be an ordinary
|
|
126 ASCII char, since we want to make it our interrupt character.
|
|
127
|
|
128 If we are not running on an ordinary terminal, it still needs to be
|
|
129 an ordinary ASCII char. This character needs to be recognized in
|
|
130 the input interrupt handler. At this point, the keystroke is
|
|
131 represented as a struct input_event, while the desired quit
|
|
132 character is specified as a lispy event. The mapping from struct
|
|
133 input_events to lispy events cannot run in an interrupt handler,
|
|
134 and the reverse mapping is difficult for anything but ASCII
|
|
135 keystrokes.
|
|
136
|
|
137 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
|
|
138 ASCII character. */
|
|
139 int quit_char;
|
|
140
|
|
141 extern Lisp_Object current_global_map;
|
|
142 extern int minibuf_level;
|
|
143
|
|
144 /* Current depth in recursive edits. */
|
|
145 int command_loop_level;
|
|
146
|
|
147 /* Total number of times command_loop has read a key sequence. */
|
|
148 int num_input_keys;
|
|
149
|
|
150 /* Last input character read as a command. */
|
|
151 Lisp_Object last_command_char;
|
|
152
|
|
153 /* Last input character read for any purpose. */
|
|
154 Lisp_Object last_input_char;
|
|
155
|
|
156 /* If not Qnil, an object to be read as the next command input. */
|
|
157 Lisp_Object unread_command_char;
|
|
158
|
|
159 /* Char to use as prefix when a meta character is typed in.
|
|
160 This is bound on entry to minibuffer in case ESC is changed there. */
|
|
161
|
|
162 Lisp_Object meta_prefix_char;
|
|
163
|
|
164 /* Last size recorded for a current buffer which is not a minibuffer. */
|
|
165 static int last_non_minibuf_size;
|
|
166
|
|
167 /* Number of idle seconds before an auto-save. */
|
|
168 static Lisp_Object Vauto_save_timeout;
|
|
169
|
|
170 /* Total number of times read_char has returned. */
|
|
171 int num_input_chars;
|
|
172
|
|
173 /* Auto-save automatically when this many characters have been typed
|
|
174 since the last time. */
|
|
175
|
|
176 static int auto_save_interval;
|
|
177
|
|
178 /* Value of num_input_chars as of last auto save. */
|
|
179
|
|
180 int last_auto_save;
|
|
181
|
|
182 /* Last command executed by the editor command loop, not counting
|
|
183 commands that set the prefix argument. */
|
|
184
|
|
185 Lisp_Object last_command;
|
|
186
|
|
187 /* The command being executed by the command loop.
|
|
188 Commands may set this, and the value set will be copied into last_command
|
|
189 instead of the actual command. */
|
|
190 Lisp_Object this_command;
|
|
191
|
|
192 #ifndef HAVE_X11
|
|
193 /* Window of last mouse click. */
|
|
194 extern Lisp_Object Vmouse_window;
|
|
195
|
|
196 /* List containing details of last mouse click. */
|
|
197 extern Lisp_Object Vmouse_event;
|
|
198 #endif /* defined HAVE_X11 */
|
|
199
|
|
200 /* Hook to call on each mouse event after running its definition. */
|
|
201 Lisp_Object Vmouse_event_function;
|
|
202
|
|
203 /* Hook to call when mouse leaves screen. */
|
|
204 Lisp_Object Vmouse_left_hook;
|
|
205
|
|
206 /* Hook to call when a screen is mapped. */
|
|
207 Lisp_Object Vmap_screen_hook;
|
|
208
|
|
209 /* Hook to call when a screen is unmapped. */
|
|
210 Lisp_Object Vunmap_screen_hook;
|
|
211
|
|
212 /* Handler for non-grabbed (no keys depressed) mouse motion. */
|
|
213 Lisp_Object Vmouse_motion_handler;
|
|
214
|
|
215 /* The screen in which the last input event occurred.
|
|
216 command_loop_1 will select this screen before running the
|
|
217 command bound to an event sequence, and read_key_sequence will
|
|
218 toss the existing prefix if the user starts typing at a
|
|
219 new screen. */
|
|
220 Lisp_Object Vlast_event_screen;
|
|
221
|
|
222 /* X Windows wants this for selection ownership. */
|
|
223 unsigned long last_event_timestamp;
|
|
224
|
|
225 Lisp_Object Qself_insert_command;
|
|
226 Lisp_Object Qforward_char;
|
|
227 Lisp_Object Qbackward_char;
|
|
228
|
|
229 /* read_key_sequence stores here the command definition of the
|
|
230 key sequence that it reads. */
|
|
231 Lisp_Object read_key_sequence_cmd;
|
|
232
|
|
233 /* Form to evaluate (if non-nil) when Emacs is started. */
|
|
234 Lisp_Object Vtop_level;
|
|
235
|
|
236 /* User-supplied string to translate input characters through. */
|
|
237 Lisp_Object Vkeyboard_translate_table;
|
|
238
|
|
239 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
|
|
240 extern Lisp_Object Vfunction_key_map;
|
|
241
|
|
242 /* File in which we write all commands we read. */
|
|
243 FILE *dribble;
|
|
244
|
|
245 /* Nonzero if input is available. */
|
|
246 int input_pending;
|
|
247
|
|
248 /* Nonzero if should obey 0200 bit in input chars as "Meta". */
|
|
249 int meta_key;
|
|
250
|
|
251 extern char *pending_malloc_warning;
|
|
252
|
|
253 /* Circular buffer for pre-read keyboard input. */
|
|
254 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
|
|
255
|
|
256 /* Pointer to next available character in kbd_buffer.
|
|
257 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
|
|
258 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
|
|
259 next available char is in kbd_buffer[0]. */
|
|
260 static struct input_event *kbd_fetch_ptr;
|
|
261
|
|
262 /* Pointer to next place to store character in kbd_buffer. This
|
|
263 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
|
|
264 character should go in kbd_buffer[0]. */
|
|
265 static struct input_event *kbd_store_ptr;
|
|
266
|
|
267 /* The above pair of variables forms a "queue empty" flag. When we
|
|
268 enqueue a non-hook event, we increment kbd_write_count. When we
|
|
269 dequeue a non-hook event, we increment kbd_read_count. We say that
|
|
270 there is input available iff the two counters are equal.
|
|
271
|
|
272 Why not just have a flag set and cleared by the enqueuing and
|
|
273 dequeuing functions? Such a flag could be screwed up by interrupts
|
|
274 at inopportune times. */
|
|
275
|
|
276 /* If this flag is non-zero, mouse movement events will appear in the
|
|
277 input stream. If is zero, mouse movement will be ignored. */
|
|
278 int do_mouse_tracking;
|
|
279
|
|
280 /* The window system handling code should set this if the mouse has
|
|
281 moved since the last call to the mouse_position_hook. Calling that
|
|
282 hook should clear this. Code assumes that if this is set, it can
|
|
283 call mouse_position_hook to get the promised position, so don't set
|
|
284 it unless you're prepared to substantiate the claim! */
|
|
285 int mouse_moved;
|
|
286
|
|
287 /* True iff there is an event in kbd_buffer, or if mouse tracking is
|
|
288 enabled and there is a new mouse position in the mouse movement
|
|
289 buffer. Note that if this is false, that doesn't mean that there
|
|
290 is readable input; all the events in the queue might be button-up
|
|
291 events, and do_mouse_tracking might be off. */
|
|
292 #define EVENT_QUEUES_EMPTY \
|
|
293 ((kbd_fetch_ptr == kbd_store_ptr) && (!do_mouse_tracking || !mouse_moved))
|
|
294
|
|
295
|
|
296 /* Symbols to head events. */
|
|
297 Lisp_Object Qmouse_movement;
|
|
298
|
|
299 Lisp_Object Qvscrollbar_part;
|
|
300 Lisp_Object Qvslider_part;
|
|
301 Lisp_Object Qvthumbup_part;
|
|
302 Lisp_Object Qvthumbdown_part;
|
|
303
|
|
304 Lisp_Object Qhscrollbar_part;
|
|
305 Lisp_Object Qhslider_part;
|
|
306 Lisp_Object Qhthumbleft_part;
|
|
307 Lisp_Object Qhthumbright_part;
|
|
308
|
|
309 /* Symbols to denote kinds of events. */
|
|
310 Lisp_Object Qfunction_key;
|
|
311 Lisp_Object Qmouse_click;
|
|
312 /* Lisp_Object Qmouse_movement; - also an event header */
|
|
313 Lisp_Object Qscrollbar_click;
|
|
314
|
|
315 /* Properties of event headers. */
|
|
316 Lisp_Object Qevent_kind;
|
|
317 Lisp_Object Qevent_unmodified;
|
|
318
|
|
319 /* Symbols to use for non-text mouse positions. */
|
|
320 Lisp_Object Qmode_line;
|
|
321 Lisp_Object Qvertical_split;
|
|
322
|
|
323
|
|
324 /* Address (if not 0) of word to zero out if a SIGIO interrupt happens. */
|
|
325 long *input_available_clear_word;
|
|
326
|
|
327 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
|
|
328 Default is 1 if INTERRUPT_INPUT is defined. */
|
|
329 int interrupt_input;
|
|
330
|
|
331 /* Nonzero while interrupts are temporarily deferred during redisplay. */
|
|
332 int interrupts_deferred;
|
|
333
|
|
334 /* nonzero means use ^S/^Q for flow control. */
|
|
335 int flow_control;
|
|
336
|
|
337 #ifndef BSD4_1
|
|
338 #define sigfree() sigsetmask (SIGEMPTYMASK)
|
|
339 #define sigholdx(sig) sigsetmask (sigmask (sig))
|
|
340 #define sigblockx(sig) sigblock (sigmask (sig))
|
|
341 #define sigunblockx(sig) sigblock (SIGEMPTYMASK)
|
|
342 #define sigpausex(sig) sigpause (0)
|
|
343 #endif /* not BSD4_1 */
|
|
344
|
|
345 #ifdef BSD4_1
|
|
346 #define SIGIO SIGTINT
|
|
347 /* sigfree and sigholdx are in sysdep.c */
|
|
348 #define sigblockx(sig) sighold (sig)
|
|
349 #define sigunblockx(sig) sigrelse (sig)
|
|
350 #define sigpausex(sig) sigpause (sig)
|
|
351 #endif /* BSD4_1 */
|
|
352
|
|
353 /* Allow m- file to inhibit use of FIONREAD. */
|
|
354 #ifdef BROKEN_FIONREAD
|
|
355 #undef FIONREAD
|
|
356 #endif
|
|
357
|
|
358 /* We are unable to use interrupts if FIONREAD is not available,
|
|
359 so flush SIGIO so we won't try. */
|
|
360 #ifndef FIONREAD
|
|
361 #ifdef SIGIO
|
|
362 #undef SIGIO
|
|
363 #endif
|
|
364 #endif
|
|
365
|
|
366 /* If we support X Windows, and won't get an interrupt when input
|
|
367 arrives from the server, poll periodically so we can detect C-g. */
|
|
368 #ifdef HAVE_X_WINDOWS
|
|
369 #ifndef SIGIO
|
|
370 #define POLL_FOR_INPUT
|
|
371 #endif
|
|
372 #endif
|
|
373
|
|
374 /* Global variable declarations. */
|
|
375
|
|
376 /* Function for init_keyboard to call with no args (if nonzero). */
|
|
377 void (*keyboard_init_hook) ();
|
|
378
|
|
379 static int read_avail_input ();
|
|
380 static void get_input_pending ();
|
|
381
|
|
382 /* > 0 if we are to echo keystrokes. */
|
|
383 static int echo_keystrokes;
|
|
384
|
|
385 /* Nonzero means echo each character as typed. */
|
|
386 static int immediate_echo;
|
|
387
|
|
388 /* The text we're echoing in the modeline - partial key sequences,
|
|
389 usually. '\0'-terminated. */
|
|
390 static char echobuf[100];
|
|
391
|
|
392 /* Where to append more text to echobuf if we want to. */
|
|
393 static char *echoptr;
|
|
394
|
|
395 #define min(a,b) ((a)<(b)?(a):(b))
|
|
396 #define max(a,b) ((a)>(b)?(a):(b))
|
|
397
|
|
398 /* Install the string STR as the beginning of the string of echoing,
|
|
399 so that it serves as a prompt for the next character.
|
|
400 Also start echoing. */
|
|
401
|
|
402 echo_prompt (str)
|
|
403 char *str;
|
|
404 {
|
|
405 int len = strlen (str);
|
|
406 if (len > sizeof echobuf - 4)
|
|
407 len = sizeof echobuf - 4;
|
|
408 bcopy (str, echobuf, len + 1);
|
|
409 echoptr = echobuf + len;
|
|
410
|
|
411 echo ();
|
|
412 }
|
|
413
|
|
414 /* Add C to the echo string, if echoing is going on.
|
|
415 C can be a character, which is printed prettily ("M-C-x" and all that
|
|
416 jazz), or a symbol, whose name is printed. */
|
|
417
|
|
418 echo_char (c)
|
|
419 Lisp_Object c;
|
|
420 {
|
|
421 extern char *push_key_description ();
|
|
422
|
|
423 if (immediate_echo)
|
|
424 {
|
|
425 char *ptr = echoptr;
|
|
426
|
|
427 if (ptr != echobuf)
|
|
428 *ptr++ = ' ';
|
|
429
|
|
430 /* If someone has passed us a composite event, use its head symbol. */
|
|
431 if (EVENT_HAS_PARAMETERS (c))
|
|
432 c = EVENT_HEAD (c);
|
|
433
|
|
434 if (XTYPE (c) == Lisp_Int)
|
|
435 {
|
|
436 if (ptr - echobuf > sizeof echobuf - 6)
|
|
437 return;
|
|
438
|
|
439 ptr = push_key_description (c, ptr);
|
|
440 }
|
|
441 else if (XTYPE (c) == Lisp_Symbol)
|
|
442 {
|
|
443 struct Lisp_String *name = XSYMBOL (c)->name;
|
|
444 if (((ptr - echobuf) + name->size + 4) > sizeof echobuf)
|
|
445 return;
|
|
446 bcopy (name->data, ptr, name->size);
|
|
447 ptr += name->size;
|
|
448 }
|
|
449
|
|
450 if (echoptr == echobuf && c == help_char)
|
|
451 {
|
|
452 strcpy (ptr, " (Type ? for further options)");
|
|
453 ptr += strlen (ptr);
|
|
454 }
|
|
455
|
|
456 *ptr = 0;
|
|
457 echoptr = ptr;
|
|
458
|
|
459 echo ();
|
|
460 }
|
|
461 }
|
|
462
|
|
463 /* Temporarily add a dash to the end of the echo string if it's not
|
|
464 empty, so that it serves as a mini-prompt for the very next character. */
|
|
465
|
|
466 echo_dash ()
|
|
467 {
|
|
468 if (!immediate_echo && echoptr == echobuf)
|
|
469 return;
|
|
470
|
|
471 /* Put a dash at the end of the buffer temporarily,
|
|
472 but make it go away when the next character is added. */
|
|
473 echoptr[0] = '-';
|
|
474 echoptr[1] = 0;
|
|
475
|
|
476 echo ();
|
|
477 }
|
|
478
|
|
479 /* Display the current echo string, and begin echoing if not already
|
|
480 doing so. */
|
|
481
|
|
482 echo ()
|
|
483 {
|
|
484 if (!immediate_echo)
|
|
485 {
|
|
486 int i;
|
|
487 immediate_echo = 1;
|
|
488
|
|
489 for (i = 0; i < this_command_key_count; i++)
|
|
490 echo_char (this_command_keys[i]);
|
|
491 echo_dash ();
|
|
492 }
|
|
493
|
|
494 echoing = 1;
|
|
495 message1 (echobuf);
|
|
496 echoing = 0;
|
|
497
|
|
498 if (waiting_for_input && !NILP (Vquit_flag))
|
|
499 quit_throw_to_read_char ();
|
|
500 }
|
|
501
|
|
502 /* Turn off echoing, for the start of a new command. */
|
|
503
|
|
504 cancel_echoing ()
|
|
505 {
|
|
506 immediate_echo = 0;
|
|
507 echoptr = echobuf;
|
|
508 }
|
|
509
|
|
510 /* Return the length of the current echo string. */
|
|
511
|
|
512 static int
|
|
513 echo_length ()
|
|
514 {
|
|
515 return echoptr - echobuf;
|
|
516 }
|
|
517
|
|
518 /* Truncate the current echo message to its first LEN chars.
|
|
519 This and echo_char get used by read_key_sequence when the user
|
|
520 switches screens while entering a key sequence. */
|
|
521
|
|
522 static void
|
|
523 echo_truncate (len)
|
|
524 int len;
|
|
525 {
|
|
526 echobuf[len] = '\0';
|
|
527 echoptr = echobuf + strlen (echobuf);
|
|
528 }
|
|
529
|
|
530
|
|
531 /* Functions for manipulating this_command_keys. */
|
|
532 static void
|
|
533 add_command_key (key)
|
|
534 Lisp_Object key;
|
|
535 {
|
|
536 if (this_command_key_count == this_command_keys_size)
|
|
537 {
|
|
538 this_command_keys_size *= 2;
|
|
539 this_command_keys
|
|
540 = (Lisp_Object *) xrealloc (this_command_keys,
|
|
541 (this_command_keys_size
|
|
542 * sizeof (Lisp_Object)));
|
|
543 }
|
|
544 this_command_keys[this_command_key_count++] = key;
|
|
545 }
|
|
546
|
|
547 Lisp_Object
|
|
548 recursive_edit_1 ()
|
|
549 {
|
|
550 int count = specpdl_ptr - specpdl;
|
|
551 Lisp_Object val;
|
|
552
|
|
553 if (command_loop_level > 0)
|
|
554 {
|
|
555 specbind (Qstandard_output, Qt);
|
|
556 specbind (Qstandard_input, Qt);
|
|
557 }
|
|
558
|
|
559 val = command_loop ();
|
|
560 if (EQ (val, Qt))
|
|
561 Fsignal (Qquit, Qnil);
|
|
562
|
|
563 unbind_to (count);
|
|
564 return Qnil;
|
|
565 }
|
|
566
|
|
567 /* When an auto-save happens, record the "time", and don't do again soon. */
|
|
568 record_auto_save ()
|
|
569 {
|
|
570 last_auto_save = num_input_chars;
|
|
571 }
|
|
572
|
|
573 Lisp_Object recursive_edit_unwind (), command_loop ();
|
|
574
|
|
575 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
|
|
576 "Invoke the editor command loop recursively.\n\
|
|
577 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
|
|
578 that tells this function to return.\n\
|
|
579 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
|
|
580 This function is called by the editor initialization to begin editing.")
|
|
581 ()
|
|
582 {
|
|
583 int count = specpdl_ptr - specpdl;
|
|
584 Lisp_Object val;
|
|
585
|
|
586 command_loop_level++;
|
|
587 update_mode_lines = 1;
|
|
588
|
|
589 record_unwind_protect (recursive_edit_unwind,
|
|
590 (command_loop_level
|
|
591 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
|
|
592 ? Fcurrent_buffer ()
|
|
593 : Qnil);
|
|
594 recursive_edit_1 ();
|
|
595 return unbind_to (count, Qnil);
|
|
596 }
|
|
597
|
|
598 Lisp_Object
|
|
599 recursive_edit_unwind (buffer)
|
|
600 Lisp_Object buffer;
|
|
601 {
|
|
602 if (!NILP (buffer))
|
|
603 Fset_buffer (buffer);
|
|
604
|
|
605 command_loop_level--;
|
|
606 update_mode_lines = 1;
|
|
607 return Qnil;
|
|
608 }
|
|
609
|
|
610 Lisp_Object
|
|
611 cmd_error (data)
|
|
612 Lisp_Object data;
|
|
613 {
|
|
614 Lisp_Object errmsg, tail, errname, file_error;
|
|
615 Lisp_Object stream;
|
|
616 struct gcpro gcpro1;
|
|
617 int i;
|
|
618
|
|
619 Vquit_flag = Qnil;
|
|
620 Vinhibit_quit = Qt;
|
|
621 Vstandard_output = Qt;
|
|
622 Vstandard_input = Qt;
|
|
623 Vexecuting_macro = Qnil;
|
|
624 echo_area_glyphs = 0;
|
|
625
|
|
626 /* If the window system or terminal screen hasn't been initialized
|
|
627 yet, or we're not interactive, it's best to dump this message out
|
|
628 to stderr and exit. */
|
|
629 if (! SCREEN_MESSAGE_BUF (selected_screen)
|
|
630 || noninteractive)
|
|
631 stream = Qexternal_debugging_output;
|
|
632 else
|
|
633 {
|
|
634 Fdiscard_input ();
|
|
635 bitch_at_user ();
|
|
636 stream = Qt;
|
|
637 }
|
|
638
|
|
639 errname = Fcar (data);
|
|
640
|
|
641 if (EQ (errname, Qerror))
|
|
642 {
|
|
643 data = Fcdr (data);
|
|
644 if (!CONSP (data)) data = Qnil;
|
|
645 errmsg = Fcar (data);
|
|
646 file_error = Qnil;
|
|
647 }
|
|
648 else
|
|
649 {
|
|
650 errmsg = Fget (errname, Qerror_message);
|
|
651 file_error = Fmemq (Qfile_error,
|
|
652 Fget (errname, Qerror_conditions));
|
|
653 }
|
|
654
|
|
655 /* Print an error message including the data items.
|
|
656 This is done by printing it into a scratch buffer
|
|
657 and then making a copy of the text in the buffer. */
|
|
658
|
|
659 if (!CONSP (data)) data = Qnil;
|
|
660 tail = Fcdr (data);
|
|
661 GCPRO1 (tail);
|
|
662
|
|
663 /* For file-error, make error message by concatenating
|
|
664 all the data items. They are all strings. */
|
|
665 if (!NILP (file_error) && !NILP (tail))
|
|
666 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
|
|
667
|
|
668 if (XTYPE (errmsg) == Lisp_String)
|
|
669 Fprinc (errmsg, stream);
|
|
670 else
|
|
671 write_string_1 ("peculiar error", -1, stream);
|
|
672
|
|
673 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
|
|
674 {
|
|
675 write_string_1 (i ? ", " : ": ", 2, stream);
|
|
676 if (!NILP (file_error))
|
|
677 Fprinc (Fcar (tail), stream);
|
|
678 else
|
|
679 Fprin1 (Fcar (tail), stream);
|
|
680 }
|
|
681 UNGCPRO;
|
|
682
|
|
683 /* If the window system or terminal screen hasn't been initialized
|
|
684 yet, or we're in -batch mode, this error should cause Emacs to exit. */
|
|
685 if (! SCREEN_MESSAGE_BUF (selected_screen)
|
|
686 || noninteractive)
|
|
687 {
|
|
688 Fterpri (stream);
|
|
689 Fkill_emacs (make_number (-1));
|
|
690 }
|
|
691
|
|
692 Vquit_flag = Qnil;
|
|
693
|
|
694 Vinhibit_quit = Qnil;
|
|
695 return make_number (0);
|
|
696 }
|
|
697
|
|
698 Lisp_Object command_loop_1 ();
|
|
699 Lisp_Object command_loop_2 ();
|
|
700 Lisp_Object top_level_1 ();
|
|
701
|
|
702 /* Entry to editor-command-loop.
|
|
703 This level has the catches for exiting/returning to editor command loop.
|
|
704 It returns nil to exit recursive edit, t to abort it. */
|
|
705
|
|
706 Lisp_Object
|
|
707 command_loop ()
|
|
708 {
|
|
709 if (command_loop_level > 0 || minibuf_level > 0)
|
|
710 {
|
|
711 return internal_catch (Qexit, command_loop_2, Qnil);
|
|
712 }
|
|
713 else
|
|
714 while (1)
|
|
715 {
|
|
716 internal_catch (Qtop_level, top_level_1, Qnil);
|
|
717 internal_catch (Qtop_level, command_loop_2, Qnil);
|
|
718
|
|
719 /* End of file in -batch run causes exit here. */
|
|
720 if (noninteractive)
|
|
721 Fkill_emacs (Qt);
|
|
722 }
|
|
723 }
|
|
724
|
|
725 /* Here we catch errors in execution of commands within the
|
|
726 editing loop, and reenter the editing loop.
|
|
727 When there is an error, cmd_error runs and returns a non-nil
|
|
728 value to us. A value of nil means that cmd_loop_1 itself
|
|
729 returned due to end of file (or end of kbd macro). */
|
|
730
|
|
731 Lisp_Object
|
|
732 command_loop_2 ()
|
|
733 {
|
|
734 register Lisp_Object val;
|
|
735
|
|
736 do
|
|
737 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
|
|
738 while (!NILP (val));
|
|
739
|
|
740 return Qnil;
|
|
741 }
|
|
742
|
|
743 Lisp_Object
|
|
744 top_level_2 ()
|
|
745 {
|
|
746 return Feval (Vtop_level);
|
|
747 }
|
|
748
|
|
749 Lisp_Object
|
|
750 top_level_1 ()
|
|
751 {
|
|
752 /* On entry to the outer level, run the startup file */
|
|
753 if (!NILP (Vtop_level))
|
|
754 internal_condition_case (top_level_2, Qerror, cmd_error);
|
|
755 else if (!NILP (Vpurify_flag))
|
|
756 message ("Bare impure Emacs (standard Lisp code not loaded)");
|
|
757 else
|
|
758 message ("Bare Emacs (standard Lisp code not loaded)");
|
|
759 return Qnil;
|
|
760 }
|
|
761
|
|
762 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
|
|
763 "Exit all recursive editing levels.")
|
|
764 ()
|
|
765 {
|
|
766 Fthrow (Qtop_level, Qnil);
|
|
767 }
|
|
768
|
|
769 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
|
|
770 "Exit from the innermost recursive edit or minibuffer.")
|
|
771 ()
|
|
772 {
|
|
773 if (command_loop_level > 0 || minibuf_level > 0)
|
|
774 Fthrow (Qexit, Qnil);
|
|
775
|
|
776 error ("No recursive edit is in progress");
|
|
777 }
|
|
778
|
|
779 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
|
|
780 "Abort the command that requested this recursive edit or minibuffer input.")
|
|
781 ()
|
|
782 {
|
|
783 if (command_loop_level > 0 || minibuf_level > 0)
|
|
784 Fthrow (Qexit, Qt);
|
|
785
|
|
786 error ("No recursive edit is in progress");
|
|
787 }
|
|
788
|
|
789 /* This is the actual command reading loop,
|
|
790 sans error-handling encapsulation. */
|
|
791
|
|
792 Lisp_Object Fcommand_execute ();
|
|
793 static int read_key_sequence ();
|
|
794
|
|
795 Lisp_Object
|
|
796 command_loop_1 ()
|
|
797 {
|
|
798 Lisp_Object cmd;
|
|
799 int lose;
|
|
800 int nonundocount;
|
|
801 Lisp_Object keybuf[30];
|
|
802 int i;
|
|
803 int no_redisplay;
|
|
804 int no_direct;
|
|
805
|
|
806 Vprefix_arg = Qnil;
|
|
807 waiting_for_input = 0;
|
|
808 cancel_echoing ();
|
|
809
|
|
810 /* Don't clear out last_command at the beginning of a macro. */
|
|
811 if (XTYPE (Vexecuting_macro) != Lisp_String)
|
|
812 last_command = Qt;
|
|
813
|
|
814 nonundocount = 0;
|
|
815 no_redisplay = 0;
|
|
816 this_command_key_count = 0;
|
|
817
|
|
818 while (1)
|
|
819 {
|
|
820 /* Install chars successfully executed in kbd macro. */
|
|
821
|
|
822 if (defining_kbd_macro && NILP (Vprefix_arg))
|
|
823 finalize_kbd_macro_chars ();
|
|
824
|
|
825 /* Make sure the current window's buffer is selected. */
|
|
826 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
|
|
827 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
|
|
828
|
|
829 /* Display any malloc warning that just came out. Use while because
|
|
830 displaying one warning can cause another. */
|
|
831
|
|
832 while (pending_malloc_warning)
|
|
833 display_malloc_warning ();
|
|
834
|
|
835 no_direct = 0;
|
|
836
|
|
837 /* If minibuffer on and echo area in use,
|
|
838 wait 2 sec and redraw minibufer. */
|
|
839
|
|
840 if (minibuf_level && echo_area_glyphs)
|
|
841 {
|
|
842 Fsit_for (make_number (2), Qnil, Qnil);
|
|
843 echo_area_glyphs = 0;
|
|
844 no_direct = 1;
|
|
845 if (!NILP (Vquit_flag))
|
|
846 {
|
|
847 Vquit_flag = Qnil;
|
|
848 unread_command_char = make_number (quit_char);
|
|
849 }
|
|
850 }
|
|
851
|
|
852 #ifdef C_ALLOCA
|
|
853 alloca (0); /* Cause a garbage collection now */
|
|
854 /* Since we can free the most stuff here. */
|
|
855 #endif /* C_ALLOCA */
|
|
856
|
|
857 /* Read next key sequence; i gets its length. */
|
|
858 i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), 0);
|
|
859
|
|
860 ++num_input_keys;
|
|
861
|
|
862 #ifdef MULTI_SCREEN
|
|
863 /* Select the screen that the key sequence came from. */
|
|
864 if (XTYPE (Vlast_event_screen) == Lisp_Screen
|
|
865 && XSCREEN (Vlast_event_screen) != selected_screen)
|
|
866 Fselect_screen (Vlast_event_screen, Qnil);
|
|
867 #endif
|
|
868
|
|
869 /* Now we have read a key sequence of length I,
|
|
870 or else I is 0 and we found end of file. */
|
|
871
|
|
872 if (i == 0) /* End of file -- happens only in */
|
|
873 return Qnil; /* a kbd macro, at the end. */
|
|
874
|
|
875 #if 0
|
|
876 #ifdef HAVE_X_WINDOWS
|
|
877 if (SCREEN_IS_X (selected_screen))
|
|
878 {
|
|
879 if (i == -1) /* Mouse event */
|
|
880 {
|
|
881 nonundocount = 0;
|
|
882 if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
|
|
883 !EQ (minibuf_window, selected_window))
|
|
884 Fundo_boundary ();
|
|
885
|
|
886 if (defining_kbd_macro)
|
|
887 {
|
|
888 /* Be nice if this worked... */
|
|
889 }
|
|
890 Fexecute_mouse_event (read_key_sequence_cmd);
|
|
891 no_redisplay = 0;
|
|
892 goto directly_done;
|
|
893 }
|
|
894
|
|
895 if (i == -2) /* Lisp Symbol */
|
|
896 {
|
|
897 nonundocount = 0;
|
|
898 if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
|
|
899 !EQ (minibuf_window, selected_window))
|
|
900 Fundo_boundary ();
|
|
901
|
|
902 goto directly_done;
|
|
903 }
|
|
904 }
|
|
905 #endif /* HAVE_X_WINDOWS */
|
|
906 #endif
|
|
907
|
|
908 last_command_char = keybuf[i - 1];
|
|
909
|
|
910 cmd = read_key_sequence_cmd;
|
|
911 if (!NILP (Vexecuting_macro))
|
|
912 {
|
|
913 if (!NILP (Vquit_flag))
|
|
914 {
|
|
915 Vexecuting_macro = Qt;
|
|
916 QUIT; /* Make some noise. */
|
|
917 /* Will return since macro now empty. */
|
|
918 }
|
|
919 }
|
|
920
|
|
921 /* Do redisplay processing after this command except in special
|
|
922 cases identified below that set no_redisplay to 1. */
|
|
923 no_redisplay = 0;
|
|
924
|
|
925 /* Execute the command. */
|
|
926
|
|
927 if (NILP (cmd))
|
|
928 {
|
|
929 /* nil means key is undefined. */
|
|
930 bitch_at_user ();
|
|
931 defining_kbd_macro = 0;
|
|
932 update_mode_lines = 1;
|
|
933 Vprefix_arg = Qnil;
|
|
934 }
|
|
935 else
|
|
936 {
|
|
937 this_command = cmd;
|
|
938 if (NILP (Vprefix_arg) && ! no_direct)
|
|
939 {
|
|
940 /* Recognize some common commands in common situations and
|
|
941 do them directly. */
|
|
942 if (EQ (cmd, Qforward_char) && point < ZV)
|
|
943 {
|
|
944 struct Lisp_Vector *dp
|
|
945 = window_display_table (XWINDOW (selected_window));
|
|
946 lose = FETCH_CHAR (point);
|
|
947 SET_PT (point + 1);
|
|
948 if (((dp == 0 && lose >= 040 && lose < 0177)
|
|
949 ||
|
|
950 (dp && (XTYPE (dp->contents[lose]) != Lisp_String
|
|
951 || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
|
|
952 && (XFASTINT (XWINDOW (selected_window)->last_modified)
|
|
953 >= MODIFF)
|
|
954 && (XFASTINT (XWINDOW (selected_window)->last_point)
|
|
955 == point - 1)
|
|
956 && !windows_or_buffers_changed
|
|
957 && EQ (current_buffer->selective_display, Qnil)
|
|
958 && !detect_input_pending ()
|
|
959 && NILP (Vexecuting_macro))
|
|
960 no_redisplay = direct_output_forward_char (1);
|
|
961 goto directly_done;
|
|
962 }
|
|
963 else if (EQ (cmd, Qbackward_char) && point > BEGV)
|
|
964 {
|
|
965 struct Lisp_Vector *dp
|
|
966 = window_display_table (XWINDOW (selected_window));
|
|
967 SET_PT (point - 1);
|
|
968 lose = FETCH_CHAR (point);
|
|
969 if (((dp == 0 && lose >= 040 && lose < 0177)
|
|
970 ||
|
|
971 (dp && (XTYPE (dp->contents[lose]) != Lisp_String
|
|
972 || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
|
|
973 && (XFASTINT (XWINDOW (selected_window)->last_modified)
|
|
974 >= MODIFF)
|
|
975 && (XFASTINT (XWINDOW (selected_window)->last_point)
|
|
976 == point + 1)
|
|
977 && !windows_or_buffers_changed
|
|
978 && EQ (current_buffer->selective_display, Qnil)
|
|
979 && !detect_input_pending ()
|
|
980 && NILP (Vexecuting_macro))
|
|
981 no_redisplay = direct_output_forward_char (-1);
|
|
982 goto directly_done;
|
|
983 }
|
|
984 else if (EQ (cmd, Qself_insert_command)
|
|
985 /* Try this optimization only on ascii keystrokes. */
|
|
986 && XTYPE (last_command_char) == Lisp_Int)
|
|
987 {
|
|
988 unsigned char c = XINT (last_command_char);
|
|
989
|
|
990 if (NILP (Vexecuting_macro) &&
|
|
991 !EQ (minibuf_window, selected_window))
|
|
992 {
|
|
993 if (!nonundocount || nonundocount >= 20)
|
|
994 {
|
|
995 Fundo_boundary ();
|
|
996 nonundocount = 0;
|
|
997 }
|
|
998 nonundocount++;
|
|
999 }
|
|
1000 lose = (XFASTINT (XWINDOW (selected_window)->last_modified)
|
|
1001 < MODIFF)
|
|
1002 || (XFASTINT (XWINDOW (selected_window)->last_point)
|
|
1003 != point)
|
|
1004 || MODIFF <= current_buffer->save_modified
|
|
1005 || windows_or_buffers_changed
|
|
1006 || !EQ (current_buffer->selective_display, Qnil)
|
|
1007 || detect_input_pending ()
|
|
1008 || !NILP (Vexecuting_macro);
|
|
1009 if (internal_self_insert (c, 0))
|
|
1010 {
|
|
1011 lose = 1;
|
|
1012 nonundocount = 0;
|
|
1013 }
|
|
1014 if (!lose &&
|
|
1015 (point == ZV || FETCH_CHAR (point) == '\n'))
|
|
1016 {
|
|
1017 struct Lisp_Vector *dp
|
|
1018 = window_display_table (XWINDOW (selected_window));
|
|
1019
|
|
1020 if (dp == 0 || XTYPE (dp->contents[c]) != Lisp_String)
|
|
1021 no_redisplay = direct_output_for_insert (c);
|
|
1022 else if (XSTRING (dp->contents[c])->size
|
|
1023 == sizeof (GLYPH))
|
|
1024 no_redisplay =
|
|
1025 direct_output_for_insert (*(GLYPH *)XSTRING (dp->contents[c])->data);
|
|
1026 }
|
|
1027 goto directly_done;
|
|
1028 }
|
|
1029 }
|
|
1030
|
|
1031 /* Here for a command that isn't executed directly */
|
|
1032
|
|
1033 nonundocount = 0;
|
|
1034 if (NILP (Vprefix_arg))
|
|
1035 Fundo_boundary ();
|
|
1036 Fcommand_execute (cmd, Qnil);
|
|
1037
|
|
1038 }
|
547
|
1039 directly_done: ;
|
518
|
1040
|
|
1041 /* If there is a prefix argument,
|
|
1042 1) We don't want last_command to be ``universal-argument''
|
|
1043 (that would be dumb), so don't set last_command,
|
|
1044 2) we want to leave echoing on so that the prefix will be
|
|
1045 echoed as part of this key sequence, so don't call
|
|
1046 cancel_echoing, and
|
|
1047 3) we want to leave this_command_key_count non-zero, so that
|
|
1048 read_char will realize that it is re-reading a character, and
|
|
1049 not echo it a second time. */
|
|
1050 if (NILP (Vprefix_arg))
|
|
1051 {
|
|
1052 last_command = this_command;
|
|
1053 cancel_echoing ();
|
|
1054 this_command_key_count = 0;
|
|
1055 }
|
|
1056 }
|
|
1057 }
|
|
1058
|
|
1059 /* Number of seconds between polling for input. */
|
|
1060 int polling_period;
|
|
1061
|
|
1062 /* Nonzero means polling for input is temporarily suppresed. */
|
|
1063 int poll_suppress_count;
|
|
1064
|
|
1065 #ifdef POLL_FOR_INPUT
|
|
1066 int polling_for_input;
|
|
1067
|
|
1068 /* Handle an alarm once each second and read pending input
|
|
1069 so as to handle a C-g if it comces in. */
|
|
1070
|
|
1071 SIGTYPE
|
|
1072 input_poll_signal ()
|
|
1073 {
|
|
1074 #ifdef HAVE_X_WINDOWS
|
|
1075 extern int x_input_blocked;
|
|
1076 if (x_input_blocked == 0)
|
|
1077 #endif
|
|
1078 if (!waiting_for_input)
|
|
1079 read_avail_input (0);
|
|
1080 signal (SIGALRM, input_poll_signal);
|
|
1081 alarm (polling_period);
|
|
1082 }
|
|
1083
|
|
1084 #endif
|
|
1085
|
|
1086 /* Begin signals to poll for input, if they are appropriate.
|
|
1087 This function is called unconditionally from various places. */
|
|
1088
|
|
1089 start_polling ()
|
|
1090 {
|
|
1091 #ifdef POLL_FOR_INPUT
|
|
1092 if (read_socket_hook)
|
|
1093 {
|
|
1094 poll_suppress_count--;
|
|
1095 if (poll_suppress_count == 0)
|
|
1096 {
|
|
1097 signal (SIGALRM, input_poll_signal);
|
|
1098 polling_for_input = 1;
|
|
1099 alarm (polling_period);
|
|
1100 }
|
|
1101 }
|
|
1102 #endif
|
|
1103 }
|
|
1104
|
|
1105 /* Turn off polling. */
|
|
1106
|
|
1107 stop_polling ()
|
|
1108 {
|
|
1109 #ifdef POLL_FOR_INPUT
|
|
1110 if (read_socket_hook)
|
|
1111 {
|
|
1112 if (poll_suppress_count == 0)
|
|
1113 {
|
|
1114 polling_for_input = 0;
|
|
1115 alarm (0);
|
|
1116 }
|
|
1117 poll_suppress_count++;
|
|
1118 }
|
|
1119 #endif
|
|
1120 }
|
|
1121
|
|
1122 /* Input of single characters from keyboard */
|
|
1123
|
|
1124 Lisp_Object print_help ();
|
|
1125 static Lisp_Object kbd_buffer_get_event ();
|
|
1126
|
|
1127 /* read a character from the keyboard; call the redisplay if needed */
|
|
1128 /* commandflag 0 means do not do auto-saving, but do do redisplay.
|
|
1129 -1 means do not do redisplay, but do do autosaving.
|
|
1130 1 means do both. */
|
|
1131
|
|
1132 Lisp_Object
|
|
1133 read_char (commandflag)
|
|
1134 int commandflag;
|
|
1135 {
|
|
1136 register Lisp_Object c;
|
|
1137 int count;
|
|
1138 jmp_buf save_jump;
|
|
1139
|
|
1140 if (!NILP (unread_command_char))
|
|
1141 {
|
|
1142 c = unread_command_char;
|
|
1143 unread_command_char = Qnil;
|
|
1144
|
|
1145 #if 0 /* We're not handling mouse keys specially anymore. */
|
|
1146 if (!EQ (XTYPE (obj), Lisp_Int)) /* Mouse thing */
|
|
1147 {
|
|
1148 num_input_chars++;
|
|
1149 last_input_char = 0;
|
|
1150 return obj;
|
|
1151 }
|
|
1152 #endif
|
|
1153
|
|
1154 if (this_command_key_count == 0)
|
|
1155 goto reread_first;
|
|
1156 else
|
|
1157 goto reread;
|
|
1158 }
|
|
1159
|
|
1160 if (!NILP (Vexecuting_macro))
|
|
1161 {
|
|
1162 if (executing_macro_index >= Flength (Vexecuting_macro))
|
|
1163 {
|
|
1164 XSET (c, Lisp_Int, -1);
|
|
1165 return c;
|
|
1166 }
|
|
1167
|
|
1168 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
|
|
1169 executing_macro_index++;
|
|
1170
|
|
1171 goto from_macro;
|
|
1172 }
|
|
1173
|
|
1174 /* Save outer setjmp data, in case called recursively. */
|
|
1175 bcopy (getcjmp, save_jump, sizeof getcjmp);
|
|
1176
|
|
1177 stop_polling ();
|
|
1178
|
|
1179 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
|
|
1180 redisplay ();
|
|
1181
|
|
1182 if (_setjmp (getcjmp))
|
|
1183 {
|
|
1184 XSET (c, Lisp_Int, quit_char);
|
|
1185
|
|
1186 /* Returning quit_char from this function represents a
|
|
1187 resolution to the quit request, so clear the quit flag.
|
|
1188 This prevents us from returning quit_char many times
|
|
1189 for the same quit request. */
|
|
1190 Vquit_flag = Qnil;
|
|
1191
|
|
1192 waiting_for_input = 0;
|
|
1193 input_available_clear_word = 0;
|
|
1194
|
|
1195 goto non_reread;
|
|
1196 }
|
|
1197
|
|
1198 /* Message turns off echoing unless more keystrokes turn it on again. */
|
|
1199 if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != echobuf)
|
|
1200 cancel_echoing ();
|
|
1201 else
|
|
1202 /* If already echoing, continue. */
|
|
1203 echo_dash ();
|
|
1204
|
|
1205 /* If in middle of key sequence and minibuffer not active,
|
|
1206 start echoing if enough time elapses. */
|
|
1207 if (minibuf_level == 0 && !immediate_echo && this_command_key_count > 0
|
|
1208 && echo_keystrokes > 0
|
|
1209 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
|
|
1210 {
|
|
1211 Lisp_Object tem0;
|
|
1212
|
|
1213 tem0 = Fsit_for (make_number (echo_keystrokes), Qnil, Qt);
|
|
1214 if (EQ (tem0, Qt))
|
|
1215 echo ();
|
|
1216 }
|
|
1217
|
|
1218 /* Maybe auto save due to number of keystrokes or idle time. */
|
|
1219
|
|
1220 if (commandflag != 0
|
|
1221 && auto_save_interval > 0
|
|
1222 && num_input_chars - last_auto_save > max (auto_save_interval, 20)
|
|
1223 && !detect_input_pending ())
|
|
1224 {
|
|
1225 jmp_buf temp;
|
|
1226 save_getcjmp (temp);
|
|
1227 Fdo_auto_save (Qnil, Qnil);
|
|
1228 restore_getcjmp (temp);
|
|
1229 }
|
|
1230
|
|
1231 /* Slow down auto saves logarithmically in size of current buffer,
|
|
1232 and garbage collect while we're at it. */
|
|
1233 {
|
|
1234 int delay_level, buffer_size;
|
|
1235
|
|
1236 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
|
|
1237 last_non_minibuf_size = Z - BEG;
|
|
1238 buffer_size = (last_non_minibuf_size >> 8) + 1;
|
|
1239 delay_level = 0;
|
|
1240 while (buffer_size > 64)
|
|
1241 delay_level++, buffer_size -= buffer_size >> 2;
|
|
1242 if (delay_level < 4) delay_level = 4;
|
|
1243 /* delay_level is 4 for files under around 50k, 7 at 100k,
|
|
1244 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
|
|
1245
|
|
1246 /* Auto save if enough time goes by without input. */
|
|
1247 if (commandflag != 0
|
|
1248 && num_input_chars > last_auto_save
|
|
1249 && XTYPE (Vauto_save_timeout) == Lisp_Int
|
|
1250 && XINT (Vauto_save_timeout) > 0)
|
|
1251 {
|
|
1252 Lisp_Object tem0;
|
|
1253 int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
|
|
1254 tem0 = Fsit_for (make_number (delay), Qnil, Qt);
|
|
1255 if (EQ (tem0, Qt))
|
|
1256 {
|
|
1257 jmp_buf temp;
|
|
1258 save_getcjmp (temp);
|
|
1259 Fdo_auto_save (Qnil, Qnil);
|
|
1260 restore_getcjmp (temp);
|
|
1261
|
|
1262 /* If we have auto-saved and there is still no input
|
|
1263 available, garbage collect if there has been enough
|
|
1264 consing going on to make it worthwhile. */
|
|
1265 if (!detect_input_pending ()
|
|
1266 && consing_since_gc > gc_cons_threshold / 2)
|
|
1267 Fgarbage_collect ();
|
|
1268 }
|
|
1269 }
|
|
1270 }
|
|
1271
|
|
1272 /* Actually read a character, waiting if necessary. */
|
|
1273 c = kbd_buffer_get_event ();
|
|
1274
|
|
1275 if (NILP (c))
|
|
1276 abort (); /* Don't think this can happen. */
|
|
1277
|
|
1278 #if 0 /* I think that all the different kinds of events should be
|
|
1279 handled together now... */
|
|
1280 if (XTYPE (c) != Lisp_Int)
|
|
1281 {
|
|
1282 start_polling ();
|
|
1283 return c;
|
|
1284 }
|
|
1285 c = XINT (obj);
|
|
1286 #endif
|
|
1287
|
|
1288 /* Terminate Emacs in batch mode if at eof. */
|
|
1289 if (noninteractive && c < 0)
|
|
1290 Fkill_emacs (make_number (1));
|
|
1291
|
|
1292 non_reread:
|
|
1293
|
|
1294 bcopy (save_jump, getcjmp, sizeof getcjmp);
|
|
1295
|
|
1296 start_polling ();
|
|
1297
|
|
1298 echo_area_glyphs = 0;
|
|
1299
|
|
1300 /* Handle things that only apply to characters. */
|
|
1301 if (XTYPE (c) == Lisp_Int)
|
|
1302 {
|
|
1303 /* If kbd_buffer_get_event gave us an EOF, return that. */
|
|
1304 if (XINT (c) < 0)
|
|
1305 return c;
|
|
1306
|
|
1307 /* Strip the high bits, and maybe the meta bit too. */
|
|
1308 XSETINT (c, c & (meta_key ? 0377 : 0177));
|
|
1309
|
|
1310 if (XTYPE (Vkeyboard_translate_table) == Lisp_String
|
|
1311 && XSTRING (Vkeyboard_translate_table)->size > XINT (c))
|
|
1312 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[c]);
|
|
1313 }
|
|
1314
|
|
1315 total_keys++;
|
|
1316 recent_keys[recent_keys_index] = c;
|
|
1317 if (++recent_keys_index >= (sizeof (recent_keys)/sizeof(recent_keys[0])))
|
|
1318 recent_keys_index = 0;
|
|
1319
|
|
1320 /* Write c to the dribble file. If c is a lispy event, write
|
|
1321 the event's symbol to the dribble file, in <brackets>. Bleaugh.
|
|
1322 If you, dear reader, have a better idea, you've got the source. :-) */
|
|
1323 if (dribble)
|
|
1324 {
|
|
1325 if (XTYPE (c) == Lisp_Int)
|
|
1326 putc (c, dribble);
|
|
1327 else
|
|
1328 {
|
|
1329 Lisp_Object dribblee = c;
|
|
1330
|
|
1331 /* If it's a structured event, take the event header. */
|
|
1332 if (EVENT_HAS_PARAMETERS (dribblee))
|
|
1333 dribblee = EVENT_HEAD (dribblee);
|
|
1334
|
|
1335 if (XTYPE (c) == Lisp_Symbol)
|
|
1336 {
|
|
1337 putc ('<', dribble);
|
|
1338 fwrite (XSYMBOL (c)->name->data, sizeof (char),
|
|
1339 XSYMBOL (c)->name->size,
|
|
1340 dribble);
|
|
1341 putc ('>', dribble);
|
|
1342 }
|
|
1343 }
|
|
1344
|
|
1345 fflush (dribble);
|
|
1346 }
|
|
1347
|
|
1348 store_kbd_macro_char (c);
|
|
1349
|
|
1350 from_macro:
|
|
1351 reread_first:
|
|
1352 echo_char (c);
|
|
1353
|
|
1354 /* Record this character as part of the current key. */
|
|
1355 add_command_key (c);
|
|
1356
|
|
1357 /* Re-reading in the middle of a command */
|
|
1358 reread:
|
|
1359 last_input_char = c;
|
|
1360 num_input_chars++;
|
|
1361
|
|
1362 /* Process the help character specially if enabled */
|
|
1363 if (EQ (c, help_char) && !NILP (Vhelp_form))
|
|
1364 {
|
|
1365 Lisp_Object tem0;
|
|
1366 count = specpdl_ptr - specpdl;
|
|
1367
|
|
1368 record_unwind_protect (Fset_window_configuration,
|
|
1369 Fcurrent_window_configuration (Qnil));
|
|
1370
|
|
1371 tem0 = Feval (Vhelp_form);
|
|
1372 if (XTYPE (tem0) == Lisp_String)
|
|
1373 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
|
|
1374
|
|
1375 cancel_echoing ();
|
|
1376 c = read_char (0);
|
|
1377 /* Remove the help from the screen */
|
|
1378 unbind_to (count, Qnil);
|
|
1379 redisplay ();
|
|
1380 if (EQ (c, make_number (040)))
|
|
1381 {
|
|
1382 cancel_echoing ();
|
|
1383 c = read_char (0);
|
|
1384 }
|
|
1385 }
|
|
1386
|
|
1387 return c;
|
|
1388 }
|
|
1389
|
|
1390 Lisp_Object
|
|
1391 print_help (object)
|
|
1392 Lisp_Object object;
|
|
1393 {
|
|
1394 Fprinc (object, Qnil);
|
|
1395 return Qnil;
|
|
1396 }
|
|
1397
|
|
1398 /* Copy out or in the info on where C-g should throw to.
|
|
1399 This is used when running Lisp code from within get_char,
|
|
1400 in case get_char is called recursively.
|
|
1401 See read_process_output. */
|
|
1402
|
|
1403 save_getcjmp (temp)
|
|
1404 jmp_buf temp;
|
|
1405 {
|
|
1406 bcopy (getcjmp, temp, sizeof getcjmp);
|
|
1407 }
|
|
1408
|
|
1409 restore_getcjmp (temp)
|
|
1410 jmp_buf temp;
|
|
1411 {
|
|
1412 bcopy (temp, getcjmp, sizeof getcjmp);
|
|
1413 }
|
|
1414
|
|
1415
|
|
1416 /* Low level keyboard/mouse input.
|
|
1417 kbd_buffer_store_event places events in kbd_buffer, and
|
|
1418 kbd_buffer_get_event retrieves them.
|
|
1419 mouse_moved indicates when the mouse has moved again, and
|
|
1420 *mouse_position_hook provides the mouse position. */
|
|
1421
|
|
1422 /* Set this for debugging, to have a way to get out */
|
|
1423 int stop_character;
|
|
1424
|
|
1425 extern int screen_garbaged;
|
|
1426
|
|
1427 /* Return true iff there are any events in the queue that read-char
|
|
1428 would return. If this returns false, a read-char would block. */
|
|
1429 static int
|
|
1430 readable_events ()
|
|
1431 {
|
|
1432 struct input_event *ep;
|
|
1433
|
|
1434 if (EVENT_QUEUES_EMPTY)
|
|
1435 return 0;
|
|
1436
|
|
1437 if (do_mouse_tracking)
|
|
1438 return 1;
|
|
1439
|
|
1440 /* Mouse tracking is disabled, so we need to actually scan the
|
|
1441 input queue to see if any events are currently readable. */
|
|
1442 for (ep = kbd_fetch_ptr; ep != kbd_store_ptr; ep++)
|
|
1443 {
|
|
1444 if (ep == kbd_buffer + KBD_BUFFER_SIZE)
|
|
1445 ep = kbd_buffer;
|
|
1446
|
|
1447 /* Skip button-up events. */
|
|
1448 if ((ep->kind == mouse_click || ep->kind == scrollbar_click)
|
|
1449 && (ep->modifiers & up_modifier))
|
|
1450 continue;
|
|
1451
|
|
1452 return 1;
|
|
1453 }
|
|
1454
|
|
1455 return 0;
|
|
1456 }
|
|
1457
|
|
1458
|
|
1459 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
|
|
1460 of this function. */
|
|
1461 static Lisp_Object
|
|
1462 tracking_off (old_value)
|
|
1463 Lisp_Object old_value;
|
|
1464 {
|
|
1465 if (! XFASTINT (old_value))
|
|
1466 {
|
|
1467 do_mouse_tracking = 0;
|
|
1468
|
|
1469 /* Redisplay may have been preempted because there was input
|
|
1470 available, and it assumes it will be called again after the
|
|
1471 input has been processed. If the only input available was
|
|
1472 the sort that we have just disabled, then we need to call
|
|
1473 redisplay. */
|
|
1474 if (!readable_events ())
|
|
1475 {
|
|
1476 redisplay_preserve_echo_area ();
|
|
1477 get_input_pending (&input_pending);
|
|
1478 }
|
|
1479 }
|
|
1480 }
|
|
1481
|
|
1482 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
|
|
1483 "Evaluate BODY with mouse movement and button release events enabled.\n\
|
|
1484 Within a track-mouse, read-event reports mouse movement and button releases;\n\
|
|
1485 otherwise, they are ignored.")
|
|
1486 (args)
|
|
1487 Lisp_Object args;
|
|
1488 {
|
|
1489 int count = specpdl_ptr - specpdl;
|
|
1490 Lisp_Object val;
|
|
1491
|
|
1492 XSET (val, Lisp_Int, do_mouse_tracking);
|
|
1493 record_unwind_protect (tracking_off, val);
|
|
1494
|
|
1495 do_mouse_tracking = 1;
|
|
1496
|
|
1497 val = Fprogn (args);
|
|
1498 return unbind_to (count, val);
|
|
1499 }
|
|
1500
|
|
1501 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
|
|
1502
|
|
1503 void
|
|
1504 kbd_buffer_store_event (event)
|
|
1505 register struct input_event *event;
|
|
1506 {
|
|
1507 if (event->kind == no_event)
|
|
1508 abort ();
|
|
1509
|
|
1510 if (event->kind == ascii_keystroke)
|
|
1511 {
|
|
1512 register int c = XFASTINT (event->code) & 0377;
|
|
1513
|
|
1514 if (c == quit_char
|
|
1515 || ((c == (0200 | quit_char)) && !meta_key))
|
|
1516 {
|
|
1517 /* If this results in a quit_char being returned to Emacs as
|
|
1518 input, set last-event-screen properly. If this doesn't
|
|
1519 get returned to Emacs as an event, the next event read
|
|
1520 will set Vlast_event_screen again, so this is safe to do. */
|
|
1521 extern SIGTYPE interrupt_signal ();
|
|
1522 XSET (Vlast_event_screen, Lisp_Screen, event->screen);
|
|
1523 last_event_timestamp = XINT (event->timestamp);
|
|
1524 interrupt_signal ();
|
|
1525 return;
|
|
1526 }
|
|
1527
|
|
1528 if (c && c == stop_character)
|
|
1529 {
|
|
1530 sys_suspend ();
|
|
1531 return;
|
|
1532 }
|
|
1533
|
|
1534 XSET (event->code, Lisp_Int, c);
|
|
1535 }
|
|
1536
|
|
1537 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
|
|
1538 kbd_store_ptr = kbd_buffer;
|
|
1539
|
|
1540 /* Don't let the very last slot in the buffer become full,
|
|
1541 since that would make the two pointers equal,
|
|
1542 and that is indistinguishable from an empty buffer.
|
|
1543 Discard the event if it would fill the last slot. */
|
|
1544 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
|
|
1545 {
|
|
1546 kbd_store_ptr->kind = event->kind;
|
|
1547 kbd_store_ptr->code = event->code;
|
|
1548 kbd_store_ptr->part = event->part;
|
|
1549 kbd_store_ptr->screen = event->screen;
|
|
1550 kbd_store_ptr->modifiers = event->modifiers;
|
|
1551 kbd_store_ptr->x = event->x;
|
|
1552 kbd_store_ptr->y = event->y;
|
|
1553 kbd_store_ptr->timestamp = event->timestamp;
|
|
1554
|
|
1555 kbd_store_ptr++;
|
|
1556 }
|
|
1557 }
|
|
1558
|
|
1559 static Lisp_Object make_lispy_event ();
|
|
1560 static Lisp_Object make_lispy_movement ();
|
|
1561 static Lisp_Object modify_event_symbol ();
|
|
1562
|
|
1563 static Lisp_Object
|
|
1564 kbd_buffer_get_event ()
|
|
1565 {
|
|
1566 register int c;
|
|
1567 Lisp_Object obj;
|
|
1568
|
|
1569 if (noninteractive)
|
|
1570 {
|
|
1571 c = getchar ();
|
|
1572 XSET (obj, Lisp_Int, c);
|
|
1573 return obj;
|
|
1574 }
|
|
1575
|
|
1576 /* Wait until there is input available. */
|
|
1577 for (;;)
|
|
1578 {
|
|
1579
|
|
1580 /* Process or toss any events that we don't want to return as
|
|
1581 input. The fact that we remove undesirable events here
|
|
1582 allows us to use EVENT_QUEUES_EMPTY in the rest of this loop. */
|
|
1583 if (! do_mouse_tracking)
|
|
1584 while (kbd_fetch_ptr != kbd_store_ptr)
|
|
1585 {
|
|
1586 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
|
|
1587 kbd_fetch_ptr = kbd_buffer;
|
|
1588
|
|
1589 if (kbd_fetch_ptr->kind == mouse_click
|
|
1590 || kbd_fetch_ptr->kind == scrollbar_click)
|
|
1591 {
|
|
1592 if ((kbd_fetch_ptr->modifiers & up_modifier) == 0)
|
|
1593 break;
|
|
1594 }
|
|
1595 else
|
|
1596 break;
|
|
1597
|
|
1598 kbd_fetch_ptr++;
|
|
1599 }
|
|
1600
|
|
1601 if (!EVENT_QUEUES_EMPTY)
|
|
1602 break;
|
|
1603
|
|
1604 /* If the quit flag is set, then read_char will return
|
|
1605 quit_char, so that counts as "available input." */
|
|
1606 if (!NILP (Vquit_flag))
|
|
1607 quit_throw_to_read_char ();
|
|
1608
|
|
1609 /* One way or another, wait until input is available; then, if
|
|
1610 interrupt handlers have not read it, read it now. */
|
|
1611
|
|
1612 #ifdef OLDVMS
|
|
1613 wait_for_kbd_input ();
|
|
1614 #else
|
|
1615 /* Note SIGIO has been undef'd if FIONREAD is missing. */
|
|
1616 #ifdef SIGIO
|
|
1617 gobble_input (0);
|
|
1618 #endif /* SIGIO */
|
|
1619 if (EVENT_QUEUES_EMPTY)
|
|
1620 {
|
|
1621 #ifdef subprocesses
|
|
1622 wait_reading_process_input (0, 0, -1, 1);
|
|
1623 #else
|
|
1624 /* Note SIGIO has been undef'd if FIONREAD is missing. */
|
|
1625 #ifdef SIGIO
|
|
1626 if (interrupt_input)
|
|
1627 {
|
|
1628 sigblockx (SIGIO);
|
|
1629 set_waiting_for_input (0);
|
|
1630 while (EVENT_QUEUES_EMPTY)
|
|
1631 sigpausex (SIGIO);
|
|
1632 clear_waiting_for_input ();
|
|
1633 sigunblockx (SIGIO);
|
|
1634 }
|
|
1635 #else
|
|
1636 interrupt_input = 0;
|
|
1637 #endif /* not SIGIO */
|
|
1638 #endif /* subprocesses */
|
|
1639
|
|
1640 if (!interrupt_input && EVENT_QUEUES_EMPTY)
|
|
1641 {
|
|
1642 read_avail_input (0);
|
|
1643 }
|
|
1644 }
|
|
1645 #endif /* not VMS */
|
|
1646 }
|
|
1647
|
|
1648 /* At this point, we know that there is a readable event available
|
|
1649 somewhere. If the event queue is empty, then there must be a
|
|
1650 mouse movement enabled and available. */
|
|
1651 if (kbd_fetch_ptr != kbd_store_ptr)
|
|
1652 {
|
|
1653 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
|
|
1654 kbd_fetch_ptr = kbd_buffer;
|
|
1655 XSET (Vlast_event_screen, Lisp_Screen, kbd_fetch_ptr->screen);
|
|
1656 last_event_timestamp = XINT (kbd_fetch_ptr->timestamp);
|
|
1657 obj = make_lispy_event (kbd_fetch_ptr);
|
|
1658 kbd_fetch_ptr->kind = no_event;
|
|
1659 kbd_fetch_ptr++;
|
|
1660 if (XTYPE (obj) == Lisp_Int)
|
|
1661 XSET (obj, Lisp_Int, XINT (obj) & (meta_key ? 0377 : 0177));
|
|
1662 }
|
|
1663 else if (do_mouse_tracking && mouse_moved)
|
|
1664 {
|
|
1665 SCREEN_PTR screen;
|
|
1666 Lisp_Object x, y, time;
|
|
1667
|
|
1668 (*mouse_position_hook) (&screen, &x, &y, &time);
|
|
1669 XSET (Vlast_event_screen, Lisp_Screen, screen);
|
|
1670
|
|
1671 obj = make_lispy_movement (screen, x, y, time);
|
|
1672 }
|
|
1673 else
|
|
1674 /* We were promised by the above while loop that there was
|
|
1675 something for us to read! */
|
|
1676 abort ();
|
|
1677
|
|
1678 input_pending = readable_events ();
|
|
1679
|
|
1680 return (obj);
|
|
1681 }
|
|
1682
|
|
1683 /* Caches for modify_event_symbol. */
|
|
1684 static Lisp_Object func_key_syms;
|
|
1685 static Lisp_Object mouse_syms;
|
|
1686
|
|
1687 /* You'll notice that this table is arranged to be conveniently
|
|
1688 indexed by X Windows keysym values. */
|
|
1689 static char *lispy_function_keys[] =
|
|
1690 {
|
|
1691 /* X Keysym value */
|
|
1692
|
|
1693 "home", /* 0xff50 */ /* IsCursorKey */
|
|
1694 "left",
|
|
1695 "up",
|
|
1696 "right",
|
|
1697 "down",
|
|
1698 "prior",
|
|
1699 "next",
|
|
1700 "end",
|
|
1701 "begin",
|
|
1702 0, /* 0xff59 */
|
|
1703 0, 0, 0, 0, 0, 0,
|
|
1704 "select", /* 0xff60 */ /* IsMiscFunctionKey */
|
|
1705 "print",
|
|
1706 "execute",
|
|
1707 "insert",
|
|
1708 0, /* 0xff64 */
|
|
1709 "undo",
|
|
1710 "redo",
|
|
1711 "menu",
|
|
1712 "find",
|
|
1713 "cancel",
|
|
1714 "help",
|
|
1715 "break", /* 0xff6b */
|
|
1716
|
|
1717 /* Here are some keys found mostly on HP keyboards. The X event
|
|
1718 handling code will strip bit 29, which flags vendor-specific
|
|
1719 keysyms. */
|
|
1720 "reset", /* 0x1000ff6c */
|
|
1721 "system",
|
|
1722 "user",
|
|
1723 "clearline",
|
|
1724 "insertline",
|
|
1725 "deleteline",
|
|
1726 "insertchar",
|
|
1727 "deletechar",
|
|
1728 "backtab",
|
|
1729 "kp_backtab", /* 0x1000ff75 */
|
|
1730 0, /* 0xff76 */
|
|
1731 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff7f */
|
|
1732 "kp-space", /* 0xff80 */ /* IsKeypadKey */
|
|
1733 0, 0, 0, 0, 0, 0, 0, 0,
|
|
1734 "kp-tab", /* 0xff89 */
|
|
1735 0, 0, 0,
|
|
1736 "kp-enter", /* 0xff8d */
|
|
1737 0, 0, 0,
|
|
1738 "kp-f1", /* 0xff91 */
|
|
1739 "kp-f2",
|
|
1740 "kp-f3",
|
|
1741 "kp-f4",
|
|
1742 0, /* 0xff95 */
|
|
1743 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
1744 "kp-multiply", /* 0xffaa */
|
|
1745 "kp-add",
|
|
1746 "kp-separator",
|
|
1747 "kp-subtract",
|
|
1748 "kp-decimal",
|
|
1749 "kp-divide", /* 0xffaf */
|
|
1750 "kp-0", /* 0xffb0 */
|
|
1751 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
|
|
1752 0, /* 0xffba */
|
|
1753 0, 0,
|
|
1754 "kp-equal", /* 0xffbd */
|
|
1755 "f1", /* 0xffbe */ /* IsFunctionKey */
|
|
1756 "f2", "f3", "f4",
|
|
1757 "f5", "f6", "f7", "f8", "f9", "f10", "f11", "f12",
|
|
1758 "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20",
|
|
1759 "f21", "f22", "f23", "f24", "f25", "f26", "f27", "f28",
|
|
1760 "f29", "f30", "f31", "f32", "f33", "f34", "f35" /* 0xffe0 */
|
|
1761 };
|
|
1762
|
|
1763 static char *lispy_mouse_names[] =
|
|
1764 {
|
|
1765 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
|
|
1766 };
|
|
1767
|
|
1768 /* Given a struct input_event, build the lisp event which represents
|
|
1769 it. If EVENT is 0, build a mouse movement event from the mouse
|
|
1770 movement buffer, which should have a movement event in it. */
|
|
1771
|
|
1772 static Lisp_Object
|
|
1773 make_lispy_event (event)
|
|
1774 struct input_event *event;
|
|
1775 {
|
|
1776 #ifdef SWITCH_ENUM_BUG
|
|
1777 switch ((int) event->kind)
|
|
1778 #else
|
|
1779 switch (event->kind)
|
|
1780 #endif
|
|
1781 {
|
|
1782
|
|
1783 /* A simple keystroke. */
|
|
1784 case ascii_keystroke:
|
|
1785 return event->code;
|
|
1786 break;
|
|
1787
|
|
1788 /* A function key. The symbol may need to have modifier prefixes
|
|
1789 tacked onto it. */
|
|
1790 case non_ascii_keystroke:
|
|
1791 return modify_event_symbol (XFASTINT (event->code), event->modifiers,
|
|
1792 Qfunction_key,
|
|
1793 lispy_function_keys, &func_key_syms,
|
|
1794 (sizeof (lispy_function_keys)
|
|
1795 / sizeof (lispy_function_keys[0])));
|
|
1796 break;
|
|
1797
|
|
1798 /* A mouse click - build a list of the relevant information. */
|
|
1799 case mouse_click:
|
|
1800 {
|
|
1801 int part;
|
|
1802 Lisp_Object window =
|
|
1803 window_from_coordinates (event->screen,
|
|
1804 XINT (event->x), XINT (event->y),
|
|
1805 &part);
|
|
1806 Lisp_Object posn;
|
|
1807
|
|
1808 if (XTYPE (window) != Lisp_Window)
|
|
1809 posn = Qnil;
|
|
1810 else
|
|
1811 {
|
|
1812 XSETINT (event->x, (XINT (event->x)
|
|
1813 - XINT (XWINDOW (window)->left)));
|
|
1814 XSETINT (event->y, (XINT (event->y)
|
|
1815 - XINT (XWINDOW (window)->top)));
|
|
1816
|
|
1817 if (part == 1)
|
|
1818 posn = Qmode_line;
|
|
1819 else if (part == 2)
|
|
1820 posn = Qvertical_split;
|
|
1821 else
|
|
1822 XSET (posn, Lisp_Int,
|
|
1823 buffer_posn_from_coords (XWINDOW (window),
|
|
1824 XINT (event->x),
|
|
1825 XINT (event->y)));
|
|
1826 }
|
|
1827
|
|
1828 return Fcons (modify_event_symbol (XFASTINT (event->code) - 1,
|
|
1829 event->modifiers,
|
|
1830 Qmouse_click,
|
|
1831 lispy_mouse_names, &mouse_syms,
|
|
1832 (sizeof (lispy_mouse_names)
|
|
1833 / sizeof (lispy_mouse_names[0]))),
|
|
1834 Fcons (window,
|
|
1835 Fcons (posn,
|
|
1836 Fcons (Fcons (event->x, event->y),
|
|
1837 Fcons (event->timestamp,
|
|
1838 Qnil)))));
|
|
1839 }
|
|
1840
|
|
1841 /* A scrollbar click. Build a list containing the relevant
|
|
1842 information. */
|
|
1843 case scrollbar_click:
|
|
1844 {
|
|
1845 Lisp_Object button
|
|
1846 = modify_event_symbol (XFASTINT (event->code) - 1,
|
|
1847 event->modifiers,
|
|
1848 Qmouse_click,
|
|
1849 lispy_mouse_names, &mouse_syms,
|
|
1850 (sizeof (lispy_mouse_names)
|
|
1851 / sizeof (lispy_mouse_names[0])));
|
|
1852 return Fcons (event->part,
|
|
1853 Fcons (SCREEN_SELECTED_WINDOW (event->screen),
|
|
1854 Fcons (button,
|
|
1855 Fcons (Fcons (event->x, event->y),
|
|
1856 Fcons (event->timestamp,
|
|
1857 Qnil)))));
|
|
1858 }
|
|
1859
|
|
1860 /* The 'kind' field of the event is something we don't recognize. */
|
|
1861 default:
|
|
1862 abort();
|
|
1863 }
|
|
1864 }
|
|
1865
|
|
1866 static Lisp_Object
|
|
1867 make_lispy_movement (screen, x, y, time)
|
|
1868 SCREEN_PTR screen;
|
|
1869 Lisp_Object x, y;
|
|
1870 Lisp_Object time;
|
|
1871 {
|
|
1872 Lisp_Object window;
|
|
1873 int ix, iy;
|
|
1874 Lisp_Object posn;
|
|
1875 int part;
|
|
1876
|
|
1877 ix = XINT (x);
|
|
1878 iy = XINT (y);
|
|
1879 window = (screen
|
|
1880 ? window_from_coordinates (screen, ix, iy, &part)
|
|
1881 : Qnil);
|
|
1882 if (XTYPE (window) != Lisp_Window)
|
|
1883 posn = Qnil;
|
|
1884 else
|
|
1885 {
|
|
1886 ix -= XINT (XWINDOW (window)->left);
|
|
1887 iy -= XINT (XWINDOW (window)->top);
|
|
1888 if (part == 1)
|
|
1889 posn = Qmode_line;
|
|
1890 else if (part == 2)
|
|
1891 posn = Qvertical_split;
|
|
1892 else
|
|
1893 XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window),
|
|
1894 ix, iy));
|
|
1895 }
|
|
1896
|
|
1897 XSETINT (x, ix);
|
|
1898 XSETINT (y, iy);
|
|
1899 return Fcons (Qmouse_movement,
|
|
1900 Fcons (window,
|
|
1901 Fcons (posn,
|
|
1902 Fcons (Fcons (x, y),
|
|
1903 Fcons (time, Qnil)))));
|
|
1904 }
|
|
1905
|
|
1906
|
|
1907
|
|
1908 /* Place the written representation of MODIFIERS in BUF, '\0'-terminated,
|
|
1909 and return its length. */
|
|
1910
|
|
1911 static int
|
|
1912 format_modifiers (modifiers, buf)
|
|
1913 int modifiers;
|
|
1914 char *buf;
|
|
1915 {
|
|
1916 char *p = buf;
|
|
1917
|
|
1918 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
|
|
1919 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
|
|
1920 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
|
|
1921 if (modifiers & up_modifier) { *p++ = 'U'; *p++ = '-'; }
|
|
1922 *p = '\0';
|
|
1923
|
|
1924 return p - buf;
|
|
1925 }
|
|
1926
|
|
1927
|
|
1928 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
|
|
1929 return a symbol with the modifiers placed in the canonical order.
|
|
1930
|
|
1931 Fdefine_key calls this to make sure that (for example) C-M-foo
|
|
1932 and M-C-foo end up being equivalent in the keymap. */
|
|
1933
|
|
1934 Lisp_Object
|
|
1935 reorder_modifiers (symbol)
|
|
1936 Lisp_Object symbol;
|
|
1937 {
|
|
1938 struct Lisp_String *name;
|
|
1939 int i;
|
|
1940 int modifiers;
|
|
1941 int not_canonical;
|
|
1942
|
|
1943 CHECK_SYMBOL (symbol, 1);
|
|
1944
|
|
1945 modifiers = 0;
|
|
1946 name = XSYMBOL (symbol)->name;
|
|
1947
|
|
1948 /* Special case for things with only one modifier, which is
|
|
1949 (hopefully) the vast majority of cases. */
|
|
1950 if (! (name->size >= 4 && name->data[1] == '-' && name->data[3] == '-'))
|
|
1951 return symbol;
|
|
1952
|
|
1953 for (i = 0; i + 1 < name->size && name->data[i + 1] == '-'; i += 2)
|
|
1954 switch (name->data[i])
|
|
1955 {
|
|
1956 case 'M':
|
|
1957 not_canonical |= (modifiers & (meta_modifier|ctrl_modifier
|
|
1958 |shift_modifier|up_modifier));
|
|
1959 modifiers |= meta_modifier;
|
|
1960 break;
|
|
1961
|
|
1962 case 'C':
|
|
1963 not_canonical |= (modifiers &
|
|
1964 (ctrl_modifier|shift_modifier|up_modifier));
|
|
1965 modifiers |= ctrl_modifier;
|
|
1966 break;
|
|
1967
|
|
1968 case 'S':
|
|
1969 not_canonical |= (modifiers & (shift_modifier|up_modifier));
|
|
1970 modifiers |= shift_modifier;
|
|
1971 break;
|
|
1972
|
|
1973 case 'U':
|
|
1974 not_canonical |= (modifiers & (up_modifier));
|
|
1975 modifiers |= up_modifier;
|
|
1976 break;
|
|
1977
|
|
1978 default:
|
|
1979 goto no_more_modifiers;
|
|
1980 }
|
|
1981 no_more_modifiers:
|
|
1982
|
|
1983 if (!not_canonical)
|
|
1984 return symbol;
|
|
1985
|
|
1986 /* The modifiers were out of order, so find a new symbol with the
|
|
1987 mods in order. Since the symbol name could contain nulls, we can't
|
|
1988 use intern here; we have to use Fintern, which expects a genuine
|
|
1989 Lisp_String, and keeps a reference to it. */
|
|
1990 {
|
|
1991 char *new_mods = (char *) alloca (sizeof ("C-M-S-U-"));
|
|
1992 int len = format_modifiers (modifiers, new_mods);
|
|
1993 Lisp_Object new_name = make_uninit_string (len + name->size - i);
|
|
1994
|
|
1995 bcopy (new_mods, XSTRING (new_name)->data, len);
|
|
1996 bcopy (name->data + i, XSTRING (new_name)->data + len, name->size - i);
|
|
1997
|
|
1998 return Fintern (new_name, Qnil);
|
|
1999 }
|
|
2000 }
|
|
2001
|
|
2002
|
|
2003 /* For handling events, we often want to produce a symbol whose name
|
|
2004 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
|
|
2005 to some base, like the name of a function key or mouse button.
|
|
2006 modify_event_symbol produces symbols of this sort.
|
|
2007
|
|
2008 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
|
|
2009 is the name of the i'th symbol. TABLE_SIZE is the number of elements
|
|
2010 in the table.
|
|
2011
|
|
2012 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
|
|
2013 persist between calls to modify_event_symbol that it can use to
|
|
2014 store a cache of the symbols it's generated for this NAME_TABLE
|
|
2015 before.
|
|
2016
|
|
2017 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
|
|
2018
|
|
2019 MODIFIERS is a set of modifier bits (as given in struct input_events)
|
|
2020 whose prefixes should be applied to the symbol name.
|
|
2021
|
|
2022 SYMBOL_KIND is the value to be placed in the event_kind property of
|
|
2023 the returned symbol. */
|
|
2024
|
|
2025 static Lisp_Object
|
|
2026 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table,
|
|
2027 symbol_table, table_size)
|
|
2028 int symbol_num;
|
|
2029 unsigned modifiers;
|
|
2030 Lisp_Object symbol_kind;
|
|
2031 char **name_table;
|
|
2032 Lisp_Object *symbol_table;
|
|
2033 int table_size;
|
|
2034 {
|
|
2035 Lisp_Object *slot, *unmodified_slot;
|
|
2036
|
|
2037 /* Is this a request for a valid symbol? */
|
|
2038 if (symbol_num < 0 || symbol_num >= table_size
|
|
2039 || modifiers >= NUM_MODIFIER_COMBOS)
|
|
2040 abort ();
|
|
2041
|
|
2042 /* If *symbol_table is not a vector of the appropriate size,
|
|
2043 set it to one. */
|
|
2044 if (XTYPE (*symbol_table) != Lisp_Vector
|
|
2045 || XVECTOR (*symbol_table)->size != table_size)
|
|
2046 *symbol_table = Fmake_vector (make_number (table_size), Qnil);
|
|
2047
|
|
2048 unmodified_slot = slot = & XVECTOR (*symbol_table)->contents[symbol_num];
|
|
2049
|
|
2050 /* If there are modifier keys, there had better be a vector in
|
|
2051 this symbol's position of the symbol_table. */
|
|
2052 if (modifiers != 0)
|
|
2053 {
|
|
2054 Lisp_Object slot_contents = *slot;
|
|
2055
|
|
2056 /* If there isn't the right sort of vector there, put one in. */
|
|
2057 if (XTYPE (slot_contents) != Lisp_Vector
|
|
2058 || XVECTOR (slot_contents)->size != NUM_MODIFIER_COMBOS)
|
|
2059 {
|
|
2060 *slot = Fmake_vector (make_number (NUM_MODIFIER_COMBOS), Qnil);
|
|
2061
|
|
2062 /* Make sure that the vector has an entry for the unmodified
|
|
2063 symbol, so we can put it on the event_unmodified property. */
|
|
2064 if (! NILP (slot_contents))
|
|
2065 XVECTOR (*slot)->contents[0] = slot_contents;
|
|
2066 else
|
|
2067 XVECTOR (*slot)->contents[0] = intern (name_table [symbol_num]);
|
|
2068 }
|
|
2069 }
|
|
2070
|
|
2071 /* If this entry has been filled in with a modified symbol vector,
|
|
2072 point to the appropriate slot within that. */
|
|
2073 if (XTYPE (*slot) == Lisp_Vector)
|
|
2074 {
|
|
2075 unmodified_slot = & XVECTOR (*slot)->contents[0];
|
|
2076 slot = & XVECTOR (*slot)->contents[modifiers];
|
|
2077 }
|
|
2078
|
|
2079 /* Make sure we have an unmodified version of the symbol in its
|
|
2080 proper place? */
|
|
2081 if (NILP (*unmodified_slot))
|
|
2082 {
|
|
2083 *unmodified_slot = intern (name_table [symbol_num]);
|
|
2084 Fput (*unmodified_slot, Qevent_kind, symbol_kind);
|
|
2085 Fput (*unmodified_slot, Qevent_unmodified, *unmodified_slot);
|
|
2086 }
|
|
2087
|
|
2088 /* Have we already created a symbol for this combination of modifiers? */
|
|
2089 if (NILP (*slot))
|
|
2090 {
|
|
2091 /* No, let's create one. */
|
|
2092 char *modified_name
|
|
2093 = (char *) alloca (sizeof ("C-M-S-U-")
|
|
2094 + strlen (name_table [symbol_num]));
|
|
2095
|
|
2096 strcpy (modified_name + format_modifiers (modifiers, modified_name),
|
|
2097 name_table [symbol_num]);
|
|
2098
|
|
2099 *slot = intern (modified_name);
|
|
2100 Fput (*slot, Qevent_kind, symbol_kind);
|
|
2101 Fput (*slot, Qevent_unmodified, *unmodified_slot);
|
|
2102 }
|
|
2103
|
|
2104 return *slot;
|
|
2105 }
|
|
2106
|
|
2107 DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0,
|
|
2108 "Return non-nil iff OBJECT is a representation of a mouse event.\n\
|
|
2109 A mouse event is a list of five elements whose car is a symbol of the\n\
|
|
2110 form <MODIFIERS>mouse-<DIGIT>. I hope this is a temporary hack.")
|
|
2111 (object)
|
|
2112 Lisp_Object object;
|
|
2113 {
|
|
2114 if (EVENT_HAS_PARAMETERS (object)
|
|
2115 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)),
|
|
2116 Qmouse_click))
|
|
2117 return Qt;
|
|
2118 else
|
|
2119 return Qnil;
|
|
2120 }
|
|
2121
|
|
2122 /* Store into *addr a value nonzero if terminal input chars are available.
|
|
2123 Serves the purpose of ioctl (0, FIONREAD, addr)
|
|
2124 but works even if FIONREAD does not exist.
|
|
2125 (In fact, this may actually read some input.) */
|
|
2126
|
|
2127 static void
|
|
2128 get_input_pending (addr)
|
|
2129 int *addr;
|
|
2130 {
|
|
2131 /* First of all, have we already counted some input? */
|
|
2132 *addr = !NILP (Vquit_flag) || readable_events ();
|
|
2133
|
|
2134 /* If input is being read as it arrives, and we have none, there is none. */
|
|
2135 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
|
|
2136 return;
|
|
2137
|
|
2138 /* Try to read some input and see how much we get. */
|
|
2139 gobble_input (0);
|
|
2140 *addr = !NILP (Vquit_flag) || readable_events ();
|
|
2141 }
|
|
2142
|
|
2143 /* Interface to read_avail_input, blocking SIGIO if necessary. */
|
|
2144
|
|
2145 int
|
|
2146 gobble_input (expected)
|
|
2147 int expected;
|
|
2148 {
|
|
2149 #ifndef VMS
|
|
2150 #ifdef SIGIO
|
|
2151 if (interrupt_input)
|
|
2152 {
|
|
2153 SIGMASKTYPE mask = sigblockx (SIGIO);
|
|
2154 read_avail_input (expected);
|
|
2155 sigsetmask (mask);
|
|
2156 }
|
|
2157 else
|
|
2158 #endif
|
|
2159 read_avail_input (expected);
|
|
2160 #endif
|
|
2161 }
|
|
2162
|
|
2163 #ifndef VMS
|
|
2164
|
|
2165 /* Read any terminal input already buffered up by the system
|
|
2166 into the kbd_buffer, but do not wait.
|
|
2167
|
|
2168 EXPECTED should be nonzero if the caller knows there is some input.
|
|
2169
|
|
2170 Except on VMS, all input is read by this function.
|
|
2171 If interrupt_input is nonzero, this function MUST be called
|
|
2172 only when SIGIO is blocked.
|
|
2173
|
|
2174 Returns the number of keyboard chars read, or -1 meaning
|
|
2175 this is a bad time to try to read input. */
|
|
2176
|
|
2177 static int
|
|
2178 read_avail_input (expected)
|
|
2179 int expected;
|
|
2180 {
|
|
2181 struct input_event buf[KBD_BUFFER_SIZE];
|
|
2182 register int i;
|
|
2183 int nread;
|
|
2184
|
|
2185 if (read_socket_hook)
|
|
2186 /* No need for FIONREAD or fcntl; just say don't wait. */
|
|
2187 nread = (*read_socket_hook) (0, buf, KBD_BUFFER_SIZE, expected, expected);
|
|
2188 else
|
|
2189 {
|
|
2190 unsigned char cbuf[KBD_BUFFER_SIZE];
|
|
2191
|
|
2192 #ifdef FIONREAD
|
|
2193 /* Find out how much input is available. */
|
|
2194 if (ioctl (0, FIONREAD, &nread) < 0)
|
|
2195 /* Formerly simply reported no input, but that sometimes led to
|
|
2196 a failure of Emacs to terminate.
|
|
2197 SIGHUP seems appropriate if we can't reach the terminal. */
|
|
2198 kill (getpid (), SIGHUP);
|
|
2199 if (nread == 0)
|
|
2200 return 0;
|
|
2201 if (nread > sizeof cbuf)
|
|
2202 nread = sizeof cbuf;
|
|
2203 #else /* no FIONREAD */
|
|
2204 #ifdef USG
|
|
2205 /* Read some input if available, but don't wait. */
|
|
2206 nread = sizeof cbuf;
|
|
2207 fcntl (fileno (stdin), F_SETFL, O_NDELAY);
|
|
2208 #else
|
|
2209 you lose;
|
|
2210 #endif
|
|
2211 #endif
|
|
2212
|
|
2213 /* Now read; for one reason or another, this will not block. */
|
|
2214 while (1)
|
|
2215 {
|
|
2216 nread = read (fileno (stdin), cbuf, nread);
|
|
2217 #ifdef AIX
|
|
2218 /* The kernel sometimes fails to deliver SIGHUP for ptys.
|
|
2219 This looks incorrect, but it isn't, because _BSD causes
|
|
2220 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
|
|
2221 and that causes a value other than 0 when there is no input. */
|
|
2222 if (nread == 0)
|
|
2223 kill (SIGHUP, 0);
|
|
2224 #endif
|
|
2225 /* Retry the read if it is interrupted. */
|
|
2226 if (nread >= 0
|
|
2227 || ! (errno == EAGAIN || errno == EFAULT
|
|
2228 #ifdef EBADSLT
|
|
2229 || errno == EBADSLT
|
|
2230 #endif
|
|
2231 ))
|
|
2232 break;
|
|
2233 }
|
|
2234
|
|
2235 #ifndef FIONREAD
|
|
2236 #ifdef USG
|
|
2237 fcntl (fileno (stdin), F_SETFL, 0);
|
|
2238 #endif /* USG */
|
|
2239 #endif /* no FIONREAD */
|
|
2240 for (i = 0; i < nread; i++)
|
|
2241 {
|
|
2242 buf[i].kind = ascii_keystroke;
|
|
2243 XSET (buf[i].code, Lisp_Int, cbuf[i]);
|
|
2244 buf[i].screen = selected_screen;
|
|
2245 }
|
|
2246 }
|
|
2247
|
|
2248 /* Scan the chars for C-g and store them in kbd_buffer. */
|
|
2249 for (i = 0; i < nread; i++)
|
|
2250 {
|
|
2251 kbd_buffer_store_event (&buf[i]);
|
|
2252 /* Don't look at input that follows a C-g too closely.
|
|
2253 This reduces lossage due to autorepeat on C-g. */
|
|
2254 if (buf[i].kind == ascii_keystroke
|
|
2255 && XINT(buf[i].code) == quit_char)
|
|
2256 break;
|
|
2257 }
|
|
2258
|
|
2259 return nread;
|
|
2260 }
|
|
2261 #endif /* not VMS */
|
|
2262
|
|
2263 #ifdef SIGIO /* for entire page */
|
|
2264 /* Note SIGIO has been undef'd if FIONREAD is missing. */
|
|
2265
|
|
2266 input_available_signal (signo)
|
|
2267 int signo;
|
|
2268 {
|
|
2269 /* Must preserve main program's value of errno. */
|
|
2270 int old_errno = errno;
|
|
2271 #ifdef BSD4_1
|
|
2272 extern int select_alarmed;
|
|
2273 #endif
|
|
2274
|
|
2275 #ifdef USG
|
|
2276 /* USG systems forget handlers when they are used;
|
|
2277 must reestablish each time */
|
|
2278 signal (signo, input_available_signal);
|
|
2279 #endif /* USG */
|
|
2280
|
|
2281 #ifdef BSD4_1
|
|
2282 sigisheld (SIGIO);
|
|
2283 #endif
|
|
2284
|
|
2285 if (input_available_clear_word)
|
|
2286 *input_available_clear_word = 0;
|
|
2287
|
|
2288 while (1)
|
|
2289 {
|
|
2290 int nread;
|
|
2291 nread = read_avail_input (1);
|
|
2292 /* -1 means it's not ok to read the input now.
|
|
2293 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
|
|
2294 0 means there was no keyboard input available. */
|
|
2295 if (nread <= 0)
|
|
2296 break;
|
|
2297
|
|
2298 #ifdef BSD4_1
|
|
2299 select_alarmed = 1; /* Force the select emulator back to life */
|
|
2300 #endif
|
|
2301 }
|
|
2302
|
|
2303 #ifdef BSD4_1
|
|
2304 sigfree ();
|
|
2305 #endif
|
|
2306 errno = old_errno;
|
|
2307 }
|
|
2308 #endif /* SIGIO */
|
|
2309
|
|
2310 /* Return the prompt-string of a sparse keymap.
|
|
2311 This is the first element which is a string.
|
|
2312 Return nil if there is none. */
|
|
2313
|
|
2314 Lisp_Object
|
|
2315 map_prompt (map)
|
|
2316 Lisp_Object map;
|
|
2317 {
|
|
2318 while (CONSP (map))
|
|
2319 {
|
|
2320 register Lisp_Object tem;
|
|
2321 tem = Fcar (map);
|
|
2322 if (XTYPE (tem) == Lisp_String)
|
|
2323 return tem;
|
|
2324 map = Fcdr (map);
|
|
2325 }
|
|
2326 return Qnil;
|
|
2327 }
|
|
2328
|
|
2329 static int echo_flag;
|
|
2330 static int echo_now;
|
|
2331
|
|
2332 /* Read a character like read_char but optionally prompt based on maps
|
|
2333 LOCAL and GLOBAL.
|
|
2334
|
|
2335 The prompting is done based on the prompt-string of the map
|
|
2336 and the strings associated with various map elements. */
|
|
2337
|
|
2338 Lisp_Object
|
|
2339 read_char_menu_prompt (prompt, local, global)
|
|
2340 int prompt;
|
|
2341 Lisp_Object local, global;
|
|
2342 {
|
|
2343 register Lisp_Object rest, name;
|
|
2344 Lisp_Object hmap;
|
|
2345 int nlength;
|
|
2346 int width = SCREEN_WIDTH (selected_screen) - 4;
|
|
2347 char *menu = (char *) alloca (width);
|
|
2348
|
|
2349 /* Use local over global Menu maps */
|
|
2350
|
|
2351 if (menu_prompting)
|
|
2352 return read_char (!prompt);
|
|
2353
|
|
2354 /* We can't get prompt strings from dense keymaps. */
|
|
2355 if (CONSP (local)
|
|
2356 && EQ (Fcar (local), Qkeymap)
|
|
2357 && !(CONSP (XCONS (local)->cdr)
|
|
2358 && XTYPE (XCONS (XCONS (local)->cdr)->car) == Lisp_Vector))
|
|
2359 hmap = local;
|
|
2360 else if (CONSP (global)
|
|
2361 && EQ (Fcar (global), Qkeymap)
|
|
2362 && !(CONSP (XCONS (global)->cdr)
|
|
2363 && XTYPE (XCONS (XCONS (global)->cdr)->car) == Lisp_Vector))
|
|
2364 hmap = global;
|
|
2365 else
|
|
2366 return read_char (!prompt);
|
|
2367
|
|
2368 /* Get the map's prompt string. */
|
|
2369 name = map_prompt (hmap);
|
|
2370 if (NILP (name))
|
|
2371 return read_char (!prompt);
|
|
2372
|
|
2373 /* Prompt string always starts with map's prompt, and a space. */
|
|
2374 strcpy (menu, XSTRING (name)->data);
|
|
2375 nlength = XSTRING (name)->size;
|
|
2376 menu[nlength++] = ' ';
|
|
2377 menu[nlength] = 0;
|
|
2378
|
|
2379 /* Start prompting at start of map. */
|
|
2380 rest = hmap; /* Current menu item */
|
|
2381
|
|
2382 /* Present the documented bindings, a line at a time. */
|
|
2383 while (1)
|
|
2384 {
|
|
2385 int notfirst = 0;
|
|
2386 int i = nlength;
|
|
2387 Lisp_Object obj;
|
|
2388 int ch;
|
|
2389
|
|
2390 /* If reached end of map, start at beginning. */
|
|
2391 if (NILP (Fcdr (rest))) rest = hmap;
|
|
2392
|
|
2393 /* Loop over elements of map. */
|
|
2394 while (!NILP (rest) && i < width)
|
|
2395 {
|
|
2396 Lisp_Object s;
|
|
2397
|
|
2398 /* Look for conses whose cadrs are strings. */
|
|
2399 s = Fcar_safe (Fcdr_safe (Fcar_safe (rest)));
|
|
2400 if (XTYPE (s) != Lisp_String)
|
|
2401 /* Ignore all other elements. */
|
|
2402 ;
|
|
2403 /* If first such element, or enough room, add string to prompt. */
|
|
2404 else if (XSTRING (s)->size + i < width
|
|
2405 || !notfirst)
|
|
2406 {
|
|
2407 int thiswidth;
|
|
2408
|
|
2409 /* Punctuate between strings. */
|
|
2410 if (notfirst)
|
|
2411 {
|
|
2412 strcpy (menu + i, ", ");
|
|
2413 i += 2;
|
|
2414 }
|
|
2415 notfirst = 1;
|
|
2416
|
|
2417 /* Add as much of string as fits. */
|
|
2418 thiswidth = XSTRING (s)->size;
|
|
2419 if (thiswidth + i > width)
|
|
2420 thiswidth = width - i;
|
|
2421 bcopy (XSTRING (s)->data, menu + i, thiswidth);
|
|
2422 i += thiswidth;
|
|
2423 }
|
|
2424 else
|
|
2425 {
|
|
2426 /* If some elts don't fit, show there are more. */
|
|
2427 strcpy (menu + i, "...");
|
|
2428 break;
|
|
2429 }
|
|
2430
|
|
2431 /* Move past this element. */
|
|
2432 rest = Fcdr_safe (rest);
|
|
2433 }
|
|
2434
|
|
2435 /* Prompt with that and read response. */
|
|
2436 message1 (menu);
|
|
2437 obj = read_char (1);
|
|
2438
|
|
2439 if (XTYPE (obj) != Lisp_Int)
|
|
2440 return obj;
|
|
2441 else
|
|
2442 ch = XINT (obj);
|
|
2443
|
|
2444 if (obj != menu_prompt_more_char
|
|
2445 && (XTYPE (menu_prompt_more_char) != Lisp_Int
|
|
2446 || obj != make_number (Ctl (XINT (menu_prompt_more_char)))))
|
|
2447 return obj;
|
|
2448 }
|
|
2449 }
|
|
2450
|
|
2451
|
|
2452 /* Reading key sequences. */
|
|
2453
|
|
2454 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
|
|
2455 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
|
|
2456 keymap, or nil otherwise. Return the index of the first keymap in
|
|
2457 which KEY has any binding, or NMAPS if no map has a binding.
|
|
2458
|
|
2459 If KEY is a meta ASCII character, treat it like meta-prefix-char
|
|
2460 followed by the corresponding non-meta character. Keymaps in
|
|
2461 CURRENT with non-prefix bindings for meta-prefix-char become nil in
|
|
2462 NEXT.
|
|
2463
|
|
2464 When KEY is not defined in any of the keymaps, if it is an upper
|
|
2465 case letter and there are bindings for the corresponding lower-case
|
|
2466 letter, return the bindings for the lower-case letter.
|
|
2467
|
|
2468 NEXT may == CURRENT. */
|
|
2469
|
|
2470 static int
|
|
2471 follow_key (key, nmaps, current, defs, next)
|
|
2472 Lisp_Object key;
|
|
2473 Lisp_Object *current, *defs, *next;
|
|
2474 int nmaps;
|
|
2475 {
|
|
2476 int i, first_binding;
|
|
2477
|
|
2478 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
|
|
2479 followed by the corresponding non-meta character. */
|
|
2480 if (XTYPE (key) == Lisp_Int
|
|
2481 && XINT (key) >= 0200)
|
|
2482 {
|
|
2483 for (i = 0; i < nmaps; i++)
|
|
2484 if (! NILP (current[i]))
|
|
2485 {
|
|
2486 next[i] = get_keyelt (access_keymap (current[i],
|
|
2487 meta_prefix_char));
|
|
2488
|
|
2489 /* Note that since we pass the resulting bindings through
|
|
2490 get_keymap_1, non-prefix bindings for meta-prefix-char
|
|
2491 disappear. */
|
|
2492 next[i] = get_keymap_1 (next[i], 0);
|
|
2493 }
|
|
2494 else
|
|
2495 next[i] = Qnil;
|
|
2496
|
|
2497 current = next;
|
|
2498 XSET (key, Lisp_Int, XFASTINT (key) & 0177);
|
|
2499 }
|
|
2500
|
|
2501 first_binding = nmaps;
|
|
2502 for (i = nmaps - 1; i >= 0; i--)
|
|
2503 {
|
|
2504 if (! NILP (current[i]))
|
|
2505 {
|
|
2506 defs[i] = get_keyelt (access_keymap (current[i], key));
|
|
2507 if (! NILP (defs[i]))
|
|
2508 first_binding = i;
|
|
2509 }
|
|
2510 else
|
|
2511 defs[i] = Qnil;
|
|
2512 }
|
|
2513
|
|
2514 /* When KEY is not defined in any of the keymaps, if it is an upper
|
|
2515 case letter and there are bindings for the corresponding
|
|
2516 lower-case letter, return the bindings for the lower-case letter. */
|
|
2517 if (first_binding == nmaps
|
|
2518 && XTYPE (key) == Lisp_Int
|
|
2519 && UPPERCASEP (XINT (key)))
|
|
2520 {
|
|
2521 XSETINT (key, DOWNCASE (XINT (key)));
|
|
2522
|
|
2523 first_binding = nmaps;
|
|
2524 for (i = nmaps - 1; i >= 0; i--)
|
|
2525 {
|
|
2526 if (! NILP (current[i]))
|
|
2527 {
|
|
2528 defs[i] = get_keyelt (access_keymap (current[i], key));
|
|
2529 if (! NILP (defs[i]))
|
|
2530 first_binding = i;
|
|
2531 }
|
|
2532 else
|
|
2533 defs[i] = Qnil;
|
|
2534 }
|
|
2535 }
|
|
2536
|
|
2537 /* Given the set of bindings we've found, produce the next set of maps. */
|
|
2538 for (i = 0; i < nmaps; i++)
|
|
2539 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0);
|
|
2540
|
|
2541 return first_binding;
|
|
2542 }
|
|
2543
|
|
2544 /* Read a sequence of keys that ends with a non prefix character
|
|
2545 according to the keymaps in KEYMAPS[0..nmaps-1]. Keymaps appearing
|
|
2546 earlier in KEYMAPS take precidence over those appearing later.
|
|
2547
|
|
2548 Store the sequence in KEYBUF, a buffer of size BUFSIZE. Prompt
|
|
2549 with PROMPT. Echo starting immediately unless `prompt' is 0.
|
|
2550 Return the length of the key sequence stored.
|
|
2551
|
|
2552 If the user switches screens in the midst of a key sequence, we
|
|
2553 throw away any prefix we have read so far, and start afresh. For
|
|
2554 mouse clicks, we look up the click in the keymap of the buffer
|
|
2555 clicked on, throwing away any prefix if it is not the same buffer
|
|
2556 we used to be reading from. */
|
|
2557
|
|
2558 static int
|
|
2559 read_key_sequence (keybuf, bufsize, prompt)
|
|
2560 Lisp_Object *keybuf;
|
|
2561 int bufsize;
|
|
2562 Lisp_Object prompt;
|
|
2563 {
|
|
2564 /* How many keys there are in the current key sequence. */
|
|
2565 int t;
|
|
2566
|
|
2567 /* The buffer that the most recently read event was typed at. This
|
|
2568 helps us read mouse clicks according to the buffer clicked in,
|
|
2569 and notice when the mouse has moved from one screen to another. */
|
|
2570 struct buffer *last_event_buffer = current_buffer;
|
|
2571
|
|
2572 /* The length of the echo buffer when we started reading, and
|
|
2573 the length of this_command_keys when we started reading. */
|
|
2574 int echo_start;
|
|
2575 int keys_start = this_command_key_count;
|
|
2576
|
|
2577 /* The number of keymaps we're scanning right now, and the number of
|
|
2578 keymaps we have allocated space for. */
|
|
2579 int nmaps;
|
|
2580 int nmaps_allocated = 0;
|
|
2581
|
|
2582 /* current[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
|
|
2583 in the current keymaps, or nil where it is not a prefix. */
|
|
2584 Lisp_Object *current;
|
|
2585
|
|
2586 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
|
|
2587 the current keymaps. */
|
|
2588 Lisp_Object *defs;
|
|
2589
|
|
2590 /* The lowest i such that defs[i] is non-nil. */
|
|
2591 int first_binding;
|
|
2592
|
|
2593 /* If mock_input > t, then KEYBUF[t] should be read as the next
|
|
2594 input key. */
|
|
2595 int mock_input = 0;
|
|
2596
|
|
2597 /* If the sequence is unbound in current[], keymap[fkey_start..fkey_end-1]
|
|
2598 is a prefix in Vfunction_key_map, and fkey_map is its binding.
|
|
2599 These might be > t, indicating that all function key scanning should
|
|
2600 hold off until t reaches them. */
|
|
2601 int fkey_start = 0, fkey_end = 0;
|
|
2602 Lisp_Object fkey_map = Vfunction_key_map;
|
|
2603
|
|
2604 if (INTERACTIVE)
|
|
2605 {
|
|
2606 if (prompt)
|
|
2607 echo_prompt (prompt);
|
|
2608 else if (cursor_in_echo_area)
|
|
2609 /* This doesn't put in a dash if the echo buffer is empty, so
|
|
2610 you don't always see a dash hanging out in the minibuffer. */
|
|
2611 echo_dash ();
|
|
2612 echo_start = echo_length ();
|
|
2613 }
|
|
2614
|
|
2615 /* If there is no function key map, turn of function key scanning. */
|
|
2616 if (NILP (Fkeymapp (Vfunction_key_map)))
|
|
2617 fkey_start = fkey_end = bufsize + 1;
|
|
2618
|
|
2619 restart:
|
|
2620 t = 0;
|
|
2621 this_command_key_count = keys_start;
|
|
2622
|
|
2623 {
|
|
2624 Lisp_Object *maps;
|
|
2625
|
|
2626 nmaps = current_minor_maps (0, &maps) + 2;
|
|
2627 if (nmaps > nmaps_allocated)
|
|
2628 {
|
|
2629 current = (Lisp_Object *) alloca (nmaps * sizeof (current[0]));
|
|
2630 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
|
|
2631 nmaps_allocated = nmaps;
|
|
2632 }
|
|
2633 bcopy (maps, current, (nmaps - 2) * sizeof (current[0]));
|
|
2634 current[nmaps-2] = last_event_buffer->keymap;
|
|
2635 current[nmaps-1] = global_map;
|
|
2636 }
|
|
2637
|
|
2638 /* Find an accurate initial value for first_binding. */
|
|
2639 for (first_binding = 0; first_binding < nmaps; first_binding++)
|
|
2640 if (! NILP (current[first_binding]))
|
|
2641 break;
|
|
2642
|
|
2643 while ((first_binding < nmaps && ! NILP (current[first_binding]))
|
|
2644 || (first_binding >= nmaps && fkey_start < t))
|
|
2645 {
|
|
2646 Lisp_Object key;
|
|
2647
|
|
2648 if (t >= bufsize)
|
|
2649 error ("key sequence too long");
|
|
2650
|
|
2651 /* Are we reading keys stuffed into keybuf? */
|
|
2652 if (t < mock_input)
|
|
2653 {
|
|
2654 key = keybuf[t];
|
|
2655 add_command_key (key);
|
|
2656 echo_char (key);
|
|
2657 }
|
|
2658 /* Otherwise, we should actually read a character. */
|
|
2659 else
|
|
2660 {
|
|
2661 struct buffer *buf;
|
|
2662
|
|
2663 if (!prompt && INTERACTIVE)
|
|
2664 key = read_char_menu_prompt (prompt, Qnil, Qnil);
|
|
2665 else
|
|
2666 key = read_char (!prompt);
|
|
2667
|
|
2668 /* The above routines return -1 at the end of a macro.
|
|
2669 Emacs 18 handles this by returning immediately with a
|
|
2670 zero, so that's what we'll do. */
|
|
2671 if (XTYPE (key) == Lisp_Int && XINT (key) < 0)
|
|
2672 return 0;
|
|
2673
|
|
2674 Vquit_flag = Qnil;
|
|
2675
|
|
2676 /* What buffer was this event typed/moused at? */
|
|
2677 if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol)
|
|
2678 buf = (XBUFFER
|
|
2679 (XWINDOW
|
|
2680 (SCREEN_SELECTED_WINDOW
|
|
2681 (XSCREEN (Vlast_event_screen)))->buffer));
|
|
2682 else if (EVENT_HAS_PARAMETERS (key))
|
|
2683 {
|
|
2684 Lisp_Object window = EVENT_WINDOW (key);
|
|
2685
|
|
2686 if (NILP (window))
|
|
2687 abort ();
|
|
2688
|
|
2689 buf = XBUFFER (XWINDOW (window)->buffer);
|
|
2690 }
|
|
2691 else
|
|
2692 abort ();
|
|
2693
|
|
2694 /* If this event came to a different buffer than the one
|
|
2695 we're currently in, switch buffers and start a new key
|
|
2696 sequence, starting with key. */
|
|
2697 if (buf != last_event_buffer)
|
|
2698 {
|
|
2699 last_event_buffer = buf;
|
|
2700 Fselect_screen (Vlast_event_screen, Qnil);
|
|
2701
|
|
2702 /* Arrange to read key as the next event. */
|
|
2703 keybuf[0] = key;
|
|
2704 mock_input = 1;
|
|
2705
|
|
2706 /* Truncate the key sequence in the echo area. */
|
|
2707 if (INTERACTIVE)
|
|
2708 echo_truncate (echo_start);
|
|
2709
|
|
2710 goto restart;
|
|
2711 }
|
|
2712 }
|
|
2713
|
|
2714 first_binding = (follow_key (key,
|
|
2715 nmaps - first_binding,
|
|
2716 current + first_binding,
|
|
2717 defs + first_binding,
|
|
2718 current + first_binding)
|
|
2719 + first_binding);
|
|
2720 keybuf[t++] = key;
|
|
2721
|
|
2722 /* If the sequence is unbound, see if we can hang a function key
|
|
2723 off the end of it. Don't reread the expansion of a function key. */
|
|
2724 if (first_binding >= nmaps
|
|
2725 && t > mock_input)
|
|
2726 {
|
|
2727 Lisp_Object fkey_next;
|
|
2728
|
|
2729 /* Scan from fkey_end until we find a bound suffix. */
|
|
2730 while (fkey_end < t)
|
|
2731 {
|
|
2732 fkey_next =
|
|
2733 get_keyelt (access_keymap (fkey_map, keybuf[fkey_end++]));
|
|
2734 /* If keybuf[fkey_start..fkey_next] is bound in the
|
547
|
2735 function key map and it's a suffix of the current
|
|
2736 sequence (i.e. fkey_next == t), replace it with
|
|
2737 the binding and restart with fkey_start at the end. */
|
518
|
2738 if (XTYPE (fkey_next) == Lisp_Vector
|
|
2739 && fkey_end == t)
|
|
2740 {
|
|
2741 t = fkey_start + XVECTOR (fkey_next)->size;
|
|
2742 if (t >= bufsize)
|
|
2743 error ("key sequence too long");
|
|
2744
|
|
2745 bcopy (XVECTOR (fkey_next)->contents,
|
|
2746 keybuf + fkey_start,
|
|
2747 (t - fkey_start) * sizeof (keybuf[0]));
|
|
2748
|
|
2749 mock_input = t;
|
|
2750 fkey_start = fkey_end = t;
|
|
2751
|
|
2752 /* Truncate the key sequence in the echo area. */
|
|
2753 if (INTERACTIVE)
|
|
2754 echo_truncate (echo_start);
|
|
2755
|
|
2756 goto restart;
|
|
2757 }
|
|
2758
|
|
2759 fkey_map = get_keymap_1 (fkey_next, 0);
|
|
2760
|
547
|
2761 /* If we no longer have a bound suffix, try a new positions for
|
|
2762 fkey_start. */
|
518
|
2763 if (NILP (fkey_map))
|
|
2764 {
|
|
2765 fkey_end = ++fkey_start;
|
|
2766 fkey_map = Vfunction_key_map;
|
|
2767 }
|
|
2768 }
|
|
2769 }
|
|
2770 }
|
|
2771
|
|
2772 read_key_sequence_cmd = (first_binding < nmaps
|
|
2773 ? defs[first_binding]
|
|
2774 : Qnil);
|
|
2775
|
|
2776 return t;
|
|
2777 }
|
|
2778
|
|
2779 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 1, 0,
|
|
2780 "Read a sequence of keystrokes and return as a string or vector.\n\
|
|
2781 The sequence is sufficient to specify a non-prefix command in the\n\
|
|
2782 current local and global maps.\n\
|
|
2783 \n\
|
|
2784 Arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
|
|
2785 \n\
|
|
2786 If Emacs is running on multiple screens, switching between screens in\n\
|
|
2787 the midst of a keystroke will toss any prefix typed so far. A C-g\n\
|
|
2788 typed while in this function is treated like any other character, and\n\
|
|
2789 `quit-flag' is not set.")
|
|
2790 (prompt)
|
|
2791 Lisp_Object prompt;
|
|
2792 {
|
|
2793 Lisp_Object keybuf[30];
|
|
2794 register int i;
|
|
2795 struct gcpro gcpro1, gcpro2;
|
|
2796
|
|
2797 if (!NILP (prompt))
|
|
2798 CHECK_STRING (prompt, 0);
|
|
2799 QUIT;
|
|
2800
|
|
2801 bzero (keybuf, sizeof keybuf);
|
|
2802 GCPRO1 (keybuf[0]);
|
|
2803 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
|
|
2804
|
|
2805 this_command_key_count = 0;
|
|
2806 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
|
|
2807 NILP (prompt) ? 0 : XSTRING (prompt)->data);
|
|
2808
|
|
2809 UNGCPRO;
|
|
2810 return make_array (i, keybuf);
|
|
2811 }
|
|
2812
|
|
2813 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
|
|
2814 "Execute CMD as an editor command.\n\
|
|
2815 CMD must be a symbol that satisfies the `commandp' predicate.\n\
|
|
2816 Optional second arg RECORD-FLAG non-nil\n\
|
|
2817 means unconditionally put this command in `command-history'.\n\
|
|
2818 Otherwise, that is done only if an arg is read using the minibuffer.")
|
|
2819 (cmd, record)
|
|
2820 Lisp_Object cmd, record;
|
|
2821 {
|
|
2822 register Lisp_Object final;
|
|
2823 register Lisp_Object tem;
|
|
2824 Lisp_Object prefixarg;
|
|
2825 struct backtrace backtrace;
|
|
2826 extern int debug_on_next_call;
|
|
2827
|
|
2828 prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
|
|
2829 Vcurrent_prefix_arg = prefixarg;
|
|
2830 debug_on_next_call = 0;
|
|
2831
|
|
2832 if (XTYPE (cmd) == Lisp_Symbol)
|
|
2833 {
|
|
2834 tem = Fget (cmd, Qdisabled);
|
|
2835 if (!NILP (tem))
|
|
2836 return call1 (Vrun_hooks, Vdisabled_command_hook);
|
|
2837 }
|
|
2838
|
|
2839 while (1)
|
|
2840 {
|
|
2841 final = cmd;
|
|
2842 while (XTYPE (final) == Lisp_Symbol)
|
|
2843 {
|
|
2844 if (EQ (Qunbound, XSYMBOL (final)->function))
|
|
2845 Fsymbol_function (final); /* Get an error! */
|
|
2846 final = XSYMBOL (final)->function;
|
|
2847 }
|
|
2848
|
|
2849 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
|
|
2850 do_autoload (final, cmd);
|
|
2851 else
|
|
2852 break;
|
|
2853 }
|
|
2854
|
|
2855 if (XTYPE (final) == Lisp_String
|
|
2856 || XTYPE (final) == Lisp_Vector)
|
|
2857 {
|
|
2858 /* If requested, place the macro in the command history. For
|
|
2859 other sorts of commands, call-interactively takes care of
|
|
2860 this. */
|
|
2861 if (!NILP (record))
|
|
2862 Vcommand_history
|
|
2863 = Fcons (Fcons (Qexecute_kbd_macro,
|
|
2864 Fcons (final, Fcons (prefixarg, Qnil))),
|
|
2865 Vcommand_history);
|
|
2866
|
|
2867 return Fexecute_kbd_macro (final, prefixarg);
|
|
2868 }
|
|
2869 if (CONSP (final) || XTYPE (final) == Lisp_Subr
|
|
2870 || XTYPE (final) == Lisp_Compiled)
|
|
2871 {
|
|
2872 backtrace.next = backtrace_list;
|
|
2873 backtrace_list = &backtrace;
|
|
2874 backtrace.function = &Qcall_interactively;
|
|
2875 backtrace.args = &cmd;
|
|
2876 backtrace.nargs = 1;
|
|
2877 backtrace.evalargs = 0;
|
|
2878
|
|
2879 tem = Fcall_interactively (cmd, record);
|
|
2880
|
|
2881 backtrace_list = backtrace.next;
|
|
2882 return tem;
|
|
2883 }
|
|
2884 return Qnil;
|
|
2885 }
|
|
2886
|
|
2887 #if 0
|
|
2888 DEFUN ("execute-mouse-event", Fexecute_mouse_event, Sexecute_mouse_event,
|
|
2889 1, 1, 0,
|
|
2890 "Execute the definition of the mouse-click event EVENT.\n\
|
|
2891 The handler function is found by looking the event's key sequence up\n\
|
|
2892 in the buffer's local mouse map and in `global-mouse-map'.\n\
|
|
2893 \n\
|
|
2894 After running the handler, call the value of `mouse-event-function'\n\
|
|
2895 with EVENT as arg.")
|
|
2896 (event)
|
|
2897 Lisp_Object event;
|
|
2898 {
|
|
2899 Lisp_Object tem;
|
|
2900 Lisp_Object mouse_cmd;
|
|
2901 Lisp_Object keyseq, window, screen_part, pos, time;
|
|
2902
|
|
2903 #ifndef HAVE_X11
|
|
2904 Vmouse_event = event;
|
|
2905 #endif
|
|
2906
|
|
2907 if (EQ (event, Qnil))
|
|
2908 {
|
|
2909 bitch_at_user ();
|
|
2910 return Qnil;
|
|
2911 }
|
|
2912
|
|
2913 CHECK_CONS (event, 0);
|
|
2914 pos = Fcar (event);
|
|
2915 window = Fcar (Fcdr (event));
|
|
2916 screen_part = Fcar (Fcdr (Fcdr (event)));
|
|
2917 keyseq = Fcar (Fcdr (Fcdr (Fcdr (event))));
|
|
2918 time = Fcar (Fcdr (Fcdr (Fcdr (Fcdr (event)))));
|
|
2919 CHECK_STRING (keyseq, 0);
|
|
2920 CHECK_WINDOW (window, 0);
|
|
2921
|
|
2922 /* Look up KEYSEQ in the buffer's local mouse map, then in global one. */
|
|
2923
|
|
2924 mouse_cmd = Qnil;
|
|
2925
|
|
2926 if (!NILP (XWINDOW (window)->buffer))
|
|
2927 {
|
|
2928 Lisp_Object local_map;
|
|
2929
|
|
2930 local_map = XBUFFER (XWINDOW (window)->buffer)->mouse_map;
|
|
2931 tem = Fkeymapp (local_map);
|
|
2932 if (!NILP (tem))
|
|
2933 mouse_cmd = Flookup_key (local_map, keyseq);
|
|
2934 /* A number as value means the key is too long; treat as undefined. */
|
|
2935 if (XTYPE (mouse_cmd) == Lisp_Int)
|
|
2936 mouse_cmd = Qnil;
|
|
2937 }
|
|
2938
|
|
2939 tem = Fkeymapp (Vglobal_mouse_map);
|
|
2940 if (NILP (mouse_cmd) && !NILP (tem))
|
|
2941 mouse_cmd = Flookup_key (Vglobal_mouse_map, keyseq);
|
|
2942 if (XTYPE (mouse_cmd) == Lisp_Int)
|
|
2943 mouse_cmd = Qnil;
|
|
2944
|
|
2945 if (NILP (mouse_cmd))
|
|
2946 {
|
|
2947 /* This button/shift combination is not defined.
|
|
2948 If it is a button-down event, ring the bell. */
|
|
2949 #ifdef HAVE_X11
|
|
2950 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 0x18 == 0)
|
|
2951 #else
|
|
2952 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 4 == 0)
|
|
2953 #endif
|
|
2954 bitch_at_user ();
|
|
2955 }
|
|
2956 else
|
|
2957 {
|
|
2958 SCREEN_PTR s = XSCREEN (WINDOW_SCREEN (XWINDOW (window)));
|
|
2959
|
|
2960 #ifndef HAVE_X11
|
|
2961 Vmouse_window = s->selected_window;
|
|
2962 #endif /* HAVE_X11 */
|
|
2963 /* It's defined; call the definition. */
|
|
2964 Vprefix_arg = Qnil;
|
|
2965 if (!NILP (screen_part))
|
|
2966 {
|
|
2967 /* For a scroll-bar click, set the prefix arg
|
|
2968 to the number of lines down from the top the click was.
|
|
2969 Many scroll commands want to scroll by this many lines. */
|
|
2970 Lisp_Object position;
|
|
2971 Lisp_Object length;
|
|
2972 Lisp_Object offset;
|
|
2973
|
|
2974 position = Fcar (pos);
|
|
2975 length = Fcar (Fcdr (pos));
|
|
2976 offset = Fcar (Fcdr (Fcdr (pos)));
|
|
2977
|
|
2978 if (XINT (length) != 0)
|
|
2979 XSET (Vprefix_arg, Lisp_Int,
|
|
2980 (SCREEN_HEIGHT (s) * (XINT (position) + XINT (offset))
|
|
2981 / (XINT (length) + 2 * XINT (offset))));
|
|
2982 }
|
|
2983 Fcommand_execute (mouse_cmd, Qnil);
|
|
2984 }
|
|
2985
|
|
2986 if (!NILP (Vmouse_event_function)) /* Not `event' so no need for GCPRO */
|
|
2987 call1 (Vmouse_event_function, Vmouse_event);
|
|
2988 return Qnil;
|
|
2989 }
|
|
2990 #endif
|
|
2991
|
|
2992 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
|
|
2993 1, 1, "P",
|
|
2994 "Read function name, then read its arguments and call it.")
|
|
2995 (prefixarg)
|
|
2996 Lisp_Object prefixarg;
|
|
2997 {
|
|
2998 Lisp_Object function;
|
|
2999 char buf[40];
|
|
3000 Lisp_Object saved_keys;
|
|
3001 struct gcpro gcpro1;
|
|
3002
|
|
3003 saved_keys = Fthis_command_keys ();
|
|
3004 buf[0] = 0;
|
|
3005 GCPRO1 (saved_keys);
|
|
3006
|
|
3007 if (EQ (prefixarg, Qminus))
|
|
3008 strcpy (buf, "- ");
|
|
3009 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
|
|
3010 strcpy (buf, "C-u ");
|
|
3011 else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
|
|
3012 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
|
|
3013 else if (XTYPE (prefixarg) == Lisp_Int)
|
|
3014 sprintf (buf, "%d ", XINT (prefixarg));
|
|
3015
|
|
3016 /* This isn't strictly correct if execute-extended-command
|
|
3017 is bound to anything else. Perhaps it should use
|
|
3018 this_command_keys? */
|
|
3019 strcat (buf, "M-x ");
|
|
3020
|
|
3021 /* Prompt with buf, and then read a string, completing from and
|
|
3022 restricting to the set of all defined commands. Don't provide
|
|
3023 any initial input. The last Qnil says not to perform a
|
|
3024 peculiar hack on the initial input. */
|
|
3025 function = Fcompleting_read (build_string (buf),
|
|
3026 Vobarray, Qcommandp,
|
|
3027 Qt, Qnil, Qnil);
|
|
3028
|
|
3029 /* Add the text read to this_command_keys. */
|
|
3030 {
|
|
3031 struct Lisp_String *func_str = XSTRING (function);
|
|
3032 int i;
|
|
3033 Lisp_Object tem;
|
|
3034
|
|
3035 for (i = 0; i < func_str->size; i++)
|
|
3036 {
|
|
3037 XSET (tem, Lisp_Int, func_str->data[i]);
|
|
3038 add_command_key (tem);
|
|
3039 }
|
|
3040 }
|
|
3041
|
|
3042 UNGCPRO;
|
|
3043
|
|
3044 function = Fintern (function, Vobarray);
|
|
3045 Vprefix_arg = prefixarg;
|
|
3046 this_command = function;
|
|
3047
|
|
3048 return Fcommand_execute (function, Qt);
|
|
3049 }
|
|
3050
|
|
3051
|
|
3052 detect_input_pending ()
|
|
3053 {
|
|
3054 if (!input_pending)
|
|
3055 get_input_pending (&input_pending);
|
|
3056
|
|
3057 return input_pending;
|
|
3058 }
|
|
3059
|
|
3060 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
|
|
3061 "T if command input is currently available with no waiting.\n\
|
|
3062 Actually, the value is nil only if we can be sure that no input is available.")
|
|
3063 ()
|
|
3064 {
|
|
3065 if (!NILP (unread_command_char))
|
|
3066 return (Qt);
|
|
3067
|
|
3068 return detect_input_pending () ? Qt : Qnil;
|
|
3069 }
|
|
3070
|
|
3071 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
|
|
3072 "Return vector of last 100 chars read from terminal.")
|
|
3073 ()
|
|
3074 {
|
|
3075 Lisp_Object val;
|
|
3076
|
|
3077 if (total_keys < NUM_RECENT_KEYS)
|
|
3078 return Fvector (total_keys, recent_keys);
|
|
3079 else
|
|
3080 {
|
|
3081 val = Fvector (NUM_RECENT_KEYS, recent_keys);
|
|
3082 bcopy (recent_keys + recent_keys_index,
|
|
3083 XVECTOR (val)->contents,
|
|
3084 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
|
|
3085 bcopy (recent_keys,
|
|
3086 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
|
|
3087 recent_keys_index * sizeof (Lisp_Object));
|
|
3088 return val;
|
|
3089 }
|
|
3090 }
|
|
3091
|
|
3092 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
|
|
3093 "Return string of the keystrokes that invoked this command.")
|
|
3094 ()
|
|
3095 {
|
|
3096 return make_array (this_command_key_count, this_command_keys);
|
|
3097 }
|
|
3098
|
|
3099 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
|
|
3100 "Return the current depth in recursive edits.")
|
|
3101 ()
|
|
3102 {
|
|
3103 Lisp_Object temp;
|
|
3104 XFASTINT (temp) = command_loop_level + minibuf_level;
|
|
3105 return temp;
|
|
3106 }
|
|
3107
|
|
3108 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
|
|
3109 "FOpen dribble file: ",
|
|
3110 "Start writing all keyboard characters to FILE.")
|
|
3111 (file)
|
|
3112 Lisp_Object file;
|
|
3113 {
|
|
3114 if (NILP (file))
|
|
3115 {
|
|
3116 fclose (dribble);
|
|
3117 dribble = 0;
|
|
3118 }
|
|
3119 else
|
|
3120 {
|
|
3121 file = Fexpand_file_name (file, Qnil);
|
|
3122 dribble = fopen (XSTRING (file)->data, "w");
|
|
3123 }
|
|
3124 return Qnil;
|
|
3125 }
|
|
3126
|
|
3127 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
|
|
3128 "Discard the contents of the terminal input buffer.\n\
|
|
3129 Also cancel any kbd macro being defined.")
|
|
3130 ()
|
|
3131 {
|
|
3132 defining_kbd_macro = 0;
|
|
3133 update_mode_lines++;
|
|
3134
|
|
3135 #if 0
|
|
3136 unread_command_char = make_number (-1);
|
|
3137 #endif
|
|
3138 unread_command_char = Qnil;
|
|
3139
|
|
3140 discard_tty_input ();
|
|
3141
|
|
3142 kbd_fetch_ptr = kbd_store_ptr;
|
|
3143 input_pending = 0;
|
|
3144
|
|
3145 return Qnil;
|
|
3146 }
|
|
3147
|
|
3148 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
|
|
3149 "Stop Emacs and return to superior process. You can resume later.\n\
|
|
3150 On systems that don't have job control, run a subshell instead.\n\n\
|
|
3151 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
|
|
3152 to be read as terminal input by Emacs's superior shell.\n\
|
|
3153 Before suspending, if `suspend-hook' is bound and value is non-nil\n\
|
|
3154 call the value as a function of no args. Don't suspend if it returns non-nil.\n\
|
|
3155 Otherwise, suspend normally and after resumption call\n\
|
|
3156 `suspend-resume-hook' if that is bound and non-nil.\n\
|
|
3157 \n\
|
|
3158 Some operating systems cannot stop the Emacs process and resume it later.\n\
|
|
3159 On such systems, Emacs will start a subshell and wait for it to exit.")
|
|
3160 (stuffstring)
|
|
3161 Lisp_Object stuffstring;
|
|
3162 {
|
|
3163 register Lisp_Object tem;
|
|
3164 int count = specpdl_ptr - specpdl;
|
|
3165 int old_height, old_width;
|
|
3166 int width, height;
|
|
3167 struct gcpro gcpro1;
|
|
3168 extern init_sys_modes ();
|
|
3169
|
|
3170 if (!NILP (stuffstring))
|
|
3171 CHECK_STRING (stuffstring, 0);
|
|
3172 GCPRO1 (stuffstring);
|
|
3173
|
|
3174 /* Call value of suspend-hook
|
|
3175 if it is bound and value is non-nil. */
|
|
3176 if (!NILP (Vrun_hooks))
|
|
3177 {
|
|
3178 tem = call1 (Vrun_hooks, intern ("suspend-hook"));
|
|
3179 if (!EQ (tem, Qnil)) return Qnil;
|
|
3180 }
|
|
3181
|
|
3182 get_screen_size (&old_width, &old_height);
|
|
3183 reset_sys_modes ();
|
|
3184 /* sys_suspend can get an error if it tries to fork a subshell
|
|
3185 and the system resources aren't available for that. */
|
|
3186 record_unwind_protect (init_sys_modes, 0);
|
|
3187 stuff_buffered_input (stuffstring);
|
|
3188 sys_suspend ();
|
|
3189 unbind_to (count, Qnil);
|
|
3190
|
|
3191 /* Check if terminal/window size has changed.
|
|
3192 Note that this is not useful when we are running directly
|
|
3193 with a window system; but suspend should be disabled in that case. */
|
|
3194 get_screen_size (&width, &height);
|
|
3195 if (width != old_width || height != old_height)
|
|
3196 change_screen_size (height, width, 0);
|
|
3197
|
|
3198 /* Call value of suspend-resume-hook
|
|
3199 if it is bound and value is non-nil. */
|
|
3200 if (!NILP (Vrun_hooks))
|
|
3201 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
|
|
3202
|
|
3203 UNGCPRO;
|
|
3204 return Qnil;
|
|
3205 }
|
|
3206
|
|
3207 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
|
|
3208 Then in any case stuff anthing Emacs has read ahead and not used. */
|
|
3209
|
|
3210 stuff_buffered_input (stuffstring)
|
|
3211 Lisp_Object stuffstring;
|
|
3212 {
|
|
3213 register unsigned char *p;
|
|
3214
|
|
3215 /* stuff_char works only in BSD, versions 4.2 and up. */
|
|
3216 #ifdef BSD
|
|
3217 #ifndef BSD4_1
|
|
3218 if (XTYPE (stuffstring) == Lisp_String)
|
|
3219 {
|
|
3220 register int count;
|
|
3221
|
|
3222 p = XSTRING (stuffstring)->data;
|
|
3223 count = XSTRING (stuffstring)->size;
|
|
3224 while (count-- > 0)
|
|
3225 stuff_char (*p++);
|
|
3226 stuff_char ('\n');
|
|
3227 }
|
|
3228 /* Anything we have read ahead, put back for the shell to read. */
|
|
3229 while (kbd_fetch_ptr != kbd_store_ptr)
|
|
3230 {
|
|
3231 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
|
|
3232 kbd_fetch_ptr = kbd_buffer;
|
|
3233 if (kbd_fetch_ptr->kind == ascii_keystroke)
|
|
3234 stuff_char (XINT (kbd_fetch_ptr->code));
|
|
3235 kbd_fetch_ptr++;
|
|
3236 }
|
|
3237 input_pending = 0;
|
|
3238 #endif
|
|
3239 #endif /* BSD and not BSD4_1 */
|
|
3240 }
|
|
3241
|
|
3242 set_waiting_for_input (word_to_clear)
|
|
3243 long *word_to_clear;
|
|
3244 {
|
|
3245 input_available_clear_word = word_to_clear;
|
|
3246
|
|
3247 /* Tell interrupt_signal to throw back to read_char, */
|
|
3248 waiting_for_input = 1;
|
|
3249
|
|
3250 /* If interrupt_signal was called before and buffered a C-g,
|
|
3251 make it run again now, to avoid timing error. */
|
|
3252 if (!NILP (Vquit_flag))
|
|
3253 quit_throw_to_read_char ();
|
|
3254
|
|
3255 /* If alarm has gone off already, echo now. */
|
|
3256 if (echo_flag)
|
|
3257 {
|
|
3258 echo ();
|
|
3259 echo_flag = 0;
|
|
3260 }
|
|
3261 }
|
|
3262
|
|
3263 clear_waiting_for_input ()
|
|
3264 {
|
|
3265 /* Tell interrupt_signal not to throw back to read_char, */
|
|
3266 waiting_for_input = 0;
|
|
3267 input_available_clear_word = 0;
|
|
3268 }
|
|
3269
|
|
3270 /* This routine is called at interrupt level in response to C-G.
|
|
3271 If interrupt_input, this is the handler for SIGINT.
|
|
3272 Otherwise, it is called from kbd_buffer_store_event,
|
|
3273 in handling SIGIO or SIGTINT.
|
|
3274
|
|
3275 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
|
|
3276 immediately throw back to read_char.
|
|
3277
|
|
3278 Otherwise it sets the Lisp variable quit-flag not-nil.
|
|
3279 This causes eval to throw, when it gets a chance.
|
|
3280 If quit-flag is already non-nil, it stops the job right away. */
|
|
3281
|
|
3282 SIGTYPE
|
|
3283 interrupt_signal ()
|
|
3284 {
|
|
3285 char c;
|
|
3286 /* Must preserve main program's value of errno. */
|
|
3287 int old_errno = errno;
|
|
3288 extern Lisp_Object Vwindow_system;
|
|
3289
|
|
3290 #ifdef USG
|
|
3291 /* USG systems forget handlers when they are used;
|
|
3292 must reestablish each time */
|
|
3293 signal (SIGINT, interrupt_signal);
|
|
3294 signal (SIGQUIT, interrupt_signal);
|
|
3295 #endif /* USG */
|
|
3296
|
|
3297 cancel_echoing ();
|
|
3298
|
|
3299 if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen))
|
|
3300 {
|
|
3301 fflush (stdout);
|
|
3302 reset_sys_modes ();
|
|
3303 sigfree ();
|
|
3304 #ifdef SIGTSTP /* Support possible in later USG versions */
|
|
3305 /*
|
|
3306 * On systems which can suspend the current process and return to the original
|
|
3307 * shell, this command causes the user to end up back at the shell.
|
|
3308 * The "Auto-save" and "Abort" questions are not asked until
|
|
3309 * the user elects to return to emacs, at which point he can save the current
|
|
3310 * job and either dump core or continue.
|
|
3311 */
|
|
3312 sys_suspend ();
|
|
3313 #else
|
|
3314 #ifdef VMS
|
|
3315 if (sys_suspend () == -1)
|
|
3316 {
|
|
3317 printf ("Not running as a subprocess;\n");
|
|
3318 printf ("you can continue or abort.\n");
|
|
3319 }
|
|
3320 #else /* not VMS */
|
|
3321 /* Perhaps should really fork an inferior shell?
|
|
3322 But that would not provide any way to get back
|
|
3323 to the original shell, ever. */
|
|
3324 printf ("No support for stopping a process on this operating system;\n");
|
|
3325 printf ("you can continue or abort.\n");
|
|
3326 #endif /* not VMS */
|
|
3327 #endif /* not SIGTSTP */
|
|
3328 printf ("Auto-save? (y or n) ");
|
|
3329 fflush (stdout);
|
|
3330 if (((c = getchar ()) & ~040) == 'Y')
|
|
3331 Fdo_auto_save (Qnil, Qnil);
|
|
3332 while (c != '\n') c = getchar ();
|
|
3333 #ifdef VMS
|
|
3334 printf ("Abort (and enter debugger)? (y or n) ");
|
|
3335 #else /* not VMS */
|
|
3336 printf ("Abort (and dump core)? (y or n) ");
|
|
3337 #endif /* not VMS */
|
|
3338 fflush (stdout);
|
|
3339 if (((c = getchar ()) & ~040) == 'Y')
|
|
3340 abort ();
|
|
3341 while (c != '\n') c = getchar ();
|
|
3342 printf ("Continuing...\n");
|
|
3343 fflush (stdout);
|
|
3344 init_sys_modes ();
|
|
3345 }
|
|
3346 else
|
|
3347 {
|
|
3348 /* If executing a function that wants to be interrupted out of
|
|
3349 and the user has not deferred quitting by binding `inhibit-quit'
|
|
3350 then quit right away. */
|
|
3351 if (immediate_quit && NILP (Vinhibit_quit))
|
|
3352 {
|
|
3353 immediate_quit = 0;
|
|
3354 sigfree ();
|
|
3355 Fsignal (Qquit, Qnil);
|
|
3356 }
|
|
3357 else
|
|
3358 /* Else request quit when it's safe */
|
|
3359 Vquit_flag = Qt;
|
|
3360 }
|
|
3361
|
|
3362 if (waiting_for_input && !echoing)
|
|
3363 quit_throw_to_read_char ();
|
|
3364
|
|
3365 errno = old_errno;
|
|
3366 }
|
|
3367
|
|
3368 /* Handle a C-g by making read_char return C-g. */
|
|
3369
|
|
3370 quit_throw_to_read_char ()
|
|
3371 {
|
|
3372 quit_error_check ();
|
|
3373 sigfree ();
|
|
3374 /* Prevent another signal from doing this before we finish. */
|
|
3375 waiting_for_input = 0;
|
|
3376 input_pending = 0;
|
|
3377
|
|
3378 #if 0
|
|
3379 unread_command_char = make_number (-1);
|
|
3380 #endif
|
|
3381 unread_command_char = Qnil;
|
|
3382
|
|
3383 _longjmp (getcjmp, 1);
|
|
3384 }
|
|
3385
|
|
3386 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
|
|
3387 "Set mode of reading keyboard input.\n\
|
|
3388 First arg non-nil means use input interrupts; nil means use CBREAK mode.\n\
|
|
3389 Second arg non-nil means use ^S/^Q flow control for output to terminal\n\
|
|
3390 (no effect except in CBREAK mode).\n\
|
|
3391 Third arg non-nil means accept 8-bit input (for a Meta key).\n\
|
|
3392 Otherwise, the top bit is ignored, on the assumption it is parity.\n\
|
|
3393 Optional fourth arg non-nil specifies character to use for quitting.")
|
|
3394 (interrupt, flow, meta, quit)
|
|
3395 Lisp_Object interrupt, flow, meta, quit;
|
|
3396 {
|
|
3397 if (!NILP (quit)
|
|
3398 && (XTYPE (quit) != Lisp_Int
|
|
3399 || XINT (quit) < 0 || XINT (quit) > 0400))
|
|
3400 error ("set-input-mode: QUIT must be an ASCII character.");
|
|
3401
|
|
3402 reset_sys_modes ();
|
|
3403 #ifdef SIGIO
|
|
3404 /* Note SIGIO has been undef'd if FIONREAD is missing. */
|
|
3405 #ifdef NO_SOCK_SIGIO
|
|
3406 if (read_socket_hook)
|
|
3407 interrupt_input = 0; /* No interrupts if reading from a socket. */
|
|
3408 else
|
|
3409 #endif /* NO_SOCK_SIGIO */
|
|
3410 interrupt_input = !NILP (interrupt);
|
|
3411 #else /* not SIGIO */
|
|
3412 interrupt_input = 0;
|
|
3413 #endif /* not SIGIO */
|
|
3414 /* Our VMS input only works by interrupts, as of now. */
|
|
3415 #ifdef VMS
|
|
3416 interrupt_input = 1;
|
|
3417 #endif
|
|
3418 flow_control = !NILP (flow);
|
|
3419 meta_key = !NILP (meta);
|
|
3420 if (!NILP (quit))
|
|
3421 /* Don't let this value be out of range. */
|
|
3422 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
|
|
3423
|
|
3424 init_sys_modes ();
|
|
3425 return Qnil;
|
|
3426 }
|
|
3427
|
|
3428 init_keyboard ()
|
|
3429 {
|
|
3430 this_command_keys_size = 40;
|
|
3431 this_command_keys =
|
|
3432 (Lisp_Object *) xmalloc (this_command_keys_size * sizeof (Lisp_Object));
|
|
3433
|
|
3434 /* This is correct before outermost invocation of the editor loop */
|
|
3435 command_loop_level = -1;
|
|
3436 immediate_quit = 0;
|
|
3437 quit_char = Ctl ('g');
|
|
3438 unread_command_char = Qnil;
|
|
3439 recent_keys_index = 0;
|
|
3440 total_keys = 0;
|
|
3441 kbd_fetch_ptr = kbd_buffer;
|
|
3442 kbd_store_ptr = kbd_buffer;
|
|
3443 do_mouse_tracking = 0;
|
|
3444 input_pending = 0;
|
|
3445
|
|
3446 if (!noninteractive)
|
|
3447 {
|
|
3448 signal (SIGINT, interrupt_signal);
|
|
3449 #ifdef HAVE_TERMIO
|
|
3450 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
|
|
3451 SIGQUIT and we can't tell which one it will give us. */
|
|
3452 signal (SIGQUIT, interrupt_signal);
|
|
3453 #endif /* HAVE_TERMIO */
|
|
3454 /* Note SIGIO has been undef'd if FIONREAD is missing. */
|
|
3455 #ifdef SIGIO
|
|
3456 signal (SIGIO, input_available_signal);
|
|
3457 #endif SIGIO
|
|
3458 }
|
|
3459
|
|
3460 /* Use interrupt input by default, if it works and noninterrupt input
|
|
3461 has deficiencies. */
|
|
3462
|
|
3463 #ifdef INTERRUPT_INPUT
|
|
3464 interrupt_input = 1;
|
|
3465 #else
|
|
3466 interrupt_input = 0;
|
|
3467 #endif
|
|
3468
|
|
3469 /* Our VMS input only works by interrupts, as of now. */
|
|
3470 #ifdef VMS
|
|
3471 interrupt_input = 1;
|
|
3472 #endif
|
|
3473
|
|
3474 sigfree ();
|
|
3475 dribble = 0;
|
|
3476
|
|
3477 if (keyboard_init_hook)
|
|
3478 (*keyboard_init_hook) ();
|
|
3479
|
|
3480 #ifdef POLL_FOR_INPUT
|
|
3481 poll_suppress_count = 1;
|
|
3482 start_polling ();
|
|
3483 #endif
|
|
3484 }
|
|
3485
|
|
3486 /* This type's only use is in syms_of_keyboard, to initialize the
|
|
3487 event header symbols and put properties on them. */
|
|
3488 struct event_head {
|
|
3489 Lisp_Object *var;
|
|
3490 char *name;
|
|
3491 Lisp_Object *kind;
|
|
3492 };
|
|
3493
|
|
3494 struct event_head head_table[] = {
|
|
3495 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
|
|
3496 &Qvscrollbar_part, "vscrollbar-part", &Qscrollbar_click,
|
|
3497 &Qvslider_part, "vslider-part", &Qscrollbar_click,
|
|
3498 &Qvthumbup_part, "vthumbup-part", &Qscrollbar_click,
|
|
3499 &Qvthumbdown_part, "vthumbdown-part", &Qscrollbar_click,
|
|
3500 &Qhscrollbar_part, "hscrollbar-part", &Qscrollbar_click,
|
|
3501 &Qhslider_part, "hslider-part", &Qscrollbar_click,
|
|
3502 &Qhthumbleft_part, "hthumbleft-part", &Qscrollbar_click,
|
|
3503 &Qhthumbright_part,"hthumbright-part", &Qscrollbar_click
|
|
3504 };
|
|
3505
|
|
3506 syms_of_keyboard ()
|
|
3507 {
|
|
3508 Qself_insert_command = intern ("self-insert-command");
|
|
3509 staticpro (&Qself_insert_command);
|
|
3510
|
|
3511 Qforward_char = intern ("forward-char");
|
|
3512 staticpro (&Qforward_char);
|
|
3513
|
|
3514 Qbackward_char = intern ("backward-char");
|
|
3515 staticpro (&Qbackward_char);
|
|
3516
|
|
3517 Qdisabled = intern ("disabled");
|
|
3518 staticpro (&Qdisabled);
|
|
3519
|
|
3520 Qfunction_key = intern ("function-key");
|
|
3521 staticpro (&Qfunction_key);
|
|
3522 Qmouse_movement = intern ("mouse-click");
|
|
3523 staticpro (&Qmouse_click);
|
|
3524 Qmouse_movement = intern ("scrollbar-click");
|
|
3525 staticpro (&Qmouse_movement);
|
|
3526
|
|
3527 Qmode_line = intern ("mode-line");
|
|
3528 staticpro (&Qmode_line);
|
|
3529 Qvertical_split = intern ("vertical-split");
|
|
3530 staticpro (&Qvertical_split);
|
|
3531
|
|
3532 Qevent_kind = intern ("event-type");
|
|
3533 staticpro (&Qevent_kind);
|
|
3534 Qevent_unmodified = intern ("event-unmodified");
|
|
3535 staticpro (&Qevent_unmodified);
|
|
3536
|
|
3537 {
|
|
3538 struct event_head *p;
|
|
3539
|
|
3540 for (p = head_table;
|
|
3541 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
|
|
3542 p++)
|
|
3543 {
|
|
3544 *p->var = intern (p->name);
|
|
3545 staticpro (p->var);
|
|
3546 Fput (*p->var, Qevent_kind, *p->kind);
|
|
3547 Fput (*p->var, Qevent_unmodified, *p->var);
|
|
3548 }
|
|
3549 }
|
|
3550
|
|
3551 func_key_syms = Qnil;
|
|
3552 staticpro (&func_key_syms);
|
|
3553
|
|
3554 mouse_syms = Qnil;
|
|
3555 staticpro (&mouse_syms);
|
|
3556
|
|
3557 defsubr (&Sread_key_sequence);
|
|
3558 defsubr (&Srecursive_edit);
|
|
3559 defsubr (&Strack_mouse);
|
|
3560 defsubr (&Smouse_click_p);
|
|
3561 defsubr (&Sinput_pending_p);
|
|
3562 defsubr (&Scommand_execute);
|
|
3563 defsubr (&Srecent_keys);
|
|
3564 defsubr (&Sthis_command_keys);
|
|
3565 defsubr (&Ssuspend_emacs);
|
|
3566 defsubr (&Sabort_recursive_edit);
|
|
3567 defsubr (&Sexit_recursive_edit);
|
|
3568 defsubr (&Srecursion_depth);
|
|
3569 defsubr (&Stop_level);
|
|
3570 defsubr (&Sdiscard_input);
|
|
3571 defsubr (&Sopen_dribble_file);
|
|
3572 defsubr (&Sset_input_mode);
|
|
3573 defsubr (&Sexecute_extended_command);
|
|
3574
|
|
3575 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
|
|
3576 "Value is called instead of any command that is disabled\n\
|
|
3577 (has a non-nil `disabled' property).");
|
|
3578
|
|
3579 DEFVAR_LISP ("last-command-char", &last_command_char,
|
|
3580 "Last terminal input key that was part of a command.");
|
|
3581
|
|
3582 DEFVAR_LISP ("last-input-char", &last_input_char,
|
|
3583 "Last terminal input key.");
|
|
3584
|
|
3585 DEFVAR_LISP ("unread-command-char", &unread_command_char,
|
|
3586 "Object to be read as next input from input stream, or nil if none.");
|
|
3587
|
|
3588 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
|
|
3589 "Meta-prefix character code. Meta-foo as command input\n\
|
|
3590 turns into this character followed by foo.");
|
|
3591 XSET (meta_prefix_char, Lisp_Int, 033);
|
|
3592
|
|
3593 DEFVAR_LISP ("last-command", &last_command,
|
|
3594 "The last command executed. Normally a symbol with a function definition,\n\
|
|
3595 but can be whatever was found in the keymap, or whatever the variable\n\
|
|
3596 `this-command' was set to by that command.");
|
|
3597 last_command = Qnil;
|
|
3598
|
|
3599 DEFVAR_LISP ("this-command", &this_command,
|
|
3600 "The command now being executed.\n\
|
|
3601 The command can set this variable; whatever is put here\n\
|
|
3602 will be in `last-command' during the following command.");
|
|
3603 this_command = Qnil;
|
|
3604
|
|
3605 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
|
|
3606 "*Number of keyboard input characters between auto-saves.\n\
|
|
3607 Zero means disable autosaving due to number of characters typed.");
|
|
3608 auto_save_interval = 300;
|
|
3609
|
|
3610 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
|
|
3611 "*Number of seconds idle time before auto-save.\n\
|
|
3612 Zero or nil means disable auto-saving due to idleness.");
|
|
3613 XFASTINT (Vauto_save_timeout) = 30;
|
|
3614
|
|
3615 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
|
|
3616 "*Nonzero means echo unfinished commands after this many seconds of pause.");
|
|
3617 echo_keystrokes = 1;
|
|
3618
|
|
3619 DEFVAR_INT ("polling-period", &polling_period,
|
|
3620 "*Interval between polling for input during Lisp execution.\n\
|
|
3621 The reason for polling is to make C-g work to stop a running program.\n\
|
|
3622 Polling is needed only when using X windows and SIGIO does not work.\n\
|
|
3623 Polling is automatically disabled in all other cases.");
|
|
3624 polling_period = 2;
|
|
3625
|
|
3626 DEFVAR_INT ("num-input-keys", &num_input_keys,
|
|
3627 "*Number of complete keys read from the keyboard so far.");
|
|
3628 num_input_keys = 0;
|
|
3629
|
|
3630 DEFVAR_LISP ("last-event-screen", &Vlast_event_screen,
|
|
3631 "*The screen in which the most recently read event occurred.");
|
|
3632 Vlast_event_screen = Qnil;
|
|
3633
|
|
3634 DEFVAR_LISP ("help-char", &help_char,
|
|
3635 "Character to recognize as meaning Help.\n\
|
|
3636 When it is read, do `(eval help-form)', and display result if it's a string.\n\
|
|
3637 If the value of `help-form' is nil, this char can be read normally.");
|
|
3638 XSET (help_char, Lisp_Int, Ctl ('H'));
|
|
3639
|
|
3640 DEFVAR_LISP ("help-form", &Vhelp_form,
|
|
3641 "Form to execute when character help-char is read.\n\
|
|
3642 If the form returns a string, that string is displayed.\n\
|
|
3643 If `help-form' is nil, the help char is not recognized.");
|
|
3644 Vhelp_form = Qnil;
|
|
3645
|
|
3646 DEFVAR_LISP ("top-level", &Vtop_level,
|
|
3647 "Form to evaluate when Emacs starts up.\n\
|
|
3648 Useful to set before you dump a modified Emacs.");
|
|
3649 Vtop_level = Qnil;
|
|
3650
|
|
3651 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
|
|
3652 "String used as translate table for keyboard input, or nil.\n\
|
|
3653 Each character is looked up in this string and the contents used instead.\n\
|
|
3654 If string is of length N, character codes N and up are untranslated.");
|
|
3655 Vkeyboard_translate_table = Qnil;
|
|
3656
|
|
3657 #ifdef HAVE_X_WINDOWS
|
|
3658 DEFVAR_LISP ("mouse-event-function", &Vmouse_event_function,
|
|
3659 "Function to call for each mouse event, after the event's definition.\n\
|
|
3660 Called, if non-nil, with one argument, which is the event-list.\n\
|
|
3661 See the variable `mouse-event' for the format of this list.");
|
|
3662 Vmouse_event_function = Qnil;
|
|
3663
|
|
3664 DEFVAR_LISP ("mouse-left-hook", &Vmouse_left_hook,
|
|
3665 "Function to call when mouse leaves window. No arguments.");
|
|
3666 Vmouse_left_hook = Qnil;
|
|
3667
|
|
3668 DEFVAR_LISP ("map-screen-hook", &Vmap_screen_hook,
|
|
3669 "Function to call when screen is mapped. No arguments.");
|
|
3670 Vmap_screen_hook = Qnil;
|
|
3671
|
|
3672 DEFVAR_LISP ("unmap-screen-hook", &Vunmap_screen_hook,
|
|
3673 "Function to call when screen is unmapped. No arguments.");
|
|
3674 Vunmap_screen_hook = Qnil;
|
|
3675
|
|
3676 DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler,
|
|
3677 "Handler for motion events. No arguments.");
|
|
3678 Vmouse_motion_handler = Qnil;
|
|
3679 #endif
|
|
3680
|
|
3681 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
|
|
3682 "Non-nil means prompt with menus in echo area when appropriate.\n\
|
|
3683 This is done when reading from a keymap that has a prompt string,\n\
|
|
3684 for elements that have prompt strings.");
|
|
3685 menu_prompting = 1;
|
|
3686
|
|
3687 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
|
|
3688 "Character to see next line of menu prompt.\n\
|
|
3689 Type this character while in a menu prompt to rotate around the lines of it.");
|
|
3690 XSET (menu_prompt_more_char, Lisp_Int, ' ');
|
|
3691 }
|
|
3692
|
|
3693 keys_of_keyboard ()
|
|
3694 {
|
|
3695 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
|
|
3696 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
|
|
3697 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
|
|
3698 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
|
|
3699 initial_define_key (meta_map, 'x', "execute-extended-command");
|
|
3700 }
|