gui: use libhandy

1 files changed, 82 insertions, 43 deletions

diff --git a/src/scm/webid-oidc/client/gui/application.scm b/src/scm/webid-oidc/client/gui/application.scm
index c2ee97d..ff7dce9 100644
--- a/src/scm/webid-oidc/client/gui/application.scm
+++ b/src/scm/webid-oidc/client/gui/application.scm
@@ -28,6 +28,7 @@
   #:use-module (webid-oidc errors)
   #:use-module (webid-oidc web-i18n)
   #:use-module ((webid-oidc parameters) #:prefix p:)
+  #:use-module ((webid-oidc config) #:prefix config:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
   #:use-module ((webid-oidc jwk) #:prefix jwk:)
@@ -48,7 +49,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   application
+   (the-application . application)
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -58,7 +59,8 @@
 
 (use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new))
               ("Gtk" "3.0")
-              ("GLib" "2.0"))
+              ("GLib" "2.0")
+              ("Handy" "1"))
 
 (define gi:connect
   (@ (gi) connect))
@@ -69,7 +71,7 @@
 (define gi:make
   (@ (gi) make))
 
-(define application
+(define the-application
   (application:new
    "eu.planete_kraus.Disfluid"
    (list->application-flags '(flags-none))))
@@ -77,52 +79,89 @@
 (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 window-builder #f)
 (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)
+(define explorer-container #f)
+(define authorizations-container #f)
+(define accounts-container #f)
+(define settings-container #f)
+
+(define content-builder #f)
+(define explorer-widget #f)
+(define authorizations-widget #f)
+(define accounts-widget #f)
+(define settings-widget #f)
+
+(define (set-state! application)
   (call-with-values
       (lambda ()
-        (->widget state))
-    (lambda (roots widget)
-      (set! current-state-widget widget)
-      (set! additional-gc-roots roots)))
+        (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)
+              (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))))))))
   (when main-window
-    (add main-window current-state-widget)
     (show-all main-window)))
 
-(define (on-activate application)
+(define (on-activate app)
+  (set! window-builder
+    (builder:new-from-file (string-append config:uidir "/main-window.glade")))
   (set! main-window
-    (gi:make <GtkApplicationWindow>
-      #:application application))
+    (builder:get-object window-builder "main_window"))
+  (set-object-property! main-window application app)
+  (add-window app main-window)
+  (set! explorer-container
+    (builder:get-object window-builder "explorer_container"))
+  (set! authorizations-container
+    (builder:get-object window-builder "authorizations_container"))
+  (set! accounts-container
+    (builder:get-object window-builder "accounts_container"))
+  (set! settings-container
+    (builder:get-object window-builder "settings_container"))
+  (let ((squeezer
+         (builder:get-object window-builder "squeezer"))
+        (headerbar-switcher
+         (builder:get-object window-builder "headerbar_switcher"))
+        (bottom-switcher
+         (builder:get-object window-builder "bottom_switcher"))
+        (notify
+         (gi:make <signal>
+                  #:name "notify"
+                  #:param-types (list G_TYPE_OBJECT))))
+    (gi:connect squeezer notify
+                (lambda _
+                  (let ((child (get-visible-child squeezer)))
+                    (set-reveal bottom-switcher
+                                (not (is-a? child <HdyViewSwitcher>)))))))
   (add-hook! application-state-changed-hook set-state! #t)
-  (run-hook application-activated-hook application))
+  (run-hook application-activated-hook the-application)
+  (show-all main-window))
 
-(gi:connect application activate on-activate)
+(gi:connect the-application activate on-activate)