Mercurial > hg > xemacs-beta

comparison lisp/prim/cmdloop1.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; cmdloop.el
2 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
3
4 ;; This file is part of XEmacs.
5
6 ;; XEmacs is free software; you can redistribute it and/or modify it
7 ;; under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
9 ;; any later version.
10
11 ;; XEmacs is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
15
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with XEmacs; see the file COPYING. If not, write to the Free
18 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ;;; Synched up with: Not in FSF.
21
22 ;; Written by Richard Mlynarik 8-Jul-92
23
24 ;; Putting this in lisp slows things down.
25
26 (defun recursive-edit ()
27 "Invoke the editor command loop recursively.
28 To get out of the recursive edit, a command can do `(throw 'exit nil)';
29 that tells this function to return.
30 Alternately, `(throw 'exit t)' makes this function signal an error."
31 (interactive)
32 (let ((command-loop-level (1+ command-loop-level)))
33 (redraw-modeline)
34 (let ((_buf (and (not (eq (current-buffer)
35 (window-buffer (selected-window))))
36 (current-buffer))))
37 (unwind-protect
38 ;; command_loop
39 (if (catch 'exit
40 (let ((standard-output t)
41 (standard-input t))
42 ;; command_loop_2
43 (while t (funcall command-loop t))))
44 ;; turn abort-recursive-edit into a quit
45 (signal 'quit '()))
46 (if _buf (set-buffer _buf))
47 (redraw-modeline)))
48 nil))
49
50 ;; We demand lexical scope!
51 (defun command-loop (_catch_errors)
52 "This function is the default value of the variable command-loop."
53 (setq prefix-arg nil)
54 (setq last-command 't)
55 (cond ((not _catch_errors)
56 (command-loop-1))
57 ((> (recursion-depth) 0)
58 (while (condition-case e
59 (command-loop-1)
60 (t (command-error e) t))))
61 (t
62 (if (not (null top-level))
63 ;; On entry to the outer level, run the startup file
64 (condition-case e
65 (catch 'top-level
66 (eval top-level))
67 (t (command-error e))))
68
69 ;; If an error occurred during startup and the initial device
70 ;; wasn't created, then die now (the error was already printed out
71 ;; on the terminal device).
72 (if (and (not (noninteractive))
73 (or (not (devicep (selected-device)))
74 (eq 'terminal (device-type (selected-device)))))
75 (kill-emacs -1))
76
77 ;; End of -batch run causes exit here.
78 (if (noninteractive)
79 (kill-emacs t))
80
81 (catch 'top-level
82 (while (condition-case e
83 (command-loop-1)
84 (t (command-error e) t)))))))
85
86 ;; Putting this in lisp slows things down a lot; see also comment above.
87 ;(defun command-loop-1 ()
88 ; (let ((_event (allocate-event))
89 ; (_old-command-loop command-loop)
90 ; ;; We deal with quits ourself
91 ; (_old-inhibit-quit inhibit-quit)
92 ; (inhibit-quit t))
93 ;
94 ; ;; ## cancel_echoing();
95 ;
96 ; ;; This magically makes single character keyboard macros work just
97 ; ;; like the real thing. This is slightly bogus, but it's in here for
98 ; ;; compatibility with Emacs 18.
99 ; ;; It's not even clear what the "right thing" is.
100 ; (and executing-macro
101 ; (eq (length executing-macro) 1)
102 ; (setq last-command 't))
103 ;
104 ; ;; Keep looping until somebody wants a different command-loop
105 ; (while (eq command-loop _old-command-loop)
106 ;
107 ; ;; Make sure current window's buffer is selected.
108 ; (set-buffer (window-buffer (selected-window)))
109 ;
110 ; ;; C code had a `QUIT' here so that if ^G was typed before we got here
111 ; ;; (that is, before emacs was idle and waiting for input) then we treat
112 ; ;; that as an interrupt. The easiest way to do that here is to make a
113 ; ;; function call (but pick one the compiler won't optimize away...)
114 ; (let ((inhibit-quit _old-inhibit-quit)) (eval nil))
115 ;
116 ; ;; This condition-case was originally just wrapped around the
117 ; ;; call to dispatch-event, but in fact we can have errors signalled
118 ; ;; by process-filters in either sit-for and next-event. Those errors
119 ; ;; shouldn't be fatal to the command-loop, so we put the condition-case
120 ; ;; here and hope we're not hiding other bugs in the process.
121 ; (condition-case e
122 ; (progn
123 ; (if (and (> (minibuffer-depth) 0)
124 ; (message-displayed-p))
125 ; (progn
126 ; (sit-for 2)
127 ; (message nil)))
128 ;
129 ; (next-event _event)
130 ; ;; If ^G was typed while emacs was reading input from the user,
131 ; ;; then it is treated as just another key. This is what v18
132 ; ;; did. This is bogus because it gives the illusion that one
133 ; ;; can bind commands to sequences involving ^G, when really one
134 ; ;; can only execute those sequences in non-typeahead contexts.
135 ; (setq quit-flag nil)
136 ;
137 ; (let ((inhibit-quit _old-inhibit-quit))
138 ; (dispatch-event _event))
139 ;
140 ; ;; check for bogus code trying to use the old method of unreading.
141 ; (if (globally-boundp 'unread-command-char)
142 ; (progn
143 ; (makunbound 'unread-command-char)
144 ; (error
145 ; "%S set unread-command-char instead of unread-command-event."
146 ; this-command)))
147 ; )
148 ; (t
149 ; (command-error e))))))
150
151 (setq-default command-loop 'command-loop)