lisp/winner.el

   1 ;;; winner.el  --- Restore window configuration or change buffer
   2
   3 ;; (C) 1997 Ivar Rummelhoff
   4
   5 ;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no>
   6 ;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
   7 ;; Created: 27 Feb 1997
   8 ;; Version: 1.13
   9 ;; RCS: $Id: winner.el,v 1.13 1997/04/01 11:11:12 ivarr Exp ivarr $
  10 ;; Keywords: extensions,windows
  11 ;; Location: http://www.ifi.uio.no/~ivarr/share/elisp/
  12
  13 ;; This program 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 ;; This program 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.el provides a minor mode (`winner-mode') that does
  31 ;;   essentially two things:
  32 ;;
  33 ;;     1) It keeps track of changing window configurations, so that
  34 ;;        when you wish to go back to a previous view, all you have
  35 ;;        to do is to press C-left a couple of times.
  36 ;;
  37 ;;     2) It lets you switch to other buffers by pressing C-right.
  38 ;;
  39 ;;
  40 ;; Installation:
  41 ;;
  42 ;;   1. Put this file in a directory on your (emacs) load-path
  43 ;;   2. Byte-compile the file (eg. with M-x byte-compile-file)
  44 ;;   3. Put these two lines in your .emacs - file:
  45 ;;
  46 ;;      (autoload 'winner-mode "winner" "Toggle Winner mode." t)
  47 ;;      (add-hook 'after-init-hook (lambda () (winner-mode 1)))
  48 ;;
  49 ;;   4. Restart emacs for changes to take effect.
  50 ;;
  51 ;;   (This version of) Winner will only run properly
  52 ;;   on Emacs-19.35 or newer.
  53 ;;
  54 \f
  55 ;; Details:
  56 ;;
  57 ;;   1. You may of course decide to use other bindings than those
  58 ;;      mentioned above.  Just set these variables in your .emacs:
  59 ;;
  60 ;;          `winner-prev-event'
  61 ;;          `winner-next-event'
  62 ;;
  63 ;;   2. When you have found the view of  your choice
  64 ;;      (using your favourite keys), you may press ctrl-space
  65 ;;      (`winner-max-event') to `delete-other-windows'.
  66 ;;
  67 ;;   3. Winner now keeps one configuration stack for each frame.
  68 ;;
  69 ;;
  70 ;;
  71 ;;                           Yours sincerely,   Ivar Rummelhoff
  72 ;;
  73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74
  75 ;;; Code:
  76
  77
  78
  79 ;;;; Variables you may want to change
  80
  81 (defvar winner-prev-event 'C-left
  82   "Winner mode binds this event to the command `winner-previous'.")
  83
  84 (defvar winner-next-event 'C-right
  85   "Winner mode binds this event to the command `winner-next'.")
  86
  87 (defvar winner-max-event 67108896       ; CTRL-space
  88   "Event for deleting other windows
  89 after having selected a view with Winner.
  90
  91 The normal functions of this event will also be performed.
  92 In the default case (CTRL-SPACE) the mark will be set.")
  93
  94 (defvar winner-skip-buffers
  95   '("*Messages*",
  96     "*Compile-Log*",
  97     ".newsrc-dribble",
  98     "*Completions*",
  99     "*Buffer list*")
 100   "Exclude these buffer names
 101 from any \(Winner mode\) list of buffers.")
 102
 103 (defvar winner-skip-regexps '("^ ")
 104   "Exclude buffers with names matching any of these regexps.
 105 ..from any \(Winner mode\) list of buffers.
 106
 107 By default `winner-skip-regexps' is set to \(\"^ \"\),
 108 which excludes \"invisible buffers\".")
 109
 110 \f
 111 (defvar winner-limit 50
 112   "Winner will save no more than 2 * `winner-limit' window configurations.
 113 \(.. and no less than `winner-limit'.\)")
 114
 115 (defvar winner-mode-hook nil
 116   "Functions to run whenever Winner mode is turned on.")
 117
 118 (defvar winner-mode-leave-hook nil
 119   "Functions to run whenever Winner mode is turned off.")
 120
 121 (defvar winner-dont-bind-my-keys nil
 122   "If non-nil: Do not use `winner-mode-map' in Winner mode.")
 123
 124
 125
 126 ;;;; Winner mode
 127
 128 (eval-when-compile (require 'cl))
 129
 130
 131 (defvar winner-mode nil)                ; For the modeline.
 132 (defvar winner-mode-map nil "Keymap for Winner mode.")
 133 (defun winner-mode (&optional arg)
 134   "Toggle Winner mode.
 135 With arg, turn Winner mode on if and only if arg is positive."
 136   (interactive "P")
 137   (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
 138                 (not winner-mode))))
 139     (cond
 140      (on-p (let ((winner-frames-changed (frame-list)))
 141              (winner-do-save))          ; Save current configurations
 142            (add-hook 'window-configuration-change-hook 'winner-save-configuration)
 143            (setq winner-mode t)
 144            (run-hooks 'winner-mode-hook))
 145      (t (remove-hook 'window-configuration-change-hook 'winner-save-configuration)
 146         (when winner-mode
 147           (setq winner-mode nil)
 148           (run-hooks 'winner-mode-leave-hook))))
 149     (force-mode-line-update)))
 150
 151
 152 ;; List of frames which have changed
 153 (defvar winner-frames-changed nil)
 154
 155 ;; Time to save the window configuration.
 156 (defun winner-save-configuration ()
 157   (push (selected-frame) winner-frames-changed)
 158   (add-hook 'post-command-hook 'winner-do-save))
 159
 160 \f
 161 (defun winner-do-save ()
 162   (let ((current (selected-frame)))
 163     (unwind-protect
 164         (do ((frames winner-frames-changed (cdr frames)))
 165             ((null frames))
 166           (unless (memq (car frames) (cdr frames))
 167             ;; Process each frame once.
 168             (select-frame (car frames))
 169             (winner-push (current-window-configuration) (car frames))))
 170       (setq winner-frames-changed nil)
 171       (select-frame current)
 172       (remove-hook 'post-command-hook 'winner-do-save))))
 173
 174
 175
 176
 177
 178 ;;;; Configuration stacks (one for each frame)
 179
 180
 181 (defvar winner-stacks nil) ; ------ " ------
 182
 183
 184 ;; A stack of window configurations with some additional information.
 185 (defstruct (winner-stack
 186             (:constructor winner-stack-new
 187                           (config &aux
 188                                   (data (list config))
 189                                   (place data))))
 190   data place (count 1))
 191
 192
 193 ;; Return the stack of this frame
 194 (defun winner-stack (frame)
 195   (let ((stack (cdr (assq frame winner-stacks))))
 196     (if stack (winner-stack-data stack)
 197       ;; Else make new stack
 198       (letf (((selected-frame) frame))
 199         (let ((config (current-window-configuration)))
 200           (push (cons frame (winner-stack-new config))
 201                 winner-stacks)
 202           (list config))))))
 203
 204
 205
 206 \f
 207 ;; Push this window configuration on the right stack,
 208 ;; but make sure the stack doesn't get too large etc...
 209 (defun winner-push (config frame)
 210   (let ((this (cdr (assq frame winner-stacks))))
 211     (if (not this) (push (cons frame (winner-stack-new config))
 212                          winner-stacks)
 213       (push config (winner-stack-data this))
 214       (when (> (incf (winner-stack-count this)) winner-limit)
 215         ;; No more than 2*winner-limit configs
 216         (setcdr (winner-stack-place this) nil)
 217         (setf   (winner-stack-place this)
 218                 (winner-stack-data  this))
 219         (setf   (winner-stack-count this) 1)))))
 220
 221
 222
 223
 224
 225
 226
 227
 228 ;;;; Selecting a window configuration
 229
 230
 231 ;; Return list of names of other buffers, excluding the current buffer
 232 ;; and buffers specified by the user.
 233 (defun winner-other-buffers ()
 234   (loop for buf in (buffer-list)
 235         for name = (buffer-name buf)
 236         unless (or (eq (current-buffer) buf)
 237                    (member name winner-skip-buffers)
 238                    (loop for regexp in winner-skip-regexps
 239                          if (string-match regexp name) return t
 240                          finally return nil))
 241         collect name))
 242
 243
 244
 245 (defun winner-select (&optional arg)
 246
 247   "Change to previous or new window configuration.
 248 With arg start at position 1 if arg is positive, and
 249 at -1 if arg is negative;  else start at position 0.
 250 \(For Winner to record changes in window configurations,
 251 Winner mode must be turned on.\)"
 252   (interactive "P")
 253
 254   (setq arg
 255         (cond
 256          ((not arg) nil)
 257          ((> (prefix-numeric-value arg) 0) winner-next-event)
 258          ((< (prefix-numeric-value arg) 0) winner-prev-event)
 259          (t nil)))
 260   (if arg (push arg unread-command-events))
 261 \f
 262   (let ((stack (winner-stack (selected-frame)))
 263         (store nil)
 264         (buffers (winner-other-buffers))
 265         (passed nil)
 266         (config (current-window-configuration))
 267         (pos 0) event)
 268     ;; `stack'   and `store'  are stacks of window configuration while
 269     ;; `buffers' and `passed' are stacks of buffer names.
 270
 271     (condition-case nil
 272
 273         (loop
 274          (setq event (read-event))
 275          (cond
 276
 277           ((eq event winner-prev-event)
 278            (cond (passed     (push (pop passed) buffers)(decf pos))
 279                  ((cdr stack)(push (pop stack)  store)  (decf pos))
 280                  (t (setq stack (append (nreverse store) stack))
 281                     (setq store nil)
 282                     (setq pos   0))))
 283
 284           ((eq event winner-next-event)
 285            (cond (store   (push (pop store)   stack)  (incf pos))
 286                  (buffers (push (pop buffers) passed) (incf pos))
 287                  (t (setq buffers (nreverse passed))
 288                     (setq passed nil)
 289                     (setq pos 0))))
 290
 291           ((eq event winner-max-event)
 292            ;; Delete other windows and leave.
 293            (delete-other-windows)
 294            ;; Let this change be saved.
 295            (setq pos -1)
 296            ;; Perform other actions of this event.
 297            (push event unread-command-events)
 298            (return))
 299           (t (push event unread-command-events) (return)))
 300
 301          (cond
 302           ;; Display
 303           (passed (set-window-buffer (selected-window) (car passed))
 304                   (message (concat "Winner\(%d\): [%s] "
 305                                    (mapconcat 'identity buffers " "))
 306                            pos (car passed)))
 307
 308           (t (set-window-configuration (car stack))
 309              (if (window-minibuffer-p (selected-window))
 310                  (other-window 1))
 311              (message "Winner\(%d\)" pos))))
 312
 313       (quit (set-window-configuration config)
 314             (setq pos 0)))
 315     (if (zerop pos)
 316         ;; Do not record these changes.
 317         (remove-hook 'post-command-hook 'winner-do-save)
 318       ;; Else update the buffer list and make sure that the displayed
 319       ;; buffer is the same as the current buffer.
 320       (switch-to-buffer (window-buffer)))))
 321 \f
 322
 323
 324
 325
 326 (defun winner-previous ()
 327   "Change to previous window configuration."
 328   (interactive)
 329   (winner-select -1))
 330
 331 (defun winner-next ()
 332   "Change to new window configuration."
 333   (interactive)
 334   (winner-select 1))
 335
 336
 337
 338
 339 ;;;; To be evaluated when the package is loaded:
 340
 341 (unless winner-mode-map
 342   (setq winner-mode-map (make-sparse-keymap))
 343   (define-key winner-mode-map (vector winner-prev-event) 'winner-previous)
 344   (define-key winner-mode-map (vector winner-next-event) 'winner-next))
 345
 346 (unless (or (assq 'winner-mode minor-mode-map-alist)
 347             winner-dont-bind-my-keys)
 348   (push (cons 'winner-mode winner-mode-map)
 349         minor-mode-map-alist))
 350
 351 (unless (assq 'winner-mode minor-mode-alist)
 352   (push '(winner-mode " Win") minor-mode-alist))
 353
 354 (provide 'winner)
 355
 356 ;;; Winner.el ends here