;; -*-theme-d-*-

;; Copyright (C) 2025 Tommi Höynälänmaa

;; This file is part of Theme-D-Intr.

;; You can redistribute and/or modify this file under the terms of the
;; GNU Lesser General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any
;; later version.

;; This file 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 Lesser General Public License
;; along with this program. If not, see https://www.gnu.org/licenses/.


(define-body (intr-gtk4-examples calc2 ui-interface)


  (import (standard-library core)
          (standard-library string-utilities)
          (standard-library object-string-conversion)
          (standard-library console-io))

  (import (intr-gtk4-examples calc2 ui-utils))


  (define-simple-method show-message-dialog1
    (((str-title <string>)
      (str-text <string>)
      (str-icon <string>)
      (proc-cb (:procedure () <none> nonpure)))
     <none> nonpure)
    (let ((text-buffer (gtk-text-buffer-new #f)))
      (set-text text-buffer str-text -1)
      (let* ((window-dialog (cast <gtk-window> (gtk-window-new)))
             (image
              (cast <gtk-image> (gtk-image-new-from-icon-name str-icon)))
             (box (cast <gtk-box> (gtk-box-new 'vertical 20)))
             (text-view
              (cast <gtk-text-view>
                    (gtk-text-view-new-with-buffer text-buffer)))
             (button (gtk-button-new-with-label "Ok")))
        (slot-set! text-view 'editable #f)
        (slot-set! text-view 'cursor-visible #f)
        (gtk-box-append box image)
        (gtk-box-append box text-view)
        (gtk-box-append box button)
        (gtk-window-set-child window-dialog box)
        ;; (set-transient-for window-dialog window-transient-parent)
        (slot-set! image 'icon-size 'large)
        (slot-set! window-dialog 'width-request 400)
        (slot-set! window-dialog 'title str-title)
        (slot-set! window-dialog 'modal #t)
        (slot-set! window-dialog 'destroy-with-parent #t)
        (slot-set! box 'margin-start 20)
        (slot-set! box 'margin-end 20)
        (slot-set! box 'margin-top 20)
        (slot-set! box 'margin-bottom 20)
        (gtype-instance-signal-connect
         button
         'clicked
         (lambda (((args (rest <object>))) <object> nonpure)
           (proc-cb)
           #f))
        (show window-dialog)))))


  (define-simple-method ui-cb-load-config-error
      (((ui-interface <ui-interface>)
        (exc <object>)
        (proc-cb (:procedure () <none> nonpure)))
       <none> nonpure)
    (let* ((str1
            (string-append "Error loading plugin configuration.\n"
                           "The configuration shall be resetted."))
           (str-detail
            (if (rte-exception? exc)
                (begin
                 ;; TBR
                 (console-display-line 
                  (get-rte-exception-info (cast <condition> exc)))
                 (string-append
                  "Error type: "
                  (symbol->string 
                   (get-rte-exception-kind (cast <condition> exc)))
                  "."))
                ""))
           (str-contents
            (if (not (string-empty? str-detail))
                (string-append str1 "\n" str-detail "\n")
                str1)))   
      (show-message-dialog1 "Configuration Error"
                            str-contents
                            "dialog-error"
                            proc-cb))))


