1 ;;; winner.el --- Restore old window configurations
3 ;; Copyright (C) 1997-1998, 2001-2015 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 (setf (alist-get (selected-frame) winner-currents
) (winner-conf)))
117 ;; Consult `winner-currents'.
118 (defun winner-configuration (&optional frame
)
119 (or (cdr (assq (or frame
(selected-frame)) winner-currents
))
120 (with-selected-frame frame
125 ;;; Saved configurations
127 ;; This variable contains the window configuration rings.
128 ;; The key in this alist is the frame.
129 (defvar winner-ring-alist nil
)
131 ;; Find the right ring. If it does not exist, create one.
132 (defsubst winner-ring
(frame)
133 (or (cdr (assq frame winner-ring-alist
))
134 (let ((ring (make-ring winner-ring-size
)))
135 (ring-insert ring
(winner-configuration frame
))
136 (push (cons frame ring
) winner-ring-alist
)
140 ;; If the same command is called several times in a row,
141 ;; we only save one window configuration.
142 (defvar winner-last-command nil
)
144 ;; Frames affected by the previous command.
145 (defvar winner-last-frames nil
)
148 (defsubst winner-equal
(a b
)
149 "Check whether two Winner configurations (as produced by
150 `winner-conf') are equal."
151 (equal (cdr a
) (cdr b
)))
154 ;; Save the current window configuration, if it has changed.
155 ;; If so return frame, otherwise return nil.
156 (defun winner-insert-if-new (frame)
157 (unless (or (memq frame winner-last-frames
)
158 (eq this-command
'winner-redo
))
159 (let ((conf (winner-configuration frame
))
160 (ring (winner-ring frame
)))
161 (when (and (not (ring-empty-p ring
))
162 (winner-equal conf
(ring-ref ring
0)))
163 ;; When the previous configuration was very similar,
164 ;; keep only the latest.
165 (ring-remove ring
0))
166 (ring-insert ring conf
)
167 (push frame winner-last-frames
)
174 ;; Frames affected by the current command.
175 (defvar winner-modified-list nil
)
177 ;; Called whenever the window configuration changes
178 ;; (a `window-configuration-change-hook').
179 (defun winner-change-fun ()
182 (setq winner-modified-list
183 (cl-remove-if-not 'frame-live-p winner-modified-list
))
185 (unless (or (memq (selected-frame) winner-modified-list
)
186 (/= 0 (minibuffer-depth)))
187 (push (selected-frame) winner-modified-list
)))
189 ;; A `post-command-hook' for emacsen with
190 ;; `window-configuration-change-hook'.
191 (defun winner-save-old-configurations ()
192 (when (zerop (minibuffer-depth))
193 (unless (eq this-command winner-last-command
)
194 (setq winner-last-frames nil
)
195 (setq winner-last-command this-command
))
196 (dolist (frame winner-modified-list
)
197 (winner-insert-if-new frame
))
198 (setq winner-modified-list nil
)
201 ;; A `minibuffer-setup-hook'.
202 (defun winner-save-unconditionally ()
203 (unless (eq this-command winner-last-command
)
204 (setq winner-last-frames nil
)
205 (setq winner-last-command this-command
))
206 (winner-insert-if-new (selected-frame))
209 ;; A `post-command-hook' for other emacsen.
210 ;; Also called by `winner-undo' before "undoing".
211 (defun winner-save-conditionally ()
212 (when (zerop (minibuffer-depth))
213 (winner-save-unconditionally)))
218 ;;;; Restoring configurations
220 ;; Works almost as `set-window-configuration',
221 ;; but does not change the contents or the size of the minibuffer,
222 ;; and tries to preserve the selected window.
223 (defun winner-set-conf (winconf)
224 (let* ((miniwin (minibuffer-window))
225 (chosen (selected-window))
226 (minisize (window-height miniwin
)))
227 (cl-letf (((window-buffer miniwin
))
228 ((window-point miniwin
)))
229 (set-window-configuration winconf
))
231 ((window-live-p chosen
) (select-window chosen
))
232 ((window-minibuffer-p) (other-window 1)))
233 (when (/= minisize
(window-height miniwin
))
234 (with-selected-window miniwin
235 (setf (window-height) minisize
)))))
239 (defvar winner-point-alist nil
)
240 ;; `set-window-configuration' restores old points and marks. This is
241 ;; not what we want, so we make a list of the "real" (i.e. new) points
242 ;; and marks before undoing window configurations.
244 ;; Format of entries: (buffer (mark . mark-active) (window . point) ..)
246 (defun winner-make-point-alist ()
249 for win in
(winner-window-list)
251 (or (assq (window-buffer win
) alist
)
252 (car (push (list (set-buffer (window-buffer win
))
253 (cons (mark t
) (winner-active-region)))
255 do
(push (cons win
(window-point win
))
257 finally return alist
)))
259 (defun winner-get-point (buf win
)
260 ;; Consult (and possibly extend) `winner-point-alist'.
261 ;; Returns nil if buf no longer exists.
262 (when (buffer-name buf
)
263 (let ((entry (assq buf winner-point-alist
)))
266 (or (cdr (assq win
(cddr entry
)))
267 (cdr (assq nil
(cddr entry
)))
268 (with-current-buffer buf
269 (push (cons nil
(point)) (cddr entry
))
271 (t (with-current-buffer buf
273 (cons (mark t
) (winner-active-region))
279 ;; Make sure point does not end up in the minibuffer and delete
280 ;; windows displaying dead or boring buffers
281 ;; (c.f. `winner-boring-buffers'). Return nil if all the windows
282 ;; should be deleted. Preserve correct points and marks.
283 (defun winner-set (conf)
284 ;; For the format of `conf', see `winner-conf'.
287 ;; Possibly update `winner-point-alist'
288 (cl-loop for buf in
(mapcar 'cdr
(cdr conf
))
289 for pos
= (winner-get-point buf nil
)
290 if
(and pos
(not (memq buf buffers
)))
291 do
(push buf buffers
)
293 (winner-set-conf (car conf
))
294 (let (xwins) ; to be deleted
297 (dolist (win (winner-sorted-window-list))
298 (unless (and (pop alive
)
299 (setf (window-point win
)
300 (winner-get-point (window-buffer win
) win
))
301 (not (member (buffer-name (window-buffer win
))
302 winner-boring-buffers
)))
303 (push win xwins
))) ; delete this window
307 (cl-loop for buf in buffers
308 for entry
= (cadr (assq buf winner-point-alist
))
309 do
(progn (set-buffer buf
)
310 (set-mark (car entry
))
311 (setf (winner-active-region) (cdr entry
)))))
312 ;; Delete windows, whose buffers are dead or boring.
313 ;; Return t if this is still a possible configuration.
316 (mapc 'delete-window
(cdr xwins
)) ; delete all but one
317 (unless (one-window-p t
)
318 (delete-window (car xwins
))
323 ;;;; Winner mode (a minor mode)
325 (defcustom winner-mode-hook nil
326 "Functions to run whenever Winner mode is turned on or off."
330 (define-obsolete-variable-alias 'winner-mode-leave-hook
331 'winner-mode-off-hook
"24.3")
333 (defcustom winner-mode-off-hook nil
334 "Functions to run whenever Winner mode is turned off."
338 (defvar winner-mode-map
339 (let ((map (make-sparse-keymap)))
340 (unless winner-dont-bind-my-keys
341 (define-key map
[(control c
) left
] 'winner-undo
)
342 (define-key map
[(control c
) right
] 'winner-redo
))
344 "Keymap for Winner mode.")
348 (define-minor-mode winner-mode nil
:global t
; let d-m-m make the doc
351 (add-hook 'window-configuration-change-hook
'winner-change-fun
)
352 (add-hook 'post-command-hook
'winner-save-old-configurations
)
353 (add-hook 'minibuffer-setup-hook
'winner-save-unconditionally
)
354 (setq winner-modified-list
(frame-list))
355 (winner-save-old-configurations))
356 (remove-hook 'window-configuration-change-hook
'winner-change-fun
)
357 (remove-hook 'post-command-hook
'winner-save-old-configurations
)
358 (remove-hook 'minibuffer-setup-hook
'winner-save-unconditionally
)))
360 ;; Inspired by undo (simple.el)
362 (defvar winner-undo-frame nil
)
364 (defvar winner-pending-undo-ring nil
365 "The ring currently used by `winner-undo'.")
366 (defvar winner-undo-counter nil
)
367 (defvar winner-undone-data nil
) ; There confs have been passed.
369 (defun winner-undo ()
370 "Switch back to an earlier window configuration saved by Winner mode.
371 In other words, \"undo\" changes in window configuration."
374 ((not winner-mode
) (error "Winner mode is turned off"))
375 (t (unless (and (eq last-command
'winner-undo
)
376 (eq winner-undo-frame
(selected-frame)))
377 (winner-save-conditionally) ; current configuration->stack
378 (setq winner-undo-frame
(selected-frame))
379 (setq winner-point-alist
(winner-make-point-alist))
380 (setq winner-pending-undo-ring
(winner-ring (selected-frame)))
381 (setq winner-undo-counter
0)
382 (setq winner-undone-data
(list (winner-win-data))))
383 (cl-incf winner-undo-counter
) ; starting at 1
384 (when (and (winner-undo-this)
385 (not (window-minibuffer-p)))
386 (message "Winner undo (%d / %d)"
388 (1- (ring-length winner-pending-undo-ring
)))))))
393 (defun winner-undo-this () ; The heart of winner undo.
396 ((>= winner-undo-counter
(ring-length winner-pending-undo-ring
))
397 (message "No further window configuration undo information")
400 ((and ; If possible configuration
401 (winner-set (ring-ref winner-pending-undo-ring
402 winner-undo-counter
))
403 ; .. and new configuration
404 (let ((data (winner-win-data)))
405 (and (not (member data winner-undone-data
))
406 (push data winner-undone-data
))))
407 (cl-return t
)) ; .. then everything is fine.
408 (t ;; Otherwise, discharge it (and try the next one).
409 (ring-remove winner-pending-undo-ring winner-undo-counter
)))))
412 (defun winner-redo () ; If you change your mind.
413 "Restore a more recent window configuration saved by Winner mode."
416 ((eq last-command
'winner-undo
)
418 (if (zerop (minibuffer-depth))
419 (ring-remove winner-pending-undo-ring
0)
420 (ring-ref winner-pending-undo-ring
0)))
421 (unless (eq (selected-window) (minibuffer-window))
422 (message "Winner undid undo")))
423 (t (user-error "Previous command was not a `winner-undo'"))))
426 ;;; winner.el ends here