(eval-when-compile (require 'cl))
(require 'ring)
(when (fboundp 'defgroup)
(defgroup winner nil "Restoring window configurations."
:group 'windows))
(unless (fboundp 'defcustom)
(defmacro defcustom (symbol &optional initvalue docs &rest rest)
(list 'defvar symbol initvalue docs)))
(defcustom winner-mode nil
"Toggle winner-mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `winner-mode'."
:set #'(lambda (symbol value)
(winner-mode (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)
(defvar winner-ring-alist nil)
(defsubst winner-ring (frame)
(or (cdr (assq frame winner-ring-alist))
(progn
(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)
(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)
(defun winner-change-fun ()
(unless (memq (selected-frame) winner-modified-list)
(push (selected-frame) winner-modified-list)))
(defun winner-save-new-configurations ()
(setq winner-last-saviour
(cons this-command
(mapcar 'winner-insert-if-new winner-modified-list)))
(setq winner-modified-list nil))
(defun winner-save-unconditionally ()
(setq winner-last-saviour
(cons this-command
(list (winner-insert-if-new (selected-frame))))))
(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)))))
(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 () (loop for win being the windows
unless (window-minibuffer-p win)
collect (list (window-buffer win)
(window-width win)
(window-height win))))
(defun winner-set (conf)
(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)
(cond
((null xwins) t)
((progn (mapcar 'delete-window (cdr xwins))
(one-window-p t))
nil) (t (delete-window (car xwins)))))))
(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 nil "Keymap for Winner mode.")
(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-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
(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-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))
(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)))
(defvar winner-pending-undo-ring nil
"The ring currently used by winner undo.")
(defvar winner-undo-counter nil)
(defvar winner-undone-data nil)
(defun winner-undo (arg)
"Switch back to an earlier window configuration saved by Winner mode.
In other words, \"undo\" changes in window configuration.
With prefix arg, undo that many levels."
(interactive "p")
(cond
((not winner-mode) (error "Winner mode is turned off"))
(t (setq this-command t)
(unless (eq last-command 'winner-undo)
(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 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-this () (if (>= winner-undo-counter (ring-length winner-pending-undo-ring))
(error "No further window configuration undo information")
(unless (and
(winner-set
(ring-ref winner-pending-undo-ring
winner-undo-counter))
(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 () "Restore a more recent window configuration saved by Winner mode."
(interactive)
(cond
((eq last-command 'winner-undo)
(ring-remove winner-pending-undo-ring 0)
(winner-set
(ring-remove winner-pending-undo-ring 0))
(or (eq (selected-window) (minibuffer-window))
(message "Winner undid undo")))
(t (error "Previous command was not a winner-undo"))))
(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 [(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)
(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)