code.delx.au - gnu-emacs/blob - 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 Setting this variable directly does not take effect;
  59 use either \\[customize] or the function `winner-mode'."
  60   :set #'(lambda (symbol value)
  61            (winner-mode (or value 0)))
  62   :initialize 'custom-initialize-default
  63   :type    'boolean
  64   :group   'winner
  65   :require 'winner)
  66
  67 (defcustom winner-dont-bind-my-keys nil
  68   "If non-nil: Do not use `winner-mode-map' in Winner mode."
  69   :type  'boolean
  70   :group 'winner)
  71
  72 (defcustom winner-ring-size 200
  73   "Maximum number of stored window configurations per frame."
  74   :type  'integer
  75   :group 'winner)
  76
  77
  78
  79
  80 \f;;;; Internal variables and subroutines
  81
  82
  83 ;; This variable contains the window cofiguration rings.
  84 ;; The key in this alist is the frame.
  85 (defvar winner-ring-alist nil)
  86
  87 ;; Find the right ring.  If it does not exist, create one.
  88 (defsubst winner-ring (frame)
  89   (or (cdr (assq frame winner-ring-alist))
  90       (progn
  91         (let ((ring (make-ring winner-ring-size)))
  92           (ring-insert ring (winner-configuration frame))
  93           (push (cons frame ring) winner-ring-alist)
  94           ring))))
  95
  96 (defvar winner-last-saviour nil)
  97
  98 ;; Save the current window configuration, if it has changed and return
  99 ;; frame, else return nil.  If the last change was due to the same
 100 ;; command, save only the latest configuration.
 101 (defun winner-insert-if-new (frame)
 102   (let ((conf (winner-configuration))
 103         (ring (winner-ring frame)))
 104     (cond
 105      ((winner-equal conf (ring-ref ring 0)) nil)
 106      (t (when (and (eq this-command (car winner-last-saviour))
 107                    (memq frame (cdr winner-last-saviour)))
 108           (ring-remove ring 0))
 109         (ring-insert ring conf)
 110         frame))))
 111
 112 (defvar winner-modified-list nil) ; Which frames have changed?
 113
 114 ;; This function is called when the window configuration changes.
 115 (defun winner-change-fun ()
 116   (unless (memq (selected-frame) winner-modified-list)
 117     (push (selected-frame) winner-modified-list)))
 118
 119 ;; For Emacs20
 120 (defun winner-save-new-configurations ()
 121   (setq winner-last-saviour
 122         (cons this-command
 123               (mapcar 'winner-insert-if-new winner-modified-list)))
 124   (setq winner-modified-list nil))
 125
 126 ;; For compatibility with other emacsen.
 127 (defun winner-save-unconditionally ()
 128   (setq winner-last-saviour
 129         (cons this-command
 130               (list (winner-insert-if-new (selected-frame))))))
 131
 132 ;; Arrgh.  This is storing the same information twice.
 133 (defun winner-configuration (&optional frame)
 134   (if frame (letf (((selected-frame) frame)) (winner-configuration))
 135     (cons (current-window-configuration)
 136           (loop for w being the windows
 137                 collect (window-buffer w)))))
 138
 139 \f
 140 ;; The same as `set-window-configuration',
 141 ;; but doesn't touch the minibuffer.
 142 (defun winner-set-conf (winconf)
 143   (let ((min-sel  (window-minibuffer-p (selected-window)))
 144         (minibuf  (window-buffer (minibuffer-window)))
 145         (minipoint (letf ((selected-window) (minibuffer-window))
 146                      (point)))
 147         win)
 148     (set-window-configuration winconf)
 149     (setq win (selected-window))
 150     (select-window (minibuffer-window))
 151     (set-window-buffer (minibuffer-window) minibuf)
 152     (goto-char minipoint)
 153     (cond
 154      (min-sel)
 155      ((window-minibuffer-p win)
 156       (other-window 1))
 157      (t (select-window win)))))
 158
 159 (defun winner-win-data () ; Information about the windows
 160   (loop for win being the windows
 161         unless (window-minibuffer-p win)
 162         collect (list (window-buffer win)
 163                       (window-width  win)
 164                       (window-height win))))
 165
 166 ;; Make sure point doesn't end up in the minibuffer and
 167 ;; delete windows displaying dead buffers.  Return nil
 168 ;; if and only if all the windows should have been deleted.
 169 (defun winner-set (conf)
 170   (let ((origpoints
 171          (save-excursion
 172            (loop for buf in (cdr conf)
 173                  collect (if (buffer-name buf)
 174                              (progn (set-buffer buf) (point))
 175                            nil)))))
 176     (winner-set-conf (car conf))
 177     (let* ((win (selected-window))
 178            (xwins (loop for window being the windows
 179                         for pos in origpoints
 180                         unless (window-minibuffer-p window)
 181                         if pos do (progn (select-window window)
 182                                          (goto-char pos))
 183                         else collect window)))
 184       (select-window win)
 185       ;; Return t if possible configuration
 186       (cond
 187        ((null xwins) t)
 188        ((progn (mapcar 'delete-window (cdr xwins))
 189                (one-window-p t))
 190         nil) ; No existing buffers
 191        (t (delete-window (car xwins)))))))
 192
 193
 194
 195
 196 \f;;;; Winner mode  (a minor mode)
 197
 198 (defcustom winner-mode-hook nil
 199   "Functions to run whenever Winner mode is turned on."
 200   :type 'hook
 201   :group 'winner)
 202
 203 (defcustom winner-mode-leave-hook nil
 204   "Functions to run whenever Winner mode is turned off."
 205   :type 'hook
 206   :group 'winner)
 207
 208 (defvar winner-mode-map nil "Keymap for Winner mode.")
 209
 210 ;; Is `window-configuration-change-hook' working?
 211 (defun winner-hook-installed-p ()
 212   (save-window-excursion
 213     (let ((winner-var nil)
 214           (window-configuration-change-hook
 215            '((lambda () (setq winner-var t)))))
 216       (split-window)
 217       winner-var)))
 218
 219 ;;;###autoload
 220 (defun winner-mode (&optional arg)
 221   "Toggle Winner mode.
 222 With arg, turn Winner mode on if and only if arg is positive."
 223   (interactive "P")
 224   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 225                 (not winner-mode))))
 226     (cond
 227      ;; Turn mode on
 228      (on-p
 229       (setq winner-mode t)
 230       (cond
 231        ((winner-hook-installed-p)
 232         (add-hook 'window-configuration-change-hook 'winner-change-fun)
 233         (add-hook 'post-command-hook 'winner-save-new-configurations))
 234        (t (add-hook 'post-command-hook 'winner-save-unconditionally)))
 235       (setq winner-modified-list (frame-list))
 236       (winner-save-new-configurations)
 237       (run-hooks 'winner-mode-hook))
 238      ;; Turn mode off
 239      (winner-mode
 240       (setq winner-mode nil)
 241       (remove-hook 'window-configuration-change-hook 'winner-change-fun)
 242       (remove-hook 'post-command-hook 'winner-save-new-configurations)
 243       (remove-hook 'post-command-hook 'winner-save-unconditionally)
 244       (run-hooks 'winner-mode-leave-hook)))
 245     (force-mode-line-update)))
 246
 247 \f;; Inspired by undo (simple.el)
 248
 249 (defvar winner-pending-undo-ring nil
 250   "The ring currently used by winner undo.")
 251 (defvar winner-undo-counter nil)
 252 (defvar winner-undone-data  nil) ; There confs have been passed.
 253
 254 (defun winner-undo (arg)
 255   "Switch back to an earlier window configuration saved by Winner mode.
 256 In other words, \"undo\" changes in window configuration.
 257 With prefix arg, undo that many levels."
 258   (interactive "p")
 259   (cond
 260    ((not winner-mode) (error "Winner mode is turned off"))
 261    ;;   ((eq (selected-window) (minibuffer-window))
 262    ;;    (error "No winner undo from minibuffer."))
 263    (t (setq this-command t)
 264       (unless (eq last-command 'winner-undo)
 265         (setq winner-pending-undo-ring (winner-ring (selected-frame)))
 266         (setq winner-undo-counter 0)
 267         (setq winner-undone-data (list (winner-win-data))))
 268       (incf winner-undo-counter arg)
 269       (winner-undo-this)
 270       (unless (window-minibuffer-p (selected-window))
 271         (message "Winner undo (%d)" winner-undo-counter))
 272       (setq this-command 'winner-undo))))
 273
 274 (defun winner-undo-this () ; The heart of winner undo.
 275   (if (>= winner-undo-counter (ring-length winner-pending-undo-ring))
 276       (error "No further window configuration undo information")
 277     (unless (and
 278              ;; Possible configuration
 279              (winner-set
 280               (ring-ref winner-pending-undo-ring
 281                         winner-undo-counter))
 282              ;; New configuration
 283              (let ((data (winner-win-data)))
 284                (if (member data winner-undone-data) nil
 285                  (push data winner-undone-data))))
 286       (ring-remove winner-pending-undo-ring winner-undo-counter)
 287       (winner-undo-this))))
 288
 289 (defun winner-redo () ; If you change your mind.
 290   "Restore a more recent window configuration saved by Winner mode."
 291   (interactive)
 292   (cond
 293    ((eq last-command 'winner-undo)
 294     (ring-remove winner-pending-undo-ring 0)
 295     (winner-set
 296      (ring-remove winner-pending-undo-ring 0))
 297     (or (eq (selected-window) (minibuffer-window))
 298         (message "Winner undid undo")))
 299    (t (error "Previous command was not a winner-undo"))))
 300
 301 \f;;;; To be evaluated when the package is loaded:
 302
 303 (if (fboundp 'compare-window-configurations)
 304     (defalias 'winner-equal 'compare-window-configurations)
 305   (defalias 'winner-equal 'equal))
 306
 307 (unless winner-mode-map
 308   (setq winner-mode-map (make-sparse-keymap))
 309   (define-key winner-mode-map [(control x) left] 'winner-undo)
 310   (define-key winner-mode-map [(control x) right] 'winner-redo))
 311
 312 (unless (or (assq 'winner-mode minor-mode-map-alist)
 313             winner-dont-bind-my-keys)
 314   (push (cons 'winner-mode winner-mode-map)
 315         minor-mode-map-alist))
 316
 317 (unless (assq 'winner-mode minor-mode-alist)
 318   (push '(winner-mode " Win") minor-mode-alist))
 319
 320 (provide 'winner)
 321
 322 ;;; winner.el ends here