Adw1-demo - Adding the AdwDemoPageDialogs (wip)

  Note: this a wip because although everything works in terms of
  defining and presenting the dialog, as well as selecting an
  answer, there is a (misterious) adw-message-dialog-choose
  callback problem, in that the user-data argument (the last
  argument of that method), which supposed to be passed to the
  callback procedure (the third argumet of this method), that is
  not what happen in g-golf. And i can't figure out why, so I
  decided to clean and push this nearly complete additional
  adw1-demo page example.

  Those interested to help may read the comments I added to
  the (adw1-demo dialogs) demo-message-dialog-cb procedure and
  the message-cb code, the callback procedure passed to the
  adw-message-dialog-choose call.

  Then, those interested to help still, may, in order to get some
  usefull trace (peek) debug info while running the example, may
  start the adw1-demo passing either -d or --debug option on the
  command line:		./adw1-demo.scm --debug

* examples/adw-1/adw1-demo/dialogs.scm:
* examples/adw-1/adw1-demo/ui/dialogs.scm:
* examples/adw-1/adw1-demo/ui/dialogs.ui: New files.

* examples/adw-1/adw1-demo/ui/window.scm:
* examples/adw-1/adw1-demo/ui/window.ui:
* examples/adw-1/adw1-demo/window.scm: Adding the AdwDemoPageDialogs.

6 files changed, 214 insertions, 2 deletions

