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