(in-package "CLIM-USER") (define-application-frame vbox () ((extra :initform nil :accessor extra)) (:panes (foo (make-pane 'vbox-pane :contents (list (make-pane 'interactor-pane))))) (:layouts (default foo))) (define-vbox-command (com-double :name t) () (let* ((frame *application-frame*) (vbox (find-pane-named frame 'foo))) (with-look-and-feel-realization ((find-frame-manager) frame) (reinitialize-instance vbox :contents (list (car (sheet-children vbox)) +fill+ (setf (extra frame) (make-pane 'application-pane :min-width 200 :min-height 200 :display-time nil))))))) (define-vbox-command (com-draw :name t) () (let* ((frame *application-frame*) (extra (extra frame))) (draw-circle* extra 150 150 10 :filled t :ink +black+))) (in-package :climi) (defmethod reinitialize-instance :after ((pane box-pane) &key contents) (labels ((parse-box-content (content) "Parses a box/rack content and returns a BOX-CLIENT instance." ;; ### we need to parse more (cond ;; ((panep content) (make-instance 'box-client :pane content)) ;; +fill+ ((or (eql content +fill+) (eql content '+fill+) (eql content :fill)) (make-instance 'box-client :pane nil :fillp t)) ;; (+fill+ ) ((and (consp content) (or (member (car content) '(+fill+ :fill)) (eql (car content) +fill+))) (make-instance 'box-client :pane (cadr content) :fillp t)) ;; ;; ;; what about something like (30 :mm) ? ;; ((and (realp content) (>= content 0)) (make-instance 'box-client :pane nil :fixed-size content)) ;; ( pane) ((and (consp content) (realp (car content)) (>= (car content) 0) (consp (cdr content)) (panep (cadr content)) (null (cddr content))) (let ((number (car content)) (child (cadr content))) (if (< number 1) (make-instance 'box-client :pane child :proportion number) (make-instance 'box-client :pane child :fixed-size number)))) (t (error "~S is not a valid element in the ~S option of ~S." content :contents pane)) ))) (let* ((clients (mapcar #'parse-box-content contents)) (children (remove nil (mapcar #'box-client-pane clients)))) ;; (setf (box-layout-mixin-clients pane) clients) (mapc (curry #'sheet-adopt-child pane) children)))) (defmethod reinitialize-instance :before ((pane box-pane) &key contents) (let ((children (sheet-children pane))) (mapc (curry #'sheet-disown-child pane) children) (setf (box-layout-mixin-clients pane) nil)))