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*)))