428
+ − 1 /* Editor command loop.
+ − 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
2532
+ − 3 Copyright (C) 1995, 1996, 2001, 2002, 2003 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");
442
+ − 140 #ifdef HAVE_MS_WINDOWS
771
+ − 141 Fmswindows_message_box (build_msg_string ("Initialization error"),
442
+ − 142 Qnil, Qnil);
+ − 143 #endif
2268
+ − 144 Fkill_emacs (make_int (-1));
+ − 145 RETURN_NOT_REACHED (Qnil);
428
+ − 146 }
+ − 147
+ − 148
+ − 149 /**********************************************************************/
+ − 150 /* Command-loop (in C) */
+ − 151 /**********************************************************************/
+ − 152
+ − 153 #ifndef LISP_COMMAND_LOOP
+ − 154
+ − 155 /* The guts of the command loop are in command_loop_1(). This function
+ − 156 doesn't catch errors, though -- that's the job of command_loop_2(),
+ − 157 which is a condition-case wrapper around command_loop_1().
+ − 158 command_loop_1() never returns, but may get thrown out of.
+ − 159
+ − 160 When an error occurs, cmd_error() is called, which usually
+ − 161 invokes the Lisp error handler in `command-error'; however,
+ − 162 a default error handler is provided if `command-error' is nil
+ − 163 (e.g. during startup). The purpose of the error handler is
+ − 164 simply to display the error message and do associated cleanup;
+ − 165 it does not need to throw anywhere. When the error handler
+ − 166 finishes, the condition-case in command_loop_2() will finish and
+ − 167 command_loop_2() will reinvoke command_loop_1().
+ − 168
+ − 169 command_loop_2() is invoked from three places: from
+ − 170 initial_command_loop() (called from main() at the end of
+ − 171 internal initialization), from the Lisp function `recursive-edit',
+ − 172 and from call_command_loop().
+ − 173
+ − 174 call_command_loop() is called when a macro is started and when the
+ − 175 minibuffer is entered; normal termination of the macro or
+ − 176 minibuffer causes a throw out of the recursive command loop. (To
3025
+ − 177 `execute-kbd-macro' for macros and `exit' for minibuffers. Note also
428
+ − 178 that the low-level minibuffer-entering function,
+ − 179 `read-minibuffer-internal', provides its own error handling and
+ − 180 does not need command_loop_2()'s error encapsulation; so it tells
+ − 181 call_command_loop() to invoke command_loop_1() directly.)
+ − 182
+ − 183 Note that both read-minibuffer-internal and recursive-edit set
3025
+ − 184 up a catch for `exit'; this is why `abort-recursive-edit', which
428
+ − 185 throws to this catch, exits out of either one.
+ − 186
+ − 187 initial_command_loop(), called from main(), sets up a catch
3025
+ − 188 for `top-level' when invoking command_loop_2(), allowing functions
428
+ − 189 to throw all the way to the top level if they really need to.
+ − 190 Before invoking command_loop_2(), initial_command_loop() calls
+ − 191 top_level_1(), which handles all of the startup stuff (creating
+ − 192 the initial frame, handling the command-line options, loading
+ − 193 the user's .emacs file, etc.). The function that actually does this
+ − 194 is in Lisp and is pointed to by the variable `top-level';
+ − 195 normally this function is `normal-top-level'. top_level_1() is
+ − 196 just an error-handling wrapper similar to command_loop_2().
3025
+ − 197 Note also that initial_command_loop() sets up a catch for `top-level'
428
+ − 198 when invoking top_level_1(), just like when it invokes
+ − 199 command_loop_2(). */
+ − 200
+ − 201
+ − 202 static Lisp_Object
2286
+ − 203 cmd_error (Lisp_Object data, Lisp_Object UNUSED (dummy))
428
+ − 204 {
+ − 205 /* This function can GC */
+ − 206 check_quit (); /* make Vquit_flag accurate */
+ − 207 Vquit_flag = Qnil;
+ − 208
+ − 209 any_console_state ();
+ − 210
+ − 211 if (!NILP (Ffboundp (Qcommand_error)))
+ − 212 return call1 (Qcommand_error, data);
+ − 213
+ − 214 return default_error_handler (data);
+ − 215 }
+ − 216
+ − 217 static Lisp_Object
2286
+ − 218 top_level_1 (Lisp_Object UNUSED (dummy))
428
+ − 219 {
+ − 220 /* This function can GC */
+ − 221 /* On entry to the outer level, run the startup file */
+ − 222 if (!NILP (Vtop_level))
+ − 223 condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
+ − 224 #if 1
+ − 225 else
+ − 226 {
+ − 227 message ("\ntemacs can only be run in -batch mode.");
+ − 228 noninteractive = 1; /* prevent things under kill-emacs from blowing up */
+ − 229 Fkill_emacs (make_int (-1));
+ − 230 }
+ − 231 #else
+ − 232 else if (purify_flag)
+ − 233 message ("Bare impure Emacs (standard Lisp code not loaded)");
+ − 234 else
+ − 235 message ("Bare Emacs (standard Lisp code not loaded)");
+ − 236 #endif
+ − 237
+ − 238 return Qnil;
+ − 239 }
+ − 240
+ − 241 /* Here we catch errors in execution of commands within the
+ − 242 editing loop, and reenter the editing loop.
+ − 243 When there is an error, cmd_error runs and the call
+ − 244 to condition_case_1() returns. */
+ − 245
+ − 246 /* Avoid confusing the compiler. A helper function for command_loop_2 */
2268
+ − 247 static DECLARE_DOESNT_RETURN (command_loop_3 (void));
+ − 248
428
+ − 249 static DOESNT_RETURN
+ − 250 command_loop_3 (void)
+ − 251 {
+ − 252 /*
1268
+ − 253 * If we are inside of a menu callback we cannot reenter the command loop
+ − 254 * because we will deadlock, as no input is allowed.
428
+ − 255 */
1268
+ − 256 if (in_modal_loop)
+ − 257 invalid_operation ("Attempt to enter command loop inside menu callback",
+ − 258 Qunbound);
428
+ − 259 /* This function can GC */
+ − 260 for (;;)
+ − 261 {
+ − 262 condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
+ − 263 /* #### wrong with selected-console? */
+ − 264 /* See command in initial_command_loop about why this value
+ − 265 is 0. */
+ − 266 reset_this_command_keys (Vselected_console, 0);
+ − 267 }
+ − 268 }
+ − 269
2268
+ − 270 static DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, command_loop_2 (Lisp_Object));
+ − 271
+ − 272 static DOESNT_RETURN_TYPE (Lisp_Object)
2286
+ − 273 command_loop_2 (Lisp_Object UNUSED (dummy))
428
+ − 274 {
+ − 275 command_loop_3(); /* doesn't return */
2268
+ − 276 RETURN_NOT_REACHED (Qnil);
428
+ − 277 }
+ − 278
+ − 279 /* This is called from emacs.c when it's done with initialization. */
+ − 280
+ − 281 DOESNT_RETURN
+ − 282 initial_command_loop (Lisp_Object load_me)
+ − 283 {
+ − 284 /* This function can GC */
+ − 285 if (!NILP (load_me))
+ − 286 Vtop_level = list2 (Qload, load_me);
+ − 287
+ − 288 /* First deal with startup and command-line arguments. A throw
3025
+ − 289 to `top-level' gets us back here directly (does this ever happen?).
428
+ − 290 Otherwise, this function will return normally when all command-
+ − 291 line arguments have been processed, the user's initialization
+ − 292 file has been read in, and the first frame has been created. */
2532
+ − 293 internal_catch (Qtop_level, top_level_1, Qnil, 0, 0, 0);
428
+ − 294
+ − 295 /* If an error occurred during startup and the initial console
+ − 296 wasn't created, then die now (the error was already printed out
+ − 297 on the terminal device). */
+ − 298 if (!noninteractive &&
+ − 299 (!CONSOLEP (Vselected_console) ||
+ − 300 CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
+ − 301 Fkill_emacs (make_int (-1));
+ − 302
+ − 303 /* End of -batch run causes exit here. */
+ − 304 if (noninteractive)
+ − 305 Fkill_emacs (Qt);
+ − 306
+ − 307 for (;;)
+ − 308 {
+ − 309 command_loop_level = 0;
+ − 310 MARK_MODELINE_CHANGED;
+ − 311 /* Now invoke the command loop. It never returns; however, a
3025
+ − 312 throw to `top-level' will place us at the end of this loop. */
2532
+ − 313 internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0, 0);
428
+ − 314 /* #### wrong with selected-console? */
+ − 315 /* We don't actually call clear_echo_area() here, partially
+ − 316 at least because that runs Lisp code and it may be unsafe
+ − 317 to do so -- we are outside of the normal catches for
+ − 318 errors and such. */
+ − 319 reset_this_command_keys (Vselected_console, 0);
+ − 320 }
+ − 321 }
+ − 322
+ − 323 /* This function is invoked when a macro or minibuffer starts up.
+ − 324 Normal termination of the macro or minibuffer causes a throw past us.
+ − 325 See the comment above.
+ − 326
+ − 327 Note that this function never returns (but may be thrown out of). */
+ − 328
2268
+ − 329 DOESNT_RETURN_TYPE (Lisp_Object)
428
+ − 330 call_command_loop (Lisp_Object catch_errors)
+ − 331 {
+ − 332 /* This function can GC */
+ − 333 if (NILP (catch_errors))
2268
+ − 334 command_loop_1 (Qnil);
428
+ − 335 else
2268
+ − 336 command_loop_2 (Qnil);
+ − 337 RETURN_NOT_REACHED (Qnil);
428
+ − 338 }
+ − 339
+ − 340 static Lisp_Object
+ − 341 recursive_edit_unwind (Lisp_Object buffer)
+ − 342 {
+ − 343 if (!NILP (buffer))
+ − 344 Fset_buffer (buffer);
+ − 345
+ − 346 command_loop_level--;
+ − 347 MARK_MODELINE_CHANGED;
+ − 348
+ − 349 return Qnil;
+ − 350 }
+ − 351
+ − 352 DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
+ − 353 Invoke the editor command loop recursively.
+ − 354 To get out of the recursive edit, a command can do `(throw 'exit nil)';
+ − 355 that tells this function to return.
+ − 356 Alternately, `(throw 'exit t)' makes this function signal an error.
+ − 357 */
+ − 358 ())
+ − 359 {
+ − 360 /* This function can GC */
+ − 361 Lisp_Object val;
+ − 362 int speccount = specpdl_depth ();
+ − 363
+ − 364 command_loop_level++;
+ − 365 MARK_MODELINE_CHANGED;
+ − 366
+ − 367 record_unwind_protect (recursive_edit_unwind,
872
+ − 368 current_buffer
+ − 369 != XWINDOW_XBUFFER (Fselected_window (Qnil))
428
+ − 370 ? Fcurrent_buffer ()
872
+ − 371 : Qnil);
428
+ − 372
+ − 373 specbind (Qstandard_output, Qt);
+ − 374 specbind (Qstandard_input, Qt);
+ − 375
2532
+ − 376 val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0, 0);
428
+ − 377
+ − 378 if (EQ (val, Qt))
+ − 379 /* Turn abort-recursive-edit into a quit. */
+ − 380 Fsignal (Qquit, Qnil);
+ − 381
771
+ − 382 return unbind_to (speccount);
428
+ − 383 }
+ − 384
+ − 385 #endif /* !LISP_COMMAND_LOOP */
+ − 386
+ − 387
+ − 388 /**********************************************************************/
+ − 389 /* Alternate command-loop (largely in Lisp) */
+ − 390 /**********************************************************************/
+ − 391
+ − 392 #ifdef LISP_COMMAND_LOOP
+ − 393
+ − 394 static Lisp_Object
+ − 395 load1 (Lisp_Object name)
+ − 396 {
+ − 397 /* This function can GC */
+ − 398 call4 (Qload, name, Qnil, Qt, Qnil);
+ − 399 return (Qnil);
+ − 400 }
+ − 401
+ − 402 /* emergency backups for cold-load-stream use */
+ − 403 static Lisp_Object
+ − 404 cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
+ − 405 {
+ − 406 /* This function can GC */
+ − 407 check_quit (); /* make Vquit_flag accurate */
+ − 408 Vquit_flag = Qnil;
+ − 409
+ − 410 return default_error_handler (datum);
+ − 411 }
+ − 412
+ − 413 static Lisp_Object
+ − 414 cold_load_command_loop (Lisp_Object dummy)
+ − 415 {
+ − 416 /* This function can GC */
+ − 417 return (condition_case_1 (Qt,
+ − 418 command_loop_1, Qnil,
+ − 419 cold_load_command_error, Qnil));
+ − 420 }
+ − 421
2268
+ − 422 DOESNT_RETURN_TYPE (Lisp_Object)
428
+ − 423 call_command_loop (Lisp_Object catch_errors)
+ − 424 {
+ − 425 /* This function can GC */
479
+ − 426 reset_this_command_keys (Vselected_console, 0); /* #### bleagh */
428
+ − 427
+ − 428 loop:
+ − 429 for (;;)
+ − 430 {
+ − 431 if (NILP (Vcommand_loop))
+ − 432 break;
+ − 433 call1 (Vcommand_loop, catch_errors);
+ − 434 }
+ − 435
+ − 436 /* This isn't a "correct" definition, but you're pretty hosed if
+ − 437 you broke "command-loop" anyway */
+ − 438 /* #### not correct with Vselected_console */
+ − 439 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
+ − 440 if (NILP (catch_errors))
+ − 441 Fcommand_loop_1 ();
+ − 442 else
2532
+ − 443 internal_catch (Qtop_level, cold_load_command_loop, Qnil, 0, 0, 0);
428
+ − 444 goto loop;
2268
+ − 445 RETURN_NOT_REACHED (Qnil);
428
+ − 446 }
+ − 447
+ − 448 static Lisp_Object
+ − 449 initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
+ − 450 {
+ − 451 /* This function can GC */
+ − 452 Vcommand_loop = Qnil;
+ − 453 Fding (Qnil, Qnil, Qnil);
+ − 454
+ − 455 if (CONSP (datum) && EQ (XCAR (datum), Qquit))
+ − 456 /* Don't bother with the message */
+ − 457 return (Qt);
+ − 458
+ − 459 message ("Error in command-loop!!");
+ − 460 Fset (intern ("last-error"), datum); /* #### Better/different name? */
+ − 461 Fsit_for (make_int (2), Qnil);
+ − 462 cold_load_command_error (datum, Qnil);
+ − 463 return (Qt);
+ − 464 }
+ − 465
+ − 466 DOESNT_RETURN
+ − 467 initial_command_loop (Lisp_Object load_me)
+ − 468 {
+ − 469 /* This function can GC */
+ − 470 if (!NILP (load_me))
+ − 471 {
+ − 472 if (!NILP (condition_case_1 (Qt, load1, load_me,
+ − 473 initial_error_handler, Qnil)))
+ − 474 Fkill_emacs (make_int (-1));
+ − 475 }
+ − 476
+ − 477 for (;;)
+ − 478 {
+ − 479 command_loop_level = 0;
+ − 480 MARK_MODELINE_CHANGED;
+ − 481
+ − 482 condition_case_1 (Qt,
+ − 483 call_command_loop, Qtop_level,
+ − 484 initial_error_handler, Qnil);
+ − 485 }
+ − 486 }
+ − 487
+ − 488 #endif /* LISP_COMMAND_LOOP */
+ − 489
+ − 490
+ − 491 /**********************************************************************/
+ − 492 /* Guts of command loop */
+ − 493 /**********************************************************************/
+ − 494
2268
+ − 495 #ifdef LISP_COMMAND_LOOP
428
+ − 496 static Lisp_Object
2268
+ − 497 #else
+ − 498 static DOESNT_RETURN_TYPE (Lisp_Object)
+ − 499 #endif
2286
+ − 500 command_loop_1 (Lisp_Object UNUSED (dummy))
428
+ − 501 {
+ − 502 /* This function can GC */
+ − 503 /* #### not correct with Vselected_console */
+ − 504 XCONSOLE (Vselected_console)->prefix_arg = Qnil;
2268
+ − 505 Fcommand_loop_1 ();
+ − 506 #ifdef LISP_COMMAND_LOOP
+ − 507 return Qnil;
+ − 508 #else
+ − 509 RETURN_NOT_REACHED (Qnil);
+ − 510 #endif
428
+ − 511 }
+ − 512
+ − 513 /* This is the actual command reading loop, sans error-handling
+ − 514 encapsulation. This is used for both the C and Lisp command
+ − 515 loops. Originally this function was written in Lisp when
+ − 516 the Lisp command loop was used, but it was too slow that way.
+ − 517
+ − 518 Under the C command loop, this function will never return
+ − 519 (although someone might throw past it). Under the Lisp
+ − 520 command loop, this will return only when the user specifies
+ − 521 a new command loop by changing the command-loop variable. */
+ − 522
2268
+ − 523 #ifdef LISP_COMMAND_LOOP
+ − 524 #define DEFUN_COMMAND_LOOP(a,b,c,d,e,f) DEFUN (a, b, c, d, e, f)
+ − 525 #else
+ − 526 #define DEFUN_COMMAND_LOOP(a,b,c,d,e,f) DEFUN_NORETURN (a, b, c, d, e, f)
+ − 527 #endif
+ − 528
+ − 529 DEFUN_COMMAND_LOOP ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
428
+ − 530 Invoke the internals of the canonical editor command loop.
+ − 531 Don't call this unless you know what you're doing.
+ − 532 */
+ − 533 ())
+ − 534 {
+ − 535 /* This function can GC */
+ − 536 Lisp_Object event = Fmake_event (Qnil, Qnil);
+ − 537 Lisp_Object old_loop = Qnil;
+ − 538 struct gcpro gcpro1, gcpro2;
+ − 539 int was_locked = in_single_console_state ();
+ − 540 GCPRO2 (event, old_loop);
+ − 541
+ − 542 /* cancel_echoing (); */
+ − 543 /* This magically makes single character keyboard macros work just
+ − 544 like the real thing. This is slightly bogus, but it's in here for
+ − 545 compatibility with Emacs 18. It's not even clear what the "right
+ − 546 thing" is. */
434
+ − 547 if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
+ − 548 && XINT (Flength (Vexecuting_macro)) == 1))
428
+ − 549 Vlast_command = Qt;
+ − 550
+ − 551 #ifndef LISP_COMMAND_LOOP
+ − 552 while (1)
+ − 553 #else
+ − 554 old_loop = Vcommand_loop;
+ − 555 while (EQ (Vcommand_loop, old_loop))
+ − 556 #endif /* LISP_COMMAND_LOOP */
+ − 557 {
+ − 558 /* If focus_follows_mouse, make sure the frame with window manager
+ − 559 focus is selected. */
+ − 560 if (focus_follows_mouse)
+ − 561 investigate_frame_change ();
434
+ − 562
428
+ − 563 /* Make sure the current window's buffer is selected. */
+ − 564 {
+ − 565 Lisp_Object selected_window = Fselected_window (Qnil);
+ − 566
+ − 567 if (!NILP (selected_window) &&
872
+ − 568 XWINDOW_XBUFFER (selected_window) != current_buffer)
428
+ − 569 {
872
+ − 570 set_buffer_internal (XWINDOW_XBUFFER (selected_window));
428
+ − 571 }
+ − 572 }
+ − 573
444
+ − 574 #if 0 /* What's wrong with going through ordinary procedure of quit?
+ − 575 quitting here leaves overriding-terminal-local-map
+ − 576 when you type C-u C-u C-g. */
428
+ − 577 /* If ^G was typed before we got here (that is, before emacs was
+ − 578 idle and waiting for input) then we treat that as an interrupt. */
+ − 579 QUIT;
444
+ − 580 #endif
428
+ − 581
+ − 582 /* If minibuffer on and echo area in use, wait 2 sec and redraw
+ − 583 minibuffer. Treat a ^G here as a command, not an interrupt.
+ − 584 */
+ − 585 if (minibuf_level > 0 && echo_area_active (selected_frame ()))
+ − 586 {
+ − 587 /* Bind dont_check_for_quit to 1 so that C-g gets read in
+ − 588 rather than quitting back to the minibuffer. */
771
+ − 589 int count = begin_dont_check_for_quit ();
1703
+ − 590 if (!NILP (Vminibuffer_echo_wait_function))
+ − 591 call0 (Vminibuffer_echo_wait_function);
+ − 592 else
+ − 593 Fsit_for (make_int (2), Qnil);
428
+ − 594 clear_echo_area (selected_frame (), Qnil, 0);
853
+ − 595 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
771
+ − 596 unbind_to (count);
428
+ − 597 }
+ − 598
+ − 599 Fnext_event (event, Qnil);
+ − 600 Fdispatch_event (event);
+ − 601
+ − 602 if (!was_locked)
+ − 603 any_console_state ();
1204
+ − 604
+ − 605 DO_NOTHING_DISABLING_NO_RETURN_WARNINGS;
428
+ − 606 }
+ − 607 #ifdef LISP_COMMAND_LOOP
+ − 608 UNGCPRO;
+ − 609 return Qnil;
1204
+ − 610 #else
+ − 611 RETURN_NOT_REACHED (Qnil);
428
+ − 612 #endif
+ − 613 }
+ − 614
+ − 615
+ − 616 /**********************************************************************/
+ − 617 /* Initialization */
+ − 618 /**********************************************************************/
+ − 619
+ − 620 void
+ − 621 syms_of_cmdloop (void)
+ − 622 {
733
+ − 623 DEFSYMBOL (Qdisabled_command_hook);
563
+ − 624 DEFSYMBOL (Qcommand_error);
+ − 625 DEFSYMBOL (Qreally_early_error_handler);
+ − 626 DEFSYMBOL (Qtop_level);
+ − 627 DEFSYMBOL (Qerrors_deactivate_region);
428
+ − 628
+ − 629 #ifndef LISP_COMMAND_LOOP
+ − 630 DEFSUBR (Frecursive_edit);
+ − 631 #endif
+ − 632 DEFSUBR (Freally_early_error_handler);
+ − 633 DEFSUBR (Fcommand_loop_1);
+ − 634 }
+ − 635
+ − 636 void
+ − 637 vars_of_cmdloop (void)
+ − 638 {
+ − 639 DEFVAR_INT ("command-loop-level", &command_loop_level /*
+ − 640 Number of recursive edits in progress.
+ − 641 */ );
+ − 642 command_loop_level = 0;
+ − 643
+ − 644 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
+ − 645 Value is called instead of any command that is disabled,
+ − 646 i.e. has a non-nil `disabled' property.
+ − 647 */ );
+ − 648 Vdisabled_command_hook = intern ("disabled-command-hook");
+ − 649
+ − 650 DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
+ − 651 Not yet implemented.
+ − 652 */ );
+ − 653 Vleave_window_hook = Qnil;
+ − 654
+ − 655 DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
+ − 656 Not yet implemented.
+ − 657 */ );
+ − 658 Venter_window_hook = Qnil;
+ − 659
1703
+ − 660 DEFVAR_LISP ("minibuffer-echo-wait-function",
+ − 661 &Vminibuffer_echo_wait_function /*
+ − 662 The function called by command loop when minibuffer was active and
+ − 663 message was displayed (text appeared in \" *Echo Area*\" buffer). It
+ − 664 must wait after displaying message so that user can read it. If the
+ − 665 variable value is `nil', the equivalent of `(sit-for 2)' is run.
+ − 666 */ );
+ − 667 Vminibuffer_echo_wait_function = Qnil;
+ − 668
428
+ − 669 #ifndef LISP_COMMAND_LOOP
+ − 670 DEFVAR_LISP ("top-level", &Vtop_level /*
+ − 671 Form to evaluate when Emacs starts up.
+ − 672 Useful to set before you dump a modified Emacs.
+ − 673 */ );
+ − 674 Vtop_level = Qnil;
+ − 675 #else
+ − 676 DEFVAR_LISP ("command-loop", &Vcommand_loop /*
+ − 677 Function or one argument to call to read and process keyboard commands.
+ − 678 The passed argument specifies whether or not to handle errors.
+ − 679 */ );
+ − 680 Vcommand_loop = Qnil;
+ − 681 #endif /* LISP_COMMAND_LOOP */
+ − 682 }