;; -*-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-utils)


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


  (define-simple-method show-message-dialog
    (((str-title <string>)
      (str-text <string>)
      (str-icon <string>)
      (window-transient-parent (:alt-maybe <gtk-window>)))
     <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)
           (gtk-window-destroy window-dialog)
           #f))
        (show window-dialog))))


  (define-simple-method show-message-dialog1
    (((str-title <string>)
      (str-text <string>)
      (str-icon <string>)
      (app <gtk-application>)
      (proc-cb (:procedure () <none> nonpure)))
     <none> nonpure)
    (dwln 'debug1 "show-message-dialog1 ENTER")
    (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")))
        (dwln 'debug1 "show-message-dialog1/1")
        (gtk-application-add-window app window-dialog)
        (dwln 'debug1 "show-message-dialog1/2")
        (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)
           (destroy window-dialog)
           (proc-cb)
           #f))
        (gtype-instance-signal-connect
         window-dialog
         'close-request
         (lambda (((args (rest <object>))) <object> nonpure)
           (destroy window-dialog)
           (proc-cb)
           #f))
        (show window-dialog)))))

  