1 /* Editor command loop.
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Mule 2.0. Not synched with FSF.
23 This was renamed from keyboard.c. However, it only contains the
24 command-loop stuff from FSF's keyboard.c; all the rest is in
25 event*.c, console.c, or signal.c. */
27 /* #### This module purports to separate out the command-loop stuff
28 from event-stream.c, but it doesn't really. Perhaps this file
29 should just be merged into event-stream.c, given its shortness. */
40 /* Current depth in recursive edits. */
41 int command_loop_level;
43 /* Total number of times command_loop has read a key sequence. */
46 #ifndef LISP_COMMAND_LOOP
47 /* Form to evaluate (if non-nil) when Emacs is started. */
48 Lisp_Object Vtop_level;
50 /* Function to call to evaluate to read and process events. */
51 Lisp_Object Vcommand_loop;
52 #endif /* LISP_COMMAND_LOOP */
54 Lisp_Object Venter_window_hook, Vleave_window_hook;
56 /* The error handler. */
57 Lisp_Object Qcommand_error;
59 /* The emergency error handler, before we're ready. */
60 Lisp_Object Qreally_early_error_handler;
62 /* Variable defined in Lisp. */
63 Lisp_Object Qerrors_deactivate_region;
65 Lisp_Object Qtop_level;
67 static Lisp_Object command_loop_1 (Lisp_Object dummy);
68 EXFUN (Fcommand_loop_1, 0);
70 /* There are two possible command loops -- one written entirely in
71 C and one written mostly in Lisp, except stuff written in C for
72 speed. The advantage of the Lisp command loop is that the user
73 can specify their own command loop to use by changing the variable
74 `command-loop'. Its disadvantage is that it's slow. */
77 default_error_handler (Lisp_Object data)
79 int speccount = specpdl_depth ();
81 /* None of this is invoked, normally. This code is almost identical
82 to the `command-error' function, except `command-error' does cool
83 tricks with sounds. This function is a fallback, invoked if
84 command-error is unavailable. */
86 Fding (Qnil, Qnil, Qnil);
88 if (!NILP (Fboundp (Qerrors_deactivate_region))
89 && !NILP (Fsymbol_value (Qerrors_deactivate_region)))
90 zmacs_deactivate_region ();
92 specbind (Qinhibit_quit, Qt);
93 Vstandard_output = Qt;
95 Vexecuting_macro = Qnil;
96 Fset (intern ("last-error"), data);
97 clear_echo_area (selected_frame (), Qnil, 0);
98 Fdisplay_error (data, Qt);
99 check_quit (); /* make Vquit_flag accurate */
101 return (unbind_to (speccount, Qt));
104 DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /*
105 You should almost certainly not be using this.
109 /* This is an error handler used when we're running temacs and when
110 we're in the early stages of XEmacs. No errors ought to be
111 occurring in those cases (or they ought to be trapped and
112 dealt with elsewhere), but if an error slips through, we need
113 to deal with it. We could write this function in Lisp (and it
114 used to be this way, at the beginning of loadup.el), but we do
115 it this way in case an error occurs before we get to loading
116 loadup.el. Note that there is also an `early-error-handler',
117 used in startup.el to catch more reasonable errors that
118 might occur during startup if the sysadmin or whoever fucked
119 up. This function is more conservative in what it does
120 and is used only as a last resort, indicating that the
121 programmer himself fucked up somewhere. */
122 stderr_out ("*** Error in XEmacs initialization");
123 Fprint (x, Qexternal_debugging_output);
124 stderr_out ("*** Backtrace\n");
125 Fbacktrace (Qexternal_debugging_output, Qt);
126 stderr_out ("*** Killing XEmacs\n");
127 return Fkill_emacs (make_int (-1));
131 /**********************************************************************/
132 /* Command-loop (in C) */
133 /**********************************************************************/
135 #ifndef LISP_COMMAND_LOOP
137 /* The guts of the command loop are in command_loop_1(). This function
138 doesn't catch errors, though -- that's the job of command_loop_2(),
139 which is a condition-case wrapper around command_loop_1().
140 command_loop_1() never returns, but may get thrown out of.
142 When an error occurs, cmd_error() is called, which usually
143 invokes the Lisp error handler in `command-error'; however,
144 a default error handler is provided if `command-error' is nil
145 (e.g. during startup). The purpose of the error handler is
146 simply to display the error message and do associated cleanup;
147 it does not need to throw anywhere. When the error handler
148 finishes, the condition-case in command_loop_2() will finish and
149 command_loop_2() will reinvoke command_loop_1().
151 command_loop_2() is invoked from three places: from
152 initial_command_loop() (called from main() at the end of
153 internal initialization), from the Lisp function `recursive-edit',
154 and from call_command_loop().
156 call_command_loop() is called when a macro is started and when the
157 minibuffer is entered; normal termination of the macro or
158 minibuffer causes a throw out of the recursive command loop. (To
159 'execute-kbd-macro for macros and 'exit for minibuffers. Note also
160 that the low-level minibuffer-entering function,
161 `read-minibuffer-internal', provides its own error handling and
162 does not need command_loop_2()'s error encapsulation; so it tells
163 call_command_loop() to invoke command_loop_1() directly.)
165 Note that both read-minibuffer-internal and recursive-edit set
166 up a catch for 'exit; this is why `abort-recursive-edit', which
167 throws to this catch, exits out of either one.
169 initial_command_loop(), called from main(), sets up a catch
170 for 'top-level when invoking command_loop_2(), allowing functions
171 to throw all the way to the top level if they really need to.
172 Before invoking command_loop_2(), initial_command_loop() calls
173 top_level_1(), which handles all of the startup stuff (creating
174 the initial frame, handling the command-line options, loading
175 the user's .emacs file, etc.). The function that actually does this
176 is in Lisp and is pointed to by the variable `top-level';
177 normally this function is `normal-top-level'. top_level_1() is
178 just an error-handling wrapper similar to command_loop_2().
179 Note also that initial_command_loop() sets up a catch for 'top-level
180 when invoking top_level_1(), just like when it invokes
185 cmd_error (Lisp_Object data, Lisp_Object dummy)
187 /* This function can GC */
188 check_quit (); /* make Vquit_flag accurate */
191 any_console_state ();
193 if (!NILP (Ffboundp (Qcommand_error)))
194 return call1 (Qcommand_error, data);
196 return default_error_handler (data);
200 top_level_1 (Lisp_Object dummy)
202 /* This function can GC */
203 /* On entry to the outer level, run the startup file */
204 if (!NILP (Vtop_level))
205 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
209 message ("\ntemacs can only be run in -batch mode.");
210 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
211 Fkill_emacs (make_int (-1));
214 else if (purify_flag)
215 message ("Bare impure Emacs (standard Lisp code not loaded)");
217 message ("Bare Emacs (standard Lisp code not loaded)");
223 /* Here we catch errors in execution of commands within the
224 editing loop, and reenter the editing loop.
225 When there is an error, cmd_error runs and the call
226 to condition_case_1() returns. */
228 /* Avoid confusing the compiler. A helper function for command_loop_2 */
230 command_loop_3 (void)
232 #ifdef LWLIB_MENUBARS_LUCID
233 extern int in_menu_callback; /* defined in menubar-x.c */
234 #endif /* LWLIB_MENUBARS_LUCID */
236 #ifdef LWLIB_MENUBARS_LUCID
238 * #### Fix the menu code so this isn't necessary.
240 * We cannot allow the lwmenu code to be reentered, because the
241 * code is not written to be reentrant and will crash. Therefore
242 * paths from the menu callbacks back into the menu code have to
243 * be blocked. Fnext_event is the normal path into the menu code,
244 * but waiting to signal an error there is too late in case where
245 * a new command loop has been started. The error will be caught
246 * and Fnext_event will be called again, looping forever. So we
247 * signal an error here to avoid the loop.
249 if (in_menu_callback)
250 error ("Attempt to enter command_loop_3 inside menu callback");
251 #endif /* LWLIB_MENUBARS_LUCID */
252 /* This function can GC */
255 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
256 /* #### wrong with selected-console? */
257 /* See command in initial_command_loop about why this value
259 reset_this_command_keys (Vselected_console, 0);
264 command_loop_2 (Lisp_Object dummy)
266 command_loop_3(); /* doesn't return */
270 /* This is called from emacs.c when it's done with initialization. */
273 initial_command_loop (Lisp_Object load_me)
275 /* This function can GC */
277 Vtop_level = list2 (Qload, load_me);
279 /* First deal with startup and command-line arguments. A throw
280 to 'top-level gets us back here directly (does this ever happen?).
281 Otherwise, this function will return normally when all command-
282 line arguments have been processed, the user's initialization
283 file has been read in, and the first frame has been created. */
284 internal_catch (Qtop_level, top_level_1, Qnil, 0);
286 /* If an error occurred during startup and the initial console
287 wasn't created, then die now (the error was already printed out
288 on the terminal device). */
289 if (!noninteractive &&
290 (!CONSOLEP (Vselected_console) ||
291 CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
292 Fkill_emacs (make_int (-1));
294 /* End of -batch run causes exit here. */
300 command_loop_level = 0;
301 MARK_MODELINE_CHANGED;
302 /* Now invoke the command loop. It never returns; however, a
303 throw to 'top-level will place us at the end of this loop. */
304 internal_catch (Qtop_level, command_loop_2, Qnil, 0);
305 /* #### wrong with selected-console? */
306 /* We don't actually call clear_echo_area() here, partially
307 at least because that runs Lisp code and it may be unsafe
308 to do so -- we are outside of the normal catches for
310 reset_this_command_keys (Vselected_console, 0);
314 /* This function is invoked when a macro or minibuffer starts up.
315 Normal termination of the macro or minibuffer causes a throw past us.
316 See the comment above.
318 Note that this function never returns (but may be thrown out of). */
321 call_command_loop (Lisp_Object catch_errors)
323 /* This function can GC */
324 if (NILP (catch_errors))
325 return (command_loop_1 (Qnil));
327 return (command_loop_2 (Qnil));
331 recursive_edit_unwind (Lisp_Object buffer)
334 Fset_buffer (buffer);
336 command_loop_level--;
337 MARK_MODELINE_CHANGED;
342 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
343 Invoke the editor command loop recursively.
344 To get out of the recursive edit, a command can do `(throw 'exit nil)';
345 that tells this function to return.
346 Alternately, `(throw 'exit t)' makes this function signal an error.
350 /* This function can GC */
352 int speccount = specpdl_depth ();
354 command_loop_level++;
355 MARK_MODELINE_CHANGED;
357 record_unwind_protect (recursive_edit_unwind,
359 != XBUFFER (XWINDOW (Fselected_window
364 specbind (Qstandard_output, Qt);
365 specbind (Qstandard_input, Qt);
367 val = internal_catch (Qexit, command_loop_2, Qnil, 0);
370 /* Turn abort-recursive-edit into a quit. */
371 Fsignal (Qquit, Qnil);
373 return unbind_to (speccount, Qnil);
376 #endif /* !LISP_COMMAND_LOOP */
379 /**********************************************************************/
380 /* Alternate command-loop (largely in Lisp) */
381 /**********************************************************************/
383 #ifdef LISP_COMMAND_LOOP
386 load1 (Lisp_Object name)
388 /* This function can GC */
389 call4 (Qload, name, Qnil, Qt, Qnil);
393 /* emergency backups for cold-load-stream use */
395 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
397 /* This function can GC */
398 check_quit (); /* make Vquit_flag accurate */
401 return default_error_handler (datum);
405 cold_load_command_loop (Lisp_Object dummy)
407 /* This function can GC */
408 return (condition_case_1 (Qt,
409 command_loop_1, Qnil,
410 cold_load_command_error, Qnil));
414 call_command_loop (Lisp_Object catch_errors)
416 /* This function can GC */
417 reset_this_command_keys (Vselected_console, Qnil); /* #### bleagh */
422 if (NILP (Vcommand_loop))
424 call1 (Vcommand_loop, catch_errors);
427 /* This isn't a "correct" definition, but you're pretty hosed if
428 you broke "command-loop" anyway */
429 /* #### not correct with Vselected_console */
430 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
431 if (NILP (catch_errors))
434 internal_catch (Qtop_level,
435 cold_load_command_loop, Qnil, 0);
441 initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
443 /* This function can GC */
444 Vcommand_loop = Qnil;
445 Fding (Qnil, Qnil, Qnil);
447 if (CONSP (datum) && EQ (XCAR (datum), Qquit))
448 /* Don't bother with the message */
451 message ("Error in command-loop!!");
452 Fset (intern ("last-error"), datum); /* #### Better/different name? */
453 Fsit_for (make_int (2), Qnil);
454 cold_load_command_error (datum, Qnil);
459 initial_command_loop (Lisp_Object load_me)
461 /* This function can GC */
464 if (!NILP (condition_case_1 (Qt, load1, load_me,
465 initial_error_handler, Qnil)))
466 Fkill_emacs (make_int (-1));
471 command_loop_level = 0;
472 MARK_MODELINE_CHANGED;
474 condition_case_1 (Qt,
475 call_command_loop, Qtop_level,
476 initial_error_handler, Qnil);
480 #endif /* LISP_COMMAND_LOOP */
483 /**********************************************************************/
484 /* Guts of command loop */
485 /**********************************************************************/
488 command_loop_1 (Lisp_Object dummy)
490 /* This function can GC */
491 /* #### not correct with Vselected_console */
492 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
493 return (Fcommand_loop_1 ());
496 /* This is the actual command reading loop, sans error-handling
497 encapsulation. This is used for both the C and Lisp command
498 loops. Originally this function was written in Lisp when
499 the Lisp command loop was used, but it was too slow that way.
501 Under the C command loop, this function will never return
502 (although someone might throw past it). Under the Lisp
503 command loop, this will return only when the user specifies
504 a new command loop by changing the command-loop variable. */
506 DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
507 Invoke the internals of the canonical editor command loop.
508 Don't call this unless you know what you're doing.
512 /* This function can GC */
513 Lisp_Object event = Fmake_event (Qnil, Qnil);
514 Lisp_Object old_loop = Qnil;
515 struct gcpro gcpro1, gcpro2;
516 int was_locked = in_single_console_state ();
517 GCPRO2 (event, old_loop);
519 /* cancel_echoing (); */
520 /* This magically makes single character keyboard macros work just
521 like the real thing. This is slightly bogus, but it's in here for
522 compatibility with Emacs 18. It's not even clear what the "right
524 if (!(((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
525 && XINT (Flength (Vexecuting_macro)) == 1)))
528 #ifndef LISP_COMMAND_LOOP
531 old_loop = Vcommand_loop;
532 while (EQ (Vcommand_loop, old_loop))
533 #endif /* LISP_COMMAND_LOOP */
535 /* If focus_follows_mouse, make sure the frame with window manager
536 focus is selected. */
537 if (focus_follows_mouse)
538 investigate_frame_change ();
540 /* Make sure the current window's buffer is selected. */
542 Lisp_Object selected_window = Fselected_window (Qnil);
544 if (!NILP (selected_window) &&
545 (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
547 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
551 /* If ^G was typed before we got here (that is, before emacs was
552 idle and waiting for input) then we treat that as an interrupt. */
555 /* If minibuffer on and echo area in use, wait 2 sec and redraw
556 minibuffer. Treat a ^G here as a command, not an interrupt.
558 if (minibuf_level > 0 && echo_area_active (selected_frame ()))
560 /* Bind dont_check_for_quit to 1 so that C-g gets read in
561 rather than quitting back to the minibuffer. */
562 int count = specpdl_depth ();
563 begin_dont_check_for_quit ();
564 Fsit_for (make_int (2), Qnil);
565 clear_echo_area (selected_frame (), Qnil, 0);
566 unbind_to (count, Qnil);
569 Fnext_event (event, Qnil);
570 /* If ^G was typed while emacs was reading input from the user, then
571 Fnext_event() will have read it as a normal event and
572 next_event_internal() will have set Vquit_flag. We reset this
573 so that the ^G is treated as just another key. This is strange,
574 but it is what emacs 18 did.
576 Do not call check_quit() here. */
578 Fdispatch_event (event);
581 any_console_state ();
582 #if (defined (_MSC_VER) \
583 || defined (__SUNPRO_C) \
584 || defined (__SUNPRO_CC) \
585 || (defined (DEC_ALPHA) \
587 if (0) return Qnil; /* Shut up compiler */
590 #ifdef LISP_COMMAND_LOOP
597 /**********************************************************************/
599 /**********************************************************************/
602 syms_of_cmdloop (void)
604 defsymbol (&Qcommand_error, "command-error");
605 defsymbol (&Qreally_early_error_handler, "really-early-error-handler");
606 defsymbol (&Qtop_level, "top-level");
607 defsymbol (&Qerrors_deactivate_region, "errors-deactivate-region");
609 #ifndef LISP_COMMAND_LOOP
610 DEFSUBR (Frecursive_edit);
612 DEFSUBR (Freally_early_error_handler);
613 DEFSUBR (Fcommand_loop_1);
617 vars_of_cmdloop (void)
619 DEFVAR_INT ("command-loop-level", &command_loop_level /*
620 Number of recursive edits in progress.
622 command_loop_level = 0;
624 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
625 Value is called instead of any command that is disabled,
626 i.e. has a non-nil `disabled' property.
628 Vdisabled_command_hook = intern ("disabled-command-hook");
630 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
633 Vleave_window_hook = Qnil;
635 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
638 Venter_window_hook = Qnil;
640 #ifndef LISP_COMMAND_LOOP
641 DEFVAR_LISP ("top-level", &Vtop_level /*
642 Form to evaluate when Emacs starts up.
643 Useful to set before you dump a modified Emacs.
647 DEFVAR_LISP ("command-loop", &Vcommand_loop /*
648 Function or one argument to call to read and process keyboard commands.
649 The passed argument specifies whether or not to handle errors.
651 Vcommand_loop = Qnil;
652 #endif /* LISP_COMMAND_LOOP */