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