gui: use the application API

15 files changed, 624 insertions, 630 deletions

diff --git a/po/disfluid.pot b/po/disfluid.pot
index 1d64deb..44a0a99 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-04 23:21+0200\n"
+"POT-Creation-Date: 2021-10-05 16:51+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -615,18 +615,18 @@ msgstr ""
 msgid "The issuer should be a string or URI."
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:213
+#: src/scm/webid-oidc/client/application.scm:242
 #, scheme-format
 msgid "Add an account on ~a"
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:228
+#: src/scm/webid-oidc/client/application.scm:257
 #, scheme-format
 msgid ""
 "You already have an account for ~a issued by ~a and it is currently selected."
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:247
+#: src/scm/webid-oidc/client/application.scm:276
 #, scheme-format
 msgid "You already have an account for ~a issued by ~a."
 msgstr ""
@@ -637,40 +637,25 @@ msgid ""
 "pair.."
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui.scm:63
+#: src/scm/webid-oidc/client/gui.scm:64
 #, scheme-format
-msgid "The client changed: it is now ~a.\n"
+msgid "The application state changed: it is now ~a.\n"
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui.scm:68
-#, scheme-format
-msgid "The accounts changed: the main account is ~a, and the others are ~a.\n"
-msgstr ""
-
-#: src/scm/webid-oidc/client/gui/account-widget.scm:81
-msgid "You don’t have set up an account yet."
+#: src/scm/webid-oidc/client/gui/accounts-widget.scm:87
+msgid "Please add an account."
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui/accounts-widget-logic.scm:75
+#: src/scm/webid-oidc/client/gui/accounts-widget-logic.scm:66
 msgid "Stub: please enter an URI or a host name...\n"
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:78
+#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:75
 #, scheme-format
 msgid "Your authorization is required: ~a"
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:81
-#, scheme-format
-msgid "~a, and ~a"
-msgstr ""
-
-#: src/scm/webid-oidc/client/gui/client-widget.scm:86
-#, scheme-format
-msgid "The client cannot be constructed: ~a\n"
-msgstr ""
-
-#: src/scm/webid-oidc/client/gui/settings.scm:206
+#: src/scm/webid-oidc/client/gui/settings.scm:202
 msgid "can only store 10 accounts"
 msgstr ""
 
diff --git a/po/fr.po b/po/fr.po
index 4ece7a1..4aaae18 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-04 23:21+0200\n"
-"PO-Revision-Date: 2021-10-04 23:06+0200\n"
+"POT-Creation-Date: 2021-10-05 16:51+0200\n"
+"PO-Revision-Date: 2021-10-05 12:06+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
 "Language: fr\n"
@@ -664,12 +664,12 @@ msgstr "Le sujet doit être une chaîne de caractères ou une URI."
 msgid "The issuer should be a string or URI."
 msgstr "L’émetteur doit être une chaîne de caractères ou une URI."
 
-#: src/scm/webid-oidc/client/application.scm:213
+#: src/scm/webid-oidc/client/application.scm:242
 #, scheme-format
 msgid "Add an account on ~a"
 msgstr "Ajouter un compte sur ~a"
 
-#: src/scm/webid-oidc/client/application.scm:228
+#: src/scm/webid-oidc/client/application.scm:257
 #, scheme-format
 msgid ""
 "You already have an account for ~a issued by ~a and it is currently selected."
@@ -677,7 +677,7 @@ msgstr ""
 "Vous avez déjà un compte pour ~a émis par ~a et il est actuellement "
 "sélectionné."
 
-#: src/scm/webid-oidc/client/application.scm:247
+#: src/scm/webid-oidc/client/application.scm:276
 #, scheme-format
 msgid "You already have an account for ~a issued by ~a."
 msgstr "Vous avez déjà un compte pour ~a émis par ~a."
@@ -690,41 +690,25 @@ msgstr ""
 "L’ID de client et l’URI de redirection doivent être des URIs, et la paire de "
 "clés doit être une paire de clés."
 
-#: src/scm/webid-oidc/client/gui.scm:63
+#: src/scm/webid-oidc/client/gui.scm:64
 #, scheme-format
-msgid "The client changed: it is now ~a.\n"
-msgstr "Le client a changé : c’est maintenant ~a.\n"
+msgid "The application state changed: it is now ~a.\n"
+msgstr "L’état de l’application a changé : c’est maintenant ~a.\n"
 
-#: src/scm/webid-oidc/client/gui.scm:68
-#, scheme-format
-msgid "The accounts changed: the main account is ~a, and the others are ~a.\n"
-msgstr ""
-"Les comptes ont changé : le compte principal est ~a, et les autres sont ~a.\n"
-
-#: src/scm/webid-oidc/client/gui/account-widget.scm:81
-msgid "You don’t have set up an account yet."
-msgstr "Vous n’avez pas encore défini de compte."
+#: src/scm/webid-oidc/client/gui/accounts-widget.scm:87
+msgid "Please add an account."
+msgstr "Veuillez ajouter un compte."
 
-#: src/scm/webid-oidc/client/gui/accounts-widget-logic.scm:75
+#: src/scm/webid-oidc/client/gui/accounts-widget-logic.scm:66
 msgid "Stub: please enter an URI or a host name...\n"
 msgstr "Bouchon : veuillez entrer une URI ou un nom d’hôte…\n"
 
-#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:78
+#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:75
 #, scheme-format
 msgid "Your authorization is required: ~a"
 msgstr "Votre autorisation est requise : ~a"
 
-#: src/scm/webid-oidc/client/gui/authorization-prompt.scm:81
-#, scheme-format
-msgid "~a, and ~a"
-msgstr "~a et ~a"
-
-#: src/scm/webid-oidc/client/gui/client-widget.scm:86
-#, scheme-format
-msgid "The client cannot be constructed: ~a\n"
-msgstr "Le client ne peut pas être construit : ~a\n"
-
-#: src/scm/webid-oidc/client/gui/settings.scm:206
+#: src/scm/webid-oidc/client/gui/settings.scm:202
 msgid "can only store 10 accounts"
 msgstr "on ne peut stocker que 10 comptes"
 
@@ -2683,6 +2667,24 @@ msgid "Update"
 msgstr "Mettre à jour"
 
 #, scheme-format
+#~ msgid ""
+#~ "The accounts changed: the main account is ~a, and the others are ~a.\n"
+#~ msgstr ""
+#~ "Les comptes ont changé : le compte principal est ~a, et les autres sont "
+#~ "~a.\n"
+
+#~ msgid "You don’t have set up an account yet."
+#~ msgstr "Vous n’avez pas encore défini de compte."
+
+#, scheme-format
+#~ msgid "~a, and ~a"
+#~ msgstr "~a et ~a"
+
+#, scheme-format
+#~ msgid "The client cannot be constructed: ~a\n"
+#~ msgstr "Le client ne peut pas être construit : ~a\n"
+
+#, scheme-format
 #~ msgid "Stub: adding an account with identity provider ~s...\n"
 #~ msgstr "Bouchon : ajout d’un compte avec le fournisseur d’identité ~s…\n"
 
diff --git a/src/scm/webid-oidc/client/application.scm b/src/scm/webid-oidc/client/application.scm
index 6263a82..5185cfb 100644
--- a/src/scm/webid-oidc/client/application.scm
+++ b/src/scm/webid-oidc/client/application.scm
@@ -48,18 +48,21 @@
    description result-box thread
    result join
 
+   <authorization-prompt>
+   authorization-uri reason continuation
+
    <application-state>
    main-account other-accounts client error-messages authorization-prompts running-jobs pages
 
    add-account
    choose-account
+   remove-account
+   set-accounts
    set-client
    fold-authorization-prompts
    add-page
    set-page-uri
    close-page
-
-   ->sexp
    )
   #:declarative? #t)
 
