1 ;;; winner.el --- Restore old window configurations
3 ;; Copyright (C) 1997-1998, 2001-2014 Free Software Foundation, Inc.
5 ;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
6 ;; Created: 27 Feb 1997
7 ;; Keywords: convenience frames
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Winner mode is a global minor mode that records the changes in the
27 ;; window configuration (i.e. how the frames are partitioned into
28 ;; windows) so that the changes can be "undone" using the command
29 ;; `winner-undo'. By default this one is bound to the key sequence
30 ;; ctrl-c left. If you change your mind (while undoing), you can
31 ;; press ctrl-c right (calling `winner-redo'). Even though it uses
32 ;; some features of Emacs20.3, winner.el should also work with
33 ;; Emacs19.34 and XEmacs20, provided that the installed version of
34 ;; custom is not obsolete.
36 ;; Winner mode was improved August 1998.
37 ;; Further improvements February 2002.
41 (eval-when-compile (require 'cl-lib
))
43 (defun winner-active-region ()
44 (declare (gv-setter (lambda (store)
45 (if (featurep 'xemacs
)
46 `(if ,store
(zmacs-activate-region)
47 (zmacs-deactivate-region))
48 `(if ,store
(activate-mark) (deactivate-mark))))))
51 (defalias 'winner-edges
52 (if (featurep 'xemacs
) 'window-pixel-edges
'window-edges
))
53 (defalias 'winner-window-list
54 (if (featurep 'xemacs
)
55 (lambda () (delq (minibuffer-window) (window-list nil
0)))
56 (lambda () (window-list nil
0))))
61 "Restoring window configurations."
64 (defcustom winner-dont-bind-my-keys nil
65 "Non-nil means do not bind keys in Winner mode."
69 (defcustom winner-ring-size
200
70 "Maximum number of stored window configurations per frame."
74 (defcustom winner-boring-buffers
'("*Completions*")
75 "List of buffer names whose windows `winner-undo' will not restore.
76 You may want to include buffer names such as *Help*, *Apropos*,
77 *Buffer List*, *info* and *Compile-Log*."
78 :type
'(repeat string
)
83 ;;;; Saving old configurations (internal variables and subroutines)
86 ;;; Current configuration
88 ;; List the windows according to their edges.
89 (defun winner-sorted-window-list ()
90 (sort (winner-window-list)
92 (cl-loop for a in
(winner-edges x
)
93 for b in
(winner-edges y
)
95 finally return
(< a b
)))))
97 (defun winner-win-data ()
98 ;; Essential properties of the windows in the selected frame.
99 (cl-loop for win in
(winner-sorted-window-list)
100 collect
(cons (winner-edges win
) (window-buffer win
))))
102 ;; This variable is updated with the current window configuration
103 ;; every time it changes.
104 (defvar winner-currents nil
)
106 ;; The current configuration (+ the buffers involved).
107 (defsubst winner-conf
()
108 (cons (current-window-configuration)
112 ;; Save current configuration.
113 ;; (Called below by `winner-save-old-configurations').
114 (defun winner-remember ()
115 (let ((entry (assq (selected-frame) winner-currents
)))
116 (if entry
(setcdr entry
(winner-conf))
117 (push (cons (selected-frame) (winner-conf))
120 ;; Consult `winner-currents'.
121 (defun winner-configuration (&optional frame
)
122 (or (cdr (assq (or frame
(selected-frame)) winner-currents
))
123 (with-selected-frame frame
128 ;;; Saved configurations
130 ;; This variable contains the window configuration rings.
131 ;; The key in this alist is the frame.
132 (defvar winner-ring-alist nil
)
134 ;; Find the right ring. If it does not exist, create one.
135 (defsubst winner-ring
(frame)
136 (or (cdr (assq frame winner-ring-alist
))
137 (let ((ring (make-ring winner-ring-size
)))
138 (ring-insert ring
(winner-configuration frame
))
139 (push (cons frame ring
) winner-ring-alist
)
143 ;; If the same command is called several times in a row,
144 ;; we only save one window configuration.
145 (defvar winner-last-command nil
)
147 ;; Frames affected by the previous command.
148 (defvar winner-last-frames nil
)
151 (defsubst winner-equal
(a b
)
152 "Check whether two Winner configurations (as produced by
153 `winner-conf') are equal."
154 (equal (cdr a
) (cdr b
)))
157 ;; Save the current window configuration, if it has changed.
158 ;; If so return frame, otherwise return nil.
159 (defun winner-insert-if-new (frame)
160 (unless (or (memq frame winner-last-frames
)
161 (eq this-command
'winner-redo
))
162 (let ((conf (winner-configuration frame
))
163 (ring (winner-ring frame
)))
164 (when (and (not (ring-empty-p ring
))
165 (winner-equal conf
(ring-ref ring
0)))
166 ;; When the previous configuration was very similar,
167 ;; keep only the latest.
168 (ring-remove ring
0))
169 (ring-insert ring conf
)
170 (push frame winner-last-frames
)
177 ;; Frames affected by the current command.
178 (defvar winner-modified-list nil
)
180 ;; Called whenever the window configuration changes
181 ;; (a `window-configuration-change-hook').
182 (defun winner-change-fun ()
183 (unless (or (memq (selected-frame) winner-modified-list
)
184 (/= 0 (minibuffer-depth)))
185 (push (selected-frame) winner-modified-list
)))
187 ;; A `post-command-hook' for emacsen with
188 ;; `window-configuration-change-hook'.
189 (defun winner-save-old-configurations ()
190 (when (zerop (minibuffer-depth))
191 (unless (eq this-command winner-last-command
)
192 (setq winner-last-frames nil
)
193 (setq winner-last-command this-command
))
194 (dolist (frame winner-modified-list
)
195 (winner-insert-if-new frame
))
196 (setq winner-modified-list nil
)
199 ;; A `minibuffer-setup-hook'.
200 (defun winner-save-unconditionally ()
201 (unless (eq this-command winner-last-command
)
202 (setq winner-last-frames nil
)
203 (setq winner-last-command this-command
))
204 (winner-insert-if-new (selected-frame))
207 ;; A `post-command-hook' for other emacsen.
208 ;; Also called by `winner-undo' before "undoing".
209 (defun winner-save-conditionally ()
210 (when (zerop (minibuffer-depth))
211 (winner-save-unconditionally)))
216 ;;;; Restoring configurations
218 ;; Works almost as `set-window-configuration',
219 ;; but does not change the contents or the size of the minibuffer,
220 ;; and tries to preserve the selected window.
221 (defun winner-set-conf (winconf)
222 (let* ((miniwin (minibuffer-window))
223 (chosen (selected-window))
224 (minisize (window-height miniwin
)))
225 (cl-letf (((window-buffer miniwin
))
226 ((window-point miniwin
)))
227 (set-window-configuration winconf
))
229 ((window-live-p chosen
) (select-window chosen
))
230 ((window-minibuffer-p) (other-window 1)))
231 (when (/= minisize
(window-height miniwin
))
232 (with-selected-window miniwin
233 (setf (window-height) minisize
)))))
237 (defvar winner-point-alist nil
)
238 ;; `set-window-configuration' restores old points and marks. This is
239 ;; not what we want, so we make a list of the "real" (i.e. new) points
240 ;; and marks before undoing window configurations.
242 ;; Format of entries: (buffer (mark . mark-active) (window . point) ..)
244 (defun winner-make-point-alist ()
247 for win in
(winner-window-list)
249 (or (assq (window-buffer win
) alist
)
250 (car (push (list (set-buffer (window-buffer win
))
251 (cons (mark t
) (winner-active-region)))
253 do
(push (cons win
(window-point win
))
255 finally return alist
)))
257 (defun winner-get-point (buf win
)
258 ;; Consult (and possibly extend) `winner-point-alist'.
259 ;; Returns nil if buf no longer exists.
260 (when (buffer-name buf
)
261 (let ((entry (assq buf winner-point-alist
)))
264 (or (cdr (assq win
(cddr entry
)))
265 (cdr (assq nil
(cddr entry
)))
266 (with-current-buffer buf
267 (push (cons nil
(point)) (cddr entry
))
269 (t (with-current-buffer buf
271 (cons (mark t
) (winner-active-region))
277 ;; Make sure point does not end up in the minibuffer and delete
278 ;; windows displaying dead or boring buffers
279 ;; (c.f. `winner-boring-buffers'). Return nil if all the windows
280 ;; should be deleted. Preserve correct points and marks.
281 (defun winner-set (conf)
282 ;; For the format of `conf', see `winner-conf'.
285 ;; Possibly update `winner-point-alist'
286 (cl-loop for buf in
(mapcar 'cdr
(cdr conf
))
287 for pos
= (winner-get-point buf nil
)
288 if
(and pos
(not (memq buf buffers
)))
289 do
(push buf buffers
)
291 (winner-set-conf (car conf
))
292 (let (xwins) ; to be deleted
295 (dolist (win (winner-sorted-window-list))
296 (unless (and (pop alive
)
297 (setf (window-point win
)
298 (winner-get-point (window-buffer win
) win
))
299 (not (member (buffer-name (window-buffer win
))
300 winner-boring-buffers
)))
301 (push win xwins
))) ; delete this window
305 (cl-loop for buf in buffers
306 for entry
= (cadr (assq buf winner-point-alist
))
307 do
(progn (set-buffer buf
)
308 (set-mark (car entry
))
309 (setf (winner-active-region) (cdr entry
)))))
310 ;; Delete windows, whose buffers are dead or boring.
311 ;; Return t if this is still a possible configuration.
314 (mapc 'delete-window
(cdr xwins
)) ; delete all but one
315 (unless (one-window-p t
)
316 (delete-window (car xwins
))
321 ;;;; Winner mode (a minor mode)
323 (defcustom winner-mode-hook nil
324 "Functions to run whenever Winner mode is turned on or off."
328 (define-obsolete-variable-alias 'winner-mode-leave-hook
329 'winner-mode-off-hook
"24.3")
331 (defcustom winner-mode-off-hook nil
332 "Functions to run whenever Winner mode is turned off."
336 (defvar winner-mode-map
337 (let ((map (make-sparse-keymap)))
338 (unless winner-dont-bind-my-keys
339 (define-key map
[(control c
) left
] 'winner-undo
)
340 (define-key map
[(control c
) right
] 'winner-redo
))
342 "Keymap for Winner mode.")
346 (define-minor-mode winner-mode nil
:global t
; let d-m-m make the doc
349 (add-hook 'window-configuration-change-hook
'winner-change-fun
)
350 (add-hook 'post-command-hook
'winner-save-old-configurations
)
351 (add-hook 'minibuffer-setup-hook
'winner-save-unconditionally
)
352 (setq winner-modified-list
(frame-list))
353 (winner-save-old-configurations))
354 (remove-hook 'window-configuration-change-hook
'winner-change-fun
)
355 (remove-hook 'post-command-hook
'winner-save-old-configurations
)
356 (remove-hook 'minibuffer-setup-hook
'winner-save-unconditionally
)))
358 ;; Inspired by undo (simple.el)
360 (defvar winner-undo-frame nil
)
362 (defvar winner-pending-undo-ring nil
363 "The ring currently used by `winner-undo'.")
364 (defvar winner-undo-counter nil
)
365 (defvar winner-undone-data nil
) ; There confs have been passed.
367 (defun winner-undo ()
368 "Switch back to an earlier window configuration saved by Winner mode.
369 In other words, \"undo\" changes in window configuration."
372 ((not winner-mode
) (error "Winner mode is turned off"))
373 (t (unless (and (eq last-command
'winner-undo
)
374 (eq winner-undo-frame
(selected-frame)))
375 (winner-save-conditionally) ; current configuration->stack
376 (setq winner-undo-frame
(selected-frame))
377 (setq winner-point-alist
(winner-make-point-alist))
378 (setq winner-pending-undo-ring
(winner-ring (selected-frame)))
379 (setq winner-undo-counter
0)
380 (setq winner-undone-data
(list (winner-win-data))))
381 (cl-incf winner-undo-counter
) ; starting at 1
382 (when (and (winner-undo-this)
383 (not (window-minibuffer-p)))
384 (message "Winner undo (%d / %d)"
386 (1- (ring-length winner-pending-undo-ring
)))))))
391 (defun winner-undo-this () ; The heart of winner undo.
394 ((>= winner-undo-counter
(ring-length winner-pending-undo-ring
))
395 (message "No further window configuration undo information")
398 ((and ; If possible configuration
399 (winner-set (ring-ref winner-pending-undo-ring
400 winner-undo-counter
))
401 ; .. and new configuration
402 (let ((data (winner-win-data)))
403 (and (not (member data winner-undone-data
))
404 (push data winner-undone-data
))))
405 (cl-return t
)) ; .. then everything is fine.
406 (t ;; Otherwise, discharge it (and try the next one).
407 (ring-remove winner-pending-undo-ring winner-undo-counter
)))))
410 (defun winner-redo () ; If you change your mind.
411 "Restore a more recent window configuration saved by Winner mode."
414 ((eq last-command
'winner-undo
)
416 (if (zerop (minibuffer-depth))
417 (ring-remove winner-pending-undo-ring
0)
418 (ring-ref winner-pending-undo-ring
0)))
419 (unless (eq (selected-window) (minibuffer-window))
420 (message "Winner undid undo")))
421 (t (error "Previous command was not a `winner-undo'"))))
424 ;;; winner.el ends here