Mercurial > hg > xemacs-beta
annotate src/cmdloop.c @ 4949:018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-01-17 Ben Wing <ben@xemacs.org>
* bytecomp-runtime.el:
* bytecomp-runtime.el (error-unless-tests-match): New.
* bytecomp-runtime.el (byte-compile-file-being-compiled): New.
* bytecomp-runtime.el (compiled-if): New.
* bytecomp-runtime.el (compiled-when): New.
Add functions for dealing with conditional compilation of different code
depending on the presence or absence of features. Necessary for some
Mule code where code is run during compilation (macros or eval-when-compile)
but, depending on how the code is written, the code itself will crash
either with or without Unicode-internal.
compiled-if and compiled-when are the basic functions for conditional
compilation. They automatically trigger an error message upon file
loading if, at that time, the test expression that selected which code
to compile does not have the same value as at compile time.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 17 Jan 2010 04:52:48 -0600 |
| parents | 3465c3161fea |
| children | 838630c0734f |
| rev | line source |
|---|---|
| 428 | 1 /* Editor command loop. |
| 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
|
4841
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
3 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Mule 2.0. Not synched with FSF. | |
| 23 This was renamed from keyboard.c. However, it only contains the | |
| 24 command-loop stuff from FSF's keyboard.c; all the rest is in | |
| 25 event*.c, console.c, or signal.c. */ | |
| 26 | |
| 27 /* #### This module purports to separate out the command-loop stuff | |
| 28 from event-stream.c, but it doesn't really. Perhaps this file | |
| 29 should just be merged into event-stream.c, given its shortness. */ | |
| 30 | |
| 31 #include <config.h> | |
| 32 #include "lisp.h" | |
| 33 | |
| 34 #include "buffer.h" | |
| 872 | 35 #include "console-impl.h" |
| 800 | 36 #include "device.h" |
| 428 | 37 #include "commands.h" |
| 38 #include "frame.h" | |
| 39 #include "events.h" | |
| 40 #include "window.h" | |
| 41 | |
| 872 | 42 #ifdef HAVE_MS_WINDOWS |
| 43 #include "console-msw.h" | |
| 44 #endif | |
| 45 | |
| 428 | 46 /* Current depth in recursive edits. */ |
| 458 | 47 Fixnum command_loop_level; |
| 428 | 48 |
| 49 #ifndef LISP_COMMAND_LOOP | |
| 50 /* Form to evaluate (if non-nil) when Emacs is started. */ | |
| 51 Lisp_Object Vtop_level; | |
| 52 #else | |
| 53 /* Function to call to evaluate to read and process events. */ | |
| 54 Lisp_Object Vcommand_loop; | |
| 55 #endif /* LISP_COMMAND_LOOP */ | |
| 56 | |
| 57 Lisp_Object Venter_window_hook, Vleave_window_hook; | |
| 58 | |
| 733 | 59 Lisp_Object Qdisabled_command_hook, Vdisabled_command_hook; |
| 60 | |
| 428 | 61 /* The error handler. */ |
| 62 Lisp_Object Qcommand_error; | |
| 63 | |
| 64 /* The emergency error handler, before we're ready. */ | |
| 65 Lisp_Object Qreally_early_error_handler; | |
| 66 | |
| 67 /* Variable defined in Lisp. */ | |
| 68 Lisp_Object Qerrors_deactivate_region; | |
| 69 | |
| 70 Lisp_Object Qtop_level; | |
| 1703 | 71 Lisp_Object Vminibuffer_echo_wait_function; |
| 428 | 72 |
| 2268 | 73 #ifdef LISP_COMMAND_LOOP |
| 428 | 74 static Lisp_Object command_loop_1 (Lisp_Object dummy); |
| 75 EXFUN (Fcommand_loop_1, 0); | |
| 2268 | 76 #else |
| 77 static DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, | |
| 78 command_loop_1 (Lisp_Object dummy)); | |
| 79 EXFUN_NORETURN (Fcommand_loop_1, 0); | |
| 80 #endif | |
| 428 | 81 |
| 82 /* There are two possible command loops -- one written entirely in | |
| 83 C and one written mostly in Lisp, except stuff written in C for | |
| 84 speed. The advantage of the Lisp command loop is that the user | |
| 85 can specify their own command loop to use by changing the variable | |
| 86 `command-loop'. Its disadvantage is that it's slow. */ | |
| 87 | |
| 88 static Lisp_Object | |
| 89 default_error_handler (Lisp_Object data) | |
| 90 { | |
| 91 int speccount = specpdl_depth (); | |
| 92 | |
| 93 /* None of this is invoked, normally. This code is almost identical | |
| 94 to the `command-error' function, except `command-error' does cool | |
| 95 tricks with sounds. This function is a fallback, invoked if | |
| 96 command-error is unavailable. */ | |
| 97 | |
| 98 Fding (Qnil, Qnil, Qnil); | |
| 99 | |
| 100 if (!NILP (Fboundp (Qerrors_deactivate_region)) | |
| 101 && !NILP (Fsymbol_value (Qerrors_deactivate_region))) | |
| 102 zmacs_deactivate_region (); | |
| 103 Fdiscard_input (); | |
| 104 specbind (Qinhibit_quit, Qt); | |
| 105 Vstandard_output = Qt; | |
| 106 Vstandard_input = Qt; | |
| 107 Vexecuting_macro = Qnil; | |
| 108 Fset (intern ("last-error"), data); | |
| 109 clear_echo_area (selected_frame (), Qnil, 0); | |
| 110 Fdisplay_error (data, Qt); | |
| 111 check_quit (); /* make Vquit_flag accurate */ | |
| 112 Vquit_flag = Qnil; | |
| 771 | 113 return (unbind_to_1 (speccount, Qt)); |
| 428 | 114 } |
| 115 | |
| 2268 | 116 DEFUN_NORETURN ("really-early-error-handler", Freally_early_error_handler, |
| 117 1, 1, 0, /* | |
| 428 | 118 You should almost certainly not be using this. |
| 119 */ | |
| 120 (x)) | |
| 121 { | |
| 122 /* This is an error handler used when we're running temacs and when | |
| 123 we're in the early stages of XEmacs. No errors ought to be | |
| 124 occurring in those cases (or they ought to be trapped and | |
| 125 dealt with elsewhere), but if an error slips through, we need | |
| 126 to deal with it. We could write this function in Lisp (and it | |
| 127 used to be this way, at the beginning of loadup.el), but we do | |
| 128 it this way in case an error occurs before we get to loading | |
| 129 loadup.el. Note that there is also an `early-error-handler', | |
| 130 used in startup.el to catch more reasonable errors that | |
| 131 might occur during startup if the sysadmin or whoever fucked | |
| 132 up. This function is more conservative in what it does | |
| 133 and is used only as a last resort, indicating that the | |
| 134 programmer himself fucked up somewhere. */ | |
| 135 stderr_out ("*** Error in XEmacs initialization"); | |
| 136 Fprint (x, Qexternal_debugging_output); | |
| 137 stderr_out ("*** Backtrace\n"); | |
| 138 Fbacktrace (Qexternal_debugging_output, Qt); | |
| 139 stderr_out ("*** Killing XEmacs\n"); | |
|
4841
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
140 #ifdef DEBUG_XEMACS |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
141 /* When configured --with-debug, and debug-on-error is set, exit to the |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
142 debugger and abort. This will happen during loadup/dumping. There is |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
143 also code in signal_call_debugger() to do the same whenever running |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
144 noninteractively. That's intended for use debugging e.g. batch byte |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
145 compilation, AFTER dumping has already happened, where the XEMACSDEBUG |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
146 variable can be set to '(setq debug-on-error t)' to trigger the |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
147 behavior. |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
148 |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
149 Why do we need to duplicate the bomb-out check here? Well, |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
150 signal_call_debugger() doesn't want to bomb out unless it has an |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
151 uncaught error, and in this case, we've installed a |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
152 call-with-condition-case handler, and so signal_call_debugger() can't |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
153 bomb out before calling us. If we returned and let the error be |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
154 processed further, it *would* trigger the bomb-out-to-debugger |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
155 behavior, but in fact it never gets there because we do `kill-emacs'. |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
156 Therefore, we have to provide the bomb-to-debugger feature |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
157 ourselves. */ |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
158 if (!NILP (Vdebug_on_error)) |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
159 { |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
160 stderr_out ("XEmacs exiting to debugger.\n"); |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
161 Fforce_debugging_signal (Qt); |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
162 } |
|
3465c3161fea
when `debug', abort when lisp error during loadup
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
163 #endif |
| 442 | 164 #ifdef HAVE_MS_WINDOWS |
| 771 | 165 Fmswindows_message_box (build_msg_string ("Initialization error"), |
| 442 | 166 Qnil, Qnil); |
| 167 #endif | |
| 2268 | 168 Fkill_emacs (make_int (-1)); |
| 169 RETURN_NOT_REACHED (Qnil); | |
| 428 | 170 } |
| 171 | |
| 172 | |
| 173 /**********************************************************************/ | |
| 174 /* Command-loop (in C) */ | |
| 175 /**********************************************************************/ | |
| 176 | |
| 177 #ifndef LISP_COMMAND_LOOP | |
| 178 | |
| 179 /* The guts of the command loop are in command_loop_1(). This function | |
| 180 doesn't catch errors, though -- that's the job of command_loop_2(), | |
| 181 which is a condition-case wrapper around command_loop_1(). | |
| 182 command_loop_1() never returns, but may get thrown out of. | |
| 183 | |
| 184 When an error occurs, cmd_error() is called, which usually | |
| 185 invokes the Lisp error handler in `command-error'; however, | |
| 186 a default error handler is provided if `command-error' is nil | |
| 187 (e.g. during startup). The purpose of the error handler is | |
| 188 simply to display the error message and do associated cleanup; | |
| 189 it does not need to throw anywhere. When the error handler | |
| 190 finishes, the condition-case in command_loop_2() will finish and | |
| 191 command_loop_2() will reinvoke command_loop_1(). | |
| 192 | |
| 193 command_loop_2() is invoked from three places: from | |
| 194 initial_command_loop() (called from main() at the end of | |
| 195 internal initialization), from the Lisp function `recursive-edit', | |
| 196 and from call_command_loop(). | |
| 197 | |
| 198 call_command_loop() is called when a macro is started and when the | |
| 199 minibuffer is entered; normal termination of the macro or | |
| 200 minibuffer causes a throw out of the recursive command loop. (To | |
| 3025 | 201 `execute-kbd-macro' for macros and `exit' for minibuffers. Note also |
| 428 | 202 that the low-level minibuffer-entering function, |
| 203 `read-minibuffer-internal', provides its own error handling and | |
| 204 does not need command_loop_2()'s error encapsulation; so it tells | |
| 205 call_command_loop() to invoke command_loop_1() directly.) | |
| 206 | |
| 207 Note that both read-minibuffer-internal and recursive-edit set | |
| 3025 | 208 up a catch for `exit'; this is why `abort-recursive-edit', which |
| 428 | 209 throws to this catch, exits out of either one. |
| 210 | |
| 211 initial_command_loop(), called from main(), sets up a catch | |
| 3025 | 212 for `top-level' when invoking command_loop_2(), allowing functions |
| 428 | 213 to throw all the way to the top level if they really need to. |
| 214 Before invoking command_loop_2(), initial_command_loop() calls | |
| 215 top_level_1(), which handles all of the startup stuff (creating | |
| 216 the initial frame, handling the command-line options, loading | |
| 217 the user's .emacs file, etc.). The function that actually does this | |
| 218 is in Lisp and is pointed to by the variable `top-level'; | |
| 219 normally this function is `normal-top-level'. top_level_1() is | |
| 220 just an error-handling wrapper similar to command_loop_2(). | |
| 3025 | 221 Note also that initial_command_loop() sets up a catch for `top-level' |
| 428 | 222 when invoking top_level_1(), just like when it invokes |
| 223 command_loop_2(). */ | |
| 224 | |
| 225 | |
| 226 static Lisp_Object | |
| 2286 | 227 cmd_error (Lisp_Object data, Lisp_Object UNUSED (dummy)) |
| 428 | 228 { |
| 229 /* This function can GC */ | |
| 230 check_quit (); /* make Vquit_flag accurate */ | |
| 231 Vquit_flag = Qnil; | |
| 232 | |
| 233 any_console_state (); | |
| 234 | |
| 235 if (!NILP (Ffboundp (Qcommand_error))) | |
| 236 return call1 (Qcommand_error, data); | |
| 237 | |
| 238 return default_error_handler (data); | |
| 239 } | |
| 240 | |
| 241 static Lisp_Object | |
| 2286 | 242 top_level_1 (Lisp_Object UNUSED (dummy)) |
| 428 | 243 { |
| 244 /* This function can GC */ | |
| 245 /* On entry to the outer level, run the startup file */ | |
| 246 if (!NILP (Vtop_level)) | |
| 247 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil); | |
| 248 #if 1 | |
| 249 else | |
| 250 { | |
| 251 message ("\ntemacs can only be run in -batch mode."); | |
| 252 noninteractive = 1; /* prevent things under kill-emacs from blowing up */ | |
| 253 Fkill_emacs (make_int (-1)); | |
| 254 } | |
| 255 #else | |
| 256 else if (purify_flag) | |
| 257 message ("Bare impure Emacs (standard Lisp code not loaded)"); | |
| 258 else | |
| 259 message ("Bare Emacs (standard Lisp code not loaded)"); | |
| 260 #endif | |
| 261 | |
| 262 return Qnil; | |
| 263 } | |
| 264 | |
| 265 /* Here we catch errors in execution of commands within the | |
| 266 editing loop, and reenter the editing loop. | |
| 267 When there is an error, cmd_error runs and the call | |
| 268 to condition_case_1() returns. */ | |
| 269 | |
| 270 /* Avoid confusing the compiler. A helper function for command_loop_2 */ | |
| 2268 | 271 static DECLARE_DOESNT_RETURN (command_loop_3 (void)); |
| 272 | |
| 428 | 273 static DOESNT_RETURN |
| 274 command_loop_3 (void) | |
| 275 { | |
| 276 /* | |
| 1268 | 277 * If we are inside of a menu callback we cannot reenter the command loop |
| 278 * because we will deadlock, as no input is allowed. | |
| 428 | 279 */ |
| 1268 | 280 if (in_modal_loop) |
| 281 invalid_operation ("Attempt to enter command loop inside menu callback", | |
| 282 Qunbound); | |
| 428 | 283 /* This function can GC */ |
| 284 for (;;) | |
| 285 { | |
| 286 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil); | |
| 287 /* #### wrong with selected-console? */ | |
| 288 /* See command in initial_command_loop about why this value | |
| 289 is 0. */ | |
| 290 reset_this_command_keys (Vselected_console, 0); | |
| 291 } | |
| 292 } | |
| 293 | |
| 2268 | 294 static DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, command_loop_2 (Lisp_Object)); |
| 295 | |
| 296 static DOESNT_RETURN_TYPE (Lisp_Object) | |
| 2286 | 297 command_loop_2 (Lisp_Object UNUSED (dummy)) |
| 428 | 298 { |
| 299 command_loop_3(); /* doesn't return */ | |
| 2268 | 300 RETURN_NOT_REACHED (Qnil); |
| 428 | 301 } |
| 302 | |
| 303 /* This is called from emacs.c when it's done with initialization. */ | |
| 304 | |
| 305 DOESNT_RETURN | |
| 306 initial_command_loop (Lisp_Object load_me) | |
| 307 { | |
| 308 /* This function can GC */ | |
| 309 if (!NILP (load_me)) | |
| 310 Vtop_level = list2 (Qload, load_me); | |
| 311 | |
| 312 /* First deal with startup and command-line arguments. A throw | |
| 3025 | 313 to `top-level' gets us back here directly (does this ever happen?). |
| 428 | 314 Otherwise, this function will return normally when all command- |
| 315 line arguments have been processed, the user's initialization | |
| 316 file has been read in, and the first frame has been created. */ | |
| 2532 | 317 internal_catch (Qtop_level, top_level_1, Qnil, 0, 0, 0); |
| 428 | 318 |
| 319 /* If an error occurred during startup and the initial console | |
| 320 wasn't created, then die now (the error was already printed out | |
| 321 on the terminal device). */ | |
| 322 if (!noninteractive && | |
| 323 (!CONSOLEP (Vselected_console) || | |
| 324 CONSOLE_STREAM_P (XCONSOLE (Vselected_console)))) | |
| 325 Fkill_emacs (make_int (-1)); | |
| 326 | |
| 327 /* End of -batch run causes exit here. */ | |
| 328 if (noninteractive) | |
| 329 Fkill_emacs (Qt); | |
| 330 | |
| 331 for (;;) | |
| 332 { | |
| 333 command_loop_level = 0; | |
| 334 MARK_MODELINE_CHANGED; | |
| 335 /* Now invoke the command loop. It never returns; however, a | |
| 3025 | 336 throw to `top-level' will place us at the end of this loop. */ |
| 2532 | 337 internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0, 0); |
| 428 | 338 /* #### wrong with selected-console? */ |
| 339 /* We don't actually call clear_echo_area() here, partially | |
| 340 at least because that runs Lisp code and it may be unsafe | |
| 341 to do so -- we are outside of the normal catches for | |
| 342 errors and such. */ | |
| 343 reset_this_command_keys (Vselected_console, 0); | |
| 344 } | |
| 345 } | |
| 346 | |
| 347 /* This function is invoked when a macro or minibuffer starts up. | |
| 348 Normal termination of the macro or minibuffer causes a throw past us. | |
| 349 See the comment above. | |
| 350 | |
| 351 Note that this function never returns (but may be thrown out of). */ | |
| 352 | |
| 2268 | 353 DOESNT_RETURN_TYPE (Lisp_Object) |
| 428 | 354 call_command_loop (Lisp_Object catch_errors) |
| 355 { | |
| 356 /* This function can GC */ | |
| 357 if (NILP (catch_errors)) | |
| 2268 | 358 command_loop_1 (Qnil); |
| 428 | 359 else |
| 2268 | 360 command_loop_2 (Qnil); |
| 361 RETURN_NOT_REACHED (Qnil); | |
| 428 | 362 } |
| 363 | |
| 364 static Lisp_Object | |
| 365 recursive_edit_unwind (Lisp_Object buffer) | |
| 366 { | |
| 367 if (!NILP (buffer)) | |
| 368 Fset_buffer (buffer); | |
| 369 | |
| 370 command_loop_level--; | |
| 371 MARK_MODELINE_CHANGED; | |
| 372 | |
| 373 return Qnil; | |
| 374 } | |
| 375 | |
| 376 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /* | |
| 377 Invoke the editor command loop recursively. | |
| 378 To get out of the recursive edit, a command can do `(throw 'exit nil)'; | |
| 379 that tells this function to return. | |
| 380 Alternately, `(throw 'exit t)' makes this function signal an error. | |
| 381 */ | |
| 382 ()) | |
| 383 { | |
| 384 /* This function can GC */ | |
| 385 Lisp_Object val; | |
| 386 int speccount = specpdl_depth (); | |
| 387 | |
| 388 command_loop_level++; | |
| 389 MARK_MODELINE_CHANGED; | |
| 390 | |
| 391 record_unwind_protect (recursive_edit_unwind, | |
| 872 | 392 current_buffer |
| 393 != XWINDOW_XBUFFER (Fselected_window (Qnil)) | |
| 428 | 394 ? Fcurrent_buffer () |
| 872 | 395 : Qnil); |
| 428 | 396 |
| 397 specbind (Qstandard_output, Qt); | |
| 398 specbind (Qstandard_input, Qt); | |
| 399 | |
| 2532 | 400 val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0, 0); |
| 428 | 401 |
| 402 if (EQ (val, Qt)) | |
| 403 /* Turn abort-recursive-edit into a quit. */ | |
| 404 Fsignal (Qquit, Qnil); | |
| 405 | |
| 771 | 406 return unbind_to (speccount); |
| 428 | 407 } |
| 408 | |
| 409 #endif /* !LISP_COMMAND_LOOP */ | |
| 410 | |
| 411 | |
| 412 /**********************************************************************/ | |
| 413 /* Alternate command-loop (largely in Lisp) */ | |
| 414 /**********************************************************************/ | |
| 415 | |
| 416 #ifdef LISP_COMMAND_LOOP | |
| 417 | |
| 418 static Lisp_Object | |
| 419 load1 (Lisp_Object name) | |
| 420 { | |
| 421 /* This function can GC */ | |
| 422 call4 (Qload, name, Qnil, Qt, Qnil); | |
| 423 return (Qnil); | |
| 424 } | |
| 425 | |
| 426 /* emergency backups for cold-load-stream use */ | |
| 427 static Lisp_Object | |
| 428 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored) | |
| 429 { | |
| 430 /* This function can GC */ | |
| 431 check_quit (); /* make Vquit_flag accurate */ | |
| 432 Vquit_flag = Qnil; | |
| 433 | |
| 434 return default_error_handler (datum); | |
| 435 } | |
| 436 | |
| 437 static Lisp_Object | |
| 438 cold_load_command_loop (Lisp_Object dummy) | |
| 439 { | |
| 440 /* This function can GC */ | |
| 441 return (condition_case_1 (Qt, | |
| 442 command_loop_1, Qnil, | |
| 443 cold_load_command_error, Qnil)); | |
| 444 } | |
| 445 | |
| 2268 | 446 DOESNT_RETURN_TYPE (Lisp_Object) |
| 428 | 447 call_command_loop (Lisp_Object catch_errors) |
| 448 { | |
| 449 /* This function can GC */ | |
| 479 | 450 reset_this_command_keys (Vselected_console, 0); /* #### bleagh */ |
| 428 | 451 |
| 452 loop: | |
| 453 for (;;) | |
| 454 { | |
| 455 if (NILP (Vcommand_loop)) | |
| 456 break; | |
| 457 call1 (Vcommand_loop, catch_errors); | |
| 458 } | |
| 459 | |
| 460 /* This isn't a "correct" definition, but you're pretty hosed if | |
| 461 you broke "command-loop" anyway */ | |
| 462 /* #### not correct with Vselected_console */ | |
| 463 XCONSOLE (Vselected_console)->prefix_arg = Qnil; | |
| 464 if (NILP (catch_errors)) | |
| 465 Fcommand_loop_1 (); | |
| 466 else | |
| 2532 | 467 internal_catch (Qtop_level, cold_load_command_loop, Qnil, 0, 0, 0); |
| 428 | 468 goto loop; |
| 2268 | 469 RETURN_NOT_REACHED (Qnil); |
| 428 | 470 } |
| 471 | |
| 472 static Lisp_Object | |
| 473 initial_error_handler (Lisp_Object datum, Lisp_Object ignored) | |
| 474 { | |
| 475 /* This function can GC */ | |
| 476 Vcommand_loop = Qnil; | |
| 477 Fding (Qnil, Qnil, Qnil); | |
| 478 | |
| 479 if (CONSP (datum) && EQ (XCAR (datum), Qquit)) | |
| 480 /* Don't bother with the message */ | |
| 481 return (Qt); | |
| 482 | |
| 483 message ("Error in command-loop!!"); | |
| 484 Fset (intern ("last-error"), datum); /* #### Better/different name? */ | |
| 485 Fsit_for (make_int (2), Qnil); | |
| 486 cold_load_command_error (datum, Qnil); | |
| 487 return (Qt); | |
| 488 } | |
| 489 | |
| 490 DOESNT_RETURN | |
| 491 initial_command_loop (Lisp_Object load_me) | |
| 492 { | |
| 493 /* This function can GC */ | |
| 494 if (!NILP (load_me)) | |
| 495 { | |
| 496 if (!NILP (condition_case_1 (Qt, load1, load_me, | |
| 497 initial_error_handler, Qnil))) | |
| 498 Fkill_emacs (make_int (-1)); | |
| 499 } | |
| 500 | |
| 501 for (;;) | |
| 502 { | |
| 503 command_loop_level = 0; | |
| 504 MARK_MODELINE_CHANGED; | |
| 505 | |
| 506 condition_case_1 (Qt, | |
| 507 call_command_loop, Qtop_level, | |
| 508 initial_error_handler, Qnil); | |
| 509 } | |
| 510 } | |
| 511 | |
| 512 #endif /* LISP_COMMAND_LOOP */ | |
| 513 | |
| 514 | |
| 515 /**********************************************************************/ | |
| 516 /* Guts of command loop */ | |
| 517 /**********************************************************************/ | |
| 518 | |
| 2268 | 519 #ifdef LISP_COMMAND_LOOP |
| 428 | 520 static Lisp_Object |
| 2268 | 521 #else |
| 522 static DOESNT_RETURN_TYPE (Lisp_Object) | |
| 523 #endif | |
| 2286 | 524 command_loop_1 (Lisp_Object UNUSED (dummy)) |
| 428 | 525 { |
| 526 /* This function can GC */ | |
| 527 /* #### not correct with Vselected_console */ | |
| 528 XCONSOLE (Vselected_console)->prefix_arg = Qnil; | |
| 2268 | 529 Fcommand_loop_1 (); |
| 530 #ifdef LISP_COMMAND_LOOP | |
| 531 return Qnil; | |
| 532 #else | |
| 533 RETURN_NOT_REACHED (Qnil); | |
| 534 #endif | |
| 428 | 535 } |
| 536 | |
| 537 /* This is the actual command reading loop, sans error-handling | |
| 538 encapsulation. This is used for both the C and Lisp command | |
| 539 loops. Originally this function was written in Lisp when | |
| 540 the Lisp command loop was used, but it was too slow that way. | |
| 541 | |
| 542 Under the C command loop, this function will never return | |
| 543 (although someone might throw past it). Under the Lisp | |
| 544 command loop, this will return only when the user specifies | |
| 545 a new command loop by changing the command-loop variable. */ | |
| 546 | |
| 2268 | 547 #ifdef LISP_COMMAND_LOOP |
| 548 #define DEFUN_COMMAND_LOOP(a,b,c,d,e,f) DEFUN (a, b, c, d, e, f) | |
| 549 #else | |
| 550 #define DEFUN_COMMAND_LOOP(a,b,c,d,e,f) DEFUN_NORETURN (a, b, c, d, e, f) | |
| 551 #endif | |
| 552 | |
| 553 DEFUN_COMMAND_LOOP ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /* | |
| 428 | 554 Invoke the internals of the canonical editor command loop. |
| 555 Don't call this unless you know what you're doing. | |
| 556 */ | |
| 557 ()) | |
| 558 { | |
| 559 /* This function can GC */ | |
| 560 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 561 Lisp_Object old_loop = Qnil; | |
| 562 struct gcpro gcpro1, gcpro2; | |
| 563 int was_locked = in_single_console_state (); | |
| 564 GCPRO2 (event, old_loop); | |
| 565 | |
| 566 /* cancel_echoing (); */ | |
| 567 /* This magically makes single character keyboard macros work just | |
| 568 like the real thing. This is slightly bogus, but it's in here for | |
| 569 compatibility with Emacs 18. It's not even clear what the "right | |
| 570 thing" is. */ | |
| 434 | 571 if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)) |
| 572 && XINT (Flength (Vexecuting_macro)) == 1)) | |
| 428 | 573 Vlast_command = Qt; |
| 574 | |
| 575 #ifndef LISP_COMMAND_LOOP | |
| 576 while (1) | |
| 577 #else | |
| 578 old_loop = Vcommand_loop; | |
| 579 while (EQ (Vcommand_loop, old_loop)) | |
| 580 #endif /* LISP_COMMAND_LOOP */ | |
| 581 { | |
| 582 /* If focus_follows_mouse, make sure the frame with window manager | |
| 583 focus is selected. */ | |
| 584 if (focus_follows_mouse) | |
| 585 investigate_frame_change (); | |
| 434 | 586 |
| 428 | 587 /* Make sure the current window's buffer is selected. */ |
| 588 { | |
| 589 Lisp_Object selected_window = Fselected_window (Qnil); | |
| 590 | |
| 591 if (!NILP (selected_window) && | |
| 872 | 592 XWINDOW_XBUFFER (selected_window) != current_buffer) |
| 428 | 593 { |
| 872 | 594 set_buffer_internal (XWINDOW_XBUFFER (selected_window)); |
| 428 | 595 } |
| 596 } | |
| 597 | |
| 444 | 598 #if 0 /* What's wrong with going through ordinary procedure of quit? |
| 599 quitting here leaves overriding-terminal-local-map | |
| 600 when you type C-u C-u C-g. */ | |
| 428 | 601 /* If ^G was typed before we got here (that is, before emacs was |
| 602 idle and waiting for input) then we treat that as an interrupt. */ | |
| 603 QUIT; | |
| 444 | 604 #endif |
| 428 | 605 |
| 606 /* If minibuffer on and echo area in use, wait 2 sec and redraw | |
| 607 minibuffer. Treat a ^G here as a command, not an interrupt. | |
| 608 */ | |
| 609 if (minibuf_level > 0 && echo_area_active (selected_frame ())) | |
| 610 { | |
| 611 /* Bind dont_check_for_quit to 1 so that C-g gets read in | |
| 612 rather than quitting back to the minibuffer. */ | |
| 771 | 613 int count = begin_dont_check_for_quit (); |
| 1703 | 614 if (!NILP (Vminibuffer_echo_wait_function)) |
| 615 call0 (Vminibuffer_echo_wait_function); | |
| 616 else | |
| 617 Fsit_for (make_int (2), Qnil); | |
| 428 | 618 clear_echo_area (selected_frame (), Qnil, 0); |
| 853 | 619 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ |
| 771 | 620 unbind_to (count); |
| 428 | 621 } |
| 622 | |
| 623 Fnext_event (event, Qnil); | |
| 624 Fdispatch_event (event); | |
| 625 | |
| 626 if (!was_locked) | |
| 627 any_console_state (); | |
| 1204 | 628 |
| 629 DO_NOTHING_DISABLING_NO_RETURN_WARNINGS; | |
| 428 | 630 } |
| 631 #ifdef LISP_COMMAND_LOOP | |
| 632 UNGCPRO; | |
| 633 return Qnil; | |
| 1204 | 634 #else |
| 635 RETURN_NOT_REACHED (Qnil); | |
| 428 | 636 #endif |
| 637 } | |
| 638 | |
| 639 | |
| 640 /**********************************************************************/ | |
| 641 /* Initialization */ | |
| 642 /**********************************************************************/ | |
| 643 | |
| 644 void | |
| 645 syms_of_cmdloop (void) | |
| 646 { | |
| 733 | 647 DEFSYMBOL (Qdisabled_command_hook); |
| 563 | 648 DEFSYMBOL (Qcommand_error); |
| 649 DEFSYMBOL (Qreally_early_error_handler); | |
| 650 DEFSYMBOL (Qtop_level); | |
| 651 DEFSYMBOL (Qerrors_deactivate_region); | |
| 428 | 652 |
| 653 #ifndef LISP_COMMAND_LOOP | |
| 654 DEFSUBR (Frecursive_edit); | |
| 655 #endif | |
| 656 DEFSUBR (Freally_early_error_handler); | |
| 657 DEFSUBR (Fcommand_loop_1); | |
| 658 } | |
| 659 | |
| 660 void | |
| 661 vars_of_cmdloop (void) | |
| 662 { | |
| 663 DEFVAR_INT ("command-loop-level", &command_loop_level /* | |
| 664 Number of recursive edits in progress. | |
| 665 */ ); | |
| 666 command_loop_level = 0; | |
| 667 | |
| 668 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /* | |
| 669 Value is called instead of any command that is disabled, | |
| 670 i.e. has a non-nil `disabled' property. | |
| 671 */ ); | |
| 672 Vdisabled_command_hook = intern ("disabled-command-hook"); | |
| 673 | |
| 674 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /* | |
| 675 Not yet implemented. | |
| 676 */ ); | |
| 677 Vleave_window_hook = Qnil; | |
| 678 | |
| 679 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /* | |
| 680 Not yet implemented. | |
| 681 */ ); | |
| 682 Venter_window_hook = Qnil; | |
| 683 | |
| 1703 | 684 DEFVAR_LISP ("minibuffer-echo-wait-function", |
| 685 &Vminibuffer_echo_wait_function /* | |
| 686 The function called by command loop when minibuffer was active and | |
| 687 message was displayed (text appeared in \" *Echo Area*\" buffer). It | |
| 688 must wait after displaying message so that user can read it. If the | |
| 689 variable value is `nil', the equivalent of `(sit-for 2)' is run. | |
| 690 */ ); | |
| 691 Vminibuffer_echo_wait_function = Qnil; | |
| 692 | |
| 428 | 693 #ifndef LISP_COMMAND_LOOP |
| 694 DEFVAR_LISP ("top-level", &Vtop_level /* | |
| 695 Form to evaluate when Emacs starts up. | |
| 696 Useful to set before you dump a modified Emacs. | |
| 697 */ ); | |
| 698 Vtop_level = Qnil; | |
| 699 #else | |
| 700 DEFVAR_LISP ("command-loop", &Vcommand_loop /* | |
| 701 Function or one argument to call to read and process keyboard commands. | |
| 702 The passed argument specifies whether or not to handle errors. | |
| 703 */ ); | |
| 704 Vcommand_loop = Qnil; | |
| 705 #endif /* LISP_COMMAND_LOOP */ | |
| 706 } |