home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / keyboard.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-15  |  24.8 KB  |  794 lines
  1. /* Keyboard input; editor command loop.
  2.    Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Mule 2.0.  Not synched with FSF. */
  21.  
  22. #include <config.h>
  23. #include "lisp.h"
  24.  
  25. #include "buffer.h"
  26. #include "commands.h"
  27. #include "device.h"
  28. #include "device-tty.h"
  29. #include "events.h"
  30. #include "frame.h"
  31. #include "macros.h"
  32. #include "sysdep.h"
  33. #include "window.h"
  34.  
  35. #include <setjmp.h>
  36. #include <errno.h>
  37. #include "systime.h"
  38.  
  39. Lisp_Object Qsuspend_hook;
  40. Lisp_Object Qsuspend_resume_hook;
  41.  
  42. /* Current depth in recursive edits.  */
  43. int command_loop_level;
  44.  
  45. /* Total number of times command_loop has read a key sequence.  */
  46. int num_input_keys;
  47.  
  48. #ifndef LISP_COMMAND_LOOP
  49. /* Form to evaluate (if non-nil) when Emacs is started */
  50. Lisp_Object Vtop_level;
  51. #else
  52. /* Function to call to evaluate to read and process events */
  53. Lisp_Object Vcommand_loop;
  54. #endif /* LISP_COMMAND_LOOP */
  55.  
  56. /* The error handler */
  57. Lisp_Object Qcommand_error;
  58.  
  59. /* The emergency error handler, before we're ready */
  60. Lisp_Object Qreally_early_error_handler;
  61.  
  62. /* File in which we write all commands we read */
  63. /* #### there is exactly zero chance that this works right now */
  64. static FILE *dribble;
  65.  
  66. static Lisp_Object command_loop_1 (Lisp_Object dummy);
  67.  
  68. /* There are two possible command loops -- one written entirely in
  69.    C and one written mostly in Lisp, except stuff written in C for
  70.    speed.  The advantage of the Lisp command loop is that the user
  71.    can specify their own command loop to use by changing the variable
  72.    `command-loop'.  Its disadvantage is that it's slow. */
  73.  
  74. static Lisp_Object
  75. default_error_handler (Lisp_Object data)
  76. {
  77.   int speccount = specpdl_depth ();
  78.  
  79.   Fding (Qnil, Qnil, Qnil);
  80.   zmacs_deactivate_region ();
  81.   Fdiscard_input ();
  82.   specbind (Qinhibit_quit, Qt);
  83.   Vstandard_output = Qt;
  84.   Vstandard_input = Qt;
  85.   Vexecuting_macro = Qnil;
  86.   clear_echo_area (selected_frame (), Qnil, 0);
  87.   data = Fprin1_to_string (data, Qnil);
  88.   message ("Error: %s", string_data (XSTRING (data)));
  89.   check_quit (); /* make Vquit_flag accurate */
  90.   Vquit_flag = Qnil;
  91.   return (unbind_to (speccount, Qt));
  92. }
  93.  
  94. DEFUN ("really-early-error-handler", Freally_early_error_handler,
  95.        Sreally_early_error_handler, 1, 1, 0,
  96.   "You should almost certainly not be using this.")
  97.   (x)
  98.   Lisp_Object x;
  99. {
  100.   /* This is an error handler used when we're running temacs and when
  101.      we're in the early stages of XEmacs.  No errors ought to be
  102.      occurring in those cases (or they ought to be trapped and
  103.      dealt with elsewhere), but if an error slips through, we need
  104.      to deal with it.  We could write this function in Lisp (and it
  105.      used to be this way, at the beginning of loadup.el), but we do
  106.      it this way in case an error occurs before we get to loading
  107.      loadup.el.  Note that there is also an `early-error-handler',
  108.      used in startup.el to catch more reasonable errors that
  109.      might occur during startup if the sysadmin or whoever fucked
  110.      up.  This function is more conservative in what it does
  111.      and is used only as a last resort, indicating that the
  112.      programmer himself fucked up somewhere. */
  113.   stderr_out ("*** Error in XEmacs initialization");
  114.   Fprint (x, Qexternal_debugging_output);
  115.   stderr_out ("*** Backtrace\n");
  116.   Fbacktrace (Qexternal_debugging_output, Qt);
  117.   stderr_out ("*** Killing XEmacs\n");
  118.   return Fkill_emacs (make_number (-1));
  119. }
  120.  
  121.  
  122. /**********************************************************************/
  123. /*                     Command-loop (in C)                            */
  124. /**********************************************************************/
  125.  
  126. #ifndef LISP_COMMAND_LOOP
  127.  
  128. /* The guts of the command loop are in command_loop_1().  This function
  129.    doesn't catch errors, though -- that's the job of command_loop_2(),
  130.    which is a condition-case wrapper around command_loop_1().
  131.    command_loop_1() never returns, but may get thrown out of.
  132.  
  133.    When an error occurs, cmd_error() is called, which usually
  134.    invokes the Lisp error handler in `command-error'; however,
  135.    a default error handler is provided if `command-error' is nil
  136.    (e.g. during startup).  The purpose of the error handler is
  137.    simply to display the error message and do associated cleanup;
  138.    it does not need to throw anywhere.  When the error handler
  139.    finishes, the condition-case in command_loop_2() will finish and
  140.    command_loop_2() will reinvoke command_loop_1().
  141.  
  142.    command_loop_2() is invoked from three places: from
  143.    initial_command_loop() (called from main() at the end of
  144.    internal initialization), from the Lisp function `recursive-edit',
  145.    and from call_command_loop().
  146.  
  147.    call_command_loop() is called when a macro is started and when the
  148.    minibuffer is entered; normal termination of the macro or
  149.    minibuffer causes a throw out of the recursive command loop. (To
  150.    'execute-kbd-macro for macros and 'exit for minibuffers.  Note also
  151.    that the low-level minibuffer-entering function,
  152.    `read-minibuffer-internal', provides its own error handling and
  153.    does not need command_loop_2()'s error encapsulation; so it tells
  154.    call_command_loop() to invoke command_loop_1() directly.)
  155.  
  156.    Note that both read-minibuffer-internal and recursive-edit set
  157.    up a catch for 'exit; this is why `abort-recursive-edit', which
  158.    throws to this catch, exits out of either one.
  159.  
  160.    initial_command_loop(), called from main(), sets up a catch
  161.    for 'top-level when invoking command_loop_2(), allowing functions
  162.    to throw all the way to the top level if they really need to.
  163.    Before invoking command_loop_2(), initial_command_loop() calls
  164.    top_level_1(), which handles all of the startup stuff (creating
  165.    the initial frame, handling the command-line options, loading
  166.    the user's .emacs file, etc.).  The function that actually does this
  167.    is in Lisp and is pointed to by the variable `top-level';
  168.    normally this function is `normal-top-level'.  top_level_1() is
  169.    just an error-handling wrapper similar to command_loop_2().
  170.    Note also that initial_command_loop() sets up a catch for 'top-level
  171.    when invoking top_level_1(), just like when it invokes
  172.    command_loop_2(). */
  173.  
  174.  
  175. static Lisp_Object
  176. cmd_error (Lisp_Object data, Lisp_Object dummy)
  177. {
  178.   /* This function can GC */
  179.   check_quit (); /* make Vquit_flag accurate */
  180.   Vquit_flag = Qnil;
  181.  
  182.   if (!NILP (Ffboundp (Qcommand_error)))
  183.     return call1 (Qcommand_error, data);
  184.  
  185.   return default_error_handler (data);
  186. }
  187.  
  188. static Lisp_Object
  189. top_level_1 (Lisp_Object dummy)
  190. {
  191.   /* This function can GC */
  192.   /* On entry to the outer level, run the startup file */
  193.   if (!NILP (Vtop_level))
  194.     condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
  195. #if 1
  196.   else
  197.     {
  198.       message ("\ntemacs can only be run in -batch mode.");
  199.       noninteractive = 1; /* prevent things under kill-emacs from blowing up */
  200.       Fkill_emacs (make_number (-1));
  201.     }
  202. #else
  203.   else if (purify_flag)
  204.     message ("Bare impure Emacs (standard Lisp code not loaded)");
  205.   else
  206.     message ("Bare Emacs (standard Lisp code not loaded)");
  207. #endif
  208.  
  209.   return Qnil;
  210. }
  211.  
  212. /* Here we catch errors in execution of commands within the
  213.    editing loop, and reenter the editing loop.
  214.    When there is an error, cmd_error runs and the call
  215.    to condition_case_1() returns. */
  216.  
  217. static Lisp_Object
  218. command_loop_2 (Lisp_Object dummy)
  219. {
  220.   /* This function can GC */
  221.   for (;;)
  222.     {
  223.       condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
  224.     }
  225.  
  226.   return Qnil; /* suppress warnings */
  227. }
  228.  
  229. /* This is called from emacs.c when it's done with initialization. */
  230.  
  231. DOESNT_RETURN
  232. initial_command_loop (Lisp_Object load_me)
  233. {
  234.   /* This function can GC */
  235.   if (!NILP (load_me))
  236.     Vtop_level = list2 (Qload, load_me);
  237.  
  238.   /* First deal with startup and command-line arguments.  A throw
  239.      to 'top-level gets us back here directly (does this ever happen?).
  240.      Otherwise, this function will return normally when all command-
  241.      line arguments have been processed, the user's initialization
  242.      file has been read in, and the first frame has been created. */
  243.   internal_catch (Qtop_level, top_level_1, Qnil, 0);
  244.  
  245.   /* If an error occurred during startup and the initial device
  246.      wasn't created, then die now (the error was already printed out
  247.      on the terminal device). */
  248.   if (!noninteractive &&
  249.       (!DEVICEP (Fselected_device ()) ||
  250.        DEVICE_IS_STREAM (XDEVICE (Fselected_device ()))))
  251.     Fkill_emacs (make_number (-1));
  252.   
  253.   /* End of -batch run causes exit here. */
  254.   if (noninteractive)
  255.     Fkill_emacs (Qt);
  256.  
  257.   for (;;)
  258.     {
  259.       command_loop_level = 0;
  260.       MARK_MODELINE_CHANGED;
  261.       /* Now invoke the command loop.  It never returns; however, a
  262.      throw to 'top-level will place us at the end of this loop. */
  263.       internal_catch (Qtop_level, command_loop_2, Qnil, 0);
  264.     }
  265. }
  266.  
  267. /* This function is invoked when a macro or minibuffer starts up.
  268.    Normal termination of the macro or minibuffer causes a throw past us.
  269.    See the comment above.
  270.  
  271.    Note that this function never returns (but may be thrown out of). */
  272.  
  273. Lisp_Object
  274. call_command_loop (Lisp_Object catch_errors)
  275. {
  276.   /* This function can GC */
  277.   if (NILP (catch_errors))
  278.     return (command_loop_1 (Qnil));
  279.   else
  280.     return (command_loop_2 (Qnil));
  281. }
  282.  
  283. static Lisp_Object
  284. recursive_edit_unwind (Lisp_Object buffer)
  285. {
  286.   if (!NILP (buffer))
  287.     Fset_buffer (buffer);
  288.  
  289.   command_loop_level--;
  290.   MARK_MODELINE_CHANGED;
  291.  
  292.   return Qnil;
  293. }
  294.  
  295. DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
  296.   "Invoke the editor command loop recursively.\n\
  297. To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
  298. that tells this function to return.\n\
  299. Alternately, `(throw 'exit t)' makes this function signal an error.")
  300.   ()
  301. {
  302.   /* This function can GC */
  303.   Lisp_Object val;
  304.   int speccount = specpdl_depth ();
  305.  
  306.   command_loop_level++;
  307.   MARK_MODELINE_CHANGED;
  308.  
  309.   record_unwind_protect (recursive_edit_unwind,
  310.              ((current_buffer
  311.                            != XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer))
  312.                           ? Fcurrent_buffer ()
  313.                           : Qnil));
  314.  
  315.   specbind (Qstandard_output, Qt);
  316.   specbind (Qstandard_input, Qt);
  317.  
  318.   val = internal_catch (Qexit, command_loop_2, Qnil, 0);
  319.  
  320.   if (EQ (val, Qt))
  321.     /* Turn abort-recursive-edit into a quit. */
  322.     Fsignal (Qquit, Qnil);
  323.  
  324.   return unbind_to (speccount, Qnil);
  325. }
  326.  
  327. #endif /* !LISP_COMMAND_LOOP */
  328.  
  329.  
  330. /**********************************************************************/
  331. /*             Alternate command-loop (largely in Lisp)               */
  332. /**********************************************************************/
  333.  
  334. #ifdef LISP_COMMAND_LOOP
  335.  
  336. static Lisp_Object
  337. load1 (Lisp_Object name)
  338. {
  339.   /* This function can GC */
  340.   call4 (Qload, name, Qnil, Qt, Qnil);
  341.   return (Qnil);
  342. }
  343.  
  344. /* emergency backups for cold-load-stream use */
  345. static Lisp_Object
  346. cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
  347. {
  348.   /* This function can GC */
  349.   check_quit (); /* make Vquit_flag accurate */
  350.   Vquit_flag = Qnil;
  351.  
  352.   return default_error_handler (datum);
  353. }
  354.  
  355. static Lisp_Object
  356. cold_load_command_loop (Lisp_Object dummy)
  357. {
  358.   /* This function can GC */
  359.   return (condition_case_1 (Qt,
  360.                             command_loop_1, Qnil,
  361.                             cold_load_command_error, Qnil));
  362. }
  363.  
  364. Lisp_Object
  365. call_command_loop (Lisp_Object catch_errors)
  366. {
  367.   /* This function can GC */
  368.   reset_this_command_keys (Qnil);
  369.  
  370.  loop:
  371.   for (;;)
  372.   {
  373.     if (NILP (Vcommand_loop))
  374.       break;
  375.     call1 (Vcommand_loop, catch_errors);
  376.   }
  377.  
  378.   /* This isn't a "correct" definition, but you're pretty hosed if
  379.      you broke "command-loop" anyway */
  380.   Vprefix_arg = Qnil;
  381.   if (NILP (catch_errors))
  382.     Fcommand_loop_1 ();
  383.   else 
  384.     internal_catch (Qtop_level,
  385.                     cold_load_command_loop, Qnil, 0);
  386.   goto loop;
  387.   return Qnil;
  388. }
  389.  
  390. static Lisp_Object
  391. initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
  392. {
  393.   /* This function can GC */
  394.   Vcommand_loop =  Qnil;
  395.   Fding (Qnil, Qnil, Qnil);
  396.  
  397.   if (CONSP (datum) && EQ (XCAR (datum), Qquit))
  398.     /* Don't bother with the message */
  399.     return (Qt);
  400.       
  401.   message ("Error in command-loop!!");
  402.   Fset (intern ("last-error"), datum); /* #### Better/different name? */
  403.   Fsit_for (make_number (2), Qnil);
  404.   cold_load_command_error (datum, Qnil);
  405.   return (Qt);
  406. }
  407.  
  408. DOESNT_RETURN
  409. initial_command_loop (Lisp_Object load_me)
  410. {
  411.   /* This function can GC */
  412.   if (!NILP (load_me))
  413.     {
  414.       if (!NILP (condition_case_1 (Qt, load1, load_me,
  415.                                    initial_error_handler, Qnil)))
  416.     Fkill_emacs (make_number (-1));
  417.     }
  418.  
  419.   for (;;)
  420.     {
  421.       command_loop_level = 0;
  422.       MARK_MODELINE_CHANGED;
  423.  
  424.       condition_case_1 (Qt,
  425.             call_command_loop, Qtop_level,
  426.             initial_error_handler, Qnil);
  427.     }
  428. }
  429.  
  430. #endif /* LISP_COMMAND_LOOP */
  431.  
  432.  
  433. /**********************************************************************/
  434. /*                     Guts of command loop                           */
  435. /**********************************************************************/
  436.  
  437. static Lisp_Object
  438. command_loop_1 (Lisp_Object dummy)
  439. {
  440.   /* This function can GC */
  441.   Vprefix_arg = Qnil;
  442.   return (Fcommand_loop_1 ());
  443. }
  444.  
  445. /* This is the actual command reading loop, sans error-handling
  446.    encapsulation.  This is used for both the C and Lisp command
  447.    loops.  Originally this function was written in Lisp when
  448.    the Lisp command loop was used, but it was too slow that way.
  449.  
  450.    Under the C command loop, this function will never return
  451.    (although someone might throw past it).  Under the Lisp
  452.    command loop, this will return only when the user specifies
  453.    a new command loop by changing the command-loop variable. */
  454.  
  455. DEFUN ("command-loop-1", Fcommand_loop_1, Scommand_loop_1, 0, 0, 0,
  456.   "Invoke the internals of the canonical editor command loop.\n\
  457. Don't call this unless you know what you're doing.")
  458.   ()
  459. {
  460.   /* This function can GC */
  461.   Lisp_Object event = Fallocate_event ();
  462.   Lisp_Object old_loop = Qnil;
  463.   struct gcpro gcpro1, gcpro2;
  464.   GCPRO2 (event, old_loop);
  465.  
  466.   /* cancel_echoing (); */
  467.   /* This magically makes single character keyboard macros work just
  468.      like the real thing.  This is slightly bogus, but it's in here for
  469.      compatibility with Emacs 18.  It's not even clear what the "right
  470.      thing" is. */
  471.   if (!(((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
  472.          && XINT (Flength (Vexecuting_macro)) == 1)))
  473.     Vlast_command = Qt;
  474.  
  475. #ifndef LISP_COMMAND_LOOP
  476.   while (1)
  477. #else
  478.   old_loop = Vcommand_loop;
  479.   while (EQ (Vcommand_loop, old_loop))
  480. #endif /* LISP_COMMAND_LOOP */
  481.     {
  482.       /* Make sure the current window's buffer is selected.  */
  483.       {
  484.     Lisp_Object selected_window = Fselected_window (Qnil);
  485.  
  486.     if (!NILP (selected_window) &&
  487.         (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
  488.       {
  489.         set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
  490.       }
  491.       }
  492.  
  493. #if 0 /* NYI */
  494.       /* Display any malloc warning that just came out.  Use while because
  495.      displaying one warning can cause another.  */
  496.       while (pending_malloc_warning)
  497.     display_malloc_warning ();
  498. #endif
  499.  
  500.       /* If ^G was typed before we got here (that is, before emacs was
  501.      idle and waiting for input) then we treat that as an interrupt. */
  502.       QUIT;
  503.  
  504.       /* If minibuffer on and echo area in use, wait 2 sec and redraw
  505.      minibuffer.  Treat a ^G here as a command, not an interrupt.
  506.        */
  507.       if (minibuf_level > 0 && echo_area_active (selected_frame ()))
  508.     {
  509.       /* Bind inhibit-quit to t so that C-g gets read in
  510.          rather than quitting back to the minibuffer.  */
  511.       int count = specpdl_depth ();
  512.       specbind (Qinhibit_quit, Qt);
  513.       Fsit_for (make_number (2), Qnil);
  514.       clear_echo_area (selected_frame (), Qnil, 0);
  515.       unbind_to (count, Qnil);
  516.     }
  517.  
  518.       Fnext_event (event, Qnil);
  519.       /* If ^G was typed while emacs was reading input from the user, then
  520.      Fnext_event() will have read it as a normal event and
  521.      next_event_internal() will have set Vquit_flag.  We reset this
  522.      so that the ^G is treated as just another key.  This is strange,
  523.      but it is what emacs 18 did.
  524.  
  525.      Do not call check_quit() here. */
  526.       Vquit_flag = Qnil;
  527.       Fdispatch_event (event);
  528.     }
  529.   UNGCPRO; 
  530.   return Qnil;
  531. }
  532.  
  533.  
  534. /**********************************************************************/
  535. /*               Miscellaneous low-level functions                    */
  536. /**********************************************************************/
  537.  
  538. DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
  539.   "FOpen dribble file: ",
  540.   "Start writing all keyboard characters to FILE.")
  541.   (file)
  542.      Lisp_Object file;
  543. {
  544.   /* This function can GC */
  545.   if (dribble)
  546.     fclose (dribble);
  547.   dribble = 0;
  548.   if (!NILP (file))
  549.     {
  550.       file = Fexpand_file_name (file, Qnil);
  551.       dribble = fopen ((char *) string_data (XSTRING (file)), "w");
  552.     }
  553.   return Qnil;
  554. }
  555.  
  556.  
  557. static Lisp_Object
  558. unwind_init_sys_modes (Lisp_Object device)
  559. {
  560.   reinit_initial_device ();
  561.  
  562.   if (!no_redraw_on_reenter)
  563.     {
  564.       if (DEVICEP (device) && DEVICE_LIVE_P (XDEVICE (device)))
  565.     MARK_FRAME_CHANGED (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device))));
  566.     }
  567.   return Qnil;
  568. }
  569.  
  570. DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
  571.   "Stop Emacs and return to superior process.  You can resume later.\n\
  572. On systems that don't have job control, run a subshell instead.\n\n\
  573. If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
  574. to be read as terminal input by Emacs's superior shell.\n\
  575. Before suspending, if `suspend-hook' is bound and value is non-nil\n\
  576. call the value as a function of no args.  Don't suspend if it returns non-nil.\n\
  577. Otherwise, suspend normally and after resumption call\n\
  578. `suspend-resume-hook' if that is bound and non-nil.\n\
  579. \n\
  580. Some operating systems cannot stop the Emacs process and resume it later.\n\
  581. On such systems, Emacs will start a subshell and wait for it to exit.")
  582.   (stuffstring)
  583.      Lisp_Object stuffstring;
  584. {
  585.   Lisp_Object tem;
  586.   int speccount = specpdl_depth ();
  587.   struct gcpro gcpro1;
  588.  
  589.   if (!NILP (stuffstring))
  590.     CHECK_STRING (stuffstring, 0);
  591.   GCPRO1 (stuffstring);
  592.  
  593.   /* There used to be a check that the initial device is TTY.
  594.      This is bogus.  Even checking to see whether any device
  595.      is a controlling terminal is not correct -- maybe
  596.      the user used the -t option or something.  If we want to
  597.      suspend, then we suspend.  Period. */
  598.  
  599.   /* Call value of suspend-hook
  600.      if it is bound and value is non-nil.  */
  601.   if (!NILP (Vrun_hooks))
  602.     {
  603.       tem = call1 (Vrun_hooks, Qsuspend_hook);
  604.       if (!EQ (tem, Qnil)) return Qnil;
  605.     }
  606.  
  607.   reset_initial_device ();
  608.   /* sys_suspend can get an error if it tries to fork a subshell
  609.      and the system resources aren't available for that.  */
  610.   record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal);
  611.   stuff_buffered_input (stuffstring);
  612.   sys_suspend ();
  613.   /* the device is un-reset inside of the unwind-protect. */
  614.   unbind_to (speccount, Qnil);
  615.  
  616.   /* Call value of suspend-resume-hook
  617.      if it is bound and value is non-nil.  */
  618.   if (!NILP (Vrun_hooks))
  619.     call1 (Vrun_hooks, Qsuspend_resume_hook);
  620.   
  621.   UNGCPRO;
  622.   return Qnil;
  623. }
  624.  
  625. /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
  626.    Then in any case stuff anything Emacs has read ahead and not used.  */
  627.  
  628. void
  629. stuff_buffered_input (Lisp_Object stuffstring)
  630. {
  631. /* stuff_char works only in BSD, versions 4.2 and up.  */
  632. #if defined (BSD)
  633.   unsigned char *p;
  634.  
  635.   if (!DEVICEP (Vcontrolling_terminal) ||
  636.       !DEVICE_LIVE_P (XDEVICE (Vcontrolling_terminal)))
  637.     return;
  638.  
  639.   if (STRINGP (stuffstring))
  640.     {
  641.       int count;
  642.  
  643.       p = (unsigned char *) string_ext_data (XSTRING (stuffstring));
  644.       count = string_ext_length (XSTRING (stuffstring));
  645.       while (count-- > 0)
  646.     stuff_char (XDEVICE (Vcontrolling_terminal), *p++);
  647.       stuff_char (XDEVICE (Vcontrolling_terminal), '\n');
  648.     }
  649.   /* Anything we have read ahead, put back for the shell to read.  */
  650. # if 0 /* oh, who cares about this silliness */
  651.   while (kbd_fetch_ptr != kbd_store_ptr)
  652.     {
  653.       if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
  654.     kbd_fetch_ptr = kbd_buffer;
  655.       stuff_char (XDEVICE (Vcontrolling_terminal), *kbd_fetch_ptr++);
  656.     }
  657. # endif
  658. #endif /* BSD */
  659. }
  660.  
  661. DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 5, 0,
  662.   "Set mode of reading keyboard input.\n\
  663. First arg is ignored, for backward compatibility.\n\
  664. Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
  665.  (no effect except in CBREAK mode).\n\
  666. Third arg META t means accept 8-bit input (for a Meta key).\n\
  667.  META nil means ignore the top bit, on the assumption it is parity.\n\
  668.  Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
  669. First three arguments only apply to TTY devices.\n\
  670. Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
  671. Optional fifth arg DEVICE specifies device to make changes to; nil means\n\
  672.  the current device.\n\
  673. See also `current-input-mode'.")
  674.   (ignored, flow, meta, quit, device)
  675.      Lisp_Object ignored, flow, meta, quit, device;
  676. {
  677.   struct device *d = get_device (device);
  678.   int meta_key = 1;
  679.  
  680.   if (DEVICE_IS_TTY (d))
  681.     {
  682.       if (NILP (meta))
  683.     meta_key = 0;
  684.       else if (EQ (meta, Qt))
  685.     meta_key = 1;
  686.       else
  687.     meta_key = 2;
  688.     }
  689.  
  690.   if (!NILP (quit))
  691.     {
  692.       CHECK_INT (quit, 3);
  693.       DEVICE_QUIT_CHAR (d) =
  694.     ((unsigned int) XINT (quit)) & (meta_key ? 0377 : 0177);
  695.     }
  696.  
  697.   if (DEVICE_IS_TTY (d))
  698.     {
  699.       reset_one_device (d);
  700.       TTY_FLAGS (d).flow_control = !NILP (flow);
  701.       TTY_FLAGS (d).meta_key = meta_key;
  702.       init_one_device (d);
  703.     }
  704.  
  705.   return Qnil;
  706. }
  707.  
  708. DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 1, 0,
  709.   "Return information about the way Emacs currently reads keyboard input.\n\
  710. Optional arg DEVICE specifies device to return information about; nil means\n\
  711.  the current device.\n\
  712. The value is a list of the form (nil FLOW META QUIT), where\n\
  713.   FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
  714.     terminal; this does not apply if Emacs uses interrupt-driven input.\n\
  715.   META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
  716.     META nil means ignoring the top bit, on the assumption it is parity.\n\
  717.     META is neither t nor nil if accepting 8-bit input and using\n\
  718.     all 8 bits as the character code.\n\
  719.   QUIT is the character Emacs currently uses to quit.\n\
  720. FLOW, and META are only meaningful for TTY devices.\n\
  721. The elements of this list correspond to the arguments of\n\
  722. `set-input-mode'.")
  723.   (device)
  724.      Lisp_Object device;
  725. {
  726.   Lisp_Object val[4];
  727.   struct device *d = get_device (device);
  728.  
  729.   val[0] = Qnil;
  730.   val[1] = DEVICE_IS_TTY (d) && TTY_FLAGS (d).flow_control ? Qt : Qnil;
  731.   val[2] = (!DEVICE_IS_TTY (d) || TTY_FLAGS (d).meta_key == 1) ?
  732.     Qt : TTY_FLAGS (d).meta_key == 2 ? make_number (0) : Qnil;
  733.   val[3] = make_number (DEVICE_QUIT_CHAR (d));
  734.  
  735.   return Flist (sizeof (val) / sizeof (val[0]), val);
  736. }
  737.  
  738.  
  739. /**********************************************************************/
  740. /*                         Initialization                             */
  741. /**********************************************************************/
  742.  
  743. void
  744. syms_of_keyboard (void)
  745. {
  746.   defsymbol (&Qcommand_error, "command-error");
  747.   defsymbol (&Qreally_early_error_handler, "really-early-error-handler");
  748.   defsymbol (&Qtop_level, "top-level");
  749.   defsymbol (&Qsuspend_hook, "suspend-hook");
  750.   defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
  751.  
  752. #ifndef LISP_COMMAND_LOOP
  753.   defsubr (&Srecursive_edit);
  754. #endif
  755.   defsubr (&Sreally_early_error_handler);
  756.   defsubr (&Scommand_loop_1);
  757.  
  758.   defsubr (&Ssuspend_emacs);
  759.   defsubr (&Sopen_dribble_file);
  760.   defsubr (&Sset_input_mode);
  761.   defsubr (&Scurrent_input_mode);
  762. }
  763.  
  764. void
  765. vars_of_keyboard (void)
  766. {
  767.   DEFVAR_INT ("command-loop-level", &command_loop_level,
  768.     "Number of recursive edits in progress.");
  769.   command_loop_level = 0;
  770.  
  771.   DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
  772.     "Value is called instead of any command that is disabled,\n\
  773. i.e. has a non-nil `disabled' property.");
  774.   Vdisabled_command_hook = intern ("disabled-command-hook");
  775.  
  776. #ifndef LISP_COMMAND_LOOP
  777.   DEFVAR_LISP ("top-level", &Vtop_level,
  778.     "Form to evaluate when Emacs starts up.\n\
  779. Useful to set before you dump a modified Emacs.");
  780.   Vtop_level = Qnil;
  781. #else
  782.   DEFVAR_LISP ("command-loop", &Vcommand_loop,
  783.     "Function or one argument to call to read and process keyboard commands.\n\
  784. The passed argument specifies whether or not to handle errors.");
  785.   Vcommand_loop = Qnil;
  786. #endif /* LISP_COMMAND_LOOP */
  787. }
  788.  
  789. void
  790. init_keyboard (void)
  791. {
  792.   dribble = 0;
  793. }
  794.