installer: Use named prompt to abort or break installer steps.

* gnu/installer/steps.scm (run-installer-steps): Set up
'installer-step prompt.
* gnu/installer/newt/ethernet.scm (run-ethernet-page)
* gnu/installer/newt/final.scm (run-config-display-page,
run-install-failed-page)
* gnu/installer/newt/keymap.scm (run-layout-page, run-variant-page)
* gnu/installer/newt/locale.scm (run-language-page,
run-territory-page, run-codeset-page, run-modifier-page,
run-locale-page)
* gnu/installer/newt/network.scm (run-technology-page,
wait-service-online)
* gnu/installer/newt/page.scm (run-listbox-selection-page,
run-checkbox-tree-page)
* gnu/installer/newt/partition.scm (button-exit-action)
* gnu/installer/newt/services.scm (run-desktop-environments-cbt-page,
run-networking-cbt-page, run-other-services-cbt-page,
run-network-management-page)
* gnu/installer/newt/timezone.scm (run-timezone-page)
* gnu/installer/newt/user.scm (run-user-page)
* gnu/installer/newt/welcome.scm (run-menu-page)
* gnu/installer/newt/wifi.scm (run-wifi-page): Use the 'installer-step
prompt to abort.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>

1 files changed, 55 insertions, 72 deletions

diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index d9b3d6d07e..8bc38181a7 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -28,13 +28,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (rnrs io ports)
-  #:export (&installer-step-abort
-            installer-step-abort?
-
-            &installer-step-break
-            installer-step-break?
-
-            <installer-step>
+  #:export (<installer-step>
             installer-step
             make-installer-step
             installer-step?
@@ -60,14 +54,6 @@
 ;; purposes.
 (define %current-result (make-hash-table))
 
-;; This condition may be raised to abort the current step.
-(define-condition-type &installer-step-abort &condition
-  installer-step-abort?)
-
-;; This condition may be raised to break out from the steps execution.
-(define-condition-type &installer-step-break &condition
-  installer-step-break?)
-
 ;; An installer-step record is basically an id associated to a compute
 ;; procedure. The COMPUTE procedure takes exactly one argument, an association
 ;; list containing the results of previously executed installer-steps (see
@@ -94,8 +80,10 @@
                               (rewind-strategy 'previous)
                               (menu-proc (const #f)))
   "Run the COMPUTE procedure of all <installer-step> records in STEPS
-sequentially.  If the &installer-step-abort condition is raised, fallback to a
-previous install-step, accordingly to the specified REWIND-STRATEGY.
+sequentially, inside a the 'installer-step prompt.  When aborted to with a
+parameter of 'abort, fallback to a previous install-step, accordingly to the
+specified REWIND-STRATEGY.  When aborted to with a parameter of 'break, stop
+the computation and return the accumalated result so far.
 
 REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
 is selected, the execution will resume at the previous installer-step. If
@@ -112,10 +100,7 @@ the form:
 where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
 result of the associated COMPUTE procedure. This result association list is
 passed as argument of every COMPUTE procedure. It is finally returned when the
-computation is over.
-
-If the &installer-step-break condition is raised, stop the computation and
-return the accumalated result so far."
+computation is over."
   (define (pop-result list)
     (cdr list))
 
@@ -149,63 +134,61 @@ return the accumalated result so far."
     (match todo-steps
       (() (reverse result))
       ((step . rest-steps)
-       (guard (c ((installer-step-abort? c)
-                  (case rewind-strategy
-                    ((previous)
-                     (match done-steps
-                       (()
-                        ;; We cannot go previous the first step. So re-raise
-                        ;; the exception. It might be useful in the case of
-                        ;; nested run-installer-steps. Abort to 'raise-above
-                        ;; prompt to prevent the condition from being catched
-                        ;; by one of the previously installed guard.
-                        (abort-to-prompt 'raise-above c))
-                       ((prev-done ... last-done)
-                        (run (pop-result result)
-                             #:todo-steps (cons last-done todo-steps)
-                             #:done-steps prev-done))))
-                    ((menu)
-                     (let ((goto-step (menu-proc
-                                       (append done-steps (list step)))))
-                       (if (eq? goto-step step)
-                           (run result
-                                #:todo-steps todo-steps
-                                #:done-steps done-steps)
-                           (skip-to-step goto-step result
-                                         #:todo-steps todo-steps
-                                         #:done-steps done-steps))))
-                    ((start)
-                     (if (null? done-steps)
-                         ;; Same as above, it makes no sense to jump to start
-                         ;; when we are at the first installer-step. Abort to
-                         ;; 'raise-above prompt to re-raise the condition.
-                         (abort-to-prompt 'raise-above c)
-                         (run '()
-                              #:todo-steps steps
-                              #:done-steps '())))))
-                 ((installer-step-break? c)
-                  (reverse result)))
-         (installer-log-line "running step '~a'" (installer-step-id step))
-         (let* ((id (installer-step-id step))
-                (compute (installer-step-compute step))
-                (res (compute result done-steps)))
-           (hash-set! %current-result id res)
-           (run (alist-cons id res result)
-                #:todo-steps rest-steps
-                #:done-steps (append done-steps (list step))))))))
+       (call-with-prompt 'installer-step
+         (lambda ()
+           (installer-log-line "running step '~a'" (installer-step-id step))
+           (let* ((id (installer-step-id step))
+                  (compute (installer-step-compute step))
+                  (res (compute result done-steps)))
+             (hash-set! %current-result id res)
+             (run (alist-cons id res result)
+                  #:todo-steps rest-steps
+                  #:done-steps (append done-steps (list step)))))
+         (lambda (k action)
+           (match action
+             ('abort
+              (case rewind-strategy
+                ((previous)
+                 (match done-steps
+                   (()
+                    ;; We cannot go previous the first step. Abort again to
+                    ;; 'installer-step prompt. It might be useful in the case
+                    ;; of nested run-installer-steps.
+                    (abort-to-prompt 'installer-step action))
+                   ((prev-done ... last-done)
+                    (run (pop-result result)
+                         #:todo-steps (cons last-done todo-steps)
+                         #:done-steps prev-done))))
+                ((menu)
+                 (let ((goto-step (menu-proc
+                                   (append done-steps (list step)))))
+                   (if (eq? goto-step step)
+                       (run result
+                            #:todo-steps todo-steps
+                            #:done-steps done-steps)
+                       (skip-to-step goto-step result
+                                     #:todo-steps todo-steps
+                                     #:done-steps done-steps))))
+                ((start)
+                 (if (null? done-steps)
+                     ;; Same as above, it makes no sense to jump to start
+                     ;; when we are at the first installer-step. Abort to
+                     ;; 'installer-step prompt again.
+                     (abort-to-prompt 'installer-step action)
+                     (run '()
+                          #:todo-steps steps
+                          #:done-steps '())))))
+             ('break
+              (reverse result))))))))
 
   ;; Ignore SIGPIPE so that we don't die if a client closes the connection
   ;; prematurely.
   (sigaction SIGPIPE SIG_IGN)
 
   (with-server-socket
-    (call-with-prompt 'raise-above
-      (lambda ()
-        (run '()
-             #:todo-steps steps
-             #:done-steps '()))
-      (lambda (k condition)
-        (raise condition)))))
+    (run '()
+         #:todo-steps steps
+         #:done-steps '())))
 
 (define (find-step-by-id steps id)
   "Find and return the step in STEPS whose id is equal to ID."