gui: wire the widget for new page.

6 files changed, 110 insertions, 26 deletions

diff --git a/po/POTFILES.in b/po/POTFILES.in
index a55dcd4..3da1412 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -47,6 +47,7 @@ src/scm/webid-oidc/client/gui/authorization-prompt.scm
 src/scm/webid-oidc/client/gui/authorizations-widget.scm
 src/scm/webid-oidc/client/gui/client-widget.scm
 src/scm/webid-oidc/client/gui/clock.scm
+src/scm/webid-oidc/client/gui/new-page.scm
 src/scm/webid-oidc/client/gui/settings.scm
 src/scm/webid-oidc/dpop-proof.scm
 src/scm/webid-oidc/errors.scm
diff --git a/po/disfluid.pot b/po/disfluid.pot
index 274f6b3..df0e8cb 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -665,7 +665,7 @@ msgstr ""
 msgid "Please add an account."
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui/application.scm:116
+#: src/scm/webid-oidc/client/gui/application.scm:97
 msgid "Coming soon!"
 msgstr ""
 
diff --git a/po/fr.po b/po/fr.po
index 1ea4749..6ae4ccf 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -718,7 +718,7 @@ msgstr "Bouchon : veuillez entrer une URI ou un nom d’hôte…\n"
 msgid "Please add an account."
 msgstr "Veuillez ajouter un compte."
 
-#: src/scm/webid-oidc/client/gui/application.scm:116
+#: src/scm/webid-oidc/client/gui/application.scm:97
 msgid "Coming soon!"
 msgstr "C’est pour bientôt !"
 
diff --git a/src/scm/webid-oidc/client/gui/Makefile.am b/src/scm/webid-oidc/client/gui/Makefile.am
index fc8f751..6969777 100644
--- a/src/scm/webid-oidc/client/gui/Makefile.am
+++ b/src/scm/webid-oidc/client/gui/Makefile.am
@@ -24,7 +24,8 @@ dist_guiclientwebidoidcmod_DATA += \
   %reldir%/application.scm \
   %reldir%/authorization-prompt.scm \
   %reldir%/clock.scm \
-  %reldir%/authorizations-widget.scm
+  %reldir%/authorizations-widget.scm \
+  %reldir%/new-page.scm
 
 guiclientwebidoidcgo_DATA += \
   %reldir%/settings.go \
@@ -36,4 +37,5 @@ guiclientwebidoidcgo_DATA += \
   %reldir%/application.go \
   %reldir%/authorization-prompt.go \
   %reldir%/authorizations-widget.go \
-  %reldir%/clock.go
+  %reldir%/clock.go \
+  %reldir%/new-page.go
diff --git a/src/scm/webid-oidc/client/gui/application.scm b/src/scm/webid-oidc/client/gui/application.scm
index ff7dce9..6711d41 100644
--- a/src/scm/webid-oidc/client/gui/application.scm
+++ b/src/scm/webid-oidc/client/gui/application.scm
@@ -39,6 +39,7 @@
   #:use-module ((webid-oidc client gui client-widget) #:prefix client:)
   #:use-module ((webid-oidc client gui accounts-widget) #:prefix accounts:)
   #:use-module ((webid-oidc client gui authorizations-widget) #:prefix authorizations:)
+  #:use-module ((webid-oidc client gui new-page) #:prefix page:)
   #:use-module (webid-oidc client gui application-hooks)
   #:use-module (webid-oidc client application)
   #:use-module (web uri)
