;;;;
;;;; combobox.stk   -- GTklos Combobox class
;;;;
;;;; Copyright © 2002-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: 17-Jan-2002 19:03 (eg)
;;;;

;;;
;;; GTK bindings
;;;

(define-gtk gtk-combo-box-text-new () #:pointer
  "gtk_combo_box_text_new") 
 
(define-gtk gtk-combo-box-text-new-with-entry  () #:pointer
  "gtk_combo_box_text_new_with_entry")

(define-gtk gtk-combo-box-text-remove-all (#:pointer)  #:void
  "gtk_combo_box_text_remove_all")

(define-gtk gtk-combo-box-text-get-active (#:pointer) #:long
  "gtk_combo_box_text_get_active_text")

(define-gtk gtk-combo-box-text-append (#:pointer #:string) #:void
  "gtk_combo_box_text_append_text")

(define-gtk gtk-combo-box-get-active (#:pointer) #:long
  "gtk_combo_box_get_active")

(define-gtk gtk-combo-box-set-active (#:pointer #:long) #:void
  "gtk_combo_box_set_active")

(define-gtk gtk-combo-box-text-prepend-text (#:pointer #:string) #:void
  "gtk_combo_box_text_prepend_text")

(define-gtk gtk-combo-box-text-insert-text (#:pointer #:long #:string) #:void
  "gtk_combo_box_text_insert_text")

(define-gtk gtk-combo-box-text-remove (#:pointer #:long) #:void
  "gtk_combo_box_text_remove")



;======================================================================
;
;                < C o m b o b o x >
;
;======================================================================
(define-class <combobox> (<gtk-container>)
  ((items     #:accessor      items
              #:init-keyword  #:items
              #:allocation    #:virtual
              #:slot-ref      (lambda (o)
                                (%widget-data-get o #:items #f))
              #:slot-set!     (lambda (o v)
                                ;; Delete old items
                                (let ((old (%widget-data-get o #:items '()))
                                      (w   (wid o)))
                                  ;; Remove all entries
                                  (gtk-combo-box-text-remove-all w)
                                  ;; Add new ones
                                  (for-each (lambda (x) (container-add! o x)) v)
                                  (%widget-data-set! o #:items v))))
   (value     #:accessor        value
              #:init-keyword    #:value
              #:allocation      #:virtual
              #:slot-ref        (lambda (o)
                                  (let ((v (gtk-combo-box-get-active (wid o))))
                                    (if (= v -1)
                                        #f
                                        (list-ref (%widget-data-get o #:items #f) v))))
              #:slot-set!       (lambda (o v)
                                  (if v
                                      (let Loop ((lst (%widget-data-get o #:items '()))
                                                 (i 0))
                                        (cond
                                         ((null? lst)
                                          (error "cannot find item ~S in combobox ~S"
                                                 v o))
                                         ((equal? (car lst) v)
                                          (gtk-combo-box-set-active (wid o) i))
                                         (else
                                          (Loop (cdr lst) (+ i 1)))))
                                      ;; v = #f => unset value
                                      (gtk-combo-box-set-active (wid o) -1))))
   (command   #:accessor        command
              #:init-keyword    #:command
              #:allocation      #:virtual
              #:slot-ref        (%make-event-getter-func "changed")
              #:slot-set!       (%make-event-setter-func "changed"))
   ))

(define-method realize-widget ((self <combobox>) initargs)
  (let ((c (gtk-combo-box-text-new)))
    (cpointer-type-set! c 'gtk-combobox)
    (slot-set! self 'wid c)))

;;;;
;;;; Container-add!
;;;;
(define-method container-add! ((self <combobox>) (str <string>))
  (gtk-combo-box-text-append (wid self) str))

(define-method container-add! ((self <combobox>) obj . args)
  (error "Only strings can be added to  <combobox> fo now. It was ~S" obj))


;======================================================================
;
;            < E n t r y - c o m b o b o x >
;
;======================================================================
(define-class <entry-combobox> (<combobox>)
  ((value  #:accessor       value
           #:init-keyword   #:value
           #:allocation     #:virtual
           #:slot-ref       (lambda (o)
                              ;; FIXME: this string must be free with g_free!!!!
                              (gtk-combo-box-text-get-active (wid o)))
           #:slot-set!      (lambda (o v)
                              (let ((w (wid o)))
                                (gtk-combo-box-text-prepend-text w v)
                                (gtk-combo-box-set-active w 0)
                                (gtk-combo-box-text-remove w 0))))

    ;;(gtk-combo-box-prepend-text w v)
	;;			    (gtk-combo-box-set-active w 0)
	;;			    (gtk-combo-box-remove-text w 0))))))
   ))

(define-method realize-widget ((self <entry-combobox>) initargs)
  (let ((c (gtk-combo-box-text-new-with-entry)))
    (cpointer-type-set! c 'gtk-entry-combobox)
    (slot-set! self 'wid c)))



;;;
;;; Exports
;;;
(export <combobox> <entry-combobox> items value command)

