;; 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 account-widget) #: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 (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 web-i18n) #:use-module (webid-oidc client client) #:use-module (webid-oidc client accounts) #: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 ( make-account-widget )) (push-duplicate-handler! 'merge-generics) ;; This avoids a crash when compiling the module (use-typelibs ("GdkPixbuf" "2.0") ("Gtk" "3.0")) ;; The created account does not handle signals. (define (make-account-widget account) ;; Return many values: ;; - the builder ;; - the whole widget ;; - the discard button ;; - the use button (if account (let ((builder (builder:new-from-file (string-append config:uidir "/account-widget.glade")))) (let ((whole-widget (builder:get-object builder "account_widget")) (webid (builder:get-object builder "webid")) (issuer (builder:get-object builder "issuer")) (discard-button (builder:get-object builder "discard_button")) (use-button (builder:get-object builder "use_button"))) (link-button:set-uri webid (uri->string (subject account))) (link-button:set-uri issuer (uri->string (issuer account))) (button:set-label webid (uri->string (subject account))) (button:set-label issuer (uri->string (issuer account))) (values builder whole-widget discard-button use-button))) (values #f (label:new (G_ "You don’t have set up an account yet.")) #f #f)))