[climacs-cvs] CVS update: climacs/window-commands.lisp

[Dwight Holman]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv28153

Modified Files:
	window-commands.lisp 
Log Message:
Fixed behavior of window splits when there is just one climacs-pane,
and tried to make sure the window always splits evenly.


Date: Mon Dec  5 10:56:19 2005
Author: dholman

Index: climacs/window-commands.lisp
diff -u climacs/window-commands.lisp:1.2 climacs/window-commands.lisp:1.3
--- climacs/window-commands.lisp:1.2	Sun Nov 13 10:24:45 2005
+++ climacs/window-commands.lisp	Mon Dec  5 10:56:19 2005
@@ -38,15 +38,31 @@
 	 (first (first children))
 	 (second (second children))
 	 (third (third children))
+	 (first-split-p (= (length (sheet-children parent)) 2))
+	 (parent-region (sheet-region parent))
+	 (parent-height (rectangle-height parent-region))
+	 (parent-width (rectangle-width parent-region))
+	 (filler (when first-split-p (make-pane 'basic-pane))) ;Prevents resizing.
          (adjust (make-pane 'clim-extensions:box-adjuster-gadget)))
     (assert (member constellation children))
+    
+    (when first-split-p (setf (sheet-region filler) (sheet-region parent)) 
+      (sheet-adopt-child parent filler))
+
     (sheet-disown-child parent constellation)
+
+    (if vertical-p
+	(resize-sheet constellation parent-width (/ parent-height 2))
+	(resize-sheet constellation  (/ parent-width 2) parent-height))
+    
     (let ((new (if vertical-p
 		   (vertically ()
 		     constellation adjust additional-constellation)
 		   (horizontally ()
 		     constellation adjust additional-constellation))))
       (sheet-adopt-child parent new)
+
+      (when first-split-p (sheet-disown-child parent filler))
       (reorder-sheets parent 
 		      (if (eq constellation first)
 			  (if third
@@ -283,8 +299,8 @@
 	    (remove window (windows *application-frame*)))
       (setf *standard-output* (car (windows *application-frame*)))
       (sheet-disown-child box other)
+      (sheet-adopt-child parent other)
       (sheet-disown-child parent box)
-	 (sheet-adopt-child parent other)
       (reorder-sheets parent (if (eq box first)
 				 (if third
 				     (list other second third)