lisp/winner.el

   1 ;;; winner.el  --- Restore window configuration (or switch buffer)
   2
   3 ;; Copyright (C) 1997 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 (eval-when-compile (require 'cl))
  49 (require 'ring)
  50
  51 (defvar winner-dont-bind-my-keys nil
  52   "If non-nil: Do not use `winner-mode-map' in Winner mode.")
  53
  54 (defvar winner-ring-size 100
  55   "Maximum number of stored window configurations per frame.")
  56
  57 (defvar winner-skip-buffers
  58   '("*Messages*",
  59     "*Compile-Log*",
  60     ".newsrc-dribble",
  61     "*Completions*",
  62     "*Buffer list*")
  63   "Exclude these buffer names from any \(Winner switch\) list of buffers.")
  64
  65 (defvar winner-skip-regexps '("^ ")
  66   "Winner excludes buffers with names matching any of these regexps.
  67 They are not included in any Winner mode list of buffers.
  68
  69 By default `winner-skip-regexps' is set to \(\"^ \"\),
  70 which excludes \"invisible buffers\".")
  71
  72 (defvar winner-ring-alist nil)
  73
  74 (defsubst winner-ring (frame)
  75   (or (cdr (assq frame winner-ring-alist))
  76       (progn
  77         (push (cons frame (make-ring winner-ring-size))
  78               winner-ring-alist)
  79         (cdar winner-ring-alist))))
  80
  81 (defvar winner-modified-list nil)
  82
  83 (defun winner-change-fun ()
  84   (pushnew (selected-frame) winner-modified-list))
  85
  86 (defun winner-save-new-configurations ()
  87   (while winner-modified-list
  88     (ring-insert
  89      (winner-ring (car winner-modified-list))
  90      (current-window-configuration (pop winner-modified-list)))))
  91
  92 (defun winner-set (conf)
  93   (set-window-configuration conf)
  94   (if (eq (selected-window) (minibuffer-window))
  95       (other-window 1)))
  96
  97
  98 ;;; Winner mode  (a minor mode)
  99
 100 (defvar winner-mode-hook nil
 101   "Functions to run whenever Winner mode is turned on.")
 102
 103 (defvar winner-mode-leave-hook nil
 104   "Functions to run whenever Winner mode is turned off.")
 105
 106 (defvar winner-mode nil) ; mode variable
 107 (defvar winner-mode-map nil "Keymap for Winner mode.")
 108
 109 (defun winner-mode (&optional arg)
 110   "Toggle Winner mode.
 111 With arg, turn Winner mode on if and only if arg is positive."
 112   (interactive "P")
 113   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 114                 (not winner-mode))))
 115     (cond
 116      ;; Turn mode on
 117      (on-p
 118       (setq winner-mode t)
 119       (add-hook 'window-configuration-change-hook 'winner-change-fun)
 120       (add-hook 'post-command-hook 'winner-save-new-configurations)
 121       (setq winner-modified-list (frame-list))
 122       (winner-save-new-configurations)
 123       (run-hooks 'winner-mode-hook))
 124      ;; Turn mode off
 125      (winner-mode
 126       (setq winner-mode nil)
 127       (run-hooks 'winner-mode-leave-hook)))
 128     (force-mode-line-update)))
 129
 130 ;; Inspired by undo (simple.el)
 131 (defun winner-undo (arg)
 132   "Switch back to an earlier window configuration saved by Winner mode.
 133 In other words, \"undo\" changes in window configuration."
 134   (interactive "p")
 135   (cond
 136    ((not winner-mode) (error "Winner mode is turned off"))
 137    ((eq (selected-window) (minibuffer-window))
 138     (error "No winner undo from minibuffer."))
 139    (t (setq this-command t)
 140       (if (eq last-command 'winner-undo)
 141           ;; This was no new window configuration after all.
 142           (ring-remove winner-pending-undo-ring 0)
 143         (setq winner-pending-undo-ring (winner-ring (selected-frame)))
 144         (setq winner-undo-counter 0))
 145       (winner-undo-more (or arg 1))
 146       (message "Winner undo (%d)!" winner-undo-counter)
 147       (setq this-command 'winner-undo))))
 148
 149 (defvar winner-pending-undo-ring nil)
 150
 151 (defvar winner-undo-counter nil)
 152
 153 (defun winner-undo-more (count)
 154   "Undo N window configuration changes beyond what was already undone.
 155 Call `winner-undo-start' to get ready to undo recent changes,
 156 then call `winner-undo-more' one or more times to undo them."
 157   (let ((len (ring-length winner-pending-undo-ring)))
 158     (incf winner-undo-counter count)
 159     (if (>= winner-undo-counter len)
 160         (error "No further window configuration undo information")
 161       (winner-set
 162        (ring-ref winner-pending-undo-ring
 163                  winner-undo-counter)))))
 164
 165 (defun winner-redo ()
 166   "Restore a more recent window configuration saved by Winner mode."
 167   (interactive)
 168   (cond
 169    ((eq last-command 'winner-undo)
 170     (ring-remove winner-pending-undo-ring 0)
 171     (winner-set
 172      (ring-remove winner-pending-undo-ring 0))
 173     (or (eq (selected-window) (minibuffer-window))
 174         (message "Winner undid undo!")))
 175    (t (error "Previous command was not a winner-undo"))))
 176
 177 ;;; Winner switch
 178
 179 (defun winner-switch-buffer-list ()
 180   (loop for buf in (buffer-list)
 181         for name = (buffer-name buf)
 182         unless (or (eq (current-buffer) buf)
 183                    (member name winner-skip-buffers)
 184                    (loop for regexp in winner-skip-regexps
 185                          if (string-match regexp name) return t
 186                          finally return nil))
 187         collect name))
 188
 189 (defvar winner-switch-list nil)
 190
 191 (defun winner-switch (count)
 192   "Step through your buffers without disturbing `winner-mode'.
 193 `winner-switch' does not consider buffers mentioned in the list
 194 `winner-skip-buffers' or matched by `winner-skip-regexps'."
 195   (interactive "p")
 196   (decf count)
 197   (setq this-command t)
 198   (cond
 199    ((eq last-command 'winner-switch)
 200     (if winner-mode (ring-remove (winner-ring (selected-frame)) 0))
 201     (bury-buffer (current-buffer))
 202     (mapcar 'bury-buffer winner-switch-list))
 203    (t (setq winner-switch-list (winner-switch-buffer-list))))
 204   (setq winner-switch-list (nthcdr count winner-switch-list))
 205   (or winner-switch-list
 206       (setq winner-switch-list (winner-switch-buffer-list))
 207       (error "No more buffers"))
 208   (switch-to-buffer (pop winner-switch-list))
 209   (message (concat "Winner: [%s] "
 210                    (mapconcat 'identity winner-switch-list " "))
 211            (buffer-name))
 212   (setq this-command 'winner-switch))
 213
 214 ;;;; To be evaluated when the package is loaded:
 215
 216 (unless winner-mode-map
 217   (setq winner-mode-map (make-sparse-keymap))
 218   (define-key winner-mode-map [?\C-x left]  'winner-undo)
 219   (define-key winner-mode-map [?\C-x right] 'winner-redo))
 220
 221 (unless (or (assq 'winner-mode minor-mode-map-alist)
 222             winner-dont-bind-my-keys)
 223   (push (cons 'winner-mode winner-mode-map)
 224         minor-mode-map-alist))
 225
 226 (unless (assq 'winner-mode minor-mode-alist)
 227   (push '(winner-mode " Win") minor-mode-alist))
 228
 229 (provide 'winner)
 230
 231 ;;; winner.el ends here