code.delx.au - gnu-emacs/blob - 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   (or (memq (selected-frame) winner-modified-list)
  85       (push (selected-frame) winner-modified-list)))
  86
  87 (defun winner-save-new-configurations ()
  88   (while winner-modified-list
  89     (ring-insert
  90      (winner-ring (car winner-modified-list))
  91      (current-window-configuration (pop winner-modified-list)))))
  92
  93 (defun winner-set (conf)
  94   (set-window-configuration conf)
  95   (if (eq (selected-window) (minibuffer-window))
  96       (other-window 1)))
  97
  98
  99 ;;; Winner mode  (a minor mode)
 100
 101 (defvar winner-mode-hook nil
 102   "Functions to run whenever Winner mode is turned on.")
 103
 104 (defvar winner-mode-leave-hook nil
 105   "Functions to run whenever Winner mode is turned off.")
 106
 107 (defvar winner-mode nil) ; mode variable
 108 (defvar winner-mode-map nil "Keymap for Winner mode.")
 109
 110 (defun winner-mode (&optional arg)
 111   "Toggle Winner mode.
 112 With arg, turn Winner mode on if and only if arg is positive."
 113   (interactive "P")
 114   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 115                 (not winner-mode))))
 116     (cond
 117      ;; Turn mode on
 118      (on-p
 119       (setq winner-mode t)
 120       (add-hook 'window-configuration-change-hook 'winner-change-fun)
 121       (add-hook 'post-command-hook 'winner-save-new-configurations)
 122       (setq winner-modified-list (frame-list))
 123       (winner-save-new-configurations)
 124       (run-hooks 'winner-mode-hook))
 125      ;; Turn mode off
 126      (winner-mode
 127       (setq winner-mode nil)
 128       (run-hooks 'winner-mode-leave-hook)))
 129     (force-mode-line-update)))
 130
 131 ;; Inspired by undo (simple.el)
 132
 133 (defvar winner-pending-undo-ring nil)
 134
 135 (defvar winner-undo-counter nil)
 136
 137 (defun winner-undo (arg)
 138   "Switch back to an earlier window configuration saved by Winner mode.
 139 In other words, \"undo\" changes in window configuration."
 140   (interactive "p")
 141   (cond
 142    ((not winner-mode) (error "Winner mode is turned off"))
 143    ((eq (selected-window) (minibuffer-window))
 144     (error "No winner undo from minibuffer."))
 145    (t (setq this-command t)
 146       (if (eq last-command 'winner-undo)
 147           ;; This was no new window configuration after all.
 148           (ring-remove winner-pending-undo-ring 0)
 149         (setq winner-pending-undo-ring (winner-ring (selected-frame)))
 150         (setq winner-undo-counter 0))
 151       (winner-undo-more (or arg 1))
 152       (message "Winner undo (%d)!" winner-undo-counter)
 153       (setq this-command 'winner-undo))))
 154
 155 (defun winner-undo-more (count)
 156   "Undo N window configuration changes beyond what was already undone.
 157 Call `winner-undo-start' to get ready to undo recent changes,
 158 then call `winner-undo-more' one or more times to undo them."
 159   (let ((len (ring-length winner-pending-undo-ring)))
 160     (incf winner-undo-counter count)
 161     (if (>= winner-undo-counter len)
 162         (error "No further window configuration undo information")
 163       (winner-set
 164        (ring-ref winner-pending-undo-ring
 165                  winner-undo-counter)))))
 166
 167 (defun winner-redo ()
 168   "Restore a more recent window configuration saved by Winner mode."
 169   (interactive)
 170   (cond
 171    ((eq last-command 'winner-undo)
 172     (ring-remove winner-pending-undo-ring 0)
 173     (winner-set
 174      (ring-remove winner-pending-undo-ring 0))
 175     (or (eq (selected-window) (minibuffer-window))
 176         (message "Winner undid undo!")))
 177    (t (error "Previous command was not a winner-undo"))))
 178
 179 ;;; Winner switch
 180
 181 (defun winner-switch-buffer-list ()
 182   (loop for buf in (buffer-list)
 183         for name = (buffer-name buf)
 184         unless (or (eq (current-buffer) buf)
 185                    (member name winner-skip-buffers)
 186                    (loop for regexp in winner-skip-regexps
 187                          if (string-match regexp name) return t
 188                          finally return nil))
 189         collect name))
 190
 191 (defvar winner-switch-list nil)
 192
 193 (defun winner-switch (count)
 194   "Step through your buffers without disturbing `winner-mode'.
 195 `winner-switch' does not consider buffers mentioned in the list
 196 `winner-skip-buffers' or matched by `winner-skip-regexps'."
 197   (interactive "p")
 198   (decf count)
 199   (setq this-command t)
 200   (cond
 201    ((eq last-command 'winner-switch)
 202     (if winner-mode (ring-remove (winner-ring (selected-frame)) 0))
 203     (bury-buffer (current-buffer))
 204     (mapcar 'bury-buffer winner-switch-list))
 205    (t (setq winner-switch-list (winner-switch-buffer-list))))
 206   (setq winner-switch-list (nthcdr count winner-switch-list))
 207   (or winner-switch-list
 208       (setq winner-switch-list (winner-switch-buffer-list))
 209       (error "No more buffers"))
 210   (switch-to-buffer (pop winner-switch-list))
 211   (message (concat "Winner: [%s] "
 212                    (mapconcat 'identity winner-switch-list " "))
 213            (buffer-name))
 214   (setq this-command 'winner-switch))
 215
 216 ;;;; To be evaluated when the package is loaded:
 217
 218 (unless winner-mode-map
 219   (setq winner-mode-map (make-sparse-keymap))
 220   (define-key winner-mode-map [?\C-x left]  'winner-undo)
 221   (define-key winner-mode-map [?\C-x right] 'winner-redo))
 222
 223 (unless (or (assq 'winner-mode minor-mode-map-alist)
 224             winner-dont-bind-my-keys)
 225   (push (cons 'winner-mode winner-mode-map)
 226         minor-mode-map-alist))
 227
 228 (unless (assq 'winner-mode minor-mode-alist)
 229   (push '(winner-mode " Win") minor-mode-alist))
 230
 231 (provide 'winner)
 232
 233 ;;; winner.el ends here