diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-05 11:25:18 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-07 12:34:19 +0200 |
commit | 381a7d0399434aa277aa86a30e742ee215f2576a (patch) | |
tree | 561589e60e93420aa831eb180c378f0e0ec4170b /src/scm/webid-oidc/client/gui/application.scm | |
parent | dd18ea62055a95733db6c7bc507e01783e526858 (diff) |
gui: use the application API
Diffstat (limited to 'src/scm/webid-oidc/client/gui/application.scm')
-rw-r--r-- | src/scm/webid-oidc/client/gui/application.scm | 80 |
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) |