[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

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

Modified Files:
	gui.lisp 
Log Message:
Simplified implementation of com-single-window and made it independent
of the clim-internals package. 

Date: Mon Feb 21 08:47:27 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.114 climacs/gui.lisp:1.115
--- climacs/gui.lisp:1.114	Sun Feb 20 06:39:16 2005
+++ climacs/gui.lisp	Mon Feb 21 08:47:26 2005
@@ -992,25 +992,10 @@
 
 
 (define-named-command com-single-window ()
-  (unless (null (cdr (windows *application-frame*)))
-    (let* ((saver (parent3 (current-window)))
-	    (top-level (do 
-			   ((n saver (setf n (sheet-parent n))))
-			   ((clim-internals::top-level-sheet-pane-p n) n)))
-	    (level1 (car (sheet-children top-level)))          ;; should be the only thing on level1
-	    (level2 (if (typep (car (sheet-children level1)) 'vrack-pane) ;;don't select raised pane
-		         (car (sheet-children level1))
-		         (cadr (sheet-children level1))))
-	    (level2-children (sheet-children level2))
-	    (junker (if (typep (car level2-children) 'vrack-pane) ;;don't select minibuffer
-		         (car level2-children)
-		         (cadr level2-children))))
-      (sheet-disown-child (sheet-parent saver) saver)
-      (sheet-disown-child level2 junker)
-      (sheet-adopt-child level2 saver)
-      (reorder-sheets level2 (reverse (sheet-children level2))) ;;minibuffer goes on bottom
-      (setf (windows *application-frame*) (list (car (windows *application-frame*)))))))
-
+  (loop until (null (cdr (windows *application-frame*)))
+	do (rotatef (car (windows *application-frame*))
+		    (cadr (windows *application-frame*)))
+	   (com-delete-window)))
 
 ;; (define-named-command com-delete-window ()
 ;;   (unless (null (cdr (windows *application-frame*)))