--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/prim/cmdloop1.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,151 @@
+;;; cmdloop.el
+;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
+ 
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: Not in FSF.
+
+;; Written by Richard Mlynarik 8-Jul-92
+
+;; Putting this in lisp slows things down.
+
+(defun recursive-edit ()
+  "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."
+  (interactive)
+  (let ((command-loop-level (1+ command-loop-level)))
+    (redraw-modeline)
+    (let ((_buf (and (not (eq (current-buffer)
+			      (window-buffer (selected-window))))
+		     (current-buffer))))
+      (unwind-protect
+           ;; command_loop
+           (if (catch 'exit
+                 (let ((standard-output t)
+                       (standard-input t))
+                   ;; command_loop_2
+                   (while t (funcall command-loop t))))
+               ;; turn abort-recursive-edit into a quit
+               (signal 'quit '()))
+        (if _buf (set-buffer _buf))
+        (redraw-modeline)))
+    nil))
+
+;; We demand lexical scope!
+(defun command-loop (_catch_errors)
+  "This function is the default value of the variable command-loop."
+  (setq prefix-arg nil)
+  (setq last-command 't)
+  (cond ((not _catch_errors)
+         (command-loop-1))
+        ((> (recursion-depth) 0)
+         (while (condition-case e
+                    (command-loop-1)
+                  (t (command-error e) t))))
+        (t
+         (if (not (null top-level))
+             ;; On entry to the outer level, run the startup file
+             (condition-case e
+                 (catch 'top-level
+                   (eval top-level))
+               (t (command-error e))))
+
+	 ;; If an error occurred during startup and the initial device
+	 ;; wasn't created, then die now (the error was already printed out
+	 ;; on the terminal device).
+	 (if (and (not (noninteractive))
+		  (or (not (devicep (selected-device)))
+		      (eq 'terminal (device-type (selected-device)))))
+	     (kill-emacs -1))
+
+	 ;; End of -batch run causes exit here.
+         (if (noninteractive)
+             (kill-emacs t))
+
+         (catch 'top-level
+           (while (condition-case e
+                      (command-loop-1)
+                    (t (command-error e) t)))))))
+
+;; Putting this in lisp slows things down a lot; see also comment above.
+;(defun command-loop-1 ()
+;  (let ((_event (allocate-event))
+;      (_old-command-loop command-loop)
+;      ;; We deal with quits ourself
+;      (_old-inhibit-quit inhibit-quit)
+;      (inhibit-quit t))
+;
+;  ;; ## 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.
+;  (and executing-macro
+;       (eq (length executing-macro) 1)
+;       (setq last-command 't))
+;
+;  ;; Keep looping until somebody wants a different command-loop
+;  (while (eq command-loop _old-command-loop)
+;
+;    ;; Make sure current window's buffer is selected.
+;    (set-buffer (window-buffer (selected-window)))
+;
+;    ;; C code had a `QUIT' here so that 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.  The easiest way to do that here is to make a
+;    ;; function call (but pick one the compiler won't optimize away...)
+;    (let ((inhibit-quit _old-inhibit-quit)) (eval nil))
+;
+;    ;; This condition-case was originally just wrapped around the
+;    ;;  call to dispatch-event, but in fact we can have errors signalled
+;    ;;  by process-filters in either sit-for and next-event.  Those errors
+;    ;;  shouldn't be fatal to the command-loop, so we put the condition-case
+;    ;;  here and hope we're not hiding other bugs in the process.
+;    (condition-case e
+;        (progn
+;          (if (and (> (minibuffer-depth) 0)
+;                   (message-displayed-p))
+;              (progn
+;                (sit-for 2)
+;                (message nil)))
+;
+;          (next-event _event)
+;          ;; If ^G was typed while emacs was reading input from the user, 
+;          ;; then it is treated as just another key.  This is what v18
+;          ;; did.  This is bogus because it gives the illusion that one
+;          ;; can bind commands to sequences involving ^G, when really one
+;          ;; can only execute those sequences in non-typeahead contexts.
+;          (setq quit-flag nil)
+;
+;          (let ((inhibit-quit _old-inhibit-quit))
+;            (dispatch-event _event))
+;
+;          ;; check for bogus code trying to use the old method of unreading.
+;          (if (globally-boundp 'unread-command-char)
+;              (progn
+;                (makunbound 'unread-command-char)
+;                (error
+;                 "%S set unread-command-char instead of unread-command-event."
+;		   this-command)))
+;	    )
+;        (t
+;         (command-error e))))))
+
+(setq-default command-loop 'command-loop)