@@ -70,9 +73,23 @@
   (description #:init-keyword #:description #:getter description)
   (result-box #:init-thunk (lambda () (make-atomic-box #f)) #:getter result-box))
 
+(define-method (equal? (x <job>) (y <job>))
+  (and (equal? (description x) (description y))
+       (eq? (result-box x) (result-box y))))
+
 (define-method (result (job <job>))
   (atomic-box-ref (result-box job)))
 
+(define-class <authorization-prompt> ()
+  (authorization-uri #:init-keyword #:authorization-uri #:getter authorization-uri)
+  (reason #:init-keyword #:reason #:getter reason)
+  (continuation #:init-keyword #:continuation #:getter continuation))
+
+(define-method (equal? (x <authorization-prompt>) (y <authorization-prompt>))
+  (and (equal? (authorization-uri x) (authorization-uri y))
+       (equal? (reason x) (reason y))
+       (eq? (continuation x) (continuation y))))
+
 (define-class <application-state> ()
   (main-account
    #:init-keyword #:main-account
@@ -95,9 +112,6 @@
    #:init-keyword #:error-messages
    #:getter error-messages
    #:init-value '())
-  ;; This is a list of pairs: URI * procedure to call with the
-  ;; authorization code. The procedure takes 2 arguments: the code and
-  ;; a state, and it returns the updated state.
   (authorization-prompts
    #:init-keyword #:authorization-prompts
    #:getter authorization-prompts
@@ -111,34 +125,32 @@
    #:getter pages
    #:init-value '()))
 
-(define-method (->sexp (state <application-state>))
-  `(begin
-     (use-modules (oop goops) (webid-oidc client application))
-     (make <application-state>
-       ,@(let ((main-account (main-account state)))
-           (if main-account
-               `(#:main-account ,(account:->sexp main-account))
-               '()))
-       #:other-accounts (list ,@(map account:->sexp (other-accounts state)))
-       ,@(let ((client (client state)))
-           (if client
-               `(#:client ,(client:->sexp client))
-               '()))
-       #:error-messages (list ,@(error-messages state)))))
-
-(define-method (write (state <application-state>) port)
-  (pretty-print (->sexp state) port))
+(define-method (equal? (x <application-state>) (y <application-state>))
+  (and (equal? (main-account x) (main-account y))
+       (equal? (other-accounts x) (other-accounts y))
+       (equal? (client x) (client y))
+       (equal? (error-messages x) (error-messages y))
+       (equal? (authorization-prompts x) (authorization-prompts y))
+       (equal? (running-jobs x) (running-jobs y))
+       (equal? (pages x) (pages y))))
 
 (define-method (display (state <application-state>) port)
-  (format port "#<<application-state> main-account=~a client=~a error-messages=~a authorization-prompts=~a running-jobs=~a>"
+  (format port "#<<application-state> main-account=~a other-accounts=~a client=~a error-messages=~a authorization-prompts=~a running-jobs=~a>"
           (call-with-output-string
             (lambda (port)
               (display (main-account state) port)))
           (call-with-output-string
             (lambda (port)
+              (display (map (lambda (acct)
+                              (uri->string (account:subject acct)))
+                            (other-accounts state))
+                       port)))
+          (call-with-output-string
+            (lambda (port)
               (display (client state) port)))
           (error-messages state)
-          (map (match-lambda (((= uri->string uri) . _) uri))
+          (map (lambda (prompt)
+                 (uri->string (authorization-uri prompt)))
                (authorization-prompts state))
           (map description (running-jobs state))))
 
@@ -151,6 +163,8 @@
                                 (jobs (map result finished)))
         (match jobs
           (() state)
+          ((#f tl ...)
+           (apply-finished-jobs state tl))
           ((hd tl ...)
            (apply-finished-jobs (hd state) tl)))))))
 
@@ -159,50 +173,65 @@
     (call-with-new-thread
      (lambda ()
        (let ((tag (make-prompt-tag)))
-         (call-with-prompt tag
-           (lambda ()
-             (parameterize
-                 ((client:client (client state))
-                  (account:authorization-process
-                   (lambda* (uri #:key (reason #f))
-                     (abort-to-prompt
-                      tag
-                      (lambda (continuation)
-                        ;; This is a state updating function. It just
-                        ;; registers the continuation as a new
-                        ;; authorization prompt.
-                        (lambda (previous-state)
-                          ;; This code runs in the main thread.
-                          (define (continue state code)
-                            (add-job state description
-                                     (lambda ()
-                                       (continuation code))))
-                          (let ((ret (shallow-clone previous-state)))
-                            (slot-set! ret 'authorization-prompts
-                                       `((,uri . ,continue)
-                                         ,@(authorization-prompts previous-state)))
-                            ret)))))))
-               (cache:use-cache
-                (lambda ()
-                  (with-exception-handler
-                      (lambda (exn)
-                        (let ((msg (if (exception-with-message? exn)
-                                       (exception-message exn)
-                                       (format #f "~s" exn))))
-                          (abort-to-prompt
-                           tag
-                           (lambda (_)
-                             ;; We won’t continue, but we will show the error message
-                             (lambda (previous-state)
-                               (let ((ret (shallow-clone previous-state)))
-                                 (slot-set! ret 'error-messages
-                                            `(,msg ,@(error-messages previous-state)))
-                                 ret))))))
-                    (lambda ()
-                      (let ((updater (f)))
-                        (atomic-box-set! (result-box job) updater))))))))
-           (lambda (continuation get-updater)
-             (atomic-box-set! (result-box job) (get-updater continuation)))))))
+         (atomic-box-set!
+          (result-box job)
+          ;; The following code returns an updater. The updater takes
+          ;; a previous state and returns a new state.
+          ;;
+          ;; There are 2 possible branches:
+          ;;
+          ;; 1. If everything works, the updater is what’s returned by
+          ;; (f);
+          ;;
+          ;; 2. If (f) calls the authorization process, the updater is
+          ;; a function that adds an authorization prompts to further
+          ;; continue the call in a new job. In that case, continuing
+          ;; yields an updater too, because it is delimited by this
+          ;; prompt.
+          (call-with-prompt tag
+            (lambda ()
+              (parameterize
+                  ((client:client (client state))
+                   (account:authorization-process
+                    (lambda* (uri #:key (reason #f))
+                      (abort-to-prompt
+                       tag
+                       (lambda (continuation)
+                         ;; This is a state updating function. It just
+                         ;; registers the continuation as a new
+                         ;; authorization prompt.
+                         (lambda (previous-state)
+                           ;; This code runs in the main thread.
+                           (define (continue state code)
+                             (add-job state description
+                                      (lambda ()
+                                        (continuation code))))
+                           (let ((ret (shallow-clone previous-state)))
+                             (slot-set! ret 'authorization-prompts
+                                        `(,(make <authorization-prompt>
+                                             #:authorization-uri uri
+                                             #:reason reason
+                                             #:continuation continue)
+                                          ,@(authorization-prompts previous-state)))
+                             ret)))))))
+                (with-exception-handler
+                    (lambda (exn)
+                      (let ((msg (if (exception-with-message? exn)
+                                     (exception-message exn)
+                                     (format #f "~s" exn))))
+                        (abort-to-prompt
+                         tag
+                         (lambda (_)
+                           ;; We won’t continue, but we will show the error message
+                           (lambda (previous-state)
+                             (let ((ret (shallow-clone previous-state)))
+                               (slot-set! ret 'error-messages
+                                          `(,msg ,@(error-messages previous-state)))
+                               ret))))))
+                  (lambda ()
+                    (f)))))
+            (lambda (continuation get-updater)
+              (get-updater continuation)))))))
     (let ((ret (shallow-clone state)))
       (slot-set! ret 'running-jobs `(,job ,@(running-jobs ret)))
       ret)))
@@ -220,14 +249,14 @@
        (lambda (previous-state)
          (let ((current-main-account (main-account previous-state)))
            (if current-main-account
-               (if (and (equal? (subject current-main-account) (subject new-account))
-                        (equal? (issuer current-main-account) (issuer new-account)))
+               (if (and (equal? (account:subject current-main-account) (account:subject new-account))
+                        (equal? (account:issuer current-main-account) (account:issuer new-account)))
                    ;; First kind of duplicate
                    (let ((ret (shallow-clone previous-state)))
                      (slot-set! ret 'error-messages
                                 `(,(format #f (G_ "You already have an account for ~a issued by ~a and it is currently selected.")
-                                           (uri->string (subject new-account))
-                                           (uri->string (issuer new-account)))))
+                                           (uri->string (account:subject new-account))
+                                           (uri->string (account:issuer new-account)))))
                      ret)
                    ;; The main account slot is already taken, add it to the other accounts
                    (let check ((other (other-accounts previous-state)))
@@ -239,30 +268,59 @@
                                      `(,new-account ,@(other-accounts previous-state)))
                           ret))
                        ((existing other ...)
-                        (if (and (equal? (subject existing) (subject new-account))
-                                 (equal? (issuer existing) (issuer new-account)))
+                        (if (and (equal? (account:subject existing) (account:subject new-account))
+                                 (equal? (account:issuer existing) (account:issuer new-account)))
                             ;; Second kind of duplicate
                             (let ((ret (shallow-clone previous-state)))
                               (slot-set! ret 'error-messages
                                          `(,(format #f (G_ "You already have an account for ~a issued by ~a.")
-                                                    (uri->string (subject new-account))
-                                                    (uri->string (issuer new-account)))))
+                                                    (uri->string (account:subject new-account))
+                                                    (uri->string (account:issuer new-account)))))
                               ret)
                             (check other))))))
                ;; No main account yet
                (let ((ret (shallow-clone previous-state)))
                  (slot-set! ret 'main-account new-account)
-                 ret)))))))
-  state)
+                 ret))))))))
 
 (define-method (choose-account (state <application-state>) (account <account:account>))
   (let ((ret (shallow-clone state)))
     (slot-set! ret 'main-account account)
     (slot-set! ret 'other-accounts
                (filter (lambda (other)
-                         (not (equal? other account)))))
+                         (not (equal? other account)))
+                       `(,(main-account state) ,@(other-accounts state))))
     ret))
 
+(define-method (remove-account (state <application-state>) (account <account:account>))
+  (let ((ret (shallow-clone state)))
+    (let ((main (main-account ret))
+          (other (other-accounts ret)))
+      (let* ((all `(,main ,@other))
+             (kept (filter (lambda (a) (not (equal? a account))) all)))
+        (match kept
+          (()
+           (slot-set! ret 'main-account #f)
+           (slot-set! ret 'other-accounts '()))
+          ((main other ...)
+           (slot-set! ret 'main-account main)
+           (slot-set! ret 'other-accounts other)))))
+    ret))
+
+(define-method (set-accounts (state <application-state>) (accounts <list>))
+  (let ((ret (shallow-clone state)))
+    (match accounts
+      (()
+       (slot-set! ret 'main-account #f)
+       (slot-set! ret 'other-accounts '()))
+      ((main other ...)
+       (slot-set! ret 'main-account main)
+       (slot-set! ret 'other-accounts other)))
+    ret))
+
+(define-method (set-accounts (state <application-state>) (main <account:account>) (other <list>))
+  (set-accounts state `(,main ,@other)))
+
 (define-method (set-client (state <application-state>) (client <client:client>))
   (let ((ret (shallow-clone state)))
     (slot-set! ret 'client client)
@@ -278,46 +336,67 @@
     (match prompts
       (()
        (values seed state))
-      (((uri . continue) prompts ...)
-       (receive (seed code) (f seed uri)
+      ((prompt prompts ...)
+       (receive (seed code) (f seed (authorization-uri prompt))
          (let ((state
                 ;; If I have a code, transform state by calling the
                 ;; continuation function (i.e., add a job that will
                 ;; finish the task). If I don’t, I need to keep this
                 ;; prompt around.
                 (if code
-                    (continue state code)
+                    ((continuation prompt) state code)
                     (let ((with-unresolved-prompt (shallow-clone state)))
                       (slot-set! ret 'authorization-prompts
-                                 `((,uri . ,continue) ,@(authorization-prompts state)))
+                                 `(,prompt ,@(authorization-prompts state)))
                       with-unresolved-prompt))))
            (iter prompts seed state)))))))
 
 (define-class <page> ()
   (identifier #:init-keyword #:identifier #:getter identifier))
 
+(define-method (equal? (x <page>) (y <page>))
+  (and (equal? (identifier x) (identifier y))))
+
 (define-class <new-page> (<page>))
 
 (define-class <page-with-uri> (<page>)
   (uri #:init-keyword #:uri #:getter uri))
 
+(define-method (equal? (x <page-with-uri>) (y <page-with-uri>))
+  (and (equal? (uri x) (uri y))))
+
 (define-class <loading-page> (<page-with-uri>))
 
 (define-class <error-page> (<page-with-uri>)
   (code #:init-keyword #:code #:getter code)
   (reason-phrase #:init-keyword #:reason-phrase #:getter reason-phrase))
 
+(define-method (equal? (x <error-page>) (y <error-page>))
+  (and (equal? (code x) (code y))
+       (equal? (reason-phrase x) (reason-phrase y))))
+
 (define-class <loaded-page> (<page-with-uri>)
   (etag #:init-keyword #:etag #:getter etag)
   (links #:init-keyword #:links #:getter links))
 
+(define-method (equal? (x <loaded-page>) (y <loaded-page>))
+  (and (equal? (etag x) (etag y))
+       (equal? (links x) (links y))))
+
 (define-class <rdf-page> (<loaded-page>)
   (triples #:init-keyword #:triples #:getter triples))
 
+(define-method (equal? (x <rdf-page>) (y <rdf-page>))
+  (and (equal? (triples x) (triples y))))
+
 (define-class <non-rdf-page> (<loaded-page>)
   (content-type #:init-keyword #:content-type #:getter content-type)
   (content #:init-keyword #:content #:getter content))
 
+(define-method (equal? (x <non-rdf-page>) (y <non-rdf-page>))
+  (and (equal? (content-type x) (content-type y))
+       (equal? (content x) (content y))))
+
 (define-method (add-page (state <application-state>) (identifier <string>))
   (let ((ret (shallow-clone state)))
     (slot-set! ret 'pages
diff --git a/src/scm/webid-oidc/client/gui.scm b/src/scm/webid-oidc/client/gui.scm
index 29bf556..3fbd291 100644
--- a/src/scm/webid-oidc/client/gui.scm
+++ b/src/scm/webid-oidc/client/gui.scm
@@ -37,6 +37,7 @@
   #:use-module (webid-oidc client accounts)
   #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #:use-module ((webid-oidc client gui application) #:prefix app:)
+  #:use-module (webid-oidc client gui application-hooks)
   #:use-module ((webid-oidc cache) #:prefix cache:)
   #:use-module ((webid-oidc catalog) #:prefix catalog:)
   #:use-module (web uri)
@@ -58,15 +59,9 @@
 (use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new))
               ("Gtk" "3.0"))
 
-(add-hook! settings:client-changed-hook
-           (lambda (client)
-             (format #t (G_ "The client changed: it is now ~a.\n") client)
-             ((@ (webid-oidc client) client) client)))
-
-(add-hook! settings:accounts-changed-hook
-           (lambda (main other)
-             (format #t (G_ "The accounts changed: the main account is ~a, and the others are ~a.\n")
-                     main other)))
+(add-hook! application-state-changed-hook
+           (lambda (state)
+             (format #t (G_ "The application state changed: it is now ~a.\n") state)))
 
 (define (main)
   (parameterize ((p:anonymous-http-request (@ (web client) http-request)))
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)))))
diff --git a/src/ui/accounts-widget.glade b/src/ui/accounts-widget.glade
index d177e34..711d39c 100644
--- a/src/ui/accounts-widget.glade
+++ b/src/ui/accounts-widget.glade
@@ -1,62 +1,50 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<!-- Generated with glade 3.36.0 -->
+<!-- Generated with glade 3.38.2 -->
 <interface>
   <requires lib="gtk+" version="3.22"/>
-  <object class="GtkBox" id="accounts_widget">
+  <object class="GtkViewport" id="accounts_widget">
     <property name="visible">True</property>
-    <property name="can_focus">False</property>
-    <property name="orientation">vertical</property>
-    <property name="spacing">12</property>
+    <property name="can-focus">False</property>
+    <property name="shadow-type">none</property>
     <child>
       <object class="GtkBox">
         <property name="visible">True</property>
-        <property name="can_focus">False</property>
+        <property name="can-focus">False</property>
         <property name="orientation">vertical</property>
+        <property name="spacing">12</property>
         <child>
-          <object class="GtkLabel">
+          <object class="GtkBox">
             <property name="visible">True</property>
-            <property name="can_focus">False</property>
-            <property name="label" translatable="yes">Main account:</property>
-          </object>
-          <packing>
-            <property name="expand">False</property>
-            <property name="fill">True</property>
-            <property name="position">0</property>
-          </packing>
-        </child>
-        <child>
-          <object class="GtkBox" id="main_account_box">
-            <property name="visible">True</property>
-            <property name="can_focus">False</property>
+            <property name="can-focus">False</property>
             <property name="orientation">vertical</property>
-            <property name="spacing">8</property>
             <child>
-              <placeholder/>
+              <object class="GtkLabel">
+                <property name="visible">True</property>
+                <property name="can-focus">False</property>
+                <property name="label" translatable="yes">Main account:</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">0</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkBox" id="main_account_box">
+                <property name="visible">True</property>
+                <property name="can-focus">False</property>
+                <property name="orientation">vertical</property>
+                <property name="spacing">8</property>
+                <child>
+                  <placeholder/>
+                </child>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">1</property>
+              </packing>
             </child>
-          </object>
-          <packing>
-            <property name="expand">False</property>
-            <property name="fill">True</property>
-            <property name="position">1</property>
-          </packing>
-        </child>
-      </object>
-      <packing>
-        <property name="expand">False</property>
-        <property name="fill">True</property>
-        <property name="position">0</property>
-      </packing>
-    </child>
-    <child>
-      <object class="GtkBox">
-        <property name="visible">True</property>
-        <property name="can_focus">False</property>
-        <property name="orientation">vertical</property>
-        <child>
-          <object class="GtkLabel">
-            <property name="visible">True</property>
-            <property name="can_focus">False</property>
-            <property name="label" translatable="yes">Other accounts:</property>
           </object>
           <packing>
             <property name="expand">False</property>
@@ -65,13 +53,37 @@
           </packing>
         </child>
         <child>
-          <object class="GtkBox" id="other_accounts_box">
+          <object class="GtkBox">
             <property name="visible">True</property>
-            <property name="can_focus">False</property>
+            <property name="can-focus">False</property>
             <property name="orientation">vertical</property>
-            <property name="spacing">8</property>
             <child>
-              <placeholder/>
+              <object class="GtkLabel">
+                <property name="visible">True</property>
+                <property name="can-focus">False</property>
+                <property name="label" translatable="yes">Other accounts:</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">0</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkBox" id="other_accounts_box">
+                <property name="visible">True</property>
+                <property name="can-focus">False</property>
+                <property name="orientation">vertical</property>
+                <property name="spacing">8</property>
+                <child>
+                  <placeholder/>
+                </child>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">1</property>
+              </packing>
             </child>
           </object>
           <packing>
@@ -80,49 +92,49 @@
             <property name="position">1</property>
           </packing>
         </child>
-      </object>
-      <packing>
-        <property name="expand">False</property>
-        <property name="fill">True</property>
-        <property name="position">1</property>
-      </packing>
-    </child>
-    <child>
-      <object class="GtkBox">
-        <property name="visible">True</property>
-        <property name="can_focus">False</property>
-        <property name="orientation">vertical</property>
         <child>
-          <object class="GtkLabel">
+          <object class="GtkBox">
             <property name="visible">True</property>
-            <property name="can_focus">False</property>
-            <property name="label" translatable="yes">To add an account,
+            <property name="can-focus">False</property>
+            <property name="orientation">vertical</property>
+            <child>
+              <object class="GtkLabel">
+                <property name="visible">True</property>
+                <property name="can-focus">False</property>
+                <property name="label" translatable="yes">To add an account,
 please enter your identity provider:</property>
-            <property name="wrap">True</property>
-          </object>
-          <packing>
-            <property name="expand">False</property>
-            <property name="fill">True</property>
-            <property name="position">0</property>
-          </packing>
-        </child>
-        <child>
-          <object class="GtkEntry" id="identity_provider_entry">
-            <property name="visible">True</property>
-            <property name="can_focus">True</property>
-          </object>
-          <packing>
-            <property name="expand">False</property>
-            <property name="fill">True</property>
-            <property name="position">2</property>
-          </packing>
-        </child>
-        <child>
-          <object class="GtkButton" id="add_account_button">
-            <property name="label" translatable="yes">Add an account</property>
-            <property name="visible">True</property>
-            <property name="can_focus">True</property>
-            <property name="receives_default">True</property>
+                <property name="wrap">True</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">0</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkEntry" id="identity_provider_entry">
+                <property name="visible">True</property>
+                <property name="can-focus">True</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">2</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkButton" id="add_account_button">
+                <property name="label" translatable="yes">Add an account</property>
+                <property name="visible">True</property>
+                <property name="can-focus">True</property>
+                <property name="receives-default">True</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">3</property>
+              </packing>
+            </child>
           </object>
           <packing>
             <property name="expand">False</property>
@@ -131,11 +143,6 @@ please enter your identity provider:</property>
           </packing>
         </child>
       </object>
-      <packing>
-        <property name="expand">False</property>
-        <property name="fill">True</property>
-        <property name="position">3</property>
-      </packing>
     </child>
   </object>
 </interface>