Mercurial > emacs
comparison lisp/winner.el @ 43556:9e4a1be87f8c
(winner-boring-buffers, winner-set): A window which
displays a buffer whose name is in the list `winner-boring-buffers'
will no longer be restored by `winner-undo'.
(winner-sorted-window-list): Used to improve comparison between
window configurations.
(winner-win-data): Simplified and moved.
(winner-conf): Simplified (now uses `winner-win-data').
(winner-change-fun, winner-save-old-configurations)
(winner-save-(un)conditionally, winner-redo): Changes made while in
the minibuffer will be ignored. (Such changes are undone upon
exit for the minibuffer, anyway.)
(winner-set-conf): Preserve selected window whenever possible.
(winner-make-point-alist): Simplified.
(winner-mode, winner-save-unconditionally): Save current window
configuration on entering minibuffer.
(minor-mode-alist): Don't add winner-mode to `minor-mode-alist',
since it does not change the overall behavior of Emacs.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 26 Feb 2002 16:08:29 +0000 |
parents | 63281ffd14fd |
children | ee08f1e3d269 |
comparison
equal
deleted
inserted
replaced
43555:c33c91ae60fc | 43556:9e4a1be87f8c |
---|---|
2 | 2 |
3 ;; Copyright (C) 1997, 1998, 2001 Free Software Foundation. Inc. | 3 ;; Copyright (C) 1997, 1998, 2001 Free Software Foundation. Inc. |
4 | 4 |
5 ;; Author: Ivar Rummelhoff <ivarru@math.uio.no> | 5 ;; Author: Ivar Rummelhoff <ivarru@math.uio.no> |
6 ;; Created: 27 Feb 1997 | 6 ;; Created: 27 Feb 1997 |
7 ;; Time-stamp: <1998-08-21 19:51:02 ivarr> | 7 ;; Time-stamp: <2002-02-20 22:06:58 ivarru> |
8 ;; Keywords: convenience frames | 8 ;; Keywords: convenience frames |
9 | 9 |
10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
11 | 11 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
34 ;; press ctrl-x right (calling `winner-redo'). Even though it uses | 34 ;; press ctrl-x right (calling `winner-redo'). Even though it uses |
35 ;; some features of Emacs20.3, winner.el should also work with | 35 ;; some features of Emacs20.3, winner.el should also work with |
36 ;; Emacs19.34 and XEmacs20, provided that the installed version of | 36 ;; Emacs19.34 and XEmacs20, provided that the installed version of |
37 ;; custom is not obsolete. | 37 ;; custom is not obsolete. |
38 | 38 |
39 ;; Winner mode was improved august 1998. | 39 ;; Winner mode was improved August 1998. |
40 ;; Further improvements February 2002. | |
40 | 41 |
41 ;;; Code: | 42 ;;; Code: |
42 | 43 |
43 (eval-when-compile | 44 (eval-when-compile |
44 (require 'cl)) | 45 (require 'cl)) |
54 (t (defmacro winner-active-region () | 55 (t (defmacro winner-active-region () |
55 'mark-active) | 56 'mark-active) |
56 (defsetf winner-active-region () (store) | 57 (defsetf winner-active-region () (store) |
57 `(setq mark-active ,store)))) ) | 58 `(setq mark-active ,store)))) ) |
58 | 59 |
60 (eval-and-compile | |
61 (cond | |
62 ((eq (aref (emacs-version) 0) ?X) | |
63 (defalias 'winner-edges 'window-pixel-edges) | |
64 (defsubst winner-window-list () | |
65 (remq (minibuffer-window) | |
66 (window-list nil 0)))) | |
67 (t (defalias 'winner-edges 'window-edges) | |
68 (defsubst winner-window-list () | |
69 (window-list nil 0)))) ) | |
70 | |
59 (require 'ring) | 71 (require 'ring) |
60 | 72 |
61 (when (fboundp 'defgroup) | 73 (when (fboundp 'defgroup) |
62 (defgroup winner nil | 74 (defgroup winner nil |
63 "Restoring window configurations." | 75 "Restoring window configurations." |
65 | 77 |
66 (unless (fboundp 'defcustom) | 78 (unless (fboundp 'defcustom) |
67 (defmacro defcustom (symbol &optional initvalue docs &rest rest) | 79 (defmacro defcustom (symbol &optional initvalue docs &rest rest) |
68 (list 'defvar symbol initvalue docs))) | 80 (list 'defvar symbol initvalue docs))) |
69 | 81 |
70 | |
71 ;;;###autoload | 82 ;;;###autoload |
72 (defcustom winner-mode nil | 83 (defcustom winner-mode nil |
73 "Toggle winner-mode. | 84 "Toggle winner-mode. |
74 Setting this variable directly does not take effect; | 85 Setting this variable directly does not take effect; |
75 use either \\[customize] or the function `winner-mode'." | 86 use either \\[customize] or the function `winner-mode'." |
88 (defcustom winner-ring-size 200 | 99 (defcustom winner-ring-size 200 |
89 "Maximum number of stored window configurations per frame." | 100 "Maximum number of stored window configurations per frame." |
90 :type 'integer | 101 :type 'integer |
91 :group 'winner) | 102 :group 'winner) |
92 | 103 |
93 | 104 (defcustom winner-boring-buffers '("*Completions*") |
94 | 105 "`winner-undo' will not restore windows displaying any of these \ |
95 | 106 buffers. |
96 ;;;; Saving old configurations (internal variables and subroutines) | 107 You may want to include buffer names such as *Help*, *Apropos*, |
97 | 108 *Buffer List*, *info* and *Compile-Log*." |
109 :type '(repeat string) | |
110 :group 'winner) | |
111 | |
112 | |
113 | |
114 | |
115 ;;;; Saving old configurations (internal variables and subroutines) | |
116 | |
117 | |
118 ;;; Current configuration | |
119 | |
120 ;; List the windows according to their edges. | |
121 (defun winner-sorted-window-list () | |
122 (sort (winner-window-list) | |
123 (lambda (x y) | |
124 (loop for a in (winner-edges x) | |
125 for b in (winner-edges y) | |
126 while (= a b) | |
127 finally return (< a b))))) | |
128 | |
129 (defun winner-win-data () | |
130 ;; Essential properties of the windows in the selected frame. | |
131 (loop for win in (winner-sorted-window-list) | |
132 collect (cons (winner-edges win) (window-buffer win)))) | |
133 | |
98 ;; This variable is updated with the current window configuration | 134 ;; This variable is updated with the current window configuration |
99 ;; after every command, so that when command make changes in the | 135 ;; every time it changes. |
100 ;; window configuration, the last configuration can be saved. | |
101 (defvar winner-currents nil) | 136 (defvar winner-currents nil) |
102 | 137 |
103 ;; The current configuration (+ the buffers involved). | 138 ;; The current configuration (+ the buffers involved). |
104 (defsubst winner-conf () | 139 (defsubst winner-conf () |
105 (list (current-window-configuration) | 140 (cons (current-window-configuration) |
106 (loop for w being the windows | 141 (winner-win-data))) |
107 unless (window-minibuffer-p w) | 142 |
108 collect (window-buffer w)) )) | |
109 ;; (if winner-testvar (incf winner-testvar) ; For debugging purposes | |
110 ;; (setq winner-testvar 0)))) | |
111 | 143 |
112 ;; Save current configuration. | 144 ;; Save current configuration. |
113 ;; (Called by `winner-save-old-configurations' below). | 145 ;; (Called below by `winner-save-old-configurations'). |
114 (defun winner-remember () | 146 (defun winner-remember () |
115 (let ((entry (assq (selected-frame) winner-currents))) | 147 (let ((entry (assq (selected-frame) winner-currents))) |
116 (if entry (setcdr entry (winner-conf)) | 148 (if entry (setcdr entry (winner-conf)) |
117 (push (cons (selected-frame) (winner-conf)) | 149 (push (cons (selected-frame) (winner-conf)) |
118 winner-currents)))) | 150 winner-currents)))) |
122 (or (cdr (assq (or frame (selected-frame)) winner-currents)) | 154 (or (cdr (assq (or frame (selected-frame)) winner-currents)) |
123 (letf (((selected-frame) frame)) | 155 (letf (((selected-frame) frame)) |
124 (winner-conf)))) | 156 (winner-conf)))) |
125 | 157 |
126 | 158 |
159 | |
160 ;;; Saved configurations | |
127 | 161 |
128 ;; This variable contains the window cofiguration rings. | 162 ;; This variable contains the window cofiguration rings. |
129 ;; The key in this alist is the frame. | 163 ;; The key in this alist is the frame. |
130 (defvar winner-ring-alist nil) | 164 (defvar winner-ring-alist nil) |
131 | 165 |
145 ;; Frames affected by the previous command. | 179 ;; Frames affected by the previous command. |
146 (defvar winner-last-frames nil) | 180 (defvar winner-last-frames nil) |
147 | 181 |
148 | 182 |
149 (defun winner-equal (a b) | 183 (defun winner-equal (a b) |
150 "Check two Winner configurations A and B for equality. | 184 "Check whether two Winner configurations (as produced by |
151 Winner configurations are of the form (CONFIG BUFFERS), | 185 `winner-conf') are equal." |
152 where CONFIG is a window configuration and BUFFERS is a list of | 186 (equal (cdr a) (cdr b))) |
153 buffers." | |
154 (and (compare-window-configurations (car a) (car b)) | |
155 (equal (cdr a) (cdr b)))) | |
156 | 187 |
157 | 188 |
158 ;; Save the current window configuration, if it has changed. | 189 ;; Save the current window configuration, if it has changed. |
159 ;; Then return frame, else return nil. | 190 ;; If so return frame, otherwise return nil. |
160 (defun winner-insert-if-new (frame) | 191 (defun winner-insert-if-new (frame) |
161 (unless (or (memq frame winner-last-frames) | 192 (unless (or (memq frame winner-last-frames) |
162 (eq this-command 'winner-redo)) | 193 (eq this-command 'winner-redo)) |
163 (let ((conf (winner-configuration frame)) | 194 (let ((conf (winner-configuration frame)) |
164 (ring (winner-ring frame))) | 195 (ring (winner-ring frame))) |
165 (when (and (not (ring-empty-p ring)) | 196 (when (and (not (ring-empty-p ring)) |
166 (winner-equal conf (ring-ref ring 0))) | 197 (winner-equal conf (ring-ref ring 0))) |
198 ;; When the previous configuration was very similar, | |
199 ;; keep only the latest. | |
167 (ring-remove ring 0)) | 200 (ring-remove ring 0)) |
168 (ring-insert ring conf) | 201 (ring-insert ring conf) |
169 (push frame winner-last-frames) | 202 (push frame winner-last-frames) |
170 frame))) | 203 frame))) |
171 | 204 |
205 | |
206 | |
207 ;;; Hooks | |
208 | |
172 ;; Frames affected by the current command. | 209 ;; Frames affected by the current command. |
173 (defvar winner-modified-list nil) | 210 (defvar winner-modified-list nil) |
174 | 211 |
175 ;; Called whenever the window configuration changes | 212 ;; Called whenever the window configuration changes |
176 ;; (a `window-configuration-change-hook'). | 213 ;; (a `window-configuration-change-hook'). |
177 (defun winner-change-fun () | 214 (defun winner-change-fun () |
178 (unless (memq (selected-frame) winner-modified-list) | 215 (unless (or (memq (selected-frame) winner-modified-list) |
216 (/= 0 (minibuffer-depth))) | |
179 (push (selected-frame) winner-modified-list))) | 217 (push (selected-frame) winner-modified-list))) |
180 | 218 |
181 | 219 ;; A `post-command-hook' for emacsen with |
182 ;; For Emacs20 (a `post-command-hook'). | 220 ;; `window-configuration-change-hook'. |
183 (defun winner-save-old-configurations () | 221 (defun winner-save-old-configurations () |
184 (unless (eq this-command winner-last-command) | 222 (when (zerop (minibuffer-depth)) |
185 (setq winner-last-frames nil) | 223 (unless (eq this-command winner-last-command) |
186 (setq winner-last-command this-command)) | 224 (setq winner-last-frames nil) |
187 (dolist (frame winner-modified-list) | 225 (setq winner-last-command this-command)) |
188 (winner-insert-if-new frame)) | 226 (dolist (frame winner-modified-list) |
189 (setq winner-modified-list nil) | 227 (winner-insert-if-new frame)) |
190 ;; (ir-trace ; For debugging purposes | 228 (setq winner-modified-list nil) |
191 ;; "%S" | 229 (winner-remember))) |
192 ;; (loop with ring = (winner-ring (selected-frame)) | 230 |
193 ;; for i from 0 to (1- (ring-length ring)) | 231 ;; A `minibuffer-setup-hook'. |
194 ;; collect (caddr (ring-ref ring i)))) | |
195 (winner-remember)) | |
196 | |
197 ;; For compatibility with other emacsen | |
198 ;; and called by `winner-undo' before "undoing". | |
199 (defun winner-save-unconditionally () | 232 (defun winner-save-unconditionally () |
200 (unless (eq this-command winner-last-command) | 233 (unless (eq this-command winner-last-command) |
201 (setq winner-last-frames nil) | 234 (setq winner-last-frames nil) |
202 (setq winner-last-command this-command)) | 235 (setq winner-last-command this-command)) |
203 (winner-insert-if-new (selected-frame)) | 236 (winner-insert-if-new (selected-frame)) |
204 (winner-remember)) | 237 (winner-remember)) |
205 | 238 |
239 ;; A `post-command-hook' for other emacsen. | |
240 ;; Also called by `winner-undo' before "undoing". | |
241 (defun winner-save-conditionally () | |
242 (when (zerop (minibuffer-depth)) | |
243 (winner-save-unconditionally))) | |
206 | 244 |
207 | 245 |
208 | 246 |
209 ;;;; Restoring configurations | 247 ;;;; Restoring configurations |
210 | 248 |
211 ;; Works almost as `set-window-configuration', | 249 ;; Works almost as `set-window-configuration', |
212 ;; but doesn't change the contents or the size of the minibuffer. | 250 ;; but does not change the contents or the size of the minibuffer, |
251 ;; and tries to preserve the selected window. | |
213 (defun winner-set-conf (winconf) | 252 (defun winner-set-conf (winconf) |
214 (let ((miniwin (minibuffer-window)) | 253 (let* ((miniwin (minibuffer-window)) |
215 (minisel (window-minibuffer-p (selected-window)))) | 254 (chosen (selected-window)) |
216 (let ((minibuf (window-buffer miniwin)) | 255 (minisize (window-height miniwin))) |
217 (minipoint (window-point miniwin)) | 256 (letf (((window-buffer miniwin)) |
218 (minisize (window-height miniwin))) | 257 ((window-point miniwin))) |
219 (set-window-configuration winconf) | 258 (set-window-configuration winconf)) |
220 (setf (window-buffer miniwin) minibuf | 259 (cond |
221 (window-point miniwin) minipoint) | 260 ((window-live-p chosen) (select-window chosen)) |
222 (when (/= minisize (window-height miniwin)) | 261 ((window-minibuffer-p (selected-window)) |
223 (letf (((selected-window) miniwin) ) | 262 (other-window 1))) |
224 ;; Clumsy due to cl-macs-limitation | 263 (when (/= minisize (window-height miniwin)) |
225 (setf (window-height) minisize))) | 264 (letf (((selected-window) miniwin) ) |
226 (cond | 265 (setf (window-height) minisize))))) |
227 (minisel (select-window miniwin)) | 266 |
228 ((window-minibuffer-p (selected-window)) | |
229 (other-window 1)))))) | |
230 | 267 |
231 | 268 |
232 (defvar winner-point-alist nil) | 269 (defvar winner-point-alist nil) |
233 ;; `set-window-configuration' restores old points and marks. This is | 270 ;; `set-window-configuration' restores old points and marks. This is |
234 ;; not what we want, so we make a list of the "real" (i.e. new) points | 271 ;; not what we want, so we make a list of the "real" (i.e. new) points |
237 ;; Format of entries: (buffer (mark . mark-active) (window . point) ..) | 274 ;; Format of entries: (buffer (mark . mark-active) (window . point) ..) |
238 | 275 |
239 (defun winner-make-point-alist () | 276 (defun winner-make-point-alist () |
240 (letf (((current-buffer))) | 277 (letf (((current-buffer))) |
241 (loop with alist | 278 (loop with alist |
242 with entry | 279 for win in (winner-window-list) |
243 for win being the windows | 280 for entry = |
244 do (cond | 281 (or (assq (window-buffer win) alist) |
245 ((window-minibuffer-p win)) | 282 (car (push (list (set-buffer (window-buffer win)) |
246 ((setq entry (assq win alist)) | 283 (cons (mark t) (winner-active-region))) |
247 ;; Update existing entry | 284 alist))) |
248 (push (cons win (window-point win)) | 285 do (push (cons win (window-point win)) |
249 (cddr entry))) | 286 (cddr entry)) |
250 (t;; Else create new entry | |
251 (push (list (set-buffer (window-buffer win)) | |
252 (cons (mark t) (winner-active-region)) | |
253 (cons win (window-point win))) | |
254 alist))) | |
255 finally return alist))) | 287 finally return alist))) |
256 | |
257 | 288 |
258 (defun winner-get-point (buf win) | 289 (defun winner-get-point (buf win) |
259 ;; Consult (and possibly extend) `winner-point-alist'. | 290 ;; Consult (and possibly extend) `winner-point-alist'. |
291 ;; Returns nil iff buf no longer exists. | |
260 (when (buffer-name buf) | 292 (when (buffer-name buf) |
261 (let ((entry (assq buf winner-point-alist))) | 293 (let ((entry (assq buf winner-point-alist))) |
262 (cond | 294 (cond |
263 (entry | 295 (entry |
264 (or (cdr (assq win (cddr entry))) | 296 (or (cdr (assq win (cddr entry))) |
271 (cons (mark t) (winner-active-region)) | 303 (cons (mark t) (winner-active-region)) |
272 (cons nil (point))) | 304 (cons nil (point))) |
273 winner-point-alist) | 305 winner-point-alist) |
274 (point))))))) | 306 (point))))))) |
275 | 307 |
276 ;; Make sure point doesn't end up in the minibuffer and | 308 ;; Make sure point does not end up in the minibuffer and delete |
277 ;; delete windows displaying dead buffers. Return nil | 309 ;; windows displaying dead or boring buffers |
278 ;; if and only if all the windows should have been deleted. | 310 ;; (c.f. `winner-boring-buffers'). Return nil iff all the windows |
279 ;; Do not move neither points nor marks. | 311 ;; should be deleted. Preserve correct points and marks. |
280 (defun winner-set (conf) | 312 (defun winner-set (conf) |
313 ;; For the format of `conf', see `winner-conf'. | |
281 (let* ((buffers nil) | 314 (let* ((buffers nil) |
282 (origpoints | 315 (alive |
283 (loop for buf in (cadr conf) | 316 ;; Possibly update `winner-point-alist' |
317 (loop for buf in (mapcar 'cdr (cdr conf)) | |
284 for pos = (winner-get-point buf nil) | 318 for pos = (winner-get-point buf nil) |
285 if (and pos (not (memq buf buffers))) | 319 if (and pos (not (memq buf buffers))) |
286 do (push buf buffers) | 320 do (push buf buffers) |
287 collect pos))) | 321 collect pos))) |
288 (winner-set-conf (car conf)) | 322 (winner-set-conf (car conf)) |
289 (let (xwins) ; These windows should be deleted | 323 (let (xwins) ; to be deleted |
290 (loop for win being the windows | 324 |
291 unless (window-minibuffer-p win) | 325 ;; Restore points |
292 do (if (pop origpoints) | 326 (dolist (win (winner-sorted-window-list)) |
293 (setf (window-point win) | 327 (unless (and (pop alive) |
294 ;; Restore point | 328 (setf (window-point win) |
295 (winner-get-point | 329 (winner-get-point (window-buffer win) win)) |
296 (window-buffer win) | 330 (not (member (buffer-name (window-buffer win)) |
297 win)) | 331 winner-boring-buffers))) |
298 (push win xwins))) ; delete this window | 332 (push win xwins))) ; delete this window |
299 ;; Restore mark | 333 |
334 ;; Restore marks | |
300 (letf (((current-buffer))) | 335 (letf (((current-buffer))) |
301 (loop for buf in buffers | 336 (loop for buf in buffers |
302 for entry = (cadr (assq buf winner-point-alist)) | 337 for entry = (cadr (assq buf winner-point-alist)) |
303 do (progn (set-buffer buf) | 338 do (progn (set-buffer buf) |
304 (set-mark (car entry)) | 339 (set-mark (car entry)) |
305 (setf (winner-active-region) (cdr entry))))) | 340 (setf (winner-active-region) (cdr entry))))) |
306 ;; Delete windows, whose buffers are dead. | 341 ;; Delete windows, whose buffers are dead or boring. |
307 ;; Return t if this is still a possible configuration. | 342 ;; Return t if this is still a possible configuration. |
308 (or (null xwins) | 343 (or (null xwins) |
309 (progn (mapcar 'delete-window (cdr xwins)) | 344 (progn |
310 (if (one-window-p t) | 345 (mapc 'delete-window (cdr xwins)) ; delete all but one |
311 nil ; No windows left | 346 (unless (one-window-p t) |
312 (progn (delete-window (car xwins)) | 347 (delete-window (car xwins)) |
313 t))))))) | 348 t)))))) |
314 | 349 |
315 | 350 |
316 | 351 |
317 ;;;; Winner mode (a minor mode) | 352 ;;;; Winner mode (a minor mode) |
318 | 353 |
326 :type 'hook | 361 :type 'hook |
327 :group 'winner) | 362 :group 'winner) |
328 | 363 |
329 (defvar winner-mode-map nil "Keymap for Winner mode.") | 364 (defvar winner-mode-map nil "Keymap for Winner mode.") |
330 | 365 |
331 ;; Is `window-configuration-change-hook' working? | 366 ;; Check if `window-configuration-change-hook' is working. |
332 (defun winner-hook-installed-p () | 367 (defun winner-hook-installed-p () |
333 (save-window-excursion | 368 (save-window-excursion |
334 (let ((winner-var nil) | 369 (let ((winner-var nil) |
335 (window-configuration-change-hook | 370 (window-configuration-change-hook |
336 '((lambda () (setq winner-var t))))) | 371 '((lambda () (setq winner-var t))))) |
351 (setq winner-mode t) | 386 (setq winner-mode t) |
352 (cond | 387 (cond |
353 ((winner-hook-installed-p) | 388 ((winner-hook-installed-p) |
354 (add-hook 'window-configuration-change-hook 'winner-change-fun) | 389 (add-hook 'window-configuration-change-hook 'winner-change-fun) |
355 (add-hook 'post-command-hook 'winner-save-old-configurations)) | 390 (add-hook 'post-command-hook 'winner-save-old-configurations)) |
356 (t (add-hook 'post-command-hook 'winner-save-unconditionally))) | 391 (t (add-hook 'post-command-hook 'winner-save-conditionally))) |
392 (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) | |
357 (setq winner-modified-list (frame-list)) | 393 (setq winner-modified-list (frame-list)) |
358 (winner-save-old-configurations) | 394 (winner-save-old-configurations) |
359 (run-hooks 'winner-mode-hook)) | 395 (run-hooks 'winner-mode-hook) |
396 (when (interactive-p) (message "Winner mode enabled"))) | |
360 ;; Turn mode off | 397 ;; Turn mode off |
361 (winner-mode | 398 (winner-mode |
362 (setq winner-mode nil) | 399 (setq winner-mode nil) |
363 (remove-hook 'window-configuration-change-hook 'winner-change-fun) | 400 (remove-hook 'window-configuration-change-hook 'winner-change-fun) |
364 (remove-hook 'post-command-hook 'winner-save-old-configurations) | 401 (remove-hook 'post-command-hook 'winner-save-old-configurations) |
365 (remove-hook 'post-command-hook 'winner-save-unconditionally) | 402 (remove-hook 'post-command-hook 'winner-save-conditionally) |
366 (run-hooks 'winner-mode-leave-hook))) | 403 (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally) |
367 (force-mode-line-update))) | 404 (run-hooks 'winner-mode-leave-hook) |
368 | 405 (when (interactive-p) (message "Winner mode disabled")))))) |
369 ;; Inspired by undo (simple.el) | 406 |
407 ;; Inspired by undo (simple.el) | |
370 | 408 |
371 (defvar winner-undo-frame nil) | 409 (defvar winner-undo-frame nil) |
372 | 410 |
373 (defvar winner-pending-undo-ring nil | 411 (defvar winner-pending-undo-ring nil |
374 "The ring currently used by winner undo.") | 412 "The ring currently used by winner undo.") |
381 (interactive) | 419 (interactive) |
382 (cond | 420 (cond |
383 ((not winner-mode) (error "Winner mode is turned off")) | 421 ((not winner-mode) (error "Winner mode is turned off")) |
384 (t (unless (and (eq last-command 'winner-undo) | 422 (t (unless (and (eq last-command 'winner-undo) |
385 (eq winner-undo-frame (selected-frame))) | 423 (eq winner-undo-frame (selected-frame))) |
386 (winner-save-unconditionally) ; current configuration->stack | 424 (winner-save-conditionally) ; current configuration->stack |
387 (setq winner-undo-frame (selected-frame)) | 425 (setq winner-undo-frame (selected-frame)) |
388 (setq winner-point-alist (winner-make-point-alist)) | 426 (setq winner-point-alist (winner-make-point-alist)) |
389 (setq winner-pending-undo-ring (winner-ring (selected-frame))) | 427 (setq winner-pending-undo-ring (winner-ring (selected-frame))) |
390 (setq winner-undo-counter 0) | 428 (setq winner-undo-counter 0) |
391 (setq winner-undone-data (list (winner-win-data)))) | 429 (setq winner-undone-data (list (winner-win-data)))) |
394 (not (window-minibuffer-p (selected-window)))) | 432 (not (window-minibuffer-p (selected-window)))) |
395 (message "Winner undo (%d / %d)" | 433 (message "Winner undo (%d / %d)" |
396 winner-undo-counter | 434 winner-undo-counter |
397 (1- (ring-length winner-pending-undo-ring))))))) | 435 (1- (ring-length winner-pending-undo-ring))))))) |
398 | 436 |
399 (defun winner-win-data () | 437 |
400 ;; Essential properties of the windows in the selected frame. | |
401 (loop for win being the windows | |
402 unless (window-minibuffer-p win) | |
403 collect (list (window-buffer win) | |
404 (window-width win) | |
405 (window-height win)))) | |
406 | 438 |
407 | 439 (defun winner-undo-this () ; The heart of winner undo. |
408 (defun winner-undo-this () ; The heart of winner undo. | |
409 (loop | 440 (loop |
410 (cond | 441 (cond |
411 ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) | 442 ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) |
412 (message "No further window configuration undo information") | 443 (message "No further window configuration undo information") |
413 (return nil)) | 444 (return nil)) |
414 | 445 |
415 ((and ; If possible configuration | 446 ((and ; If possible configuration |
416 (winner-set (ring-ref winner-pending-undo-ring | 447 (winner-set (ring-ref winner-pending-undo-ring |
417 winner-undo-counter)) | 448 winner-undo-counter)) |
418 ;; .. and new configuration | 449 ; .. and new configuration |
419 (let ((data (winner-win-data))) | 450 (let ((data (winner-win-data))) |
420 (and (not (member data winner-undone-data)) | 451 (and (not (member data winner-undone-data)) |
421 (push data winner-undone-data)))) | 452 (push data winner-undone-data)))) |
422 (return t)) ; .. then everything is all right. | 453 (return t)) ; .. then everything is fine. |
423 (t ; Else; discharge it and try another one. | 454 (t ;; Otherwise, discharge it (and try the next one). |
424 (ring-remove winner-pending-undo-ring winner-undo-counter))))) | 455 (ring-remove winner-pending-undo-ring winner-undo-counter))))) |
425 | 456 |
426 | 457 |
427 (defun winner-redo () ; If you change your mind. | 458 (defun winner-redo () ; If you change your mind. |
428 "Restore a more recent window configuration saved by Winner mode." | 459 "Restore a more recent window configuration saved by Winner mode." |
429 (interactive) | 460 (interactive) |
430 (cond | 461 (cond |
431 ((eq last-command 'winner-undo) | 462 ((eq last-command 'winner-undo) |
432 (winner-set | 463 (winner-set |
433 (ring-remove winner-pending-undo-ring 0)) | 464 (if (zerop (minibuffer-depth)) |
465 (ring-remove winner-pending-undo-ring 0) | |
466 (ring-ref winner-pending-undo-ring 0))) | |
434 (unless (eq (selected-window) (minibuffer-window)) | 467 (unless (eq (selected-window) (minibuffer-window)) |
435 (message "Winner undid undo"))) | 468 (message "Winner undid undo"))) |
436 (t (error "Previous command was not a winner-undo")))) | 469 (t (error "Previous command was not a winner-undo")))) |
437 | 470 |
438 ;;; To be evaluated when the package is loaded: | 471 ;;; To be evaluated when the package is loaded: |
439 | 472 |
440 (unless winner-mode-map | 473 (unless winner-mode-map |
441 (setq winner-mode-map (make-sparse-keymap)) | 474 (setq winner-mode-map (make-sparse-keymap)) |
442 (define-key winner-mode-map [(control x) left] 'winner-undo) | 475 (define-key winner-mode-map [(control x) left] 'winner-undo) |
445 (unless (or (assq 'winner-mode minor-mode-map-alist) | 478 (unless (or (assq 'winner-mode minor-mode-map-alist) |
446 winner-dont-bind-my-keys) | 479 winner-dont-bind-my-keys) |
447 (push (cons 'winner-mode winner-mode-map) | 480 (push (cons 'winner-mode winner-mode-map) |
448 minor-mode-map-alist)) | 481 minor-mode-map-alist)) |
449 | 482 |
450 (unless (assq 'winner-mode minor-mode-alist) | |
451 (push '(winner-mode " Win") minor-mode-alist)) | |
452 | |
453 (provide 'winner) | 483 (provide 'winner) |
454 | 484 |
455 ;;; winner.el ends here | 485 ;;; winner.el ends here |