X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e0a816503cc6229db1209aaa2b0dc8d775892c9b..6a142f266eca5da37d9ee586cfddf514c810f239:/lisp/winner.el

diff --git a/lisp/winner.el b/lisp/winner.el
index 6f07d5bf45..2e35995943 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,12 +1,11 @@
-;;; winner.el  --- Restore old window configurations
+;;; winner.el --- Restore old window configurations
 
 ;; Copyright (C) 1997, 1998 Free Software Foundation. Inc.
 
-;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no>
-;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
+;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
 ;; Created: 27 Feb 1997
-;; Time-stamp: <1998-03-05 19:01:37 ivarr>
-;; Keywords: windows
+;; Time-stamp: <1998-08-21 19:51:02 ivarr>
+;; Keywords: convenience frames
 
 ;; This file is part of GNU Emacs.
 
@@ -29,7 +28,7 @@
 
 ;; 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
+;; windows) so that the changes can be "undone" using the command
 ;; `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
@@ -37,13 +36,30 @@
 ;; Emacs19.34 and XEmacs20, provided that the installed version of
 ;; custom is not obsolete.
 
-;;; Code:
+;; Winner mode was improved august 1998.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(eval-when-compile
+  (cond
+   ((eq (aref (emacs-version) 0) ?X)
+    (defmacro winner-active-region ()
+      '(region-active-p))
+    (defsetf winner-active-region () (store)
+      `(if ,store (zmacs-activate-region)
+	 (zmacs-deactivate-region))))
+   (t (defmacro winner-active-region ()
+	'mark-active)
+      (defsetf winner-active-region () (store)
+	`(setq mark-active ,store)))) )
 
-(eval-when-compile (require 'cl))
 (require 'ring)
 
 (when (fboundp 'defgroup)
-  (defgroup winner nil ; Customization by Dave Love
+  (defgroup winner nil
     "Restoring window configurations."
     :group 'windows))
 
@@ -51,12 +67,12 @@
   (defmacro defcustom (symbol &optional initvalue docs &rest rest)
     (list 'defvar symbol initvalue docs)))
 
-
+
 ;;;###autoload
 (defcustom winner-mode nil
   "Toggle winner-mode.
-This variable should be set only with \\[customize], which is equivalent
-to using the function `winner-mode'."
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `winner-mode'."
   :set #'(lambda (symbol value)
 	   (winner-mode (or value 0)))
   :initialize 'custom-initialize-default
@@ -77,7 +93,36 @@ to using the function `winner-mode'."
 
 
 
-;;;; Internal variables and subroutines
+;;;; Saving old configurations (internal variables and subroutines)
+
+;; This variable is updated with the current window configuration
+;; after every command, so that when command make changes in the
+;; window configuration, the last configuration can be saved.
+(defvar winner-currents nil)
+
+;; The current configuration (+ the buffers involved).
+(defsubst winner-conf ()
+  (list (current-window-configuration)
+	(loop for w being the windows
+	      unless (window-minibuffer-p w)
+	      collect (window-buffer w)) ))
+;;	(if winner-testvar (incf winner-testvar) ; For debugging purposes
+;;	  (setq winner-testvar 0))))
+
+;; Save current configuration.
+;; (Called by `winner-save-old-configurations' below).
+(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))))
+
 
 
 ;; This variable contains the window cofiguration rings.
@@ -93,107 +138,173 @@ to using the function `winner-mode'."
 	  (push (cons frame ring) winner-ring-alist)
 	  ring))))
 
-(defvar winner-last-saviour nil)
+;; If the same command is called several times in a row,
+;; we only save one window configuration.
+(defvar winner-last-command 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))))
+;; Frames affected by the previous command.
+(defvar winner-last-frames nil)
 
-(defvar winner-modified-list nil) ; Which frames have changed?
-
-;; This function is called when the window configuration changes.
+;; Save the current window configuration, if it has changed.
+;; Then return frame, else 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)))
+	(ring-remove ring 0))
+      (ring-insert ring conf)
+      (push frame winner-last-frames)
+      frame)))
+
+;; 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 (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.
+;; For Emacs20 (a `post-command-hook').
+(defun winner-save-old-configurations ()
+  (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)
+  ;;  (ir-trace ; For debugging purposes
+  ;;   "%S"
+  ;;   (loop with ring = (winner-ring (selected-frame))
+  ;;	 for i from 0 to (1- (ring-length ring))
+  ;;	 collect (caddr (ring-ref ring i))))
+  (winner-remember))
+
+;; For compatibility with other emacsen
+;; and called by `winner-undo' before "undoing".
 (defun winner-save-unconditionally ()
-  (setq winner-last-saviour
-	(cons this-command
-	      (list (winner-insert-if-new (selected-frame))))))
+  (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))
 
-;; 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)))))
 
