changeset 21125:d66c9c7b4927

Use list syntax for key definitions. (winner-mode, winner-save-unconditionally) (winner-hook-installed-p): Save window configuration after every command if window-configuration-change-hook is not present. (winner-save-new-configurations, winner-insert-if-new): Compare a new window configuration with the previous configuration before saving it. (winner-insert-if-new, winner-ring) (winner-configuration, winner-set): Save buffer list together with the window configurations, so that windows that can no longer be correctly restored can instead be deleted. (winner-undo): Compare restored configuration with other configurations that have been reviewed and skip this one if it looks similar. (winner-insert-if-new, winner-save-new-configurations) (winner-save-unconditionally): Just save the final configuration if the same command (changing the window configuration) is applied several times in a row. (winner-switch): Removed the command `winner-switch' (and the variables connected to it), since because of the change above, any "switching package" may now be used without disturbing winner-mode too much. (winner-change-fun): Removed the pushnew command, so that `cl' will not have to be loaded. (winner-set-conf): Introduced "wrapper" around `set-window-configuration', so that `winner-undo' may be called from the minibuffer.

--- a/lisp/winner.el	Mon Mar 09 16:01:20 1998 +0000
+++ b/lisp/winner.el	Mon Mar 09 22:42:13 1998 +0000
@@ -1,11 +1,12 @@
-;;; winner.el  --- Restore window configuration (or switch buffer)
+;;; winner.el  --- Restore old window configurations
 
 ;; Copyright (C) 1997, 1998 Free Software Foundation. Inc.
 
 ;; Author: Ivar Rummelhoff <[e-mail]>
 ;; Maintainer: Ivar Rummelhoff <[e-mail]>
 ;; Created: 27 Feb 1997
-;; Keywords: extensions, windows
+;; Time-stamp: <1998-03-05 19:01:37 ivarr>
+;; Keywords: windows
 
 ;; This file is part of GNU Emacs.
 
@@ -26,98 +27,172 @@
 
 ;;; 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.
+;; Winner mode is a global minor mode that records the changes in the
+;; window configuration (i.e. how the frames are partitioned into
+;; windows).  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').  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.
 
-;;; Code:
+;;; Code:
 
 (eval-when-compile (require 'cl))
 (require 'ring)
 
-(defgroup winner nil
-  "Restoring window configurations."
-  :group 'windows)
+(when (fboundp 'defgroup)
+  (defgroup winner nil ; Customization by Dave Love
+    "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.
 You must modify via \\[customize] for this variable to have an effect."
-  :set (lambda (symbol value)
-	 (winner-mode (or value 0)))
+  :set #'(lambda (symbol value)
+	   (winner-mode (or value 0)))
   :initialize 'custom-initialize-default
-  :type 'boolean
-  :group 'winner
+  :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
+  :type  'boolean
+  :group 'winner)
+
+(defcustom winner-ring-size 200
+  "Maximum number of stored window configurations per frame."
+  :type  'integer
   :group 'winner)
 
-(defvar winner-ring-size 100
-  "Maximum number of stored window configurations per frame.")
+
+
 
-(defcustom winner-skip-buffers
-  '("*Messages*",
-    "*Compile-Log*",
-    ".newsrc-dribble",
-    "*Completions*",
-    "*Buffer list*")
-  "Exclude these buffer names from any \(Winner switch\) list of buffers."
-  :type '(repeat string)
-  :group 'winner)
+;;;; Internal variables and subroutines
+
 
-(defcustom 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\"."
-  :type '(repeat regexp)
-  :group 'winner)
-
+;; 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))
       (progn
-	(push (cons frame (make-ring winner-ring-size))
-	      winner-ring-alist)
-	(cdar winner-ring-alist))))
+	(let ((ring (make-ring winner-ring-size)))
+	  (ring-insert ring (winner-configuration frame))
+	  (push (cons frame ring) winner-ring-alist)
+	  ring))))
+
+(defvar winner-last-saviour nil)
+
+;; Save the current window configuration, if it has changed and return
+;; frame, else return nil.  If the last change was due to the same
+;; command, save only the latest configuration.
+(defun winner-insert-if-new (frame)
+  (let ((conf (winner-configuration))
+	(ring (winner-ring frame)))
+    (cond
+     ((winner-equal conf (ring-ref ring 0)) nil)
+     (t (when (and (eq this-command (car winner-last-saviour))
+		   (memq frame (cdr winner-last-saviour)))
+	  (ring-remove ring 0))
+	(ring-insert ring conf)
+	frame))))
+
+(defvar winner-modified-list nil) ; Which frames have changed?
 
-(defvar winner-modified-list nil)
-
+;; This function is called when the window configuration changes.
 (defun winner-change-fun ()
-  (or (memq (selected-frame) winner-modified-list)
-      (push (selected-frame) winner-modified-list)))
+  (unless (memq (selected-frame) winner-modified-list)
+    (push (selected-frame) winner-modified-list)))
+
+;; For Emacs20
+(defun winner-save-new-configurations ()
+  (setq winner-last-saviour
+	(cons this-command
+	      (mapcar 'winner-insert-if-new winner-modified-list)))
+  (setq winner-modified-list nil))
+
+;; For compatibility with other emacsen.
+(defun winner-save-unconditionally ()
+  (setq winner-last-saviour
+	(cons this-command
+	      (list (winner-insert-if-new (selected-frame))))))
+
+;; Arrgh.  This is storing the same information twice.
+(defun winner-configuration (&optional frame)
+  (if frame (letf (((selected-frame) frame)) (winner-configuration))
+    (cons (current-window-configuration)
+	  (loop for w being the windows
+		collect (window-buffer w)))))
 
-(defun winner-save-new-configurations ()
-  (while winner-modified-list
-    (ring-insert
-     (winner-ring (car winner-modified-list))
-     (current-window-configuration (pop winner-modified-list)))))
+
+;; The same as `set-window-configuration',
+;; but doesn't touch the minibuffer.
+(defun winner-set-conf (winconf)
+  (let ((min-sel  (window-minibuffer-p (selected-window)))
+	(minibuf  (window-buffer (minibuffer-window)))
+	(minipoint (letf ((selected-window) (minibuffer-window))
+		     (point)))
+	win)
+    (set-window-configuration winconf)
+    (setq win (selected-window))
+    (select-window (minibuffer-window))
+    (set-window-buffer (minibuffer-window) minibuf)
+    (goto-char minipoint)
+    (cond
+     (min-sel)
+     ((window-minibuffer-p win)
+      (other-window 1))
+     (t (select-window win)))))
+
+(defun winner-win-data () ; Information about the windows
+  (loop for win being the windows
+	unless (window-minibuffer-p win)
+	collect (list (window-buffer win)
+		      (window-width  win)
+		      (window-height win))))
 
