lisp/winner.el

   1 ;;; winner.el  --- Restore old window configurations
   2
   3 ;; Copyright (C) 1997, 1998 Free Software Foundation. Inc.
   4
   5 ;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no>
   6 ;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
   7 ;; Created: 27 Feb 1997
   8 ;; Time-stamp: <1998-03-05 19:01:37 ivarr>
   9 ;; Keywords: windows
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Winner mode is a global minor mode that records the changes in the
  31 ;; window configuration (i.e. how the frames are partitioned into
  32 ;; windows).  This way the changes can be "undone" using the function
  33 ;; `winner-undo'.  By default this one is bound to the key sequence
  34 ;; ctrl-x left.  If you change your mind (while undoing), you can
  35 ;; press ctrl-x right (calling `winner-redo').  Even though it uses
  36 ;; some features of Emacs20.3, winner.el should also work with
  37 ;; Emacs19.34 and XEmacs20, provided that the installed version of
  38 ;; custom is not obsolete.
  39
  40 \f;;; Code:
  41
  42 (eval-when-compile (require 'cl))
  43 (require 'ring)
  44
  45 (when (fboundp 'defgroup)
  46   (defgroup winner nil ; Customization by Dave Love
  47     "Restoring window configurations."
  48     :group 'windows))
  49
  50 (unless (fboundp 'defcustom)
  51   (defmacro defcustom (symbol &optional initvalue docs &rest rest)
  52     (list 'defvar symbol initvalue docs)))
  53
  54
  55 ;;;###autoload
  56 (defcustom winner-mode nil
  57   "Toggle winner-mode.
  58 You must modify via \\[customize] for this variable to have an effect."
  59   :set #'(lambda (symbol value)
  60            (winner-mode (or value 0)))
  61   :initialize 'custom-initialize-default
  62   :type    'boolean
  63   :group   'winner
  64   :require 'winner)
  65
  66 (defcustom winner-dont-bind-my-keys nil
  67   "If non-nil: Do not use `winner-mode-map' in Winner mode."
  68   :type  'boolean
  69   :group 'winner)
  70
  71 (defcustom winner-ring-size 200
  72   "Maximum number of stored window configurations per frame."
  73   :type  'integer
  74   :group 'winner)
  75
  76
  77
  78
  79 \f;;;; Internal variables and subroutines
  80
  81
  82 ;; This variable contains the window cofiguration rings.
  83 ;; The key in this alist is the frame.
  84 (defvar winner-ring-alist nil)
  85
  86 ;; Find the right ring.  If it does not exist, create one.
  87 (defsubst winner-ring (frame)
  88   (or (cdr (assq frame winner-ring-alist))
  89       (progn
  90         (let ((ring (make-ring winner-ring-size)))
  91           (ring-insert ring (winner-configuration frame))
  92           (push (cons frame ring) winner-ring-alist)
  93           ring))))
  94
  95 (defvar winner-last-saviour nil)
  96
  97 ;; Save the current window configuration, if it has changed and return
  98 ;; frame, else return nil.  If the last change was due to the same
  99 ;; command, save only the latest configuration.
 100 (defun winner-insert-if-new (frame)
 101   (let ((conf (winner-configuration))
 102         (ring (winner-ring frame)))
 103     (cond
 104      ((winner-equal conf (ring-ref ring 0)) nil)
 105      (t (when (and (eq this-command (car winner-last-saviour))
 106                    (memq frame (cdr winner-last-saviour)))
 107           (ring-remove ring 0))
 108         (ring-insert ring conf)
 109         frame))))
 110
 111 (defvar winner-modified-list nil) ; Which frames have changed?
 112
 113 ;; This function is called when the window configuration changes.
 114 (defun winner-change-fun ()
 115   (unless (memq (selected-frame) winner-modified-list)
 116     (push (selected-frame) winner-modified-list)))
 117
 118 ;; For Emacs20
 119 (defun winner-save-new-configurations ()
 120   (setq winner-last-saviour
 121         (cons this-command
 122               (mapcar 'winner-insert-if-new winner-modified-list)))
 123   (setq winner-modified-list nil))
 124
 125 ;; For compatibility with other emacsen.
 126 (defun winner-save-unconditionally ()
 127   (setq winner-last-saviour
 128         (cons this-command
 129               (list (winner-insert-if-new (selected-frame))))))
 130
 131 ;; Arrgh.  This is storing the same information twice.
 132 (defun winner-configuration (&optional frame)
 133   (if frame (letf (((selected-frame) frame)) (winner-configuration))
 134     (cons (current-window-configuration)
 135           (loop for w being the windows
 136                 collect (window-buffer w)))))
 137
 138 \f
 139 ;; The same as `set-window-configuration',
 140 ;; but doesn't touch the minibuffer.
 141 (defun winner-set-conf (winconf)
 142   (let ((min-sel  (window-minibuffer-p (selected-window)))
 143         (minibuf  (window-buffer (minibuffer-window)))
 144         (minipoint (letf ((selected-window) (minibuffer-window))
 145                      (point)))
 146         win)
 147     (set-window-configuration winconf)
 148     (setq win (selected-window))
 149     (select-window (minibuffer-window))
 150     (set-window-buffer (minibuffer-window) minibuf)
 151     (goto-char minipoint)
 152     (cond
 153      (min-sel)
 154      ((window-minibuffer-p win)
 155       (other-window 1))
 156      (t (select-window win)))))
 157
 158 (defun winner-win-data () ; Information about the windows
 159   (loop for win being the windows
 160         unless (window-minibuffer-p win)
 161         collect (list (window-buffer win)
 162                       (window-width  win)
 163                       (window-height win))))
 164
 165 ;; Make sure point doesn't end up in the minibuffer and
 166 ;; delete windows displaying dead buffers.  Return nil
 167 ;; if and only if all the windows should have been deleted.
 168 (defun winner-set (conf)
 169   (let ((origpoints
 170          (save-excursion
 171            (loop for buf in (cdr conf)
 172                  collect (if (buffer-name buf)
 173                              (progn (set-buffer buf) (point))
 174                            nil)))))
 175     (winner-set-conf (car conf))
 176     (let* ((win (selected-window))
 177            (xwins (loop for window being the windows
 178                         for pos in origpoints
 179                         unless (window-minibuffer-p window)
 180                         if pos do (progn (select-window window)
 181                                          (goto-char pos))
 182                         else collect window)))
 183       (select-window win)
 184       ;; Return t if possible configuration
 185       (cond
 186        ((null xwins) t)
 187        ((progn (mapcar 'delete-window (cdr xwins))
 188                (one-window-p t))
 189         nil) ; No existing buffers
 190        (t (delete-window (car xwins)))))))
 191
 192
 193
 194
 195 \f;;;; Winner mode  (a minor mode)
 196
 197 (defcustom winner-mode-hook nil
 198   "Functions to run whenever Winner mode is turned on."
 199   :type 'hook
 200   :group 'winner)
 201
 202 (defcustom winner-mode-leave-hook nil
 203   "Functions to run whenever Winner mode is turned off."
 204   :type 'hook
 205   :group 'winner)
 206
 207 (defvar winner-mode-map nil "Keymap for Winner mode.")
 208
 209 ;; Is `window-configuration-change-hook' working?
 210 (defun winner-hook-installed-p ()
 211   (save-window-excursion
 212     (let ((winner-var nil)
 213           (window-configuration-change-hook
 214            '((lambda () (setq winner-var t)))))
 215       (split-window)
 216       winner-var)))
 217
 218 ;;;###autoload
 219 (defun winner-mode (&optional arg)
 220   "Toggle Winner mode.
 221 With arg, turn Winner mode on if and only if arg is positive."
 222   (interactive "P")
 223   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 224                 (not winner-mode))))
 225     (cond
 226      ;; Turn mode on
 227      (on-p
 228       (setq winner-mode t)
 229       (cond
 230        ((winner-hook-installed-p)
 231         (add-hook 'window-configuration-change-hook 'winner-change-fun)
 232         (add-hook 'post-command-hook 'winner-save-new-configurations))
 233        (t (add-hook 'post-command-hook 'winner-save-unconditionally)))
 234       (setq winner-modified-list (frame-list))
 235       (winner-save-new-configurations)
 236       (run-hooks 'winner-mode-hook))
 237      ;; Turn mode off
 238      (winner-mode
 239       (setq winner-mode nil)
 240       (remove-hook 'window-configuration-change-hook 'winner-change-fun)
 241       (remove-hook 'post-command-hook 'winner-save-new-configurations)
 242       (remove-hook 'post-command-hook 'winner-save-unconditionally)
 243       (run-hooks 'winner-mode-leave-hook)))
 244     (force-mode-line-update)))
 245
 246 \f;; Inspired by undo (simple.el)
 247 (defun winner-undo (arg)
 248   "Switch back to an earlier window configuration saved by Winner mode.
 249 In other words, \"undo\" changes in window configuration.
 250 With prefix arg, undo that many levels."
 251   (interactive "p")
 252   (cond
 253    ((not winner-mode) (error "Winner mode is turned off"))
 254    ;;   ((eq (selected-window) (minibuffer-window))
 255    ;;    (error "No winner undo from minibuffer."))
 256    (t (setq this-command t)
 257       (unless (eq last-command 'winner-undo)
 258         (setq winner-pending-undo-ring (winner-ring (selected-frame)))
 259         (setq winner-undo-counter 0)
 260         (setq winner-undone-data (list (winner-win-data))))
 261       (incf winner-undo-counter arg)
 262       (winner-undo-this)
 263       (unless (window-minibuffer-p (selected-window))
 264         (message "Winner undo (%d)" winner-undo-counter))
 265       (setq this-command 'winner-undo))))
 266
 267 (defvar winner-pending-undo-ring nil) ; The ring currently used by
 268                                       ; undo.
 269 (defvar winner-undo-counter nil)
 270 (defvar winner-undone-data  nil) ; There confs have been passed.
 271
 272 (defun winner-undo-this () ; The heart of winner undo.
 273   (if (>= winner-undo-counter (ring-length winner-pending-undo-ring))
 274       (error "No further window configuration undo information")
 275     (unless (and
 276              ;; Possible configuration
 277              (winner-set
 278               (ring-ref winner-pending-undo-ring
 279                         winner-undo-counter))
 280              ;; New configuration
 281              (let ((data (winner-win-data)))
 282                (if (member data winner-undone-data) nil
 283                  (push data winner-undone-data))))
 284       (ring-remove winner-pending-undo-ring winner-undo-counter)
 285       (winner-undo-this))))
 286
 287 (defun winner-redo () ; If you change your mind.
 288   "Restore a more recent window configuration saved by Winner mode."
 289   (interactive)
 290   (cond
 291    ((eq last-command 'winner-undo)
 292     (ring-remove winner-pending-undo-ring 0)
 293     (winner-set
 294      (ring-remove winner-pending-undo-ring 0))
 295     (or (eq (selected-window) (minibuffer-window))
 296         (message "Winner undid undo")))
 297    (t (error "Previous command was not a winner-undo"))))
 298
 299 \f;;;; To be evaluated when the package is loaded:
 300
 301 (if (fboundp 'compare-window-configurations)
 302     (defalias 'winner-equal 'compare-window-configurations)
 303   (defalias 'winner-equal 'equal))
 304
 305 (unless winner-mode-map
 306   (setq winner-mode-map (make-sparse-keymap))
 307   (define-key winner-mode-map [(control x) left] 'winner-undo)
 308   (define-key winner-mode-map [(control x) right] 'winner-redo))
 309
 310 (unless (or (assq 'winner-mode minor-mode-map-alist)
 311             winner-dont-bind-my-keys)
 312   (push (cons 'winner-mode winner-mode-map)
 313         minor-mode-map-alist))
 314
 315 (unless (assq 'winner-mode minor-mode-alist)
 316   (push '(winner-mode " Win") minor-mode-alist))
 317
 318 (provide 'winner)
 319
 320 ;;; winner.el ends here