gui: use the application API

1 files changed, 37 insertions, 76 deletions

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 <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>
-                #: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>
+                                     #: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))))