X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/17c17ec9b4d09ab35789c3c158aed6a4ab84f53f..b0c9a334c2f0eb881eff47f590997e746cc3bdb3:/lisp/electric.el diff --git a/lisp/electric.el b/lisp/electric.el index 775c7b246f..4c4f70b093 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -1,13 +1,17 @@ -;;; 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. -;; Principal author K. Shane Hartman +;; Copyright (C) 1985, 1986, 1995, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. + +;; Author: K. Shane Hartman +;; Maintainer: FSF +;; Keywords: extensions ;; 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 1, or (at your option) +;; 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, @@ -16,54 +20,33 @@ ;; 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: ; zaaaaaaap -;; perhaps this should be in subr.el... -(defun shrink-window-if-larger-than-buffer (window) - (save-excursion - (set-buffer (window-buffer window)) - (let ((w (selected-window)) ;save-window-excursion can't win - (buffer-file-name buffer-file-name) - (p (point)) - (n 0) - (window-min-height 0) - (buffer-read-only nil) - (modified (buffer-modified-p)) - (buffer (current-buffer))) - (unwind-protect - (progn - (select-window window) - (goto-char (point-min)) - (while (pos-visible-in-window-p (point-max)) - ;; defeat file locking... don't try this at home, kids! - (setq buffer-file-name nil) - (insert ?\n) (setq n (1+ n))) - (if (> n 0) (shrink-window (1- n)))) - (delete-region (point-min) (point)) - (set-buffer-modified-p modified) - (goto-char p) - (select-window w) - ;; Make sure we unbind buffer-read-only - ;; with the proper current buffer. - (set-buffer buffer))))) - +;;; 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 @@ -72,17 +55,26 @@ (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)) - (= last-input-char ?\C-g)) - (progn (setq unread-command-char -1 + (eq last-input-char ?\C-g)) + (progn (setq unread-command-events nil prefix-arg nil) ;; If it wasn't cancelling a prefix character, then quit. (if (or (= (length (this-command-keys)) 1) @@ -97,8 +89,8 @@ (progn (command-execute cmd) (setq last-command this-command) (if (or (prog1 quit-flag (setq quit-flag nil)) - (= last-input-char ?\C-g)) - (progn (setq unread-command-char -1) + (eq last-input-char ?\C-g)) + (progn (setq unread-command-events nil) (if (not inhibit-quit) (progn (ding) (message "Quit") @@ -132,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 @@ -144,7 +136,7 @@ ;; Switch to buffer in the current window. ;; ;; Then if max-height is nil, and not all of the lines in the buffer -;; are displayed, grab the whole screen. +;; are displayed, grab the whole frame. ;; ;; Returns selected window on buffer positioned at point-min. @@ -153,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) -; electric.el ends here +;;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8 +;;; electric.el ends here