+;; 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)))
+
+
+
+\f
+;;;; 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)))))
+
+
+
+(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)))))))
+
+\f
+;; 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)))
+
+\f
+;;;###autoload