gui: use the application API

10 files changed, 313 insertions, 387 deletions

diff --git a/src/scm/webid-oidc/client/gui/account-widget.scm b/src/scm/webid-oidc/client/gui/account-widget.scm
index f92e271..4449049 100644
--- a/src/scm/webid-oidc/client/gui/account-widget.scm
+++ b/src/scm/webid-oidc/client/gui/account-widget.scm
@@ -29,11 +29,14 @@
   #:use-module (srfi srfi-26)
   #:use-module (webid-oidc errors)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc config) #:prefix config:)
+  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #: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 (webid-oidc client application)
   #:use-module (web uri)
   #:use-module (web response)
   #:use-module (rnrs bytevectors)
@@ -42,7 +45,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   make-account-widget
+   ->widget
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -53,29 +56,36 @@
 
 ;; 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)))
+(define-method (->widget (account <account>) (can-use? <boolean>))
+  (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-link
+           (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-link (uri->string (issuer account)))
+      (button:set-label webid (uri->string (subject account)))
+      (button:set-label issuer-link (uri->string (issuer account)))
+      (unless can-use?
+        (widget:set-sensitive use-button #f))
+      (connect discard-button clicked
+               (lambda _
+                 (widget:set-sensitive use-button #f)
+                 (widget:set-sensitive discard-button #f)
+                 (settings:application-state
+                  (remove-account (settings:application-state) account))))
+      (connect use-button clicked
+               (lambda _
+                 (widget:set-sensitive use-button #f)
+                 (widget:set-sensitive discard-button #f)
+                 (settings:application-state
+                  (choose-account (settings:application-state) account))))
+      (values builder whole-widget))))
diff --git a/src/scm/webid-oidc/client/gui/accounts-widget-logic.scm b/src/scm/webid-oidc/client/gui/accounts-widget-logic.scm
index 2ea9024..8121b10 100644
--- a/src/scm/webid-oidc/client/gui/accounts-widget-logic.scm
+++ b/src/scm/webid-oidc/client/gui/accounts-widget-logic.scm
@@ -33,6 +33,7 @@
   #:use-module (webid-oidc offloading)
   #:use-module (webid-oidc client client)
   #:use-module (webid-oidc client accounts)
+  #:use-module (webid-oidc client application)
   #:use-module (webid-oidc client gui account-widget)
   #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #:use-module ((webid-oidc client gui clock) #:prefix clock:)
@@ -59,17 +60,7 @@
     ((or (? string? (= string->uri (? uri? uri)))
          (? string? (= as-host-name (? uri? uri))))
      (clear-issuer-entry!)
-     (use-authorizations-widget
-      (lambda ()
-        (let ((new-account
-               (make <account>
-                 #:issuer uri)))
-          (clock:wait
-           (lambda ()
-             (let ((old (settings:main-account))
-                   (other (settings:other-accounts)))
-               (if old
-                   (settings:other-accounts `(,new-account ,@other))
-                   (settings:main-account new-account)))))))))
+     (settings:application-state
+      (add-account (settings:application-state) uri)))
     (else
      (format (current-error-port) (G_ "Stub: please enter an URI or a host name...\n")))))
diff --git a/src/scm/webid-oidc/client/gui/accounts-widget.scm b/src/scm/webid-oidc/client/gui/accounts-widget.scm
index b9e5403..be95960 100644
--- a/src/scm/webid-oidc/client/gui/accounts-widget.scm
+++ b/src/scm/webid-oidc/client/gui/accounts-widget.scm
@@ -38,6 +38,7 @@
   #:use-module (webid-oidc client gui application-hooks)
   #:use-module (webid-oidc client gui authorizations-widget)
   #:use-module (webid-oidc client gui accounts-widget-logic)
+  #:use-module (webid-oidc client application)
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (web uri)
@@ -48,7 +49,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   accounts-widget
+   ->widget
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -57,88 +58,50 @@
 (use-typelibs ("GdkPixbuf" "2.0")
               ("Gtk" "3.0"))
 
-(define builder #f)
-(define accounts-widget #f)
+(define srfi-1:map (@ (srfi srfi-1) map))
 
-(define current-main-child '())
-(define current-other-children '())
+(define account:->widget
+  (@ (webid-oidc client gui account-widget) ->widget))
 
-(define (build-accounts-widget app)
-  (unless accounts-widget
-    (set! builder
-          (builder:new-from-file (string-append config:uidir "/accounts-widget.glade")))
-    (set! accounts-widget
-          (builder:get-object builder "accounts_widget"))
-    (let ((main-account-box
+(define-method (->widget (application <application-state>))
+  (let ((builder
+         (builder:new-from-file (string-append config:uidir "/accounts-widget.glade"))))
+    (let ((accounts-widget
+           (builder:get-object builder "accounts_widget"))
+          (main-account-box
            (builder:get-object builder "main_account_box"))
           (other-accounts-box
            (builder:get-object builder "other_accounts_box"))
           (identity-provider-entry
            (builder:get-object builder "identity_provider_entry"))
           (add-account-button
-           (builder:get-object builder "add_account_button")))
-      (define (set-accounts main other)
-        (for-each
-         (match-lambda
-           ((_ widget)
-            (container:remove main-account-box widget)))
-         current-main-child)
-        (set! current-main-child '())
-        (for-each
-         (match-lambda
-           ((_ widget)
-            (container:remove other-accounts-box widget)))
-         current-other-children)
-        (set! current-other-children '())
-        (receive (main-builder main-widget discard-button use-button)
-            (make-account-widget main)
-          (set! current-main-child
-                `((,main-builder ,main-widget)))
-          (when discard-button
-            ((@ (gi) connect) discard-button clicked
-             (lambda _
-               (match other
-                 ((new-main new-other ...)
-                  (settings:main-account new-main)
-                  (settings:other-accounts new-other))
-                 (()
-                  (settings:main-account #f))))))
-          (when use-button
-            (widget:set-sensitive use-button #f))
-          (box:pack-end main-account-box main-widget #t #t 0))
-        (for-each
-         (lambda (other-account)
-           (let ((not-represented (filter (lambda (a) (not (eq? a other-account)))
-                                          other)))
-             ;; We’re packing a widget for other-account, and if the
-             ;; discard button is clicked, replace the list of other
-             ;; accounts with not-represented.
-             (receive (builder widget discard-button use-button)
-                 (make-account-widget other-account)
-               (set! current-other-children
-                     `((,builder ,widget) ,@current-other-children))
-               ((@ (gi) connect) discard-button clicked
-                (lambda _
-                  (settings:other-accounts not-represented)))
-               ((@ (gi) connect) use-button clicked
-                (lambda _
-                  (settings:main-account other-account)
-                  (settings:other-accounts `(,main ,@not-represented))))
-               (box:pack-end main-account-box widget #t #t 0))))
-         other)
-        ((@ (gi) connect) add-account-button clicked
-         (lambda _
-           ((@ (webid-oidc client gui accounts-widget-logic) add-account-button-clicked)
-            (entry:get-text identity-provider-entry)
-            (lambda ()
-              (entry:set-text identity-provider-entry "")))))
-        ((@ (gi) connect) identity-provider-entry activate
-         (lambda _
-           ((@ (webid-oidc client gui accounts-widget-logic) add-account-button-clicked)
-            (entry:get-text identity-provider-entry)
-            (lambda ()
-              (entry:set-text identity-provider-entry ""))))))
-      (set-accounts (settings:main-account) (settings:other-accounts))
-      (add-hook! settings:accounts-changed-hook set-accounts))))
-
-(add-hook! application-activated-hook build-accounts-widget)
+           (builder:get-object builder "add_account_button"))
+          (builders (list builder)))
+      (let ((main-widget
+             (let ((acct (main-account application)))
+               (if acct
+                   (receive (additional-builder widget)
+                       (account:->widget acct #f)
+                     (set! builders `(,additional-builder ,@builders))
+                     widget)
+                   (label:new (G_ "Please add an account.")))))
+            (other-widgets
+             (srfi-1:map
+              (lambda (account)
+                (receive (additional-builder widget)
+                    (account:->widget account #t)
+                  (set! builders `(,additional-builder ,@builders))
+                  widget))
+              (other-accounts application))))
+        (define (add-account-activated . _)
+          (add-account-button-clicked
+           (entry:get-text identity-provider-entry)
+           (lambda ()
+             (widget:set-sensitive identity-provider-entry #f)
+             (widget:set-sensitive add-account-button #f))))
+        (box:pack-end main-account-box main-widget #t #t 0)
+        (for-each (cute box:pack-end other-accounts-box <> #t #t 0)
+                  other-widgets)
+        (connect identity-provider-entry activate add-account-activated)
+        (connect add-account-button clicked add-account-activated)
+        (values builder accounts-widget)))))
diff --git a/src/scm/webid-oidc/client/gui/application-hooks.scm b/src/scm/webid-oidc/client/gui/application-hooks.scm
index 0d51599..5aca298 100644
--- a/src/scm/webid-oidc/client/gui/application-hooks.scm
+++ b/src/scm/webid-oidc/client/gui/application-hooks.scm
@@ -40,7 +40,11 @@
   #:export
   (
    application-activated-hook
+   application-state-changed-hook
    ))
 
 (define application-activated-hook
   (make-hook 1))
+
+(define application-state-changed-hook
+  (make-hook 1))
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)
diff --git a/src/scm/webid-oidc/client/gui/authorization-prompt.scm b/src/scm/webid-oidc/client/gui/authorization-prompt.scm
index 8e9ab81..cd32489 100644
--- a/src/scm/webid-oidc/client/gui/authorization-prompt.scm
+++ b/src/scm/webid-oidc/client/gui/authorization-prompt.scm
@@ -33,6 +33,8 @@
   #:use-module ((webid-oidc config) #:prefix config:)
   #:use-module (webid-oidc client 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 jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (web uri)
@@ -43,7 +45,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   make-authorization-prompt
+   ->widget
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -52,11 +54,10 @@
 (use-typelibs ("GdkPixbuf" "2.0")
               ("Gtk" "3.0"))
 
-(define (make-authorization-prompt uri)
-  ;; Return 3 values:
-  ;; - the builder
-  ;; - the whole widget
-  ;; - a 2-value function (reason, continuation) to add a handler
+(define format:format
+  (@ (ice-9 format) format))
+
+(define-method (->widget (prompt <authorization-prompt>))
   (let ((builder
          (builder:new-from-file
           (string-append config:uidir "/authorization-prompt.glade"))))
@@ -69,26 +70,27 @@
           (entry
            (builder:get-object builder "authorization_code_entry"))
           (ok
-           (builder:get-object builder "ok_button"))
-          (reasons '())
-          (handlers '()))
-      (let ((handle (lambda (reason continuation)
-                      (label:set-text reason-label
-                                      ((@ (ice-9 format) format) #f
-                                       (G_ "Your authorization is required: ~a")
-                                       (if (null? reasons)
-                                           reason
-                                           (format #f (G_ "~a, and ~a")
-                                                   (string-join (reverse reasons) ", ")
-                                                   reason))))
-                      (set! reasons `(,reason ,@reasons))
-                      (set! handlers `(,continuation ,@handlers)))))
-        (link-button:set-uri link-button (uri->string uri))
-        ((@ (gi) connect) entry activate
-         (lambda _
-           (button:clicked ok)))
-        ((@ (gi) connect) ok clicked
-         (lambda _
-           (let ((code (entry:get-text entry)))
-             ((@ (srfi srfi-1) for-each) (cute <> code) (reverse handlers)))))
-        (values builder whole-widget handle)))))
+           (builder:get-object builder "ok_button")))
+      (label:set-text reason-label
+                      (format:format #f (G_ "Your authorization is required: ~a")
+                                     (reason prompt)))
+      (link-button:set-uri link-button (uri->string (authorization-uri prompt)))
+      ((@ (gi) connect) entry activate
+       (lambda _
+         (button:clicked ok)))
+      ((@ (gi) connect) ok clicked
+       (lambda _
+         (let ((code (entry:get-text entry)))
+           (widget:set-sensitive entry #f)
+           (widget:set-sensitive ok #f)
+           (receive (_ new-state)
+               (fold-authorization-prompts
+                (settings:application-state)
+                (match-lambda*
+                  ((_ p)
+                   (values #t
+                           (and (equal? p (authorization-uri prompt))
+                                code))))
+                #t)
+             (settings:application-state new-state)))))
+      (values builder whole-widget))))
diff --git a/src/scm/webid-oidc/client/gui/authorizations-widget.scm b/src/scm/webid-oidc/client/gui/authorizations-widget.scm
index ba76185..cfe5a7f 100644
--- a/src/scm/webid-oidc/client/gui/authorizations-widget.scm
+++ b/src/scm/webid-oidc/client/gui/authorizations-widget.scm
@@ -38,6 +38,7 @@
   #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #:use-module ((webid-oidc client gui clock) #:prefix clock:)
   #:use-module (webid-oidc client gui application-hooks)
+  #:use-module (webid-oidc client application)
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (web uri)
@@ -48,8 +49,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   authorizations-widget
-   use-authorizations-widget
+   ->widget
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -58,93 +58,16 @@
 (use-typelibs ("GdkPixbuf" "2.0")
               ("Gtk" "3.0"))
 
-(define authorizations-widget #f)
-(define by-uri (make-hash-table))
+(define prompt:->widget
+  (@ (webid-oidc client gui authorization-prompt) ->widget))
 
-(define authorizations-widget #f)
-
-;; Since authorizations may be requested by any threads, they are
-;; collected here and a timer updates the GUI every so often.
-(define pending-authorizations
-  (make-atomic-box '()))
-
-(define (update-ui)
-  (let ((authz (atomic-box-ref pending-authorizations)))
-    (let ((confirmed (atomic-box-compare-and-swap! pending-authorizations authz '())))
-      (if (eq? authz confirmed)
-          (let add-authorization ((authz authz))
-            (match authz
-              (() ;; done
-               #t)
-              (((reason uri continuation) authz ...)
-               (let ((value (uri->string uri)))
-                 (match (or (hash-ref by-uri value)
-                            (receive (builder widget handle)
-                                ((@ (webid-oidc client gui authorization-prompt)
-                                    make-authorization-prompt) uri)
-                              (let ((ret `(,builder ,widget ,handle)))
-                                (hash-set! by-uri value ret)
-                                (box:pack-start authorizations-widget widget #t #t 0)
-                                ret)))
-                   ((_ widget handle)
-                    ;; Put it on top
-                    (container:remove authorizations-widget widget)
-                    (box:pack-start authorizations-widget widget #t #t 0)
-                    ;; Add (reason, continuation) to the
-                    ;; existing or created widget
-                    (handle reason
-                            (lambda (code)
-                              ;; When the button is
-                              ;; clicked, first remove
-                              ;; the widget if it still
-                              ;; exists
-                              (when (hash-ref by-uri value)
-                                (hash-remove! by-uri value)
-                                (container:remove authorizations-widget widget))
-                              ((@ (ice-9 threads) call-with-new-thread)
-                               (lambda ()
-                                 ;; In case the
-                                 ;; continuation expects
-                                 ;; further authorizations:
-                                 (use-authorizations-widget
-                                  (lambda ()
-                                    (continuation code)))))))))))))
-          ;; Else, retry
-          (update-ui)))))
-
-(define (use-authorizations-widget f)
-  (let ((prompt (make-prompt-tag)))
-    (call-with-prompt prompt
-      (lambda ()
-        (parameterize
-            ((authorization-process
-              (lambda* (uri #:key reason)
-                (abort-to-prompt
-                 prompt
-                 (lambda (continuation)
-                   (let save ((other (atomic-box-ref pending-authorizations)))
-                     (let ((confirmed
-                            (atomic-box-compare-and-swap!
-                             pending-authorizations
-                             other
-                             `((,reason ,uri ,continuation) ,@other))))
-                       (unless (eq? confirmed other)
-                         (save (atomic-box-ref pending-authorizations))))))))))
-          (f)))
-      (lambda (continuation handler)
-        (handler continuation)))))
-
-(define (update-ui-next)
-  (update-ui)
-  (clock:wait
-   (lambda ()
-     (update-ui-next))))
-
-(define (build-widget app)
-  (unless authorizations-widget
-    (set! authorizations-widget (box:new (symbol->orientation 'vertical) 8))
-    (clock:wait
-     (lambda ()
-       (update-ui-next)))))
-
-(add-hook! application-activated-hook build-widget)
+(define-method (->widget (application <application-state>))
+  (let ((builders '())
+        (box (box:new (symbol->orientation 'vertical) 8)))
+    (for-each
+     (lambda (prompt)
+       (receive (builder widget) (prompt:->widget prompt)
+         (set! builders `(,builder ,@builders))
+         (box:pack-start box widget #t #t 0)))
+     (authorization-prompts application))
+    (values builders box)))
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))))
diff --git a/src/scm/webid-oidc/client/gui/clock.scm b/src/scm/webid-oidc/client/gui/clock.scm
index efb7ce8..87d6b48 100644
--- a/src/scm/webid-oidc/client/gui/clock.scm
+++ b/src/scm/webid-oidc/client/gui/clock.scm
@@ -20,7 +20,10 @@
   #:use-module (gi util)
   #:use-module (ice-9 atomic)
   #:use-module (webid-oidc client gui application-hooks)
+  #:use-module (webid-oidc client application)
+  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #:declarative? #t
+  #:duplicates (merge-generics)
   #:export (wait))
 
 (use-typelibs ("GLib" "2.0"))
@@ -37,6 +40,8 @@
     (if (eq? old (atomic-box-compare-and-swap! pending-ops old '()))
         (begin
           (for-each (lambda (f) (f)) (reverse old))
+          (settings:application-state
+           (join (settings:application-state)))
           #t)
         (run))))
 
diff --git a/src/scm/webid-oidc/client/gui/settings.scm b/src/scm/webid-oidc/client/gui/settings.scm
index 8f97b2e..60e0b3f 100644
--- a/src/scm/webid-oidc/client/gui/settings.scm
+++ b/src/scm/webid-oidc/client/gui/settings.scm
@@ -33,6 +33,7 @@
   #:use-module (webid-oidc client client)
   #:use-module (webid-oidc client accounts)
   #:use-module (webid-oidc client gui application-hooks)
+  #:use-module (webid-oidc client application)
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (web uri)
@@ -43,12 +44,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   client
-   main-account
-   other-accounts
-
-   client-changed-hook
-   accounts-changed-hook
+   application-state
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -58,6 +54,9 @@
 (define goops:make
   (@ (oop goops) make))
 
+(define app:client
+  (@ (webid-oidc client application) client))
+
 (define root-settings
   (settings:new "eu.planete_kraus.Disfluid"))
 
@@ -110,11 +109,6 @@
                            (uri->string (redirect-uri client)))
       (settings:apply client-settings))))
 
-(define client
-  (match-lambda*
-    (() (get-client))
-    ((value) (set-client! value))))
-
 (unless (equal? (get-client) (get-client))
   ;; The key is generated each time, fix it
   (set-client! (get-client)))
@@ -125,13 +119,13 @@
     (str str)))
 
 (define (read-account settings)
-  (let ((subject (empty-is-false (settings:get-string main-account-settings "subject")))
-        (issuer (empty-is-false (settings:get-string main-account-settings "issuer")))
-        (key-pair (empty-is-false (settings:get-string main-account-settings "key-pair")))
-        (id-token-header (empty-is-false (settings:get-string main-account-settings "id-token-header")))
-        (id-token (empty-is-false (settings:get-string main-account-settings "id-token")))
-        (access-token (empty-is-false (settings:get-string main-account-settings "access-token")))
-        (refresh-token (empty-is-false (settings:get-string main-account-settings "refresh-token"))))
+  (let ((subject (empty-is-false (settings:get-string settings "subject")))
+        (issuer (empty-is-false (settings:get-string settings "issuer")))
+        (key-pair (empty-is-false (settings:get-string settings "key-pair")))
+        (id-token-header (empty-is-false (settings:get-string settings "id-token-header")))
+        (id-token (empty-is-false (settings:get-string settings "id-token")))
+        (access-token (empty-is-false (settings:get-string settings "access-token")))
+        (refresh-token (empty-is-false (settings:get-string settings "refresh-token"))))
     (and subject issuer key-pair
          (let ((subject (string->uri subject))
                (issuer (string->uri issuer))
@@ -145,9 +139,10 @@
              #:issuer issuer
              #:key-pair key-pair
              #:id-token
-             (goops:make <id-token>
-               #:jwt-header id-token-header
-               #:jwt-payload id-token)
+             (and id-token-header id-token
+                  (goops:make <id-token>
+                              #:jwt-header id-token-header
+                              #:jwt-payload id-token))
              #:access-token access-token
              #:refresh-token refresh-token)))))
 
@@ -166,18 +161,24 @@
     (settings:set-string? settings "subject" (uri->string (subject account)))
     (settings:set-string? settings "issuer" (uri->string (issuer account)))
     (settings:set-string? settings "key-pair"
-                         (stubs:scm->json-string (key->jwk (key-pair account))))
-    (when (id-token account)
-      (receive (id-token-header id-token)
-          (token->jwt (id-token account))
+                          (stubs:scm->json-string (key->jwk (key-pair account))))
+    (call-with-values
+        (lambda ()
+          (let ((id (id-token account)))
+            (if id
+                (token->jwt id)
+                (values #f #f))))
+      (lambda (id-token-header id-token)
         (settings:set-string? settings "id-token-header"
-                             (stubs:scm->json-string id-token-header))
+                              (if id-token-header
+                                  (stubs:scm->json-string id-token-header)
+                                  ""))
         (settings:set-string? settings "id-token"
-                             (stubs:scm->json-string id-token))))
-    (when (access-token account)
-      (settings:set-string? settings "access-token" (access-token account)))
-    (when (refresh-token account)
-      (settings:set-string? settings "refresh-token" (refresh-token account)))))
+                              (if id-token
+                                  (stubs:scm->json-string id-token)
+                                  ""))))
+    (settings:set-string? settings "access-token" (or (access-token account) ""))
+    (settings:set-string? settings "refresh-token" (or (refresh-token account) ""))))
 
 (define (get-main-account)
   (read-account main-account-settings))
@@ -185,11 +186,6 @@
 (define (set-main-account! account)
   (save-account main-account-settings account))
 
-(define main-account
-  (match-lambda*
-    (() (get-main-account))
-    ((value) (set-main-account! value))))
-
 (define (get-other-accounts)
   (filter (lambda (x) x)
           (map read-account other-accounts-settings)))
@@ -200,35 +196,44 @@
                   (settings other-accounts-settings))
       (match `(,accounts . ,settings)
         ((() . ()) #t)
-        ((() . (hd tl ...))
-         (do-save (list #f) tl))
+        ((() . settings)
+         (do-save (list #f) settings))
         ((_ . ())
          (fail (G_ "can only store 10 accounts")))
         (((account accounts ...) . (setting settings ...))
          (save-account setting account)
-         (do-save accounts tl))))))
-
-(define other-accounts
-  (match-lambda*
-    (() (get-other-accounts))
-    ((value) (set-other-accounts! value))))
+         (do-save accounts settings))))))
 
-(define client-changed-hook
-  (make-hook 1))
+(define last-application-state #f)
 
-(define accounts-changed-hook
-  (make-hook 2))
+(define hook-enabled?
+  (make-parameter #t))
 
 (connect client-settings change-event
          (lambda _
-           (run-hook client-changed-hook (client))
-           #f))
+           (let ((the-client (get-client)))
+             (when (and last-application-state
+                        (not (equal? the-client (client last-application-state))))
+               (set! last-application-state
+                 (set-client last-application-state client))
+               (when (hook-enabled?)
+                 (run-hook application-state-changed-hook last-application-state)))
+             #f)))
 
 (define (run-accounts-changed-hook . _)
-  (run-hook accounts-changed-hook
-            (main-account)
-            (other-accounts))
-  #f)
+  (let ((main (get-main-account))
+        (other (get-other-accounts)))
+    (when (and last-application-state
+               (or (not (equal? main (main-account last-application-state)))
+                   (not (equal? other (other-accounts last-application-state)))))
+      (set! last-application-state
+        (set-accounts last-application-state
+                      (if main
+                          `(,main ,@other)
+                          other)))
+      (when (hook-enabled?)
+        (run-hook application-state-changed-hook last-application-state)))
+    #f))
 
 (connect main-account-settings change-event run-accounts-changed-hook)
 (for-each
@@ -238,8 +243,22 @@
 
 (add-hook! application-activated-hook
            (lambda (app)
-             (run-hook client-changed-hook (client))
-             (run-hook accounts-changed-hook
-                       (main-account)
-                       (other-accounts)))
+             (set! last-application-state
+               (goops:make <application-state>
+                 #:main-account (get-main-account)
+                 #:other-accounts (get-other-accounts)
+                 #:client (get-client)))
+             (run-hook application-state-changed-hook last-application-state))
            #t)
+
+(define application-state
+  (match-lambda*
+    (() last-application-state)
+    ((new-state)
+     (unless (equal? new-state last-application-state)
+       (parameterize ((hook-enabled? #f))
+         (set-client! (app:client new-state))
+         (set-main-account! (main-account new-state))
+         (set-other-accounts! (other-accounts new-state)))
+       (set! last-application-state new-state)
+       (run-hook application-state-changed-hook last-application-state)))))