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