Source

XEmacs / src / cmdloop.c

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
/* Editor command loop.
   Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
   Copyright (C) 1995, 1996 Ben Wing.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Mule 2.0.  Not synched with FSF.
   This was renamed from keyboard.c.  However, it only contains the
   command-loop stuff from FSF's keyboard.c; all the rest is in
   event*.c, console.c, or signal.c. */

/* #### This module purports to separate out the command-loop stuff
   from event-stream.c, but it doesn't really.  Perhaps this file
   should just be merged into event-stream.c, given its shortness. */

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "commands.h"
#include "frame.h"
#include "events.h"
#include "macros.h"
#include "window.h"

/* Current depth in recursive edits.  */
int command_loop_level;

/* Total number of times command_loop has read a key sequence.  */
int num_input_keys;

#ifndef LISP_COMMAND_LOOP
/* Form to evaluate (if non-nil) when Emacs is started.  */
Lisp_Object Vtop_level;
#else
/* Function to call to evaluate to read and process events.  */
Lisp_Object Vcommand_loop;
#endif /* LISP_COMMAND_LOOP */

Lisp_Object Venter_window_hook, Vleave_window_hook;

/* The error handler.  */
Lisp_Object Qcommand_error;

/* The emergency error handler, before we're ready.  */
Lisp_Object Qreally_early_error_handler;

static Lisp_Object command_loop_1 (Lisp_Object dummy);

/* There are two possible command loops -- one written entirely in
   C and one written mostly in Lisp, except stuff written in C for
   speed.  The advantage of the Lisp command loop is that the user
   can specify their own command loop to use by changing the variable
   `command-loop'.  Its disadvantage is that it's slow. */

static Lisp_Object
default_error_handler (Lisp_Object data)
{
  int speccount = specpdl_depth ();

  Fding (Qnil, Qnil, Qnil);
  zmacs_deactivate_region ();
  Fdiscard_input ();
  specbind (Qinhibit_quit, Qt);
  Vstandard_output = Qt;
  Vstandard_input = Qt;
  Vexecuting_macro = Qnil;
  clear_echo_area (selected_frame (), Qnil, 0);
  data = Fprin1_to_string (data, Qnil);
  message ("Error: %s", XSTRING_DATA (data));
  check_quit (); /* make Vquit_flag accurate */
  Vquit_flag = Qnil;
  return (unbind_to (speccount, Qt));
}

DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /*
You should almost certainly not be using this.
*/
       (x))
{
  /* This is an error handler used when we're running temacs and when
     we're in the early stages of XEmacs.  No errors ought to be
     occurring in those cases (or they ought to be trapped and
     dealt with elsewhere), but if an error slips through, we need
     to deal with it.  We could write this function in Lisp (and it
     used to be this way, at the beginning of loadup.el), but we do
     it this way in case an error occurs before we get to loading
     loadup.el.  Note that there is also an `early-error-handler',
     used in startup.el to catch more reasonable errors that
     might occur during startup if the sysadmin or whoever fucked
     up.  This function is more conservative in what it does
     and is used only as a last resort, indicating that the
     programmer himself fucked up somewhere. */
  stderr_out ("*** Error in XEmacs initialization");
  Fprint (x, Qexternal_debugging_output);
  stderr_out ("*** Backtrace\n");
  Fbacktrace (Qexternal_debugging_output, Qt);
  stderr_out ("*** Killing XEmacs\n");
  return Fkill_emacs (make_int (-1));
}


/**********************************************************************/
/*                     Command-loop (in C)                            */
/**********************************************************************/

#ifndef LISP_COMMAND_LOOP

