![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to keyboard.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to keyboard.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Keyboard input; editor command loop.
2: Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21: /*** For version 19, can simplify this by making interrupt_input 1 on VMS. */
22:
23: /* Allow config.h to undefine symbols found here. */
24: #include <signal.h>
25:
26: #include "config.h"
27: #include <stdio.h>
28: #undef NULL
29: #include "termchar.h"
30: #include "termopts.h"
31: #include "termhooks.h"
32: #include "lisp.h"
33: #include "macros.h"
34: #include "window.h"
35: #include "commands.h"
36: #include "buffer.h"
37: #include <setjmp.h>
38: #include <errno.h>
39:
40: extern int errno;
41:
42: /* Get FIONREAD, if it is available. */
43: #ifdef USG
44: #include <termio.h>
45: #include <fcntl.h>
46: #else /* not USG */
47: #ifndef VMS
48: #include <sys/ioctl.h>
49: #endif /* not VMS */
50: #endif /* not USG */
51:
52: /* Allow m- file to inhibit use of FIONREAD. */
53: #ifdef BROKEN_FIONREAD
54: #undef FIONREAD
55: #endif
56:
57: /* Make all keyboard buffers much bigger when using X windows. */
58: #ifdef HAVE_X_WINDOWS
59: #define BUFFER_SIZE_FACTOR 16
60: #else
61: #define BUFFER_SIZE_FACTOR 1
62: #endif
63:
64: /* Following definition copied from eval.c */
65:
66: struct backtrace
67: {
68: struct backtrace *next;
69: Lisp_Object *function;
70: Lisp_Object *args; /* Points to vector of args. */
71: int nargs; /* length of vector */
72: /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */
73: char evalargs;
74: };
75:
76: /* Non-nil disable property on a command means
77: do not execute it; call disabled-command-hook's value instead. */
78: Lisp_Object Qdisabled, Vdisabled_command_hook;
79:
80: int recent_keys_index; /* Index for storing next element into recent_keys */
81: int total_keys; /* Total number of elements stored into recent_keys */
82: char recent_keys[100]; /* Holds last 100 keystrokes */
83:
84: extern struct backtrace *backtrace_list;
85:
86: static jmp_buf getcjmp; /* for longjmp to where kbd input is being done. */
87:
88: int waiting_for_input; /* True while doing kbd input */
89:
90: static int echoing; /* True while inside EchoKeys. Delays C-g throwing. */
91:
92: int immediate_quit; /* Nonzero means C-G should cause immediate error-signal. */
93:
94: int help_char; /* Character to recognize as the help char. */
95:
96: Lisp_Object Vhelp_form; /* Form to execute when help char is typed. */
97:
98: extern struct Lisp_Vector *CurrentGlobalMap;
99:
100: /* Total number of times get_char has returned. */
101:
102: int num_input_chars;
103:
104: /* Last input character read as a command. */
105:
106: int last_command_char;
107:
108: /* Last input character read for any purpose. */
109:
110: int last_input_char;
111:
112: /* If not -1, a character to be read as the next command input */
113:
114: int unread_command_char;
115:
116: /* Char to use as prefix when a meta character is typed in.
117: This is bound on entry to minibuffer in case Esc is changed there. */
118:
119: int meta_prefix_char;
120:
121: static int auto_save_interval; /* The number of keystrokes between
122: auto-saves. */
123: static int Keystrokes; /* The number of keystrokes since the last
124: auto-save. */
125:
126: Lisp_Object last_command; /* Previous command, represented by a Lisp object.
127: Does not include prefix commands and arg setting commands */
128:
129: Lisp_Object this_command; /* If a command sets this,
130: the value goes into previous-command for the next command. */
131:
132: Lisp_Object Qself_insert_command;
133: Lisp_Object Qforward_char;
134: Lisp_Object Qbackward_char;
135:
136: /* read_key_sequence stores here the command definition of the
137: key sequence that it reads */
138: Lisp_Object read_key_sequence_cmd;
139:
140: /* Form to evaluate (if non-nil) when Emacs is started */
141: Lisp_Object Vtop_level;
142:
143: /* User-supplied string to translate input characters through */
144: Lisp_Object Vkeyboard_translate_table;
145:
146: FILE *dribble; /* File in which we write all commands we read */
147:
148: /* Nonzero if input is available */
149: int input_pending;
150:
151: /* Nonzero if should obey 0200 bit in input chars as "Meta" */
152: int MetaFlag;
153:
154: /* Buffer for pre-read keyboard input */
155: unsigned char kbd_buffer [256 * BUFFER_SIZE_FACTOR];
156:
157: /* Number of characters available in kbd_buffer. */
158: int kbd_count;
159:
160: /* Pointer to next available character in kbd_buffer. */
161: unsigned char *kbd_ptr;
162:
163: /* Address (if not 0) of word to zero out
164: if a SIGIO interrupt happens */
165: long *input_available_clear_word;
166:
167: /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
168: Default is 1 if INTERRUPT_INPUT is defined. */
169:
170: int interrupt_input;
171:
172: /* Nonzero while interrupts are temporarily deferred during redisplay. */
173:
174: int interrupts_deferred;
175:
176: /* nonzero means use ^S/^Q for flow control. */
177:
178: int flow_control;
179:
180: #ifndef BSD4_1
181: #define sigfree() sigsetmask (0)
182: #define sigholdx(sig) sigsetmask (1 << ((sig) - 1))
183: #define sigblockx(sig) sigblock (1 << ((sig) - 1))
184: #define sigunblockx(sig) sigblock (0)
185: #define sigpausex(sig) sigpause (0)
186: #endif /* not BSD4_1 */
187:
188: #ifdef BSD4_1
189: #define SIGIO SIGTINT
190: /* sigfree and sigholdx are in sysdep.c */
191: #define sigblockx(sig) sighold (sig)
192: #define sigunblockx(sig) sigrelse (sig)
193: #define sigpausex(sig) sigpause (sig)
194: #endif /* BSD4_1 */
195:
196: #ifndef sigmask
197: #define sigmask(no) (1L << ((no) - 1))
198: #endif
199:
200: /* We are unable to use interrupts if FIONREAD is not available,
201: so flush SIGIO so we won't try. */
202: #ifndef FIONREAD
203: #ifdef SIGIO
204: #undef SIGIO
205: #endif
206: #endif
207:
208: /* Function for init_keyboard to call with no args (if nonzero). */
209: void (*keyboard_init_hook) ();
210:
211: static void read_avail_input ();
212: static void get_input_pending ();
213:
214: /* Non-zero tells input_available_signal to call read_socket_hook
215: even if FIONREAD returns zero. */
216: static int force_input;
217:
218: static char KeyBuf[40]; /* Buffer for keys from get_char () */
219: static int NextK; /* Next index into KeyBuf */
220: static int echo_keystrokes; /* > 0 if we are to echo keystrokes */
221: static int Echo1; /* Stuff for final echo */
222: unsigned char *keys_prompt; /* String to display in front of echoed keystrokes, or 0 */
223:
224: #define min(a,b) ((a)<(b)?(a):(b))
225:
226: static char echobuf[100];
227:
228: EchoThem (notfinal)
229: register notfinal;
230: {
231: char *p;
232: int i;
233:
234: extern char *push_key_description ();
235:
236: if (!(keys_prompt || (echo_keystrokes > 0 && NextK)))
237: return;
238:
239: echoing = 1;
240: p = echobuf;
241: if (keys_prompt)
242: {
243: strcpy (p, keys_prompt);
244: p += strlen (p);
245: }
246: for (i = 0; i < NextK; i++)
247: {
248: p = push_key_description (KeyBuf[i], p);
249: *p++ = ' ';
250: if (i == 0 && KeyBuf[0] == help_char)
251: {
252: strcpy (p, "(Type ? for further options) ");
253: p += strlen (p);
254: }
255: }
256: if (notfinal && NextK
257: && !(NextK == 1 && KeyBuf[0] == help_char))
258: p[-1] = '-';
259: *p = 0;
260: minibuf_message = echobuf;
261:
262: if (notfinal)
263: Echo1++; /* set echoed-flag */
264: if (notfinal >= 0)
265: DoDsp (0);
266:
267: echoing = 0;
268:
269: if (waiting_for_input && !NULL (Vquit_flag))
270: quit_throw_to_get_char ();
271: }
272:
273: Lisp_Object recursive_edit_unwind (), command_loop ();
274:
275: DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
276: "Invoke the editor command loop recursively.\n\
277: Do (throw 'exit nil) within the command loop to make this function return,\n\
278: or (throw 'exit t) to make this function signal an error.\n\
279: This function is called by the editor initialization\n\
280: to begin editing.")
281: ()
282: {
283: int count = specpdl_ptr - specpdl;
284: Lisp_Object val;
285:
286: RecurseDepth++;
287: RedoModes++;
288:
289: if (RecurseDepth)
290: {
291: specbind (Qstandard_output, Qt);
292: specbind (Qstandard_input, Qt);
293: }
294:
295: record_unwind_protect (recursive_edit_unwind,
296: (RecurseDepth &&
297: bf_cur != XBUFFER (XWINDOW (selected_window)->buffer))
298: ? Fcurrent_buffer ()
299: : Qnil);
300:
301: val = command_loop ();
302: if (EQ (val, Qt))
303: Fsignal (Qquit, Qnil);
304:
305: unbind_to (count);
306: return Qnil;
307: }
308:
309: Lisp_Object
310: recursive_edit_unwind (buffer)
311: Lisp_Object buffer;
312: {
313: if (!NULL (buffer))
314: Fset_buffer (buffer);
315: RecurseDepth--;
316: RedoModes++;
317: return Qnil;
318: }
319:
320: Lisp_Object
321: cmd_error (data)
322: Lisp_Object data;
323: {
324: Lisp_Object errmsg, tail, errname, file_error;
325: int i;
326:
327: Vquit_flag = Qnil;
328: Vinhibit_quit = Qt;
329: Vstandard_output = Qt;
330: Vstandard_input = Qt;
331: Vexecuting_macro = Qnil;
332: minibuf_message = 0;
333:
334: Fdiscard_input ();
335: Ding ();
336:
337: errname = Fcar (data);
338:
339: if (EQ (errname, Qerror))
340: {
341: data = Fcdr (data);
342: if (!CONSP (data)) data = Qnil;
343: errmsg = Fcar (data);
344: file_error = Qnil;
345: }
346: else
347: {
348: errmsg = Fget (errname, Qerror_message);
349: file_error = Fmemq (Qfile_error,
350: Fget (errname, Qerror_conditions));
351: }
352:
353: /* Print an error message including the data items.
354: This is done by printing it into a scratch buffer
355: and then making a copy of the text in the buffer. */
356:
357: if (!CONSP (data)) data = Qnil;
358: tail = Fcdr (data);
359:
360: /* For file-error, make error message by concatenating
361: all the data items. They are all strings. */
362: if (!NULL (file_error))
363: errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
364:
365: if (XTYPE (errmsg) == Lisp_String)
366: Fprinc (errmsg, Qt);
367: else
368: write_string_1 ("peculiar error", -1, Qt);
369:
370: for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
371: {
372: write_string_1 (i ? ", " : ": ", 2, Qt);
373: if (!NULL (file_error))
374: Fprinc (Fcar (tail), Qt);
375: else
376: Fprin1 (Fcar (tail), Qt);
377: }
378:
379: /* In -batch mode, force out the error message and newlines after it
380: and then die. */
381: if (noninteractive)
382: {
383: message ("");
384: Fkill_emacs (make_number (-1));
385: }
386:
387: Vquit_flag = Qnil;
388:
389: Vinhibit_quit = Qnil;
390: return make_number (0);
391: }
392:
393: Lisp_Object command_loop_1 ();
394: Lisp_Object command_loop_2 ();
395: Lisp_Object cmd_error ();
396: Lisp_Object top_level_1 ();
397:
398: /* Entry to editor-command-loop.
399: This level has the catches for exiting/returning to editor command loop.
400: It returns nil to exit recursive edit, t to abort it. */
401:
402: Lisp_Object
403: command_loop ()
404: {
405: if (RecurseDepth)
406: {
407: return internal_catch (Qexit, command_loop_2, Qnil);
408: }
409: else
410: while (1)
411: {
412: internal_catch (Qtop_level, top_level_1, Qnil);
413: internal_catch (Qtop_level, command_loop_2, Qnil);
414: /* End of file in -batch run causes exit here. */
415: if (noninteractive)
416: Fkill_emacs (Qt);
417: }
418: }
419:
420: /* Here we catch errors in execution of commands within the
421: editing loop, and reenter the editing loop.
422: When there is an error, cmd_error runs and returns a non-nil
423: value to us. A value of nil means that cmd_loop_1 itself
424: returned due to end of file (or end of kbd macro). */
425:
426: Lisp_Object
427: command_loop_2 ()
428: {
429: register Lisp_Object val;
430: do
431: val = internal_condition_case (command_loop_1, Qerror, cmd_error);
432: while (!NULL (val));
433: return Qnil;
434: }
435:
436: Lisp_Object
437: top_level_2 ()
438: {
439: return Feval (Vtop_level);
440: }
441:
442: Lisp_Object
443: top_level_1 ()
444: {
445: /* On entry to the outer level, run the startup file */
446: if (!NULL (Vtop_level))
447: internal_condition_case (top_level_2, Qerror, cmd_error);
448: else if (!NULL (Vpurify_flag))
449: message ("Bare impure Emacs (standard Lisp code not loaded)");
450: else
451: message ("Bare Emacs (standard Lisp code not loaded)");
452: return Qnil;
453: }
454:
455: DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
456: "Exit all recursive editing levels.")
457: ()
458: {
459: Fthrow (Qtop_level, Qnil);
460: }
461:
462: DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
463: "Exit from the innermost recursive edit or minibuffer.")
464: ()
465: {
466: if (RecurseDepth)
467: Fthrow (Qexit, Qnil);
468: error ("No recursive edit is in progress");
469: }
470:
471: DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
472: "Abort the command that requested this recursive edit or minibuffer input.")
473: ()
474: {
475: if (RecurseDepth)
476: Fthrow (Qexit, Qt);
477: error ("No recursive edit is in progress");
478: }
479:
480: /* This is the actual command reading loop,
481: sans error-handling encapsulation */
482:
483: Lisp_Object Fcommand_execute ();
484:
485: Lisp_Object
486: command_loop_1 ()
487: {
488: Lisp_Object cmd;
489: int lose;
490: int nonundocount;
491: char keybuf[30];
492: int i;
493: int no_redisplay;
494: int no_direct;
495:
496: Vprefix_arg = Qnil;
497: waiting_for_input = 0;
498: Echo1 = 0;
499: NextK = 0;
500: last_command = Qt;
501: nonundocount = 0;
502: no_redisplay = 0;
503:
504: while (1)
505: {
506: /* Install chars successfully executed in kbd macro */
507: if (defining_kbd_macro && NULL (Vprefix_arg))
508: finalize_kbd_macro_chars ();
509:
510: /* Make sure current window's buffer is selected. */
511:
512: if (XBUFFER (XWINDOW (selected_window)->buffer) != bf_cur)
513: SetBfp (XBUFFER (XWINDOW (selected_window)->buffer));
514:
515: no_direct = 0;
516:
517: /* If minibuffer on and echo area in use,
518: wait 2 sec and redraw minibufer. */
519:
520: if (MinibufDepth && minibuf_message)
521: {
522: Fsit_for (make_number (2), Qnil);
523: minibuf_message = 0;
524: no_direct = 1;
525: if (!NULL (Vquit_flag))
526: {
527: Vquit_flag = Qnil;
528: unread_command_char = Ctl ('g');
529: }
530: }
531:
532: i = 0;
533: #if 0
534: /* If prev. command was directly displayed, we don't need
535: redisplay. Try shortcut for reading single-char key sequence. */
536: if (no_redisplay)
537: i = fast_read_one_key (keybuf);
538: #endif /* 0 */
539: /* Shortcut not applicable or found a prefix key.
540: Take full precautions and read key sequence the hard way. */
541: if (i == 0)
542: {
543: #ifdef C_ALLOCA
544: alloca (0); /* Cause a garbage collection now */
545: /* Since we can free the most stuff here. */
546: #endif /* C_ALLOCA */
547:
548: /* Read next key sequence; i gets its length. */
549:
550: i = read_key_sequence (keybuf, sizeof keybuf, 0,
551: no_redisplay && buffer_shared <= 1);
552: }
553:
554: /* Now we have read a key sequence of length I,
555: or else I is 0 and we found end of file. */
556:
557: if (i == 0) /* End of file -- happens only in */
558: return Qnil; /* a kbd macro, at the end */
559:
560: last_command_char = keybuf[i - 1];
561:
562: cmd = read_key_sequence_cmd;
563: if (!NULL (Vexecuting_macro))
564: {
565: if (!NULL (Vquit_flag))
566: {
567: Vexecuting_macro = Qt;
568: QUIT; /* Make some noise. */
569: /* Will return since macro now empty. */
570: }
571: }
572:
573: /* Do redisplay processing after this command except in special
574: cases identified below that set no_redisplay to 1. */
575: no_redisplay = 0;
576:
577: /* Execute the command. */
578:
579: if (NULL (cmd))
580: {
581: /* nil means key is undefined. */
582: Ding ();
583: defining_kbd_macro = 0;
584: RedoModes++;
585: Vprefix_arg = Qnil;
586: }
587: else
588: {
589: this_command = cmd;
590: if (NULL (Vprefix_arg) && ! no_direct)
591: {
592: if (EQ (cmd, Qforward_char) && point <= NumCharacters)
593: {
594: lose = CharAt (point);
595: SetPoint (point + 1);
596: if (lose >= ' ' && lose < 0177
597: && (XFASTINT (XWINDOW (selected_window)->last_modified)
598: >= bf_modified)
599: && (XFASTINT (XWINDOW (selected_window)->last_point)
600: == point)
601: && !windows_or_buffers_changed
602: && EQ (bf_cur->selective_display, Qnil)
603: && !detect_input_pending ()
604: && NULL (Vexecuting_macro))
605: no_redisplay = direct_output_forward_char (1);
606: goto directly_done;
607: }
608: else if (EQ (cmd, Qbackward_char) && point > FirstCharacter)
609: {
610: SetPoint (point - 1);
611: lose = CharAt (point);
612: if (lose >= ' ' && lose < 0177
613: && (XFASTINT (XWINDOW (selected_window)->last_modified)
614: >= bf_modified)
615: && (XFASTINT (XWINDOW (selected_window)->last_point)
616: == point)
617: && !windows_or_buffers_changed
618: && EQ (bf_cur->selective_display, Qnil)
619: && !detect_input_pending ()
620: && NULL (Vexecuting_macro))
621: no_redisplay = direct_output_forward_char (-1);
622: goto directly_done;
623: }
624: else if (EQ (cmd, Qself_insert_command))
625: {
626: if (NULL (Vexecuting_macro) &&
627: !EQ (minibuf_window, selected_window))
628: {
629: if (!nonundocount || nonundocount >= 20)
630: {
631: Fundo_boundary ();
632: nonundocount = 0;
633: }
634: nonundocount++;
635: }
636: lose = (XFASTINT (XWINDOW (selected_window)->last_modified)
637: < bf_modified)
638: || (XFASTINT (XWINDOW (selected_window)->last_point)
639: != point)
640: || bf_modified <= bf_cur->save_modified
641: || windows_or_buffers_changed
642: || !EQ (bf_cur->selective_display, Qnil)
643: || detect_input_pending ()
644: || !NULL (Vexecuting_macro);
645: if (SelfInsert (last_command_char, 0))
646: {
647: lose = 1;
648: nonundocount = 0;
649: }
650: if (!lose
651: && (point == NumCharacters + 1 || CharAt (point) == '\n')
652: && last_command_char >= ' '
653: && last_command_char < 0177)
654: no_redisplay
655: = direct_output_for_insert (last_command_char);
656: goto directly_done;
657: }
658: }
659:
660: /* Here for a command that isn't executed directly */
661:
662: nonundocount = 0;
663: if (NULL (Vprefix_arg) && NULL (Vexecuting_macro) &&
664: !EQ (minibuf_window, selected_window))
665: Fundo_boundary ();
666: Fcommand_execute (cmd, Qnil);
667:
668: directly_done: ;
669: }
670:
671: if (NULL (Vprefix_arg))
672: {
673: last_command = this_command;
674: NextK = 0;
675: Echo1 = 0;
676: }
677: }
678: }
679:
680: /* Input of single characters from keyboard */
681:
682: Lisp_Object print_help ();
683:
684: int echo_flag;
685: int echo_now;
686:
687: /* Alarm interrupt calls this and requests echoing at earliest safe time. */
688: request_echo ()
689: {
690: int old_errno = errno;
691:
692: /* Note: no need to reestablish handler on USG systems
693: because it is established, if approriate, each time an alarm is requested. */
694: #ifdef subprocesses
695: #ifdef BSD4_1
696: extern int select_alarmed;
697: if (select_alarmed == 0)
698: {
699: select_alarmed = 1;
700: sigrelse (SIGALRM);
701: return;
702: }
703: #endif
704: #endif
705:
706: #ifdef BSD4_1
707: sigisheld (SIGALRM);
708: #endif
709:
710: if (echo_now)
711: EchoThem (1);
712: else
713: echo_flag = 1;
714:
715: #ifdef BSD4_1
716: sigunhold (SIGALRM);
717: #endif
718:
719: errno = old_errno;
720: }
721:
722: /* read a character from the keyboard; call the redisplay if needed */
723: /* commandflag 0 means do not do auto-saving, but do do redisplay.
724: -1 means do not do redisplay, but do do autosaving.
725: 1 means do both. */
726:
727: get_char (commandflag)
728: int commandflag;
729: {
730: register int c;
731: int alarmtime;
732: int count;
733: Lisp_Object tem;
734: extern request_echo ();
735:
736: if ((c = unread_command_char) >= 0)
737: {
738: unread_command_char = -1;
739: goto reread;
740: }
741:
742: if (!NULL (Vexecuting_macro))
743: {
744: if (XTYPE (Vexecuting_macro) != Lisp_String
745: || XSTRING (Vexecuting_macro)->size <= executing_macro_index)
746: return -1;
747: QUIT;
748: c = XSTRING (Vexecuting_macro)->data[executing_macro_index++];
749: goto from_macro;
750: }
751:
752: if (commandflag >= 0 && !input_pending && !detect_input_pending ())
753: DoDsp (0);
754:
755: if (commandflag != 0
756: && auto_save_interval > 0
757: && Keystrokes > auto_save_interval
758: && Keystrokes > 20
759: && !input_pending && !detect_input_pending ())
760: {
761: Fdo_auto_save (Qnil);
762: Keystrokes = 0;
763: }
764:
765: Keystrokes++;
766:
767: if (_setjmp (getcjmp))
768: {
769: c = Ctl('g');
770: waiting_for_input = 0;
771: input_available_clear_word = 0;
772:
773: goto non_reread;
774: }
775:
776: /* Message turns off echoing unless more keystrokes turn it on again. */
777: if (minibuf_message && *minibuf_message && minibuf_message != echobuf)
778: Echo1 = 0, NextK = 0;
779:
780: /* If already echoing, continue. */
781: else if (Echo1 != 0 /*|| cursor_in_echo_area*/ )
782: EchoThem (1);
783:
784: /* If in middle of key sequence and minibuffer not active,
785: start echoing if enough time elapses. */
786: else if (MinibufDepth == 0 && NextK != 0 && echo_keystrokes > 0)
787: {
788: /* Else start echoing if user waits more than `alarmtime' seconds. */
789: /* This interrupt either calls EchoThem right away
790: or sets echo_flag, which causes EchoThem to be called
791: by set_waiting_for_input's next invocation. */
792: signal (SIGALRM, request_echo);
793: echo_flag = 0;
794: echo_now = 0;
795: alarmtime = echo_keystrokes;
796: alarm ((unsigned) alarmtime);
797: }
798:
799: c = kbd_buffer_get_char ();
800:
801: non_reread:
802:
803: /* Cancel alarm if it was set and has not already gone off. */
804: if (alarmtime > 0) alarm (0);
805:
806: minibuf_message = 0;
807:
808: if (c < 0) return -1;
809:
810: c &= MetaFlag ? 0377 : 0177;
811:
812: if (XTYPE (Vkeyboard_translate_table) == Lisp_String
813: && XSTRING (Vkeyboard_translate_table)->size > c)
814: c = XSTRING (Vkeyboard_translate_table)->data[c];
815:
816: total_keys++;
817: recent_keys[recent_keys_index] = c;
818: recent_keys_index = (recent_keys_index + 1) % sizeof recent_keys;
819:
820: if (dribble)
821: {
822: putc (c, dribble);
823: fflush (dribble);
824: }
825:
826: store_kbd_macro_char (c);
827:
828: from_macro:
829: if (NextK < sizeof KeyBuf)
830: KeyBuf[NextK++] = c;
831:
832: /* If already echoing, echo right away. */
833: if (Echo1 /*|| cursor_in_echo_area*/ )
834: EchoThem (0);
835:
836: reread:
837: /* If the first character of a command is being reread,
838: store it in case a pause follows and it must be echoed later.
839: This has no effect on a non-reread character
840: since NextK is not zero here for them. */
841: if (NextK == 0)
842: KeyBuf[NextK++] = c;
843:
844: last_input_char = c;
845:
846: num_input_chars++;
847:
848: /* Process the help character specially if enabled */
849: if (c == help_char && !NULL (Vhelp_form))
850: {
851: count = specpdl_ptr - specpdl;
852:
853: record_unwind_protect (Fset_window_configuration,
854: Fcurrent_window_configuration ());
855:
856: tem = Feval (Vhelp_form);
857: if (XTYPE (tem) == Lisp_String)
858: internal_with_output_to_temp_buffer ("*Help*", print_help, tem);
859:
860: NextK = 0;
861: c = get_char (0);
862: /* Remove the help from the screen */
863: unbind_to (count);
864: DoDsp (0);
865: if (c == 040)
866: {
867: NextK = 0;
868: c = get_char (0);
869: }
870: }
871:
872: return c;
873: }
874:
875: Lisp_Object
876: print_help (object)
877: Lisp_Object object;
878: {
879: Fprinc (object, Qnil);
880: return Qnil;
881: }
882:
883: /* Low level keyboard input.
884: Read characters into kbd_buffer
885: from which they are obtained by kbd_buffer_get_char. */
886:
887: /* Set this for debugging, to have a way to get out */
888: int stop_character;
889:
890: /* Store a character obtained at interrupt level into kbd_buffer, fifo */
891: kbd_buffer_store_char (c)
892: register int c;
893: {
894: c &= 0377;
895:
896: if (c == Ctl ('g')
897: || ((c == (0200 | Ctl ('g'))) && !MetaFlag))
898: {
899: interrupt_signal ();
900: return;
901: }
902:
903: if (c && c == stop_character)
904: {
905: sys_suspend ();
906: return;
907: }
908:
909: if (kbd_ptr != kbd_buffer)
910: {
911: bcopy (kbd_ptr, kbd_buffer, kbd_count);
912: kbd_ptr = kbd_buffer;
913: }
914:
915: if (kbd_count < sizeof kbd_buffer)
916: {
917: kbd_buffer[kbd_count++] = c;
918: }
919: }
920:
921: kbd_buffer_get_char ()
922: {
923: register int c;
924:
925: if (noninteractive)
926: {
927: c = getchar ();
928: return c;
929: }
930:
931: /* Either ordinary input buffer or C-g buffered means we can return. */
932: while (!kbd_count)
933: {
934: if (!NULL (Vquit_flag))
935: quit_throw_to_get_char ();
936:
937: /* One way or another, wait until input is available; then, if
938: interrupt handlers have not read it, read it now. */
939:
940: #ifdef VMS
941: set_waiting_for_input (0);
942: wait_for_kbd_input ();
943: clear_waiting_for_input (0);
944: #else
945: /* Note SIGIO has been undef'd if FIONREAD is missing. */
946: #ifdef SIGIO
947: gobble_input ();
948: #endif /* SIGIO */
949: if (!kbd_count)
950: {
951: #ifdef subprocesses
952: wait_reading_process_input (0, -1, 1);
953: #else
954: /* Note SIGIO has been undef'd if FIONREAD is missing. */
955: #ifdef SIGIO
956: if (interrupt_input)
957: {
958: sigblockx (SIGIO);
959: set_waiting_for_input (0);
960: while (!kbd_count)
961: sigpausex (SIGIO);
962: clear_waiting_for_input ();
963: sigunblockx (SIGIO);
964: }
965: #else
966: interrupt_input = 0;
967: #endif /* not SIGIO */
968: #endif /* subprocesses */
969:
970: if (!interrupt_input && !kbd_count)
971: {
972: read_avail_input (0);
973: }
974: }
975: #endif /* not VMS */
976: }
977:
978: input_pending = --kbd_count > 0;
979: c = *kbd_ptr; /* *kbd_ptr++ would have a timing error. */
980: kbd_ptr++; /* See kbd_buffer_store_char. */
981: return (c & (MetaFlag ? 0377 : 0177)); /* Clean up if sign was extended. */
982: }
983:
984: /* Force an attempt to read input regardless of what FIONREAD says. */
985:
986: force_input_read ()
987: {
988: force_input = 1;
989: detect_input_pending ();
990: force_input = 0;
991: }
992:
993: /* Store into *addr the number of terminal input chars available.
994: Equivalent to ioctl (0, FIONREAD, addr) but works
995: even if FIONREAD does not exist. */
996:
997: static void
998: get_input_pending (addr)
999: int *addr;
1000: {
1001: #ifdef VMS
1002: /* On VMS, we always have something in the buffer
1003: if any input is available. */
1004: /*** It might be simpler to make interrupt_input 1 on VMS ***/
1005: *addr = kbd_count | !NULL (Vquit_flag);
1006: #else
1007: /* First of all, have we already counted some input? */
1008: *addr = kbd_count | !NULL (Vquit_flag);
1009: /* If input is being read as it arrives, and we have none, there is none. */
1010: if (*addr > 0 || (interrupt_input && ! interrupts_deferred && ! force_input))
1011: return;
1012: #ifdef FIONREAD
1013: if (! force_input)
1014: {
1015: /* If we can count the input without reading it, do so. */
1016: if (ioctl (0, FIONREAD, addr) < 0)
1017: *addr = 0;
1018: if (*addr == 0 || read_socket_hook == 0)
1019: return;
1020: /* If the input consists of window-events, not all of them
1021: are necessarily kbd chars. So process all the input
1022: and see how many kbd chars we got. */
1023: }
1024: #endif
1025: #ifdef SIGIO
1026: {
1027: /* It seems there is a timing error such that a SIGIO can be handled here
1028: and cause kbd_count to become nonzero even though raising of SIGIO
1029: has already been turned off. */
1030: int mask = sigblock (sigmask (SIGIO));
1031: if (kbd_count == 0)
1032: read_avail_input (*addr);
1033: sigsetmask (mask);
1034: }
1035: #else
1036: /* If we can't count the input, read it (if any) and see what we got. */
1037: read_avail_input (*addr);
1038: #endif
1039: *addr = kbd_count;
1040: #endif
1041: }
1042:
1043: /* Read any terminal input already buffered up by the system
1044: into the kbd_buffer, assuming the buffer is currently empty.
1045: Never waits. We assume that kbd_buffer is empty before you call.
1046:
1047: If NREAD is nonzero, assume it contains # chars of raw data waiting.
1048: If it is zero, we determine that datum.
1049:
1050: Input gets into the kbd_buffer either through this function
1051: (at main program level) or at interrupt level if input
1052: is interrupt-driven. */
1053:
1054: static void
1055: read_avail_input (nread)
1056: int nread;
1057: {
1058: /* This function is not used on VMS. */
1059: #ifndef VMS
1060: #ifdef FIONREAD
1061: char buf[256 * BUFFER_SIZE_FACTOR];
1062: register char *p;
1063: register int i;
1064:
1065: if (kbd_count)
1066: abort ();
1067:
1068: if (! force_input)
1069: {
1070: if (nread == 0)
1071: get_input_pending (&nread);
1072: if (nread == 0)
1073: return;
1074: }
1075: if (nread > sizeof buf)
1076: nread = sizeof buf;
1077:
1078: /* Read what is waiting. */
1079: if (read_socket_hook)
1080: nread = (*read_socket_hook) (0, buf, nread);
1081: else
1082: nread = read (0, buf, nread);
1083:
1084: /* Scan the chars for C-g and store them in kbd_buffer. */
1085: kbd_ptr = kbd_buffer;
1086: for (i = 0; i < nread; i++)
1087: {
1088: kbd_buffer_store_char (buf[i]);
1089: /* Don't look at input that follows a C-g too closely.
1090: This reduces lossage due to autorepeat on C-g. */
1091: if (buf[i] == Ctl ('G'))
1092: break;
1093: }
1094:
1095: #else /* no FIONREAD */
1096: #ifdef USG
1097: if (kbd_count)
1098: abort ();
1099:
1100: fcntl (fileno (stdin), F_SETFL, O_NDELAY);
1101: kbd_ptr = kbd_buffer;
1102: if (read_socket_hook)
1103: {
1104: kbd_count = (*read_socket_hook) (0, kbd_buffer, sizeof kbd_buffer);
1105: }
1106: else
1107: {
1108: kbd_count = read (fileno (stdin), kbd_buffer, sizeof kbd_buffer);
1109: }
1110: #ifdef EBADSLT
1111: if (kbd_count == -1 && (errno == EAGAIN || errno == EBADSLT))
1112: #else
1113: if (kbd_count == -1 && errno == EAGAIN)
1114: #endif
1115: kbd_count = 0;
1116: fcntl (fileno (stdin), F_SETFL, 0);
1117: #else /* not USG */
1118: you lose
1119: #endif /* not USG */
1120: #endif /* no FIONREAD */
1121: #endif /* not VMS */
1122: }
1123:
1124: #ifdef SIGIO /* for entire page */
1125: /* Note SIGIO has been undef'd if FIONREAD is missing. */
1126:
1127: /* If using interrupt input and some input chars snuck into the
1128: buffer before we enabled interrupts, fake an interrupt for them. */
1129:
1130: gobble_input ()
1131: {
1132: int nread;
1133: if (interrupt_input)
1134: {
1135: if (ioctl (0, FIONREAD, &nread) < 0)
1136: nread = 0;
1137: if (nread)
1138: {
1139: sigholdx (SIGIO);
1140: input_available_signal (SIGIO);
1141: sigfree ();
1142: }
1143: }
1144: }
1145:
1146: input_available_signal (signo)
1147: int signo;
1148: {
1149: unsigned char buf[256 * BUFFER_SIZE_FACTOR];
1150: int nread;
1151: register int i;
1152: /* Must preserve main program's value of errno. */
1153: int old_errno = errno;
1154: #ifdef BSD4_1
1155: extern int select_alarmed;
1156: #endif
1157:
1158: #ifdef USG
1159: /* USG systems forget handlers when they are used;
1160: must reestablish each time */
1161: signal (signo, input_available_signal);
1162: #endif /* USG */
1163:
1164: #ifdef BSD4_1
1165: sigisheld (SIGIO);
1166: #endif
1167:
1168: if (input_available_clear_word)
1169: *input_available_clear_word = 0;
1170:
1171: while (1)
1172: {
1173: if (ioctl (0, FIONREAD, &nread) < 0)
1174: nread = 0;
1175: if (nread <= 0)
1176: break;
1177: #ifdef BSD4_1
1178: select_alarmed = 1; /* Force the select emulator back to life */
1179: #endif
1180: if (read_socket_hook)
1181: {
1182: nread = (*read_socket_hook) (0, buf, sizeof buf);
1183: if (!nread)
1184: continue;
1185: }
1186: else
1187: {
1188: if (nread > sizeof buf)
1189: nread = sizeof buf;
1190: nread = read (0, buf, nread);
1191: }
1192:
1193: for (i = 0; i < nread; i++)
1194: {
1195: kbd_buffer_store_char (buf[i]);
1196: /* Don't look at input that follows a C-g too closely.
1197: This reduces lossage due to autorepeat on C-g. */
1198: if (buf[i] == Ctl('G'))
1199: break;
1200: }
1201: }
1202: #ifdef BSD4_1
1203: sigfree ();
1204: #endif
1205: errno = old_errno;
1206: }
1207: #endif /* SIGIO */
1208:
1209: #if 0
1210: /* This is turned off because it didn't produce much speedup. */
1211:
1212: /* Read a single-char key sequence. Do not redisplay.
1213: Return 1 if successful, or 0 if what follows is not
1214: a single-char key. (In that case, a char has been unread.)
1215: This is used instead of read_key_sequence as an optimization
1216: just after a direct-updating command is done, since at such
1217: times we know that no redisplay is required. */
1218:
1219: int
1220: fast_read_one_key (keybuf)
1221: char *keybuf;
1222: {
1223: register Lisp_Object map;
1224: register int c;
1225: register Lisp_Object tem;
1226:
1227: keys_prompt = 0;
1228: /* Read a character, and do not redisplay. */
1229: c = get_char (-1);
1230: Vquit_flag = Qnil;
1231:
1232: /* Assume until further notice that we are unlucky
1233: and will return zero, so this char will be
1234: reread by read_key_sequence. */
1235:
1236: unread_command_char = c;
1237:
1238: if (c < 0 || c >= 0200)
1239: return 0;
1240:
1241: map = bf_cur->keymap;
1242: if (!EQ (map, Qnil))
1243: {
1244: tem = get_keyelt (access_keymap (map, c));
1245: if (!EQ (tem, Qnil))
1246: return 0;
1247: }
1248:
1249: XSET (map, Lisp_Vector, CurrentGlobalMap);
1250: tem = !NULL (map)
1251: ? get_keyelt (access_keymap (map, c))
1252: : Qnil;
1253:
1254: read_key_sequence_cmd = tem;
1255:
1256: /* trace symbols to their function definitions */
1257:
1258: while (XTYPE (tem) == Lisp_Symbol && !NULL (tem)
1259: && !EQ (tem, Qunbound))
1260: tem = XSYMBOL (tem)->function;
1261:
1262: /* Is the definition a prefix character? */
1263:
1264: if (XTYPE (tem) == Lisp_Vector ||
1265: (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)))
1266: return 0;
1267:
1268: unread_command_char = -1;
1269: keybuf[0] = c;
1270: return 1;
1271: }
1272:
1273: #endif /* 0 */
1274:
1275: /* Read a sequence of keys that ends with a non prefix character,
1276: and store them in KEYBUF, a buffer of size BUFSIZE.
1277: Prompt with PROMPT. Echo starting immediately unless `prompt' is 0.
1278: Return the length of the key sequence stored.
1279: NODISPLAY nonzero means don't do redisplay before the first character
1280: (just for speedup). */
1281:
1282: int
1283: read_key_sequence (keybuf, bufsize, prompt, nodisplay)
1284: char *keybuf;
1285: int bufsize;
1286: unsigned char *prompt;
1287: int nodisplay;
1288: {
1289: register int i;
1290: Lisp_Object nextlocal, nextglobal;
1291: register int c, nextc;
1292: Lisp_Object local, global;
1293:
1294: keys_prompt = prompt;
1295:
1296: if (prompt)
1297: NextK = 0;
1298: if ((prompt || cursor_in_echo_area) && INTERACTIVE)
1299: EchoThem (1);
1300:
1301: nextc = get_char (nodisplay ? -1 : !prompt);
1302: nextlocal = bf_cur->keymap;
1303: XSET (nextglobal, Lisp_Vector, CurrentGlobalMap);
1304:
1305: i = 0;
1306: while (!NULL (nextlocal) || !NULL (nextglobal))
1307: {
1308: if (i == bufsize)
1309: error ("key sequence too long");
1310:
1311: if (nextc >= 0)
1312: {
1313: c = nextc;
1314: nextc = -1;
1315: }
1316: else
1317: c = get_char (!prompt);
1318: Vquit_flag = Qnil;
1319: nodisplay = 0;
1320:
1321: if (c < 0)
1322: return 0;
1323: if (c >= 0200)
1324: {
1325: nextc = c & 0177;
1326: c = meta_prefix_char;
1327: }
1328:
1329: keybuf[i] = c;
1330:
1331: global = !NULL (nextglobal)
1332: ? get_keyelt (access_keymap (nextglobal, c))
1333: : Qnil;
1334:
1335: local = !NULL (nextlocal)
1336: ? get_keyelt (access_keymap (nextlocal, c))
1337: : Qnil;
1338:
1339: /* If C is not defined in either keymap
1340: and it is an uppercase letter, try corresponding lowercase. */
1341:
1342: if (NULL (global) && NULL (local) && UPPERCASEP (c))
1343: {
1344: global = !NULL (nextglobal)
1345: ? get_keyelt (access_keymap (nextglobal, DOWNCASE (c)))
1346: : Qnil;
1347:
1348: local = !NULL (nextlocal)
1349: ? get_keyelt (access_keymap (nextlocal, DOWNCASE (c)))
1350: : Qnil;
1351:
1352: /* If that has worked better that the original char,
1353: downcase it permanently. */
1354:
1355: if (!NULL (global) || !NULL (local))
1356: {
1357: keybuf[i] = c = DOWNCASE (c);
1358: }
1359: }
1360:
1361: i++;
1362:
1363: nextlocal = Qnil;
1364: nextglobal = Qnil;
1365:
1366: read_key_sequence_cmd = !NULL (local) ? local : global;
1367:
1368: /* trace symbols to their function definitions */
1369:
1370: while (XTYPE (global) == Lisp_Symbol && !NULL (global)
1371: && !EQ (global, Qunbound))
1372: global = XSYMBOL (global)->function;
1373: while (XTYPE (local) == Lisp_Symbol && !NULL (local)
1374: && !EQ (local, Qunbound))
1375: local = XSYMBOL (local)->function;
1376:
1377: /* Are the definitions prefix characters? */
1378:
1379: if (XTYPE (local) == Lisp_Vector ||
1380: (CONSP (local) && EQ (XCONS (local)->car, Qkeymap))
1381: ||
1382: /* If nextc is set, we are processing a prefix char
1383: that represents a meta-bit.
1384: Let a global prefix definition override a local non-prefix.
1385: This is for minibuffers that redefine Escape for completion.
1386: A real Escape gets completion, but Meta bits get ESC-prefix. */
1387: ((NULL (local) || nextc >= 0)
1388: && (XTYPE (global) == Lisp_Vector ||
1389: (CONSP (global) && EQ (XCONS (global)->car, Qkeymap)))))
1390: {
1391: if (XTYPE (local) == Lisp_Vector ||
1392: (CONSP (local) && EQ (XCONS (local)->car, Qkeymap)))
1393: nextlocal = local;
1394: else
1395: nextlocal = Qnil;
1396:
1397: if (XTYPE (global) == Lisp_Vector ||
1398: (CONSP (global) && EQ (XCONS (global)->car, Qkeymap)))
1399: nextglobal = global;
1400: else
1401: nextglobal = Qnil;
1402: }
1403: }
1404:
1405: keys_prompt = 0;
1406: return i;
1407: }
1408:
1409: DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 1, 0,
1410: "Read a sequence of keystrokes and return as a string.\n\
1411: The sequence is sufficient to specify a non-prefix command\n\
1412: starting from the current local and global keymaps.\n\
1413: A C-g typed while in this function is treated like\n\
1414: any other character, and quit-flag is not set.\n\
1415: One arg, PROMPT, a prompt string or nil, meaning do not prompt specially.")
1416: (prompt)
1417: Lisp_Object prompt;
1418: {
1419: char keybuf[30];
1420: register int i;
1421:
1422: if (!NULL (prompt))
1423: CHECK_STRING (prompt, 0);
1424: QUIT;
1425: i = read_key_sequence (keybuf, sizeof keybuf,
1426: (NULL (prompt)) ? 0 : XSTRING (prompt)->data,
1427: 0);
1428: return make_string (keybuf, i);
1429: }
1430:
1431: DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
1432: "Execute CMD as an editor command.\n\
1433: CMD must be a symbol that satisfies the `commandp' predicate.\n\
1434: Optional second arg RECORD-FLAG non-nil\n\
1435: means unconditionally put this command in the command-history.\n\
1436: Otherwise, this is done only if an arg is read using the minibuffer.")
1437: (cmd, record)
1438: Lisp_Object cmd, record;
1439: {
1440: register Lisp_Object final;
1441: register Lisp_Object tem;
1442: Lisp_Object prefixarg;
1443: struct backtrace backtrace;
1444: extern int debug_on_next_call;
1445:
1446: prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
1447: Vcurrent_prefix_arg = prefixarg;
1448: debug_on_next_call = 0;
1449:
1450: if (XTYPE (cmd) == Lisp_Symbol)
1451: {
1452: tem = Fget (cmd, Qdisabled);
1453: if (!NULL (tem))
1454: return call0 (Vdisabled_command_hook);
1455: }
1456:
1457: while (1)
1458: {
1459: final = cmd;
1460: while (XTYPE (final) == Lisp_Symbol)
1461: {
1462: if (EQ (Qunbound, XSYMBOL (final)->function))
1463: Fsymbol_function (final); /* Get an error! */
1464: final = XSYMBOL (final)->function;
1465: }
1466:
1467: if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
1468: do_autoload (final, cmd);
1469: else
1470: break;
1471: }
1472:
1473: if (CONSP (final) || XTYPE (final) == Lisp_Subr)
1474: {
1475: backtrace.next = backtrace_list;
1476: backtrace_list = &backtrace;
1477: backtrace.function = &Qcall_interactively;
1478: backtrace.args = &cmd;
1479: backtrace.nargs = 1;
1480: backtrace.evalargs = 0;
1481:
1482: tem = Fcall_interactively (cmd, record);
1483:
1484: backtrace_list = backtrace.next;
1485: return tem;
1486: }
1487: if (XTYPE (final) == Lisp_String)
1488: {
1489: return Fexecute_kbd_macro (final, prefixarg);
1490: }
1491: return Qnil;
1492: }
1493:
1494: DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
1495: 1, 1, "P",
1496: "Read function name, then read its arguments and call it.")
1497: (prefixarg)
1498: Lisp_Object prefixarg;
1499: {
1500: Lisp_Object function;
1501: char buf[40];
1502: char saved_keys[40];
1503: int saved_keys_len = min (NextK, sizeof (saved_keys));
1504:
1505: bcopy (KeyBuf, saved_keys, saved_keys_len);
1506:
1507: buf[0] = 0;
1508:
1509: if (EQ (prefixarg, Qminus))
1510: strcpy (buf, "- ");
1511: else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
1512: strcpy (buf, "C-u ");
1513: else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
1514: sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
1515: else if (XTYPE (prefixarg) == Lisp_Int)
1516: sprintf (buf, "%d ", XINT (prefixarg));
1517:
1518: /* This isn't strictly correct if execute-extended-command
1519: is bound to anything else */
1520: strcat (buf, "M-x ");
1521:
1522: function = Fcompleting_read (build_string (buf), Vobarray, Qcommandp, Qt, Qnil);
1523:
1524: saved_keys_len = min (saved_keys_len, sizeof (KeyBuf));
1525: bcopy (saved_keys, KeyBuf, saved_keys_len);
1526: if (saved_keys_len >= sizeof (KeyBuf))
1527: NextK = sizeof (KeyBuf);
1528: else
1529: {
1530: int l = XSTRING (function)->size;
1531: l = min (sizeof (KeyBuf) - saved_keys_len, l);
1532: bcopy (XSTRING (function)->data, KeyBuf + saved_keys_len, l);
1533: NextK = saved_keys_len + l;
1534: }
1535:
1536: function = Fintern (function, Vobarray);
1537: Vprefix_arg = prefixarg;
1538: this_command = function;
1539:
1540: return Fcommand_execute (function, Qt);
1541: }
1542:
1543:
1544: detect_input_pending ()
1545: {
1546: if (!input_pending)
1547: get_input_pending (&input_pending);
1548:
1549: return input_pending;
1550: }
1551:
1552: DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
1553: "T if command input is currently available with no waiting.\n\
1554: Actually, the value is NIL only if we can be sure that no input is available.")
1555: ()
1556: {
1557: if (unread_command_char >= 0) return Qt;
1558:
1559: return detect_input_pending () ? Qt : Qnil;
1560: }
1561:
1562: DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
1563: "Return string of last 100 chars read from terminal.")
1564: ()
1565: {
1566: Lisp_Object val;
1567: if (total_keys < sizeof recent_keys)
1568: return make_string (recent_keys, total_keys);
1569:
1570: val = make_string (recent_keys, sizeof recent_keys);
1571: bcopy (recent_keys + recent_keys_index,
1572: XSTRING (val)->data,
1573: sizeof recent_keys - recent_keys_index);
1574: bcopy (recent_keys,
1575: XSTRING (val)->data + sizeof recent_keys - recent_keys_index,
1576: recent_keys_index);
1577: return val;
1578: }
1579:
1580: DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
1581: "Return string of the keystrokes that invoked this command.")
1582: ()
1583: {
1584: return make_string (KeyBuf, NextK);
1585: }
1586:
1587: DEFSIMPLE ("recursion-depth", Frecursion_depth, Srecursion_depth,
1588: "Return the current depth in recursive edits.",
1589: Lisp_Int, XSETINT, RecurseDepth)
1590:
1591: DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
1592: "FOpen dribble file: ",
1593: "Start writing all keyboard characters to FILE.")
1594: (file)
1595: Lisp_Object file;
1596: {
1597: file = Fexpand_file_name (file, Qnil);
1598: dribble = fopen (XSTRING (file)->data, "w");
1599: return Qnil;
1600: }
1601:
1602: DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
1603: "Discard the contents of the terminal input buffer.\n\
1604: Also flush any kbd macro definition in progress.")
1605: ()
1606: {
1607: defining_kbd_macro = 0;
1608: RedoModes++;
1609:
1610: unread_command_char = -1;
1611: discard_tty_input ();
1612:
1613: kbd_count = 0;
1614: input_pending = 0;
1615:
1616: return Qnil;
1617: }
1618:
1619: DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
1620: "Stop Emacs and return to superior process. You can resume.\n\
1621: If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
1622: to be read as terminal input by Emacs's superior shell.\n\
1623: Before suspending, if `suspend-hook' is bound and value is non-nil\n\
1624: call the value as a function of no args. Don't suspend if it returns non-nil.\n\
1625: Otherwise, suspend normally and after resumption call\n\
1626: `suspend-resume-hook' if that is bound and non-nil.")
1627: (stuffstring)
1628: Lisp_Object stuffstring;
1629: {
1630: register Lisp_Object tem;
1631: int count = specpdl_ptr - specpdl;
1632: extern init_sys_modes ();
1633:
1634: if (!NULL (stuffstring))
1635: CHECK_STRING (stuffstring, 0);
1636:
1637: /* Call value of suspend-hook
1638: if it is bound and value is non-nil. */
1639: tem = intern ("suspend-hook");
1640: tem = XSYMBOL (tem)->value;
1641: if (! EQ (tem, Qunbound) && ! EQ (tem, Qnil))
1642: {
1643: tem = call0 (tem);
1644: if (!EQ (tem, Qnil)) return Qnil;
1645: }
1646:
1647: reset_sys_modes ();
1648: /* sys_suspend can get an error if it tries to fork a subshell
1649: and the system resources aren't available for that. */
1650: record_unwind_protect (init_sys_modes, 0);
1651: stuff_buffered_input (stuffstring);
1652: sys_suspend ();
1653: unbind_to (count);
1654:
1655: /* Call value of suspend-resume-hook
1656: if it is bound and value is non-nil. */
1657: tem = intern ("suspend-resume-hook");
1658: tem = XSYMBOL (tem)->value;
1659: if (! EQ (tem, Qunbound) && ! EQ (tem, Qnil))
1660: call0 (tem);
1661: return Qnil;
1662: }
1663:
1664: /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
1665: Then in any case stuff anthing Emacs has read ahead and not used. */
1666:
1667: stuff_buffered_input (stuffstring)
1668: Lisp_Object stuffstring;
1669: {
1670: register unsigned char *p;
1671:
1672: /* stuff_char works only in BSD, versions 4.2 and up. */
1673: #ifdef BSD
1674: #ifndef BSD4_1
1675: if (XTYPE (stuffstring) == Lisp_String)
1676: {
1677: register int count;
1678:
1679: p = XSTRING (stuffstring)->data;
1680: count = XSTRING (stuffstring)->size;
1681: while (count-- > 0)
1682: stuff_char (*p++);
1683: stuff_char ('\n');
1684: }
1685: /* Anything we have read ahead, put back for the shell to read. */
1686: while (kbd_count)
1687: {
1688: stuff_char (*kbd_ptr++);
1689: kbd_count--;
1690: }
1691: input_pending = 0;
1692: #endif
1693: #endif /* BSD and not BSD4_1 */
1694: }
1695:
1696: set_waiting_for_input (word_to_clear)
1697: long *word_to_clear;
1698: {
1699: input_available_clear_word = word_to_clear;
1700:
1701: /* Tell interrupt_signal to throw back to get_char, */
1702: waiting_for_input = 1;
1703:
1704: /* If interrupt_signal was called before and buffered a C-g,
1705: make it run again now, to avoid timing error. */
1706: if (!NULL (Vquit_flag))
1707: quit_throw_to_get_char ();
1708:
1709: /* Tell alarm signal to echo right away */
1710: echo_now = 1;
1711:
1712: /* If alarm has gone off already, echo now. */
1713: if (echo_flag)
1714: {
1715: EchoThem (1);
1716: echo_flag = 0;
1717: }
1718: }
1719:
1720: clear_waiting_for_input ()
1721: {
1722: /* Tell interrupt_signal not to throw back to get_char, */
1723: waiting_for_input = 0;
1724: echo_now = 0;
1725: input_available_clear_word = 0;
1726: }
1727:
1728: /* This routine is called at interrupt level in response to C-G.
1729: If interrupt_input, this is the handler for SIGINT.
1730: Otherwise, it is called from kbd_buffer_store_char,
1731: in handling SIGIO or SIGTINT.
1732:
1733: If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
1734: immediately throw back to get_char.
1735:
1736: Otherwise it sets the Lisp variable quit-flag not-nil.
1737: This causes eval to throw, when it gets a chance.
1738: If quit-flag is already non-nil, it stops the job right away. */
1739:
1740: interrupt_signal ()
1741: {
1742: char c;
1743: /* Must preserve main program's value of errno. */
1744: int old_errno = errno;
1745: extern Lisp_Object Vwindow_system;
1746:
1747: #ifdef USG
1748: /* USG systems forget handlers when they are used;
1749: must reestablish each time */
1750: signal (SIGINT, interrupt_signal);
1751: signal (SIGQUIT, interrupt_signal);
1752: #endif /* USG */
1753:
1754: Echo1 = 0;
1755:
1756: if (!NULL (Vquit_flag) && NULL (Vwindow_system))
1757: {
1758: fflush (stdout);
1759: reset_sys_modes ();
1760: sigfree ();
1761: #ifdef SIGTSTP /* Support possible in later USG versions */
1762: /*
1763: * On systems which can suspend the current process and return to the original
1764: * shell, this command causes the user to end up back at the shell.
1765: * The "Auto-save" and "Abort" questions are not asked until
1766: * the user elects to return to emacs, at which point he can save the current
1767: * job and either dump core or continue.
1768: */
1769: sys_suspend ();
1770: #else
1771: #ifdef VMS
1772: if (sys_suspend () == -1)
1773: {
1774: printf ("Not running as a subprocess;\n");
1775: printf ("you can continue or abort.\n");
1776: }
1777: #else /* not VMS */
1778: /* Perhaps should really fork an inferior shell?
1779: But that would not provide any way to get back
1780: to the original shell, ever. */
1781: printf ("No support for stopping a process on this operating system;\n");
1782: printf ("you can continue or abort.\n");
1783: #endif /* not VMS */
1784: #endif /* not SIGTSTP */
1785: printf ("Auto-save? (y or n) ");
1786: fflush (stdout);
1787: if (((c = getchar ()) & ~040) == 'Y')
1788: Fdo_auto_save (Qnil);
1789: while (c != '\n') c = getchar ();
1790: #ifdef VMS
1791: printf ("Abort (and enter debugger)? (y or n) ");
1792: #else /* not VMS */
1793: printf ("Abort (and dump core)? (y or n) ");
1794: #endif /* not VMS */
1795: fflush (stdout);
1796: if (((c = getchar ()) & ~040) == 'Y')
1797: abort ();
1798: while (c != '\n') c = getchar ();
1799: printf ("Continuing...\n");
1800: fflush (stdout);
1801: init_sys_modes ();
1802: }
1803: else
1804: {
1805: /* If executing a function that wants to be interrupted out of
1806: and the user has not deferred quitting by binding `inhibit-quit'
1807: then quit right away. */
1808: if (immediate_quit && NULL (Vinhibit_quit))
1809: {
1810: immediate_quit = 0;
1811: sigfree ();
1812: Fsignal (Qquit, Qnil);
1813: }
1814: else
1815: /* Else request quit when it's safe */
1816: Vquit_flag = Qt;
1817: }
1818:
1819: if (waiting_for_input && !echoing)
1820: quit_throw_to_get_char ();
1821:
1822: errno = old_errno;
1823: }
1824:
1825: /* Handle a C-g by making get_char return C-g. */
1826:
1827: quit_throw_to_get_char ()
1828: {
1829: quit_error_check ();
1830: sigfree ();
1831: /* Prevent another signal from doing this before we finish. */
1832: waiting_for_input = 0;
1833: input_pending = 0;
1834: unread_command_char = -1;
1835: _longjmp (getcjmp, 1);
1836: }
1837:
1838: DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 2, 2, 0,
1839: "Set mode of reading keyboard input.\n\
1840: First arg non-nil means use input interrupts; nil means use CBREAK mode.\n\
1841: Second arg non-nil means use ^S/^Q flow control for output to terminal\n\
1842: (no effect except in CBREAK mode).")
1843: (interrupt, flow)
1844: Lisp_Object interrupt, flow;
1845: {
1846: reset_sys_modes ();
1847: #ifdef SIGIO
1848: /* Note SIGIO has been undef'd if FIONREAD is missing. */
1849: interrupt_input = !NULL (interrupt);
1850: #else /* not SIGIO */
1851: interrupt_input = 0;
1852: #endif /* not SIGIO */
1853: flow_control = !NULL (flow);
1854: init_sys_modes ();
1855: return Qnil;
1856: }
1857:
1858: init_keyboard ()
1859: {
1860: RecurseDepth = -1; /* Correct, before outermost invocation of editor loop */
1861: keys_prompt = 0;
1862: immediate_quit = 0;
1863: unread_command_char = -1;
1864: recent_keys_index = 0;
1865: total_keys = 0;
1866: kbd_count = 0;
1867: kbd_ptr = kbd_buffer;
1868: input_pending = 0;
1869: force_input = 0;
1870: if (!noninteractive)
1871: {
1872: signal (SIGINT, interrupt_signal);
1873: #ifdef USG
1874: /* On USG systems, C-g is set up for both SIGINT and SIGQUIT
1875: and we can't tell which one it will give us. */
1876: signal (SIGQUIT, interrupt_signal);
1877: #endif /* USG */
1878: /* Note SIGIO has been undef'd if FIONREAD is missing. */
1879: #ifdef SIGIO
1880: signal (SIGIO, input_available_signal);
1881: #endif SIGIO
1882: }
1883:
1884: /* Use interrupt input by default, if it works and noninterrupt input
1885: has deficiencies. */
1886:
1887: #ifdef INTERRUPT_INPUT
1888: interrupt_input = 1;
1889: #else
1890: interrupt_input = 0;
1891: #endif
1892:
1893: sigfree ();
1894: dribble = 0;
1895:
1896: if (keyboard_init_hook)
1897: (*keyboard_init_hook) ();
1898: }
1899:
1900: syms_of_keyboard ()
1901: {
1902: Qself_insert_command = intern ("self-insert-command");
1903: staticpro (&Qself_insert_command);
1904:
1905: Qforward_char = intern ("forward-char");
1906: staticpro (&Qforward_char);
1907:
1908: Qbackward_char = intern ("backward-char");
1909: staticpro (&Qbackward_char);
1910:
1911: Qtop_level = intern ("top-level");
1912: staticpro (&Qtop_level);
1913:
1914: Qdisabled = intern ("disabled");
1915: staticpro (&Qdisabled);
1916:
1917: defsubr (&Sread_key_sequence);
1918: defsubr (&Srecursive_edit);
1919: defsubr (&Sinput_pending_p);
1920: defsubr (&Scommand_execute);
1921: defsubr (&Srecent_keys);
1922: defsubr (&Sthis_command_keys);
1923: defsubr (&Ssuspend_emacs);
1924: defsubr (&Sabort_recursive_edit);
1925: defsubr (&Sexit_recursive_edit);
1926: defsubr (&Srecursion_depth);
1927: defsubr (&Stop_level);
1928: defsubr (&Sdiscard_input);
1929: defsubr (&Sopen_dribble_file);
1930: defsubr (&Sset_input_mode);
1931: defsubr (&Sexecute_extended_command);
1932:
1933: DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
1934: "Value is called instead of any command that is disabled\n\
1935: \(has a non-nil disabled property).");
1936:
1937: DEFVAR_BOOL ("meta-flag", &MetaFlag,
1938: "*Non-nil means treat 0200 bit in terminal input as Meta bit.");
1939:
1940: DEFVAR_INT ("last-command-char", &last_command_char,
1941: "Last terminal input character that was part of a command, as an integer.");
1942:
1943: DEFVAR_INT ("last-input-char", &last_input_char,
1944: "Last terminal input character, as an integer.");
1945:
1946: DEFVAR_INT ("unread-command-char", &unread_command_char,
1947: "Character to be read as next input from command input stream, or -1 if none.");
1948:
1949: DEFVAR_INT ("meta-prefix-char", &meta_prefix_char,
1950: "Meta-prefix character code. Meta-foo as command input\n\
1951: turns into this character followed by foo.");
1952: meta_prefix_char = 033;
1953:
1954: DEFVAR_LISP ("last-command", &last_command,
1955: "The last command executed. Normally a symbol with a function definition,\n\
1956: but can be whatever was found in the keymap, or whatever the variable\n\
1957: `this-command' was set to by that command.");
1958: last_command = Qnil;
1959:
1960: DEFVAR_LISP ("this-command", &this_command,
1961: "The command now being executed.\n\
1962: The command can set this variable; whatever is put here\n\
1963: will be in last-command during the following command.");
1964: this_command = Qnil;
1965:
1966: DEFVAR_INT ("auto-save-interval", &auto_save_interval,
1967: "*Number of keyboard input characters between auto-saves.\n\
1968: Zero means disable autosaving.");
1969: auto_save_interval = 300;
1970:
1971: DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
1972: "*Nonzero means echo unfinished commands after this many seconds of pause.");
1973: echo_keystrokes = 1;
1974:
1975: DEFVAR_INT ("help-char", &help_char,
1976: "Character to recognize as meaning Help.\n\
1977: When it is read, do (eval help-form), and display result if it's a string.\n\
1978: If help-form's value is nil, this char can be read normally.");
1979: help_char = Ctl ('H');
1980:
1981: DEFVAR_LISP ("help-form", &Vhelp_form,
1982: "Form to execute when character help-char is read.\n\
1983: If the form returns a string, that string is displayed.\n\
1984: If help-form is nil, the help char is not recognized.");
1985: Vhelp_form = Qnil;
1986:
1987: DEFVAR_LISP ("top-level", &Vtop_level,
1988: "Form to evaluate when Emacs starts up.\n\
1989: Useful to set before you dump a modified Emacs.");
1990: Vtop_level = Qnil;
1991:
1992: DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
1993: "String used as translate table for keyboard input, or nil.\n\
1994: Each character is looked up in this string and the contents used instead.\n\
1995: If string is of length N, character codes N and up are untranslated.");
1996: Vkeyboard_translate_table = Qnil;
1997: }
1998:
1999: keys_of_keyboard ()
2000: {
2001: defkey (GlobalMap, Ctl ('Z'), "suspend-emacs");
2002: defkey (CtlXmap, Ctl ('Z'), "suspend-emacs");
2003: defkey (ESCmap, Ctl ('C'), "exit-recursive-edit");
2004: defkey (GlobalMap, Ctl (']'), "abort-recursive-edit");
2005: defkey (ESCmap, 'x', "execute-extended-command");
2006: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.