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.
This commit is contained in:
Richard M. Stallman
parent
576827ffbe
commit
2a92dc2540
1 changed files with 188 additions and 127 deletions
315
lisp/winner.el
315
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 <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.
|
||||
|
||||
|
|
@ -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.
|
||||
;; 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:
|
||||
;;; 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-modified-list nil)
|
||||
(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) ; 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)))
|
||||
(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)
|
||||
|
||||
|
||||
;;;; 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)))))
|
||||
(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-redo ()
|
||||
(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
|
||||
;;;; To be evaluated when the package is loaded:
|
||||
|
||||
(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:
|
||||
(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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue