;;;;
;;;; utils.stk  -- Utilities
;;;;
;;;; Copyright © 2007-2023 Erick Gallesio <eg@stklos.net>
;;;;
;;;;
;;;; 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@essi.fr]
;;;;    Creation date: 23-Aug-2007 15:03 (eg)
;;;;



;;;;
;;;; GTK Bindings
;;;;
(define-gtk gtk-init (:pointer :pointer) :void        "gtk_init")
(define-gtk gtk-main-iteration-do (:boolean) :boolean "gtk_main_iteration_do")
(define-gtk gtk-main () :void                         "gtk_main")
;;(define-gtk gtk-events-pending () :boolean          "gtk_events_pending")
;;(define-gtk gtk-main-iteration () :void             "gtk_main_iteration")


(define *table-id* '())

(define (gtklos-wid-associate wid obj)
  (set! *table-id* (cons (cons wid obj) *table-id*)))

(define (diw obj)               ;; wid inverse function
  (if (cpointer? obj)
      (let ((x (assoc obj *table-id*)))
        (and x (cdr x)))
      (error "bad pointer ~S" obj)))

;;//TODO:(define (diw* obj)              ;; the same one trying to find a known Scheme obj
;;//TODO:  (let ((res (diw obj)))
;;//TODO:    (or res
;;//TODO:        (let ((parent (gtk-widget-get-parent obj)))
;;//TODO:          (and (cpointer? parent) (diw* parent))))))
;;//TODO:

;;// (define (gtklos-widget-set-parent! w p)
;;//   (let ((old (gtk-widget-get-parent w)))
;;//     ( (if (eq? old #void) gtk-widget-set-parent gtk-widget-reparent) w p)))


;; ----------------------------------------------------------------------

(define (gtklos-slot-is-ro slot)
  (lambda (o v)
    (error "slot `~S' is read-only in ~S" slot o)))



;; ======================================================================
;;
;; Set GTK properties (special case for C pointers)
;;
;; ======================================================================

;; Normally we use the function %gtk-set-property! for setting properties
;; (defined in C). Unfortunately this function don't work whe we manipulate
;; pointers.

;; The next definition is not completely correct. It is a specialized version
;; for setting values which are pointers in GTK. Her the value set must be a
;; Cpointer. Furthermore, we only set one property here (the last pointer being
;; always #void here),whereas the g_object_set accepts any number of properties

(define-gtk g-object-set-for-pointers (:pointer #:string #:pointer #:pointer) #:void
   "g_object_set" gtk)

(define (%gtk-set-pointer-property! obj prop value)
  (g-object-set-for-pointers obj prop value (void)))


;; ======================================================================
;;
;;      GTK+ Event Loop management
;;
;; ======================================================================

(import READLINE)

(define (start-interactive-gtk)
  (let ((readline-flavor (key-get *%system-state-plist* #:readline #f)))
    (case readline-flavor
      ((readline libedit)
         ;; We are using a line editor. Use a hook function to poll the
         ;; editor input. NOTE: macOS libedit doesn't provide rl-event-hook
         (if rl-event-hook
             ;; We have a rl-event-hook
             (begin
               (rl-input-timeout 0)
               (%readline-idle-hook rl-event-hook))
             ;; No rl-event-hook (we're probably on macOS).
             ;; FIXME: Run gtk-main in a separate thread
             ;; Something like (thread-start! (make-thread gtl-main))
             ;; is OK on GNU/Linux but  doesn't work (in fact it seems
             ;; that using external functions in
             ;; a thread yield a SISEGV.
             (error "no event hook available. Use gtk-main instead")))
      (else
         ;; no editor. Use a file-port hook
         (port-idle-register! (current-input-port)
                              (lambda ()
                                (gtk-main-iteration-do #f)))))))


;;(define gtk-idle-proc (make-parameter #f))
;;
;;(define (start-gtk)
;;  ;; See if we have GTK+ events
;;  (let Loop ()
;;    (when (gtk-events-pending)
;;      (gtk-main-iteration-do #t)
;;      (Loop)))
;;  ;; See if we have a user idle proc
;;  (let ((proc (gtk-idle-proc)))
;;    (when proc (proc)))
;;  ;; Loop
;;  (start-gtk))


;;; Initialize GTK
(gtk-init (void) (void))

;;;
;;; Module exports
;;;
(export start-interactive-gtk
        gtk-main) ;; the GTK "official" event loop
