X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/21f3d1d389c4e37dc2323062082b7c332d2aa021..1b74c4346e92c9ac1ae0575c2ad69f8d81126d7e:/lisp/winner.el diff --git a/lisp/winner.el b/lisp/winner.el index 15a86994c7..0fbd0221e4 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,11 +1,12 @@ -;;; winner.el --- Restore window configuration or change buffer +;;; winner.el --- Restore old window configurations -;; Copyright (C) 1997 Free Software Foundation. Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation. Inc. -;; Author: Ivar Rummelhoff -;; Maintainer: Ivar Rummelhoff +;; Author: Ivar Rummelhoff ;; Created: 27 Feb 1997 -;; Keywords: extensions,windows +;; Time-stamp: <2002-02-20 22:06:58 ivarru> +;; Keywords: convenience frames ;; This file is part of GNU Emacs. @@ -21,325 +22,464 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; -;; winner.el provides a minor mode (`winner-mode') that does -;; essentially two things: -;; -;; 1) It keeps track of changing window configurations, so that -;; when you wish to go back to a previous view, all you have -;; to do is to press C-left a couple of times. -;; -;; 2) It lets you switch to other buffers by pressing C-right. -;; -;; To use Winner mode, put this line in your .emacs file: -;; -;; (add-hook 'after-init-hook (lambda () (winner-mode 1))) - -;; Details: -;; -;; 1. You may of course decide to use other bindings than those -;; mentioned above. Just set these variables in your .emacs: -;; -;; `winner-prev-event' -;; `winner-next-event' -;; -;; 2. When you have found the view of your choice -;; (using your favourite keys), you may press ctrl-space -;; (`winner-max-event') to `delete-other-windows'. -;; -;; 3. Winner now keeps one configuration stack for each frame. -;; -;; -;; -;; Yours sincerely, Ivar Rummelhoff -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: - - -;;;; Variables you may want to change +;; Winner mode is a global minor mode that records the changes in the +;; window configuration (i.e. how the frames are partitioned into +;; windows) so that the changes can be "undone" using the command +;; `winner-undo'. By default this one is bound to the key sequence +;; ctrl-c left. If you change your mind (while undoing), you can +;; press ctrl-c right (calling `winner-redo'). Even though it uses +;; some features of Emacs20.3, winner.el should also work with +;; Emacs19.34 and XEmacs20, provided that the installed version of +;; custom is not obsolete. -(defvar winner-prev-event 'C-left - "Winner mode binds this event to the command `winner-previous'.") +;; Winner mode was improved August 1998. +;; Further improvements February 2002. -(defvar winner-next-event 'C-right - "Winner mode binds this event to the command `winner-next'.") - -(defvar winner-max-event 67108896 ; CTRL-space - "Event for deleting other windows -after having selected a view with Winner. - -The normal functions of this event will also be performed. -In the default case (CTRL-SPACE) the mark will be set.") - -(defvar winner-skip-buffers - '("*Messages*", - "*Compile-Log*", - ".newsrc-dribble", - "*Completions*", - "*Buffer list*") - "Exclude these buffer names -from any \(Winner mode\) list of buffers.") - -(defvar winner-skip-regexps '("^ ") - "Exclude buffers with names matching any of these regexps. -..from any \(Winner mode\) list of buffers. - -By default `winner-skip-regexps' is set to \(\"^ \"\), -which excludes \"invisible buffers\".") - - -(defvar winner-limit 50 - "Winner will save no more than 2 * `winner-limit' window configurations. -\(.. and no less than `winner-limit'.\)") +;;; Code: -(defvar winner-mode-hook nil - "Functions to run whenever Winner mode is turned on.") +(eval-when-compile + (require 'cl)) -(defvar winner-mode-leave-hook nil - "Functions to run whenever Winner mode is turned off.") -(defvar winner-dont-bind-my-keys nil - "If non-nil: Do not use `winner-mode-map' in Winner mode.") +(defmacro winner-active-region () + (if (fboundp 'region-active-p) + '(region-active-p) + 'mark-active)) +(defsetf winner-active-region () (store) + (if (fboundp 'zmacs-activate-region) + `(if ,store (zmacs-activate-region) + (zmacs-deactivate-region)) + `(setq mark-active ,store))) +(defalias 'winner-edges + (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) +(defalias 'winner-window-list + (if (featurep 'xemacs) + (lambda () (delq (minibuffer-window) (window-list nil 0))) + (lambda () (window-list nil 0)))) -;;;; Winner mode +(require 'ring) -(eval-when-compile (require 'cl)) +(unless (fboundp 'defgroup) + (defmacro defgroup (&rest rest))) +(defgroup winner nil + "Restoring window configurations." + :group 'windows) -(defvar winner-mode nil) ; For the modeline. -(defvar winner-mode-map nil "Keymap for Winner mode.") +(unless (fboundp 'defcustom) + (defmacro defcustom (symbol &optional initvalue docs &rest rest) + (list 'defvar symbol initvalue docs))) ;;;###autoload -(defun winner-mode (&optional arg) +(defcustom winner-mode nil "Toggle Winner mode. -With arg, turn Winner mode on if and only if arg is positive." - (interactive "P") - (let ((on-p (if arg (> (prefix-numeric-value arg) 0) - (not winner-mode)))) - (cond - (on-p (let ((winner-frames-changed (frame-list))) - (winner-do-save)) ; Save current configurations - (add-hook 'window-configuration-change-hook 'winner-save-configuration) - (setq winner-mode t) - (run-hooks 'winner-mode-hook)) - (t (remove-hook 'window-configuration-change-hook 'winner-save-configuration) - (when winner-mode - (setq winner-mode nil) - (run-hooks 'winner-mode-leave-hook)))) - (force-mode-line-update))) - - -;; List of frames which have changed -(defvar winner-frames-changed nil) - -;; Time to save the window configuration. -(defun winner-save-configuration () - (push (selected-frame) winner-frames-changed) - (add-hook 'post-command-hook 'winner-do-save)) - - -(defun winner-do-save () - (let ((current (selected-frame))) - (unwind-protect - (do ((frames winner-frames-changed (cdr frames))) - ((null frames)) - (unless (memq (car frames) (cdr frames)) - ;; Process each frame once. - (select-frame (car frames)) - (winner-push (current-window-configuration) (car frames)))) - (setq winner-frames-changed nil) - (select-frame current) - (remove-hook 'post-command-hook 'winner-do-save)))) +Setting this variable directly does not take effect; +use either \\[customize] or the function `winner-mode'." + :set #'(lambda (symbol value) (funcall symbol (or value 0))) + :initialize 'custom-initialize-default + :type 'boolean + :group 'winner + :require 'winner) +(defcustom winner-dont-bind-my-keys nil + "If non-nil: Do not use `winner-mode-map' in Winner mode." + :type 'boolean + :group 'winner) +(defcustom winner-ring-size 200 + "Maximum number of stored window configurations per frame." + :type 'integer + :group 'winner) +(defcustom winner-boring-buffers '("*Completions*") + "`winner-undo' will not restore windows displaying any of these buffers. +You may want to include buffer names such as *Help*, *Apropos*, +*Buffer List*, *info* and *Compile-Log*." + :type '(repeat string) + :group 'winner) -;;;; Configuration stacks (one for each frame) - - -(defvar winner-stacks nil) ; ------ " ------ - - -;; A stack of window configurations with some additional information. -(defstruct (winner-stack - (:constructor winner-stack-new - (config &aux - (data (list config)) - (place data)))) - data place (count 1)) - - -;; Return the stack of this frame -(defun winner-stack (frame) - (let ((stack (cdr (assq frame winner-stacks)))) - (if stack (winner-stack-data stack) - ;; Else make new stack - (letf (((selected-frame) frame)) - (let ((config (current-window-configuration))) - (push (cons frame (winner-stack-new config)) - winner-stacks) - (list config)))))) - -;; Push this window configuration on the right stack, -;; but make sure the stack doesn't get too large etc... -(defun winner-push (config frame) - (let ((this (cdr (assq frame winner-stacks)))) - (if (not this) (push (cons frame (winner-stack-new config)) - winner-stacks) - (push config (winner-stack-data this)) - (when (> (incf (winner-stack-count this)) winner-limit) - ;; No more than 2*winner-limit configs - (setcdr (winner-stack-place this) nil) - (setf (winner-stack-place this) - (winner-stack-data this)) - (setf (winner-stack-count this) 1))))) - - +;;;; Saving old configurations (internal variables and subroutines) + + +;;; Current configuration + +;; List the windows according to their edges. +(defun winner-sorted-window-list () + (sort (winner-window-list) + (lambda (x y) + (loop for a in (winner-edges x) + for b in (winner-edges y) + while (= a b) + finally return (< a b))))) + +(defun winner-win-data () + ;; Essential properties of the windows in the selected frame. + (loop for win in (winner-sorted-window-list) + collect (cons (winner-edges win) (window-buffer win)))) + +;; This variable is updated with the current window configuration +;; every time it changes. +(defvar winner-currents nil) + +;; The current configuration (+ the buffers involved). +(defsubst winner-conf () + (cons (current-window-configuration) + (winner-win-data))) + + +;; Save current configuration. +;; (Called below by `winner-save-old-configurations'). +(defun winner-remember () + (let ((entry (assq (selected-frame) winner-currents))) + (if entry (setcdr entry (winner-conf)) + (push (cons (selected-frame) (winner-conf)) + winner-currents)))) + +;; Consult `winner-currents'. +(defun winner-configuration (&optional frame) + (or (cdr (assq (or frame (selected-frame)) winner-currents)) + (letf (((selected-frame) frame)) + (winner-conf)))) +;;; Saved configurations +;; This variable contains the window cofiguration rings. +;; The key in this alist is the frame. +(defvar winner-ring-alist nil) +;; Find the right ring. If it does not exist, create one. +(defsubst winner-ring (frame) + (or (cdr (assq frame winner-ring-alist)) + (let ((ring (make-ring winner-ring-size))) + (ring-insert ring (winner-configuration frame)) + (push (cons frame ring) winner-ring-alist) + ring))) -;;;; Selecting a window configuration + +;; If the same command is called several times in a row, +;; we only save one window configuration. +(defvar winner-last-command nil) + +;; Frames affected by the previous command. +(defvar winner-last-frames nil) + + +(defsubst winner-equal (a b) + "Check whether two Winner configurations (as produced by +`winner-conf') are equal." + (equal (cdr a) (cdr b))) + + +;; Save the current window configuration, if it has changed. +;; If so return frame, otherwise return nil. +(defun winner-insert-if-new (frame) + (unless (or (memq frame winner-last-frames) + (eq this-command 'winner-redo)) + (let ((conf (winner-configuration frame)) + (ring (winner-ring frame))) + (when (and (not (ring-empty-p ring)) + (winner-equal conf (ring-ref ring 0))) + ;; When the previous configuration was very similar, + ;; keep only the latest. + (ring-remove ring 0)) + (ring-insert ring conf) + (push frame winner-last-frames) + frame))) + + + +;;; Hooks + +;; Frames affected by the current command. +(defvar winner-modified-list nil) + +;; Called whenever the window configuration changes +;; (a `window-configuration-change-hook'). +(defun winner-change-fun () + (unless (or (memq (selected-frame) winner-modified-list) + (/= 0 (minibuffer-depth))) + (push (selected-frame) winner-modified-list))) + +;; A `post-command-hook' for emacsen with +;; `window-configuration-change-hook'. +(defun winner-save-old-configurations () + (when (zerop (minibuffer-depth)) + (unless (eq this-command winner-last-command) + (setq winner-last-frames nil) + (setq winner-last-command this-command)) + (dolist (frame winner-modified-list) + (winner-insert-if-new frame)) + (setq winner-modified-list nil) + (winner-remember))) + +;; A `minibuffer-setup-hook'. +(defun winner-save-unconditionally () + (unless (eq this-command winner-last-command) + (setq winner-last-frames nil) + (setq winner-last-command this-command)) + (winner-insert-if-new (selected-frame)) + (winner-remember)) + +;; A `post-command-hook' for other emacsen. +;; Also called by `winner-undo' before "undoing". +(defun winner-save-conditionally () + (when (zerop (minibuffer-depth)) + (winner-save-unconditionally))) -;; Return list of names of other buffers, excluding the current buffer -;; and buffers specified by the user. -(defun winner-other-buffers () - (loop for buf in (buffer-list) - for name = (buffer-name buf) - unless (or (eq (current-buffer) buf) - (member name winner-skip-buffers) - (loop for regexp in winner-skip-regexps - if (string-match regexp name) return t - finally return nil)) - collect name)) + +;;;; Restoring configurations + +;; Works almost as `set-window-configuration', +;; but does not change the contents or the size of the minibuffer, +;; and tries to preserve the selected window. +(defun winner-set-conf (winconf) + (let* ((miniwin (minibuffer-window)) + (chosen (selected-window)) + (minisize (window-height miniwin))) + (letf (((window-buffer miniwin)) + ((window-point miniwin))) + (set-window-configuration winconf)) + (cond + ((window-live-p chosen) (select-window chosen)) + ((window-minibuffer-p (selected-window)) + (other-window 1))) + (when (/= minisize (window-height miniwin)) + (letf (((selected-window) miniwin) ) + (setf (window-height) minisize))))) -(defun winner-select (&optional arg) - "Change to previous or new window configuration. -With arg start at position 1 if arg is positive, and -at -1 if arg is negative; else start at position 0. -\(For Winner to record changes in window configurations, -Winner mode must be turned on.\)" - (interactive "P") +(defvar winner-point-alist nil) +;; `set-window-configuration' restores old points and marks. This is +;; not what we want, so we make a list of the "real" (i.e. new) points +;; and marks before undoing window configurations. +;; +;; Format of entries: (buffer (mark . mark-active) (window . point) ..) + +(defun winner-make-point-alist () + (letf (((current-buffer))) + (loop with alist + for win in (winner-window-list) + for entry = + (or (assq (window-buffer win) alist) + (car (push (list (set-buffer (window-buffer win)) + (cons (mark t) (winner-active-region))) + alist))) + do (push (cons win (window-point win)) + (cddr entry)) + finally return alist))) + +(defun winner-get-point (buf win) + ;; Consult (and possibly extend) `winner-point-alist'. + ;; Returns nil iff buf no longer exists. + (when (buffer-name buf) + (let ((entry (assq buf winner-point-alist))) + (cond + (entry + (or (cdr (assq win (cddr entry))) + (cdr (assq nil (cddr entry))) + (letf (((current-buffer) buf)) + (push (cons nil (point)) (cddr entry)) + (point)))) + (t (letf (((current-buffer) buf)) + (push (list buf + (cons (mark t) (winner-active-region)) + (cons nil (point))) + winner-point-alist) + (point))))))) - (setq arg - (cond - ((not arg) nil) - ((> (prefix-numeric-value arg) 0) winner-next-event) - ((< (prefix-numeric-value arg) 0) winner-prev-event) - (t nil))) - (if arg (push arg unread-command-events)) - (let ((stack (winner-stack (selected-frame))) - (store nil) - (buffers (winner-other-buffers)) - (passed nil) - (config (current-window-configuration)) - (pos 0) event) - ;; `stack' and `store' are stacks of window configuration while - ;; `buffers' and `passed' are stacks of buffer names. - - (condition-case nil - - (loop - (setq event (read-event)) - (cond - - ((eq event winner-prev-event) - (cond (passed (push (pop passed) buffers)(decf pos)) - ((cdr stack)(push (pop stack) store) (decf pos)) - (t (setq stack (append (nreverse store) stack)) - (setq store nil) - (setq pos 0)))) - - ((eq event winner-next-event) - (cond (store (push (pop store) stack) (incf pos)) - (buffers (push (pop buffers) passed) (incf pos)) - (t (setq buffers (nreverse passed)) - (setq passed nil) - (setq pos 0)))) - - ((eq event winner-max-event) - ;; Delete other windows and leave. - (delete-other-windows) - ;; Let this change be saved. - (setq pos -1) - ;; Perform other actions of this event. - (push event unread-command-events) - (return)) - (t (push event unread-command-events) (return))) - - (cond - ;; Display - (passed (set-window-buffer (selected-window) (car passed)) - (message (concat "Winner\(%d\): [%s] " - (mapconcat 'identity buffers " ")) - pos (car passed))) - - (t (set-window-configuration (car stack)) - (if (window-minibuffer-p (selected-window)) - (other-window 1)) - (message "Winner\(%d\)" pos)))) - - (quit (set-window-configuration config) - (setq pos 0))) - (if (zerop pos) - ;; Do not record these changes. - (remove-hook 'post-command-hook 'winner-do-save) - ;; Else update the buffer list and make sure that the displayed - ;; buffer is the same as the current buffer. - (switch-to-buffer (window-buffer))))) - - - - - -(defun winner-previous () - "Change to previous window configuration." - (interactive) - (winner-select -1)) +;; Make sure point does not end up in the minibuffer and delete +;; windows displaying dead or boring buffers +;; (c.f. `winner-boring-buffers'). Return nil iff all the windows +;; should be deleted. Preserve correct points and marks. +(defun winner-set (conf) + ;; For the format of `conf', see `winner-conf'. + (let* ((buffers nil) + (alive + ;; Possibly update `winner-point-alist' + (loop for buf in (mapcar 'cdr (cdr conf)) + for pos = (winner-get-point buf nil) + if (and pos (not (memq buf buffers))) + do (push buf buffers) + collect pos))) + (winner-set-conf (car conf)) + (let (xwins) ; to be deleted + + ;; Restore points + (dolist (win (winner-sorted-window-list)) + (unless (and (pop alive) + (setf (window-point win) + (winner-get-point (window-buffer win) win)) + (not (member (buffer-name (window-buffer win)) + winner-boring-buffers))) + (push win xwins))) ; delete this window + + ;; Restore marks + (letf (((current-buffer))) + (loop for buf in buffers + for entry = (cadr (assq buf winner-point-alist)) + do (progn (set-buffer buf) + (set-mark (car entry)) + (setf (winner-active-region) (cdr entry))))) + ;; Delete windows, whose buffers are dead or boring. + ;; Return t if this is still a possible configuration. + (or (null xwins) + (progn + (mapc 'delete-window (cdr xwins)) ; delete all but one + (unless (one-window-p t) + (delete-window (car xwins)) + t)))))) + + + +;;;; Winner mode (a minor mode) + +(defcustom winner-mode-hook nil + "Functions to run whenever Winner mode is turned on." + :type 'hook + :group 'winner) + +(defcustom winner-mode-leave-hook nil + "Functions to run whenever Winner mode is turned off." + :type 'hook + :group 'winner) + +(defvar winner-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(control c) left] 'winner-undo) + (define-key map [(control c) right] 'winner-redo) + map) + "Keymap for Winner mode.") + +;; Check if `window-configuration-change-hook' is working. +(defun winner-hook-installed-p () + (save-window-excursion + (let ((winner-var nil) + (window-configuration-change-hook + '((lambda () (setq winner-var t))))) + (split-window) + winner-var))) -(defun winner-next () - "Change to new window configuration." + +;;;###autoload +(defun winner-mode (&optional arg) + "Toggle Winner mode. +With arg, turn Winner mode on if and only if arg is positive." + (interactive "P") + (let ((on-p (if arg (> (prefix-numeric-value arg) 0) + (not winner-mode)))) + (cond + ;; Turn mode on + (on-p + (setq winner-mode t) + (cond + ((winner-hook-installed-p) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations)) + (t (add-hook 'post-command-hook 'winner-save-conditionally))) + (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) + (setq winner-modified-list (frame-list)) + (winner-save-old-configurations) + (run-hooks 'winner-mode-hook) + (when (interactive-p) (message "Winner mode enabled"))) + ;; Turn mode off + (winner-mode + (setq winner-mode nil) + (remove-hook 'window-configuration-change-hook 'winner-change-fun) + (remove-hook 'post-command-hook 'winner-save-old-configurations) + (remove-hook 'post-command-hook 'winner-save-conditionally) + (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally) + (run-hooks 'winner-mode-leave-hook) + (when (interactive-p) (message "Winner mode disabled")))))) + +;; Inspired by undo (simple.el) + +(defvar winner-undo-frame nil) + +(defvar winner-pending-undo-ring nil + "The ring currently used by `winner-undo'.") +(defvar winner-undo-counter nil) +(defvar winner-undone-data nil) ; There confs have been passed. + +(defun winner-undo () + "Switch back to an earlier window configuration saved by Winner mode. +In other words, \"undo\" changes in window configuration." (interactive) - (winner-select 1)) - - + (cond + ((not winner-mode) (error "Winner mode is turned off")) + (t (unless (and (eq last-command 'winner-undo) + (eq winner-undo-frame (selected-frame))) + (winner-save-conditionally) ; current configuration->stack + (setq winner-undo-frame (selected-frame)) + (setq winner-point-alist (winner-make-point-alist)) + (setq winner-pending-undo-ring (winner-ring (selected-frame))) + (setq winner-undo-counter 0) + (setq winner-undone-data (list (winner-win-data)))) + (incf winner-undo-counter) ; starting at 1 + (when (and (winner-undo-this) + (not (window-minibuffer-p (selected-window)))) + (message "Winner undo (%d / %d)" + winner-undo-counter + (1- (ring-length winner-pending-undo-ring))))))) -;;;; To be evaluated when the package is loaded: -(unless winner-mode-map - (setq winner-mode-map (make-sparse-keymap)) - (define-key winner-mode-map (vector winner-prev-event) 'winner-previous) - (define-key winner-mode-map (vector winner-next-event) 'winner-next)) + +(defun winner-undo-this () ; The heart of winner undo. + (loop + (cond + ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) + (message "No further window configuration undo information") + (return nil)) + + ((and ; If possible configuration + (winner-set (ring-ref winner-pending-undo-ring + winner-undo-counter)) + ; .. and new configuration + (let ((data (winner-win-data))) + (and (not (member data winner-undone-data)) + (push data winner-undone-data)))) + (return t)) ; .. then everything is fine. + (t ;; Otherwise, discharge it (and try the next one). + (ring-remove winner-pending-undo-ring winner-undo-counter))))) + + +(defun winner-redo () ; If you change your mind. + "Restore a more recent window configuration saved by Winner mode." + (interactive) + (cond + ((eq last-command 'winner-undo) + (winner-set + (if (zerop (minibuffer-depth)) + (ring-remove winner-pending-undo-ring 0) + (ring-ref winner-pending-undo-ring 0))) + (unless (eq (selected-window) (minibuffer-window)) + (message "Winner undid undo"))) + (t (error "Previous command was not a `winner-undo'")))) + +;;; To be evaluated when the package is loaded: (unless (or (assq 'winner-mode minor-mode-map-alist) winner-dont-bind-my-keys) (push (cons 'winner-mode winner-mode-map) minor-mode-map-alist)) -(unless (assq 'winner-mode minor-mode-alist) - (push '(winner-mode " Win") minor-mode-alist)) - (provide 'winner) - +;; arch-tag: 686d1c1b-010e-42ca-a192-b5685112418f ;;; winner.el ends here