From 381a7d0399434aa277aa86a30e742ee215f2576a Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Tue, 5 Oct 2021 11:25:18 +0200 Subject: gui: use the application API --- src/scm/webid-oidc/client/gui/client-widget.scm | 113 ++++++++---------------- 1 file changed, 37 insertions(+), 76 deletions(-) (limited to 'src/scm/webid-oidc/client/gui/client-widget.scm') diff --git a/src/scm/webid-oidc/client/gui/client-widget.scm b/src/scm/webid-oidc/client/gui/client-widget.scm index 792b8f8..b4b58aa 100644 --- a/src/scm/webid-oidc/client/gui/client-widget.scm +++ b/src/scm/webid-oidc/client/gui/client-widget.scm @@ -37,6 +37,7 @@ #:use-module ((webid-oidc config) #:prefix config:) #:use-module (webid-oidc client) #:use-module (webid-oidc client accounts) + #:use-module (webid-oidc client application) #:use-module ((webid-oidc client gui settings) #:prefix settings:) #:use-module (webid-oidc client gui application-hooks) #:use-module (web uri) @@ -46,7 +47,7 @@ #:duplicates (merge-generics) #:export ( - client-widget + ->widget )) (push-duplicate-handler! 'merge-generics) @@ -55,16 +56,12 @@ (use-typelibs ("GdkPixbuf" "2.0") ("Gtk" "3.0")) -(define builder #f) -(define client-widget #f) - -(define (build-client-widget app) - (unless client-widget - (set! builder - (builder:new-from-file (string-append config:uidir "/client-widget.glade"))) - (set! client-widget - (builder:get-object builder "client_widget")) - (let ((client-id-entry +(define-method (->widget (client )) + (let ((builder + (builder:new-from-file (string-append config:uidir "/client-widget.glade")))) + (let ((whole-widget + (builder:get-object builder "client_widget")) + (client-id-entry (builder:get-object builder "client_id_entry")) (redirect-uri-entry (builder:get-object builder "redirect_uri_entry")) @@ -76,72 +73,36 @@ (builder:get-object builder "undo_button")) (update-button (builder:get-object builder "update_button"))) - (define (current-edition) - ;; Return the client based on the edited fields - (let/ec return - (with-exception-handler - (lambda (exn) - ((@ (ice-9 format) format) - (current-error-port) - (G_ "The client cannot be constructed: ~a\n") - (if (exception-with-message? exn) - (exception-message exn) - exn)) - (return #f)) - (lambda () - ((@ (oop goops) make) - #:client-id (entry:get-text client-id-entry) - #:redirect-uri (entry:get-text redirect-uri-entry) - #:key-pair - (jwk:jwk->key (stubs:json-string->scm (entry:get-text key-pair-entry)))))))) - (define (on-entry-changed . _) - (let ((current-client (settings:client)) - (edited (current-edition))) - (receive (can-undo? can-update?) - (cond - ((and edited (equal? edited current-client)) - ;; The undo button is disabled and the update button too - (values #f #f)) - (edited - ;; We have changed something and it’s valid - (values #t #t)) - (else - ;; We have changed something, but it’s invalid - (values #t #f))) - (widget:set-sensitive undo-button can-undo?) - (widget:set-sensitive update-button can-update?)))) - (define (set-client client) + (define (undo) (entry:set-text client-id-entry (uri->string (client-id client))) (entry:set-text redirect-uri-entry (uri->string (redirect-uri client))) (entry:set-text key-pair-entry (stubs:scm->json-string - (jwk:key->jwk (key-pair client)))) - (on-entry-changed)) - ((@ (gi) connect) client-id-entry activate on-entry-changed) - ((@ (gi) connect) redirect-uri-entry activate on-entry-changed) - ((@ (gi) connect) key-pair-entry activate on-entry-changed) - ((@ (gi) connect) - generate-key-pair-button clicked - (lambda _ - (entry:set-text key-pair-entry - (stubs:scm->json-string - (jwk:key->jwk - (jwk:generate-key #:n-size 2048)))) - (on-entry-changed))) - ((@ (gi) connect) undo-button clicked - (lambda _ - (set-client (settings:client)) - (on-entry-changed))) - ((@ (gi) connect) update-button clicked - (lambda _ - (settings:client (current-edition)) - (widget:set-sensitive undo-button #f) - (widget:set-sensitive update-button #f))) - (set-client (settings:client)) - (add-hook! settings:client-changed-hook - (lambda (c) - (unless (widget:get-sensitive? undo-button) - ;; If we were doing an edition, ignore - (set-client c))))))) - -(add-hook! application-activated-hook build-client-widget) + (jwk:key->jwk (key-pair client))))) + (define (disable) + (widget:set-sensitive client-id-entry #f) + (widget:set-sensitive redirect-uri-entry #f) + (widget:set-sensitive key-pair-entry #f) + (widget:set-sensitive generate-key-pair-button #f) + (widget:set-sensitive undo-button #f) + (widget:set-sensitive update-button #f)) + (undo) + (connect generate-key-pair-button clicked + (lambda _ + (entry:set-text key-pair-entry + (stubs:scm->json-string + (jwk:key->jwk (jwk:generate-key #:n-size 2048)))))) + (connect undo-button clicked (lambda _ (undo))) + (connect update-button clicked + (lambda _ + (disable) + (let ((new-client (make + #:client-id (entry:get-text client-id-entry) + #:redirect-uri (entry:get-text redirect-uri-entry) + #:key-pair + (jwk:jwk->key + (stubs:json-string->scm + (entry:get-text key-pair-entry)))))) + (settings:application-state + (set-client (settings:application-state) new-client))))) + (values builder whole-widget)))) -- cgit v1.2.3