diff --git a/examples/adw-1/adw1-demo/dialogs.scm b/examples/adw-1/adw1-demo/dialogs.scm
new file mode 100644
index 0000000..a055a74
--- /dev/null
+++ b/examples/adw-1/adw1-demo/dialogs.scm
@@ -0,0 +1,143 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+
+;;;;
+;;;; Copyright (C) 2023
+;;;; Free Software Foundation, Inc.
+
+;;;; This file is part of GNU G-Golf
+
+;;;; GNU G-Golf is free software; you can redistribute it and/or modify
+;;;; it 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.
+
+;;;; GNU G-Golf 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
+;;;; Lesser General Public License for more details.
+
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with GNU G-Golf.  If not, see
+;;;; <https://www.gnu.org/licenses/lgpl.html>.
+;;;;
+
+;;; Commentary:
+
+;;; Code:
+
+
+(define-module (adw1-demo dialogs)
+  #:use-module (oop goops)
+  #:use-module (g-golf)
+
+  #:duplicates (merge-generics
+		replace
+		warn-override-core
+		warn
+		last)
+
+  #:export (<adw-demo-page-dialogs>))
+
+
+#;(g-export )
+
+
+(eval-when (expand load eval)
+  (g-irepository-require "Gtk" #:version "4.0")
+  (for-each (lambda (name)
+              (gi-import-by-name "Gtk" name))
+      '("Root"
+        "Button"))
+  (g-irepository-require "Adw" #:version "1")
+  (for-each (lambda (name)
+              (gi-import-by-name "Adw" name))
+      '("Bin"
+        "Toast"
+        "MessageDialog"
+        "ResponseAppearance")))
+
+
+(define-class <adw-demo-page-dialogs> (<adw-bin>)
+  ;; slots
+  (dialogs-button #:child-id "dialogs-button"
+                  #:accessor !dialogs-button)
+  ;; class options
+  #:template (string-append (dirname (current-filename))
+                            "/ui/dialogs.ui")
+  #:child-ids '("dialogs-button")
+  #:g-signal `(add-toast	;; name
+               none		;; return-type	
+               (,<adw-toast>)	;; param-types
+               (run-first)))	;; signal flags
+
+(define-method (initialize (self <adw-demo-page-dialogs>) initargs)
+  (next-method)
+
+  (connect (!dialogs-button self)
+           'clicked
+           (lambda (b)
+             (demo-message-dialog-cb self))))
+
+(define (demo-message-dialog-cb window)
+  (let* ((parent (get-root window))
+         (dialog (adw-message-dialog-new parent
+                                         "Save Changes"
+                                         "Open document contains unsaved changes. Changes which are not saved will be permanently lost.")))
+
+    (add-responses dialog
+                   '(("cancel" "Cancel")	;; (G_ "Cancel")
+                     ("discard" "Discard")	;; ...
+                     ("save" "Save")))
+    (set-response-appearance dialog "discard" 'destructive)
+    (set-response-appearance dialog "save" 'suggested)
+    (set-default-response dialog "save")
+    (set-close-response dialog "cancel")
+    (when (%debug)
+      (demo-message-dialog-cb-debug-info window parent))
+    ;; below, the user-data (last) arg should be passed to the callback,
+    ;; so passed to the message-cb data (last) arg - that's not
+    ;; happening, but i can't figure out why. whether i pass #f (NULL)
+    ;; or the g-inst pointer of the window goops proxy instance, the
+    ;; meesage-cb call always receive a valid but unknown pointer.
+    (choose dialog #f message-cb (!g-inst window))))
+
+(define (add-responses dialog responses)
+  (for-each (lambda (response)
+              (match response
+                ((id label)
+                 (add-response dialog id label))))
+      responses))
+
+(define (message-cb dialog result data)
+  (let* ((response (choose-finish dialog result))
+         (toast (make <adw-toast>
+                  #:title (format #f "Dialog response: ~A" response))))
+    (when (%debug)
+      (message-cb-debug-info dialog result data response toast))
+    ;; before i can emit the signal, I need to find why the data arg is
+    ;; not the user-data arg of the adw-message-dialog-choose method
+    ;; call above (see line 106 - and a further detailed comment lines
+    ;; 101 - 105) - currently, uncomment would (ofc) raise an exception.
+    #;(emit -the-goops-proxy-inst-for-data- 'add-toast toast)))
+
+
+;;;
+;;; *-debug-info procs
+;;;
+
+(define (demo-message-dialog-cb-debug-info window parent)
+  (dimfi 'demo-message-dialog-cb)
+  (dimfi (format #f "~20,,,' @A:" 'window) window)
+  (dimfi (format #f "~20,,,' @A:" "[ g-inst") (!g-inst window) "]")
+  (dimfi "  " '-- 'local 'variables '--)
+  (dimfi (format #f "~20,,,' @A:" 'parent) parent)
+  (dimfi (format #f "~20,,,' @A:" "[ g-inst") (!g-inst parent) "]"))
+
+(define (message-cb-debug-info dialog result data response toast)
+  (dimfi 'message-cb)
+  (dimfi (format #f "~20,,,' @A:" 'dialog) dialog)
+  (dimfi (format #f "~20,,,' @A:" 'result) result)
+  (dimfi (format #f "~20,,,' @A:" 'data) data)
+  (dimfi "  " '-- 'local 'variables '--)
+  (dimfi (format #f "~20,,,' @A:" 'response) response)
+  (dimfi (format #f "~20,,,' @A:" 'toast) toast))
diff --git a/examples/adw-1/adw1-demo/ui/dialogs.scm b/examples/adw-1/adw1-demo/ui/dialogs.scm
new file mode 100644
index 0000000..8b5d702
--- /dev/null
+++ b/examples/adw-1/adw1-demo/ui/dialogs.scm
@@ -0,0 +1,55 @@
+;; -*- mode: sxml-ui; coding: utf-8 -*-
+
+;;;;
+;;;; Copyright (C) 2023
+;;;; Free Software Foundation, Inc.
+
+;;;; This file is part of GNU G-Golf
+
+;;;; GNU G-Golf is free software; you can redistribute it and/or modify
+;;;; it 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.
+
+;;;; GNU G-Golf 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
+;;;; Lesser General Public License for more details.
+
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with GNU G-Golf.  If not, see
+;;;; <https://www.gnu.org/licenses/lgpl.html>.
+;;;;
+
+;;; Commentary:
+
+;;; Code:
+
+
+(use-modules (g-golf support sxml))
+
+
+(define %dialogs
+  `(interface
+    (requires (@ (version "4.0") (lib "gtk")))
+    (requires (@ (version "1.0") (lib "libadwaita")))
+    (template (@ (class "AdwDemoPageDialogs")
+                 (parent "AdwBin"))
+      (property (@ (name "child"))
+        (object (@ (class "AdwStatusPage"))
+          (property (@ (name "icon-name")) widget-dialog-symbolic)
+          (property (@ (name "title")
+                       (translatable "yes")) Dialogs)
+          (property (@ (name "description")
+                       (translatable "yes")) "Adaptive dialog widgets.")
+          (property (@ (name "child"))
+            (object (@ (class "GtkButton")
+                       (id dialogs-button))
+              (property (@ (name "label")
+                           (translatable "yes")) "Message Dialog")
+              (property (@ (name "halign")) center)
+              (style (class (@ (name "pill")))))))))))
+
+
+(define (make-ui)
+  (sxml->ui %dialogs))
diff --git a/examples/adw-1/adw1-demo/ui/dialogs.ui b/examples/adw-1/adw1-demo/ui/dialogs.ui
new file mode 100644
index 0000000..881794a
--- /dev/null
+++ b/examples/adw-1/adw1-demo/ui/dialogs.ui
@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<interface><requires version="4.0" lib="gtk" /><requires version="1.0" lib="libadwaita" /><template class="AdwDemoPageDialogs" parent="AdwBin"><property name="child"><object class="AdwStatusPage"><property name="icon-name">widget-dialog-symbolic</property><property name="title" translatable="yes">Dialogs</property><property name="description" translatable="yes">Adaptive dialog widgets.</property><property name="child"><object class="GtkButton" id="dialogs-button"><property name="label" translatable="yes">Message Dialog</property><property name="halign">center</property><style><class name="pill" /></style></object></property></object></property></template></interface>
diff --git a/examples/adw-1/adw1-demo/ui/window.scm b/examples/adw-1/adw1-demo/ui/window.scm
index 966751c..20d4a3b 100644
--- a/examples/adw-1/adw1-demo/ui/window.scm
+++ b/examples/adw-1/adw1-demo/ui/window.scm
@@ -80,6 +80,16 @@
      (property (@ (name "child"))
        (object (@ (class "AdwDemoPageStyleClasses"))))))
 
+(define %dialogs
+  '(object (@ (class "GtkStackPage"))
+     (property (@ (name "title")
+                  (translatable "yes")) "Dialogs")
+     (property (@ (name "child"))
+       (object (@ (class "AdwDemoPageDialogs"))
+         ;; signal - add-toast - adw_toast_overlay_add_toast
+         ;;        - toast-overlay - swapped
+         ))))
+
 (define %sidebar
   `(object (@ (class "AdwNavigationPage"))
      (property (@ (name "title")
@@ -111,7 +121,8 @@
              ;; signal - notify::visible-child ...
              (child ,%welcome-page)
              (child ,%navigation-view)
-             (child ,%style-classes)))))))
+             (child ,%style-classes)
+             (child ,%dialogs)))))))
 
 (define %window
   `(interface
diff --git a/examples/adw-1/adw1-demo/ui/window.ui b/examples/adw-1/adw1-demo/ui/window.ui
index b78a699..754aec1 100644
--- a/examples/adw-1/adw1-demo/ui/window.ui
+++ b/examples/adw-1/adw1-demo/ui/window.ui
@@ -1,2 +1,2 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<interface><requires version="4.0" lib="gtk" /><requires version="1.0" lib="libadwaita" /><menu id="primary-menu"><section><item><attribute name="label" translatable="yes">_Inspector</attribute><attribute name="action">app.inspector</attribute></item></section><section><item><attribute name="label" translatable="yes">_Preferences</attribute><attribute name="action">app.preferences</attribute></item><item><attribute name="label" translatable="yes">_About Adwaita Demo</attribute><attribute name="action">app.about</attribute></item></section></menu><template class="AdwDemoWindow" parent="AdwApplicationWindow"><property name="title" translatable="yes">Adwaita Demo</property><property name="default-width">800</property><property name="default-height">576</property><property name="width-request">360</property><property name="height-request">200</property><child><object class="AdwBreakpoint"><condition>max-width: 500sp</condition><setter object="split-view" property="collapsed">True</setter></object></child><property name="content"><object class="AdwToastOverlay" id="toast-overlay"><property name="child"><object class="AdwNavigationSplitView" id="split-view"><property name="min-sidebar-width">240</property><property name="sidebar"><object class="AdwNavigationPage"><property name="title" bind-source="AdwDemoWindow" bind-property="title" bind-flags="sync-create" /><property name="child"><object class="AdwToolbarView"><child type="top"><object class="AdwHeaderBar"><child type="start"><object class="GtkButton" id="color-scheme-button" /></child><child type="end"><object class="GtkMenuButton"><property name="tooltip-text" translatable="yes">Main Menu</property><property name="menu-model">primary-menu</property><property name="icon-name">open-menu-symbolic</property><property name="primary">True</property></object></child></object></child><property name="content"><object class="GtkStackSidebar"><property name="stack">stack</property></object></property></object></property></object></property><property name="content"><object class="AdwNavigationPage"><property name="title">Bluefox</property><property name="child"><object class="AdwToolbarView"><child type="top"><object class="AdwHeaderBar"><property name="show-title">False</property></object></child><property name="content"><object class="GtkStack" id="stack"><property name="vhomogeneous">False</property><child><object class="GtkStackPage"><property name="title" translatable="yes">Welcome</property><property name="child"><object class="AdwDemoPageWelcome" /></property></object></child><child><object class="GtkStackPage"><property name="title" translatable="yes">Navigation View</property><property name="child"><object class="AdwDemoPageNavigationView" /></property></object></child><child><object class="GtkStackPage"><property name="title" translatable="yes">Style Classes</property><property name="child"><object class="AdwDemoPageStyleClasses" /></property></object></child></object></property></object></property></object></property></object></property></object></property></template></interface>
+<interface><requires version="4.0" lib="gtk" /><requires version="1.0" lib="libadwaita" /><menu id="primary-menu"><section><item><attribute name="label" translatable="yes">_Inspector</attribute><attribute name="action">app.inspector</attribute></item></section><section><item><attribute name="label" translatable="yes">_Preferences</attribute><attribute name="action">app.preferences</attribute></item><item><attribute name="label" translatable="yes">_About Adwaita Demo</attribute><attribute name="action">app.about</attribute></item></section></menu><template class="AdwDemoWindow" parent="AdwApplicationWindow"><property name="title" translatable="yes">Adwaita Demo</property><property name="default-width">800</property><property name="default-height">576</property><property name="width-request">360</property><property name="height-request">200</property><child><object class="AdwBreakpoint"><condition>max-width: 500sp</condition><setter object="split-view" property="collapsed">True</setter></object></child><property name="content"><object class="AdwToastOverlay" id="toast-overlay"><property name="child"><object class="AdwNavigationSplitView" id="split-view"><property name="min-sidebar-width">240</property><property name="sidebar"><object class="AdwNavigationPage"><property name="title" bind-source="AdwDemoWindow" bind-property="title" bind-flags="sync-create" /><property name="child"><object class="AdwToolbarView"><child type="top"><object class="AdwHeaderBar"><child type="start"><object class="GtkButton" id="color-scheme-button" /></child><child type="end"><object class="GtkMenuButton"><property name="tooltip-text" translatable="yes">Main Menu</property><property name="menu-model">primary-menu</property><property name="icon-name">open-menu-symbolic</property><property name="primary">True</property></object></child></object></child><property name="content"><object class="GtkStackSidebar"><property name="stack">stack</property></object></property></object></property></object></property><property name="content"><object class="AdwNavigationPage"><property name="title">Bluefox</property><property name="child"><object class="AdwToolbarView"><child type="top"><object class="AdwHeaderBar"><property name="show-title">False</property></object></child><property name="content"><object class="GtkStack" id="stack"><property name="vhomogeneous">False</property><child><object class="GtkStackPage"><property name="title" translatable="yes">Welcome</property><property name="child"><object class="AdwDemoPageWelcome" /></property></object></child><child><object class="GtkStackPage"><property name="title" translatable="yes">Navigation View</property><property name="child"><object class="AdwDemoPageNavigationView" /></property></object></child><child><object class="GtkStackPage"><property name="title" translatable="yes">Style Classes</property><property name="child"><object class="AdwDemoPageStyleClasses" /></property></object></child><child><object class="GtkStackPage"><property name="title" translatable="yes">Dialogs</property><property name="child"><object class="AdwDemoPageDialogs" /></property></object></child></object></property></object></property></object></property></object></property></object></property></template></interface>
diff --git a/examples/adw-1/adw1-demo/window.scm b/examples/adw-1/adw1-demo/window.scm
index 4a284d0..11226c6 100644
--- a/examples/adw-1/adw1-demo/window.scm
+++ b/examples/adw-1/adw1-demo/window.scm
@@ -34,6 +34,7 @@
   #:use-module (adw1-demo welcome)
   #:use-module (adw1-demo navigation-view)
   #:use-module (adw1-demo style-classes)
+  #:use-module (adw1-demo dialogs)
 
   #:duplicates (merge-generics
 		replace