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 Fixnum 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 #ifdef HAVE_MS_WINDOWS
125 Fmswindows_message_box (build_string ("Initialization error"),
128 return Fkill_emacs (make_int (-1));
132 /**********************************************************************/
133 /* Command-loop (in C) */
134 /**********************************************************************/
136 #ifndef LISP_COMMAND_LOOP
138 /* The guts of the command loop are in command_loop_1(). This function
139 doesn't catch errors, though -- that's the job of command_loop_2(),
140 which is a condition-case wrapper around command_loop_1().
141 command_loop_1() never returns, but may get thrown out of.
143 When an error occurs, cmd_error() is called, which usually
144 invokes the Lisp error handler in `command-error'; however,
145 a default error handler is provided if `command-error' is nil
146 (e.g. during startup). The purpose of the error handler is
147 simply to display the error message and do associated cleanup;
148 it does not need to throw anywhere. When the error handler
149 finishes, the condition-case in command_loop_2() will finish and
150 command_loop_2() will reinvoke command_loop_1().
152 command_loop_2() is invoked from three places: from
153 initial_command_loop() (called from main() at the end of
154 internal initialization), from the Lisp function `recursive-edit',
155 and from call_command_loop().
157 call_command_loop() is called when a macro is started and when the
158 minibuffer is entered; normal termination of the macro or
159 minibuffer causes a throw out of the recursive command loop. (To
160 'execute-kbd-macro for macros and 'exit for minibuffers. Note also
161 that the low-level minibuffer-entering function,
162 `read-minibuffer-internal', provides its own error handling and
163 does not need command_loop_2()'s error encapsulation; so it tells
164 call_command_loop() to invoke command_loop_1() directly.)
166 Note that both read-minibuffer-internal and recursive-edit set
167 up a catch for 'exit; this is why `abort-recursive-edit', which
168 throws to this catch, exits out of either one.
170 initial_command_loop(), called from main(), sets up a catch
171 for 'top-level when invoking command_loop_2(), allowing functions
172 to throw all the way to the top level if they really need to.
173 Before invoking command_loop_2(), initial_command_loop() calls
174 top_level_1(), which handles all of the startup stuff (creating
175 the initial frame, handling the command-line options, loading
176 the user's .emacs file, etc.). The function that actually does this
177 is in Lisp and is pointed to by the variable `top-level';
178 normally this function is `normal-top-level'. top_level_1() is
179 just an error-handling wrapper similar to command_loop_2().
180 Note also that initial_command_loop() sets up a catch for 'top-level
181 when invoking top_level_1(), just like when it invokes
186 cmd_error (Lisp_Object data, Lisp_Object dummy)
188 /* This function can GC */
189 check_quit (); /* make Vquit_flag accurate */
192 any_console_state ();
194 if (!NILP (Ffboundp (Qcommand_error)))
195 return call1 (Qcommand_error, data);
197 return default_error_handler (data);
201 top_level_1 (Lisp_Object dummy)
203 /* This function can GC */
204 /* On entry to the outer level, run the startup file */
205 if (!NILP (Vtop_level))
206 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
210 message ("\ntemacs can only be run in -batch mode.");
211 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
212 Fkill_emacs (make_int (-1));
215 else if (purify_flag)
216 message ("Bare impure Emacs (standard Lisp code not loaded)");
218 message ("Bare Emacs (standard Lisp code not loaded)");
224 /* Here we catch errors in execution of commands within the
225 editing loop, and reenter the editing loop.
226 When there is an error, cmd_error runs and the call
227 to condition_case_1() returns. */
229 /* Avoid confusing the compiler. A helper function for command_loop_2 */
231 command_loop_3 (void)
233 #ifdef LWLIB_MENUBARS_LUCID
234 extern int in_menu_callback; /* defined in menubar-x.c */
235 #endif /* LWLIB_MENUBARS_LUCID */
237 #ifdef LWLIB_MENUBARS_LUCID
239 * #### Fix the menu code so this isn't necessary.
241 * We cannot allow the lwmenu code to be reentered, because the
242 * code is not written to be reentrant and will crash. Therefore
243 * paths from the menu callbacks back into the menu code have to
244 * be blocked. Fnext_event is the normal path into the menu code,
245 * but waiting to signal an error there is too late in case where
246 * a new command loop has been started. The error will be caught
247 * and Fnext_event will be called again, looping forever. So we
248 * signal an error here to avoid the loop.
250 if (in_menu_callback)
251 error ("Attempt to enter command_loop_3 inside menu callback");
252 #endif /* LWLIB_MENUBARS_LUCID */
253 /* This function can GC */
256 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
257 /* #### wrong with selected-console? */
258 /* See command in initial_command_loop about why this value
260 reset_this_command_keys (Vselected_console, 0);
265 command_loop_2 (Lisp_Object dummy)
267 command_loop_3(); /* doesn't return */
271 /* This is called from emacs.c when it's done with initialization. */
274 initial_command_loop (Lisp_Object load_me)
276 /* This function can GC */
278 Vtop_level = list2 (Qload, load_me);
280 /* First deal with startup and command-line arguments. A throw
281 to 'top-level gets us back here directly (does this ever happen?).
282 Otherwise, this function will return normally when all command-
283 line arguments have been processed, the user's initialization
284 file has been read in, and the first frame has been created. */
285 internal_catch (Qtop_level, top_level_1, Qnil, 0);
287 /* If an error occurred during startup and the initial console
288 wasn't created, then die now (the error was already printed out
289 on the terminal device). */
290 if (!noninteractive &&
291 (!CONSOLEP (Vselected_console) ||
292 CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
293 Fkill_emacs (make_int (-1));
295 /* End of -batch run causes exit here. */
301 command_loop_level = 0;
302 MARK_MODELINE_CHANGED;
303 /* Now invoke the command loop. It never returns; however, a
304 throw to 'top-level will place us at the end of this loop. */
305 internal_catch (Qtop_level, command_loop_2, Qnil, 0);
306 /* #### wrong with selected-console? */
307 /* We don't actually call clear_echo_area() here, partially
308 at least because that runs Lisp code and it may be unsafe
309 to do so -- we are outside of the normal catches for
311 reset_this_command_keys (Vselected_console, 0);
315 /* This function is invoked when a macro or minibuffer starts up.
316 Normal termination of the macro or minibuffer causes a throw past us.
317 See the comment above.
319 Note that this function never returns (but may be thrown out of). */
322 call_command_loop (Lisp_Object catch_errors)
324 /* This function can GC */
325 if (NILP (catch_errors))
326 return (command_loop_1 (Qnil));
328 return (command_loop_2 (Qnil));
332 recursive_edit_unwind (Lisp_Object buffer)
335 Fset_buffer (buffer);
337 command_loop_level--;
338 MARK_MODELINE_CHANGED;
343 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
344 Invoke the editor command loop recursively.
345 To get out of the recursive edit, a command can do `(throw 'exit nil)';
346 that tells this function to return.
347 Alternately, `(throw 'exit t)' makes this function signal an error.
351 /* This function can GC */
353 int speccount = specpdl_depth ();
355 command_loop_level++;
356 MARK_MODELINE_CHANGED;
358 record_unwind_protect (recursive_edit_unwind,
360 != XBUFFER (XWINDOW (Fselected_window
365 specbind (Qstandard_output, Qt);
366 specbind (Qstandard_input, Qt);
368 val = internal_catch (Qexit, command_loop_2, Qnil, 0);
371 /* Turn abort-recursive-edit into a quit. */
372 Fsignal (Qquit, Qnil);
374 return unbind_to (speccount, Qnil);
377 #endif /* !LISP_COMMAND_LOOP */
380 /**********************************************************************/
381 /* Alternate command-loop (largely in Lisp) */
382 /**********************************************************************/
384 #ifdef LISP_COMMAND_LOOP
387 load1 (Lisp_Object name)
389 /* This function can GC */
390 call4 (Qload, name, Qnil, Qt, Qnil);
394 /* emergency backups for cold-load-stream use */
396 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
398 /* This function can GC */
399 check_quit (); /* make Vquit_flag accurate */
402 return default_error_handler (datum);
406 cold_load_command_loop (Lisp_Object dummy)
408 /* This function can GC */
409 return (condition_case_1 (Qt,
410 command_loop_1, Qnil,
411 cold_load_command_error, Qnil));
415 call_command_loop (Lisp_Object catch_errors)
417 /* This function can GC */
418 reset_this_command_keys (Vselected_console, 0); /* #### bleagh */
423 if (NILP (Vcommand_loop))
425 call1 (Vcommand_loop, catch_errors);
428 /* This isn't a "correct" definition, but you're pretty hosed if
429 you broke "command-loop" anyway */
430 /* #### not correct with Vselected_console */
431 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
432 if (NILP (catch_errors))
435 internal_catch (Qtop_level,
436 cold_load_command_loop, Qnil, 0);
442 initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
444 /* This function can GC */
445 Vcommand_loop = Qnil;
446 Fding (Qnil, Qnil, Qnil);
448 if (CONSP (datum) && EQ (XCAR (datum), Qquit))
449 /* Don't bother with the message */
452 message ("Error in command-loop!!");
453 Fset (intern ("last-error"), datum); /* #### Better/different name? */
454 Fsit_for (make_int (2), Qnil);
455 cold_load_command_error (datum, Qnil);
460 initial_command_loop (Lisp_Object load_me)
462 /* This function can GC */
465 if (!NILP (condition_case_1 (Qt, load1, load_me,
466 initial_error_handler, Qnil)))
467 Fkill_emacs (make_int (-1));
472 command_loop_level = 0;
473 MARK_MODELINE_CHANGED;
475 condition_case_1 (Qt,
476 call_command_loop, Qtop_level,
477 initial_error_handler, Qnil);
481 #endif /* LISP_COMMAND_LOOP */
484 /**********************************************************************/
485 /* Guts of command loop */
486 /**********************************************************************/
489 command_loop_1 (Lisp_Object dummy)
491 /* This function can GC */
492 /* #### not correct with Vselected_console */
493 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
494 return (Fcommand_loop_1 ());
497 /* This is the actual command reading loop, sans error-handling
498 encapsulation. This is used for both the C and Lisp command
499 loops. Originally this function was written in Lisp when
500 the Lisp command loop was used, but it was too slow that way.
502 Under the C command loop, this function will never return
503 (although someone might throw past it). Under the Lisp
504 command loop, this will return only when the user specifies
505 a new command loop by changing the command-loop variable. */
507 DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
508 Invoke the internals of the canonical editor command loop.
509 Don't call this unless you know what you're doing.
513 /* This function can GC */
514 Lisp_Object event = Fmake_event (Qnil, Qnil);
515 Lisp_Object old_loop = Qnil;
516 struct gcpro gcpro1, gcpro2;
517 int was_locked = in_single_console_state ();
518 GCPRO2 (event, old_loop);
520 /* cancel_echoing (); */
521 /* This magically makes single character keyboard macros work just
522 like the real thing. This is slightly bogus, but it's in here for
523 compatibility with Emacs 18. It's not even clear what the "right
525 if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
526 && XINT (Flength (Vexecuting_macro)) == 1))
529 #ifndef LISP_COMMAND_LOOP
532 old_loop = Vcommand_loop;
533 while (EQ (Vcommand_loop, old_loop))
534 #endif /* LISP_COMMAND_LOOP */
536 /* If focus_follows_mouse, make sure the frame with window manager
537 focus is selected. */
538 if (focus_follows_mouse)
539 investigate_frame_change ();
541 /* Make sure the current window's buffer is selected. */
543 Lisp_Object selected_window = Fselected_window (Qnil);
545 if (!NILP (selected_window) &&
546 (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
548 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
552 #if 0 /* What's wrong with going through ordinary procedure of quit?
553 quitting here leaves overriding-terminal-local-map
554 when you type C-u C-u C-g. */
555 /* If ^G was typed before we got here (that is, before emacs was
556 idle and waiting for input) then we treat that as an interrupt. */
560 /* If minibuffer on and echo area in use, wait 2 sec and redraw
561 minibuffer. Treat a ^G here as a command, not an interrupt.
563 if (minibuf_level > 0 && echo_area_active (selected_frame ()))
565 /* Bind dont_check_for_quit to 1 so that C-g gets read in
566 rather than quitting back to the minibuffer. */
567 int count = specpdl_depth ();
568 begin_dont_check_for_quit ();
569 Fsit_for (make_int (2), Qnil);
570 clear_echo_area (selected_frame (), Qnil, 0);
571 unbind_to (count, Qnil);
574 Fnext_event (event, Qnil);
575 /* If ^G was typed while emacs was reading input from the user, then
576 Fnext_event() will have read it as a normal event and
577 next_event_internal() will have set Vquit_flag. We reset this
578 so that the ^G is treated as just another key. This is strange,
579 but it is what emacs 18 did.
581 Do not call check_quit() here. */
583 Fdispatch_event (event);
586 any_console_state ();
587 #if (defined (_MSC_VER) \
588 || defined (__SUNPRO_C) \
589 || defined (__SUNPRO_CC) \
590 || (defined (DEC_ALPHA) \
592 if (0) return Qnil; /* Shut up compiler */
595 #ifdef LISP_COMMAND_LOOP
602 /**********************************************************************/
604 /**********************************************************************/
607 syms_of_cmdloop (void)
609 defsymbol (&Qcommand_error, "command-error");
610 defsymbol (&Qreally_early_error_handler, "really-early-error-handler");
611 defsymbol (&Qtop_level, "top-level");
612 defsymbol (&Qerrors_deactivate_region, "errors-deactivate-region");
614 #ifndef LISP_COMMAND_LOOP
615 DEFSUBR (Frecursive_edit);
617 DEFSUBR (Freally_early_error_handler);
618 DEFSUBR (Fcommand_loop_1);
622 vars_of_cmdloop (void)
624 DEFVAR_INT ("command-loop-level", &command_loop_level /*
625 Number of recursive edits in progress.
627 command_loop_level = 0;
629 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
630 Value is called instead of any command that is disabled,
631 i.e. has a non-nil `disabled' property.
633 Vdisabled_command_hook = intern ("disabled-command-hook");
635 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
638 Vleave_window_hook = Qnil;
640 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
643 Venter_window_hook = Qnil;
645 #ifndef LISP_COMMAND_LOOP
646 DEFVAR_LISP ("top-level", &Vtop_level /*
647 Form to evaluate when Emacs starts up.
648 Useful to set before you dump a modified Emacs.
652 DEFVAR_LISP ("command-loop", &Vcommand_loop /*
653 Function or one argument to call to read and process keyboard commands.
654 The passed argument specifies whether or not to handle errors.
656 Vcommand_loop = Qnil;
657 #endif /* LISP_COMMAND_LOOP */