changeset 4445:1d41b9bcf74f

Add `set-window-configuration/mapping' and `save-window-excursion/mapping'. 2008-04-13 Henry S. Thompson <ht@inf.ed.ac.uk>, Mike Sperber <mike@xemacs.org> * window-xemacs.el (save-window-excursion/mapping, set-window-configuration/mapping): Add. These function return an alist mapping the window objects from the original window configuration to the window objects corresponding to them in the restored configuration. (set-window-configuration): (saved-window): (root-window->saved-window): (really-set-window-configuration): (restore-saved-window): Record the mapping for above functions.
author Mike Sperber <sperber@deinprogramm.de>
date Sun, 13 Apr 2008 11:18:00 +0200
parents 715c3ced8fa8
children c32b3d10c56b
files lisp/ChangeLog lisp/window-xemacs.el
diffstat 2 files changed, 76 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Apr 12 16:41:38 2008 +0200
+++ b/lisp/ChangeLog	Sun Apr 13 11:18:00 2008 +0200
@@ -1,3 +1,16 @@
+2008-04-13  Henry S. Thompson <ht@inf.ed.ac.uk>, Mike Sperber  <mike@xemacs.org>
+
+	* window-xemacs.el (save-window-excursion/mapping,
+	set-window-configuration/mapping): Add.  These function return an
+	alist mapping the window objects from the original window
+	configuration to the window objects corresponding to them in the
+	restored configuration.
+	(set-window-configuration): 
+	(saved-window): 
+	(root-window->saved-window): 
+	(really-set-window-configuration): 
+	(restore-saved-window): Record the mapping for above functions.
+
 2008-04-12  Henry S. Thompson <ht@inf.ed.ac.uk>
 
 	* window-xemacs.el (real-split-window, real-delete-window): Define
--- a/lisp/window-xemacs.el	Sat Apr 12 16:41:38 2008 +0200
+++ b/lisp/window-xemacs.el	Sun Apr 13 11:18:00 2008 +0200
@@ -124,7 +124,8 @@
   pixel-left pixel-top pixel-right pixel-bottom
   hscroll modeline-hscroll
   dedicatedp
-  first-hchild first-vchild next-child)
+  first-hchild first-vchild next-child
+  window)
 
 (defstruct window-configuration
   frame
@@ -260,6 +261,7 @@
 	  (bottom (nth 3 edges)))
       (let ((saved-window
 	     (make-saved-window
+	      :window window
 	      :currentp (eq window (selected-window (window-frame window)))
 	      :minibufferp (eq window (minibuffer-window (window-frame window)))
 	      :minibuffer-scrollp (eq window minibuffer-scroll-window)
@@ -290,10 +292,39 @@
 		    (copy-marker (mark-marker t buffer)))))
 	saved-window))))
 