/* The guts of the command loop are in command_loop_1().  This function
   doesn't catch errors, though -- that's the job of command_loop_2(),
   which is a condition-case wrapper around command_loop_1().
   command_loop_1() never returns, but may get thrown out of.

   When an error occurs, cmd_error() is called, which usually
   invokes the Lisp error handler in `command-error'; however,
   a default error handler is provided if `command-error' is nil
   (e.g. during startup).  The purpose of the error handler is
   simply to display the error message and do associated cleanup;
   it does not need to throw anywhere.  When the error handler
   finishes, the condition-case in command_loop_2() will finish and
   command_loop_2() will reinvoke command_loop_1().

   command_loop_2() is invoked from three places: from
   initial_command_loop() (called from main() at the end of
   internal initialization), from the Lisp function `recursive-edit',
   and from call_command_loop().

   call_command_loop() is called when a macro is started and when the
   minibuffer is entered; normal termination of the macro or
   minibuffer causes a throw out of the recursive command loop. (To
   'execute-kbd-macro for macros and 'exit for minibuffers.  Note also
   that the low-level minibuffer-entering function,
   `read-minibuffer-internal', provides its own error handling and
   does not need command_loop_2()'s error encapsulation; so it tells
   call_command_loop() to invoke command_loop_1() directly.)

   Note that both read-minibuffer-internal and recursive-edit set
   up a catch for 'exit; this is why `abort-recursive-edit', which
   throws to this catch, exits out of either one.

   initial_command_loop(), called from main(), sets up a catch
   for 'top-level when invoking command_loop_2(), allowing functions
   to throw all the way to the top level if they really need to.
   Before invoking command_loop_2(), initial_command_loop() calls
   top_level_1(), which handles all of the startup stuff (creating
   the initial frame, handling the command-line options, loading
   the user's .emacs file, etc.).  The function that actually does this
   is in Lisp and is pointed to by the variable `top-level';
   normally this function is `normal-top-level'.  top_level_1() is
   just an error-handling wrapper similar to command_loop_2().
   Note also that initial_command_loop() sets up a catch for 'top-level
   when invoking top_level_1(), just like when it invokes
   command_loop_2(). */


static Lisp_Object
cmd_error (Lisp_Object data, Lisp_Object dummy)
{
  /* This function can GC */
  check_quit (); /* make Vquit_flag accurate */
  Vquit_flag = Qnil;

  any_console_state ();

  if (!NILP (Ffboundp (Qcommand_error)))
    return call1 (Qcommand_error, data);

  return default_error_handler (data);
}

static Lisp_Object
top_level_1 (Lisp_Object dummy)
{
  /* This function can GC */
  /* On entry to the outer level, run the startup file */
  if (!NILP (Vtop_level))
    condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
#if 1
  else
    {
      message ("\ntemacs can only be run in -batch mode.");
      noninteractive = 1; /* prevent things under kill-emacs from blowing up */
      Fkill_emacs (make_int (-1));
    }
#else
  else if (purify_flag)
    message ("Bare impure Emacs (standard Lisp code not loaded)");
  else
    message ("Bare Emacs (standard Lisp code not loaded)");
#endif

  return Qnil;
}

/* Here we catch errors in execution of commands within the
   editing loop, and reenter the editing loop.
   When there is an error, cmd_error runs and the call
   to condition_case_1() returns. */

/* Avoid confusing the compiler. A helper function for command_loop_2 */
static DOESNT_RETURN
command_loop_3 (void)
{
  /* This function can GC */
  for (;;)
    {
      condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil);
      /* #### wrong with selected-console? */
      /* See command in initial_command_loop about why this value
	 is 0. */
      reset_this_command_keys (Vselected_console, 0);
    }
}

static Lisp_Object
command_loop_2 (Lisp_Object dummy)
{
  command_loop_3(); /* doesn't return */
  return Qnil;
}

/* This is called from emacs.c when it's done with initialization. */

DOESNT_RETURN
initial_command_loop (Lisp_Object load_me)
{
  /* This function can GC */
  if (!NILP (load_me))
    Vtop_level = list2 (Qload, load_me);

  /* First deal with startup and command-line arguments.  A throw
     to 'top-level gets us back here directly (does this ever happen?).
     Otherwise, this function will return normally when all command-
     line arguments have been processed, the user's initialization
     file has been read in, and the first frame has been created. */
  internal_catch (Qtop_level, top_level_1, Qnil, 0);

  /* If an error occurred during startup and the initial console
     wasn't created, then die now (the error was already printed out
     on the terminal device). */
  if (!noninteractive &&
      (!CONSOLEP (Vselected_console) ||
       CONSOLE_STREAM_P (XCONSOLE (Vselected_console))))
    Fkill_emacs (make_int (-1));
  
  /* End of -batch run causes exit here. */
  if (noninteractive)
    Fkill_emacs (Qt);

  for (;;)
    {
      command_loop_level = 0;
      MARK_MODELINE_CHANGED;
      /* Now invoke the command loop.  It never returns; however, a
	 throw to 'top-level will place us at the end of this loop. */
      internal_catch (Qtop_level, command_loop_2, Qnil, 0);
      /* #### wrong with selected-console? */
      /* We don't actually call clear_echo_area() here, partially
	 at least because that runs Lisp code and it may be unsafe
	 to do so -- we are outside of the normal catches for
	 errors and such. */
      reset_this_command_keys (Vselected_console, 0);
    }
}

/* This function is invoked when a macro or minibuffer starts up.
   Normal termination of the macro or minibuffer causes a throw past us.
   See the comment above.

   Note that this function never returns (but may be thrown out of). */

