lisp/winner.el

   1 ;;; winner.el  --- Restore window configuration (or switch buffer)
   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 ;; Keywords: extensions, windows
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Winner mode is a global minor mode that when turned on records
  30 ;; changes in window configuration.  This way the changes can be
  31 ;; "undone" using the function `winner-undo'.  By default this one is
  32 ;; bound to the key sequence ctrl-x left.  If you change your mind
  33 ;; (while undoing), you can press ctrl-x right (calling
  34 ;; `winner-redo').  Unlike the normal undo, you may have to skip
  35 ;; through several identical window configurations in order to find
  36 ;; the one you want.  This is a bug due to some techical limitations
  37 ;; in Emacs and can maybe be fixed in the future.
  38 ;;
  39 ;; In addition to this I have added `winner-switch' which is a program
  40 ;; that switches to other buffers without disturbing Winner mode.  If
  41 ;; you bind this command to a key sequence, you may step through all
  42 ;; your buffers (except the ones mentioned in `winner-skip-buffers' or
  43 ;; matched by `winner-skip-regexps').  With a numeric prefix argument
  44 ;; skip several buffers at a time.
  45
  46 ;;; Code:
  47
  48 (require 'cl)
  49 (require 'ring)
  50
  51 (defgroup winner nil
  52   "Restoring window configurations."
  53   :group 'windows)
  54
  55 (defcustom winner-mode nil
  56   "Toggle winner-mode.
  57 You must modify via \\[customize] for this variable to have an effect."
  58   :set (lambda (symbol value)
  59          (winner-mode (or value 0)))
  60   :initialize 'custom-initialize-default
  61   :type 'boolean
  62   :group 'winner
  63   :require 'winner)
  64
  65 (defcustom winner-dont-bind-my-keys nil
  66   "If non-nil: Do not use `winner-mode-map' in Winner mode."
  67   :type 'boolean
  68   :group 'winner)
  69
  70 (defvar winner-ring-size 100
  71   "Maximum number of stored window configurations per frame.")
  72
  73 (defcustom winner-skip-buffers
  74   '("*Messages*",
  75     "*Compile-Log*",
  76     ".newsrc-dribble",
  77     "*Completions*",
  78     "*Buffer list*")
  79   "Exclude these buffer names from any \(Winner switch\) list of buffers."
  80   :type '(repeat string)
  81   :group 'winner)
  82
  83 (defcustom winner-skip-regexps '("^ ")
  84   "Winner excludes buffers with names matching any of these regexps.
  85 They are not included in any Winner mode list of buffers.
  86
  87 By default `winner-skip-regexps' is set to \(\"^ \"\),
  88 which excludes \"invisible buffers\"."
  89   :type '(repeat regexp)
  90   :group 'winner)
  91
  92 (defvar winner-ring-alist nil)
  93
  94 (defsubst winner-ring (frame)
  95   (or (cdr (assq frame winner-ring-alist))
  96       (progn
  97         (push (cons frame (make-ring winner-ring-size))
  98               winner-ring-alist)
  99         (cdar winner-ring-alist))))
 100
 101 (defvar winner-modified-list nil)
 102
 103 (defun winner-change-fun ()
 104   (or (memq (selected-frame) winner-modified-list)
 105       (push (selected-frame) winner-modified-list)))
 106
 107 (defun winner-save-new-configurations ()
 108   (while winner-modified-list
 109     (ring-insert
 110      (winner-ring (car winner-modified-list))
 111      (current-window-configuration (pop winner-modified-list)))))
 112
 113 (defun winner-set (conf)
 114   (set-window-configuration conf)
 115   (if (eq (selected-window) (minibuffer-window))
 116       (other-window 1)))
 117
 118
 119 ;;; Winner mode  (a minor mode)
 120
 121 (defcustom winner-mode-hook nil
 122   "Functions to run whenever Winner mode is turned on."
 123   :type 'hook
 124   :group 'winner)
 125
 126 (defcustom winner-mode-leave-hook nil
 127   "Functions to run whenever Winner mode is turned off."
 128   :type 'hook
 129   :group 'winner)
 130
 131 (defvar winner-mode-map nil "Keymap for Winner mode.")
 132
 133 ;;;###autoload
 134 (defun winner-mode (&optional arg)
 135   "Toggle Winner mode.
 136 With arg, turn Winner mode on if and only if arg is positive."
 137   (interactive "P")
 138   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 139                 (not winner-mode))))
 140     (cond
 141      ;; Turn mode on
 142      (on-p
 143       (setq winner-mode t)
 144       (add-hook 'window-configuration-change-hook 'winner-change-fun)
 145       (add-hook 'post-command-hook 'winner-save-new-configurations)
 146       (setq winner-modified-list (frame-list))
 147       (winner-save-new-configurations)
 148       (run-hooks 'winner-mode-hook))
 149      ;; Turn mode off
 150      (winner-mode
 151       (setq winner-mode nil)
 152       (run-hooks 'winner-mode-leave-hook)))
 153     (force-mode-line-update)))
 154
 155 ;; Inspired by undo (simple.el)
 156
 157 (defvar winner-pending-undo-ring nil)
 158
 159 (defvar winner-undo-counter nil)
 160
 161 (defun winner-undo (arg)
 162   "Switch back to an earlier window configuration saved by Winner mode.
 163 In other words, \"undo\" changes in window configuration.
 164 With prefix arg, undo that many levels."
 165   (interactive "p")
 166   (cond
 167    ((not winner-mode) (error "Winner mode is turned off"))
 168    ((eq (selected-window) (minibuffer-window))
 169     (error "No winner undo from minibuffer."))
 170    (t (setq this-command t)
 171       (if (eq last-command 'winner-undo)
 172           ;; This was no new window configuration after all.
 173           (ring-remove winner-pending-undo-ring 0)
 174         (setq winner-pending-undo-ring (winner-ring (selected-frame)))
 175         (setq winner-undo-counter 0))
 176       (winner-undo-more (or arg 1))
 177       (message "Winner undo (%d)!" winner-undo-counter)
 178       (setq this-command 'winner-undo))))
 179
 180 (defun winner-undo-more (count)
 181   "Undo N window configuration changes beyond what was already undone.
 182 Call `winner-undo-start' to get ready to undo recent changes,
 183 then call `winner-undo-more' one or more times to undo them."
 184   (let ((len (ring-length winner-pending-undo-ring)))
 185     (incf winner-undo-counter count)
 186     (if (>= winner-undo-counter len)
 187         (error "No further window configuration undo information")
 188       (winner-set
 189        (ring-ref winner-pending-undo-ring
 190                  winner-undo-counter)))))
 191
 192 (defun winner-redo ()
 193   "Restore a more recent window configuration saved by Winner mode."
 194   (interactive)
 195   (cond
 196    ((eq last-command 'winner-undo)
 197     (ring-remove winner-pending-undo-ring 0)
 198     (winner-set
 199      (ring-remove winner-pending-undo-ring 0))
 200     (or (eq (selected-window) (minibuffer-window))
 201         (message "Winner undid undo!")))
 202    (t (error "Previous command was not a winner-undo"))))
 203
 204 ;;; Winner switch
 205
 206 (defun winner-switch-buffer-list ()
 207   (loop for buf in (buffer-list)
 208         for name = (buffer-name buf)
 209         unless (or (eq (current-buffer) buf)
 210                    (member name winner-skip-buffers)
 211                    (loop for regexp in winner-skip-regexps
 212                          if (string-match regexp name) return t
 213                          finally return nil))
 214         collect name))
 215
 216 (defvar winner-switch-list nil)
 217
 218 (defun winner-switch (count)
 219   "Step through your buffers without disturbing `winner-mode'.
 220 `winner-switch' does not consider buffers mentioned in the list
 221 `winner-skip-buffers' or matched by `winner-skip-regexps'."
 222   (interactive "p")
 223   (decf count)
 224   (setq this-command t)
 225   (cond
 226    ((eq last-command 'winner-switch)
 227     (if winner-mode (ring-remove (winner-ring (selected-frame)) 0))
 228     (bury-buffer (current-buffer))
 229     (mapcar 'bury-buffer winner-switch-list))
 230    (t (setq winner-switch-list (winner-switch-buffer-list))))
 231   (setq winner-switch-list (nthcdr count winner-switch-list))
 232   (or winner-switch-list
 233       (setq winner-switch-list (winner-switch-buffer-list))
 234       (error "No more buffers"))
 235   (switch-to-buffer (pop winner-switch-list))
 236   (message (concat "Winner: [%s] "
 237                    (mapconcat 'identity winner-switch-list " "))
 238            (buffer-name))
 239   (setq this-command 'winner-switch))
 240
 241 ;;;; To be evaluated when the package is loaded:
 242
 243 (unless winner-mode-map
 244   (setq winner-mode-map (make-sparse-keymap))
 245   (define-key winner-mode-map [?\C-x left]  'winner-undo)
 246   (define-key winner-mode-map [?\C-x right] 'winner-redo))
 247
 248 (unless (or (assq 'winner-mode minor-mode-map-alist)
 249             winner-dont-bind-my-keys)
 250   (push (cons 'winner-mode winner-mode-map)
 251         minor-mode-map-alist))
 252
 253 (unless (assq 'winner-mode minor-mode-alist)
 254   (push '(winner-mode " Win") minor-mode-alist))
 255
 256 (provide 'winner)
 257
 258 ;;; winner.el ends here