1 ;;; winner.el --- Restore old window configurations
3 ;; Copyright (C) 1997, 1998 Free Software Foundation. Inc.
5 ;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no>
6 ;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
7 ;; Created: 27 Feb 1997
8 ;; Time-stamp: <1998-03-05 19:01:37 ivarr>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs 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)
18 ;; GNU Emacs 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.
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.
30 ;; Winner mode is a global minor mode that records the changes in the
31 ;; window configuration (i.e. how the frames are partitioned into
32 ;; windows). This way the changes can be "undone" using the function
33 ;; `winner-undo'. By default this one is bound to the key sequence
34 ;; ctrl-x left. If you change your mind (while undoing), you can
35 ;; press ctrl-x right (calling `winner-redo'). Even though it uses
36 ;; some features of Emacs20.3, winner.el should also work with
37 ;; Emacs19.34 and XEmacs20, provided that the installed version of
38 ;; custom is not obsolete.
42 (eval-when-compile (require 'cl
))
45 (when (fboundp 'defgroup
)
46 (defgroup winner nil
; Customization by Dave Love
47 "Restoring window configurations."
50 (unless (fboundp 'defcustom
)
51 (defmacro defcustom
(symbol &optional initvalue docs
&rest rest
)
52 (list 'defvar symbol initvalue docs
)))
56 (defcustom winner-mode nil
58 You must modify via \\[customize] for this variable to have an effect."
59 :set
#'(lambda (symbol value
)
60 (winner-mode (or value
0)))
61 :initialize
'custom-initialize-default
66 (defcustom winner-dont-bind-my-keys nil
67 "If non-nil: Do not use `winner-mode-map' in Winner mode."
71 (defcustom winner-ring-size
200
72 "Maximum number of stored window configurations per frame."
79 \f;;;; Internal variables and subroutines
82 ;; This variable contains the window cofiguration rings.
83 ;; The key in this alist is the frame.
84 (defvar winner-ring-alist nil
)
86 ;; Find the right ring. If it does not exist, create one.
87 (defsubst winner-ring
(frame)
88 (or (cdr (assq frame winner-ring-alist
))
90 (let ((ring (make-ring winner-ring-size
)))
91 (ring-insert ring
(winner-configuration frame
))
92 (push (cons frame ring
) winner-ring-alist
)
95 (defvar winner-last-saviour nil
)
97 ;; Save the current window configuration, if it has changed and return
98 ;; frame, else return nil. If the last change was due to the same
99 ;; command, save only the latest configuration.
100 (defun winner-insert-if-new (frame)
101 (let ((conf (winner-configuration))
102 (ring (winner-ring frame
)))
104 ((winner-equal conf
(ring-ref ring
0)) nil
)
105 (t (when (and (eq this-command
(car winner-last-saviour
))
106 (memq frame
(cdr winner-last-saviour
)))
107 (ring-remove ring
0))
108 (ring-insert ring conf
)
111 (defvar winner-modified-list nil
) ; Which frames have changed?
113 ;; This function is called when the window configuration changes.
114 (defun winner-change-fun ()
115 (unless (memq (selected-frame) winner-modified-list
)
116 (push (selected-frame) winner-modified-list
)))
119 (defun winner-save-new-configurations ()
120 (setq winner-last-saviour
122 (mapcar 'winner-insert-if-new winner-modified-list
)))
123 (setq winner-modified-list nil
))
125 ;; For compatibility with other emacsen.
126 (defun winner-save-unconditionally ()
127 (setq winner-last-saviour
129 (list (winner-insert-if-new (selected-frame))))))
131 ;; Arrgh. This is storing the same information twice.
132 (defun winner-configuration (&optional frame
)
133 (if frame
(letf (((selected-frame) frame
)) (winner-configuration))
134 (cons (current-window-configuration)
135 (loop for w being the windows
136 collect
(window-buffer w
)))))
139 ;; The same as `set-window-configuration',
140 ;; but doesn't touch the minibuffer.
141 (defun winner-set-conf (winconf)
142 (let ((min-sel (window-minibuffer-p (selected-window)))
143 (minibuf (window-buffer (minibuffer-window)))
144 (minipoint (letf ((selected-window) (minibuffer-window))
147 (set-window-configuration winconf
)
148 (setq win
(selected-window))
149 (select-window (minibuffer-window))
150 (set-window-buffer (minibuffer-window) minibuf
)
151 (goto-char minipoint
)
154 ((window-minibuffer-p win
)
156 (t (select-window win
)))))
158 (defun winner-win-data () ; Information about the windows
159 (loop for win being the windows
160 unless
(window-minibuffer-p win
)
161 collect
(list (window-buffer win
)
163 (window-height win
))))
165 ;; Make sure point doesn't end up in the minibuffer and
166 ;; delete windows displaying dead buffers. Return nil
167 ;; if and only if all the windows should have been deleted.
168 (defun winner-set (conf)
171 (loop for buf in
(cdr conf
)
172 collect
(if (buffer-name buf
)
173 (progn (set-buffer buf
) (point))
175 (winner-set-conf (car conf
))
176 (let* ((win (selected-window))
177 (xwins (loop for window being the windows
178 for pos in origpoints
179 unless
(window-minibuffer-p window
)
180 if pos do
(progn (select-window window
)
182 else collect window
)))
184 ;; Return t if possible configuration
187 ((progn (mapcar 'delete-window
(cdr xwins
))
189 nil
) ; No existing buffers
190 (t (delete-window (car xwins
)))))))
195 \f;;;; Winner mode (a minor mode)
197 (defcustom winner-mode-hook nil
198 "Functions to run whenever Winner mode is turned on."
202 (defcustom winner-mode-leave-hook nil
203 "Functions to run whenever Winner mode is turned off."
207 (defvar winner-mode-map nil
"Keymap for Winner mode.")
209 ;; Is `window-configuration-change-hook' working?
210 (defun winner-hook-installed-p ()
211 (save-window-excursion
212 (let ((winner-var nil
)
213 (window-configuration-change-hook
214 '((lambda () (setq winner-var t
)))))
219 (defun winner-mode (&optional arg
)
221 With arg, turn Winner mode on if and only if arg is positive."
223 (let ((on-p (if arg
(> (prefix-numeric-value arg
) 0)
230 ((winner-hook-installed-p)
231 (add-hook 'window-configuration-change-hook
'winner-change-fun
)
232 (add-hook 'post-command-hook
'winner-save-new-configurations
))
233 (t (add-hook 'post-command-hook
'winner-save-unconditionally
)))
234 (setq winner-modified-list
(frame-list))
235 (winner-save-new-configurations)
236 (run-hooks 'winner-mode-hook
))
239 (setq winner-mode nil
)
240 (remove-hook 'window-configuration-change-hook
'winner-change-fun
)
241 (remove-hook 'post-command-hook
'winner-save-new-configurations
)
242 (remove-hook 'post-command-hook
'winner-save-unconditionally
)
243 (run-hooks 'winner-mode-leave-hook
)))
244 (force-mode-line-update)))
246 \f;; Inspired by undo (simple.el)
247 (defun winner-undo (arg)
248 "Switch back to an earlier window configuration saved by Winner mode.
249 In other words, \"undo\" changes in window configuration.
250 With prefix arg, undo that many levels."
253 ((not winner-mode
) (error "Winner mode is turned off"))
254 ;; ((eq (selected-window) (minibuffer-window))
255 ;; (error "No winner undo from minibuffer."))
256 (t (setq this-command t
)
257 (unless (eq last-command
'winner-undo
)
258 (setq winner-pending-undo-ring
(winner-ring (selected-frame)))
259 (setq winner-undo-counter
0)
260 (setq winner-undone-data
(list (winner-win-data))))
261 (incf winner-undo-counter arg
)
263 (unless (window-minibuffer-p (selected-window))
264 (message "Winner undo (%d)" winner-undo-counter
))
265 (setq this-command
'winner-undo
))))
267 (defvar winner-pending-undo-ring nil
) ; The ring currently used by
269 (defvar winner-undo-counter nil
)
270 (defvar winner-undone-data nil
) ; There confs have been passed.
272 (defun winner-undo-this () ; The heart of winner undo.
273 (if (>= winner-undo-counter
(ring-length winner-pending-undo-ring
))
274 (error "No further window configuration undo information")
276 ;; Possible configuration
278 (ring-ref winner-pending-undo-ring
279 winner-undo-counter
))
281 (let ((data (winner-win-data)))
282 (if (member data winner-undone-data
) nil
283 (push data winner-undone-data
))))
284 (ring-remove winner-pending-undo-ring winner-undo-counter
)
285 (winner-undo-this))))
287 (defun winner-redo () ; If you change your mind.
288 "Restore a more recent window configuration saved by Winner mode."
291 ((eq last-command
'winner-undo
)
292 (ring-remove winner-pending-undo-ring
0)
294 (ring-remove winner-pending-undo-ring
0))
295 (or (eq (selected-window) (minibuffer-window))
296 (message "Winner undid undo")))
297 (t (error "Previous command was not a winner-undo"))))
299 \f;;;; To be evaluated when the package is loaded:
301 (if (fboundp 'compare-window-configurations
)
302 (defalias 'winner-equal
'compare-window-configurations
)
303 (defalias 'winner-equal
'equal
))
305 (unless winner-mode-map
306 (setq winner-mode-map
(make-sparse-keymap))
307 (define-key winner-mode-map
[(control x
) left
] 'winner-undo
)
308 (define-key winner-mode-map
[(control x
) right
] 'winner-redo
))
310 (unless (or (assq 'winner-mode minor-mode-map-alist
)
311 winner-dont-bind-my-keys
)
312 (push (cons 'winner-mode winner-mode-map
)
313 minor-mode-map-alist
))
315 (unless (assq 'winner-mode minor-mode-alist
)
316 (push '(winner-mode " Win") minor-mode-alist
))
320 ;;; winner.el ends here