Lisp_Object
call_command_loop (Lisp_Object catch_errors)
{
  /* This function can GC */
  if (NILP (catch_errors))
    return (command_loop_1 (Qnil));
  else
    return (command_loop_2 (Qnil));
}

static Lisp_Object
recursive_edit_unwind (Lisp_Object buffer)
{
  if (!NILP (buffer))
    Fset_buffer (buffer);

  command_loop_level--;
  MARK_MODELINE_CHANGED;

  return Qnil;
}

DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /*
Invoke the editor command loop recursively.
To get out of the recursive edit, a command can do `(throw 'exit nil)';
that tells this function to return.
Alternately, `(throw 'exit t)' makes this function signal an error.
*/
       ())
{
  /* This function can GC */
  Lisp_Object val;
  int speccount = specpdl_depth ();

  command_loop_level++;
  MARK_MODELINE_CHANGED;

  record_unwind_protect (recursive_edit_unwind,
			 ((current_buffer
                           != XBUFFER (XWINDOW (Fselected_window
						(Qnil))->buffer))
                          ? Fcurrent_buffer ()
                          : Qnil));

  specbind (Qstandard_output, Qt);
  specbind (Qstandard_input, Qt);

  val = internal_catch (Qexit, command_loop_2, Qnil, 0);

  if (EQ (val, Qt))
    /* Turn abort-recursive-edit into a quit. */
    Fsignal (Qquit, Qnil);

  return unbind_to (speccount, Qnil);
}

#endif /* !LISP_COMMAND_LOOP */


/**********************************************************************/
/*             Alternate command-loop (largely in Lisp)               */
/**********************************************************************/

#ifdef LISP_COMMAND_LOOP

static Lisp_Object
load1 (Lisp_Object name)
{
  /* This function can GC */
  call4 (Qload, name, Qnil, Qt, Qnil);
  return (Qnil);
}

/* emergency backups for cold-load-stream use */
static Lisp_Object
cold_load_command_error (Lisp_Object datum, Lisp_Object ignored)
{
  /* This function can GC */
  check_quit (); /* make Vquit_flag accurate */
  Vquit_flag = Qnil;

  return default_error_handler (datum);
}

static Lisp_Object
cold_load_command_loop (Lisp_Object dummy)
{
  /* This function can GC */
  return (condition_case_1 (Qt,
                            command_loop_1, Qnil,
                            cold_load_command_error, Qnil));
}

Lisp_Object
call_command_loop (Lisp_Object catch_errors)
{
  /* This function can GC */
  reset_this_command_keys (Vselected_console, Qnil); /* #### bleagh */

 loop:
  for (;;)
    {
      if (NILP (Vcommand_loop))
	break;
      call1 (Vcommand_loop, catch_errors);
    }

  /* This isn't a "correct" definition, but you're pretty hosed if
     you broke "command-loop" anyway */
  /* #### not correct with Vselected_console */
  XCONSOLE (Vselected_console)->prefix_arg = Qnil;
  if (NILP (catch_errors))
    Fcommand_loop_1 ();
  else 
    internal_catch (Qtop_level,
                    cold_load_command_loop, Qnil, 0);
  goto loop;
  return Qnil;
}

static Lisp_Object
initial_error_handler (Lisp_Object datum, Lisp_Object ignored)
{
  /* This function can GC */
  Vcommand_loop =  Qnil;
  Fding (Qnil, Qnil, Qnil);

  if (CONSP (datum) && EQ (XCAR (datum), Qquit))
    /* Don't bother with the message */
    return (Qt);
      
  message ("Error in command-loop!!");
  Fset (intern ("last-error"), datum); /* #### Better/different name? */
  Fsit_for (make_int (2), Qnil);
  cold_load_command_error (datum, Qnil);
  return (Qt);
}

DOESNT_RETURN
initial_command_loop (Lisp_Object load_me)
{
  /* This function can GC */
  if (!NILP (load_me))
    {
      if (!NILP (condition_case_1 (Qt, load1, load_me,
                                   initial_error_handler, Qnil)))
	Fkill_emacs (make_int (-1));
    }

  for (;;)
    {
      command_loop_level = 0;
      MARK_MODELINE_CHANGED;

      condition_case_1 (Qt,
			call_command_loop, Qtop_level,
			initial_error_handler, Qnil);
    }
}

#endif /* LISP_COMMAND_LOOP */


/**********************************************************************/
/*                     Guts of command loop                           */
/**********************************************************************/

static Lisp_Object
command_loop_1 (Lisp_Object dummy)
{
  /* This function can GC */
  /* #### not correct with Vselected_console */
  XCONSOLE (Vselected_console)->prefix_arg = Qnil;
  return (Fcommand_loop_1 ());
}