+;; Make sure point doesn't end up in the minibuffer and
+;; delete windows displaying dead buffers.  Return nil
+;; if and only if all the windows should have been deleted.
 (defun winner-set (conf)
-  (set-window-configuration conf)
-  (if (eq (selected-window) (minibuffer-window))
-      (other-window 1)))
+  (let ((origpoints
+	 (save-excursion
+	   (loop for buf in (cdr conf)
+		 collect (if (buffer-name buf)
+			     (progn (set-buffer buf) (point))
+			   nil)))))
+    (winner-set-conf (car conf))
+    (let* ((win (selected-window))
+	   (xwins (loop for window being the windows
+			for pos in origpoints
+			unless (window-minibuffer-p window)
+			if pos do (progn (select-window window)
+					 (goto-char pos))
+			else collect window)))
+      (select-window win)
+      ;; Return t if possible configuration
+      (cond
+       ((null xwins) t)
+       ((progn (mapcar 'delete-window (cdr xwins))
+	       (one-window-p t))
+	nil) ; No existing buffers
+       (t (delete-window (car xwins)))))))
 
 
-;;; Winner mode  (a minor mode)
+       
+
+;;;; Winner mode  (a minor mode)
 
 (defcustom winner-mode-hook nil
   "Functions to run whenever Winner mode is turned on."
@@ -131,6 +206,15 @@
 
 (defvar winner-mode-map nil "Keymap for Winner mode.")
 
+;; Is `window-configuration-change-hook' 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.
@@ -142,23 +226,24 @@
      ;; 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)
+      (cond
+       ((winner-hook-installed-p)
+	(add-hook 'window-configuration-change-hook 'winner-change-fun)
+	(add-hook 'post-command-hook 'winner-save-new-configurations))
+       (t (add-hook 'post-command-hook 'winner-save-unconditionally)))
       (setq winner-modified-list (frame-list))
       (winner-save-new-configurations)
       (run-hooks 'winner-mode-hook))
      ;; 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-new-configurations)
+      (remove-hook 'post-command-hook 'winner-save-unconditionally)
       (run-hooks 'winner-mode-leave-hook)))
     (force-mode-line-update)))
 
-;; Inspired by undo (simple.el)
-
-(defvar winner-pending-undo-ring nil)
-
-(defvar winner-undo-counter nil)
-
+;; 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.
@@ -166,31 +251,40 @@
   (interactive "p")
   (cond
    ((not winner-mode) (error "Winner mode is turned off"))
-   ((eq (selected-window) (minibuffer-window))
-    (error "No winner undo from minibuffer."))
+   ;;   ((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)
+      (unless (eq last-command 'winner-undo)
 	(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 winner-undo-counter 0)
+	(setq winner-undone-data (list (winner-win-data))))
+      (incf winner-undo-counter arg)
+      (winner-undo-this)
+      (unless (window-minibuffer-p (selected-window))
+	(message "Winner undo (%d)" winner-undo-counter))
       (setq this-command 'winner-undo))))
 
-(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)))))
+(defvar winner-pending-undo-ring nil) ; The ring currently used by
+				      ; undo.
+(defvar winner-undo-counter nil)
+(defvar winner-undone-data  nil) ; There confs have been passed.
 
-(defun winner-redo ()
+(defun winner-undo-this () ; The heart of winner undo.
+  (if (>= winner-undo-counter (ring-length winner-pending-undo-ring))
+      (error "No further window configuration undo information")
+    (unless (and
+	     ;; Possible configuration
+	     (winner-set
+	      (ring-ref winner-pending-undo-ring
+			winner-undo-counter))
+	     ;; New configuration
+	     (let ((data (winner-win-data)))
+	       (if (member data winner-undone-data) nil
+		 (push data winner-undone-data))))
+      (ring-remove winner-pending-undo-ring winner-undo-counter)
+      (winner-undo-this))))
+
+(defun winner-redo () ; If you change your mind.
   "Restore a more recent window configuration saved by Winner mode."
   (interactive)
   (cond
@@ -199,52 +293,19 @@
     (winner-set
      (ring-remove winner-pending-undo-ring 0))
     (or (eq (selected-window) (minibuffer-window))
-	(message "Winner undid undo!")))
+	(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)
+;;;; To be evaluated when the package is loaded:
 
-(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:
+(if (fboundp 'compare-window-configurations)
+    (defalias 'winner-equal 'compare-window-configurations)
+  (defalias 'winner-equal 'equal))
 
 (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))
+  (define-key winner-mode-map [(control x) left] 'winner-undo)
+  (define-key winner-mode-map [(control x) right] 'winner-redo))
 
 (unless (or (assq 'winner-mode minor-mode-map-alist)
 	    winner-dont-bind-my-keys)