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 SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Mule 2.0. Not synched with FSF.
22 This was renamed from keyboard.c. However, it only contains the
23 command-loop stuff from FSF's keyboard.c; all the rest is in
24 event*.c, console.c, or signal.c. */
26 /* #### This module purports to separate out the command-loop stuff
27 from event-stream.c, but it doesn't really. Perhaps this file
28 should just be merged into event-stream.c, given its shortness. */
36 #include "events/events.h"
37 #include "ui/window.h"
39 /* Current depth in recursive edits. */
40 Fixnum command_loop_level;
42 #ifndef LISP_COMMAND_LOOP
43 /* Form to evaluate (if non-nil) when Emacs is started. */
44 Lisp_Object Vtop_level;
46 /* Function to call to evaluate to read and process events. */
47 Lisp_Object Vcommand_loop;
48 #endif /* LISP_COMMAND_LOOP */
50 Lisp_Object Venter_window_hook, Vleave_window_hook;
52 /* The error handler. */
53 Lisp_Object Qcommand_error;
55 /* The emergency error handler, before we're ready. */
56 Lisp_Object Qreally_early_error_handler;
58 /* Variable defined in Lisp. */
59 Lisp_Object Qerrors_deactivate_region;
61 Lisp_Object Qtop_level;
63 static Lisp_Object command_loop_1(Lisp_Object dummy);
64 EXFUN(Fcommand_loop_1, 0);
66 /* There are two possible command loops -- one written entirely in
67 C and one written mostly in Lisp, except stuff written in C for
68 speed. The advantage of the Lisp command loop is that the user
69 can specify their own command loop to use by changing the variable
70 `command-loop'. Its disadvantage is that it's slow. */
72 static Lisp_Object default_error_handler(Lisp_Object data)
74 int speccount = specpdl_depth();
76 /* None of this is invoked, normally. This code is almost identical
77 to the `command-error' function, except `command-error' does cool
78 tricks with sounds. This function is a fallback, invoked if
79 command-error is unavailable. */
81 Fding(Qnil, Qnil, Qnil);
83 if (!NILP(Fboundp(Qerrors_deactivate_region))
84 && !NILP(Fsymbol_value(Qerrors_deactivate_region)))
85 zmacs_deactivate_region();
87 specbind(Qinhibit_quit, Qt);
88 Vstandard_output = Qt;
90 Vexecuting_macro = Qnil;
91 Fset(intern("last-error"), data);
92 clear_echo_area(selected_frame(), Qnil, 0);
93 Fdisplay_error(data, Qt);
94 check_quit(); /* make Vquit_flag accurate */
96 return (unbind_to(speccount, Qt));
99 DEFUN("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /*
100 You should almost certainly not be using this.
104 /* This is an error handler used when we're running temacs and when
105 we're in the early stages of SXEmacs. No errors ought to be
106 occurring in those cases (or they ought to be trapped and
107 dealt with elsewhere), but if an error slips through, we need
108 to deal with it. We could write this function in Lisp (and it
109 used to be this way, at the beginning of loadup.el), but we do
110 it this way in case an error occurs before we get to loading
111 loadup.el. Note that there is also an `early-error-handler',
112 used in startup.el to catch more reasonable errors that
113 might occur during startup if the sysadmin or whoever fucked
114 up. This function is more conservative in what it does
115 and is used only as a last resort, indicating that the
116 programmer himself fucked up somewhere. */
117 stderr_out("*** Error in SXEmacs initialization");
118 Fprint(x, Qexternal_debugging_output);
119 stderr_out("*** Backtrace\n");
120 Fbacktrace(Qexternal_debugging_output, Qt);
121 stderr_out("*** Killing SXEmacs\n");
122 return Fkill_emacs(make_int(-1));
125 /**********************************************************************/
126 /* Command-loop (in C) */
127 /**********************************************************************/
129 #ifndef LISP_COMMAND_LOOP
131 /* The guts of the command loop are in command_loop_1(). This function
132 doesn't catch errors, though -- that's the job of command_loop_2(),
133 which is a condition-case wrapper around command_loop_1().
134 command_loop_1() never returns, but may get thrown out of.
136 When an error occurs, cmd_error() is called, which usually
137 invokes the Lisp error handler in `command-error'; however,
138 a default error handler is provided if `command-error' is nil
139 (e.g. during startup). The purpose of the error handler is
140 simply to display the error message and do associated cleanup;
141 it does not need to throw anywhere. When the error handler
142 finishes, the condition-case in command_loop_2() will finish and
143 command_loop_2() will reinvoke command_loop_1().
145 command_loop_2() is invoked from three places: from
146 initial_command_loop() (called from main() at the end of
147 internal initialization), from the Lisp function `recursive-edit',
148 and from call_command_loop().
150 call_command_loop() is called when a macro is started and when the
151 minibuffer is entered; normal termination of the macro or
152 minibuffer causes a throw out of the recursive command loop. (To
153 'execute-kbd-macro for macros and 'exit for minibuffers. Note also
154 that the low-level minibuffer-entering function,
155 `read-minibuffer-internal', provides its own error handling and
156 does not need command_loop_2()'s error encapsulation; so it tells
157 call_command_loop() to invoke command_loop_1() directly.)
159 Note that both read-minibuffer-internal and recursive-edit set
160 up a catch for 'exit; this is why `abort-recursive-edit', which
161 throws to this catch, exits out of either one.
163 initial_command_loop(), called from main(), sets up a catch
164 for 'top-level when invoking command_loop_2(), allowing functions
165 to throw all the way to the top level if they really need to.
166 Before invoking command_loop_2(), initial_command_loop() calls
167 top_level_1(), which handles all of the startup stuff (creating
168 the initial frame, handling the command-line options, loading
169 the user's .emacs file, etc.). The function that actually does this
170 is in Lisp and is pointed to by the variable `top-level';
171 normally this function is `normal-top-level'. top_level_1() is
172 just an error-handling wrapper similar to command_loop_2().
173 Note also that initial_command_loop() sets up a catch for 'top-level
174 when invoking top_level_1(), just like when it invokes
177 static Lisp_Object cmd_error(Lisp_Object data, Lisp_Object dummy)
179 /* This function can GC */
180 check_quit(); /* make Vquit_flag accurate */
185 if (!NILP(Ffboundp(Qcommand_error)))
186 return call1(Qcommand_error, data);
188 return default_error_handler(data);
191 static Lisp_Object top_level_1(Lisp_Object dummy)
193 /* This function can GC */
194 /* On entry to the outer level, run the startup file */
195 if (!NILP(Vtop_level))
196 condition_case_1(Qerror, Feval, Vtop_level, cmd_error, Qnil);
199 message("\ntemacs can only be run in -batch mode.");
200 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
201 Fkill_emacs(make_int(-1));
204 else if (purify_flag)
205 message("Bare impure Emacs (standard Lisp code not loaded)");
207 message("Bare Emacs (standard Lisp code not loaded)");
213 /* Here we catch errors in execution of commands within the
214 editing loop, and reenter the editing loop.
215 When there is an error, cmd_error runs and the call
216 to condition_case_1() returns. */
218 /* Avoid confusing the compiler. A helper function for command_loop_2 */
219 static DOESNT_RETURN command_loop_3(void)
221 #ifdef LWLIB_MENUBARS_LUCID
222 extern int in_menu_callback; /* defined in menubar-x.c */
223 #endif /* LWLIB_MENUBARS_LUCID */
225 #ifdef LWLIB_MENUBARS_LUCID
227 * #### Fix the menu code so this isn't necessary.
229 * We cannot allow the lwmenu code to be reentered, because the
230 * code is not written to be reentrant and will crash. Therefore
231 * paths from the menu callbacks back into the menu code have to
232 * be blocked. Fnext_event is the normal path into the menu code,
233 * but waiting to signal an error there is too late in case where
234 * a new command loop has been started. The error will be caught
235 * and Fnext_event will be called again, looping forever. So we
236 * signal an error here to avoid the loop.
238 if (in_menu_callback)
239 error("Attempt to enter command_loop_3 inside menu callback");
240 #endif /* LWLIB_MENUBARS_LUCID */
241 /* This function can GC */
243 condition_case_1(Qerror, command_loop_1, Qnil, cmd_error, Qnil);
244 /* #### wrong with selected-console? */
245 /* See command in initial_command_loop about why this value
247 reset_this_command_keys(Vselected_console, 0);
251 static Lisp_Object command_loop_2(Lisp_Object dummy)
253 command_loop_3(); /* doesn't return */
257 /* This is called from emacs.c when it's done with initialization. */
259 DOESNT_RETURN initial_command_loop(Lisp_Object load_me)
261 /* This function can GC */
262 if (!NILP(load_me)) {
263 Vtop_level = list2(Qload, load_me);
266 /* First deal with startup and command-line arguments. A throw
267 to 'top-level gets us back here directly (does this ever happen?).
268 Otherwise, this function will return normally when all command-
269 line arguments have been processed, the user's initialization
270 file has been read in, and the first frame has been created. */
271 internal_catch(Qtop_level, top_level_1, Qnil, 0);
273 /* If an error occurred during startup and the initial console
274 wasn't created, then die now (the error was already printed out
275 on the terminal device). */
276 if (!noninteractive &&
277 (!CONSOLEP(Vselected_console) ||
278 CONSOLE_STREAM_P(XCONSOLE(Vselected_console)))) {
279 fprintf(stderr, "ni:%d CONSP(Vsel):%d CONSSTRP(XCONS(...)):%d\n",
281 CONSOLEP(Vselected_console),
282 CONSOLE_STREAM_P(XCONSOLE(Vselected_console)));
283 Fprin1(Vselected_console, Qnil);
284 Fkill_emacs(make_int(-1));
287 /* End of -batch run causes exit here. */
292 command_loop_level = 0;
293 MARK_MODELINE_CHANGED;
294 /* Now invoke the command loop. It never returns; however, a
295 throw to 'top-level will place us at the end of this loop. */
296 internal_catch(Qtop_level, command_loop_2, Qnil, 0);
297 /* #### wrong with selected-console? */
298 /* We don't actually call clear_echo_area() here, partially
299 at least because that runs Lisp code and it may be unsafe
300 to do so -- we are outside of the normal catches for
302 reset_this_command_keys(Vselected_console, 0);
306 /* This function is invoked when a macro or minibuffer starts up.
307 Normal termination of the macro or minibuffer causes a throw past us.
308 See the comment above.
310 Note that this function never returns (but may be thrown out of). */
312 Lisp_Object call_command_loop(Lisp_Object catch_errors)
314 /* This function can GC */
315 if (NILP(catch_errors))
316 return (command_loop_1(Qnil));
318 return (command_loop_2(Qnil));
321 static Lisp_Object recursive_edit_unwind(Lisp_Object buffer)
326 command_loop_level--;
327 MARK_MODELINE_CHANGED;
332 DEFUN("recursive-edit", Frecursive_edit, 0, 0, "", /*
333 Invoke the editor command loop recursively.
334 To get out of the recursive edit, a command can do `(throw 'exit nil)';
335 that tells this function to return.
336 Alternately, `(throw 'exit t)' makes this function signal an error.
340 /* This function can GC */
342 int speccount = specpdl_depth();
344 command_loop_level++;
345 MARK_MODELINE_CHANGED;
348 Lisp_Object tmp = Fselected_window(Qnil);
349 record_unwind_protect(recursive_edit_unwind,
351 XBUFFER(XWINDOW(tmp)->buffer))
356 specbind(Qstandard_output, Qt);
357 specbind(Qstandard_input, Qt);
359 val = internal_catch(Qexit, command_loop_2, Qnil, 0);
362 /* Turn abort-recursive-edit into a quit. */
363 Fsignal(Qquit, Qnil);
365 return unbind_to(speccount, Qnil);
368 #endif /* !LISP_COMMAND_LOOP */
370 /**********************************************************************/
371 /* Alternate command-loop (largely in Lisp) */
372 /**********************************************************************/
374 #ifdef LISP_COMMAND_LOOP
376 static Lisp_Object load1(Lisp_Object name)
378 /* This function can GC */
379 call4(Qload, name, Qnil, Qt, Qnil);
383 /* emergency backups for cold-load-stream use */
385 cold_load_command_error(Lisp_Object datum, Lisp_Object ignored)
387 /* This function can GC */
388 check_quit(); /* make Vquit_flag accurate */
391 return default_error_handler(datum);
394 static Lisp_Object cold_load_command_loop(Lisp_Object dummy)
396 /* This function can GC */
397 return (condition_case_1(Qt,
398 command_loop_1, Qnil,
399 cold_load_command_error, Qnil));
402 Lisp_Object call_command_loop(Lisp_Object catch_errors)
404 /* This function can GC */
405 reset_this_command_keys(Vselected_console, 0); /* #### bleagh */
409 if (NILP(Vcommand_loop))
411 call1(Vcommand_loop, catch_errors);
414 /* This isn't a "correct" definition, but you're pretty hosed if
415 you broke "command-loop" anyway */
416 /* #### not correct with Vselected_console */
417 XCONSOLE(Vselected_console)->prefix_arg = Qnil;
418 if (NILP(catch_errors))
421 internal_catch(Qtop_level, cold_load_command_loop, Qnil, 0);
426 static Lisp_Object initial_error_handler(Lisp_Object datum, Lisp_Object ignored)
428 /* This function can GC */
429 Vcommand_loop = Qnil;
430 Fding(Qnil, Qnil, Qnil);
432 if (CONSP(datum) && EQ(XCAR(datum), Qquit))
433 /* Don't bother with the message */
436 message("Error in command-loop!!");
437 Fset(intern("last-error"), datum); /* #### Better/different name? */
438 Fsit_for(make_int(2), Qnil);
439 cold_load_command_error(datum, Qnil);
443 DOESNT_RETURN initial_command_loop(Lisp_Object load_me)
445 /* This function can GC */
446 if (!NILP(load_me)) {
447 if (!NILP(condition_case_1(Qt, load1, load_me,
448 initial_error_handler, Qnil)))
449 Fkill_emacs(make_int(-1));
453 command_loop_level = 0;
454 MARK_MODELINE_CHANGED;
457 call_command_loop, Qtop_level,
458 initial_error_handler, Qnil);
462 #endif /* LISP_COMMAND_LOOP */
464 /**********************************************************************/
465 /* Guts of command loop */
466 /**********************************************************************/
468 static Lisp_Object command_loop_1(Lisp_Object dummy)
470 /* This function can GC */
471 /* #### not correct with Vselected_console */
472 XCONSOLE(Vselected_console)->prefix_arg = Qnil;
473 return (Fcommand_loop_1());
476 /* This is the actual command reading loop, sans error-handling
477 encapsulation. This is used for both the C and Lisp command
478 loops. Originally this function was written in Lisp when
479 the Lisp command loop was used, but it was too slow that way.
481 Under the C command loop, this function will never return
482 (although someone might throw past it). Under the Lisp
483 command loop, this will return only when the user specifies
484 a new command loop by changing the command-loop variable. */
486 DEFUN("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
487 Invoke the internals of the canonical editor command loop.
488 Don't call this unless you know what you're doing.
492 /* This function can GC */
493 Lisp_Object event = Fmake_event(Qnil, Qnil);
494 #if defined LISP_COMMAND_LOOP || !defined HAVE_BDWGC || !defined EF_USE_BDWGC
495 Lisp_Object old_loop = Qnil;
497 struct gcpro gcpro1, gcpro2;
498 int was_locked = in_single_console_state();
499 GCPRO2(event, old_loop);
501 /* cancel_echoing (); */
502 /* This magically makes single character keyboard macros work just
503 like the real thing. This is slightly bogus, but it's in here for
504 compatibility with Emacs 18. It's not even clear what the "right
506 if (!((STRINGP(Vexecuting_macro) || VECTORP(Vexecuting_macro))
507 && XINT(Flength(Vexecuting_macro)) == 1))
510 #ifndef LISP_COMMAND_LOOP
513 old_loop = Vcommand_loop;
514 while (EQ(Vcommand_loop, old_loop))
515 #endif /* LISP_COMMAND_LOOP */
517 /* If focus_follows_mouse, make sure the frame with window manager
518 focus is selected. */
519 if (focus_follows_mouse)
520 investigate_frame_change();
522 /* Make sure the current window's buffer is selected. */
524 Lisp_Object selected_window = Fselected_window(Qnil);
526 if (!NILP(selected_window) &&
527 (XBUFFER(XWINDOW(selected_window)->buffer) !=
529 set_buffer_internal(XBUFFER
530 (XWINDOW(selected_window)->
535 #if 0 /* What's wrong with going through ordinary procedure of quit?
536 quitting here leaves overriding-terminal-local-map
537 when you type C-u C-u C-g. */
538 /* If ^G was typed before we got here (that is, before emacs was
539 idle and waiting for input) then we treat that as an interrupt. */
543 /* If minibuffer on and echo area in use, wait 2 sec and redraw
544 minibuffer. Treat a ^G here as a command, not an interrupt.
546 if (minibuf_level > 0 && echo_area_active(selected_frame())) {
547 /* Bind dont_check_for_quit to 1 so that C-g gets read in
548 rather than quitting back to the minibuffer. */
549 int count = specpdl_depth();
550 begin_dont_check_for_quit();
551 Fsit_for(make_int(2), Qnil);
552 clear_echo_area(selected_frame(), Qnil, 0);
553 unbind_to(count, Qnil);
556 Fnext_event(event, Qnil);
557 /* If ^G was typed while emacs was reading input from the user, then
558 Fnext_event() will have read it as a normal event and
559 next_event_internal() will have set Vquit_flag. We reset this
560 so that the ^G is treated as just another key. This is strange,
561 but it is what emacs 18 did.
563 Do not call check_quit() here. */
565 Fdispatch_event(event);
569 #if (defined (__SUNPRO_C) \
570 || defined (__SUNPRO_CC) \
571 || (defined(DEC_ALPHA) && defined(OSF1)))
573 return Qnil; /* Shut up compiler */
576 #ifdef LISP_COMMAND_LOOP
584 /**********************************************************************/
586 /**********************************************************************/
588 void syms_of_cmdloop(void)
590 defsymbol(&Qcommand_error, "command-error");
591 defsymbol(&Qreally_early_error_handler, "really-early-error-handler");
592 defsymbol(&Qtop_level, "top-level");
593 defsymbol(&Qerrors_deactivate_region, "errors-deactivate-region");
595 #ifndef LISP_COMMAND_LOOP
596 DEFSUBR(Frecursive_edit);
598 DEFSUBR(Freally_early_error_handler);
599 DEFSUBR(Fcommand_loop_1);
602 void vars_of_cmdloop(void)
604 DEFVAR_INT("command-loop-level", &command_loop_level /*
605 Number of recursive edits in progress.
607 command_loop_level = 0;
609 DEFVAR_LISP("disabled-command-hook", &Vdisabled_command_hook /*
610 Value is called instead of any command that is disabled,
611 i.e. has a non-nil `disabled' property.
613 Vdisabled_command_hook = intern("disabled-command-hook");
615 DEFVAR_LISP("leave-window-hook", &Vleave_window_hook /*
618 Vleave_window_hook = Qnil;
620 DEFVAR_LISP("enter-window-hook", &Venter_window_hook /*
623 Venter_window_hook = Qnil;
625 #ifndef LISP_COMMAND_LOOP
626 DEFVAR_LISP("top-level", &Vtop_level /*
627 Form to evaluate when Emacs starts up.
628 Useful to set before you dump a modified Emacs.
632 DEFVAR_LISP("command-loop", &Vcommand_loop /*
633 Function or one argument to call to read and process keyboard commands.
634 The passed argument specifies whether or not to handle errors.
636 Vcommand_loop = Qnil;
637 #endif /* LISP_COMMAND_LOOP */