/* This is the actual command reading loop, sans error-handling
   encapsulation.  This is used for both the C and Lisp command
   loops.  Originally this function was written in Lisp when
   the Lisp command loop was used, but it was too slow that way.

   Under the C command loop, this function will never return
   (although someone might throw past it).  Under the Lisp
   command loop, this will return only when the user specifies
   a new command loop by changing the command-loop variable. */

DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /*
Invoke the internals of the canonical editor command loop.
Don't call this unless you know what you're doing.
*/
       ())
{
  /* This function can GC */
  Lisp_Object event = Fmake_event ();
  Lisp_Object old_loop = Qnil;
  struct gcpro gcpro1, gcpro2;
  int was_locked = in_single_console_state ();
  GCPRO2 (event, old_loop);

  /* cancel_echoing (); */
  /* This magically makes single character keyboard macros work just
     like the real thing.  This is slightly bogus, but it's in here for
     compatibility with Emacs 18.  It's not even clear what the "right
     thing" is. */
  if (!(((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))
         && XINT (Flength (Vexecuting_macro)) == 1)))
    Vlast_command = Qt;

#ifndef LISP_COMMAND_LOOP
  while (1)
#else
  old_loop = Vcommand_loop;
  while (EQ (Vcommand_loop, old_loop))
#endif /* LISP_COMMAND_LOOP */
    {
      /* Make sure the current window's buffer is selected.  */
      {
	Lisp_Object selected_window = Fselected_window (Qnil);

	if (!NILP (selected_window) &&
	    (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer))
	  {
	    set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
	  }
      }

      /* If ^G was typed before we got here (that is, before emacs was
	 idle and waiting for input) then we treat that as an interrupt. */
      QUIT;

      /* If minibuffer on and echo area in use, wait 2 sec and redraw
	 minibuffer.  Treat a ^G here as a command, not an interrupt.
       */
      if (minibuf_level > 0 && echo_area_active (selected_frame ()))
	{
	  /* Bind dont_check_for_quit to 1 so that C-g gets read in
	     rather than quitting back to the minibuffer.  */
	  int count = specpdl_depth ();
	  begin_dont_check_for_quit ();
	  Fsit_for (make_int (2), Qnil);
	  clear_echo_area (selected_frame (), Qnil, 0);
	  unbind_to (count, Qnil);
	}

      Fnext_event (event, Qnil);
      /* If ^G was typed while emacs was reading input from the user, then
	 Fnext_event() will have read it as a normal event and
	 next_event_internal() will have set Vquit_flag.  We reset this
	 so that the ^G is treated as just another key.  This is strange,
	 but it is what emacs 18 did.

	 Do not call check_quit() here. */
      Vquit_flag = Qnil;
      Fdispatch_event (event);

      if (!was_locked)
	any_console_state ();
#if defined (__SUNPRO_C) || (defined (DEC_ALPHA) && defined (OSF1))
      if (0) return Qnil; /* Shut up compiler */
#endif
    }
#ifdef LISP_COMMAND_LOOP
  UNGCPRO;
  return Qnil;
#endif
}


/**********************************************************************/
/*                         Initialization                             */
/**********************************************************************/

void
syms_of_cmdloop (void)
{
  defsymbol (&Qcommand_error, "command-error");
  defsymbol (&Qreally_early_error_handler, "really-early-error-handler");
  defsymbol (&Qtop_level, "top-level");

#ifndef LISP_COMMAND_LOOP
  DEFSUBR (Frecursive_edit);
#endif
  DEFSUBR (Freally_early_error_handler);
  DEFSUBR (Fcommand_loop_1);
}

void
vars_of_cmdloop (void)
{
  DEFVAR_INT ("command-loop-level", &command_loop_level /*
Number of recursive edits in progress.
*/ );
  command_loop_level = 0;

  DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /*
Value is called instead of any command that is disabled,
i.e. has a non-nil `disabled' property.
*/ );
  Vdisabled_command_hook = intern ("disabled-command-hook");

  DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /*
Not yet implemented.
*/ );
  Vleave_window_hook = Qnil;

  DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /*
Not yet implemented.
*/ );
  Venter_window_hook = Qnil;

#ifndef LISP_COMMAND_LOOP
  DEFVAR_LISP ("top-level", &Vtop_level /*
Form to evaluate when Emacs starts up.
Useful to set before you dump a modified Emacs.
*/ );
  Vtop_level = Qnil;
#else
  DEFVAR_LISP ("command-loop", &Vcommand_loop /*
Function or one argument to call to read and process keyboard commands.
The passed argument specifies whether or not to handle errors.
*/ );
  Vcommand_loop = Qnil;
#endif /* LISP_COMMAND_LOOP */
}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.