@@ -92,6 +93,9 @@
 (define accounts-widget #f)
 (define settings-widget #f)
 
+(define-method (page:->widget (page <page>))
+  (values #f (label:new (G_ "Coming soon!"))))
+
 (define (set-state! application)
   (call-with-values
       (lambda ()
@@ -105,28 +109,32 @@
               (lambda ()
                 (authorizations:->widget application))
             (lambda (authorizations-builder authorizations)
-              (when (and explorer-container explorer-widget)
-                (container:remove explorer-container explorer-widget))
-              (when (and authorizations-container authorizations-widget)
-                (container:remove authorizations-container authorizations-widget))
-              (when (and accounts-container accounts-widget)
-                (container:remove accounts-container accounts-widget))
-              (when (and settings-container settings-widget)
-                (container:remove settings-container settings-widget))
-              (set! explorer-widget (label:new (G_ "Coming soon!")))
-              (set! authorizations-widget authorizations)
-              (set! accounts-widget accounts)
-              (set! settings-widget client)
-              (when explorer-container
-                (box:pack-end explorer-container explorer-widget #t #t 0))
-              (when authorizations-container
-                (box:pack-end authorizations-container authorizations-widget #t #t 0))
-              (when accounts-container
-                (box:pack-end accounts-container accounts-widget #t #t 0))
-              (when settings-container
-                (box:pack-end settings-container settings-widget #t #t 0))
-              (set! content-builder
-                `(,client-builder ,accounts-builder ,authorizations-builder))))))))
+              (call-with-values
+                  (lambda ()
+                    (page:->widget (page application)))
+                (lambda (page-builder page)
+                  (when (and explorer-container explorer-widget)
+                    (container:remove explorer-container explorer-widget))
+                  (when (and authorizations-container authorizations-widget)
+                    (container:remove authorizations-container authorizations-widget))
+                  (when (and accounts-container accounts-widget)
+                    (container:remove accounts-container accounts-widget))
+                  (when (and settings-container settings-widget)
+                    (container:remove settings-container settings-widget))
+                  (set! explorer-widget page)
+                  (set! authorizations-widget authorizations)
+                  (set! accounts-widget accounts)
+                  (set! settings-widget client)
+                  (when explorer-container
+                    (box:pack-end explorer-container explorer-widget #t #t 0))
+                  (when authorizations-container
+                    (box:pack-end authorizations-container authorizations-widget #t #t 0))
+                  (when accounts-container
+                    (box:pack-end accounts-container accounts-widget #t #t 0))
+                  (when settings-container
+                    (box:pack-end settings-container settings-widget #t #t 0))
+                  (set! content-builder
+                        `(,client-builder ,accounts-builder ,authorizations-builder ,page-builder))))))))))
   (when main-window
     (show-all main-window)))
 
diff --git a/src/scm/webid-oidc/client/gui/new-page.scm b/src/scm/webid-oidc/client/gui/new-page.scm
new file mode 100644
index 0000000..9b4c094
--- /dev/null
+++ b/src/scm/webid-oidc/client/gui/new-page.scm
@@ -0,0 +1,73 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (webid-oidc client gui new-page)
+  #:use-module (gi)
+  #:use-module (gi types)
+  #:use-module (gi util)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 i18n)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 atomic)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (webid-oidc errors)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc config) #:prefix config:)
+  #:use-module (webid-oidc web-i18n)
+  #:use-module (webid-oidc client client)
+  #:use-module (webid-oidc client accounts)
+  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
+  #:use-module ((webid-oidc client gui clock) #:prefix clock:)
+  #:use-module (webid-oidc client gui application-hooks)
+  #:use-module (webid-oidc client application)
+  #:use-module (webid-oidc jwk)
+  #:use-module (webid-oidc oidc-id-token)
+  #:use-module (web uri)
+  #:use-module (web response)
+  #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
+  #:declarative? #t
+  #:duplicates (merge-generics)
+  #:export
+  (
+   ->widget
+   ))
+
+(push-duplicate-handler! 'merge-generics)
+
+;; This avoids a crash when compiling the module
+(use-typelibs ("GdkPixbuf" "2.0")
+              ("Gtk" "3.0"))
+
+(define-method (->widget (page <new-page>))
+  (let ((builder
+         (builder:new-from-file
+          (string-append config:uidir "/new-page.glade"))))
+    (let ((main-widget
+           (builder:get-object builder "new_page"))
+          (uri-entry
+           (builder:get-object builder "uri_entry")))
+      (connect uri-entry activate
+               (lambda _
+                 (settings:application-state
+                  (set-page-uri (settings:application-state)
+                                (entry:get-text uri-entry)))))
+      (values builder main-widget))))