X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7dc8eff950a11c718e9dade91060058453825c13..ad8b6d89ef6f038921104c219ff9010ee08cb0ca:/lisp/electric.el diff --git a/lisp/electric.el b/lisp/electric.el index 39d690f5ff..4c4f70b093 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -1,6 +1,7 @@ -;;; electric.el --- window maker and Command loop for `electric' modes. +;;; electric.el --- window maker and Command loop for `electric' modes -;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1995, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF @@ -19,8 +20,9 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -29,18 +31,22 @@ ;;; Code: ;; This loop is the guts for non-standard modes which retain control -;; until some event occurs. It is a `do-forever', the only way out is to -;; throw. It assumes that you have set up the keymap, window, and +;; until some event occurs. It is a `do-forever', the only way out is +;; to throw. It assumes that you have set up the keymap, window, and ;; everything else: all it does is read commands and execute them - ;; providing error messages should one occur (if there is no loop ;; function - which see). The required argument is a tag which should -;; expect a value of nil if the user decides to punt. The -;; second argument is a prompt string (defaults to "->"). Given third -;; argument non-nil, it INHIBITS quitting unless the user types C-g at -;; toplevel. This is so user can do things like C-u C-g and not get -;; thrown out. Fourth argument, if non-nil, should be a function of two -;; arguments which is called after every command is executed. The fifth -;; argument, if provided, is the state variable for the function. If the +;; expect a value of nil if the user decides to punt. The second +;; argument is the prompt to be used: if nil, use "->", if 'noprompt, +;; don't use a prompt, if a string, use that string as prompt, and if +;; a function of no variable, it will be evaluated in every iteration +;; of the loop and its return value, which can be nil, 'noprompt or a +;; string, will be used as prompt. Given third argument non-nil, it +;; INHIBITS quitting unless the user types C-g at toplevel. This is +;; so user can do things like C-u C-g and not get thrown out. Fourth +;; argument, if non-nil, should be a function of two arguments which +;; is called after every command is executed. The fifth argument, if +;; provided, is the state variable for the function. If the ;; loop-function gets an error, the loop will abort WITHOUT throwing ;; (moral: use unwind-protect around call to this function for any ;; critical stuff). The second argument for the loop function is the @@ -49,14 +55,23 @@ (defun Electric-command-loop (return-tag &optional prompt inhibit-quit loop-function loop-state) - (if (not prompt) (setq prompt "->")) - (let (cmd (err nil)) + + (let (cmd + (err nil) + (prompt-string prompt)) (while t - (setq cmd (read-key-sequence (if (stringp prompt) - prompt (funcall prompt)))) + (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt))) + (setq prompt-string (funcall prompt))) + (if (not (stringp prompt-string)) + (if (eq prompt-string 'noprompt) + (setq prompt-string nil) + (setq prompt-string "->"))) + (setq cmd (read-key-sequence prompt-string)) (setq last-command-char (aref cmd (1- (length cmd))) - this-command (key-binding cmd) + this-command (key-binding cmd t) cmd this-command) + ;; This makes universal-argument-other-key work. + (setq universal-argument-num-events 0) (if (or (prog1 quit-flag (setq quit-flag nil)) (eq last-input-char ?\C-g)) (progn (setq unread-command-events nil @@ -109,7 +124,7 @@ (ding) (throw return-tag nil)) -;; This function is like pop-to-buffer, sort of. +;; This function is like pop-to-buffer, sort of. ;; The algorithm is ;; If there is a window displaying buffer ;; Select it @@ -130,35 +145,21 @@ (buf (get-buffer buffer)) (one-window (one-window-p t)) (pop-up-windows t) - (target-height) - (lines)) + (pop-up-frames nil)) (if (not buf) (error "Buffer %s does not exist" buffer) - (save-excursion - (set-buffer buf) - (setq lines (count-lines (point-min) (point-max))) - (setq target-height - (min (max (if max-height (min max-height (1+ lines)) (1+ lines)) - window-min-height) - (save-window-excursion - (delete-other-windows) - (1- (window-height (selected-window))))))) (cond ((and (eq (window-buffer win) buf)) (select-window win)) (one-window - (goto-char (window-start win)) (pop-to-buffer buffer) - (setq win (selected-window)) - (enlarge-window (- target-height (window-height win)))) + (setq win (selected-window))) (t (switch-to-buffer buf))) - (if (and (not max-height) - (> target-height (window-height (selected-window)))) - (progn (goto-char (window-start win)) - (enlarge-window (- target-height (window-height win))))) + (fit-window-to-buffer win max-height) (goto-char (point-min)) win))) (provide 'electric) +;;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8 ;;; electric.el ends here