(in-package :clim-user)

(defclass stack-layout-pane (clim-silica::layout-pane) ())

(defmethod compose-space ((pane stack-layout-pane) &key width height)
  (declare (ignore width height))
  (reduce (lambda (x y)
            (clim-silica:space-requirement-combine #'max x y))
          (mapcar #'compose-space (sheet-children pane))
          :initial-value
          (make-space-requirement :width 0 :min-width 0 :max-width 0
                                  :height 0 :min-height 0 :max-height 0)))

(defmethod sheet-adopt-child :after ((sheet stack-layout-pane) child)
  (declare (ignore child))
  (when (sheet-parent sheet)
    (change-space-requirements sheet)))

(defmethod sheet-disown-child :after ((sheet stack-layout-pane) child)
  (declare (ignore child))
  (when (sheet-parent sheet)
    (change-space-requirements sheet)))

(defmethod allocate-space ((pane stack-layout-pane) width height)
  (dolist (child (sheet-children pane))
    (move-and-resize-sheet child 0 0 width height)
    (allocate-space child width height)))

(defmethod initialize-instance :after ((pane stack-layout-pane)
				       &rest args
				       &key contents
				       &allow-other-keys)
  (dolist (k contents)
    (sheet-adopt-child pane k)
    (setf (sheet-enabled-p k) t)))

(defmethod stack-layout-visible-child ((sheet stack-layout-pane))
  (first (sheet-enabled-children sheet)))

(defmethod (setf stack-layout-visible-child) (new-child (sheet stack-layout-pane))
  (raise-sheet new-child))



(define-application-frame zoo ()
  ()
  (:panes
   (stack-layout (make-pane 'stack-layout-pane 
                            :contents (list (make-pane 'push-button :label "Foo"))))
   (io :interactor))
  (:layouts
   (default
       (vertically ()
         stack-layout
         io))))

(defun zoo ()
  (run-frame-top-level (make-application-frame 'zoo)))

(define-zoo-command (com-adopt :name "adopt") ()
  (let ((s (find-pane-named *application-frame* 'stack-layout))
        (new (with-look-and-feel-realization ()
               (make-pane 'push-button :label (symbol-name (gensym "Adopted"))))))
    
      (sheet-adopt-child s new)
      (raise-sheet new)))

(define-zoo-command (com-disown :name "disown") ()
  (let ((s (find-pane-named *application-frame* 'stack-layout)))
    (sheet-disown-child s (stack-layout-visible-child s))))

(define-zoo-command (com-bury :name "bury") ()
  (let ((s (find-pane-named *application-frame* 'stack-layout)))
      (bury-sheet (stack-layout-visible-child s))))

(define-zoo-command (com-break :name "break") ()
  (let* ((stack-layout (find-pane-named *application-frame* 'stack-layout))
         (parent (sheet-parent stack-layout))
         (parent-children (sheet-children parent)))
    (format *query-io* "~s~%~s~%~s~%" stack-layout parent parent-children)))