code.delx.au - gnu-emacs/blob - 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
 173 ;; A stack of window configurations with some additional information.
 174 (defstruct (winner-stack
 175             (:constructor winner-stack-new
 176                           (config &aux
 177                                   (data (list config))
 178                                   (place data))))
 179   data place (count 1))
 180
 181
 182 ;; Return the stack of this frame
 183 (defun winner-stack (frame)
 184   (let ((stack (cdr (assq frame winner-stacks))))
 185     (if stack (winner-stack-data stack)
 186       ;; Else make new stack
 187       (letf (((selected-frame) frame))
 188         (let ((config (current-window-configuration)))
 189           (push (cons frame (winner-stack-new config))
 190                 winner-stacks)
 191           (list config))))))
 192
 193
 194
 195 \f
 196 ;; Push this window configuration on the right stack,
 197 ;; but make sure the stack doesn't get too large etc...
 198 (defun winner-push (config frame)
 199   (let ((this (cdr (assq frame winner-stacks))))
 200     (if (not this) (push (cons frame (winner-stack-new config))
 201                          winner-stacks)
 202       (push config (winner-stack-data this))
 203       (when (> (incf (winner-stack-count this)) winner-limit)
 204         ;; No more than 2*winner-limit configs
 205         (setcdr (winner-stack-place this) nil)
 206         (setf   (winner-stack-place this)
 207                 (winner-stack-data  this))
 208         (setf   (winner-stack-count this) 1)))))
 209
 210
 211
 212
 213
 214
 215
 216
 217 ;;;; Selecting a window configuration
 218
 219
 220 ;; Return list of names of other buffers, excluding the current buffer
 221 ;; and buffers specified by the user.
 222 (defun winner-other-buffers ()
 223   (loop for buf in (buffer-list)
 224         for name = (buffer-name buf)
 225         unless (or (eq (current-buffer) buf)
 226                    (member name winner-skip-buffers)
 227                    (loop for regexp in winner-skip-regexps
 228                          if (string-match regexp name) return t
 229                          finally return nil))
 230         collect name))
 231
 232
 233
 234 (defun winner-select (&optional arg)
 235
 236   "Change to previous or new window configuration.
 237 With arg start at position 1 if arg is positive, and
 238 at -1 if arg is negative;  else start at position 0.
 239 \(For Winner to record changes in window configurations,
 240 Winner mode must be turned on.\)"
 241   (interactive "P")
 242
 243   (setq arg
 244         (cond
 245          ((not arg) nil)
 246          ((> (prefix-numeric-value arg) 0) winner-next-event)
 247          ((< (prefix-numeric-value arg) 0) winner-prev-event)
 248          (t nil)))
 249   (if arg (push arg unread-command-events))
 250 \f
 251   (let ((stack (winner-stack (selected-frame)))
 252         (store nil)
 253         (buffers (winner-other-buffers))
 254         (passed nil)
 255         (config (current-window-configuration))
 256         (pos 0) event)
 257     ;; `stack'   and `store'  are stacks of window configuration while
 258     ;; `buffers' and `passed' are stacks of buffer names.
 259
 260     (condition-case nil
 261
 262         (loop
 263          (setq event (read-event))
 264          (cond
 265
 266           ((eq event winner-prev-event)
 267            (cond (passed     (push (pop passed) buffers)(decf pos))
 268                  ((cdr stack)(push (pop stack)  store)  (decf pos))
 269                  (t (setq stack (append (nreverse store) stack))
 270                     (setq store nil)
 271                     (setq pos   0))))
 272
 273           ((eq event winner-next-event)
 274            (cond (store   (push (pop store)   stack)  (incf pos))
 275                  (buffers (push (pop buffers) passed) (incf pos))
 276                  (t (setq buffers (nreverse passed))
 277                     (setq passed nil)
 278                     (setq pos 0))))
 279
 280           ((eq event winner-max-event)
 281            ;; Delete other windows and leave.
 282            (delete-other-windows)
 283            ;; Let this change be saved.
 284            (setq pos -1)
 285            ;; Perform other actions of this event.
 286            (push event unread-command-events)
 287            (return))
 288           (t (push event unread-command-events) (return)))
 289
 290          (cond
 291           ;; Display
 292           (passed (set-window-buffer (selected-window) (car passed))
 293                   (message (concat "Winner\(%d\): [%s] "
 294                                    (mapconcat 'identity buffers " "))
 295                            pos (car passed)))
 296
 297           (t (set-window-configuration (car stack))
 298              (if (window-minibuffer-p (selected-window))
 299                  (other-window 1))
 300              (message "Winner\(%d\)" pos))))
 301
 302       (quit (set-window-configuration config)
 303             (setq pos 0)))
 304     (if (zerop pos)
 305         ;; Do not record these changes.
 306         (remove-hook 'post-command-hook 'winner-do-save)
 307       ;; Else update the buffer list and make sure that the displayed
 308       ;; buffer is the same as the current buffer.
 309       (switch-to-buffer (window-buffer)))))
 310 \f
 311
 312
 313
 314
 315 (defun winner-previous ()
 316   "Change to previous window configuration."
 317   (interactive)
 318   (winner-select -1))
 319
 320 (defun winner-next ()
 321   "Change to new window configuration."
 322   (interactive)
 323   (winner-select 1))
 324
 325
 326
 327
 328 ;;;; To be evaluated when the package is loaded:
 329
 330 (unless winner-mode-map
 331   (setq winner-mode-map (make-sparse-keymap))
 332   (define-key winner-mode-map (vector winner-prev-event) 'winner-previous)
 333   (define-key winner-mode-map (vector winner-next-event) 'winner-next))
 334
 335 (unless (or (assq 'winner-mode minor-mode-map-alist)
 336             winner-dont-bind-my-keys)
 337   (push (cons 'winner-mode winner-mode-map)
 338         minor-mode-map-alist))
 339
 340 (unless (assq 'winner-mode minor-mode-alist)
 341   (push '(winner-mode " Win") minor-mode-alist))
 342
 343 (provide 'winner)
 344
 345 ;;; winner.el ends here