
;; Copyright (C) 2016, 2021, 2024  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 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 General Public License
;; along with this program. If not, see https://www.gnu.org/licenses/.


(define-body (intr-gtk3-examples theme-d-intr-demo dialog)

  (import (standard-library object-string-conversion)
	  (standard-library string-utilities)
	  (intr-gtk3-examples theme-d-intr-demo _intr-imports)
	  (intr-gtk3-examples theme-d-intr-demo support))


  (define connect gtype-instance-signal-connect)

  (define-mutable gl-i-counter <integer> 0)

  ;; Should this be nonpure?
  (define gtk-message-dialog-new1
    (prim-proc gtk-message-dialog-new1
	       (<symbol> <string>) <gtk-widget> pure))
  
  (define-simple-method message-dialog-clicked
      (((window-parent <gtk-window>)) <none> nonpure)
    (let ((dialog
	   (cast <gtk-message-dialog>
		 (gtk-message-dialog-new1
		  'ok
  		  (string-append
  		   "This message box has been popped up "
  		   "the following\n"
  		   "number of times:\n\n"
  		   (integer->string gl-i-counter))))))
      (set-transient-for dialog window-parent)
      (run dialog)
      (destroy dialog)
      (set! gl-i-counter (+ gl-i-counter 1))))


  (define-simple-method interactive-dialog-clicked
      (((window-parent <gtk-window>) (entry1 <gtk-entry>) (entry2 <gtk-entry>))
       <none> nonpure)
    (let ((dialog
	   (cast <gtk-dialog> (gtk-dialog-new)))
  	  (hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
  	  (image-stock (gtk-image-new-from-icon-name
  			"dialog-question"
  			6))
  	  (table (cast <gtk-table> (gtk-table-new 2 2 #f)))
  	  (label1 (cast <gtk-label> (gtk-label-new "_Entry 1")))
  	  (entry-local1 (cast <gtk-entry> (gtk-entry-new)))
  	  (label2 (cast <gtk-label> (gtk-label-new "E_ntry 2")))
  	  (entry-local2 (cast <gtk-entry> (gtk-entry-new))))

      (set-title dialog "Interactive Dialog")
      
      (set-use-underline label1 #t)
      (set-use-underline label2 #t)

      (add-button dialog "Ok" 1)
      (add-button dialog "_Non-stock Button" 0)

      (set-border-width hbox 8)
      (pack-start (gtk-dialog-get-content-area dialog)
  		  hbox #f #f 0)

      (pack-start hbox image-stock #f #f 0)

      (set-row-spacings table 4)
      (set-col-spacings table 4)
      (pack-start hbox table #t #t 0)

      (attach-defaults table label1 0 1 0 1)
      (set-text entry-local1 (gtk-entry-get-text entry1))
      (attach-defaults table entry-local1 1 2 0 1)
      (set-mnemonic-widget label1 entry-local1)

      (attach-defaults table label2 0 1 1 2)
      (set-text entry-local2 (gtk-entry-get-text entry2))
      (attach-defaults table entry-local2 1 2 1 2)
      (set-mnemonic-widget label2 entry-local2)

      (set-transient-for dialog window-parent)

      (show-all hbox)

      (let ((i-response (run dialog)))
  	(if (equal? i-response 1)
  	    (begin
  	      (set-text entry1 (gtk-entry-get-text entry-local1))
  	      (set-text entry2 (gtk-entry-get-text entry-local2)))))
      (destroy dialog)))


  (define-simple-method run-dialog-demo (((window-parent <gtk-window>))
					 <none> nonpure)
    (let ((window (cast <gtk-window> (gtk-window-new 'toplevel)))
	  (frame (cast <gtk-frame> (gtk-frame-new "Dialogs")))
	  (vbox (cast <gtk-box> (gtk-box-new 'vertical 8))))
      (set-title window "Dialogs")
      (set-border-width window 8)
      (add window frame)
      (set-border-width vbox 8)
      (add frame vbox)

      ;; standard message dialog
      (let ((hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
	    (button
	     (cast <gtk-button>
		   (gtk-button-new-with-label "_Message Dialog"))))
	(set-use-underline button #t)
	(pack-start vbox hbox #f #f 0)
	(connect button 'clicked
		 (lambda (((args (rest <object>)))
			  <object>
			  nonpure)
		   (message-dialog-clicked window)
		   null))
	(pack-start hbox button  #f #f 0))
      (pack-start vbox (gtk-hseparator-new) #f #f 0)

      ;; interactive dialog
      (let ((hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
	    (vbox2 (cast <gtk-box> (gtk-box-new 'vertical 0)))
	    (button
	     (cast <gtk-button>
		   (gtk-button-new-with-label "_Interactive Dialog")))
	    (table (cast <gtk-table> (gtk-table-new 2 2 #f)))
	    (label1 (cast <gtk-label> (gtk-label-new "_Entry 1")))
	    (entry1 (cast <gtk-entry> (gtk-entry-new)))
	    (label2 (cast <gtk-label> (gtk-label-new "E_ntry 2")))
	    (entry2 (cast <gtk-entry> (gtk-entry-new))))

	(set-use-underline button #t)
	(set-use-underline label1 #t)
	(set-use-underline label2 #t)
	(pack-start vbox hbox #f #f 0)
	(connect
	 button 'clicked
	 (lambda (((args (rest <object>)))
		  <object>
		  nonpure)
	   (interactive-dialog-clicked window entry1 entry2)
	   null))

	(pack-start hbox vbox2 #f #f 0)
	(pack-start vbox2 button #f #f 0)
	(set-row-spacings table 4)
	(set-col-spacings table 4)

	(pack-start hbox table #f #f 0)

	(attach-defaults table label1 0 1 0 1)
	(attach-defaults table entry1 1 2 0 1)
	(set-mnemonic-widget label1 entry1)
	(attach-defaults table label2 0 1 1 2)
	(attach-defaults table entry2 1 2 1 2)
	(set-mnemonic-widget label2 entry2)

	(set-modal window #t)
	(set-transient-for window window-parent)

	(show-all window))))


  (define-simple-method get-dialog-demo (() <demo> force-pure)
    (let* ((str-name "Dialog and Message Boxes")
	   (str-module-name "dialog")
	   (str-desc 
	    (string-append
	     "Dialog widgets are used to pop up a transient window "
	     "for user feedback."))
	   (demo (create <demo> str-name str-module-name str-desc "" ""
		       run-dialog-demo)))
      (demo-compute-source demo)
      demo)))
