annotate src/cmdloop.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents a5954632b187
children 79c6ff3eef26
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Editor command loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
3 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0. Not synched with FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 This was renamed from keyboard.c. However, it only contains the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 command-loop stuff from FSF's keyboard.c; all the rest is in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 event*.c, console.c, or signal.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* #### This module purports to separate out the command-loop stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 from event-stream.c, but it doesn't really. Perhaps this file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 should just be merged into event-stream.c, given its shortness. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "buffer.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 771
diff changeset
35 #include "device.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "commands.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 /* Current depth in recursive edits. */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 444
diff changeset
42 Fixnum command_loop_level;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #ifndef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 /* Form to evaluate (if non-nil) when Emacs is started. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Lisp_Object Vtop_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 /* Function to call to evaluate to read and process events. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Lisp_Object Vcommand_loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #endif /* LISP_COMMAND_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Lisp_Object Venter_window_hook, Vleave_window_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
733
b1f74adcc1ff [xemacs-hg @ 2002-01-22 20:40:00 by janv]
janv
parents: 563
diff changeset
54 Lisp_Object Qdisabled_command_hook, Vdisabled_command_hook;
b1f74adcc1ff [xemacs-hg @ 2002-01-22 20:40:00 by janv]
janv
parents: 563
diff changeset
55
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* The error handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Qcommand_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 /* The emergency error handler, before we're ready. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Lisp_Object Qreally_early_error_handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* Variable defined in Lisp. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Qerrors_deactivate_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Lisp_Object Qtop_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 static Lisp_Object command_loop_1 (Lisp_Object dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 EXFUN (Fcommand_loop_1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* There are two possible command loops -- one written entirely in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 C and one written mostly in Lisp, except stuff written in C for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 speed. The advantage of the Lisp command loop is that the user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 can specify their own command loop to use by changing the variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 `command-loop'. Its disadvantage is that it's slow. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 default_error_handler (Lisp_Object data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 /* None of this is invoked, normally. This code is almost identical
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 to the `command-error' function, except `command-error' does cool
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 tricks with sounds. This function is a fallback, invoked if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 command-error is unavailable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Fding (Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 if (!NILP (Fboundp (Qerrors_deactivate_region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 && !NILP (Fsymbol_value (Qerrors_deactivate_region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 zmacs_deactivate_region ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Fdiscard_input ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 specbind (Qinhibit_quit, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Vstandard_output = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Vstandard_input = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Vexecuting_macro = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Fset (intern ("last-error"), data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 clear_echo_area (selected_frame (), Qnil, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Fdisplay_error (data, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Vquit_flag = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 733
diff changeset
101 return (unbind_to_1 (speccount, Qt));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 You should almost certainly not be using this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 /* This is an error handler used when we're running temacs and when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 we're in the early stages of XEmacs. No errors ought to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 occurring in those cases (or they ought to be trapped and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 dealt with elsewhere), but if an error slips through, we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 to deal with it. We could write this function in Lisp (and it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 used to be this way, at the beginning of loadup.el), but we do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 it this way in case an error occurs before we get to loading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 loadup.el. Note that there is also an `early-error-handler',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 used in startup.el to catch more reasonable errors that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 might occur during startup if the sysadmin or whoever fucked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 up. This function is more conservative in what it does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 and is used only as a last resort, indicating that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 programmer himself fucked up somewhere. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 stderr_out ("*** Error in XEmacs initialization");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Fprint (x, Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 stderr_out ("*** Backtrace\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Fbacktrace (Qexternal_debugging_output, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 stderr_out ("*** Killing XEmacs\n");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
127 #ifdef HAVE_MS_WINDOWS
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 733
diff changeset
128 Fmswindows_message_box (build_msg_string ("Initialization error"),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
129 Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
130 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 return Fkill_emacs (make_int (-1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 /* Command-loop (in C) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 #ifndef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 /* The guts of the command loop are in command_loop_1(). This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 doesn't catch errors, though -- that's the job of command_loop_2(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 which is a condition-case wrapper around command_loop_1().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 command_loop_1() never returns, but may get thrown out of.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 When an error occurs, cmd_error() is called, which usually
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 invokes the Lisp error handler in `command-error'; however,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 a default error handler is provided if `command-error' is nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (e.g. during startup). The purpose of the error handler is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 simply to display the error message and do associated cleanup;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 it does not need to throw anywhere. When the error handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 finishes, the condition-case in command_loop_2() will finish and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 command_loop_2() will reinvoke command_loop_1().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 command_loop_2() is invoked from three places: from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 initial_command_loop() (called from main() at the end of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 internal initialization), from the Lisp function `recursive-edit',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 and from call_command_loop().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 call_command_loop() is called when a macro is started and when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 minibuffer is entered; normal termination of the macro or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 minibuffer causes a throw out of the recursive command loop. (To
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 'execute-kbd-macro for macros and 'exit for minibuffers. Note also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 that the low-level minibuffer-entering function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 `read-minibuffer-internal', provides its own error handling and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 does not need command_loop_2()'s error encapsulation; so it tells
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 call_command_loop() to invoke command_loop_1() directly.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Note that both read-minibuffer-internal and recursive-edit set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 up a catch for 'exit; this is why `abort-recursive-edit', which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 throws to this catch, exits out of either one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 initial_command_loop(), called from main(), sets up a catch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 for 'top-level when invoking command_loop_2(), allowing functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 to throw all the way to the top level if they really need to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 Before invoking command_loop_2(), initial_command_loop() calls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 top_level_1(), which handles all of the startup stuff (creating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 the initial frame, handling the command-line options, loading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 the user's .emacs file, etc.). The function that actually does this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 is in Lisp and is pointed to by the variable `top-level';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 normally this function is `normal-top-level'. top_level_1() is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 just an error-handling wrapper similar to command_loop_2().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Note also that initial_command_loop() sets up a catch for 'top-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 when invoking top_level_1(), just like when it invokes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 command_loop_2(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 cmd_error (Lisp_Object data, Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 any_console_state ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 if (!NILP (Ffboundp (Qcommand_error)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 return call1 (Qcommand_error, data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 return default_error_handler (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 top_level_1 (Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 /* On entry to the outer level, run the startup file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 if (!NILP (Vtop_level))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 message ("\ntemacs can only be run in -batch mode.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Fkill_emacs (make_int (-1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 else if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 message ("Bare impure Emacs (standard Lisp code not loaded)");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 message ("Bare Emacs (standard Lisp code not loaded)");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 /* Here we catch errors in execution of commands within the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 editing loop, and reenter the editing loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 When there is an error, cmd_error runs and the call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 to condition_case_1() returns. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 /* Avoid confusing the compiler. A helper function for command_loop_2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 static DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 command_loop_3 (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 #ifdef LWLIB_MENUBARS_LUCID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 extern int in_menu_callback; /* defined in menubar-x.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 #endif /* LWLIB_MENUBARS_LUCID */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 #ifdef LWLIB_MENUBARS_LUCID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 * #### Fix the menu code so this isn't necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 * We cannot allow the lwmenu code to be reentered, because the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 * code is not written to be reentrant and will crash. Therefore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 * paths from the menu callbacks back into the menu code have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 * be blocked. Fnext_event is the normal path into the menu code,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 * but waiting to signal an error there is too late in case where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 * a new command loop has been started. The error will be caught
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 * and Fnext_event will be called again, looping forever. So we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 * signal an error here to avoid the loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 if (in_menu_callback)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 479
diff changeset
254 invalid_operation ("Attempt to enter command_loop_3 inside menu callback", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 #endif /* LWLIB_MENUBARS_LUCID */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 /* #### wrong with selected-console? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 /* See command in initial_command_loop about why this value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 is 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 reset_this_command_keys (Vselected_console, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 command_loop_2 (Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 command_loop_3(); /* doesn't return */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 /* This is called from emacs.c when it's done with initialization. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 initial_command_loop (Lisp_Object load_me)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 if (!NILP (load_me))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Vtop_level = list2 (Qload, load_me);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 /* First deal with startup and command-line arguments. A throw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 to 'top-level gets us back here directly (does this ever happen?).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 Otherwise, this function will return normally when all command-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 line arguments have been processed, the user's initialization
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 file has been read in, and the first frame has been created. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
288 internal_catch (Qtop_level, top_level_1, Qnil, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 /* If an error occurred during startup and the initial console
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 wasn't created, then die now (the error was already printed out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 on the terminal device). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 if (!noninteractive &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (!CONSOLEP (Vselected_console) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 Fkill_emacs (make_int (-1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 /* End of -batch run causes exit here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 if (noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 Fkill_emacs (Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 command_loop_level = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 /* Now invoke the command loop. It never returns; however, a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 throw to 'top-level will place us at the end of this loop. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
308 internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 /* #### wrong with selected-console? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 /* We don't actually call clear_echo_area() here, partially
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 at least because that runs Lisp code and it may be unsafe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 to do so -- we are outside of the normal catches for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 errors and such. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 reset_this_command_keys (Vselected_console, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 /* This function is invoked when a macro or minibuffer starts up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 Normal termination of the macro or minibuffer causes a throw past us.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 See the comment above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 Note that this function never returns (but may be thrown out of). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 call_command_loop (Lisp_Object catch_errors)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 if (NILP (catch_errors))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 return (command_loop_1 (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 return (command_loop_2 (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 recursive_edit_unwind (Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 Fset_buffer (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 command_loop_level--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 Invoke the editor command loop recursively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 To get out of the recursive edit, a command can do `(throw 'exit nil)';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 that tells this function to return.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Alternately, `(throw 'exit t)' makes this function signal an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 command_loop_level++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 record_unwind_protect (recursive_edit_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 ((current_buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 != XBUFFER (XWINDOW (Fselected_window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (Qnil))->buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ? Fcurrent_buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 : Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 specbind (Qstandard_output, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 specbind (Qstandard_input, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
371 val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 if (EQ (val, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 /* Turn abort-recursive-edit into a quit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 Fsignal (Qquit, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 733
diff changeset
377 return unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 #endif /* !LISP_COMMAND_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 /* Alternate command-loop (largely in Lisp) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 #ifdef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 load1 (Lisp_Object name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 call4 (Qload, name, Qnil, Qt, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 return (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 /* emergency backups for cold-load-stream use */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 check_quit (); /* make Vquit_flag accurate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 Vquit_flag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 return default_error_handler (datum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 cold_load_command_loop (Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 return (condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 command_loop_1, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 cold_load_command_error, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 call_command_loop (Lisp_Object catch_errors)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 /* This function can GC */
479
52626a2f02ef [xemacs-hg @ 2001-04-20 11:31:53 by ben]
ben
parents: 458
diff changeset
421 reset_this_command_keys (Vselected_console, 0); /* #### bleagh */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 loop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (NILP (Vcommand_loop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 call1 (Vcommand_loop, catch_errors);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 /* This isn't a "correct" definition, but you're pretty hosed if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 you broke "command-loop" anyway */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 /* #### not correct with Vselected_console */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 if (NILP (catch_errors))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 Fcommand_loop_1 ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 internal_catch (Qtop_level,
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
439 cold_load_command_loop, Qnil, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 goto loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Vcommand_loop = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 Fding (Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 if (CONSP (datum) && EQ (XCAR (datum), Qquit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 /* Don't bother with the message */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 return (Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 message ("Error in command-loop!!");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 Fset (intern ("last-error"), datum); /* #### Better/different name? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 Fsit_for (make_int (2), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 cold_load_command_error (datum, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 return (Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 initial_command_loop (Lisp_Object load_me)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 if (!NILP (load_me))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 if (!NILP (condition_case_1 (Qt, load1, load_me,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 initial_error_handler, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Fkill_emacs (make_int (-1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 command_loop_level = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 MARK_MODELINE_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 condition_case_1 (Qt,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 call_command_loop, Qtop_level,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 initial_error_handler, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 #endif /* LISP_COMMAND_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 /* Guts of command loop */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 command_loop_1 (Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 /* #### not correct with Vselected_console */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 return (Fcommand_loop_1 ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 /* This is the actual command reading loop, sans error-handling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 encapsulation. This is used for both the C and Lisp command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 loops. Originally this function was written in Lisp when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 the Lisp command loop was used, but it was too slow that way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 Under the C command loop, this function will never return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (although someone might throw past it). Under the Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 command loop, this will return only when the user specifies
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 a new command loop by changing the command-loop variable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 Invoke the internals of the canonical editor command loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 Don't call this unless you know what you're doing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 Lisp_Object event = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 Lisp_Object old_loop = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 int was_locked = in_single_console_state ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 GCPRO2 (event, old_loop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 /* cancel_echoing (); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 /* This magically makes single character keyboard macros work just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 like the real thing. This is slightly bogus, but it's in here for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 compatibility with Emacs 18. It's not even clear what the "right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 thing" is. */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
528 if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
529 && XINT (Flength (Vexecuting_macro)) == 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 Vlast_command = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 #ifndef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 old_loop = Vcommand_loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 while (EQ (Vcommand_loop, old_loop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 #endif /* LISP_COMMAND_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 /* If focus_follows_mouse, make sure the frame with window manager
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 focus is selected. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 if (focus_follows_mouse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 investigate_frame_change ();
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
543
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /* Make sure the current window's buffer is selected. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 Lisp_Object selected_window = Fselected_window (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 if (!NILP (selected_window) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
555 #if 0 /* What's wrong with going through ordinary procedure of quit?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
556 quitting here leaves overriding-terminal-local-map
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
557 when you type C-u C-u C-g. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 /* If ^G was typed before we got here (that is, before emacs was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 idle and waiting for input) then we treat that as an interrupt. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 QUIT;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
561 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 /* If minibuffer on and echo area in use, wait 2 sec and redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 minibuffer. Treat a ^G here as a command, not an interrupt.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 if (minibuf_level > 0 && echo_area_active (selected_frame ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 /* Bind dont_check_for_quit to 1 so that C-g gets read in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 rather than quitting back to the minibuffer. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 733
diff changeset
570 int count = begin_dont_check_for_quit ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 Fsit_for (make_int (2), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 clear_echo_area (selected_frame (), Qnil, 0);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 800
diff changeset
573 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 733
diff changeset
574 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 Fnext_event (event, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 Fdispatch_event (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 if (!was_locked)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 any_console_state ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 #if (defined (_MSC_VER) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 || defined (__SUNPRO_C) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 || defined (__SUNPRO_CC) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 || (defined (DEC_ALPHA) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 && defined (OSF1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 if (0) return Qnil; /* Shut up compiler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 #ifdef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 /* Initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 syms_of_cmdloop (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 {
733
b1f74adcc1ff [xemacs-hg @ 2002-01-22 20:40:00 by janv]
janv
parents: 563
diff changeset
604 DEFSYMBOL (Qdisabled_command_hook);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 479
diff changeset
605 DEFSYMBOL (Qcommand_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 479
diff changeset
606 DEFSYMBOL (Qreally_early_error_handler);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 479
diff changeset
607 DEFSYMBOL (Qtop_level);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 479
diff changeset
608 DEFSYMBOL (Qerrors_deactivate_region);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 #ifndef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 DEFSUBR (Frecursive_edit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 DEFSUBR (Freally_early_error_handler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 DEFSUBR (Fcommand_loop_1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 vars_of_cmdloop (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 DEFVAR_INT ("command-loop-level", &command_loop_level /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 Number of recursive edits in progress.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 command_loop_level = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 Value is called instead of any command that is disabled,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 i.e. has a non-nil `disabled' property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 Vdisabled_command_hook = intern ("disabled-command-hook");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 Not yet implemented.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 Vleave_window_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 Not yet implemented.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 Venter_window_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 #ifndef LISP_COMMAND_LOOP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 DEFVAR_LISP ("top-level", &Vtop_level /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Form to evaluate when Emacs starts up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 Useful to set before you dump a modified Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 Vtop_level = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 DEFVAR_LISP ("command-loop", &Vcommand_loop /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 Function or one argument to call to read and process keyboard commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 The passed argument specifies whether or not to handle errors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 Vcommand_loop = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 #endif /* LISP_COMMAND_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 }