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