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