;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: PANE-TEST; -*-
;;; ---------------------------------------------------------------------------
;;;     Title: Sheet Adoption Test
;;;   Created: 2003-06-01
;;;    Author: Andreas Fuchs <asf@void.at>
;;;   License: LLGPL
;;; ---------------------------------------------------------------------------
;;;  (c) copyright 2003 by Andreas Fuchs

(in-package :PANE-TEST)

(defpackage :pane-test
  (:use :clim-lisp))

(in-package :pane-test)

(clim:define-application-frame pane-test ()
  ()
  (:panes
   (test (clim:horizontally ()))
   (interactor :interactor))
  (:layouts
   (default
       (clim:vertically ()
                        (:fill test)
                        (1/10 interactor)))))

(define-pane-test-command (com-quit :name t) ()
  (clim:frame-exit clim:*application-frame*))

(define-pane-test-command (com-sheet-adoption-test-1 :name t) ()
  (clim:sheet-adopt-child (clim:find-pane-named clim:*application-frame* 'test)
                          (clim:with-look-and-feel-realization ((clim:frame-manager clim:*application-frame*)
                                                                clim:*application-frame*)
                            (clim:make-clim-stream-pane :display-after-commands :no-clear
                                                        :display-time t
                                                        :end-of-line-action :wrap
                                                        :end-of-page-action :scroll
                                                        :initial-cursor-visibility nil
                                                        :display-function 'display-foos))))

(define-pane-test-command (com-sheet-adoption-test-2 :name t) ()
  (clim:sheet-adopt-child (clim:find-pane-named clim:*application-frame* 'test)
                          (clim:with-look-and-feel-realization ((clim:frame-manager clim:*application-frame*)
                                                                clim:*application-frame*)
                            (clim:make-clim-stream-pane :display-after-commands :no-clear
                                                        :display-time t
                                                        :end-of-line-action :wrap
                                                        :end-of-page-action :scroll
                                                        :initial-cursor-visibility nil
                                                        :display-function 'display-foos
                                                        :max-height clim:+fill+))))

(defmethod display-foos ((frame pane-test) stream)
  (clim:format-items '("foo" "fooo" "fooooo" "foooooo" "fooooooo" "BAR!")
                     :stream stream
                     :n-columns 2))

(define-pane-test-command (com-relayout-frame :name t) ()
  (clim:layout-frame clim:*application-frame*))


(defun run ()
  (clim:run-frame-top-level (clim:make-application-frame 'pane-test)))