-
-;; 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
+;;;; Restoring configurations
+
+;; Works almost as `set-window-configuration',
+;; but doesn't change the contents or the size of the minibuffer.
+(defun winner-set-conf (winconf)
+  (let ((miniwin (minibuffer-window))
+	(minisel (window-minibuffer-p (selected-window))))
+    (let ((minibuf   (window-buffer miniwin))
+	  (minipoint (window-point  miniwin))
+	  (minisize  (window-height miniwin)))
+      (set-window-configuration winconf)
+      (setf (window-buffer miniwin) minibuf
+	    (window-point  miniwin) minipoint)
+      (when (/= minisize (window-height miniwin)) 
+	(letf (((selected-window) miniwin) )
+	  ;; Clumsy due to cl-macs-limitation
+	  (setf (window-height) minisize)))
+      (cond
+       (minisel (select-window miniwin))
+       ((window-minibuffer-p (selected-window))
+	(other-window 1))))))
+
+
+(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
+	  with entry 
+	  for win being the windows
+	  do (cond
+	      ((window-minibuffer-p win))
+	      ((setq entry (assq win alist)) 
+	       ;; Update existing entry
+	       (push (cons win (window-point win))
+		     (cddr entry)))
+	      (t;; Else create new entry
+	       (push (list (set-buffer (window-buffer win))
+			   (cons (mark t) (winner-active-region))
+			   (cons win (window-point win)))
+		     alist)))
+	  finally return alist)))
+
+
+(defun winner-get-point (buf win)
+  ;; Consult (and possibly extend) `winner-point-alist'.
+  (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 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.
+;; Do not move neither points nor marks.
 (defun winner-set (conf)
-  (let ((origpoints
-	 (save-excursion
-	   (loop for buf in (cdr conf)
-		 collect (if (buffer-name buf)
-			     (progn (set-buffer buf) (point))
-			   nil)))))
+  (let* ((buffers nil)
+	 (origpoints
+	  (loop for buf in (cadr 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* ((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)
+    (let (xwins) ; These windows should be deleted
+      (loop for win being the windows
+	    unless (window-minibuffer-p win)
+	    do (if (pop origpoints)
+		   (setf (window-point win)
+			 ;; Restore point
+			 (winner-get-point
+			  (window-buffer win)
+			  win))
+		 (push win xwins))) ; delete this window
+      ;; Restore mark
+      (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.
+      ;; Return t if this is still a possible configuration.
+      (or (null xwins)
+	  (progn (mapcar 'delete-window (cdr xwins))
+		 (if (one-window-p t)
+		     nil  ; No windows left
+		   (progn (delete-window (car xwins))
+			  t)))))))
+
+
+
+;;;; Winner mode  (a minor mode)
 
 (defcustom winner-mode-hook nil
   "Functions to run whenever Winner mode is turned on."
@@ -216,6 +327,7 @@ to using the function `winner-mode'."
       (split-window)
       winner-var)))
 
+
 ;;;###autoload
 (defun winner-mode (&optional arg)
   "Toggle Winner mode.
@@ -230,75 +342,90 @@ With arg, turn Winner mode on if and only if arg is positive."
       (cond
        ((winner-hook-installed-p)
 	(add-hook 'window-configuration-change-hook 'winner-change-fun)
-	(add-hook 'post-command-hook 'winner-save-new-configurations))
+	(add-hook 'post-command-hook 'winner-save-old-configurations))
        (t (add-hook 'post-command-hook 'winner-save-unconditionally)))
       (setq winner-modified-list (frame-list))
-      (winner-save-new-configurations)
+      (winner-save-old-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-old-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-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 (arg)
+(defun winner-undo ()
   "Switch back to an earlier window configuration saved by Winner mode.
-In other words, \"undo\" changes in window configuration.
-With prefix arg, undo that many levels."
-  (interactive "p")
+In other words, \"undo\" changes in window configuration."
+  (interactive)
   (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)
-      (unless (eq last-command 'winner-undo)
-	(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 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-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.
+   (t (unless (and (eq last-command 'winner-undo)
+ 		   (eq winner-undo-frame (selected-frame)))
+	(winner-save-unconditionally)	; 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-win-data () 
+  ;; Essential properties of the windows in the selected frame.
+  (loop for win being the windows
+ 	unless (window-minibuffer-p win)
+ 	collect (list (window-buffer win)
+ 		      (window-width  win)
+ 		      (window-height win))))
+ 
+
+(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 all right.
+    (t					; Else; discharge it and try another 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)
-    (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")))
+    (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:
+
+;;; To be evaluated when the package is loaded:
 
 (if (fboundp 'compare-window-configurations)
     (defalias 'winner-equal 'compare-window-configurations)