1 files changed, 64 insertions, 16 deletions

diff --git a/src/scm/webid-oidc/client/gui/application.scm b/src/scm/webid-oidc/client/gui/application.scm
index bfd5f7a..c2ee97d 100644
--- a/src/scm/webid-oidc/client/gui/application.scm
+++ b/src/scm/webid-oidc/client/gui/application.scm
@@ -21,7 +21,6 @@
   #: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 (srfi srfi-9)
@@ -40,11 +39,13 @@
   #: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 application-hooks)
+  #:use-module (webid-oidc client application)
   #:use-module (web uri)
   #:use-module (web response)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
   #:declarative? #t
+  #:duplicates (merge-generics)
   #:export
   (
    application
@@ -56,25 +57,72 @@
 (use-typelibs ("GdkPixbuf" "2.0"))
 
 (use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new))
-              ("Gtk" "3.0"))
+              ("Gtk" "3.0")
+              ("GLib" "2.0"))
+
+(define gi:connect
+  (@ (gi) connect))
+
+(define goops:make
+  (@ (oop goops) make))
+
+(define gi:make
+  (@ (gi) make))
 
 (define application
   (application:new
    "eu.planete_kraus.Disfluid"
    (list->application-flags '(flags-none))))
 
+(define app:client
+  (@ (webid-oidc client application) client))
+
+(define-method (->widget (application <application-state>))
+  (let ((content (box:new (symbol->orientation 'horizontal) 12)))
+    (call-with-values
+        (lambda ()
+          (client:->widget (app:client application)))
+      (lambda (client-builder client)
+        (call-with-values
+            (lambda ()
+              (accounts:->widget application))
+          (lambda (accounts-builder accounts)
+            (call-with-values
+                (lambda ()
+                  (authorizations:->widget application))
+              (lambda (authorizations-builder authorizations)
+                (box:pack-start content client #t #t 0)
+                (box:pack-start content accounts #t #t 0)
+                (box:pack-start content authorizations #t #t 0)
+                (values
+                 `(,client-builder ,accounts-builder ,authorizations-builder)
+                 content)))))))))
+
+(define main-window #f)
+
+(define current-state #f)
+(define current-state-widget #f)
+(define additional-gc-roots '())
+
+(define-method (set-state! (state <application-state>))
+  (when (and main-window current-state-widget)
+    (remove main-window current-state-widget))
+  (set! current-state state)
+  (call-with-values
+      (lambda ()
+        (->widget state))
+    (lambda (roots widget)
+      (set! current-state-widget widget)
+      (set! additional-gc-roots roots)))
+  (when main-window
+    (add main-window current-state-widget)
+    (show-all main-window)))
+
 (define (on-activate application)
-  (run-hook application-activated-hook application)
-  (let ((window (make <GtkApplicationWindow>
-                  #:application application))
-        (client client:client-widget)
-        (accounts accounts:accounts-widget)
-        (authorizations authorizations:authorizations-widget)
-        (content (box:new (symbol->orientation 'horizontal) 12)))
-    (box:pack-end content client #t #t 0)
-    (box:pack-end content accounts #t #t 0)
-    (box:pack-end content authorizations #t #t 0)
-    (add window content)
-    (show-all window)))
-
-(connect application activate on-activate)
+  (set! main-window
+    (gi:make <GtkApplicationWindow>
+      #:application application))
+  (add-hook! application-state-changed-hook set-state! #t)
+  (run-hook application-activated-hook application))
+
+(gi:connect application activate on-activate)