;; 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 . (define-module (webid-oidc client gui application) #: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 optargs) #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) #: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:) #:use-module ((webid-oidc dpop-proof) #:prefix dpop:) #:use-module (webid-oidc client) #:use-module (webid-oidc client accounts) #:use-module ((webid-oidc client gui settings) #:prefix settings:) #: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 loading-page) #:prefix page:) #:use-module ((webid-oidc client gui error-page) #:prefix page:) #:use-module ((webid-oidc client gui loaded-page) #:prefix page:) #:use-module ((webid-oidc client gui updated-page) #:prefix page:) #: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 ( (the-application . application) )) (push-duplicate-handler! 'merge-generics) ;; This avoids a crash when compiling the module (use-typelibs ("GdkPixbuf" "2.0")) (use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new)) ("Gtk" "3.0") ("GLib" "2.0") ("Handy" "1")) (define gi:connect (@ (gi) connect)) (define goops:make (@ (oop goops) make)) (define gi:make (@ (gi) make)) (define the-application (application:new "eu.planete_kraus.Disfluid" (list->application-flags '(flags-none)))) (define app:client (@ (webid-oidc client application) client)) (define window-builder #f) (define main-window #f) (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-method (page:->widget (page )) (values #f (label:new (G_ "Coming soon!")))) (define (set-state! application) (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) (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))) (define (on-activate app) (set! window-builder (builder:new-from-file (string-append config:uidir "/main-window.glade"))) (set! main-window (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 #: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 ))))))) (add-hook! application-state-changed-hook set-state! #t) (run-hook application-activated-hook the-application) (show-all main-window)) (gi:connect the-application activate on-activate)