home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / keyboard.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-01-17  |  33.0 KB  |  1,198 lines
  1. /* Keyboard input; editor command loop.
  2.    Copyright (C) 1992-1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Allow config.h to undefine symbols found here.  */
  21. #include <signal.h>
  22.  
  23. #include "config.h"
  24. #include <stdio.h>
  25.  
  26. #include "termchar.h"
  27. #include "termopts.h"
  28. #include "lisp.h"
  29. #include "termhooks.h"
  30. #include "macros.h"
  31. #include "buffer.h"
  32. #include "screen.h"
  33. #include "window.h"
  34. #include "commands.h"
  35. #include "disptab.h"
  36. #include "events.h"
  37. #include <errno.h>
  38.  
  39. extern struct event_stream *event_stream;
  40.  
  41. extern int errno;
  42.  
  43. /* Get FIONREAD, if it is available.  */
  44. #ifdef USG
  45. #include <termio.h>
  46. #include <fcntl.h>
  47. #else /* not USG */
  48. #ifndef VMS
  49. #include <sys/ioctl.h>
  50. #endif /* not VMS */
  51. #endif /* not USG */
  52.  
  53. /* UNIPLUS systems may have FIONREAD.  */
  54. #ifdef UNIPLUS
  55. #include <sys.ioctl.h>
  56. #endif
  57.  
  58. #include "emacssignal.h"
  59.  
  60. #include "backtrace.h"
  61.  
  62. /* Allow m- file to inhibit use of FIONREAD.  */
  63. #ifdef BROKEN_FIONREAD
  64. #undef FIONREAD
  65. #endif
  66.  
  67. extern Lisp_Object Qeval;
  68.  
  69. /* Non-nil disable property on a command means
  70.  do not execute it; call disabled-command-hook's value instead. */
  71. Lisp_Object Qdisabled, Vdisabled_command_hook;
  72.  
  73. /* True while doing kbd input */
  74. int waiting_for_input;
  75.  
  76. /* Nonzero means C-G should cause immediate error-signal. */
  77. int immediate_quit;
  78.  
  79. /* Character to recognize as the help char.  */
  80. int help_char;
  81.  
  82. /* Character to set Vquit_flag. */
  83. int interrupt_char;
  84.  
  85. /* Form to execute when help char is typed.  */
  86. Lisp_Object Vhelp_form;
  87.  
  88. Lisp_Object Vpre_command_hook, Vpost_command_hook;
  89. Lisp_Object Qpre_command_hook, Qpost_command_hook;
  90.  
  91. extern struct Lisp_Keymap *current_global_map;
  92. extern Lisp_Object Vglobal_function_map;
  93. extern int minibuf_level;
  94. extern char *echo_area_glyphs;
  95.  
  96. /* Current depth in recursive edits.  */
  97. int command_loop_level;
  98.  
  99. /* Last keyboard or mouse input event read as a command. */
  100. Lisp_Object Vlast_command_event;
  101.  
  102. /* The nearest ASCII equivalent of the above. */
  103. Lisp_Object Vlast_command_char;
  104.  
  105. /* Last keyboard or mouse event read for any purpose. */
  106. Lisp_Object Vlast_input_event;
  107.  
  108. /* The nearest ASCII equivalent of the above. */
  109. Lisp_Object Vlast_input_char;
  110.  
  111. /* If not Qnil, an event object to be read as the next command input */
  112. Lisp_Object Vunread_command_event;
  113.  
  114. /* Char to use as prefix when a meta character is typed in.
  115.  This is bound on entry to minibuffer in case Esc is changed there.  */
  116.  
  117. /* Previous command, represented by a Lisp object.
  118.    Does not include prefix commands and arg setting commands */
  119. Lisp_Object Vlast_command;
  120.  
  121. /* If a command sets this, the value goes into
  122.    previous-command for the next command. */
  123. Lisp_Object Vthis_command;
  124.  
  125. /* A (16bit . 16bit) representation of the time of the last-command-event.
  126.  */
  127. Lisp_Object Vlast_input_time;
  128.  
  129. Lisp_Object Qself_insert_command;
  130. Lisp_Object Qforward_char;
  131. Lisp_Object Qbackward_char;
  132.  
  133. /* Form to evaluate (if non-nil) when Emacs is started */
  134. Lisp_Object Vtop_level;
  135.  
  136. /* User-supplied string to translate input characters through */
  137. Lisp_Object Vkeyboard_translate_table;
  138.  
  139. /* File in which we write all commands we read */
  140. /* #### there is exactly zero chance that this works right now */
  141. static FILE *dribble;
  142.  
  143. /* #### this should be a property of the tty event_stream */
  144. /* Nonzero if should obey 0200 bit in input chars as "Meta" */
  145. int meta_key;
  146.  
  147. /* Address (if not 0) of word to zero out
  148.  if a SIGIO interrupt happens */
  149. /* #### whatever this is, I'm sure it doesn't work */
  150. static long *input_available_clear_word;
  151.  
  152. /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
  153.    Default is 1 if INTERRUPT_INPUT is defined.  */
  154. int interrupt_input;
  155.  
  156. /* Nonzero while interrupts are temporarily deferred during redisplay.  */
  157. int interrupts_deferred;
  158.  
  159. /* nonzero means use ^S/^Q for flow control.  */
  160. /* #### should be a property of tty event_stream */
  161. int flow_control;
  162.  
  163. #ifndef BSD4_1
  164. #define sigfree() sigsetmask (SIGEMPTYMASK)
  165. #define sigholdx(sig) sigsetmask (sigmask (sig))
  166. #define sigblockx(sig) sigblock (sigmask (sig))
  167. #define sigunblockx(sig) sigblock (SIGEMPTYMASK)
  168. #define sigpausex(sig) sigpause (0)
  169. #endif /* not BSD4_1 */
  170.  
  171. #ifdef BSD4_1
  172. #define SIGIO SIGTINT
  173. /* sigfree and sigholdx are in sysdep.c */
  174. #define sigblockx(sig) sighold (sig)
  175. #define sigunblockx(sig) sigrelse (sig)
  176. #define sigpausex(sig) sigpause (sig)
  177. #endif /* BSD4_1 */
  178.  
  179. /* We are unable to use interrupts if FIONREAD is not available,
  180.    so flush SIGIO so we won't try. */
  181. #ifndef FIONREAD
  182. #ifdef SIGIO
  183. #undef SIGIO
  184. #endif
  185. #endif
  186.  
  187. /* Function for init_keyboard to call with no args (if nonzero).  */
  188. void (*keyboard_init_hook) ();
  189.  
  190. #define    min(a,b)    ((a)<(b)?(a):(b))
  191. #define    max(a,b)    ((a)>(b)?(a):(b))
  192.  
  193. extern void init_sys_modes (void);
  194.  
  195.  
  196. static Lisp_Object command_loop (void);
  197.  
  198. static Lisp_Object unwind_init_sys_modes (Lisp_Object ignore)
  199. {
  200.   init_sys_modes();
  201.   return Qnil;
  202. }
  203.  
  204. static Lisp_Object
  205. recursive_edit_1 ()
  206. {
  207.   int count = specpdl_depth;
  208.   Lisp_Object val;
  209.  
  210.   if (command_loop_level > 0)
  211.     {
  212.       specbind (Qstandard_output, Qt);
  213.       specbind (Qstandard_input, Qt);
  214.     }
  215.  
  216.   val = command_loop ();
  217.   if (EQ (val, Qt))
  218.     Fsignal (Qquit, Qnil);
  219.  
  220.   return unbind_to (count, Qnil);
  221. }
  222.  
  223. static Lisp_Object recursive_edit_unwind (Lisp_Object);
  224.  
  225. DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
  226.   "Invoke the editor command loop recursively.\n\
  227. To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
  228. that tells this function to return.\n\
  229. Alternately, `(throw 'exit t)' makes this function signal an error.\n\
  230. This function is called by the editor initialization to begin editing.")
  231.   ()
  232. {
  233.   int count = specpdl_depth;
  234.   command_loop_level++;
  235.   redraw_mode_line++;
  236.  
  237.   record_unwind_protect (recursive_edit_unwind,
  238.              (command_loop_level
  239.               && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
  240.              ? Fcurrent_buffer ()
  241.              : Qnil);
  242.   recursive_edit_1 ();
  243.   return unbind_to (count, Qnil);
  244. }
  245.  
  246. static Lisp_Object
  247. recursive_edit_unwind (buffer)
  248.      Lisp_Object buffer;
  249. {
  250.   if (!NILP (buffer))
  251.     Fset_buffer (buffer);
  252.  
  253.   command_loop_level--;
  254.   redraw_mode_line++;
  255.  
  256.   return Qnil;
  257. }
  258.  
  259. static Lisp_Object
  260. cmd_error (Lisp_Object data, Lisp_Object dummy)
  261. {
  262.   Lisp_Object errmsg, tail, errname, file_error;
  263.   struct gcpro gcpro1;
  264.   int i;
  265.  
  266.   Vquit_flag = Qnil;
  267.   Vinhibit_quit = Qt;
  268.   Vstandard_output = Qt;
  269.   Vstandard_input = Qt;
  270.   Vexecuting_macro = Qnil;
  271.   echo_area_glyphs = 0;
  272.   cancel_echoing ();
  273.  
  274.   Fzmacs_deactivate_region ();
  275.  
  276.   Fdiscard_input ();
  277.   bitch_at_user (intern ("command-error"));  /* Lucid sound change */
  278.  
  279.   errname = Fcar (data);
  280.  
  281.   if (EQ (errname, Qerror))
  282.     {
  283.       data = Fcdr (data);
  284.       if (!CONSP (data)) data = Qnil;
  285.       errmsg = Fcar (data);
  286.       file_error = Qnil;
  287.     }
  288.   else
  289.     {
  290.       errmsg = Fget (errname, Qerror_message);
  291.       file_error = Fmemq (Qfile_error,
  292.               Fget (errname, Qerror_conditions));
  293.     }
  294.  
  295.   /* Print an error message including the data items.
  296.      This is done by printing it into a scratch buffer
  297.      and then making a copy of the text in the buffer. */
  298.  
  299.   if (!CONSP (data)) data = Qnil;
  300.   tail = Fcdr (data);
  301.   GCPRO1 (tail);
  302.  
  303.   /* For file-error, make error message by concatenating
  304.      all the data items.  They are all strings.  */
  305.   if (!NILP (file_error) && !NILP (tail))
  306.     errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
  307.  
  308.   if (STRINGP (errmsg))
  309.     Fprinc (errmsg, Qt);
  310.   else
  311.     write_string_1 ("peculiar error", -1, Qt);
  312.  
  313.   for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
  314.     {
  315.       write_string_1 (i ? ", " : ": ", 2, Qt);
  316.       if (!NILP (file_error))
  317.     Fprinc (Fcar (tail), Qt);
  318.       else
  319.     Fprin1 (Fcar (tail), Qt);
  320.     }
  321.   UNGCPRO;
  322.  
  323.   /* In -batch mode, force out the error message and newlines after it
  324.      and then die.  */
  325.   if (noninteractive)
  326.     {
  327.       message ("");
  328.       Fkill_emacs (make_number (-1));
  329.     }
  330.  
  331.   Vquit_flag = Qnil;
  332.  
  333.   Vinhibit_quit = Qnil;
  334.   return make_number (0);
  335. }
  336.  
  337. Lisp_Object command_loop_1 ();
  338. Lisp_Object command_loop_2 ();
  339. static Lisp_Object top_level_1 ();
  340.  
  341. /* Entry to editor-command-loop.
  342.    This level has the catches for exiting/returning to editor command loop.
  343.    It returns nil to exit recursive edit, t to abort it.  */
  344.  
  345. static Lisp_Object
  346. command_loop ()
  347. {
  348.   if (command_loop_level > 0 || minibuf_level > 0)
  349.     {
  350.       return internal_catch (Qexit, command_loop_2, Qnil);
  351.     }
  352.   else
  353.     while (1)
  354.       {
  355.     internal_catch (Qtop_level, top_level_1, Qnil);
  356.     internal_catch (Qtop_level, command_loop_2, Qnil);
  357.  
  358.     /* End of file in -batch run causes exit here.  */
  359.     if (noninteractive)
  360.       Fkill_emacs (Qt);
  361.       }
  362. }
  363.  
  364. /* Here we catch errors in execution of commands within the
  365.    editing loop, and reenter the editing loop.
  366.    When there is an error, cmd_error runs and returns a non-nil
  367.    value to us.  A value of nil means that cmd_loop_1 itself
  368.    returned due to end of file (or end of kbd macro).  */
  369.  
  370. Lisp_Object
  371. command_loop_2 (dummy)
  372.      Lisp_Object dummy;
  373. {
  374.   register Lisp_Object val;
  375.  
  376.   do
  377.     val = condition_case_1 (Qerror,
  378.                             command_loop_1, Qnil,
  379.                             cmd_error, Qnil);
  380.   while (!NILP (val));
  381.  
  382.   return Qnil;
  383. }
  384.  
  385. static Lisp_Object
  386. top_level_2 ()
  387. {
  388.   return Feval (Vtop_level);
  389. }
  390.  
  391. static Lisp_Object
  392. top_level_1 (dummy)
  393.      Lisp_Object dummy;
  394. {
  395.   /* On entry to the outer level, run the startup file */
  396.   if (!NILP (Vtop_level))
  397.     condition_case_1 (Qerror, top_level_2, Qnil, cmd_error, Qnil);
  398. #if 1
  399.   else
  400.     {
  401.       fprintf (stderr, "\ntemacs can only be run in -batch mode.\n");
  402.       noninteractive = 1; /* prevent things under kill-emacs from blowing up */
  403.       Fkill_emacs (make_number (-1));
  404.     }
  405. #else
  406.   else if (!NILP (Vpurify_flag))
  407.     message ("Bare impure Emacs (standard Lisp code not loaded)");
  408.   else
  409.     message ("Bare Emacs (standard Lisp code not loaded)");
  410. #endif
  411.  
  412.   return Qnil;
  413. }
  414.  
  415. DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
  416.   "Exit all recursive editing levels.")
  417.   ()
  418. {
  419.   Fthrow (Qtop_level, Qnil);
  420.   /* getting tired of compilation warnings */
  421.   return Qnil;
  422. }
  423.  
  424. DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
  425.   "Exit from the innermost recursive edit or minibuffer.")
  426.   ()
  427. {
  428.   if (command_loop_level > 0 || minibuf_level > 0)
  429.     Fthrow (Qexit, Qnil);
  430.  
  431.   error ("No recursive edit is in progress");
  432.   /* getting tired of compilation warnings */
  433.   return Qnil;
  434. }
  435.  
  436. DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
  437.   "Abort the command that requested this recursive edit or minibuffer input.")
  438.   ()
  439. {
  440.   if (command_loop_level > 0 || minibuf_level > 0)
  441.     Fthrow (Qexit, Qt);
  442.  
  443.   error ("No recursive edit is in progress");
  444.   /* getting tired of compilation warnings */
  445.   return Qnil;
  446. }
  447.  
  448. /* This is the actual command reading loop,
  449.  sans error-handling encapsulation */
  450.  
  451. Lisp_Object Fcommand_execute ();
  452.  
  453. extern Lisp_Object Fallocate_event (), Fdeallocate_event ();
  454.  
  455. Lisp_Object
  456. command_loop_1 (dummy)
  457.      Lisp_Object dummy;
  458. {
  459.   Lisp_Object event = Fallocate_event ();
  460.   struct gcpro gcpro1;
  461.   GCPRO1 (event);
  462.  
  463.   Vprefix_arg = Qnil;
  464.   waiting_for_input = 0;
  465.   cancel_echoing ();
  466.   /* This magically makes single character keyboard macros work just
  467.      like the real thing.  This is slightly bogus, but it's in here for
  468.      compatibility with Emacs 18.  It's not even clear what the "right
  469.      thing" is. */
  470.   if (!(!NILP(Vexecuting_macro) &&
  471.     ((STRINGP (Vexecuting_macro) &&
  472.       XSTRING (Vexecuting_macro)->size == 1) ||
  473.      (VECTORP (Vexecuting_macro) &&
  474.       XVECTOR (Vexecuting_macro)->size == 1))))
  475.     Vlast_command = Qt;
  476.  
  477.   while (1)
  478.     {
  479.       /* Make sure current window's buffer is selected.  */
  480.  
  481.       if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
  482.     internal_set_buffer (XBUFFER (XWINDOW (selected_window)->buffer));
  483.  
  484.       /* If ^G was typed before we got here (that is, before emacs was
  485.      idle and waiting for input) then we treat that as an interrupt. */
  486.       QUIT;
  487.  
  488.       /* If minibuffer on and echo area in use, wait 2 sec and redraw
  489.      minibuffer.  Treat a ^G here as a command, not an interrupt.
  490.        */
  491.       if (minibuf_level && echo_area_glyphs)
  492.     {
  493.       Fsit_for (make_number (2), Qnil);
  494.       echo_area_glyphs = 0;
  495.     }
  496.  
  497.       /* Shortcut not applicable or found a prefix key.
  498.      Take full precautions and read key sequence the hard way.  */
  499. #ifdef C_ALLOCA
  500.       alloca (0);        /* Cause a garbage collection now */
  501.                 /* Since we can free the most stuff here.  */
  502. #endif /* C_ALLOCA */
  503.  
  504.       Fnext_event (event);
  505.       /* If ^G was typed while emacs was reading input from the user, then
  506.      it is treated as just another key.  This is strange, but it is
  507.      what emacs 18 did. */
  508.       Vquit_flag = Qnil;
  509.       Fdispatch_event (event);
  510.     }
  511.   UNGCPRO;
  512.   /* getting tired of compilation warnings */
  513.   return Qnil;
  514. }
  515.  
  516. /* Number of seconds between polling for input.  */
  517. int polling_period;
  518.  
  519. #ifdef POLL_FOR_INPUT
  520. int polling_for_input;
  521.  
  522. /* Nonzero means polling for input is temporarily suppresed.  */
  523. int poll_suppress_count;
  524.  
  525. /* Handle an alarm once each second and read pending input
  526.    so as to handle a C-g if it comces in.  */
  527.  
  528. input_poll_signal ()
  529. {
  530.   int junk;
  531.  
  532. #ifdef HAVE_X_WINDOWS
  533.   extern int x_input_blocked;
  534.   if (x_input_blocked == 0)
  535. #endif
  536.     if (!waiting_for_input)
  537.       read_avail_input (&junk);
  538.   signal (SIGALRM, input_poll_signal);
  539.   alarm (polling_period);
  540. }
  541.  
  542. #endif
  543.  
  544. /* Begin signals to poll for input, if they are appropriate.
  545.    This function is called unconditionally from various places.  */
  546.  
  547. void
  548. start_polling ()
  549. {
  550. #ifdef POLL_FOR_INPUT
  551.   if (read_socket_hook)
  552.     {
  553.       poll_suppress_count--;
  554.       if (poll_suppress_count == 0)
  555.     {
  556.       signal (SIGALRM, input_poll_signal);
  557.       polling_for_input = 1;
  558.       alarm (polling_period);
  559.     }
  560.     }
  561. #endif
  562. }
  563.  
  564. /* Turn off polling.  */
  565.  
  566. void
  567. stop_polling ()
  568. {
  569. #ifdef POLL_FOR_INPUT
  570.   if (read_socket_hook)
  571.     {
  572.       if (poll_suppress_count == 0)
  573.     {
  574.       polling_for_input = 0;
  575.       alarm (0);
  576.     }
  577.       poll_suppress_count++;
  578.     }
  579. #endif
  580. }
  581.  
  582.  
  583. extern int screen_garbaged;
  584.  
  585. #ifdef HAVE_X_WINDOWS
  586. /* no point in including X headers, we just want to know if it's non-zero. */
  587. extern struct _XDisplay* x_current_display;
  588. #endif
  589.  
  590. /* Interface to read_avail_input, blocking SIGIO if necessary.  */
  591.  
  592.  
  593. #ifdef SIGIO   /* for entire page */
  594.  
  595. /* Note SIGIO has been undef'd if FIONREAD is missing.  */
  596.  
  597. static void
  598. input_available_signal (signo)
  599.      int signo;
  600. {
  601.   /* Must preserve main program's value of errno.  */
  602.   int old_errno = errno;
  603. #ifdef BSD4_1
  604.   extern int select_alarmed;
  605. #endif
  606.  
  607. #ifdef USG
  608.   /* USG systems forget handlers when they are used;
  609.      must reestablish each time */
  610.   signal (signo, input_available_signal);
  611. #endif /* USG */
  612.  
  613. #ifdef BSD4_1
  614.   sigisheld (SIGIO);
  615. #endif
  616.  
  617.   if (event_stream && event_stream->sigio_cb) event_stream->sigio_cb ();
  618. #ifdef BSD4_1
  619.   select_alarmed = 1;  /* Force the select emulator back to life */
  620.   sigfree ();
  621. #endif
  622.   errno = old_errno;
  623. }
  624. #endif /* SIGIO */
  625.  
  626. DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
  627.  "Execute CMD as an editor command.\n\
  628. CMD must be a symbol that satisfies the `commandp' predicate.\n\
  629. Optional second arg RECORD-FLAG non-nil\n\
  630. means unconditionally put this command in `command-history'.\n\
  631. Otherwise, that is done only if an arg is read using the minibuffer.")
  632.      (cmd, record)
  633.      Lisp_Object cmd, record;
  634. {
  635.   register Lisp_Object final;
  636.   register Lisp_Object tem;
  637.   Lisp_Object prefixarg;
  638.   struct backtrace backtrace;
  639.   extern int debug_on_next_call;
  640.  
  641.   prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
  642.   Vcurrent_prefix_arg = prefixarg;
  643.   debug_on_next_call = 0;
  644.  
  645.   if (SYMBOLP (cmd))
  646.     {
  647.       tem = Fget (cmd, Qdisabled);
  648.       if (!NILP (tem))
  649.     return call1 (Vrun_hooks, Vdisabled_command_hook);
  650.     }
  651.  
  652.   while (1)
  653.     {
  654.       final = cmd;
  655.       while (SYMBOLP (final))
  656.     {
  657.       if (EQ (Qunbound, XSYMBOL (final)->function))
  658.         Fsymbol_function (final);    /* Get an error! */
  659.       final = XSYMBOL (final)->function;
  660.     }
  661.  
  662.       if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
  663.     do_autoload (final, cmd);
  664.       else
  665.     break;
  666.     }
  667.  
  668.   if (CONSP (final) || SUBRP (final)
  669.       || COMPILEDP (final))
  670.     {
  671. #ifdef EMACS_BTL
  672.       backtrace.id_number = 0;
  673. #endif
  674.       backtrace.next = backtrace_list;
  675.       backtrace_list = &backtrace;
  676.       backtrace.function = &Qcall_interactively;
  677.       backtrace.args = &cmd;
  678.       backtrace.nargs = 1;
  679.       backtrace.evalargs = 0;
  680.  
  681.       tem = Fcall_interactively (cmd, record);
  682.  
  683.       backtrace_list = backtrace.next;
  684.       return tem;
  685.     }
  686.   if (STRINGP (final) || VECTORP (final))
  687.     {
  688.       return Fexecute_kbd_macro (final, prefixarg);
  689.     }
  690.   Fsignal (Qwrong_type_argument, Fcons (Qcommandp,
  691.                     EQ (cmd, final)
  692.                     ? Fcons (cmd, Qnil)
  693.                     : Fcons (cmd, Fcons (final, Qnil))));
  694.   return Qnil;
  695. }
  696.  
  697. extern Lisp_Object recent_keys_ring;
  698. extern int recent_keys_ring_index;
  699.  
  700. DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
  701.   "Return vector of last 100 keyboard or mouse button events read.\n\
  702. This copies 100 event objects and a vector; it is safe to keep and modify\n\
  703. them.")
  704.   ()
  705. {
  706.   struct gcpro gcpro1;
  707.   Lisp_Object val = Fmake_vector (100, Qnil);
  708.   Lisp_Object *vec = XVECTOR (val)->contents;
  709.   Lisp_Object *vec2 = XVECTOR (recent_keys_ring)->contents;
  710.   int i = 0, j = recent_keys_ring_index;
  711.   GCPRO1 (val);
  712.   while (i < 100) {
  713.     vec [i] = vec2 [j];
  714.     if (NILP (vec [i]))
  715.       vec [i] = Fallocate_event ();
  716.     else
  717.       vec [i] = Fcopy_event (vec [i], Qnil);
  718.     if (++j >= 100) j = 0;
  719.     i++;
  720.   }
  721.   UNGCPRO;
  722.   return val;
  723. }
  724.  
  725. extern Lisp_Object Vthis_command_keys;
  726. extern int this_command_keys_count;
  727.  
  728. DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
  729.   "Returns a vector of the keyboard or mouse button events that were used\n\
  730. to invoke this command.  This copies the vector and the events; it is safe\n\
  731. to keep and modify them.")
  732.    ()
  733. {
  734.   Lisp_Object val = Fmake_vector (this_command_keys_count, Qnil);
  735.   Lisp_Object *vec = XVECTOR (val)->contents;
  736.   Lisp_Object *vec2 = XVECTOR (Vthis_command_keys)->contents;
  737.   int i;
  738.   for (i=0; i < this_command_keys_count; i++)
  739.     vec [i] = Fcopy_event (vec2 [i], Qnil);
  740.   return val;
  741. }
  742.  
  743. DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
  744.   "Return the current depth in recursive edits.")
  745.   ()
  746. {
  747.   Lisp_Object temp;
  748.   XFASTINT (temp) = command_loop_level + minibuf_level;
  749.   return temp;
  750. }
  751.  
  752. DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
  753.   "FOpen dribble file: ",
  754.   "Start writing all keyboard characters to FILE.")
  755.   (file)
  756.      Lisp_Object file;
  757. {
  758.   if (dribble != 0)
  759.     fclose (dribble);
  760.   dribble = 0;
  761.   if (!NILP (file))
  762.     {
  763.       file = Fexpand_file_name (file, Qnil);
  764.       dribble = fopen ((char *)XSTRING (file)->data, "w");
  765.     }
  766.   return Qnil;
  767. }
  768.  
  769. extern void reset_sys_modes (void);
  770. extern void sys_suspend (void);
  771.  
  772. DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
  773.   "Stop Emacs and return to superior process.  You can resume later.\n\
  774. If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
  775. to be read as terminal input by Emacs's superior shell.\n\
  776. Before suspending, if `suspend-hook' is bound and value is non-nil\n\
  777. call the value as a function of no args.  Don't suspend if it returns non-nil.\n\
  778. Otherwise, suspend normally and after resumption call\n\
  779. `suspend-resume-hook' if that is bound and non-nil.")
  780.   (stuffstring)
  781.      Lisp_Object stuffstring;
  782. {
  783.   register Lisp_Object tem;
  784.   int count = specpdl_depth;
  785.   struct gcpro gcpro1;
  786.  
  787.   if (!NILP (stuffstring))
  788.     CHECK_STRING (stuffstring, 0);
  789.   GCPRO1 (stuffstring);
  790.  
  791.   /* Call value of suspend-hook
  792.      if it is bound and value is non-nil.  */
  793.   if (!NILP (Vrun_hooks))
  794.     {
  795.       tem = call1 (Vrun_hooks, intern ("suspend-hook"));
  796.       if (!EQ (tem, Qnil)) return Qnil;
  797.     }
  798.  
  799.   reset_sys_modes ();
  800.   /* sys_suspend can get an error if it tries to fork a subshell
  801.      and the system resources aren't available for that.  */
  802.   record_unwind_protect (unwind_init_sys_modes, Qnil);
  803.   stuff_buffered_input (stuffstring);
  804.   sys_suspend ();
  805.   unbind_to (count, Qnil);
  806.  
  807.   /* Call value of suspend-resume-hook
  808.      if it is bound and value is non-nil.  */
  809.   if (!NILP (Vrun_hooks))
  810.     call1 (Vrun_hooks, intern ("suspend-resume-hook"));
  811.   UNGCPRO;
  812.   return Qnil;
  813. }
  814.  
  815. /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
  816.    Then in any case stuff anthing Emacs has read ahead and not used.  */
  817.  
  818. extern void stuff_char (char);
  819.  
  820. void
  821. stuff_buffered_input (stuffstring)
  822.      Lisp_Object stuffstring;
  823. {
  824.   register unsigned char *p;
  825.  
  826. /* stuff_char works only in BSD, versions 4.2 and up.  */
  827. #ifdef BSD
  828. #ifndef BSD4_1
  829.   if (STRINGP (stuffstring))
  830.     {
  831.       register int count;
  832.  
  833.       p = XSTRING (stuffstring)->data;
  834.       count = XSTRING (stuffstring)->size;
  835.       while (count-- > 0)
  836.     stuff_char (*p++);
  837.       stuff_char ('\n');
  838.     }
  839.   /* Anything we have read ahead, put back for the shell to read.  */
  840. # if 0 /* oh, who cares about this silliness */
  841.   while (kbd_fetch_ptr != kbd_store_ptr)
  842.     {
  843.       if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
  844.     kbd_fetch_ptr = kbd_buffer;
  845.       stuff_char (*kbd_fetch_ptr++);
  846.     }
  847. # endif
  848. #endif
  849. #endif /* BSD and not BSD4_1 */
  850. }
  851.  
  852. #if 0 /* Unused in Lucid Emacs */
  853. set_waiting_for_input (word_to_clear)
  854.      long *word_to_clear;
  855. {
  856.   input_available_clear_word = word_to_clear;
  857.  
  858.   /* Tell interrupt_signal to throw back to read_char,  */
  859.   waiting_for_input = 1;
  860.  
  861.   /* If interrupt_signal was called before and buffered a C-g,
  862.      make it run again now, to avoid timing error. */
  863.   detect_input_pending ();
  864.   QUIT;
  865.  
  866. }
  867.  
  868. clear_waiting_for_input ()
  869. {
  870.   /* Tell interrupt_signal not to throw back to read_char,  */
  871.   waiting_for_input = 0;
  872.   input_available_clear_word = 0;
  873. }
  874. #endif /* Unused */
  875.  
  876. /* This routine is called at interrupt level in response to C-G.
  877.  If interrupt_input, this is the handler for SIGINT.
  878.  Otherwise, it is called from Fnext_event in handling SIGIO or SIGTINT.
  879.  
  880.  Otherwise it sets the Lisp variable  quit-flag  not-nil.
  881.  This causes  eval  to throw, when it gets a chance.
  882.  If  quit-flag  is already non-nil, it stops the job right away.  */
  883.  
  884. SIGTYPE
  885. interrupt_signal (dummy)
  886.      int dummy;
  887. {
  888.   char c;
  889.   /* Must preserve main program's value of errno.  */
  890.   int old_errno = errno;
  891.  
  892. #ifdef USG
  893.   /* USG systems forget handlers when they are used;
  894.      must reestablish each time */
  895.   signal (SIGINT, interrupt_signal);
  896.   signal (SIGQUIT, interrupt_signal);
  897. #endif /* USG */
  898.  
  899. /*  cancel_echoing (); */
  900.  
  901.   if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen))
  902.     {
  903.       fflush (stdout);
  904.       reset_sys_modes ();
  905.       sigfree ();
  906. #ifdef SIGTSTP            /* Support possible in later USG versions */
  907. /*
  908.  * On systems which can suspend the current process and return to the original
  909.  * shell, this command causes the user to end up back at the shell.
  910.  * The "Auto-save" and "Abort" questions are not asked until
  911.  * the user elects to return to emacs, at which point he can save the current
  912.  * job and either dump core or continue.
  913.  */
  914.       sys_suspend ();
  915. #else
  916. #ifdef VMS
  917.       if (sys_suspend () == -1)
  918.     {
  919.       printf ("Not running as a subprocess;\n");
  920.       printf ("you can continue or abort.\n");
  921.     }
  922. #else /* not VMS */
  923.       /* Perhaps should really fork an inferior shell?
  924.      But that would not provide any way to get back
  925.      to the original shell, ever.  */
  926.       printf ("No support for stopping a process on this operating system;\n");
  927.       printf ("you can continue or abort.\n");
  928. #endif /* not VMS */
  929. #endif /* not SIGTSTP */
  930.       printf ("Auto-save? (y or n) ");
  931.       fflush (stdout);
  932.       if (((c = getchar ()) & ~040) == 'Y')
  933.     Fdo_auto_save (Qnil);
  934.       while (c != '\n') c = getchar ();
  935. #ifdef VMS
  936.       printf ("Abort (and enter debugger)? (y or n) ");
  937. #else /* not VMS */
  938.       printf ("Abort (and dump core)? (y or n) ");
  939. #endif /* not VMS */
  940.       fflush (stdout);
  941.       if (((c = getchar ()) & ~040) == 'Y')
  942.     abort ();
  943.       while (c != '\n') c = getchar ();
  944.       printf ("Continuing...\n");
  945.       fflush (stdout);
  946.       init_sys_modes ();
  947.     }
  948.   else
  949.     {
  950.       /* If executing a function that wants to be interrupted out of
  951.          and the user has not deferred quitting by binding `inhibit-quit'
  952.          then quit right away.  */
  953.       if (immediate_quit && NILP (Vinhibit_quit))
  954.     {
  955.       immediate_quit = 0;
  956.           sigfree ();
  957.       Fsignal (Qquit, Qnil);
  958.     }
  959.       else
  960.     /* Else request quit when it's safe */
  961.     Vquit_flag = Qt;
  962.     }
  963.   errno = old_errno;
  964. }
  965.  
  966.  
  967. DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 3, 0,
  968.   "Set mode of reading keyboard input.\n\
  969. First arg non-nil means use input interrupts; nil means use CBREAK mode.\n\
  970. Second arg non-nil means use ^S/^Q flow control for output to terminal\n\
  971.  (no effect except in CBREAK mode).\n\
  972. Third arg non-nil means accept 8-bit input (for a Meta key).\n\
  973.  Otherwise, the top bit is ignored, on the assumption it is parity.")
  974.   (interrupt, flow, meta)
  975.      Lisp_Object interrupt, flow, meta;
  976. {
  977.   reset_sys_modes ();
  978. #ifdef SIGIO
  979. /* Note SIGIO has been undef'd if FIONREAD is missing.  */
  980. #ifdef NO_SOCK_SIGIO
  981.   if (read_socket_hook)
  982.     interrupt_input = 0;    /* No interrupts if reading from a socket.  */
  983.   else
  984. #endif /* NO_SOCK_SIGIO */
  985.     interrupt_input = !NILP (interrupt);
  986. #else /* not SIGIO */
  987.   interrupt_input = 0;
  988. #endif /* not SIGIO */
  989.   flow_control = !NILP (flow);
  990.   meta_key = !NILP (meta);
  991.   init_sys_modes ();
  992.   return Qnil;
  993. }
  994.  
  995. /* This may actually need to do something goofy once ttys work again */
  996. DEFUN ("set-interrupt-character", Fset_interrupt_character,
  997.        Sset_interrupt_character, 1, 1, 0,
  998.   "Change the interrupt character.  Arg is an ASCII code or nil.\n\
  999. Among other system-dependent things, this changes the value of the\n\
  1000. variable `interrupt-char'.")
  1001.   (new_interrupt_char)
  1002.     Lisp_Object new_interrupt_char;
  1003. {
  1004.   int c;
  1005.   if (NILP (new_interrupt_char))
  1006.     c = -1;
  1007.   else
  1008.     {
  1009.       CHECK_FIXNUM (new_interrupt_char, 0);
  1010.       c = XINT (new_interrupt_char);
  1011.       if (c < -1 || c > 127)
  1012.     error ("interrupt character must be an ASCII code, or nil or -1");
  1013.     }
  1014.  
  1015.   interrupt_char = c;
  1016.   return make_number (interrupt_char);
  1017. }
  1018.  
  1019.  
  1020. void
  1021. init_keyboard ()
  1022. {
  1023.   /* This is correct before outermost invocation of the editor loop */
  1024.   command_loop_level = -1;
  1025.   immediate_quit = 0;
  1026.  
  1027.   if (!noninteractive)
  1028.     {
  1029.       signal (SIGINT, interrupt_signal);
  1030. #ifdef HAVE_TERMIO
  1031.       /* On  systems with TERMIO, C-g is set up for both SIGINT and SIGQUIT
  1032.      and we can't tell which one it will give us.  */
  1033.       signal (SIGQUIT, interrupt_signal);
  1034. #endif /* HAVE_TERMIO */
  1035. /* Note SIGIO has been undef'd if FIONREAD is missing.  */
  1036. #ifdef SIGIO
  1037.       signal (SIGIO, input_available_signal);
  1038. #endif /* SIGIO */
  1039.     }
  1040.  
  1041. /* Use interrupt input by default, if it works and noninterrupt input
  1042.    has deficiencies.  */
  1043.  
  1044. #ifdef INTERRUPT_INPUT
  1045.   interrupt_input = 1;
  1046. #else
  1047.   interrupt_input = 0;
  1048. #endif
  1049.  
  1050.   sigfree ();
  1051.   dribble = 0;
  1052.  
  1053.   if (keyboard_init_hook)
  1054.     (*keyboard_init_hook) ();
  1055. }
  1056.  
  1057. void
  1058. syms_of_keyboard ()
  1059. {
  1060.   Qself_insert_command = intern ("self-insert-command");
  1061.   staticpro (&Qself_insert_command);
  1062.  
  1063.   Qforward_char = intern ("forward-char");
  1064.   staticpro (&Qforward_char);
  1065.  
  1066.   Qbackward_char = intern ("backward-char");
  1067.   staticpro (&Qbackward_char);
  1068.  
  1069.   Qtop_level = intern ("top-level");
  1070.   staticpro (&Qtop_level);
  1071.  
  1072.   Qdisabled = intern ("disabled");
  1073.   staticpro (&Qdisabled);
  1074.  
  1075.   defsubr (&Srecursive_edit);
  1076.   defsubr (&Scommand_execute);
  1077.   defsubr (&Srecent_keys);
  1078.   defsubr (&Sthis_command_keys);
  1079.   defsubr (&Ssuspend_emacs);
  1080.   defsubr (&Sabort_recursive_edit);
  1081.   defsubr (&Sexit_recursive_edit);
  1082.   defsubr (&Srecursion_depth);
  1083.   defsubr (&Stop_level);
  1084.   defsubr (&Sopen_dribble_file);
  1085.   defsubr (&Sset_input_mode);
  1086.   defsubr (&Sset_interrupt_character);
  1087.  
  1088.   DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
  1089.     "Value is called instead of any command that is disabled,\n\
  1090. i.e. has a non-nil `disabled' property.");
  1091.  
  1092.   DEFVAR_LISP ("last-command-event", &Vlast_command_event,
  1093.     "Last keyboard or mouse button event that was part of a command.  This\n\
  1094. variable is off limits: you may not set its value or modify the event that\n\
  1095. is its value, as it is destructively modified by `read-key-sequence'.  If\n\
  1096. you want to keep a pointer to this value, you must use `copy-event'.");
  1097.   Vlast_command_event = Qnil;
  1098.  
  1099.   DEFVAR_LISP ("last-command-char", &Vlast_command_char,
  1100.     "If the value of `last-command-event' is a keyboard event, then\n\
  1101. this is the nearest ASCII equivalent to it.  This the the value that\n\
  1102. `self-insert-command' will put in the buffer.  Remember that there is\n\
  1103. NOT a 1:1 mapping between keyboard events and ASCII characters: the set\n\
  1104. of keyboard events is much larger, so writing code that examines this\n\
  1105. variable to determine what key has been typed is bad practice, unless\n\
  1106. you are certain that it will be one of a small set of characters.");
  1107.   Vlast_command_char = Qnil;
  1108.  
  1109.   DEFVAR_LISP ("last-input-event", &Vlast_input_event,
  1110.     "Last keyboard or mouse button event recieved.  This variable is off\n\
  1111. limits: you may not set its value or modify the event that is its value, as\n\
  1112. it is destructively modified by `next-event'.  If you want to keep a pointer\n\
  1113. to this value, you must use `copy-event'.");
  1114.   Vlast_input_event = Qnil;
  1115.  
  1116.   DEFVAR_LISP ("last-input-char", &Vlast_input_char,
  1117.     "If the value of `last-input-event' is a keyboard event, then\n\
  1118. this is the nearest ASCII equivalent to it.  Remember that there is\n\
  1119. NOT a 1:1 mapping between keyboard events and ASCII characters: the set\n\
  1120. of keyboard events is much larger, so writing code that examines this\n\
  1121. variable to determine what key has been typed is bad practice, unless\n\
  1122. you are certain that it will be one of a small set of characters.");
  1123.   Vlast_input_char = Qnil;
  1124.  
  1125.   DEFVAR_LISP ("last-input-time", &Vlast_input_time,
  1126.     "The time (in seconds since Jan 1, 1970) of the last-command-event,\n\
  1127. represented as a cons of two 16-bit integers.  This is destructively\n\
  1128. modified, so copy it if you want to keep it.");
  1129.   Vlast_input_time = Qnil;
  1130.  
  1131.   DEFVAR_LISP ("unread-command-event", &Vunread_command_event,
  1132.     "Set this to an event object to simulate the reciept of an event from\n\
  1133. the user.  Normally this is nil.");
  1134.   Vunread_command_event = Qnil;
  1135.  
  1136.   DEFVAR_LISP ("last-command", &Vlast_command,
  1137.   "The last command executed.  Normally a symbol with a function definition,\n\
  1138. but can be whatever was found in the keymap, or whatever the variable\n\
  1139. `this-command' was set to by that command.");
  1140.   Vlast_command = Qnil;
  1141.  
  1142.   DEFVAR_LISP ("this-command", &Vthis_command,
  1143.     "The command now being executed.\n\
  1144. The command can set this variable; whatever is put here\n\
  1145. will be in `last-command' during the following command.");
  1146.   Vthis_command = Qnil;
  1147.  
  1148.   DEFVAR_INT ("help-char", &help_char,
  1149.     "Character to recognize as meaning Help.\n\
  1150. When it is read, do `(eval help-form)', and display result if it's a string.\n\
  1151. If the value of `help-form' is nil, this char can be read normally.");
  1152.   help_char = 8; /* C-h */
  1153.  
  1154.   DEFVAR_INT ("interrupt-char", &interrupt_char,
  1155.     "Character which interrupts emacs.\n\
  1156. Do not setq this variable: use the function `set-interrupt-character' instead.\n\
  1157. Depending on the system you are on, this may need to do magic like changing\n\
  1158. interrupt handlers.");
  1159.   interrupt_char = 7; /* C-g */
  1160.  
  1161.   DEFVAR_LISP ("help-form", &Vhelp_form,
  1162.     "Form to execute when character help-char is read.\n\
  1163. If the form returns a string, that string is displayed.\n\
  1164. If `help-form' is nil, the help char is not recognized.");
  1165.   Vhelp_form = Qnil;
  1166.  
  1167.   DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
  1168.      "Function or functions to run before every command.\n\
  1169. This may examine the `this-command' variable to find out what command\n\
  1170. is about to be run, or may change it to cause a different command to run.\n\
  1171. Function on this hook must be careful to avoid signalling errors!");
  1172.   Vpre_command_hook = Qnil;
  1173.   Qpre_command_hook = intern ("pre-command-hook");
  1174.   staticpro (&Qpre_command_hook);
  1175.  
  1176.   DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
  1177.      "Function or functions to run after every command.\n\
  1178. This may examine the `this-command' variable to find out what command\n\
  1179. was just executed.");
  1180.   Vpost_command_hook = Qnil;
  1181.   Qpost_command_hook = intern ("post-command-hook");
  1182.   staticpro (&Qpost_command_hook);
  1183.  
  1184.   DEFVAR_LISP ("top-level", &Vtop_level,
  1185.     "Form to evaluate when Emacs starts up.\n\
  1186. Useful to set before you dump a modified Emacs.");
  1187.   Vtop_level = Qnil;
  1188.  
  1189.   DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
  1190.     "String used as translate table for keyboard input, or nil.\n\
  1191. Each character is looked up in this string and the contents used instead.\n\
  1192. If string is of length N, character codes N and up are untranslated.\n\
  1193. This is the right thing to use only if you are on a dumb tty, as it cannot\n\
  1194. handle input which cannot be represented as ASCII.  If you are running emacs\n\
  1195. under X, you should do the translations with the `xmodmap' program instead.");
  1196.   Vkeyboard_translate_table = Qnil;
  1197. }
  1198.