[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
50/197: installer: Issue message to user on failure of filesystems task.
From: |
Danny Milosavljevic |
Subject: |
50/197: installer: Issue message to user on failure of filesystems task. |
Date: |
Mon, 3 Jul 2017 20:36:59 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit 0c5c488b2ee0677777703eb9d66a2c42922e2895
Author: John Darrington <address@hidden>
Date: Fri Dec 30 14:17:09 2016 +0100
installer: Issue message to user on failure of filesystems task.
* gnu/system/installer/filesystems.scm (filesystem-task-incomplete-reason):
New procedure,
(filesystem-task-complete?): redefine in terms of aforementioned procedure,
(filesystem-page-key-handler): Inform the user about the reason for failure.
---
gnu/system/installer/filesystems.scm | 88 +++++++++++++++++++-----------------
1 file changed, 47 insertions(+), 41 deletions(-)
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 927248b..0f67342 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -37,14 +37,36 @@
(define minimum-store-size 7000)
(define (filesystem-task-complete?)
- (and (find-mount-device "/" mount-points) ; A device for / must exist
- (>= (size-of-partition (find-mount-device "/gnu" mount-points))
- minimum-store-size) ; /gnu must have enough space
-
- ;; All partitions must have a filesystem
- (fold (lambda (x prev)
- (and (string-prefix? "ext" (partition-fs (string->partition
(car x))))
- prev)) #t mount-points)))
+ (not (filesystem-task-incomplete-reason)))
+
+(define (filesystem-task-incomplete-reason)
+ "Returns #f if the task is complete. Otherwise a string explaining why not."
+ (or
+ (and (< (size-of-partition (find-mount-device "/gnu" mount-points))
+ minimum-store-size)
+ (format #f
+ (N_ "The filesystem for /gnu requires at least ~aGB.")
+ (/ minimum-store-size 1000)))
+
+ (and (not (find-mount-device "/" mount-points))
+ (N_ "You must specify a mount point for the root (/)."))
+
+ (let ((partitions-without-filesystems
+ (fold (lambda (x prev)
+ (if (not (string-prefix? "ext"
+ (partition-fs (string->partition
+ (car x)))))
+ (cons (car x) prev)
+ prev)) '() mount-points)))
+
+ (if (null? partitions-without-filesystems)
+ #f
+ (ngettext
+ (format #f (N_ "The partition ~a does not contain a filesystem.")
+ (car partitions-without-filesystems))
+ (format #f (N_ "The partitions ~a do not contain filesystems.")
+ partitions-without-filesystems)
+ (length partitions-without-filesystems))))))
(define (make-filesystem-page parent title)
(make-page (page-surface parent)
@@ -106,14 +128,14 @@
((menu-active menu)
(menu-set-active! menu #f)
(buttons-select nav 0))
-
+
((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
(menu-set-active! menu #t)
(buttons-unselect-all nav))
-
+
(else
(buttons-select-next nav))))
-
+
((eq? ch KEY_LEFT)
(menu-set-active! menu #f)
(buttons-select-prev nav))
@@ -141,35 +163,19 @@
(delwin (inner (page-wwin page)))
(set! page-stack (cdr page-stack)))
-
+
((buttons-key-matches-symbol? nav ch 'continue)
- (cond
- ((not (find-mount-device "/" mount-points))
- (let ((next
- (make-dialog
- page
- (gettext
- "You must choose a device on which to mount the root (/) of
the operating system's filesystem."))))
- (set! page-stack (cons next page-stack))
- ((page-refresh next) next)))
-
- ((< (size-of-partition (find-mount-device "/gnu" mount-points))
minimum-store-size)
- (let ((next
- (make-dialog
- page
- (format #f
- (gettext
- "The filesystem for ~a needs at least ~aGB of disk
space.")
- "/gnu"
- (/ minimum-store-size 1000)))))
- (set! page-stack (cons next page-stack))
- ((page-refresh next) next)))
-
- (else
- (delwin (outer (page-wwin page)))
- (set! page-stack (cdr page-stack))
- ((page-refresh (car page-stack)) (car page-stack))
- ))))
+ (let ((errstr (filesystem-task-incomplete-reason)))
+ (if errstr
+ (let ((next (make-dialog page errstr)))
+ (set! page-stack (cons next page-stack))
+ ((page-refresh next) next))
+ (begin
+ (delwin (outer (page-wwin page)))
+ (set! page-stack (cdr page-stack))
+ ((page-refresh (car page-stack)) (car page-stack)))
+ ))))
+
(std-menu-key-handler menu ch))
#f
)
@@ -183,7 +189,7 @@
(text-window (derwin (inner pr) 3 (getmaxx (inner pr))
0 0))
-
+
(bwin (derwin (inner pr)
3 (getmaxx (inner pr))
(- (getmaxy (inner pr)) 3) 0
@@ -194,7 +200,7 @@
(- (getmaxy (inner pr)) 3 (getmaxy text-window))
(- (getmaxx (inner pr)) 0)
(getmaxy text-window) 0 #:panel #f))
-
+
(menu (make-menu (partition-volume-pairs)
#:disp-proc
(lambda (d row)
- 37/197: install: Define new procedure pipe-cmd and use it to implement window-pipe., (continued)
- 37/197: install: Define new procedure pipe-cmd and use it to implement window-pipe., Danny Milosavljevic, 2017/07/03
- 41/197: installer: Enable scrolling in the installation window., Danny Milosavljevic, 2017/07/03
- 38/197: installer: Correct bugs generating the configuration., Danny Milosavljevic, 2017/07/03
- 45/197: installer: Fix bug where window-pipe did not return the proper exit status., Danny Milosavljevic, 2017/07/03
- 43/197: installer: Rename module "new" to "guixsd-installer"., Danny Milosavljevic, 2017/07/03
- 42/197: installer: Wrap installer in (catch #t ...), Danny Milosavljevic, 2017/07/03
- 48/197: installer: Close unused ports in pipe-cmd., Danny Milosavljevic, 2017/07/03
- 47/197: installer: Improve install page., Danny Milosavljevic, 2017/07/03
- 29/197: installer: Add a task to actually call guix system init., Danny Milosavljevic, 2017/07/03
- 53/197: installer: Change N_ from a procedure to a macro., Danny Milosavljevic, 2017/07/03
- 50/197: installer: Issue message to user on failure of filesystems task.,
Danny Milosavljevic <=
- 61/197: installer: Indicate which wireless access points are encrypted., Danny Milosavljevic, 2017/07/03
- 59/197: installer: Format configuration to fix width of window., Danny Milosavljevic, 2017/07/03
- 65/197: installer: Ensure that all mount points are absolute paths., Danny Milosavljevic, 2017/07/03
- 09/197: installer: Use a record instead of a list to contain tasks., Danny Milosavljevic, 2017/07/03
- 23/197: installer: Use a cleaner way of generating the lspci information., Danny Milosavljevic, 2017/07/03
- 35/197: installer: New predicate valid-hostname?, Danny Milosavljevic, 2017/07/03
- 36/197: installer: Ensure that all mount-points have a file system., Danny Milosavljevic, 2017/07/03
- 39/197: installer: Replace an instance of cdr with match., Danny Milosavljevic, 2017/07/03
- 46/197: installer: Replace "%temporary-configuration-file-port" with "config-file"., Danny Milosavljevic, 2017/07/03
- 30/197: installer: Write the configuration to a temporary file., Danny Milosavljevic, 2017/07/03