Toggle diff (450 lines)
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index ecd22efbb2..d75a640519 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -65,9 +65,7 @@ (define (run-ethernet-page)
(run-error-page
(G_ "No ethernet service available, please try again.")
(G_ "No service"))
- (raise
- (condition
- (&installer-step-abort))))
+ (abort-to-prompt 'installer-step 'abort))
((service)
;; Only one service is available so return it directly.
service)
@@ -81,7 +79,5 @@ (define (run-ethernet-page)
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort))))
+ (abort-to-prompt 'installer-step 'abort))
#:listbox-callback-procedure connect-ethernet-service))))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 07e8cf3864..bd1b53b9f3 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -59,9 +59,7 @@ (define* (run-config-display-page #:key locale)
#:file-textbox-height height
#:exit-button-callback-procedure
(lambda ()
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-install-success-page)
(match (current-clients)
@@ -88,9 +86,7 @@ (define (run-install-failed-page)
(G_ "Restart the installer")
(G_ "The final system installation step failed. You can resume from \
a specific step, or restart the installer."))
- (1 (raise
- (condition
- (&installer-step-abort))))
+ (1 (abort-to-prompt 'installer-step 'abort))
(2
;; Keep going, the installer will be restarted later on.
#t)))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 92f7f46f34..c5d4be6792 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -59,9 +59,7 @@ (define (run-layout-page layouts layout->text context)
((param) (const #f))
(else
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))))
+ (abort-to-prompt 'installer-step 'abort)))))))
(define (run-variant-page variants variant->text)
(let ((title (G_ "Variant")))
@@ -74,9 +72,7 @@ (define (run-variant-page variants variant->text)
#:button-text (G_ "Back")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (sort-layouts layouts)
"Sort LAYOUTS list by putting the US layout ahead and return it."
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index bfd89aca2c..01171e253f 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -43,9 +43,7 @@ (define result
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort))))))
+ (abort-to-prompt 'installer-step 'abort))))
;; Immediately install the chosen language so that the territory page that
;; comes after (optionally) is displayed in the chosen language.
@@ -63,9 +61,7 @@ (define (run-territory-page territories territory->text)
#:button-text (G_ "Back")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-codeset-page codesets)
(let ((title (G_ "Locale codeset")))
@@ -78,9 +74,7 @@ (define (run-codeset-page codesets)
#:button-text (G_ "Back")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-modifier-page modifiers modifier->text)
(let ((title (G_ "Locale modifier")))
@@ -94,9 +88,7 @@ (define (run-modifier-page modifiers modifier->text)
#:button-text (G_ "Back")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define* (run-locale-page #:key
supported-locales
@@ -110,11 +102,10 @@ (define* (run-locale-page #:key
glibc format is returned."
(define (break-on-locale-found locales)
- "Raise the &installer-step-break condition if LOCALES contains exactly one
+ "Break to the installer step if LOCALES contains exactly one
element."
(and (= (length locales) 1)
- (raise
- (condition (&installer-step-break)))))
+ (abort-to-prompt 'installer-step 'break)))
(define (filter-locales locales result)
"Filter the list of locale records LOCALES using the RESULT returned by
@@ -218,8 +209,8 @@ (define locale-steps
;; If run-installer-steps returns locally, it means that the user had to go
;; through all steps (language, territory, codeset and modifier) to select a
- ;; locale. In that case, like if we exited by raising &installer-step-break
- ;; condition, turn the result into a glibc locale string and return it.
+ ;; locale. In that case, like if we exited by breaking to the installer
+ ;; step, turn the result into a glibc locale string and return it.
(result->locale-string
supported-locales
(run-installer-steps #:steps locale-steps)))
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index fb221483c3..0477a489be 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -65,12 +65,8 @@ (define (technology-items)
(G_ "Exit")
(G_ "The install process requires Internet access but no \
network devices were found. Do you want to continue anyway?"))
- ((1) (raise
- (condition
- (&installer-step-break))))
- ((2) (raise
- (condition
- (&installer-step-abort))))))
+ ((1) (abort-to-prompt 'installer-step 'break))
+ ((2) (abort-to-prompt 'installer-step 'abort))))
((technology)
;; Since there's only one technology available, skip the selection
;; screen.
@@ -86,9 +82,7 @@ (define (technology-items)
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort))))))))
+ (abort-to-prompt 'installer-step 'abort))))))
(define (find-technology-by-type technologies type)
"Find and return a technology with the given TYPE in TECHNOLOGIES list."
@@ -156,9 +150,7 @@ (define (online?)
(G_ "The selected network does not provide access to the \
Internet and the Guix substitute server, please try again.")
(G_ "Connection error"))
- (raise
- (condition
- (&installer-step-abort))))))
+ (abort-to-prompt 'installer-step 'abort))))
(define (run-network-page)
"Run a page to allow the user to configure connman so that it can access the
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 695c7d875f..8c675fa837 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -488,7 +488,7 @@ (define (choice->item str)
(string=? str (listbox-item->text item))))
keys)
((key . item) item)
- (#f (raise (condition (&installer-step-abort))))))
+ (#f (abort-to-prompt 'installer-step 'abort))))
;; On every listbox element change, check if we need to skip it. If yes,
;; depending on the 'last-listbox-key', jump forward or backward. If no,
@@ -690,7 +690,7 @@ (define (choice->item str)
(string=? str (item->text item))))
keys)
((key . item) item)
- (#f (raise (condition (&installer-step-abort))))))
+ (#f (abort-to-prompt 'installer-step 'abort))))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 6a3aa3daff..e7a97810ac 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -36,10 +36,8 @@ (define-module (gnu installer newt partition)
#:export (run-partitioning-page))
(define (button-exit-action)
- "Raise the &installer-step-abort condition."
- (raise
- (condition
- (&installer-step-abort))))
+ "Abort the installer step."
+ (abort-to-prompt 'installer-step 'abort))
(define (run-scheme-page)
"Run a page asking the user for a partitioning scheme."
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 1af4e7df2d..0a2fc834e1 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -45,9 +45,7 @@ (define (run-desktop-environments-cbt-page)
#:checkbox-tree-height 9
#:exit-button-callback-procedure
(lambda ()
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-networking-cbt-page)
"Run a page allowing the user to select networking services."
@@ -64,9 +62,7 @@ (define (run-networking-cbt-page)
#:checkbox-tree-height 5
#:exit-button-callback-procedure
(lambda ()
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-other-services-cbt-page)
"Run a page allowing the user to select other services."
@@ -86,9 +82,7 @@ (define (run-other-services-cbt-page)
#:checkbox-tree-height 9
#:exit-button-callback-procedure
(lambda ()
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-network-management-page)
"Run a page to select among several network management methods."
@@ -110,9 +104,7 @@ (define (run-network-management-page)
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
- (raise
- (condition
- (&installer-step-abort)))))))
+ (abort-to-prompt 'installer-step 'abort)))))
(define (run-services-page)
(let ((desktop (run-desktop-environments-cbt-page)))
diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm
index 67bf41ff84..bed9f9d5cb 100644
--- a/gnu/installer/newt/timezone.scm
+++ b/gnu/installer/newt/timezone.scm
@@ -65,9 +65,7 @@ (define (loop path)
#:button-callback-procedure
(if (null? path)
(lambda _
- (raise
- (condition
- (&installer-step-abort))))
+ (abort-to-prompt 'installer-step 'abort))
(lambda _
(loop (all-but-last path))))
#:listbox-callback-procedure
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index 58bb86bf96..97141cfe64 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -20,7 +20,6 @@
(define-module (gnu installer newt user)
#:use-module (gnu installer user)
- #:use-module ((gnu installer steps) #:select (&installer-step-abort))
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (gnu installer utils)
@@ -257,9 +256,7 @@ (define (run users)
(run users))
(reverse users))
((components=? argument exit-button)
- (raise
- (condition
- (&installer-step-abort))))))
+ (abort-to-prompt 'installer-step 'abort))))
('exit-fd-ready
;; Read the complete user list at once.
(match argument
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 5f461279e2..7a7ddfb7bd 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -84,7 +84,7 @@ (define (choice->item str)
(string=? str (listbox-item->text item))))
keys)
((key . item) item)
- (#f (raise (condition (&installer-step-abort))))))
+ (#f (abort-to-prompt 'installer-step 'abort))))
(set-textbox-text logo-textbox (read-all logo))
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
index f5d8f1fdbf..8a87cbdf4b 100644
--- a/gnu/installer/newt/wifi.scm
+++ b/gnu/installer/newt/wifi.scm
@@ -237,9 +237,7 @@ (define (run-wifi-page)
(run-wifi-scan-page)
(run-wifi-page))
((components=? argument exit-button)
- (raise
- (condition
- (&installer-step-abort))))
+ (abort-to-prompt 'installer-step 'abort))
((components=? argument listbox)
(let ((result (connect-wifi-service listbox service-items)))
(unless result
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index d9b3d6d07e..bd99e1fa2a 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -28,13 +28,7 @@ (define-module (gnu installer steps)
#: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 @@ (define-module (gnu installer steps)
;; 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 @@ (define* (run-installer-steps #:key
(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 @@ (define* (run-installer-steps #:key
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 @@ (define* (run result #:key todo-steps done-steps)
(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)))