;;; cmdloop.el ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs 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. ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; 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-mode-line) (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-mode-line))) 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)))) (catch 'top-level (while (condition-case e (command-loop-1) (t (command-error e) t)))) (if (noninteractive) ;; End of file in -batch run causes exit here. (kill-emacs 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)