+(defmacro save-window-excursion/mapping (&rest body)
+  "Execute body, preserving window sizes and contents.
+Restores which buffer appears in which window, where display starts,
+as well as the current buffer.
+Return alist mapping old windows to new windows.
+This alist maps the originally captured windows to the windows that correspond
+to them in the restored configuration.  It does not include entries for
+windows that have not changed identity.
+Does not restore the value of point in current buffer."
+  (let ((window-config (gensym 'window-config))
+	(mapping (gensym 'mapping)))
+    `(let ((,window-config (current-window-configuration))
+	   (,mapping))
+      (unwind-protect
+	  (progn ,@body)
+	(setq ,mapping (set-window-configuration/mapping ,window-config)))
+      ,mapping)))
+
 (defun set-window-configuration (configuration)
   "Set the configuration of windows and buffers as specified by CONFIGURATION.
 CONFIGURATION must be a value previously returned
 by `current-window-configuration'."
+  (set-window-configuration/mapping configuration)
+  nil) ; make sure nobody relies on mapping return value
+
+(defun set-window-configuration/mapping (configuration)
+  "Set the configuration of windows and buffers as specified by CONFIGURATION.
+CONFIGURATION must be a value previously returned
+by `current-window-configuration'.
+Return alist mapping old windows to new windows.
+This alist maps the originally captured windows to the windows that correspond
+to them in the restored configuration.  It does not include entries for
+windows that have not changed identity."
   (let ((frame (window-configuration-frame configuration)))
     (if (and (frame-live-p frame)
 	     (not (window-configuration-equal configuration
@@ -301,7 +332,8 @@
 	(really-set-window-configuration frame configuration))))
 
 (defun really-set-window-configuration (frame configuration)
-  "Set the window configuration CONFIGURATION on live frame FRAME."
+  "Set the window configuration CONFIGURATION on live frame FRAME.
+Return alist mapping old windows to new windows."
   ;; avoid potential temporary problems
   (setq window-min-width 0)
   (setq window-min-height 0)
@@ -332,22 +364,26 @@
     ;; the selected window
     (select-window (minibuffer-window frame))
 
-    (let ((window-configuration-current-window nil))
+    (let ((window-configuration-current-window nil)
+	  (mapping (list nil))) ; poor man's box
+      
       (declare (special window-configuration-current-window))
       (restore-saved-window configuration
 			    root-window
 			    (window-configuration-saved-root-window configuration)
-			    'vertical) 
+			    'vertical
+			    mapping) 
       (if window-configuration-current-window
-	  (select-window window-configuration-current-window))))
-
-  (setq window-min-width (window-configuration-min-width configuration))
-  (setq window-min-height (window-configuration-min-height configuration))
-
-  (let ((buffer (window-configuration-current-buffer configuration)))
-    (if (buffer-live-p buffer)
-	(set-buffer buffer)
-	(set-buffer (car (buffer-list))))))
+	  (select-window window-configuration-current-window))
+    
+      (setq window-min-width (window-configuration-min-width configuration))
+      (setq window-min-height (window-configuration-min-height configuration))
+      
+      (let ((buffer (window-configuration-current-buffer configuration)))
+	(if (buffer-live-p buffer)
+	    (set-buffer buffer)
+	  (set-buffer (car (buffer-list)))))
+      (car mapping))))
 
 (defun set-window-configuration-frame-size (configuration)
   "Restore the frame size of a window configuration."
@@ -381,8 +417,14 @@
    ((window-first-vchild window)
     (window-reduce-to-one (window-first-vchild window)))))
 
-(defun restore-saved-window (configuration window saved-window direction)
-  "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW."
+(defun restore-saved-window (configuration window saved-window direction mapping)
+  "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW.
+MAPPING is a one-element list whose element is an old-window-to-new-window
+mapping, which this function will extend."
+  (if (not (eq (saved-window-window saved-window) window))
+      (rplaca mapping
+	      (cons (cons (saved-window-window saved-window) window)
+		    (car mapping))))
   (cond
    ((and (saved-window-next-child saved-window)
 	 (not (saved-window-minibufferp (saved-window-next-child saved-window))))
@@ -395,7 +437,8 @@
     (restore-saved-window configuration
 			  (window-next-child window)
 			  (saved-window-next-child saved-window)
-			  direction))
+			  direction
+			  mapping))
   ((not (saved-window-minibufferp saved-window))
    (restore-saved-window-parameters configuration window saved-window)))
 
@@ -403,12 +446,14 @@
       (restore-saved-window configuration
 			    window
 			    (saved-window-first-hchild saved-window)
-			    'horizontal))
+			    'horizontal
+			    mapping))
   (if (saved-window-first-vchild saved-window)
       (restore-saved-window configuration
 			    window
 			    (saved-window-first-vchild saved-window)
-			    'vertical)))
+			    'vertical
+			    mapping)))
 
 (defun restore-saved-window-parameters (configuration window saved-window)
   "Restore the window parameters stored in SAVED-WINDOW on WINDOW."