lisp/winner.el

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