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

Modified Files: gui.lisp Log Message: Hi guys, added com-single-window [ C-x 1 ] which closes all but the current window. I'm not gone, I've just been busy. Date: Sun Feb 13 03:47:08 2005 Author: ejohnson

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.106 climacs/gui.lisp:1.107 --- climacs/gui.lisp:1.106 Wed Feb 2 08:59:41 2005 +++ climacs/gui.lisp Sun Feb 13 03:47:06 2005 @@ -971,6 +971,29 @@ (sheet-adopt-child parent other) (reorder-sheets parent (list first other)))))))

+ +(define-named-command com-single-window () + (unless (null (cdr (windows *application-frame*))) + (let* ((saver (parent3 (current-window))) + (top-level (do + ((a 1 (1+ a)) + (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*))))))) + + ;; (define-named-command com-delete-window () ;; (unless (null (cdr (windows *application-frame*))) ;; (let* ((constellation (parent3 (current-window))) @@ -1367,6 +1390,7 @@ :keystroke gesture :errorp nil))

(c-x-set-key '(#\0) 'com-delete-window) +(c-x-set-key '(#\1) 'com-single-window) (c-x-set-key '(#\2) 'com-split-window-vertically) (c-x-set-key '(#\3) 'com-split-window-horizontally) (c-x-set-key '(#() 'com-start-kbd-macro)