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 #ifndef LISP_COMMAND_LOOP
44 /* Form to evaluate (if non-nil) when Emacs is started. */
45 Lisp_Object Vtop_level;
47 /* Function to call to evaluate to read and process events. */
48 Lisp_Object Vcommand_loop;
49 #endif /* LISP_COMMAND_LOOP */
51 Lisp_Object Venter_window_hook, Vleave_window_hook;
53 /* The error handler. */
54 Lisp_Object Qcommand_error;
56 /* The emergency error handler, before we're ready. */
57 Lisp_Object Qreally_early_error_handler;
59 /* Variable defined in Lisp. */
60 Lisp_Object Qerrors_deactivate_region;
62 Lisp_Object Qtop_level;
64 static Lisp_Object command_loop_1 (Lisp_Object dummy);
65 EXFUN (Fcommand_loop_1, 0);
67 /* There are two possible command loops -- one written entirely in
68 C and one written mostly in Lisp, except stuff written in C for
69 speed. The advantage of the Lisp command loop is that the user
70 can specify their own command loop to use by changing the variable
71 `command-loop'. Its disadvantage is that it's slow. */
74 default_error_handler (Lisp_Object data)
76 int speccount = specpdl_depth ();
78 /* None of this is invoked, normally. This code is almost identical
79 to the `command-error' function, except `command-error' does cool
80 tricks with sounds. This function is a fallback, invoked if
81 command-error is unavailable. */
83 Fding (Qnil, Qnil, Qnil);
85 if (!NILP (Fboundp (Qerrors_deactivate_region))
86 && !NILP (Fsymbol_value (Qerrors_deactivate_region)))
87 zmacs_deactivate_region ();
89 specbind (Qinhibit_quit, Qt);
90 Vstandard_output = Qt;
92 Vexecuting_macro = Qnil;
93 Fset (intern ("last-error"), data);
94 clear_echo_area (selected_frame (), Qnil, 0);
95 Fdisplay_error (data, Qt);
96 check_quit (); /* make Vquit_flag accurate */
98 return (unbind_to (speccount, Qt));
101 DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /*
102 You should almost certainly not be using this.
106 /* This is an error handler used when we're running temacs and when
107 we're in the early stages of XEmacs. No errors ought to be
108 occurring in those cases (or they ought to be trapped and
109 dealt with elsewhere), but if an error slips through, we need
110 to deal with it. We could write this function in Lisp (and it
111 used to be this way, at the beginning of loadup.el), but we do
112 it this way in case an error occurs before we get to loading
113 loadup.el. Note that there is also an `early-error-handler',
114 used in startup.el to catch more reasonable errors that
115 might occur during startup if the sysadmin or whoever fucked
116 up. This function is more conservative in what it does
117 and is used only as a last resort, indicating that the
118 programmer himself fucked up somewhere. */
119 stderr_out ("*** Error in XEmacs initialization");
120 Fprint (x, Qexternal_debugging_output);
121 stderr_out ("*** Backtrace\n");
122 Fbacktrace (Qexternal_debugging_output, Qt);
123 stderr_out ("*** Killing XEmacs\n");
124 return Fkill_emacs (make_int (-1));
128 /**********************************************************************/
129 /* Command-loop (in C) */
130 /**********************************************************************/
132 #ifndef LISP_COMMAND_LOOP
134 /* The guts of the command loop are in command_loop_1(). This function
135 doesn't catch errors, though -- that's the job of command_loop_2(),
136 which is a condition-case wrapper around command_loop_1().
137 command_loop_1() never returns, but may get thrown out of.
139 When an error occurs, cmd_error() is called, which usually
140 invokes the Lisp error handler in `command-error'; however,
141 a default error handler is provided if `command-error' is nil
142 (e.g. during startup). The purpose of the error handler is
143 simply to display the error message and do associated cleanup;
144 it does not need to throw anywhere. When the error handler
145 finishes, the condition-case in command_loop_2() will finish and
146 command_loop_2() will reinvoke command_loop_1().
148 command_loop_2() is invoked from three places: from
149 initial_command_loop() (called from main() at the end of
150 internal initialization), from the Lisp function `recursive-edit',
151 and from call_command_loop().
153 call_command_loop() is called when a macro is started and when the
154 minibuffer is entered; normal termination of the macro or
155 minibuffer causes a throw out of the recursive command loop. (To
156 'execute-kbd-macro for macros and 'exit for minibuffers. Note also
157 that the low-level minibuffer-entering function,
158 `read-minibuffer-internal', provides its own error handling and
159 does not need command_loop_2()'s error encapsulation; so it tells
160 call_command_loop() to invoke command_loop_1() directly.)
162 Note that both read-minibuffer-internal and recursive-edit set
163 up a catch for 'exit; this is why `abort-recursive-edit', which
164 throws to this catch, exits out of either one.
166 initial_command_loop(), called from main(), sets up a catch
167 for 'top-level when invoking command_loop_2(), allowing functions
168 to throw all the way to the top level if they really need to.
169 Before invoking command_loop_2(), initial_command_loop() calls
170 top_level_1(), which handles all of the startup stuff (creating
171 the initial frame, handling the command-line options, loading
172 the user's .emacs file, etc.). The function that actually does this
173 is in Lisp and is pointed to by the variable `top-level';
174 normally this function is `normal-top-level'. top_level_1() is
175 just an error-handling wrapper similar to command_loop_2().
176 Note also that initial_command_loop() sets up a catch for 'top-level
177 when invoking top_level_1(), just like when it invokes
182 cmd_error (Lisp_Object data, Lisp_Object dummy)
184 /* This function can GC */
185 check_quit (); /* make Vquit_flag accurate */
188 any_console_state ();
190 if (!NILP (Ffboundp (Qcommand_error)))
191 return call1 (Qcommand_error, data);
193 return default_error_handler (data);
197 top_level_1 (Lisp_Object dummy)
199 /* This function can GC */
200 /* On entry to the outer level, run the startup file */
201 if (!NILP (Vtop_level))
202 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
206 message ("\ntemacs can only be run in -batch mode.");
207 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
208 Fkill_emacs (make_int (-1));
211 else if (purify_flag)
212 message ("Bare impure Emacs (standard Lisp code not loaded)");
214 message ("Bare Emacs (standard Lisp code not loaded)");
220 /* Here we catch errors in execution of commands within the
221 editing loop, and reenter the editing loop.
222 When there is an error, cmd_error runs and the call
223 to condition_case_1() returns. */
225 /* Avoid confusing the compiler. A helper function for command_loop_2 */
227 command_loop_3 (void)
229 #ifdef LWLIB_MENUBARS_LUCID
230 extern int in_menu_callback; /* defined in menubar-x.c */
231 #endif /* LWLIB_MENUBARS_LUCID */
233 #ifdef LWLIB_MENUBARS_LUCID
235 * #### Fix the menu code so this isn't necessary.
237 * We cannot allow the lwmenu code to be reentered, because the
238 * code is not written to be reentrant and will crash. Therefore
239 * paths from the menu callbacks back into the menu code have to
240 * be blocked. Fnext_event is the normal path into the menu code,
241 * but waiting to signal an error there is too late in case where
242 * a new command loop has been started. The error will be caught
243 * and Fnext_event will be called again, looping forever. So we
244 * signal an error here to avoid the loop.
246 if (in_menu_callback)
247 error ("Attempt to enter command_loop_3 inside menu callback");
248 #endif /* LWLIB_MENUBARS_LUCID */
249 /* This function can GC */
252 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
253 /* #### wrong with selected-console? */
254 /* See command in initial_command_loop about why this value
256 reset_this_command_keys (Vselected_console, 0);
261 command_loop_2 (Lisp_Object dummy)
263 command_loop_3(); /* doesn't return */
267 /* This is called from emacs.c when it's done with initialization. */
270 initial_command_loop (Lisp_Object load_me)
272 /* This function can GC */
274 Vtop_level = list2 (Qload, load_me);
276 /* First deal with startup and command-line arguments. A throw
277 to 'top-level gets us back here directly (does this ever happen?).
278 Otherwise, this function will return normally when all command-
279 line arguments have been processed, the user's initialization
280 file has been read in, and the first frame has been created. */
281 internal_catch (Qtop_level, top_level_1, Qnil, 0);
283 /* If an error occurred during startup and the initial console
284 wasn't created, then die now (the error was already printed out
285 on the terminal device). */
286 if (!noninteractive &&
287 (!CONSOLEP (Vselected_console) ||
288 CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
289 Fkill_emacs (make_int (-1));
291 /* End of -batch run causes exit here. */
297 command_loop_level = 0;
298 MARK_MODELINE_CHANGED;
299 /* Now invoke the command loop. It never returns; however, a
300 throw to 'top-level will place us at the end of this loop. */
301 internal_catch (Qtop_level, command_loop_2, Qnil, 0);
302 /* #### wrong with selected-console? */
303 /* We don't actually call clear_echo_area() here, partially
304 at least because that runs Lisp code and it may be unsafe
305 to do so -- we are outside of the normal catches for
307 reset_this_command_keys (Vselected_console, 0);
311 /* This function is invoked when a macro or minibuffer starts up.
312 Normal termination of the macro or minibuffer causes a throw past us.
313 See the comment above.
315 Note that this function never returns (but may be thrown out of). */
318 call_command_loop (Lisp_Object catch_errors)
320 /* This function can GC */
321 if (NILP (catch_errors))
322 return (command_loop_1 (Qnil));
324 return (command_loop_2 (Qnil));
328 recursive_edit_unwind (Lisp_Object buffer)
331 Fset_buffer (buffer);
333 command_loop_level--;
334 MARK_MODELINE_CHANGED;
339 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
340 Invoke the editor command loop recursively.
341 To get out of the recursive edit, a command can do `(throw 'exit nil)';
342 that tells this function to return.
343 Alternately, `(throw 'exit t)' makes this function signal an error.
347 /* This function can GC */
349 int speccount = specpdl_depth ();
351 command_loop_level++;
352 MARK_MODELINE_CHANGED;
354 record_unwind_protect (recursive_edit_unwind,
356 != XBUFFER (XWINDOW (Fselected_window
361 specbind (Qstandard_output, Qt);
362 specbind (Qstandard_input, Qt);
364 val = internal_catch (Qexit, command_loop_2, Qnil, 0);
367 /* Turn abort-recursive-edit into a quit. */
368 Fsignal (Qquit, Qnil);
370 return unbind_to (speccount, Qnil);
373 #endif /* !LISP_COMMAND_LOOP */
376 /**********************************************************************/
377 /* Alternate command-loop (largely in Lisp) */
378 /**********************************************************************/
380 #ifdef LISP_COMMAND_LOOP
383 load1 (Lisp_Object name)
385 /* This function can GC */
386 call4 (Qload, name, Qnil, Qt, Qnil);
390 /* emergency backups for cold-load-stream use */
392 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
394 /* This function can GC */
395 check_quit (); /* make Vquit_flag accurate */
398 return default_error_handler (datum);
402 cold_load_command_loop (Lisp_Object dummy)
404 /* This function can GC */
405 return (condition_case_1 (Qt,
406 command_loop_1, Qnil,
407 cold_load_command_error, Qnil));
411 call_command_loop (Lisp_Object catch_errors)
413 /* This function can GC */
414 reset_this_command_keys (Vselected_console, Qnil); /* #### bleagh */
419 if (NILP (Vcommand_loop))
421 call1 (Vcommand_loop, catch_errors);
424 /* This isn't a "correct" definition, but you're pretty hosed if
425 you broke "command-loop" anyway */
426 /* #### not correct with Vselected_console */
427 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
428 if (NILP (catch_errors))
431 internal_catch (Qtop_level,
432 cold_load_command_loop, Qnil, 0);
438 initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
440 /* This function can GC */
441 Vcommand_loop = Qnil;
442 Fding (Qnil, Qnil, Qnil);
444 if (CONSP (datum) && EQ (XCAR (datum), Qquit))
445 /* Don't bother with the message */
448 message ("Error in command-loop!!");
449 Fset (intern ("last-error"), datum); /* #### Better/different name? */
450 Fsit_for (make_int (2), Qnil);
451 cold_load_command_error (datum, Qnil);
456 initial_command_loop (Lisp_Object load_me)
458 /* This function can GC */
461 if (!NILP (condition_case_1 (Qt, load1, load_me,
462 initial_error_handler, Qnil)))
463 Fkill_emacs (make_int (-1));
468 command_loop_level = 0;
469 MARK_MODELINE_CHANGED;
471 condition_case_1 (Qt,
472 call_command_loop, Qtop_level,
473 initial_error_handler, Qnil);
477 #endif /* LISP_COMMAND_LOOP */
480 /**********************************************************************/
481 /* Guts of command loop */
482 /**********************************************************************/
485 command_loop_1 (Lisp_Object dummy)
487 /* This function can GC */
488 /* #### not correct with Vselected_console */
489 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
490 return (Fcommand_loop_1 ());
493 /* This is the actual command reading loop, sans error-handling
494 encapsulation. This is used for both the C and Lisp command
495 loops. Originally this function was written in Lisp when
496 the Lisp command loop was used, but it was too slow that way.
498 Under the C command loop, this function will never return
499 (although someone might throw past it). Under the Lisp
500 command loop, this will return only when the user specifies
501 a new command loop by changing the command-loop variable. */
503 DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
504 Invoke the internals of the canonical editor command loop.
505 Don't call this unless you know what you're doing.
509 /* This function can GC */
510 Lisp_Object event = Fmake_event (Qnil, Qnil);
511 Lisp_Object old_loop = Qnil;
512 struct gcpro gcpro1, gcpro2;
513 int was_locked = in_single_console_state ();
514 GCPRO2 (event, old_loop);
516 /* cancel_echoing (); */
517 /* This magically makes single character keyboard macros work just
518 like the real thing. This is slightly bogus, but it's in here for
519 compatibility with Emacs 18. It's not even clear what the "right
521 if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
522 && XINT (Flength (Vexecuting_macro)) == 1))
525 #ifndef LISP_COMMAND_LOOP
528 old_loop = Vcommand_loop;
529 while (EQ (Vcommand_loop, old_loop))
530 #endif /* LISP_COMMAND_LOOP */
532 /* If focus_follows_mouse, make sure the frame with window manager
533 focus is selected. */
534 if (focus_follows_mouse)
535 investigate_frame_change ();
537 /* Make sure the current window's buffer is selected. */
539 Lisp_Object selected_window = Fselected_window (Qnil);
541 if (!NILP (selected_window) &&
542 (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
544 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
548 /* If ^G was typed before we got here (that is, before emacs was
549 idle and waiting for input) then we treat that as an interrupt. */
552 /* If minibuffer on and echo area in use, wait 2 sec and redraw
553 minibuffer. Treat a ^G here as a command, not an interrupt.
555 if (minibuf_level > 0 && echo_area_active (selected_frame ()))
557 /* Bind dont_check_for_quit to 1 so that C-g gets read in
558 rather than quitting back to the minibuffer. */
559 int count = specpdl_depth ();
560 begin_dont_check_for_quit ();
561 Fsit_for (make_int (2), Qnil);
562 clear_echo_area (selected_frame (), Qnil, 0);
563 unbind_to (count, Qnil);
566 Fnext_event (event, Qnil);
567 /* If ^G was typed while emacs was reading input from the user, then
568 Fnext_event() will have read it as a normal event and
569 next_event_internal() will have set Vquit_flag. We reset this
570 so that the ^G is treated as just another key. This is strange,
571 but it is what emacs 18 did.
573 Do not call check_quit() here. */
575 Fdispatch_event (event);
578 any_console_state ();
579 #if (defined (_MSC_VER) \
580 || defined (__SUNPRO_C) \
581 || defined (__SUNPRO_CC) \
582 || (defined (DEC_ALPHA) \
584 if (0) return Qnil; /* Shut up compiler */
587 #ifdef LISP_COMMAND_LOOP
594 /**********************************************************************/
596 /**********************************************************************/
599 syms_of_cmdloop (void)
601 defsymbol (&Qcommand_error, "command-error");
602 defsymbol (&Qreally_early_error_handler, "really-early-error-handler");
603 defsymbol (&Qtop_level, "top-level");
604 defsymbol (&Qerrors_deactivate_region, "errors-deactivate-region");
606 #ifndef LISP_COMMAND_LOOP
607 DEFSUBR (Frecursive_edit);
609 DEFSUBR (Freally_early_error_handler);
610 DEFSUBR (Fcommand_loop_1);
614 vars_of_cmdloop (void)
616 DEFVAR_INT ("command-loop-level", &command_loop_level /*
617 Number of recursive edits in progress.
619 command_loop_level = 0;
621 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
622 Value is called instead of any command that is disabled,
623 i.e. has a non-nil `disabled' property.
625 Vdisabled_command_hook = intern ("disabled-command-hook");
627 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
630 Vleave_window_hook = Qnil;
632 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
635 Venter_window_hook = Qnil;
637 #ifndef LISP_COMMAND_LOOP
638 DEFVAR_LISP ("top-level", &Vtop_level /*
639 Form to evaluate when Emacs starts up.
640 Useful to set before you dump a modified Emacs.
644 DEFVAR_LISP ("command-loop", &Vcommand_loop /*
645 Function or one argument to call to read and process keyboard commands.
646 The passed argument specifies whether or not to handle errors.
648 Vcommand_loop = Qnil;
649 #endif /* LISP_COMMAND_LOOP */