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