X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1ffece3a395a51200dab005bc63e1eaca22854f2..aaef169dc63c4b557374540756865991e1bf6305:/lisp/winner.el?ds=sidebyside diff --git a/lisp/winner.el b/lisp/winner.el dissimilarity index 75% index ad6ae4399e..de0dcde6b0 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,231 +1,485 @@ -;;; winner.el --- Restore window configuration (or switch buffer) - -;; Copyright (C) 1997 Free Software Foundation. Inc. - -;; Author: Ivar Rummelhoff -;; Maintainer: Ivar Rummelhoff -;; Created: 27 Feb 1997 -;; Keywords: extensions, windows - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Winner mode is a global minor mode that when turned on records -;; changes in window configuration. This way the changes can be -;; "undone" using the function `winner-undo'. By default this one is -;; bound to the key sequence ctrl-x left. If you change your mind -;; (while undoing), you can press ctrl-x right (calling -;; `winner-redo'). Unlike the normal undo, you may have to skip -;; through several identical window configurations in order to find -;; the one you want. This is a bug due to some techical limitations -;; in Emacs and can maybe be fixed in the future. -;; -;; In addition to this I have added `winner-switch' which is a program -;; that switches to other buffers without disturbing Winner mode. If -;; you bind this command to a key sequence, you may step through all -;; your buffers (except the ones mentioned in `winner-skip-buffers' or -;; matched by `winner-skip-regexps'). With a numeric prefix argument -;; skip several buffers at a time. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ring) - -(defvar winner-dont-bind-my-keys nil - "If non-nil: Do not use `winner-mode-map' in Winner mode.") - -(defvar winner-ring-size 100 - "Maximum number of stored window configurations per frame.") - -(defvar winner-skip-buffers - '("*Messages*", - "*Compile-Log*", - ".newsrc-dribble", - "*Completions*", - "*Buffer list*") - "Exclude these buffer names from any \(Winner switch\) list of buffers.") - -(defvar winner-skip-regexps '("^ ") - "Winner excludes buffers with names matching any of these regexps. -They are not included in any Winner mode list of buffers. - -By default `winner-skip-regexps' is set to \(\"^ \"\), -which excludes \"invisible buffers\".") - -(defvar winner-ring-alist nil) - -(defsubst winner-ring (frame) - (or (cdr (assq frame winner-ring-alist)) - (progn - (push (cons frame (make-ring winner-ring-size)) - winner-ring-alist) - (cdar winner-ring-alist)))) - -(defvar winner-modified-list nil) - -(defun winner-change-fun () - (pushnew (selected-frame) winner-modified-list)) - -(defun winner-save-new-configurations () - (while winner-modified-list - (ring-insert - (winner-ring (car winner-modified-list)) - (current-window-configuration (pop winner-modified-list))))) - -(defun winner-set (conf) - (set-window-configuration conf) - (if (eq (selected-window) (minibuffer-window)) - (other-window 1))) - - -;;; Winner mode (a minor mode) - -(defvar winner-mode-hook nil - "Functions to run whenever Winner mode is turned on.") - -(defvar winner-mode-leave-hook nil - "Functions to run whenever Winner mode is turned off.") - -(defvar winner-mode nil) ; mode variable -(defvar winner-mode-map nil "Keymap for Winner mode.") - -(defun winner-mode (&optional arg) - "Toggle Winner mode. -With arg, turn Winner mode on if and only if arg is positive." - (interactive "P") - (let ((on-p (if arg (> (prefix-numeric-value arg) 0) - (not winner-mode)))) - (cond - ;; Turn mode on - (on-p - (setq winner-mode t) - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-new-configurations) - (setq winner-modified-list (frame-list)) - (winner-save-new-configurations) - (run-hooks 'winner-mode-hook)) - ;; Turn mode off - (winner-mode - (setq winner-mode nil) - (run-hooks 'winner-mode-leave-hook))) - (force-mode-line-update))) - -;; Inspired by undo (simple.el) -(defun winner-undo (arg) - "Switch back to an earlier window configuration saved by Winner mode. -In other words, \"undo\" changes in window configuration." - (interactive "p") - (cond - ((not winner-mode) (error "Winner mode is turned off")) - ((eq (selected-window) (minibuffer-window)) - (error "No winner undo from minibuffer.")) - (t (setq this-command t) - (if (eq last-command 'winner-undo) - ;; This was no new window configuration after all. - (ring-remove winner-pending-undo-ring 0) - (setq winner-pending-undo-ring (winner-ring (selected-frame))) - (setq winner-undo-counter 0)) - (winner-undo-more (or arg 1)) - (message "Winner undo (%d)!" winner-undo-counter) - (setq this-command 'winner-undo)))) - -(defvar winner-pending-undo-ring nil) - -(defvar winner-undo-counter nil) - -(defun winner-undo-more (count) - "Undo N window configuration changes beyond what was already undone. -Call `winner-undo-start' to get ready to undo recent changes, -then call `winner-undo-more' one or more times to undo them." - (let ((len (ring-length winner-pending-undo-ring))) - (incf winner-undo-counter count) - (if (>= winner-undo-counter len) - (error "No further window configuration undo information") - (winner-set - (ring-ref winner-pending-undo-ring - winner-undo-counter))))) - -(defun winner-redo () - "Restore a more recent window configuration saved by Winner mode." - (interactive) - (cond - ((eq last-command 'winner-undo) - (ring-remove winner-pending-undo-ring 0) - (winner-set - (ring-remove winner-pending-undo-ring 0)) - (or (eq (selected-window) (minibuffer-window)) - (message "Winner undid undo!"))) - (t (error "Previous command was not a winner-undo")))) - -;;; Winner switch - -(defun winner-switch-buffer-list () - (loop for buf in (buffer-list) - for name = (buffer-name buf) - unless (or (eq (current-buffer) buf) - (member name winner-skip-buffers) - (loop for regexp in winner-skip-regexps - if (string-match regexp name) return t - finally return nil)) - collect name)) - -(defvar winner-switch-list nil) - -(defun winner-switch (count) - "Step through your buffers without disturbing `winner-mode'. -`winner-switch' does not consider buffers mentioned in the list -`winner-skip-buffers' or matched by `winner-skip-regexps'." - (interactive "p") - (decf count) - (setq this-command t) - (cond - ((eq last-command 'winner-switch) - (if winner-mode (ring-remove (winner-ring (selected-frame)) 0)) - (bury-buffer (current-buffer)) - (mapcar 'bury-buffer winner-switch-list)) - (t (setq winner-switch-list (winner-switch-buffer-list)))) - (setq winner-switch-list (nthcdr count winner-switch-list)) - (or winner-switch-list - (setq winner-switch-list (winner-switch-buffer-list)) - (error "No more buffers")) - (switch-to-buffer (pop winner-switch-list)) - (message (concat "Winner: [%s] " - (mapconcat 'identity winner-switch-list " ")) - (buffer-name)) - (setq this-command 'winner-switch)) - -;;;; To be evaluated when the package is loaded: - -(unless winner-mode-map - (setq winner-mode-map (make-sparse-keymap)) - (define-key winner-mode-map [?\C-x left] 'winner-undo) - (define-key winner-mode-map [?\C-x right] 'winner-redo)) - -(unless (or (assq 'winner-mode minor-mode-map-alist) - winner-dont-bind-my-keys) - (push (cons 'winner-mode winner-mode-map) - minor-mode-map-alist)) - -(unless (assq 'winner-mode minor-mode-alist) - (push '(winner-mode " Win") minor-mode-alist)) - -(provide 'winner) - -;;; winner.el ends here +;;; winner.el --- Restore old window configurations + +;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation. Inc. + +;; Author: Ivar Rummelhoff +;; Created: 27 Feb 1997 +;; Time-stamp: <2006-02-06 15:13:57 ttn> +;; Keywords: convenience frames + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Winner mode is a global minor mode that records the changes in the +;; window configuration (i.e. how the frames are partitioned into +;; windows) so that the changes can be "undone" using the command +;; `winner-undo'. By default this one is bound to the key sequence +;; ctrl-c left. If you change your mind (while undoing), you can +;; press ctrl-c right (calling `winner-redo'). Even though it uses +;; some features of Emacs20.3, winner.el should also work with +;; Emacs19.34 and XEmacs20, provided that the installed version of +;; custom is not obsolete. + +;; Winner mode was improved August 1998. +;; Further improvements February 2002. + +;;; Code: + +(eval-when-compile + (require 'cl)) + + +(defmacro winner-active-region () + (if (fboundp 'region-active-p) + '(region-active-p) + 'mark-active)) + +(defsetf winner-active-region () (store) + (if (fboundp 'zmacs-activate-region) + `(if ,store (zmacs-activate-region) + (zmacs-deactivate-region)) + `(setq mark-active ,store))) + +(defalias 'winner-edges + (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) +(defalias 'winner-window-list + (if (featurep 'xemacs) + (lambda () (delq (minibuffer-window) (window-list nil 0))) + (lambda () (window-list nil 0)))) + +(require 'ring) + +(unless (fboundp 'defgroup) + (defmacro defgroup (&rest rest))) + +(defgroup winner nil + "Restoring window configurations." + :group 'windows) + +(unless (fboundp 'defcustom) + (defmacro defcustom (symbol &optional initvalue docs &rest rest) + (list 'defvar symbol initvalue docs))) + +;;;###autoload +(defcustom winner-mode nil + "Toggle Winner mode. +Setting this variable directly does not take effect; +use either \\[customize] or the function `winner-mode'." + :set #'(lambda (symbol value) (funcall symbol (or value 0))) + :initialize 'custom-initialize-default + :type 'boolean + :group 'winner + :require 'winner) + +(defcustom winner-dont-bind-my-keys nil + "If non-nil: Do not use `winner-mode-map' in Winner mode." + :type 'boolean + :group 'winner) + +(defcustom winner-ring-size 200 + "Maximum number of stored window configurations per frame." + :type 'integer + :group 'winner) + +(defcustom winner-boring-buffers '("*Completions*") + "`winner-undo' will not restore windows displaying any of these buffers. +You may want to include buffer names such as *Help*, *Apropos*, +*Buffer List*, *info* and *Compile-Log*." + :type '(repeat string) + :group 'winner) + + + + + +;;;; Saving old configurations (internal variables and subroutines) + + +;;; Current configuration + +;; List the windows according to their edges. +(defun winner-sorted-window-list () + (sort (winner-window-list) + (lambda (x y) + (loop for a in (winner-edges x) + for b in (winner-edges y) + while (= a b) + finally return (< a b))))) + +(defun winner-win-data () + ;; Essential properties of the windows in the selected frame. + (loop for win in (winner-sorted-window-list) + collect (cons (winner-edges win) (window-buffer win)))) + +;; This variable is updated with the current window configuration +;; every time it changes. +(defvar winner-currents nil) + +;; The current configuration (+ the buffers involved). +(defsubst winner-conf () + (cons (current-window-configuration) + (winner-win-data))) + + +;; Save current configuration. +;; (Called below by `winner-save-old-configurations'). +(defun winner-remember () + (let ((entry (assq (selected-frame) winner-currents))) + (if entry (setcdr entry (winner-conf)) + (push (cons (selected-frame) (winner-conf)) + winner-currents)))) + +;; Consult `winner-currents'. +(defun winner-configuration (&optional frame) + (or (cdr (assq (or frame (selected-frame)) winner-currents)) + (letf (((selected-frame) frame)) + (winner-conf)))) + + + +;;; Saved configurations + +;; This variable contains the window cofiguration rings. +;; The key in this alist is the frame. +(defvar winner-ring-alist nil) + +;; Find the right ring. If it does not exist, create one. +(defsubst winner-ring (frame) + (or (cdr (assq frame winner-ring-alist)) + (let ((ring (make-ring winner-ring-size))) + (ring-insert ring (winner-configuration frame)) + (push (cons frame ring) winner-ring-alist) + ring))) + + +;; If the same command is called several times in a row, +;; we only save one window configuration. +(defvar winner-last-command nil) + +;; Frames affected by the previous command. +(defvar winner-last-frames nil) + + +(defsubst winner-equal (a b) + "Check whether two Winner configurations (as produced by +`winner-conf') are equal." + (equal (cdr a) (cdr b))) + + +;; Save the current window configuration, if it has changed. +;; If so return frame, otherwise return nil. +(defun winner-insert-if-new (frame) + (unless (or (memq frame winner-last-frames) + (eq this-command 'winner-redo)) + (let ((conf (winner-configuration frame)) + (ring (winner-ring frame))) + (when (and (not (ring-empty-p ring)) + (winner-equal conf (ring-ref ring 0))) + ;; When the previous configuration was very similar, + ;; keep only the latest. + (ring-remove ring 0)) + (ring-insert ring conf) + (push frame winner-last-frames) + frame))) + + + +;;; Hooks + +;; Frames affected by the current command. +(defvar winner-modified-list nil) + +;; Called whenever the window configuration changes +;; (a `window-configuration-change-hook'). +(defun winner-change-fun () + (unless (or (memq (selected-frame) winner-modified-list) + (/= 0 (minibuffer-depth))) + (push (selected-frame) winner-modified-list))) + +;; A `post-command-hook' for emacsen with +;; `window-configuration-change-hook'. +(defun winner-save-old-configurations () + (when (zerop (minibuffer-depth)) + (unless (eq this-command winner-last-command) + (setq winner-last-frames nil) + (setq winner-last-command this-command)) + (dolist (frame winner-modified-list) + (winner-insert-if-new frame)) + (setq winner-modified-list nil) + (winner-remember))) + +;; A `minibuffer-setup-hook'. +(defun winner-save-unconditionally () + (unless (eq this-command winner-last-command) + (setq winner-last-frames nil) + (setq winner-last-command this-command)) + (winner-insert-if-new (selected-frame)) + (winner-remember)) + +;; A `post-command-hook' for other emacsen. +;; Also called by `winner-undo' before "undoing". +(defun winner-save-conditionally () + (when (zerop (minibuffer-depth)) + (winner-save-unconditionally))) + + + + +;;;; Restoring configurations + +;; Works almost as `set-window-configuration', +;; but does not change the contents or the size of the minibuffer, +;; and tries to preserve the selected window. +(defun winner-set-conf (winconf) + (let* ((miniwin (minibuffer-window)) + (chosen (selected-window)) + (minisize (window-height miniwin))) + (letf (((window-buffer miniwin)) + ((window-point miniwin))) + (set-window-configuration winconf)) + (cond + ((window-live-p chosen) (select-window chosen)) + ((window-minibuffer-p (selected-window)) + (other-window 1))) + (when (/= minisize (window-height miniwin)) + (letf (((selected-window) miniwin) ) + (setf (window-height) minisize))))) + + + +(defvar winner-point-alist nil) +;; `set-window-configuration' restores old points and marks. This is +;; not what we want, so we make a list of the "real" (i.e. new) points +;; and marks before undoing window configurations. +;; +;; Format of entries: (buffer (mark . mark-active) (window . point) ..) + +(defun winner-make-point-alist () + (letf (((current-buffer))) + (loop with alist + for win in (winner-window-list) + for entry = + (or (assq (window-buffer win) alist) + (car (push (list (set-buffer (window-buffer win)) + (cons (mark t) (winner-active-region))) + alist))) + do (push (cons win (window-point win)) + (cddr entry)) + finally return alist))) + +(defun winner-get-point (buf win) + ;; Consult (and possibly extend) `winner-point-alist'. + ;; Returns nil iff buf no longer exists. + (when (buffer-name buf) + (let ((entry (assq buf winner-point-alist))) + (cond + (entry + (or (cdr (assq win (cddr entry))) + (cdr (assq nil (cddr entry))) + (letf (((current-buffer) buf)) + (push (cons nil (point)) (cddr entry)) + (point)))) + (t (letf (((current-buffer) buf)) + (push (list buf + (cons (mark t) (winner-active-region)) + (cons nil (point))) + winner-point-alist) + (point))))))) + + +;; Make sure point does not end up in the minibuffer and delete +;; windows displaying dead or boring buffers +;; (c.f. `winner-boring-buffers'). Return nil iff all the windows +;; should be deleted. Preserve correct points and marks. +(defun winner-set (conf) + ;; For the format of `conf', see `winner-conf'. + (let* ((buffers nil) + (alive + ;; Possibly update `winner-point-alist' + (loop for buf in (mapcar 'cdr (cdr conf)) + for pos = (winner-get-point buf nil) + if (and pos (not (memq buf buffers))) + do (push buf buffers) + collect pos))) + (winner-set-conf (car conf)) + (let (xwins) ; to be deleted + + ;; Restore points + (dolist (win (winner-sorted-window-list)) + (unless (and (pop alive) + (setf (window-point win) + (winner-get-point (window-buffer win) win)) + (not (member (buffer-name (window-buffer win)) + winner-boring-buffers))) + (push win xwins))) ; delete this window + + ;; Restore marks + (letf (((current-buffer))) + (loop for buf in buffers + for entry = (cadr (assq buf winner-point-alist)) + do (progn (set-buffer buf) + (set-mark (car entry)) + (setf (winner-active-region) (cdr entry))))) + ;; Delete windows, whose buffers are dead or boring. + ;; Return t if this is still a possible configuration. + (or (null xwins) + (progn + (mapc 'delete-window (cdr xwins)) ; delete all but one + (unless (one-window-p t) + (delete-window (car xwins)) + t)))))) + + + +;;;; Winner mode (a minor mode) + +(defcustom winner-mode-hook nil + "Functions to run whenever Winner mode is turned on." + :type 'hook + :group 'winner) + +(defcustom winner-mode-leave-hook nil + "Functions to run whenever Winner mode is turned off." + :type 'hook + :group 'winner) + +(defvar winner-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(control c) left] 'winner-undo) + (define-key map [(control c) right] 'winner-redo) + map) + "Keymap for Winner mode.") + +;; Check if `window-configuration-change-hook' is working. +(defun winner-hook-installed-p () + (save-window-excursion + (let ((winner-var nil) + (window-configuration-change-hook + '((lambda () (setq winner-var t))))) + (split-window) + winner-var))) + + +;;;###autoload +(defun winner-mode (&optional arg) + "Toggle Winner mode. +With arg, turn Winner mode on if and only if arg is positive." + (interactive "P") + (let ((on-p (if arg (> (prefix-numeric-value arg) 0) + (not winner-mode)))) + (cond + ;; Turn mode on + (on-p + (setq winner-mode t) + (cond + ((winner-hook-installed-p) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations)) + (t (add-hook 'post-command-hook 'winner-save-conditionally))) + (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) + (setq winner-modified-list (frame-list)) + (winner-save-old-configurations) + (run-hooks 'winner-mode-hook) + (when (interactive-p) (message "Winner mode enabled"))) + ;; Turn mode off + (winner-mode + (setq winner-mode nil) + (remove-hook 'window-configuration-change-hook 'winner-change-fun) + (remove-hook 'post-command-hook 'winner-save-old-configurations) + (remove-hook 'post-command-hook 'winner-save-conditionally) + (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally) + (run-hooks 'winner-mode-leave-hook) + (when (interactive-p) (message "Winner mode disabled")))))) + +;; Inspired by undo (simple.el) + +(defvar winner-undo-frame nil) + +(defvar winner-pending-undo-ring nil + "The ring currently used by `winner-undo'.") +(defvar winner-undo-counter nil) +(defvar winner-undone-data nil) ; There confs have been passed. + +(defun winner-undo () + "Switch back to an earlier window configuration saved by Winner mode. +In other words, \"undo\" changes in window configuration." + (interactive) + (cond + ((not winner-mode) (error "Winner mode is turned off")) + (t (unless (and (eq last-command 'winner-undo) + (eq winner-undo-frame (selected-frame))) + (winner-save-conditionally) ; current configuration->stack + (setq winner-undo-frame (selected-frame)) + (setq winner-point-alist (winner-make-point-alist)) + (setq winner-pending-undo-ring (winner-ring (selected-frame))) + (setq winner-undo-counter 0) + (setq winner-undone-data (list (winner-win-data)))) + (incf winner-undo-counter) ; starting at 1 + (when (and (winner-undo-this) + (not (window-minibuffer-p (selected-window)))) + (message "Winner undo (%d / %d)" + winner-undo-counter + (1- (ring-length winner-pending-undo-ring))))))) + + + + +(defun winner-undo-this () ; The heart of winner undo. + (loop + (cond + ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) + (message "No further window configuration undo information") + (return nil)) + + ((and ; If possible configuration + (winner-set (ring-ref winner-pending-undo-ring + winner-undo-counter)) + ; .. and new configuration + (let ((data (winner-win-data))) + (and (not (member data winner-undone-data)) + (push data winner-undone-data)))) + (return t)) ; .. then everything is fine. + (t ;; Otherwise, discharge it (and try the next one). + (ring-remove winner-pending-undo-ring winner-undo-counter))))) + + +(defun winner-redo () ; If you change your mind. + "Restore a more recent window configuration saved by Winner mode." + (interactive) + (cond + ((eq last-command 'winner-undo) + (winner-set + (if (zerop (minibuffer-depth)) + (ring-remove winner-pending-undo-ring 0) + (ring-ref winner-pending-undo-ring 0))) + (unless (eq (selected-window) (minibuffer-window)) + (message "Winner undid undo"))) + (t (error "Previous command was not a `winner-undo'")))) + +;;; To be evaluated when the package is loaded: + +(unless (or (assq 'winner-mode minor-mode-map-alist) + winner-dont-bind-my-keys) + (push (cons 'winner-mode winner-mode-map) + minor-mode-map-alist)) + +(provide 'winner) +;; arch-tag: 686d1c1b-010e-42ca-a192-b5685112418f +;;; winner.el ends here