;;;;
;;;; window.stk -- GTK Windows
;;;;
;;;; Copyright © 2001-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 25-May-2001 15:47 (eg)
;;;;

;;;;
;;;; GTK Bindings
;;;;
(define-gtk gtk-window-new (:int) :pointer                 "gtk_window_new")
(define-gtk gtk-window-resize (:pointer :long :long) :void "gtk_window_resize")
;(define-gtk gtk-window-get-title (:pointer) :string        "gtk_window_get_title")
;(define-gtk gtk-window-set-title (:pointer :string) :void  "gtk_window_set_title")

(define-gtk gtk-window-set-default-size (:pointer :long :long) :void
  "gtk_window_set_default_size")


;;======================================================================
;;
;;           C l a s s   < w i n d o w >
;;
;;======================================================================

(define-class <window> (<gtk-container>)
  ((transient    #:accessor      transient
                 #:init-keyword  #:transient
                 #:init-form     #f)
   (title        #:accessor      title
                 #:init-form     "STklos window"
                 #:init-keyword  #:title
                 #:allocation    #:gtk-property)
   (resizable    #:accessor      resizable
                 #:init-keyword  #:resizable
                 #:allocation    #:gtk-property)
   (width        #:accessor      width
                 ;; #:init-keyword  #:width
                 #:allocation    #:virtual
                 #:slot-ref      (lambda (o)
                                   (gtk-widget-get-allocated-width (slot-ref o 'wid)))
                 #:slot-set!     (lambda (o v)
                                   (let* ((wid (slot-ref o 'wid))
                                          (h   (gtk-widget-get-allocated-height wid)))
                                     (gtk-window-resize wid v h))))
   (height       #:accessor      height
                 ;; #:init-keyword  #:height
                 #:allocation    #:virtual
                 #:slot-ref      (lambda (o)
                                   (gtk-widget-get-allocated-height (slot-ref o 'wid)))
                 #:slot-set!     (lambda (o v)
                                   (let* ((wid (slot-ref o 'wid))
                                          (w   (gtk-widget-get-allocated-width wid)))
                                     (gtk-window-resize wid w v))))
   (modal        #:accessor      modal
                 #:init-keyword  #:modal
                 #:allocation    #:gtk-property)))

(define-method realize-widget ((self <window>) initargs)
  (let* ((transient (key-get initargs #:transient #f))
         (w         (key-get initargs #:width  200))
         (h         (key-get initargs #:height 200)))

    ;; HACK: Set the preferred size by hand, otherwise value is not respected
    ;; Changing it after that seems to be OK
    (set! initargs (key-delete! initargs #:width))
    (set! initargs (key-delete! initargs #:height))

    (next-method)
    (let ((win (gtk-window-new (if transient 1 0))))
      (cpointer-type-set! win 'gtk-window)
      (slot-set! self 'wid win)
      (gtk-window-set-default-size win w h))))

;;======================================================================
;;
;;           C l a s s   < h w i n d o w >
;;
;;======================================================================
(define-class <hwindow> (<%hbox> <window>)
  ())

;;======================================================================
;;
;;           C l a s s   < v w i n d o w >
;;
;;======================================================================
(define-class <vwindow> (<%vbox> <window>)
  ())

;;;
;;; Module exports
;;;
(export <window> transient title resizable width height modal
        <hwindow> <vwindow>)
