Mercurial > emacs
annotate src/keyboard.c @ 708:030fb4635335
*** empty log message ***
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Wed, 10 Jun 1992 03:53:16 +0000 |
| parents | e7eb08ed73c0 |
| children | 6ef7049ea916 |
| 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 (); | |
| 1494 XSET (Vlast_event_screen, Lisp_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; | |
| 1613 XSET (Vlast_event_screen, Lisp_Screen, kbd_fetch_ptr->screen); | |
| 708 | 1614 last_event_timestamp = kbd_fetch_ptr->timestamp; |
| 518 | 1615 obj = make_lispy_event (kbd_fetch_ptr); |
| 1616 kbd_fetch_ptr->kind = no_event; | |
| 1617 kbd_fetch_ptr++; | |
| 1618 if (XTYPE (obj) == Lisp_Int) | |
| 1619 XSET (obj, Lisp_Int, XINT (obj) & (meta_key ? 0377 : 0177)); | |
| 1620 } | |
| 1621 else if (do_mouse_tracking && mouse_moved) | |
| 1622 { | |
| 1623 SCREEN_PTR screen; | |
| 1624 Lisp_Object x, y, time; | |
| 1625 | |
| 1626 (*mouse_position_hook) (&screen, &x, &y, &time); | |
| 1627 XSET (Vlast_event_screen, Lisp_Screen, screen); | |
| 1628 | |
| 1629 obj = make_lispy_movement (screen, x, y, time); | |
| 1630 } | |
| 1631 else | |
| 1632 /* We were promised by the above while loop that there was | |
| 1633 something for us to read! */ | |
| 1634 abort (); | |
| 1635 | |
| 1636 input_pending = readable_events (); | |
| 1637 | |
| 1638 return (obj); | |
| 1639 } | |
| 1640 | |
| 1641 /* Caches for modify_event_symbol. */ | |
| 1642 static Lisp_Object func_key_syms; | |
| 1643 static Lisp_Object mouse_syms; | |
| 1644 | |
| 1645 /* You'll notice that this table is arranged to be conveniently | |
| 1646 indexed by X Windows keysym values. */ | |
| 1647 static char *lispy_function_keys[] = | |
| 1648 { | |
| 1649 /* X Keysym value */ | |
| 1650 | |
| 1651 "home", /* 0xff50 */ /* IsCursorKey */ | |
| 1652 "left", | |
| 1653 "up", | |
| 1654 "right", | |
| 1655 "down", | |
| 1656 "prior", | |
| 1657 "next", | |
| 1658 "end", | |
| 1659 "begin", | |
| 1660 0, /* 0xff59 */ | |
| 1661 0, 0, 0, 0, 0, 0, | |
| 1662 "select", /* 0xff60 */ /* IsMiscFunctionKey */ | |
| 1663 "print", | |
| 1664 "execute", | |
| 1665 "insert", | |
| 1666 0, /* 0xff64 */ | |
| 1667 "undo", | |
| 1668 "redo", | |
| 1669 "menu", | |
| 1670 "find", | |
| 1671 "cancel", | |
| 1672 "help", | |
| 1673 "break", /* 0xff6b */ | |
| 1674 | |
| 1675 /* Here are some keys found mostly on HP keyboards. The X event | |
| 1676 handling code will strip bit 29, which flags vendor-specific | |
| 1677 keysyms. */ | |
| 1678 "reset", /* 0x1000ff6c */ | |
| 1679 "system", | |
| 1680 "user", | |
| 1681 "clearline", | |
| 1682 "insertline", | |
| 1683 "deleteline", | |
| 1684 "insertchar", | |
| 1685 "deletechar", | |
| 1686 "backtab", | |
| 1687 "kp_backtab", /* 0x1000ff75 */ | |
| 1688 0, /* 0xff76 */ | |
| 1689 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff7f */ | |
| 1690 "kp-space", /* 0xff80 */ /* IsKeypadKey */ | |
| 1691 0, 0, 0, 0, 0, 0, 0, 0, | |
| 1692 "kp-tab", /* 0xff89 */ | |
| 1693 0, 0, 0, | |
| 1694 "kp-enter", /* 0xff8d */ | |
| 1695 0, 0, 0, | |
| 1696 "kp-f1", /* 0xff91 */ | |
| 1697 "kp-f2", | |
| 1698 "kp-f3", | |
| 1699 "kp-f4", | |
| 1700 0, /* 0xff95 */ | |
| 1701 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
| 1702 "kp-multiply", /* 0xffaa */ | |
| 1703 "kp-add", | |
| 1704 "kp-separator", | |
| 1705 "kp-subtract", | |
| 1706 "kp-decimal", | |
| 1707 "kp-divide", /* 0xffaf */ | |
| 1708 "kp-0", /* 0xffb0 */ | |
| 1709 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9", | |
| 1710 0, /* 0xffba */ | |
| 1711 0, 0, | |
| 1712 "kp-equal", /* 0xffbd */ | |
| 1713 "f1", /* 0xffbe */ /* IsFunctionKey */ | |
| 1714 "f2", "f3", "f4", | |
| 1715 "f5", "f6", "f7", "f8", "f9", "f10", "f11", "f12", | |
| 1716 "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20", | |
| 1717 "f21", "f22", "f23", "f24", "f25", "f26", "f27", "f28", | |
| 1718 "f29", "f30", "f31", "f32", "f33", "f34", "f35" /* 0xffe0 */ | |
| 1719 }; | |
| 1720 | |
| 1721 static char *lispy_mouse_names[] = | |
| 1722 { | |
| 1723 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5" | |
| 1724 }; | |
| 1725 | |
| 1726 /* Given a struct input_event, build the lisp event which represents | |
| 1727 it. If EVENT is 0, build a mouse movement event from the mouse | |
| 1728 movement buffer, which should have a movement event in it. */ | |
| 1729 | |
| 1730 static Lisp_Object | |
| 1731 make_lispy_event (event) | |
| 1732 struct input_event *event; | |
| 1733 { | |
| 1734 #ifdef SWITCH_ENUM_BUG | |
| 1735 switch ((int) event->kind) | |
| 1736 #else | |
| 1737 switch (event->kind) | |
| 1738 #endif | |
| 1739 { | |
| 1740 | |
| 1741 /* A simple keystroke. */ | |
| 1742 case ascii_keystroke: | |
| 1743 return event->code; | |
| 1744 break; | |
| 1745 | |
| 1746 /* A function key. The symbol may need to have modifier prefixes | |
| 1747 tacked onto it. */ | |
| 1748 case non_ascii_keystroke: | |
| 1749 return modify_event_symbol (XFASTINT (event->code), event->modifiers, | |
| 1750 Qfunction_key, | |
| 1751 lispy_function_keys, &func_key_syms, | |
| 1752 (sizeof (lispy_function_keys) | |
| 1753 / sizeof (lispy_function_keys[0]))); | |
| 1754 break; | |
| 1755 | |
| 1756 /* A mouse click - build a list of the relevant information. */ | |
| 1757 case mouse_click: | |
| 1758 { | |
| 1759 int part; | |
| 1760 Lisp_Object window = | |
| 1761 window_from_coordinates (event->screen, | |
| 1762 XINT (event->x), XINT (event->y), | |
| 1763 &part); | |
| 1764 Lisp_Object posn; | |
| 1765 | |
| 1766 if (XTYPE (window) != Lisp_Window) | |
| 1767 posn = Qnil; | |
| 1768 else | |
| 1769 { | |
| 1770 XSETINT (event->x, (XINT (event->x) | |
| 1771 - XINT (XWINDOW (window)->left))); | |
| 1772 XSETINT (event->y, (XINT (event->y) | |
| 1773 - XINT (XWINDOW (window)->top))); | |
| 1774 | |
| 1775 if (part == 1) | |
| 1776 posn = Qmode_line; | |
| 1777 else if (part == 2) | |
| 1778 posn = Qvertical_split; | |
| 1779 else | |
| 1780 XSET (posn, Lisp_Int, | |
| 1781 buffer_posn_from_coords (XWINDOW (window), | |
| 1782 XINT (event->x), | |
| 1783 XINT (event->y))); | |
| 1784 } | |
| 1785 | |
| 1786 return Fcons (modify_event_symbol (XFASTINT (event->code) - 1, | |
| 1787 event->modifiers, | |
| 1788 Qmouse_click, | |
| 1789 lispy_mouse_names, &mouse_syms, | |
| 1790 (sizeof (lispy_mouse_names) | |
| 1791 / sizeof (lispy_mouse_names[0]))), | |
| 1792 Fcons (window, | |
| 1793 Fcons (posn, | |
| 1794 Fcons (Fcons (event->x, event->y), | |
| 708 | 1795 Fcons (make_number |
| 1796 (event->timestamp), | |
| 518 | 1797 Qnil))))); |
| 1798 } | |
| 1799 | |
| 1800 /* A scrollbar click. Build a list containing the relevant | |
| 1801 information. */ | |
| 1802 case scrollbar_click: | |
| 1803 { | |
| 1804 Lisp_Object button | |
| 1805 = modify_event_symbol (XFASTINT (event->code) - 1, | |
| 1806 event->modifiers, | |
| 1807 Qmouse_click, | |
| 1808 lispy_mouse_names, &mouse_syms, | |
| 1809 (sizeof (lispy_mouse_names) | |
| 1810 / sizeof (lispy_mouse_names[0]))); | |
| 1811 return Fcons (event->part, | |
| 1812 Fcons (SCREEN_SELECTED_WINDOW (event->screen), | |
| 1813 Fcons (button, | |
| 1814 Fcons (Fcons (event->x, event->y), | |
| 708 | 1815 Fcons (make_number |
| 1816 (event->timestamp), | |
| 518 | 1817 Qnil))))); |
| 1818 } | |
| 1819 | |
| 1820 /* The 'kind' field of the event is something we don't recognize. */ | |
| 1821 default: | |
| 1822 abort(); | |
| 1823 } | |
| 1824 } | |
| 1825 | |
| 1826 static Lisp_Object | |
| 1827 make_lispy_movement (screen, x, y, time) | |
| 1828 SCREEN_PTR screen; | |
| 1829 Lisp_Object x, y; | |
| 1830 Lisp_Object time; | |
| 1831 { | |
| 1832 Lisp_Object window; | |
| 1833 int ix, iy; | |
| 1834 Lisp_Object posn; | |
| 1835 int part; | |
| 1836 | |
| 1837 ix = XINT (x); | |
| 1838 iy = XINT (y); | |
| 1839 window = (screen | |
| 1840 ? window_from_coordinates (screen, ix, iy, &part) | |
| 1841 : Qnil); | |
| 1842 if (XTYPE (window) != Lisp_Window) | |
| 1843 posn = Qnil; | |
| 1844 else | |
| 1845 { | |
| 1846 ix -= XINT (XWINDOW (window)->left); | |
| 1847 iy -= XINT (XWINDOW (window)->top); | |
| 1848 if (part == 1) | |
| 1849 posn = Qmode_line; | |
| 1850 else if (part == 2) | |
| 1851 posn = Qvertical_split; | |
| 1852 else | |
| 1853 XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window), | |
| 1854 ix, iy)); | |
| 1855 } | |
| 1856 | |
| 1857 XSETINT (x, ix); | |
| 1858 XSETINT (y, iy); | |
| 1859 return Fcons (Qmouse_movement, | |
| 1860 Fcons (window, | |
| 1861 Fcons (posn, | |
| 1862 Fcons (Fcons (x, y), | |
| 1863 Fcons (time, Qnil))))); | |
| 1864 } | |
| 1865 | |
| 1866 | |
| 1867 | |
| 1868 /* Place the written representation of MODIFIERS in BUF, '\0'-terminated, | |
| 1869 and return its length. */ | |
| 1870 | |
| 1871 static int | |
| 1872 format_modifiers (modifiers, buf) | |
| 1873 int modifiers; | |
| 1874 char *buf; | |
| 1875 { | |
| 1876 char *p = buf; | |
| 1877 | |
| 708 | 1878 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } |
| 518 | 1879 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } |
| 1880 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } | |
| 1881 if (modifiers & up_modifier) { *p++ = 'U'; *p++ = '-'; } | |
| 1882 *p = '\0'; | |
| 1883 | |
| 1884 return p - buf; | |
| 1885 } | |
| 1886 | |
| 1887 | |
| 1888 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc), | |
| 1889 return a symbol with the modifiers placed in the canonical order. | |
| 1890 | |
| 1891 Fdefine_key calls this to make sure that (for example) C-M-foo | |
| 1892 and M-C-foo end up being equivalent in the keymap. */ | |
| 1893 | |
| 1894 Lisp_Object | |
| 1895 reorder_modifiers (symbol) | |
| 1896 Lisp_Object symbol; | |
| 1897 { | |
| 1898 struct Lisp_String *name; | |
| 1899 int i; | |
| 1900 int modifiers; | |
| 1901 int not_canonical; | |
| 1902 | |
| 1903 CHECK_SYMBOL (symbol, 1); | |
| 1904 | |
| 1905 modifiers = 0; | |
| 1906 name = XSYMBOL (symbol)->name; | |
| 1907 | |
| 1908 /* Special case for things with only one modifier, which is | |
| 1909 (hopefully) the vast majority of cases. */ | |
| 1910 if (! (name->size >= 4 && name->data[1] == '-' && name->data[3] == '-')) | |
| 1911 return symbol; | |
| 1912 | |
| 1913 for (i = 0; i + 1 < name->size && name->data[i + 1] == '-'; i += 2) | |
| 1914 switch (name->data[i]) | |
| 1915 { | |
| 1916 case 'M': | |
| 1917 not_canonical |= (modifiers & (meta_modifier|ctrl_modifier | |
| 1918 |shift_modifier|up_modifier)); | |
| 1919 modifiers |= meta_modifier; | |
| 1920 break; | |
| 1921 | |
| 1922 case 'C': | |
| 1923 not_canonical |= (modifiers & | |
| 1924 (ctrl_modifier|shift_modifier|up_modifier)); | |
| 1925 modifiers |= ctrl_modifier; | |
| 1926 break; | |
| 1927 | |
| 1928 case 'S': | |
| 1929 not_canonical |= (modifiers & (shift_modifier|up_modifier)); | |
| 1930 modifiers |= shift_modifier; | |
| 1931 break; | |
| 1932 | |
| 1933 case 'U': | |
| 1934 not_canonical |= (modifiers & (up_modifier)); | |
| 1935 modifiers |= up_modifier; | |
| 1936 break; | |
| 1937 | |
| 1938 default: | |
| 1939 goto no_more_modifiers; | |
| 1940 } | |
| 1941 no_more_modifiers: | |
| 1942 | |
| 1943 if (!not_canonical) | |
| 1944 return symbol; | |
| 1945 | |
| 1946 /* The modifiers were out of order, so find a new symbol with the | |
| 1947 mods in order. Since the symbol name could contain nulls, we can't | |
| 1948 use intern here; we have to use Fintern, which expects a genuine | |
| 1949 Lisp_String, and keeps a reference to it. */ | |
| 1950 { | |
| 1951 char *new_mods = (char *) alloca (sizeof ("C-M-S-U-")); | |
| 1952 int len = format_modifiers (modifiers, new_mods); | |
| 1953 Lisp_Object new_name = make_uninit_string (len + name->size - i); | |
| 1954 | |
| 1955 bcopy (new_mods, XSTRING (new_name)->data, len); | |
| 1956 bcopy (name->data + i, XSTRING (new_name)->data + len, name->size - i); | |
| 1957 | |
| 1958 return Fintern (new_name, Qnil); | |
| 1959 } | |
| 1960 } | |
| 1961 | |
| 1962 | |
| 1963 /* For handling events, we often want to produce a symbol whose name | |
| 1964 is a series of modifier key prefixes ("M-", "C-", etcetera) attached | |
| 1965 to some base, like the name of a function key or mouse button. | |
| 1966 modify_event_symbol produces symbols of this sort. | |
| 1967 | |
| 1968 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i] | |
| 1969 is the name of the i'th symbol. TABLE_SIZE is the number of elements | |
| 1970 in the table. | |
| 1971 | |
| 1972 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will | |
| 1973 persist between calls to modify_event_symbol that it can use to | |
| 1974 store a cache of the symbols it's generated for this NAME_TABLE | |
| 1975 before. | |
| 1976 | |
| 1977 SYMBOL_NUM is the number of the base name we want from NAME_TABLE. | |
| 1978 | |
| 1979 MODIFIERS is a set of modifier bits (as given in struct input_events) | |
| 1980 whose prefixes should be applied to the symbol name. | |
| 1981 | |
| 1982 SYMBOL_KIND is the value to be placed in the event_kind property of | |
| 1983 the returned symbol. */ | |
| 1984 | |
| 1985 static Lisp_Object | |
| 1986 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, | |
| 1987 symbol_table, table_size) | |
| 1988 int symbol_num; | |
| 1989 unsigned modifiers; | |
| 1990 Lisp_Object symbol_kind; | |
| 1991 char **name_table; | |
| 1992 Lisp_Object *symbol_table; | |
| 1993 int table_size; | |
| 1994 { | |
| 1995 Lisp_Object *slot, *unmodified_slot; | |
| 1996 | |
| 1997 /* Is this a request for a valid symbol? */ | |
| 1998 if (symbol_num < 0 || symbol_num >= table_size | |
| 1999 || modifiers >= NUM_MODIFIER_COMBOS) | |
| 2000 abort (); | |
| 2001 | |
| 2002 /* If *symbol_table is not a vector of the appropriate size, | |
| 2003 set it to one. */ | |
| 2004 if (XTYPE (*symbol_table) != Lisp_Vector | |
| 2005 || XVECTOR (*symbol_table)->size != table_size) | |
| 2006 *symbol_table = Fmake_vector (make_number (table_size), Qnil); | |
| 2007 | |
| 2008 unmodified_slot = slot = & XVECTOR (*symbol_table)->contents[symbol_num]; | |
| 2009 | |
| 2010 /* If there are modifier keys, there had better be a vector in | |
| 2011 this symbol's position of the symbol_table. */ | |
| 2012 if (modifiers != 0) | |
| 2013 { | |
| 2014 Lisp_Object slot_contents = *slot; | |
| 2015 | |
| 2016 /* If there isn't the right sort of vector there, put one in. */ | |
| 2017 if (XTYPE (slot_contents) != Lisp_Vector | |
| 2018 || XVECTOR (slot_contents)->size != NUM_MODIFIER_COMBOS) | |
| 2019 { | |
| 2020 *slot = Fmake_vector (make_number (NUM_MODIFIER_COMBOS), Qnil); | |
| 2021 | |
| 2022 /* Make sure that the vector has an entry for the unmodified | |
| 2023 symbol, so we can put it on the event_unmodified property. */ | |
| 2024 if (! NILP (slot_contents)) | |
| 2025 XVECTOR (*slot)->contents[0] = slot_contents; | |
| 2026 else | |
| 2027 XVECTOR (*slot)->contents[0] = intern (name_table [symbol_num]); | |
| 2028 } | |
| 2029 } | |
| 2030 | |
| 2031 /* If this entry has been filled in with a modified symbol vector, | |
| 2032 point to the appropriate slot within that. */ | |
| 2033 if (XTYPE (*slot) == Lisp_Vector) | |
| 2034 { | |
| 2035 unmodified_slot = & XVECTOR (*slot)->contents[0]; | |
| 2036 slot = & XVECTOR (*slot)->contents[modifiers]; | |
| 2037 } | |
| 2038 | |
| 2039 /* Make sure we have an unmodified version of the symbol in its | |
| 2040 proper place? */ | |
| 2041 if (NILP (*unmodified_slot)) | |
| 2042 { | |
| 2043 *unmodified_slot = intern (name_table [symbol_num]); | |
| 2044 Fput (*unmodified_slot, Qevent_kind, symbol_kind); | |
| 2045 Fput (*unmodified_slot, Qevent_unmodified, *unmodified_slot); | |
| 2046 } | |
| 2047 | |
| 2048 /* Have we already created a symbol for this combination of modifiers? */ | |
| 2049 if (NILP (*slot)) | |
| 2050 { | |
| 2051 /* No, let's create one. */ | |
| 2052 char *modified_name | |
| 2053 = (char *) alloca (sizeof ("C-M-S-U-") | |
| 2054 + strlen (name_table [symbol_num])); | |
| 2055 | |
| 2056 strcpy (modified_name + format_modifiers (modifiers, modified_name), | |
| 2057 name_table [symbol_num]); | |
| 2058 | |
| 2059 *slot = intern (modified_name); | |
| 2060 Fput (*slot, Qevent_kind, symbol_kind); | |
| 2061 Fput (*slot, Qevent_unmodified, *unmodified_slot); | |
| 2062 } | |
| 2063 | |
| 2064 return *slot; | |
| 2065 } | |
| 2066 | |
| 2067 DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0, | |
| 2068 "Return non-nil iff OBJECT is a representation of a mouse event.\n\ | |
| 2069 A mouse event is a list of five elements whose car is a symbol of the\n\ | |
| 2070 form <MODIFIERS>mouse-<DIGIT>. I hope this is a temporary hack.") | |
| 2071 (object) | |
| 2072 Lisp_Object object; | |
| 2073 { | |
| 2074 if (EVENT_HAS_PARAMETERS (object) | |
| 2075 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)), | |
| 2076 Qmouse_click)) | |
| 2077 return Qt; | |
| 2078 else | |
| 2079 return Qnil; | |
| 2080 } | |
| 2081 | |
| 2082 /* Store into *addr a value nonzero if terminal input chars are available. | |
| 2083 Serves the purpose of ioctl (0, FIONREAD, addr) | |
| 2084 but works even if FIONREAD does not exist. | |
| 2085 (In fact, this may actually read some input.) */ | |
| 2086 | |
| 2087 static void | |
| 2088 get_input_pending (addr) | |
| 2089 int *addr; | |
| 2090 { | |
| 2091 /* First of all, have we already counted some input? */ | |
| 2092 *addr = !NILP (Vquit_flag) || readable_events (); | |
| 2093 | |
| 2094 /* If input is being read as it arrives, and we have none, there is none. */ | |
| 2095 if (*addr > 0 || (interrupt_input && ! interrupts_deferred)) | |
| 2096 return; | |
| 2097 | |
| 2098 /* Try to read some input and see how much we get. */ | |
| 2099 gobble_input (0); | |
| 2100 *addr = !NILP (Vquit_flag) || readable_events (); | |
| 2101 } | |
| 2102 | |
| 2103 /* Interface to read_avail_input, blocking SIGIO if necessary. */ | |
| 2104 | |
| 2105 int | |
| 2106 gobble_input (expected) | |
| 2107 int expected; | |
| 2108 { | |
| 2109 #ifndef VMS | |
| 2110 #ifdef SIGIO | |
| 2111 if (interrupt_input) | |
| 2112 { | |
| 624 | 2113 SIGMASKTYPE mask; |
| 638 | 2114 mask = sigblockx (SIGIO); |
| 518 | 2115 read_avail_input (expected); |
| 638 | 2116 sigsetmask (mask); |
| 518 | 2117 } |
| 2118 else | |
| 2119 #endif | |
| 2120 read_avail_input (expected); | |
| 2121 #endif | |
| 2122 } | |
| 2123 | |
| 2124 #ifndef VMS | |
| 2125 | |
| 2126 /* Read any terminal input already buffered up by the system | |
| 2127 into the kbd_buffer, but do not wait. | |
| 2128 | |
| 2129 EXPECTED should be nonzero if the caller knows there is some input. | |
| 2130 | |
| 2131 Except on VMS, all input is read by this function. | |
| 2132 If interrupt_input is nonzero, this function MUST be called | |
| 2133 only when SIGIO is blocked. | |
| 2134 | |
| 2135 Returns the number of keyboard chars read, or -1 meaning | |
| 2136 this is a bad time to try to read input. */ | |
| 2137 | |
| 2138 static int | |
| 2139 read_avail_input (expected) | |
| 2140 int expected; | |
| 2141 { | |
| 2142 struct input_event buf[KBD_BUFFER_SIZE]; | |
| 2143 register int i; | |
| 2144 int nread; | |
| 2145 | |
| 2146 if (read_socket_hook) | |
| 2147 /* No need for FIONREAD or fcntl; just say don't wait. */ | |
| 2148 nread = (*read_socket_hook) (0, buf, KBD_BUFFER_SIZE, expected, expected); | |
| 2149 else | |
| 2150 { | |
| 2151 unsigned char cbuf[KBD_BUFFER_SIZE]; | |
| 2152 | |
| 2153 #ifdef FIONREAD | |
| 2154 /* Find out how much input is available. */ | |
| 2155 if (ioctl (0, FIONREAD, &nread) < 0) | |
| 2156 /* Formerly simply reported no input, but that sometimes led to | |
| 2157 a failure of Emacs to terminate. | |
| 2158 SIGHUP seems appropriate if we can't reach the terminal. */ | |
| 2159 kill (getpid (), SIGHUP); | |
| 2160 if (nread == 0) | |
| 2161 return 0; | |
| 2162 if (nread > sizeof cbuf) | |
| 2163 nread = sizeof cbuf; | |
| 2164 #else /* no FIONREAD */ | |
| 2165 #ifdef USG | |
| 2166 /* Read some input if available, but don't wait. */ | |
| 2167 nread = sizeof cbuf; | |
| 2168 fcntl (fileno (stdin), F_SETFL, O_NDELAY); | |
| 2169 #else | |
| 2170 you lose; | |
| 2171 #endif | |
| 2172 #endif | |
| 2173 | |
| 2174 /* Now read; for one reason or another, this will not block. */ | |
| 2175 while (1) | |
| 2176 { | |
| 2177 nread = read (fileno (stdin), cbuf, nread); | |
| 2178 #ifdef AIX | |
| 2179 /* The kernel sometimes fails to deliver SIGHUP for ptys. | |
| 2180 This looks incorrect, but it isn't, because _BSD causes | |
| 2181 O_NDELAY to be defined in fcntl.h as O_NONBLOCK, | |
| 2182 and that causes a value other than 0 when there is no input. */ | |
| 2183 if (nread == 0) | |
| 2184 kill (SIGHUP, 0); | |
| 2185 #endif | |
| 2186 /* Retry the read if it is interrupted. */ | |
| 2187 if (nread >= 0 | |
| 2188 || ! (errno == EAGAIN || errno == EFAULT | |
| 2189 #ifdef EBADSLT | |
| 2190 || errno == EBADSLT | |
| 2191 #endif | |
| 2192 )) | |
| 2193 break; | |
| 2194 } | |
| 2195 | |
| 2196 #ifndef FIONREAD | |
| 2197 #ifdef USG | |
| 2198 fcntl (fileno (stdin), F_SETFL, 0); | |
| 2199 #endif /* USG */ | |
| 2200 #endif /* no FIONREAD */ | |
| 2201 for (i = 0; i < nread; i++) | |
| 2202 { | |
| 2203 buf[i].kind = ascii_keystroke; | |
| 2204 XSET (buf[i].code, Lisp_Int, cbuf[i]); | |
| 2205 buf[i].screen = selected_screen; | |
| 2206 } | |
| 2207 } | |
| 2208 | |
| 2209 /* Scan the chars for C-g and store them in kbd_buffer. */ | |
| 2210 for (i = 0; i < nread; i++) | |
| 2211 { | |
| 2212 kbd_buffer_store_event (&buf[i]); | |
| 2213 /* Don't look at input that follows a C-g too closely. | |
| 2214 This reduces lossage due to autorepeat on C-g. */ | |
| 2215 if (buf[i].kind == ascii_keystroke | |
| 2216 && XINT(buf[i].code) == quit_char) | |
| 2217 break; | |
| 2218 } | |
| 2219 | |
| 2220 return nread; | |
| 2221 } | |
| 2222 #endif /* not VMS */ | |
| 2223 | |
| 2224 #ifdef SIGIO /* for entire page */ | |
| 2225 /* Note SIGIO has been undef'd if FIONREAD is missing. */ | |
| 2226 | |
| 2227 input_available_signal (signo) | |
| 2228 int signo; | |
| 2229 { | |
| 2230 /* Must preserve main program's value of errno. */ | |
| 2231 int old_errno = errno; | |
| 2232 #ifdef BSD4_1 | |
| 2233 extern int select_alarmed; | |
| 2234 #endif | |
| 2235 | |
| 2236 #ifdef USG | |
| 2237 /* USG systems forget handlers when they are used; | |
| 2238 must reestablish each time */ | |
| 2239 signal (signo, input_available_signal); | |
| 2240 #endif /* USG */ | |
| 2241 | |
| 2242 #ifdef BSD4_1 | |
| 2243 sigisheld (SIGIO); | |
| 2244 #endif | |
| 2245 | |
| 648 | 2246 if (input_available_clear_time) |
| 2247 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); | |
| 518 | 2248 |
| 2249 while (1) | |
| 2250 { | |
| 2251 int nread; | |
| 2252 nread = read_avail_input (1); | |
| 2253 /* -1 means it's not ok to read the input now. | |
| 2254 UNBLOCK_INPUT will read it later; now, avoid infinite loop. | |
| 2255 0 means there was no keyboard input available. */ | |
| 2256 if (nread <= 0) | |
| 2257 break; | |
| 2258 | |
| 2259 #ifdef BSD4_1 | |
| 2260 select_alarmed = 1; /* Force the select emulator back to life */ | |
| 2261 #endif | |
| 2262 } | |
| 2263 | |
| 2264 #ifdef BSD4_1 | |
| 2265 sigfree (); | |
| 2266 #endif | |
| 2267 errno = old_errno; | |
| 2268 } | |
| 2269 #endif /* SIGIO */ | |
| 2270 | |
| 2271 /* Return the prompt-string of a sparse keymap. | |
| 2272 This is the first element which is a string. | |
| 2273 Return nil if there is none. */ | |
| 2274 | |
| 2275 Lisp_Object | |
| 2276 map_prompt (map) | |
| 2277 Lisp_Object map; | |
| 2278 { | |
| 2279 while (CONSP (map)) | |
| 2280 { | |
| 2281 register Lisp_Object tem; | |
| 2282 tem = Fcar (map); | |
| 2283 if (XTYPE (tem) == Lisp_String) | |
| 2284 return tem; | |
| 2285 map = Fcdr (map); | |
| 2286 } | |
| 2287 return Qnil; | |
| 2288 } | |
| 2289 | |
| 2290 static int echo_flag; | |
| 2291 static int echo_now; | |
| 2292 | |
| 2293 /* Read a character like read_char but optionally prompt based on maps | |
| 2294 LOCAL and GLOBAL. | |
| 2295 | |
| 2296 The prompting is done based on the prompt-string of the map | |
| 2297 and the strings associated with various map elements. */ | |
| 2298 | |
| 2299 Lisp_Object | |
| 2300 read_char_menu_prompt (prompt, local, global) | |
| 2301 int prompt; | |
| 2302 Lisp_Object local, global; | |
| 2303 { | |
| 2304 register Lisp_Object rest, name; | |
| 2305 Lisp_Object hmap; | |
| 2306 int nlength; | |
| 2307 int width = SCREEN_WIDTH (selected_screen) - 4; | |
| 2308 char *menu = (char *) alloca (width); | |
| 2309 | |
| 2310 /* Use local over global Menu maps */ | |
| 2311 | |
| 2312 if (menu_prompting) | |
| 2313 return read_char (!prompt); | |
| 2314 | |
| 2315 /* We can't get prompt strings from dense keymaps. */ | |
| 2316 if (CONSP (local) | |
| 2317 && EQ (Fcar (local), Qkeymap) | |
| 2318 && !(CONSP (XCONS (local)->cdr) | |
| 2319 && XTYPE (XCONS (XCONS (local)->cdr)->car) == Lisp_Vector)) | |
| 2320 hmap = local; | |
| 2321 else if (CONSP (global) | |
| 2322 && EQ (Fcar (global), Qkeymap) | |
| 2323 && !(CONSP (XCONS (global)->cdr) | |
| 2324 && XTYPE (XCONS (XCONS (global)->cdr)->car) == Lisp_Vector)) | |
| 2325 hmap = global; | |
| 2326 else | |
| 2327 return read_char (!prompt); | |
| 2328 | |
| 2329 /* Get the map's prompt string. */ | |
| 2330 name = map_prompt (hmap); | |
| 2331 if (NILP (name)) | |
| 2332 return read_char (!prompt); | |
| 2333 | |
| 2334 /* Prompt string always starts with map's prompt, and a space. */ | |
| 2335 strcpy (menu, XSTRING (name)->data); | |
| 2336 nlength = XSTRING (name)->size; | |
| 2337 menu[nlength++] = ' '; | |
| 2338 menu[nlength] = 0; | |
| 2339 | |
| 2340 /* Start prompting at start of map. */ | |
| 2341 rest = hmap; /* Current menu item */ | |
| 2342 | |
| 2343 /* Present the documented bindings, a line at a time. */ | |
| 2344 while (1) | |
| 2345 { | |
| 2346 int notfirst = 0; | |
| 2347 int i = nlength; | |
| 2348 Lisp_Object obj; | |
| 2349 int ch; | |
| 2350 | |
| 2351 /* If reached end of map, start at beginning. */ | |
| 2352 if (NILP (Fcdr (rest))) rest = hmap; | |
| 2353 | |
| 2354 /* Loop over elements of map. */ | |
| 2355 while (!NILP (rest) && i < width) | |
| 2356 { | |
| 2357 Lisp_Object s; | |
| 2358 | |
| 2359 /* Look for conses whose cadrs are strings. */ | |
| 2360 s = Fcar_safe (Fcdr_safe (Fcar_safe (rest))); | |
| 2361 if (XTYPE (s) != Lisp_String) | |
| 2362 /* Ignore all other elements. */ | |
| 2363 ; | |
| 2364 /* If first such element, or enough room, add string to prompt. */ | |
| 2365 else if (XSTRING (s)->size + i < width | |
| 2366 || !notfirst) | |
| 2367 { | |
| 2368 int thiswidth; | |
| 2369 | |
| 2370 /* Punctuate between strings. */ | |
| 2371 if (notfirst) | |
| 2372 { | |
| 2373 strcpy (menu + i, ", "); | |
| 2374 i += 2; | |
| 2375 } | |
| 2376 notfirst = 1; | |
| 2377 | |
| 2378 /* Add as much of string as fits. */ | |
| 2379 thiswidth = XSTRING (s)->size; | |
| 2380 if (thiswidth + i > width) | |
| 2381 thiswidth = width - i; | |
| 2382 bcopy (XSTRING (s)->data, menu + i, thiswidth); | |
| 2383 i += thiswidth; | |
| 2384 } | |
| 2385 else | |
| 2386 { | |
| 2387 /* If some elts don't fit, show there are more. */ | |
| 2388 strcpy (menu + i, "..."); | |
| 2389 break; | |
| 2390 } | |
| 2391 | |
| 2392 /* Move past this element. */ | |
| 2393 rest = Fcdr_safe (rest); | |
| 2394 } | |
| 2395 | |
| 2396 /* Prompt with that and read response. */ | |
| 2397 message1 (menu); | |
| 2398 obj = read_char (1); | |
| 2399 | |
| 2400 if (XTYPE (obj) != Lisp_Int) | |
| 2401 return obj; | |
| 2402 else | |
| 2403 ch = XINT (obj); | |
| 2404 | |
| 2405 if (obj != menu_prompt_more_char | |
| 2406 && (XTYPE (menu_prompt_more_char) != Lisp_Int | |
| 2407 || obj != make_number (Ctl (XINT (menu_prompt_more_char))))) | |
| 2408 return obj; | |
| 2409 } | |
| 2410 } | |
| 2411 | |
| 2412 | |
| 2413 /* Reading key sequences. */ | |
| 2414 | |
| 2415 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings | |
| 2416 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a | |
| 2417 keymap, or nil otherwise. Return the index of the first keymap in | |
| 2418 which KEY has any binding, or NMAPS if no map has a binding. | |
| 2419 | |
| 2420 If KEY is a meta ASCII character, treat it like meta-prefix-char | |
| 2421 followed by the corresponding non-meta character. Keymaps in | |
| 2422 CURRENT with non-prefix bindings for meta-prefix-char become nil in | |
| 2423 NEXT. | |
| 2424 | |
| 2425 When KEY is not defined in any of the keymaps, if it is an upper | |
| 2426 case letter and there are bindings for the corresponding lower-case | |
| 2427 letter, return the bindings for the lower-case letter. | |
| 2428 | |
| 2429 NEXT may == CURRENT. */ | |
| 2430 | |
| 2431 static int | |
| 2432 follow_key (key, nmaps, current, defs, next) | |
| 2433 Lisp_Object key; | |
| 2434 Lisp_Object *current, *defs, *next; | |
| 2435 int nmaps; | |
| 2436 { | |
| 2437 int i, first_binding; | |
| 2438 | |
| 2439 /* If KEY is a meta ASCII character, treat it like meta-prefix-char | |
| 2440 followed by the corresponding non-meta character. */ | |
| 2441 if (XTYPE (key) == Lisp_Int | |
| 2442 && XINT (key) >= 0200) | |
| 2443 { | |
| 2444 for (i = 0; i < nmaps; i++) | |
| 2445 if (! NILP (current[i])) | |
| 2446 { | |
| 2447 next[i] = get_keyelt (access_keymap (current[i], | |
| 2448 meta_prefix_char)); | |
| 2449 | |
| 2450 /* Note that since we pass the resulting bindings through | |
| 2451 get_keymap_1, non-prefix bindings for meta-prefix-char | |
| 2452 disappear. */ | |
| 2453 next[i] = get_keymap_1 (next[i], 0); | |
| 2454 } | |
| 2455 else | |
| 2456 next[i] = Qnil; | |
| 2457 | |
| 2458 current = next; | |
| 2459 XSET (key, Lisp_Int, XFASTINT (key) & 0177); | |
| 2460 } | |
| 2461 | |
| 2462 first_binding = nmaps; | |
| 2463 for (i = nmaps - 1; i >= 0; i--) | |
| 2464 { | |
| 2465 if (! NILP (current[i])) | |
| 2466 { | |
| 2467 defs[i] = get_keyelt (access_keymap (current[i], key)); | |
| 2468 if (! NILP (defs[i])) | |
| 2469 first_binding = i; | |
| 2470 } | |
| 2471 else | |
| 2472 defs[i] = Qnil; | |
| 2473 } | |
| 2474 | |
| 2475 /* When KEY is not defined in any of the keymaps, if it is an upper | |
| 2476 case letter and there are bindings for the corresponding | |
| 2477 lower-case letter, return the bindings for the lower-case letter. */ | |
| 2478 if (first_binding == nmaps | |
| 2479 && XTYPE (key) == Lisp_Int | |
| 2480 && UPPERCASEP (XINT (key))) | |
| 2481 { | |
| 2482 XSETINT (key, DOWNCASE (XINT (key))); | |
| 2483 | |
| 2484 first_binding = nmaps; | |
| 2485 for (i = nmaps - 1; i >= 0; i--) | |
| 2486 { | |
| 2487 if (! NILP (current[i])) | |
| 2488 { | |
| 2489 defs[i] = get_keyelt (access_keymap (current[i], key)); | |
| 2490 if (! NILP (defs[i])) | |
| 2491 first_binding = i; | |
| 2492 } | |
| 2493 else | |
| 2494 defs[i] = Qnil; | |
| 2495 } | |
| 2496 } | |
| 2497 | |
| 2498 /* Given the set of bindings we've found, produce the next set of maps. */ | |
| 2499 for (i = 0; i < nmaps; i++) | |
| 2500 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0); | |
| 2501 | |
| 2502 return first_binding; | |
| 2503 } | |
| 2504 | |
| 2505 /* Read a sequence of keys that ends with a non prefix character | |
| 2506 according to the keymaps in KEYMAPS[0..nmaps-1]. Keymaps appearing | |
| 2507 earlier in KEYMAPS take precidence over those appearing later. | |
| 2508 | |
| 2509 Store the sequence in KEYBUF, a buffer of size BUFSIZE. Prompt | |
| 2510 with PROMPT. Echo starting immediately unless `prompt' is 0. | |
| 2511 Return the length of the key sequence stored. | |
| 2512 | |
| 2513 If the user switches screens in the midst of a key sequence, we | |
| 2514 throw away any prefix we have read so far, and start afresh. For | |
| 2515 mouse clicks, we look up the click in the keymap of the buffer | |
| 2516 clicked on, throwing away any prefix if it is not the same buffer | |
| 2517 we used to be reading from. */ | |
| 2518 | |
| 2519 static int | |
| 2520 read_key_sequence (keybuf, bufsize, prompt) | |
| 2521 Lisp_Object *keybuf; | |
| 2522 int bufsize; | |
| 2523 Lisp_Object prompt; | |
| 2524 { | |
| 2525 /* How many keys there are in the current key sequence. */ | |
| 2526 int t; | |
| 2527 | |
| 2528 /* The buffer that the most recently read event was typed at. This | |
| 2529 helps us read mouse clicks according to the buffer clicked in, | |
| 2530 and notice when the mouse has moved from one screen to another. */ | |
| 2531 struct buffer *last_event_buffer = current_buffer; | |
| 2532 | |
| 2533 /* The length of the echo buffer when we started reading, and | |
| 2534 the length of this_command_keys when we started reading. */ | |
| 2535 int echo_start; | |
| 2536 int keys_start = this_command_key_count; | |
| 2537 | |
| 2538 /* The number of keymaps we're scanning right now, and the number of | |
| 2539 keymaps we have allocated space for. */ | |
| 2540 int nmaps; | |
| 2541 int nmaps_allocated = 0; | |
| 2542 | |
| 2543 /* current[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1] | |
| 2544 in the current keymaps, or nil where it is not a prefix. */ | |
| 2545 Lisp_Object *current; | |
| 2546 | |
| 2547 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in | |
| 2548 the current keymaps. */ | |
| 2549 Lisp_Object *defs; | |
| 2550 | |
| 2551 /* The lowest i such that defs[i] is non-nil. */ | |
| 2552 int first_binding; | |
| 2553 | |
| 2554 /* If mock_input > t, then KEYBUF[t] should be read as the next | |
| 2555 input key. */ | |
| 2556 int mock_input = 0; | |
| 2557 | |
| 2558 /* If the sequence is unbound in current[], keymap[fkey_start..fkey_end-1] | |
| 2559 is a prefix in Vfunction_key_map, and fkey_map is its binding. | |
| 2560 These might be > t, indicating that all function key scanning should | |
| 2561 hold off until t reaches them. */ | |
| 2562 int fkey_start = 0, fkey_end = 0; | |
| 2563 Lisp_Object fkey_map = Vfunction_key_map; | |
| 2564 | |
| 2565 if (INTERACTIVE) | |
| 2566 { | |
| 2567 if (prompt) | |
| 2568 echo_prompt (prompt); | |
| 2569 else if (cursor_in_echo_area) | |
| 2570 /* This doesn't put in a dash if the echo buffer is empty, so | |
| 2571 you don't always see a dash hanging out in the minibuffer. */ | |
| 2572 echo_dash (); | |
| 2573 echo_start = echo_length (); | |
| 2574 } | |
| 2575 | |
| 2576 /* If there is no function key map, turn of function key scanning. */ | |
| 2577 if (NILP (Fkeymapp (Vfunction_key_map))) | |
| 2578 fkey_start = fkey_end = bufsize + 1; | |
| 2579 | |
| 2580 restart: | |
| 2581 t = 0; | |
| 2582 this_command_key_count = keys_start; | |
| 2583 | |
| 2584 { | |
| 2585 Lisp_Object *maps; | |
| 2586 | |
| 2587 nmaps = current_minor_maps (0, &maps) + 2; | |
| 2588 if (nmaps > nmaps_allocated) | |
| 2589 { | |
| 2590 current = (Lisp_Object *) alloca (nmaps * sizeof (current[0])); | |
| 2591 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0])); | |
| 2592 nmaps_allocated = nmaps; | |
| 2593 } | |
| 2594 bcopy (maps, current, (nmaps - 2) * sizeof (current[0])); | |
| 2595 current[nmaps-2] = last_event_buffer->keymap; | |
| 2596 current[nmaps-1] = global_map; | |
| 2597 } | |
| 2598 | |
| 2599 /* Find an accurate initial value for first_binding. */ | |
| 2600 for (first_binding = 0; first_binding < nmaps; first_binding++) | |
| 2601 if (! NILP (current[first_binding])) | |
| 2602 break; | |
| 2603 | |
| 2604 while ((first_binding < nmaps && ! NILP (current[first_binding])) | |
| 2605 || (first_binding >= nmaps && fkey_start < t)) | |
| 2606 { | |
| 2607 Lisp_Object key; | |
| 2608 | |
| 2609 if (t >= bufsize) | |
| 2610 error ("key sequence too long"); | |
| 2611 | |
| 2612 /* Are we reading keys stuffed into keybuf? */ | |
| 2613 if (t < mock_input) | |
| 2614 { | |
| 2615 key = keybuf[t]; | |
| 2616 add_command_key (key); | |
| 2617 echo_char (key); | |
| 2618 } | |
| 2619 /* Otherwise, we should actually read a character. */ | |
| 2620 else | |
| 2621 { | |
| 2622 struct buffer *buf; | |
| 2623 | |
| 2624 if (!prompt && INTERACTIVE) | |
| 2625 key = read_char_menu_prompt (prompt, Qnil, Qnil); | |
| 2626 else | |
| 2627 key = read_char (!prompt); | |
| 2628 | |
| 2629 /* The above routines return -1 at the end of a macro. | |
| 2630 Emacs 18 handles this by returning immediately with a | |
| 2631 zero, so that's what we'll do. */ | |
| 2632 if (XTYPE (key) == Lisp_Int && XINT (key) < 0) | |
| 2633 return 0; | |
| 2634 | |
| 2635 Vquit_flag = Qnil; | |
| 2636 | |
| 2637 /* What buffer was this event typed/moused at? */ | |
| 2638 if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol) | |
| 2639 buf = (XBUFFER | |
| 2640 (XWINDOW | |
| 2641 (SCREEN_SELECTED_WINDOW | |
| 2642 (XSCREEN (Vlast_event_screen)))->buffer)); | |
| 2643 else if (EVENT_HAS_PARAMETERS (key)) | |
| 2644 { | |
| 2645 Lisp_Object window = EVENT_WINDOW (key); | |
| 2646 | |
| 2647 if (NILP (window)) | |
| 2648 abort (); | |
| 2649 | |
| 2650 buf = XBUFFER (XWINDOW (window)->buffer); | |
| 2651 } | |
| 2652 else | |
| 2653 abort (); | |
| 2654 | |
| 2655 /* If this event came to a different buffer than the one | |
| 2656 we're currently in, switch buffers and start a new key | |
| 2657 sequence, starting with key. */ | |
| 2658 if (buf != last_event_buffer) | |
| 2659 { | |
| 2660 last_event_buffer = buf; | |
| 2661 Fselect_screen (Vlast_event_screen, Qnil); | |
| 2662 | |
| 2663 /* Arrange to read key as the next event. */ | |
| 2664 keybuf[0] = key; | |
| 2665 mock_input = 1; | |
| 2666 | |
| 2667 /* Truncate the key sequence in the echo area. */ | |
| 2668 if (INTERACTIVE) | |
| 2669 echo_truncate (echo_start); | |
| 2670 | |
| 2671 goto restart; | |
| 2672 } | |
| 2673 } | |
| 2674 | |
| 2675 first_binding = (follow_key (key, | |
| 2676 nmaps - first_binding, | |
| 2677 current + first_binding, | |
| 2678 defs + first_binding, | |
| 2679 current + first_binding) | |
| 2680 + first_binding); | |
| 2681 keybuf[t++] = key; | |
| 2682 | |
| 2683 /* If the sequence is unbound, see if we can hang a function key | |
| 2684 off the end of it. Don't reread the expansion of a function key. */ | |
| 2685 if (first_binding >= nmaps | |
| 2686 && t > mock_input) | |
| 2687 { | |
| 2688 Lisp_Object fkey_next; | |
| 2689 | |
| 2690 /* Scan from fkey_end until we find a bound suffix. */ | |
| 2691 while (fkey_end < t) | |
| 2692 { | |
| 2693 fkey_next = | |
| 2694 get_keyelt (access_keymap (fkey_map, keybuf[fkey_end++])); | |
| 2695 /* If keybuf[fkey_start..fkey_next] is bound in the | |
| 547 | 2696 function key map and it's a suffix of the current |
| 2697 sequence (i.e. fkey_next == t), replace it with | |
| 2698 the binding and restart with fkey_start at the end. */ | |
| 518 | 2699 if (XTYPE (fkey_next) == Lisp_Vector |
| 2700 && fkey_end == t) | |
| 2701 { | |
| 2702 t = fkey_start + XVECTOR (fkey_next)->size; | |
| 2703 if (t >= bufsize) | |
| 2704 error ("key sequence too long"); | |
| 2705 | |
| 2706 bcopy (XVECTOR (fkey_next)->contents, | |
| 2707 keybuf + fkey_start, | |
| 2708 (t - fkey_start) * sizeof (keybuf[0])); | |
| 2709 | |
| 2710 mock_input = t; | |
| 2711 fkey_start = fkey_end = t; | |
| 2712 | |
| 2713 /* Truncate the key sequence in the echo area. */ | |
| 2714 if (INTERACTIVE) | |
| 2715 echo_truncate (echo_start); | |
| 2716 | |
| 2717 goto restart; | |
| 2718 } | |
| 2719 | |
| 2720 fkey_map = get_keymap_1 (fkey_next, 0); | |
| 2721 | |
| 547 | 2722 /* If we no longer have a bound suffix, try a new positions for |
| 2723 fkey_start. */ | |
| 518 | 2724 if (NILP (fkey_map)) |
| 2725 { | |
| 2726 fkey_end = ++fkey_start; | |
| 2727 fkey_map = Vfunction_key_map; | |
| 2728 } | |
| 2729 } | |
| 2730 } | |
| 2731 } | |
| 2732 | |
| 2733 read_key_sequence_cmd = (first_binding < nmaps | |
| 2734 ? defs[first_binding] | |
| 2735 : Qnil); | |
| 2736 | |
| 2737 return t; | |
| 2738 } | |
| 2739 | |
|
691
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2740 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 2, 0, |
| 518 | 2741 "Read a sequence of keystrokes and return as a string or vector.\n\ |
| 2742 The sequence is sufficient to specify a non-prefix command in the\n\ | |
| 2743 current local and global maps.\n\ | |
| 2744 \n\ | |
|
691
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2745 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
|
2746 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
|
2747 as a continuation of the previous key.\n\ |
| 518 | 2748 \n\ |
| 2749 If Emacs is running on multiple screens, switching between screens in\n\ | |
| 2750 the midst of a keystroke will toss any prefix typed so far. A C-g\n\ | |
| 2751 typed while in this function is treated like any other character, and\n\ | |
| 2752 `quit-flag' is not set.") | |
|
691
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2753 (prompt, continue_echo) |
|
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2754 Lisp_Object prompt, continue_echo; |
| 518 | 2755 { |
| 2756 Lisp_Object keybuf[30]; | |
| 2757 register int i; | |
| 2758 struct gcpro gcpro1, gcpro2; | |
| 2759 | |
| 2760 if (!NILP (prompt)) | |
| 2761 CHECK_STRING (prompt, 0); | |
| 2762 QUIT; | |
| 2763 | |
| 2764 bzero (keybuf, sizeof keybuf); | |
| 2765 GCPRO1 (keybuf[0]); | |
| 2766 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0])); | |
| 2767 | |
|
691
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2768 if (! NILP (continue_echo)) |
|
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2769 this_command_key_count = 0; |
|
cae8c3ef1677
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
687
diff
changeset
|
2770 |
| 518 | 2771 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), |
| 2772 NILP (prompt) ? 0 : XSTRING (prompt)->data); | |
| 2773 | |
| 2774 UNGCPRO; | |
| 2775 return make_array (i, keybuf); | |
| 2776 } | |
| 2777 | |
| 2778 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0, | |
| 2779 "Execute CMD as an editor command.\n\ | |
| 2780 CMD must be a symbol that satisfies the `commandp' predicate.\n\ | |
| 2781 Optional second arg RECORD-FLAG non-nil\n\ | |
| 2782 means unconditionally put this command in `command-history'.\n\ | |
| 2783 Otherwise, that is done only if an arg is read using the minibuffer.") | |
| 2784 (cmd, record) | |
| 2785 Lisp_Object cmd, record; | |
| 2786 { | |
| 2787 register Lisp_Object final; | |
| 2788 register Lisp_Object tem; | |
| 2789 Lisp_Object prefixarg; | |
| 2790 struct backtrace backtrace; | |
| 2791 extern int debug_on_next_call; | |
| 2792 | |
| 2793 prefixarg = Vprefix_arg, Vprefix_arg = Qnil; | |
| 2794 Vcurrent_prefix_arg = prefixarg; | |
| 2795 debug_on_next_call = 0; | |
| 2796 | |
| 2797 if (XTYPE (cmd) == Lisp_Symbol) | |
| 2798 { | |
| 2799 tem = Fget (cmd, Qdisabled); | |
| 2800 if (!NILP (tem)) | |
| 2801 return call1 (Vrun_hooks, Vdisabled_command_hook); | |
| 2802 } | |
| 2803 | |
| 2804 while (1) | |
| 2805 { | |
| 648 | 2806 final = Findirect_function (cmd); |
| 518 | 2807 |
| 2808 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload))) | |
| 2809 do_autoload (final, cmd); | |
| 2810 else | |
| 2811 break; | |
| 2812 } | |
| 2813 | |
| 2814 if (XTYPE (final) == Lisp_String | |
| 2815 || XTYPE (final) == Lisp_Vector) | |
| 2816 { | |
| 2817 /* If requested, place the macro in the command history. For | |
| 2818 other sorts of commands, call-interactively takes care of | |
| 2819 this. */ | |
| 2820 if (!NILP (record)) | |
| 2821 Vcommand_history | |
| 2822 = Fcons (Fcons (Qexecute_kbd_macro, | |
| 2823 Fcons (final, Fcons (prefixarg, Qnil))), | |
| 2824 Vcommand_history); | |
| 2825 | |
| 2826 return Fexecute_kbd_macro (final, prefixarg); | |
| 2827 } | |
| 2828 if (CONSP (final) || XTYPE (final) == Lisp_Subr | |
| 2829 || XTYPE (final) == Lisp_Compiled) | |
| 2830 { | |
| 2831 backtrace.next = backtrace_list; | |
| 2832 backtrace_list = &backtrace; | |
| 2833 backtrace.function = &Qcall_interactively; | |
| 2834 backtrace.args = &cmd; | |
| 2835 backtrace.nargs = 1; | |
| 2836 backtrace.evalargs = 0; | |
| 2837 | |
| 2838 tem = Fcall_interactively (cmd, record); | |
| 2839 | |
| 2840 backtrace_list = backtrace.next; | |
| 2841 return tem; | |
| 2842 } | |
| 2843 return Qnil; | |
| 2844 } | |
| 2845 | |
| 2846 #if 0 | |
| 2847 DEFUN ("execute-mouse-event", Fexecute_mouse_event, Sexecute_mouse_event, | |
| 2848 1, 1, 0, | |
| 2849 "Execute the definition of the mouse-click event EVENT.\n\ | |
| 2850 The handler function is found by looking the event's key sequence up\n\ | |
| 2851 in the buffer's local mouse map and in `global-mouse-map'.\n\ | |
| 2852 \n\ | |
| 2853 After running the handler, call the value of `mouse-event-function'\n\ | |
| 2854 with EVENT as arg.") | |
| 2855 (event) | |
| 2856 Lisp_Object event; | |
| 2857 { | |
| 2858 Lisp_Object tem; | |
| 2859 Lisp_Object mouse_cmd; | |
| 2860 Lisp_Object keyseq, window, screen_part, pos, time; | |
| 2861 | |
| 2862 #ifndef HAVE_X11 | |
| 2863 Vmouse_event = event; | |
| 2864 #endif | |
| 2865 | |
| 2866 if (EQ (event, Qnil)) | |
| 2867 { | |
| 2868 bitch_at_user (); | |
| 2869 return Qnil; | |
| 2870 } | |
| 2871 | |
| 2872 CHECK_CONS (event, 0); | |
| 2873 pos = Fcar (event); | |
| 2874 window = Fcar (Fcdr (event)); | |
| 2875 screen_part = Fcar (Fcdr (Fcdr (event))); | |
| 2876 keyseq = Fcar (Fcdr (Fcdr (Fcdr (event)))); | |
| 2877 time = Fcar (Fcdr (Fcdr (Fcdr (Fcdr (event))))); | |
| 2878 CHECK_STRING (keyseq, 0); | |
| 2879 CHECK_WINDOW (window, 0); | |
| 2880 | |
| 2881 /* Look up KEYSEQ in the buffer's local mouse map, then in global one. */ | |
| 2882 | |
| 2883 mouse_cmd = Qnil; | |
| 2884 | |
| 2885 if (!NILP (XWINDOW (window)->buffer)) | |
| 2886 { | |
| 2887 Lisp_Object local_map; | |
| 2888 | |
| 2889 local_map = XBUFFER (XWINDOW (window)->buffer)->mouse_map; | |
| 2890 tem = Fkeymapp (local_map); | |
| 2891 if (!NILP (tem)) | |
| 2892 mouse_cmd = Flookup_key (local_map, keyseq); | |
| 2893 /* A number as value means the key is too long; treat as undefined. */ | |
| 2894 if (XTYPE (mouse_cmd) == Lisp_Int) | |
| 2895 mouse_cmd = Qnil; | |
| 2896 } | |
| 2897 | |
| 2898 tem = Fkeymapp (Vglobal_mouse_map); | |
| 2899 if (NILP (mouse_cmd) && !NILP (tem)) | |
| 2900 mouse_cmd = Flookup_key (Vglobal_mouse_map, keyseq); | |
| 2901 if (XTYPE (mouse_cmd) == Lisp_Int) | |
| 2902 mouse_cmd = Qnil; | |
| 2903 | |
| 2904 if (NILP (mouse_cmd)) | |
| 2905 { | |
| 2906 /* This button/shift combination is not defined. | |
| 2907 If it is a button-down event, ring the bell. */ | |
| 2908 #ifdef HAVE_X11 | |
| 2909 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 0x18 == 0) | |
| 2910 #else | |
| 2911 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 4 == 0) | |
| 2912 #endif | |
| 2913 bitch_at_user (); | |
| 2914 } | |
| 2915 else | |
| 2916 { | |
| 2917 SCREEN_PTR s = XSCREEN (WINDOW_SCREEN (XWINDOW (window))); | |
| 2918 | |
| 2919 #ifndef HAVE_X11 | |
| 2920 Vmouse_window = s->selected_window; | |
| 2921 #endif /* HAVE_X11 */ | |
| 2922 /* It's defined; call the definition. */ | |
| 2923 Vprefix_arg = Qnil; | |
| 2924 if (!NILP (screen_part)) | |
| 2925 { | |
| 2926 /* For a scroll-bar click, set the prefix arg | |
| 2927 to the number of lines down from the top the click was. | |
| 2928 Many scroll commands want to scroll by this many lines. */ | |
| 2929 Lisp_Object position; | |
| 2930 Lisp_Object length; | |
| 2931 Lisp_Object offset; | |
| 2932 | |
| 2933 position = Fcar (pos); | |
| 2934 length = Fcar (Fcdr (pos)); | |
| 2935 offset = Fcar (Fcdr (Fcdr (pos))); | |
| 2936 | |
| 2937 if (XINT (length) != 0) | |
| 2938 XSET (Vprefix_arg, Lisp_Int, | |
| 2939 (SCREEN_HEIGHT (s) * (XINT (position) + XINT (offset)) | |
| 2940 / (XINT (length) + 2 * XINT (offset)))); | |
| 2941 } | |
| 2942 Fcommand_execute (mouse_cmd, Qnil); | |
| 2943 } | |
| 2944 | |
| 2945 if (!NILP (Vmouse_event_function)) /* Not `event' so no need for GCPRO */ | |
| 2946 call1 (Vmouse_event_function, Vmouse_event); | |
| 2947 return Qnil; | |
| 2948 } | |
| 2949 #endif | |
| 2950 | |
| 2951 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, | |
| 2952 1, 1, "P", | |
| 2953 "Read function name, then read its arguments and call it.") | |
| 2954 (prefixarg) | |
| 2955 Lisp_Object prefixarg; | |
| 2956 { | |
| 2957 Lisp_Object function; | |
| 2958 char buf[40]; | |
| 2959 Lisp_Object saved_keys; | |
| 2960 struct gcpro gcpro1; | |
| 2961 | |
| 2962 saved_keys = Fthis_command_keys (); | |
| 2963 buf[0] = 0; | |
| 2964 GCPRO1 (saved_keys); | |
| 2965 | |
| 2966 if (EQ (prefixarg, Qminus)) | |
| 2967 strcpy (buf, "- "); | |
| 2968 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4) | |
| 2969 strcpy (buf, "C-u "); | |
| 2970 else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int) | |
| 2971 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car)); | |
| 2972 else if (XTYPE (prefixarg) == Lisp_Int) | |
| 2973 sprintf (buf, "%d ", XINT (prefixarg)); | |
| 2974 | |
| 2975 /* This isn't strictly correct if execute-extended-command | |
| 2976 is bound to anything else. Perhaps it should use | |
| 2977 this_command_keys? */ | |
| 2978 strcat (buf, "M-x "); | |
| 2979 | |
| 2980 /* Prompt with buf, and then read a string, completing from and | |
| 2981 restricting to the set of all defined commands. Don't provide | |
| 2982 any initial input. The last Qnil says not to perform a | |
| 2983 peculiar hack on the initial input. */ | |
| 2984 function = Fcompleting_read (build_string (buf), | |
| 2985 Vobarray, Qcommandp, | |
| 2986 Qt, Qnil, Qnil); | |
| 2987 | |
| 708 | 2988 /* Set this_command_keys to the concatenation of saved_keys and |
| 2989 function, followed by a RET. */ | |
| 518 | 2990 { |
| 708 | 2991 struct Lisp_String *str; |
| 518 | 2992 int i; |
| 2993 Lisp_Object tem; | |
| 2994 | |
| 708 | 2995 this_command_key_count = 0; |
| 2996 | |
| 2997 str = XSTRING (saved_keys); | |
| 2998 for (i = 0; i < str->size; i++) | |
| 518 | 2999 { |
| 708 | 3000 XFASTINT (tem) = str->data[i]; |
| 518 | 3001 add_command_key (tem); |
| 3002 } | |
| 708 | 3003 |
| 3004 str = XSTRING (function); | |
| 3005 for (i = 0; i < str->size; i++) | |
| 3006 { | |
| 3007 XFASTINT (tem) = str->data[i]; | |
| 3008 add_command_key (tem); | |
| 3009 } | |
| 3010 | |
| 3011 XFASTINT (tem) = '\015'; | |
| 3012 add_command_key (tem); | |
| 518 | 3013 } |
| 3014 | |
| 3015 UNGCPRO; | |
| 3016 | |
| 3017 function = Fintern (function, Vobarray); | |
| 3018 Vprefix_arg = prefixarg; | |
| 3019 this_command = function; | |
| 3020 | |
| 3021 return Fcommand_execute (function, Qt); | |
| 3022 } | |
| 3023 | |
| 3024 | |
| 3025 detect_input_pending () | |
| 3026 { | |
| 3027 if (!input_pending) | |
| 3028 get_input_pending (&input_pending); | |
| 3029 | |
| 3030 return input_pending; | |
| 3031 } | |
| 3032 | |
| 648 | 3033 /* This is called in some cases before a possible quit. |
| 3034 It cases the next call to detect_input_pending to recompute input_pending. | |
| 3035 So calling this function unnecessarily can't do any harm. */ | |
| 3036 clear_input_pending () | |
| 3037 { | |
| 3038 input_pending = 0; | |
| 3039 } | |
| 3040 | |
| 518 | 3041 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, |
| 3042 "T if command input is currently available with no waiting.\n\ | |
| 3043 Actually, the value is nil only if we can be sure that no input is available.") | |
| 3044 () | |
| 3045 { | |
| 3046 if (!NILP (unread_command_char)) | |
| 3047 return (Qt); | |
| 3048 | |
| 3049 return detect_input_pending () ? Qt : Qnil; | |
| 3050 } | |
| 3051 | |
| 3052 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, | |
| 3053 "Return vector of last 100 chars read from terminal.") | |
| 3054 () | |
| 3055 { | |
| 3056 Lisp_Object val; | |
| 3057 | |
| 3058 if (total_keys < NUM_RECENT_KEYS) | |
| 3059 return Fvector (total_keys, recent_keys); | |
| 3060 else | |
| 3061 { | |
| 3062 val = Fvector (NUM_RECENT_KEYS, recent_keys); | |
| 3063 bcopy (recent_keys + recent_keys_index, | |
| 3064 XVECTOR (val)->contents, | |
| 3065 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object)); | |
| 3066 bcopy (recent_keys, | |
| 3067 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index, | |
| 3068 recent_keys_index * sizeof (Lisp_Object)); | |
| 3069 return val; | |
| 3070 } | |
| 3071 } | |
| 3072 | |
| 3073 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0, | |
| 3074 "Return string of the keystrokes that invoked this command.") | |
| 3075 () | |
| 3076 { | |
| 3077 return make_array (this_command_key_count, this_command_keys); | |
| 3078 } | |
| 3079 | |
| 3080 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, | |
| 3081 "Return the current depth in recursive edits.") | |
| 3082 () | |
| 3083 { | |
| 3084 Lisp_Object temp; | |
| 3085 XFASTINT (temp) = command_loop_level + minibuf_level; | |
| 3086 return temp; | |
| 3087 } | |
| 3088 | |
| 3089 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, | |
| 3090 "FOpen dribble file: ", | |
| 3091 "Start writing all keyboard characters to FILE.") | |
| 3092 (file) | |
| 3093 Lisp_Object file; | |
| 3094 { | |
| 3095 if (NILP (file)) | |
| 3096 { | |
| 3097 fclose (dribble); | |
| 3098 dribble = 0; | |
| 3099 } | |
| 3100 else | |
| 3101 { | |
| 3102 file = Fexpand_file_name (file, Qnil); | |
| 3103 dribble = fopen (XSTRING (file)->data, "w"); | |
| 3104 } | |
| 3105 return Qnil; | |
| 3106 } | |
| 3107 | |
| 3108 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0, | |
| 3109 "Discard the contents of the terminal input buffer.\n\ | |
| 3110 Also cancel any kbd macro being defined.") | |
| 3111 () | |
| 3112 { | |
| 3113 defining_kbd_macro = 0; | |
| 3114 update_mode_lines++; | |
| 3115 | |
| 3116 #if 0 | |
| 3117 unread_command_char = make_number (-1); | |
| 3118 #endif | |
| 3119 unread_command_char = Qnil; | |
| 3120 | |
| 3121 discard_tty_input (); | |
| 3122 | |
| 3123 kbd_fetch_ptr = kbd_store_ptr; | |
| 3124 input_pending = 0; | |
| 3125 | |
| 3126 return Qnil; | |
| 3127 } | |
| 3128 | |
| 3129 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "", | |
| 3130 "Stop Emacs and return to superior process. You can resume later.\n\ | |
| 3131 On systems that don't have job control, run a subshell instead.\n\n\ | |
| 3132 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\ | |
| 3133 to be read as terminal input by Emacs's superior shell.\n\ | |
| 3134 Before suspending, if `suspend-hook' is bound and value is non-nil\n\ | |
| 3135 call the value as a function of no args. Don't suspend if it returns non-nil.\n\ | |
| 3136 Otherwise, suspend normally and after resumption call\n\ | |
| 3137 `suspend-resume-hook' if that is bound and non-nil.\n\ | |
| 3138 \n\ | |
| 3139 Some operating systems cannot stop the Emacs process and resume it later.\n\ | |
| 3140 On such systems, Emacs will start a subshell and wait for it to exit.") | |
| 3141 (stuffstring) | |
| 3142 Lisp_Object stuffstring; | |
| 3143 { | |
| 3144 register Lisp_Object tem; | |
| 3145 int count = specpdl_ptr - specpdl; | |
| 3146 int old_height, old_width; | |
| 3147 int width, height; | |
| 3148 struct gcpro gcpro1; | |
| 3149 extern init_sys_modes (); | |
| 3150 | |
| 3151 if (!NILP (stuffstring)) | |
| 3152 CHECK_STRING (stuffstring, 0); | |
| 3153 GCPRO1 (stuffstring); | |
| 3154 | |
| 3155 /* Call value of suspend-hook | |
| 3156 if it is bound and value is non-nil. */ | |
| 3157 if (!NILP (Vrun_hooks)) | |
| 3158 { | |
| 3159 tem = call1 (Vrun_hooks, intern ("suspend-hook")); | |
| 3160 if (!EQ (tem, Qnil)) return Qnil; | |
| 3161 } | |
| 3162 | |
| 3163 get_screen_size (&old_width, &old_height); | |
| 3164 reset_sys_modes (); | |
| 3165 /* sys_suspend can get an error if it tries to fork a subshell | |
| 3166 and the system resources aren't available for that. */ | |
| 3167 record_unwind_protect (init_sys_modes, 0); | |
| 3168 stuff_buffered_input (stuffstring); | |
| 3169 sys_suspend (); | |
| 3170 unbind_to (count, Qnil); | |
| 3171 | |
| 3172 /* Check if terminal/window size has changed. | |
| 3173 Note that this is not useful when we are running directly | |
| 3174 with a window system; but suspend should be disabled in that case. */ | |
| 3175 get_screen_size (&width, &height); | |
| 3176 if (width != old_width || height != old_height) | |
| 3177 change_screen_size (height, width, 0); | |
| 3178 | |
| 3179 /* Call value of suspend-resume-hook | |
| 3180 if it is bound and value is non-nil. */ | |
| 3181 if (!NILP (Vrun_hooks)) | |
| 3182 call1 (Vrun_hooks, intern ("suspend-resume-hook")); | |
| 3183 | |
| 3184 UNGCPRO; | |
| 3185 return Qnil; | |
| 3186 } | |
| 3187 | |
| 3188 /* If STUFFSTRING is a string, stuff its contents as pending terminal input. | |
| 3189 Then in any case stuff anthing Emacs has read ahead and not used. */ | |
| 3190 | |
| 3191 stuff_buffered_input (stuffstring) | |
| 3192 Lisp_Object stuffstring; | |
| 3193 { | |
| 3194 register unsigned char *p; | |
| 3195 | |
| 3196 /* stuff_char works only in BSD, versions 4.2 and up. */ | |
| 3197 #ifdef BSD | |
| 3198 #ifndef BSD4_1 | |
| 3199 if (XTYPE (stuffstring) == Lisp_String) | |
| 3200 { | |
| 3201 register int count; | |
| 3202 | |
| 3203 p = XSTRING (stuffstring)->data; | |
| 3204 count = XSTRING (stuffstring)->size; | |
| 3205 while (count-- > 0) | |
| 3206 stuff_char (*p++); | |
| 3207 stuff_char ('\n'); | |
| 3208 } | |
| 3209 /* Anything we have read ahead, put back for the shell to read. */ | |
| 3210 while (kbd_fetch_ptr != kbd_store_ptr) | |
| 3211 { | |
| 3212 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) | |
| 3213 kbd_fetch_ptr = kbd_buffer; | |
| 3214 if (kbd_fetch_ptr->kind == ascii_keystroke) | |
| 3215 stuff_char (XINT (kbd_fetch_ptr->code)); | |
| 3216 kbd_fetch_ptr++; | |
| 3217 } | |
| 3218 input_pending = 0; | |
| 3219 #endif | |
| 3220 #endif /* BSD and not BSD4_1 */ | |
| 3221 } | |
| 3222 | |
| 648 | 3223 set_waiting_for_input (time_to_clear) |
| 3224 EMACS_TIME *time_to_clear; | |
| 518 | 3225 { |
| 648 | 3226 input_available_clear_time = time_to_clear; |
| 518 | 3227 |
| 3228 /* Tell interrupt_signal to throw back to read_char, */ | |
| 3229 waiting_for_input = 1; | |
| 3230 | |
| 3231 /* If interrupt_signal was called before and buffered a C-g, | |
| 3232 make it run again now, to avoid timing error. */ | |
| 3233 if (!NILP (Vquit_flag)) | |
| 3234 quit_throw_to_read_char (); | |
| 3235 | |
| 3236 /* If alarm has gone off already, echo now. */ | |
| 3237 if (echo_flag) | |
| 3238 { | |
| 3239 echo (); | |
| 3240 echo_flag = 0; | |
| 3241 } | |
| 3242 } | |
| 3243 | |
| 3244 clear_waiting_for_input () | |
| 3245 { | |
| 3246 /* Tell interrupt_signal not to throw back to read_char, */ | |
| 3247 waiting_for_input = 0; | |
| 648 | 3248 input_available_clear_time = 0; |
| 518 | 3249 } |
| 3250 | |
| 3251 /* This routine is called at interrupt level in response to C-G. | |
| 3252 If interrupt_input, this is the handler for SIGINT. | |
| 3253 Otherwise, it is called from kbd_buffer_store_event, | |
| 3254 in handling SIGIO or SIGTINT. | |
| 3255 | |
| 3256 If `waiting_for_input' is non zero, then unless `echoing' is nonzero, | |
| 3257 immediately throw back to read_char. | |
| 3258 | |
| 3259 Otherwise it sets the Lisp variable quit-flag not-nil. | |
| 3260 This causes eval to throw, when it gets a chance. | |
| 3261 If quit-flag is already non-nil, it stops the job right away. */ | |
| 3262 | |
| 3263 SIGTYPE | |
| 3264 interrupt_signal () | |
| 3265 { | |
| 3266 char c; | |
| 3267 /* Must preserve main program's value of errno. */ | |
| 3268 int old_errno = errno; | |
| 3269 extern Lisp_Object Vwindow_system; | |
| 3270 | |
| 3271 #ifdef USG | |
| 3272 /* USG systems forget handlers when they are used; | |
| 3273 must reestablish each time */ | |
| 3274 signal (SIGINT, interrupt_signal); | |
| 3275 signal (SIGQUIT, interrupt_signal); | |
| 3276 #endif /* USG */ | |
| 3277 | |
| 3278 cancel_echoing (); | |
| 3279 | |
| 3280 if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen)) | |
| 3281 { | |
| 3282 fflush (stdout); | |
| 3283 reset_sys_modes (); | |
| 3284 sigfree (); | |
| 3285 #ifdef SIGTSTP /* Support possible in later USG versions */ | |
| 3286 /* | |
| 3287 * On systems which can suspend the current process and return to the original | |
| 3288 * shell, this command causes the user to end up back at the shell. | |
| 3289 * The "Auto-save" and "Abort" questions are not asked until | |
| 3290 * the user elects to return to emacs, at which point he can save the current | |
| 3291 * job and either dump core or continue. | |
| 3292 */ | |
| 3293 sys_suspend (); | |
| 3294 #else | |
| 3295 #ifdef VMS | |
| 3296 if (sys_suspend () == -1) | |
| 3297 { | |
| 3298 printf ("Not running as a subprocess;\n"); | |
| 3299 printf ("you can continue or abort.\n"); | |
| 3300 } | |
| 3301 #else /* not VMS */ | |
| 3302 /* Perhaps should really fork an inferior shell? | |
| 3303 But that would not provide any way to get back | |
| 3304 to the original shell, ever. */ | |
| 3305 printf ("No support for stopping a process on this operating system;\n"); | |
| 3306 printf ("you can continue or abort.\n"); | |
| 3307 #endif /* not VMS */ | |
| 3308 #endif /* not SIGTSTP */ | |
| 3309 printf ("Auto-save? (y or n) "); | |
| 3310 fflush (stdout); | |
| 3311 if (((c = getchar ()) & ~040) == 'Y') | |
| 3312 Fdo_auto_save (Qnil, Qnil); | |
| 3313 while (c != '\n') c = getchar (); | |
| 3314 #ifdef VMS | |
| 3315 printf ("Abort (and enter debugger)? (y or n) "); | |
| 3316 #else /* not VMS */ | |
| 3317 printf ("Abort (and dump core)? (y or n) "); | |
| 3318 #endif /* not VMS */ | |
| 3319 fflush (stdout); | |
| 3320 if (((c = getchar ()) & ~040) == 'Y') | |
| 3321 abort (); | |
| 3322 while (c != '\n') c = getchar (); | |
| 3323 printf ("Continuing...\n"); | |
| 3324 fflush (stdout); | |
| 3325 init_sys_modes (); | |
| 3326 } | |
| 3327 else | |
| 3328 { | |
| 3329 /* If executing a function that wants to be interrupted out of | |
| 3330 and the user has not deferred quitting by binding `inhibit-quit' | |
| 3331 then quit right away. */ | |
| 3332 if (immediate_quit && NILP (Vinhibit_quit)) | |
| 3333 { | |
| 3334 immediate_quit = 0; | |
| 3335 sigfree (); | |
| 3336 Fsignal (Qquit, Qnil); | |
| 3337 } | |
| 3338 else | |
| 3339 /* Else request quit when it's safe */ | |
| 3340 Vquit_flag = Qt; | |
| 3341 } | |
| 3342 | |
| 3343 if (waiting_for_input && !echoing) | |
| 3344 quit_throw_to_read_char (); | |
| 3345 | |
| 3346 errno = old_errno; | |
| 3347 } | |
| 3348 | |
| 3349 /* Handle a C-g by making read_char return C-g. */ | |
| 3350 | |
| 3351 quit_throw_to_read_char () | |
| 3352 { | |
| 3353 quit_error_check (); | |
| 3354 sigfree (); | |
| 3355 /* Prevent another signal from doing this before we finish. */ | |
| 650 | 3356 clear_waiting_for_input (); |
| 518 | 3357 input_pending = 0; |
| 3358 | |
| 3359 #if 0 | |
| 3360 unread_command_char = make_number (-1); | |
| 3361 #endif | |
| 3362 unread_command_char = Qnil; | |
| 3363 | |
| 3364 _longjmp (getcjmp, 1); | |
| 3365 } | |
| 3366 | |
| 3367 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0, | |
| 3368 "Set mode of reading keyboard input.\n\ | |
|
695
e3fac20d3015
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
691
diff
changeset
|
3369 First arg INTERRUPT non-nil means use input interrupts;\n\ |
|
e3fac20d3015
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
691
diff
changeset
|
3370 nil means use CBREAK mode.\n\ |
|
e3fac20d3015
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
691
diff
changeset
|
3371 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\ |
| 518 | 3372 (no effect except in CBREAK mode).\n\ |
|
695
e3fac20d3015
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
691
diff
changeset
|
3373 Third arg META non-nil means accept 8-bit input (for a Meta key).\n\ |
| 518 | 3374 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
|
3375 Optional fourth arg QUIT if non-nil specifies character to use for quitting.") |
| 518 | 3376 (interrupt, flow, meta, quit) |
| 3377 Lisp_Object interrupt, flow, meta, quit; | |
| 3378 { | |
| 3379 if (!NILP (quit) | |
| 3380 && (XTYPE (quit) != Lisp_Int | |
| 3381 || XINT (quit) < 0 || XINT (quit) > 0400)) | |
| 3382 error ("set-input-mode: QUIT must be an ASCII character."); | |
| 3383 | |
| 3384 reset_sys_modes (); | |
| 3385 #ifdef SIGIO | |
| 3386 /* Note SIGIO has been undef'd if FIONREAD is missing. */ | |
| 3387 #ifdef NO_SOCK_SIGIO | |
| 3388 if (read_socket_hook) | |
| 3389 interrupt_input = 0; /* No interrupts if reading from a socket. */ | |
| 3390 else | |
| 3391 #endif /* NO_SOCK_SIGIO */ | |
| 3392 interrupt_input = !NILP (interrupt); | |
| 3393 #else /* not SIGIO */ | |
| 3394 interrupt_input = 0; | |
| 3395 #endif /* not SIGIO */ | |
| 3396 /* Our VMS input only works by interrupts, as of now. */ | |
| 3397 #ifdef VMS | |
| 3398 interrupt_input = 1; | |
| 3399 #endif | |
| 3400 flow_control = !NILP (flow); | |
| 3401 meta_key = !NILP (meta); | |
| 3402 if (!NILP (quit)) | |
| 3403 /* Don't let this value be out of range. */ | |
| 3404 quit_char = XINT (quit) & (meta_key ? 0377 : 0177); | |
| 3405 | |
| 3406 init_sys_modes (); | |
| 3407 return Qnil; | |
| 3408 } | |
| 3409 | |
| 3410 init_keyboard () | |
| 3411 { | |
| 3412 this_command_keys_size = 40; | |
| 3413 this_command_keys = | |
| 3414 (Lisp_Object *) xmalloc (this_command_keys_size * sizeof (Lisp_Object)); | |
| 3415 | |
| 3416 /* This is correct before outermost invocation of the editor loop */ | |
| 3417 command_loop_level = -1; | |
| 3418 immediate_quit = 0; | |
| 3419 quit_char = Ctl ('g'); | |
| 3420 unread_command_char = Qnil; | |
| 3421 recent_keys_index = 0; | |
| 3422 total_keys = 0; | |
| 3423 kbd_fetch_ptr = kbd_buffer; | |
| 3424 kbd_store_ptr = kbd_buffer; | |
| 3425 do_mouse_tracking = 0; | |
| 3426 input_pending = 0; | |
| 3427 | |
| 3428 if (!noninteractive) | |
| 3429 { | |
| 3430 signal (SIGINT, interrupt_signal); | |
| 3431 #ifdef HAVE_TERMIO | |
| 3432 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and | |
| 3433 SIGQUIT and we can't tell which one it will give us. */ | |
| 3434 signal (SIGQUIT, interrupt_signal); | |
| 3435 #endif /* HAVE_TERMIO */ | |
| 3436 /* Note SIGIO has been undef'd if FIONREAD is missing. */ | |
| 3437 #ifdef SIGIO | |
| 3438 signal (SIGIO, input_available_signal); | |
| 3439 #endif SIGIO | |
| 3440 } | |
| 3441 | |
| 3442 /* Use interrupt input by default, if it works and noninterrupt input | |
| 3443 has deficiencies. */ | |
| 3444 | |
| 3445 #ifdef INTERRUPT_INPUT | |
| 3446 interrupt_input = 1; | |
| 3447 #else | |
| 3448 interrupt_input = 0; | |
| 3449 #endif | |
| 3450 | |
| 3451 /* Our VMS input only works by interrupts, as of now. */ | |
| 3452 #ifdef VMS | |
| 3453 interrupt_input = 1; | |
| 3454 #endif | |
| 3455 | |
| 3456 sigfree (); | |
| 3457 dribble = 0; | |
| 3458 | |
| 3459 if (keyboard_init_hook) | |
| 3460 (*keyboard_init_hook) (); | |
| 3461 | |
| 3462 #ifdef POLL_FOR_INPUT | |
| 3463 poll_suppress_count = 1; | |
| 3464 start_polling (); | |
| 3465 #endif | |
| 3466 } | |
| 3467 | |
| 3468 /* This type's only use is in syms_of_keyboard, to initialize the | |
| 3469 event header symbols and put properties on them. */ | |
| 3470 struct event_head { | |
| 3471 Lisp_Object *var; | |
| 3472 char *name; | |
| 3473 Lisp_Object *kind; | |
| 3474 }; | |
| 3475 | |
| 3476 struct event_head head_table[] = { | |
| 3477 &Qmouse_movement, "mouse-movement", &Qmouse_movement, | |
| 3478 &Qvscrollbar_part, "vscrollbar-part", &Qscrollbar_click, | |
| 3479 &Qvslider_part, "vslider-part", &Qscrollbar_click, | |
| 3480 &Qvthumbup_part, "vthumbup-part", &Qscrollbar_click, | |
| 3481 &Qvthumbdown_part, "vthumbdown-part", &Qscrollbar_click, | |
| 3482 &Qhscrollbar_part, "hscrollbar-part", &Qscrollbar_click, | |
| 3483 &Qhslider_part, "hslider-part", &Qscrollbar_click, | |
| 3484 &Qhthumbleft_part, "hthumbleft-part", &Qscrollbar_click, | |
| 3485 &Qhthumbright_part,"hthumbright-part", &Qscrollbar_click | |
| 3486 }; | |
| 3487 | |
| 3488 syms_of_keyboard () | |
| 3489 { | |
| 3490 Qself_insert_command = intern ("self-insert-command"); | |
| 3491 staticpro (&Qself_insert_command); | |
| 3492 | |
| 3493 Qforward_char = intern ("forward-char"); | |
| 3494 staticpro (&Qforward_char); | |
| 3495 | |
| 3496 Qbackward_char = intern ("backward-char"); | |
| 3497 staticpro (&Qbackward_char); | |
| 3498 | |
| 3499 Qdisabled = intern ("disabled"); | |
| 3500 staticpro (&Qdisabled); | |
| 3501 | |
| 3502 Qfunction_key = intern ("function-key"); | |
| 3503 staticpro (&Qfunction_key); | |
| 3504 Qmouse_movement = intern ("mouse-click"); | |
| 3505 staticpro (&Qmouse_click); | |
| 3506 Qmouse_movement = intern ("scrollbar-click"); | |
| 3507 staticpro (&Qmouse_movement); | |
| 3508 | |
| 3509 Qmode_line = intern ("mode-line"); | |
| 3510 staticpro (&Qmode_line); | |
| 3511 Qvertical_split = intern ("vertical-split"); | |
| 3512 staticpro (&Qvertical_split); | |
| 3513 | |
| 3514 Qevent_kind = intern ("event-type"); | |
| 3515 staticpro (&Qevent_kind); | |
| 3516 Qevent_unmodified = intern ("event-unmodified"); | |
| 3517 staticpro (&Qevent_unmodified); | |
| 3518 | |
| 3519 { | |
| 3520 struct event_head *p; | |
| 3521 | |
| 3522 for (p = head_table; | |
| 3523 p < head_table + (sizeof (head_table) / sizeof (head_table[0])); | |
| 3524 p++) | |
| 3525 { | |
| 3526 *p->var = intern (p->name); | |
| 3527 staticpro (p->var); | |
| 3528 Fput (*p->var, Qevent_kind, *p->kind); | |
| 3529 Fput (*p->var, Qevent_unmodified, *p->var); | |
| 3530 } | |
| 3531 } | |
| 3532 | |
| 3533 func_key_syms = Qnil; | |
| 3534 staticpro (&func_key_syms); | |
| 3535 | |
| 3536 mouse_syms = Qnil; | |
| 3537 staticpro (&mouse_syms); | |
| 3538 | |
| 3539 defsubr (&Sread_key_sequence); | |
| 3540 defsubr (&Srecursive_edit); | |
| 3541 defsubr (&Strack_mouse); | |
| 3542 defsubr (&Smouse_click_p); | |
| 3543 defsubr (&Sinput_pending_p); | |
| 3544 defsubr (&Scommand_execute); | |
| 3545 defsubr (&Srecent_keys); | |
| 3546 defsubr (&Sthis_command_keys); | |
| 3547 defsubr (&Ssuspend_emacs); | |
| 3548 defsubr (&Sabort_recursive_edit); | |
| 3549 defsubr (&Sexit_recursive_edit); | |
| 3550 defsubr (&Srecursion_depth); | |
| 3551 defsubr (&Stop_level); | |
| 3552 defsubr (&Sdiscard_input); | |
| 3553 defsubr (&Sopen_dribble_file); | |
| 3554 defsubr (&Sset_input_mode); | |
| 3555 defsubr (&Sexecute_extended_command); | |
| 3556 | |
| 3557 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook, | |
| 3558 "Value is called instead of any command that is disabled\n\ | |
| 3559 (has a non-nil `disabled' property)."); | |
| 3560 | |
| 3561 DEFVAR_LISP ("last-command-char", &last_command_char, | |
| 3562 "Last terminal input key that was part of a command."); | |
| 3563 | |
| 3564 DEFVAR_LISP ("last-input-char", &last_input_char, | |
| 3565 "Last terminal input key."); | |
| 3566 | |
| 3567 DEFVAR_LISP ("unread-command-char", &unread_command_char, | |
| 3568 "Object to be read as next input from input stream, or nil if none."); | |
| 3569 | |
| 3570 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char, | |
| 3571 "Meta-prefix character code. Meta-foo as command input\n\ | |
| 3572 turns into this character followed by foo."); | |
| 3573 XSET (meta_prefix_char, Lisp_Int, 033); | |
| 3574 | |
| 3575 DEFVAR_LISP ("last-command", &last_command, | |
| 3576 "The last command executed. Normally a symbol with a function definition,\n\ | |
| 3577 but can be whatever was found in the keymap, or whatever the variable\n\ | |
| 3578 `this-command' was set to by that command."); | |
| 3579 last_command = Qnil; | |
| 3580 | |
| 3581 DEFVAR_LISP ("this-command", &this_command, | |
| 3582 "The command now being executed.\n\ | |
| 3583 The command can set this variable; whatever is put here\n\ | |
| 3584 will be in `last-command' during the following command."); | |
| 3585 this_command = Qnil; | |
| 3586 | |
| 3587 DEFVAR_INT ("auto-save-interval", &auto_save_interval, | |
| 3588 "*Number of keyboard input characters between auto-saves.\n\ | |
| 3589 Zero means disable autosaving due to number of characters typed."); | |
| 3590 auto_save_interval = 300; | |
| 3591 | |
| 3592 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout, | |
| 3593 "*Number of seconds idle time before auto-save.\n\ | |
|
687
e2b747dd6a6e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
682
diff
changeset
|
3594 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
|
3595 After auto-saving due to this many seconds of idle time,\n\ |
| 701 | 3596 Emacs also does a garbage collection if that seems to be warranted."); |
| 518 | 3597 XFASTINT (Vauto_save_timeout) = 30; |
| 3598 | |
| 3599 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes, | |
| 3600 "*Nonzero means echo unfinished commands after this many seconds of pause."); | |
| 3601 echo_keystrokes = 1; | |
| 3602 | |
| 3603 DEFVAR_INT ("polling-period", &polling_period, | |
| 3604 "*Interval between polling for input during Lisp execution.\n\ | |
| 3605 The reason for polling is to make C-g work to stop a running program.\n\ | |
| 3606 Polling is needed only when using X windows and SIGIO does not work.\n\ | |
| 3607 Polling is automatically disabled in all other cases."); | |
| 3608 polling_period = 2; | |
| 3609 | |
| 3610 DEFVAR_INT ("num-input-keys", &num_input_keys, | |
| 3611 "*Number of complete keys read from the keyboard so far."); | |
| 3612 num_input_keys = 0; | |
| 3613 | |
| 3614 DEFVAR_LISP ("last-event-screen", &Vlast_event_screen, | |
| 3615 "*The screen in which the most recently read event occurred."); | |
| 3616 Vlast_event_screen = Qnil; | |
| 3617 | |
| 3618 DEFVAR_LISP ("help-char", &help_char, | |
| 3619 "Character to recognize as meaning Help.\n\ | |
| 3620 When it is read, do `(eval help-form)', and display result if it's a string.\n\ | |
| 3621 If the value of `help-form' is nil, this char can be read normally."); | |
| 3622 XSET (help_char, Lisp_Int, Ctl ('H')); | |
| 3623 | |
| 3624 DEFVAR_LISP ("help-form", &Vhelp_form, | |
| 3625 "Form to execute when character help-char is read.\n\ | |
| 3626 If the form returns a string, that string is displayed.\n\ | |
| 3627 If `help-form' is nil, the help char is not recognized."); | |
| 3628 Vhelp_form = Qnil; | |
| 3629 | |
| 3630 DEFVAR_LISP ("top-level", &Vtop_level, | |
| 3631 "Form to evaluate when Emacs starts up.\n\ | |
| 3632 Useful to set before you dump a modified Emacs."); | |
| 3633 Vtop_level = Qnil; | |
| 3634 | |
| 3635 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table, | |
| 3636 "String used as translate table for keyboard input, or nil.\n\ | |
| 3637 Each character is looked up in this string and the contents used instead.\n\ | |
| 3638 If string is of length N, character codes N and up are untranslated."); | |
| 3639 Vkeyboard_translate_table = Qnil; | |
| 3640 | |
| 3641 #ifdef HAVE_X_WINDOWS | |
| 3642 DEFVAR_LISP ("mouse-event-function", &Vmouse_event_function, | |
| 3643 "Function to call for each mouse event, after the event's definition.\n\ | |
| 3644 Called, if non-nil, with one argument, which is the event-list.\n\ | |
| 3645 See the variable `mouse-event' for the format of this list."); | |
| 3646 Vmouse_event_function = Qnil; | |
| 3647 | |
| 3648 DEFVAR_LISP ("mouse-left-hook", &Vmouse_left_hook, | |
| 3649 "Function to call when mouse leaves window. No arguments."); | |
| 3650 Vmouse_left_hook = Qnil; | |
| 3651 | |
| 3652 DEFVAR_LISP ("map-screen-hook", &Vmap_screen_hook, | |
| 3653 "Function to call when screen is mapped. No arguments."); | |
| 3654 Vmap_screen_hook = Qnil; | |
| 3655 | |
| 3656 DEFVAR_LISP ("unmap-screen-hook", &Vunmap_screen_hook, | |
| 3657 "Function to call when screen is unmapped. No arguments."); | |
| 3658 Vunmap_screen_hook = Qnil; | |
| 3659 | |
| 3660 DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler, | |
| 3661 "Handler for motion events. No arguments."); | |
| 3662 Vmouse_motion_handler = Qnil; | |
| 3663 #endif | |
| 3664 | |
| 3665 DEFVAR_BOOL ("menu-prompting", &menu_prompting, | |
| 3666 "Non-nil means prompt with menus in echo area when appropriate.\n\ | |
| 3667 This is done when reading from a keymap that has a prompt string,\n\ | |
| 3668 for elements that have prompt strings."); | |
| 3669 menu_prompting = 1; | |
| 3670 | |
| 3671 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char, | |
| 3672 "Character to see next line of menu prompt.\n\ | |
| 3673 Type this character while in a menu prompt to rotate around the lines of it."); | |
| 3674 XSET (menu_prompt_more_char, Lisp_Int, ' '); | |
| 3675 } | |
| 3676 | |
| 3677 keys_of_keyboard () | |
| 3678 { | |
| 3679 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs"); | |
| 3680 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs"); | |
| 3681 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit"); | |
| 3682 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit"); | |
| 3683 initial_define_key (meta_map, 'x', "execute-extended-command"); | |
| 3684 } |
