-;;; 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 <ivarr@ifi.uio.no>
;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
;; 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.
;;; 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.
+
+\f;;; 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)
+
+\f;;;; 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)))))
+
+\f
+;; 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)))))))
+
+
+
+
+\f;;;; Winner mode (a minor mode)
(defcustom winner-mode-hook nil
"Functions to run whenever Winner mode is turned on."
(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.
;; 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)
-
+\f;; 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.
(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
(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:
+\f;;;; 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)
projects / emacs.git / commitdiff