(defpackage :clim-gtk
  (:use :clim :clim-lisp))

(in-package :clim-gtk)

;;;; Port

(defclass gtk-port (basic-port)
  ())

(defclass gtk-graft (basic-sheet)
  ())

;;;;

(defclass gtk-frame-manager (frame-manager)
  ())

(defmethod make-pane-1 ((fm gtk-frame-manager) (frame application-frame) type &rest args)
  (let ((sym (find-symbol (concatenate 'string
                                       (symbol-name '#:gtk-) (symbol-name type))
			  :clim-gtk)))
    (unless sym
      (error "No GTK ~S pane." type))
    (apply #'make-instance
           sym
           :frame frame
           :manager fm
           :port (port frame)
           args)))

;;;;

;;;; Graft

(defvar *the-graft*
  (make-instance 'gtk-graft))

(defmethod graft-orientation ((graft gtk-graft)) :default)
(defmethod graft-units ((graft gtk-graft)) :device)
(defmethod graft-width ((graft gtk-graft) &key &allow-other-keys) 1280)
(defmethod graft-height ((graft gtk-graft) &key &allow-other-keys) 1024)

;;;

(defmethod climi::port-grafts ((port gtk-port))
  (list *the-graft*))

(defmethod initialize-instance :after ((port gtk-port) &rest args)
  (declare (ignore args))
  (push (make-instance 'gtk-frame-manager :port port)
        (slot-value port 'climi::frame-managers))
  #+NIL
  (setf (slot-value port 'climi::pointer)
	(make-instance 'climi::standard-pointer :port port))
  )

(defparameter *the-port*
  (make-instance 'gtk-port))

(defun find-port (&key server-path)
  *the-port*)

;;;; 

(defclass gtk-top-level-sheet-pane (gtk:window climi::top-level-sheet-pane sheet-multiple-child-mixin)
  ())

(defmethod initialize-instance :after ((sheet gtk-top-level-sheet-pane) &key &allow-other-keys)
  (let ((b (gtk:window-new :toplevel)))
    (gtk:twix b sheet)))

;;;;

(defclass gtk-push-button (gtk:button climi::gadget)
  ())

(defmethod initialize-instance :after ((sheet gtk-push-button) &key label &allow-other-keys)
  (let ((b (gtk:button-new-with-label label)))
    (gtk:twix b sheet)))

;;;;

(defclass gtk-vrack-pane (gtk:v-box climi::pane sheet sheet-multiple-child-mixin  )
  ())

(defmethod initialize-instance :after ((sheet gtk-vrack-pane) &key contents &allow-other-keys)
  (let ((b (gtk:vbox-new t 0)))
    (gtk:widget-show b)
    (gtk:twix b sheet))
  (dolist (c contents)
    (sheet-adopt-child sheet c)))

;;;;

(defmethod sheet-adopt-child ((sheet gtk:container) (child gtk:widget))
  (gtk:container-add sheet child)
  (gtk:widget-show child))

(defmethod sheet-adopt-child ((sheet gtk-graft) (child gtk-top-level-sheet-pane))
  (gtk:widget-show child))

(defmethod climi::port-enable-sheet ((port gtk-port) widget)
  (gtk:widget-show (sheet-direct-mirror widget)))

(defmethod climi::get-next-event ((port gtk-port) &key wait-function timeout)
  (gtk:event-loop))

;;;;

(defmethod compose-space ((sheet gtk:widget) &key width height)
  (describe (gtk:widget-size-request sheet)
            *trace-output*)
  (finish-output *trace-output*)
  (make-space-requirement :width 400 :height 400))

;;; some fakes

(defmethod climi::sheet-mirror-region ((sheet gtk-graft))
  (make-rectangle* 0 0 400 400))

(defmethod climi::port-set-mirror-region ((port gtk-port) mirror region)
  )
(defmethod climi::port-set-mirror-transformation ((port gtk-port) mirror transformation)
  )

;;;

(define-application-frame test ()
  ()
  (:menu-bar nil)
  (:panes
   (btn (make-pane 'push-button :label "Foo")))
  (:layouts
   (default
       (vertically ()
         (make-pane 'push-button :label "Foo")
         (make-pane 'push-button :label "Bar")
         (make-pane 'push-button :label "Baz")))))