;;;;
;;;; dialog.stk                 -- GTKlos Dialogs
;;;;
;;;; Copyright © 2002-2022 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: 15-Feb-2002 16:39 (eg)
;;;;

;;;
;;; GTK bindings
;;;

(define-gtk gtk-dialog-new () #:pointer       "gtk_dialog_new")
(define-gtk gtk-dialog-run (#:pointer) #:int  "gtk_dialog_run")

(define-gtk gtk-dialog-get-content-area (#:pointer) #:pointer
  "gtk_dialog_get_content_area")

(define-gtk gtk-dialog-add-button (#:pointer #:string #:long) #:void
  "gtk_dialog_add_button")

(define-gtk gtk-message-dialog-new-with-markup (#:pointer #:long #:long
                                                #:long #:string) #:pointer
  "gtk_message_dialog_new_with_markup")

;; Type enum GtkDialogFlags
(define |GTK_DIALOG_MODAL|                1)
(define |GTK_DIALOG_DESTROY_WITH_PARENT|  2)
(define |GTK_DIALOG_NO_SEPARATOR|         4)

;; Type enum GtkMessageType
(define |GTK_MESSAGE_INFO|          0)
(define |GTK_MESSAGE_WARNING|       1)
(define |GTK_MESSAGE_QUESTION|      2)
(define |GTK_MESSAGE_ERROR|         3)
(define |GTK_MESSAGE_OTHER|         4)

;; Type GtkResponseType
(define |GTK_RESPONSE_NONE|         -1)
(define |GTK_RESPONSE_REJECT|       -2)
(define |GTK_RESPONSE_ACCEPT|       -3)
(define |GTK_RESPONSE_DELETE_EVENT| -4)
(define |GTK_RESPONSE_OK|           -5)
(define |GTK_RESPONSE_CANCEL|       -6)
(define |GTK_RESPONSE_CLOSE|        -7)
(define |GTK_RESPONSE_YES|          -8)
(define |GTK_RESPONSE_NO|           -9)
(define |GTK_RESPONSE_APPLY|        -10)
(define |GTK_RESPONSE_HELP|         -11)

;; ======================================================================
;;
;;   < d i a l o g >   c l a s s
;;
;; ======================================================================
(define-class <dialog> (<window>)
  ((%run)           ;; contains a closure to run the dialog
   (use-header-bar  #:accessor      use-header-bar
                    #:init-keyword  #:use-header-bar
                    #:allocation    #:virtual
                    #:slot-ref      (lambda (o)
                                      (= (%gtk-get-property (slot-ref o 'wid)
                                                            "use-header-bar")
                                         1))
                    #:slot-set!     (lambda (o v)
                                      (%gtk-set-property (slot-ref o 'wid)
                                                         "use-header-bar"
                                                         (if v 1 0))))
   ))


(define (%create-dialog-buttons dialog buttons)
  (let Loop ((value 0) (buttons buttons))
      (unless (null? buttons)
        (let* ((first (car buttons))
               (txt   (if (symbol? first) (format "gtk-~a" first) first)))
          (gtk-dialog-add-button dialog txt value)
          (Loop (+ value 1)
                (cdr buttons))))))

(define (%create-dialog-closure dialog buttons)
  (lambda ()
    (let* ((dlg (gtk-dialog-run dialog))
           (res (if (<= 0 dlg (- (length buttons) 1))
                    (list-ref buttons dlg)
                    #f)))
      res)))

  
;; Spécify at creation time the buttons used by the dialog
;; The default is "Ok" and "Cancel"
;; If a button is a symbol, it will be used as a GTk stock item
;; and an icon will be associated to the text.
;; For instance 'ok will add a button with text "Ok" and a check
;; A complet list of stock items is available at
;; https://developer.gnome.org/gtk3/stable/gtk3-Stock-Items.html
(define-method realize-widget ((self <dialog>) initargs)
  (let ((dialog  (gtk-dialog-new))
        (buttons (key-get initargs #:buttons '(ok cancel))))
    (cpointer-type-set! dialog 'dialog)
    (slot-set! self 'wid dialog)

    ;; Create the buttons & the closure for running the dialog
    (%create-dialog-buttons dialog buttons)
    (slot-set! self '%run (%create-dialog-closure dialog buttons))
    dialog))


(define-method container-add! ((cont <dialog>) (widget <gtk-widget>) . options)
  ;; Dialogs have already a vertical box created by GTK at instanciation time
  (let ((vbox (gtk-dialog-get-content-area (slot-ref cont 'wid))))
    (gtk-container-add  vbox (slot-ref widget 'wid))
    (slot-set! cont '%children (cons widget (slot-ref cont '%children)))))


;;;
;;; dialog-run
;;;
(define-generic dialog-run)

(define-method dialog-run ((d <dialog>))
  ( (slot-ref d '%run) ))


;; ======================================================================
;;
;;   make-simple-message-dialog
;;
;; ======================================================================

;; A list of possible icon names:
;;        https://developer.gnome.org/icon-naming-spec/
(define (make-simple-message-dialog title type message
                                    :optional (buttons '(ok cancel)))
  (let* ((type  (case type
                  ((error)    "dialog-error")
                  ((info)     "dialog-information")
                  ((password) "dialog-password")
                  ((question) "dialog-question")
                  ((warning)  "dialog-warning")
                  (else       (format "~a" type))))  ;;<- convert to string
         (dialog (make <dialog> #:title title #:buttons buttons))
         (box    (make <hbox>   #:border-width 10 #:padding 20 #:parent dialog))
         (img    (make <image>  #:icon-name type :icon-size 'huge
                                #:parent box))
         (msg    (make <label>  #:text message #:parent box)))

    (let ((res (dialog-run dialog)))
      (destroy dialog)
      res)))



;;;
;;; Exports
;;;
(export <dialog> use-header-bar
        dialog-run
        make-simple-message-dialog)
