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