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

Modified Files: gui.lisp Log Message: Fixed old problem with using adjuster gadget.

Date: Mon Feb 21 09:51:03 2005 Author: rstrandh

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.116 climacs/gui.lisp:1.117 --- climacs/gui.lisp:1.116 Mon Feb 21 08:58:39 2005 +++ climacs/gui.lisp Mon Feb 21 09:51:03 2005 @@ -856,54 +856,32 @@ ;;; ;;; Commands for splitting windows

-;;; put this in for real when we find a solution for the problem -;;; it causes for com-delete-window -;; (defun replace-constellation (constellation additional-constellation vertical-p) -;; (let* ((parent (sheet-parent constellation)) -;; (children (sheet-children parent)) -;; (first (first children)) -;; (second (second children)) -;; (adjust (make-pane 'clim-extensions:box-adjuster-gadget))) -;; (assert (member constellation children)) -;; (cond ((eq constellation first) -;; (sheet-disown-child parent constellation) -;; (let ((new (if vertical-p -;; (vertically () -;; constellation adjust additional-constellation) -;; (horizontally () -;; constellation adjust additional-constellation)))) -;; (sheet-adopt-child parent new) -;; (reorder-sheets parent (list new second)))) -;; (t -;; (sheet-disown-child parent constellation) -;; (let ((new (if vertical-p -;; (vertically () -;; constellation adjust additional-constellation) -;; (horizontally () -;; constellation adjust additional-constellation)))) -;; (sheet-adopt-child parent new) -;; (reorder-sheets parent (list first new))))))) - +;; put this in for real when we find a solution for the problem +;; it causes for com-delete-window (defun replace-constellation (constellation additional-constellation vertical-p) (let* ((parent (sheet-parent constellation)) (children (sheet-children parent)) (first (first children)) - (second (second children))) + (second (second children)) + (third (third children)) + (adjust (make-pane 'clim-extensions:box-adjuster-gadget))) + (format *query-io* "~S" children) (assert (member constellation children)) - (cond ((eq constellation first) - (sheet-disown-child parent constellation) - (let ((new (if vertical-p - (vertically () constellation additional-constellation) - (horizontally () constellation additional-constellation)))) - (sheet-adopt-child parent new) - (reorder-sheets parent (list new second)))) - (t - (sheet-disown-child parent constellation) - (let ((new (if vertical-p - (vertically () constellation additional-constellation) - (horizontally () constellation additional-constellation)))) - (sheet-adopt-child parent new) - (reorder-sheets parent (list first new))))))) + (sheet-disown-child parent constellation) + (let ((new (if vertical-p + (vertically () + constellation adjust additional-constellation) + (horizontally () + constellation adjust additional-constellation)))) + (sheet-adopt-child parent new) + (reorder-sheets parent + (if (eq constellation first) + (if third + (list new second third) + (list new second)) + (if third + (list first second new) + (list first new)))))))

(defun parent3 (sheet) (sheet-parent (sheet-parent (sheet-parent sheet)))) @@ -967,53 +945,36 @@ (append (cdr (windows *application-frame*)) (list (car (windows *application-frame*))))))

+(define-named-command com-single-window () + (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*))) (let* ((constellation (parent3 (current-window))) (box (sheet-parent constellation)) (box-children (sheet-children box)) (other (if (eq constellation (first box-children)) - (second box-children) + (third box-children) (first box-children))) (parent (sheet-parent box)) (children (sheet-children parent)) (first (first children)) - (second (second children))) + (second (second children)) + (third (third children))) (pop (windows *application-frame*)) (sheet-disown-child box other) (sheet-disown-child parent box) - (sheet-adopt-child parent other) + (sheet-adopt-child parent other) (reorder-sheets parent (if (eq box first) - (list other second) - (list first other)))))) - -(define-named-command com-single-window () - (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*))) -;; (let* ((constellation (parent3 (current-window))) -;; (box (sheet-parent constellation)) -;; (box-children (sheet-children box)) -;; (other (if (eq constellation (first box-children)) -;; (third box-children) -;; (first box-children))) -;; (parent (sheet-parent box)) -;; (children (sheet-children parent)) -;; (first (first children)) -;; (second (second children)) -;; (third (third children))) -;; (pop (windows *application-frame*)) -;; (sheet-disown-child box other) -;; (sheet-disown-child parent box) -;; (sheet-adopt-child parent other) -;; (cond ((eq box first) -;; (reorder-sheets parent (list other second third))) -;; (t -;; (reorder-sheets parent (list first second other))))))) + (if third + (list other second third) + (list other second)) + (if third + (list first second other) + (list first other)))))))

;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands