From 2a92dc254096feef5abd038e73074b041c9565f8 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 9 Mar 1998 22:42:13 +0000 Subject: [PATCH] Use list syntax for key definitions. (winner-mode, winner-save-unconditionally) (winner-hook-installed-p): Save window configuration after every command if window-configuration-change-hook is not present. (winner-save-new-configurations, winner-insert-if-new): Compare a new window configuration with the previous configuration before saving it. (winner-insert-if-new, winner-ring) (winner-configuration, winner-set): Save buffer list together with the window configurations, so that windows that can no longer be correctly restored can instead be deleted. (winner-undo): Compare restored configuration with other configurations that have been reviewed and skip this one if it looks similar. (winner-insert-if-new, winner-save-new-configurations) (winner-save-unconditionally): Just save the final configuration if the same command (changing the window configuration) is applied several times in a row. (winner-switch): Removed the command `winner-switch' (and the variables connected to it), since because of the change above, any "switching package" may now be used without disturbing winner-mode too much. (winner-change-fun): Removed the pushnew command, so that `cl' will not have to be loaded. (winner-set-conf): Introduced "wrapper" around `set-window-configuration', so that `winner-undo' may be called from the minibuffer. --- lisp/winner.el | 327 +++++++++++++++++++++++++++++-------------------- 1 file changed, 194 insertions(+), 133 deletions(-) diff --git a/lisp/winner.el b/lisp/winner.el index 59b27e3447a..2b510320056 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,11 +1,12 @@ -;;; winner.el --- Restore window configuration (or switch buffer) +;;; winner.el --- Restore old window configurations ;; Copyright (C) 1997, 1998 Free Software Foundation. Inc. ;; Author: Ivar Rummelhoff ;; Maintainer: Ivar Rummelhoff ;; Created: 27 Feb 1997 -;; Keywords: extensions, windows +;; Time-stamp: <1998-03-05 19:01:37 ivarr> +;; Keywords: windows ;; This file is part of GNU Emacs. @@ -26,98 +27,172 @@ ;;; Commentary: -;; Winner mode is a global minor mode that when turned on records -;; changes in window configuration. This way the changes can be -;; "undone" using the function `winner-undo'. By default this one is -;; bound to the key sequence ctrl-x left. If you change your mind -;; (while undoing), you can press ctrl-x right (calling -;; `winner-redo'). Unlike the normal undo, you may have to skip -;; through several identical window configurations in order to find -;; the one you want. This is a bug due to some techical limitations -;; in Emacs and can maybe be fixed in the future. -;; -;; In addition to this I have added `winner-switch' which is a program -;; that switches to other buffers without disturbing Winner mode. If -;; you bind this command to a key sequence, you may step through all -;; your buffers (except the ones mentioned in `winner-skip-buffers' or -;; matched by `winner-skip-regexps'). With a numeric prefix argument -;; skip several buffers at a time. - -;;; Code: +;; Winner mode is a global minor mode that records the changes in the +;; window configuration (i.e. how the frames are partitioned into +;; windows). This way the changes can be "undone" using the function +;; `winner-undo'. By default this one is bound to the key sequence +;; ctrl-x left. If you change your mind (while undoing), you can +;; press ctrl-x 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. + + ;;; Code: (eval-when-compile (require 'cl)) (require 'ring) -(defgroup winner nil - "Restoring window configurations." - :group 'windows) +(when (fboundp 'defgroup) + (defgroup winner nil ; Customization by Dave Love + "Restoring window configurations." + :group 'windows)) + +(unless (fboundp 'defcustom) + (defmacro defcustom (symbol &optional initvalue docs &rest rest) + (list 'defvar symbol initvalue docs))) + ;;;###autoload (defcustom winner-mode nil "Toggle winner-mode. You must modify via \\[customize] for this variable to have an effect." - :set (lambda (symbol value) - (winner-mode (or value 0))) + :set #'(lambda (symbol value) + (winner-mode (or value 0))) :initialize 'custom-initialize-default - :type 'boolean - :group 'winner + :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 + :type 'boolean :group 'winner) -(defvar winner-ring-size 100 - "Maximum number of stored window configurations per frame.") - -(defcustom winner-skip-buffers - '("*Messages*", - "*Compile-Log*", - ".newsrc-dribble", - "*Completions*", - "*Buffer list*") - "Exclude these buffer names from any \(Winner switch\) list of buffers." - :type '(repeat string) +(defcustom winner-ring-size 200 + "Maximum number of stored window configurations per frame." + :type 'integer :group 'winner) -(defcustom winner-skip-regexps '("^ ") - "Winner excludes buffers with names matching any of these regexps. -They are not included in any Winner mode list of buffers. -By default `winner-skip-regexps' is set to \(\"^ \"\), -which excludes \"invisible buffers\"." - :type '(repeat regexp) - :group 'winner) + + ;;;; Internal variables and subroutines + + +;; 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)) (progn - (push (cons frame (make-ring winner-ring-size)) - winner-ring-alist) - (cdar winner-ring-alist)))) + (let ((ring (make-ring winner-ring-size))) + (ring-insert ring (winner-configuration frame)) + (push (cons frame ring) winner-ring-alist) + ring)))) + +(defvar winner-last-saviour nil) + +;; Save the current window configuration, if it has changed and return +;; frame, else return nil. If the last change was due to the same +;; command, save only the latest configuration. +(defun winner-insert-if-new (frame) + (let ((conf (winner-configuration)) + (ring (winner-ring frame))) + (cond + ((winner-equal conf (ring-ref ring 0)) nil) + (t (when (and (eq this-command (car winner-last-saviour)) + (memq frame (cdr winner-last-saviour))) + (ring-remove ring 0)) + (ring-insert ring conf) + frame)))) -(defvar winner-modified-list nil) +(defvar winner-modified-list nil) ; Which frames have changed? +;; This function is called when the window configuration changes. (defun winner-change-fun () - (or (memq (selected-frame) winner-modified-list) - (push (selected-frame) winner-modified-list))) + (unless (memq (selected-frame) winner-modified-list) + (push (selected-frame) winner-modified-list))) +;; For Emacs20 (defun winner-save-new-configurations () - (while winner-modified-list - (ring-insert - (winner-ring (car winner-modified-list)) - (current-window-configuration (pop winner-modified-list))))) - + (setq winner-last-saviour + (cons this-command + (mapcar 'winner-insert-if-new winner-modified-list))) + (setq winner-modified-list nil)) + +;; For compatibility with other emacsen. +(defun winner-save-unconditionally () + (setq winner-last-saviour + (cons this-command + (list (winner-insert-if-new (selected-frame)))))) + +;; Arrgh. This is storing the same information twice. +(defun winner-configuration (&optional frame) + (if frame (letf (((selected-frame) frame)) (winner-configuration)) + (cons (current-window-configuration) + (loop for w being the windows + collect (window-buffer w))))) + + +;; The same as `set-window-configuration', +;; but doesn't touch the minibuffer. +(defun winner-set-conf (winconf) + (let ((min-sel (window-minibuffer-p (selected-window))) + (minibuf (window-buffer (minibuffer-window))) + (minipoint (letf ((selected-window) (minibuffer-window)) + (point))) + win) + (set-window-configuration winconf) + (setq win (selected-window)) + (select-window (minibuffer-window)) + (set-window-buffer (minibuffer-window) minibuf) + (goto-char minipoint) + (cond + (min-sel) + ((window-minibuffer-p win) + (other-window 1)) + (t (select-window win))))) + +(defun winner-win-data () ; Information about the windows + (loop for win being the windows + unless (window-minibuffer-p win) + collect (list (window-buffer win) + (window-width win) + (window-height win)))) + +;; Make sure point doesn't end up in the minibuffer and +;; delete windows displaying dead buffers. Return nil +;; if and only if all the windows should have been deleted. (defun winner-set (conf) - (set-window-configuration conf) - (if (eq (selected-window) (minibuffer-window)) - (other-window 1))) - - -;;; Winner mode (a minor mode) + (let ((origpoints + (save-excursion + (loop for buf in (cdr conf) + collect (if (buffer-name buf) + (progn (set-buffer buf) (point)) + nil))))) + (winner-set-conf (car conf)) + (let* ((win (selected-window)) + (xwins (loop for window being the windows + for pos in origpoints + unless (window-minibuffer-p window) + if pos do (progn (select-window window) + (goto-char pos)) + else collect window))) + (select-window win) + ;; Return t if possible configuration + (cond + ((null xwins) t) + ((progn (mapcar 'delete-window (cdr xwins)) + (one-window-p t)) + nil) ; No existing buffers + (t (delete-window (car xwins))))))) + + + + + ;;;; Winner mode (a minor mode) (defcustom winner-mode-hook nil "Functions to run whenever Winner mode is turned on." @@ -131,6 +206,15 @@ which excludes \"invisible buffers\"." (defvar winner-mode-map nil "Keymap for Winner mode.") +;; Is `window-configuration-change-hook' 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))) + ;;;###autoload (defun winner-mode (&optional arg) "Toggle Winner mode. @@ -142,23 +226,24 @@ With arg, turn Winner mode on if and only if arg is positive." ;; Turn mode on (on-p (setq winner-mode t) - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-new-configurations) + (cond + ((winner-hook-installed-p) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-new-configurations)) + (t (add-hook 'post-command-hook 'winner-save-unconditionally))) (setq winner-modified-list (frame-list)) (winner-save-new-configurations) (run-hooks 'winner-mode-hook)) ;; 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-new-configurations) + (remove-hook 'post-command-hook 'winner-save-unconditionally) (run-hooks 'winner-mode-leave-hook))) (force-mode-line-update))) -;; Inspired by undo (simple.el) - -(defvar winner-pending-undo-ring nil) - -(defvar winner-undo-counter nil) - + ;; Inspired by undo (simple.el) (defun winner-undo (arg) "Switch back to an earlier window configuration saved by Winner mode. In other words, \"undo\" changes in window configuration. @@ -166,31 +251,40 @@ With prefix arg, undo that many levels." (interactive "p") (cond ((not winner-mode) (error "Winner mode is turned off")) - ((eq (selected-window) (minibuffer-window)) - (error "No winner undo from minibuffer.")) + ;; ((eq (selected-window) (minibuffer-window)) + ;; (error "No winner undo from minibuffer.")) (t (setq this-command t) - (if (eq last-command 'winner-undo) - ;; This was no new window configuration after all. - (ring-remove winner-pending-undo-ring 0) + (unless (eq last-command 'winner-undo) (setq winner-pending-undo-ring (winner-ring (selected-frame))) - (setq winner-undo-counter 0)) - (winner-undo-more (or arg 1)) - (message "Winner undo (%d)!" winner-undo-counter) + (setq winner-undo-counter 0) + (setq winner-undone-data (list (winner-win-data)))) + (incf winner-undo-counter arg) + (winner-undo-this) + (unless (window-minibuffer-p (selected-window)) + (message "Winner undo (%d)" winner-undo-counter)) (setq this-command 'winner-undo)))) -(defun winner-undo-more (count) - "Undo N window configuration changes beyond what was already undone. -Call `winner-undo-start' to get ready to undo recent changes, -then call `winner-undo-more' one or more times to undo them." - (let ((len (ring-length winner-pending-undo-ring))) - (incf winner-undo-counter count) - (if (>= winner-undo-counter len) - (error "No further window configuration undo information") - (winner-set - (ring-ref winner-pending-undo-ring - winner-undo-counter))))) - -(defun winner-redo () +(defvar winner-pending-undo-ring nil) ; The ring currently used by + ; undo. +(defvar winner-undo-counter nil) +(defvar winner-undone-data nil) ; There confs have been passed. + +(defun winner-undo-this () ; The heart of winner undo. + (if (>= winner-undo-counter (ring-length winner-pending-undo-ring)) + (error "No further window configuration undo information") + (unless (and + ;; Possible configuration + (winner-set + (ring-ref winner-pending-undo-ring + winner-undo-counter)) + ;; New configuration + (let ((data (winner-win-data))) + (if (member data winner-undone-data) nil + (push data winner-undone-data)))) + (ring-remove winner-pending-undo-ring winner-undo-counter) + (winner-undo-this)))) + +(defun winner-redo () ; If you change your mind. "Restore a more recent window configuration saved by Winner mode." (interactive) (cond @@ -199,52 +293,19 @@ then call `winner-undo-more' one or more times to undo them." (winner-set (ring-remove winner-pending-undo-ring 0)) (or (eq (selected-window) (minibuffer-window)) - (message "Winner undid undo!"))) + (message "Winner undid undo"))) (t (error "Previous command was not a winner-undo")))) -;;; Winner switch - -(defun winner-switch-buffer-list () - (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)) - -(defvar winner-switch-list nil) - -(defun winner-switch (count) - "Step through your buffers without disturbing `winner-mode'. -`winner-switch' does not consider buffers mentioned in the list -`winner-skip-buffers' or matched by `winner-skip-regexps'." - (interactive "p") - (decf count) - (setq this-command t) - (cond - ((eq last-command 'winner-switch) - (if winner-mode (ring-remove (winner-ring (selected-frame)) 0)) - (bury-buffer (current-buffer)) - (mapcar 'bury-buffer winner-switch-list)) - (t (setq winner-switch-list (winner-switch-buffer-list)))) - (setq winner-switch-list (nthcdr count winner-switch-list)) - (or winner-switch-list - (setq winner-switch-list (winner-switch-buffer-list)) - (error "No more buffers")) - (switch-to-buffer (pop winner-switch-list)) - (message (concat "Winner: [%s] " - (mapconcat 'identity winner-switch-list " ")) - (buffer-name)) - (setq this-command 'winner-switch)) - -;;;; To be evaluated when the package is loaded: + ;;;; To be evaluated when the package is loaded: + +(if (fboundp 'compare-window-configurations) + (defalias 'winner-equal 'compare-window-configurations) + (defalias 'winner-equal 'equal)) (unless winner-mode-map (setq winner-mode-map (make-sparse-keymap)) - (define-key winner-mode-map [?\C-x left] 'winner-undo) - (define-key winner-mode-map [?\C-x right] 'winner-redo)) + (define-key winner-mode-map [(control x) left] 'winner-undo) + (define-key winner-mode-map [(control x) right] 'winner-redo)) (unless (or (assq 'winner-mode minor-mode-map-alist) winner-dont-bind-my-keys) -- 2.39.2