[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
10/21: installer: Perform a task's dependencies prior to the task itself
From: |
John Darrington |
Subject: |
10/21: installer: Perform a task's dependencies prior to the task itself. |
Date: |
Thu, 22 Dec 2016 19:58:40 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit 7a76f1ecf60f75025ffd46f794f29b59ab7a6974
Author: John Darrington <address@hidden>
Date: Tue Dec 20 19:42:10 2016 +0100
installer: Perform a task's dependencies prior to the task itself.
* gnu/system/installer/misc.scm (host-name): Redefine to empty string.
* gnu/system/installer/new.scm (do-task, do-task-list): New procedures,
(main-page-key-handler): Use new do-task procedure,
(main-options): Redefine.
---
gnu/system/installer/misc.scm | 2 +-
gnu/system/installer/new.scm | 51 +++++++++++++++++++++++++----------------
2 files changed, 32 insertions(+), 21 deletions(-)
diff --git a/gnu/system/installer/misc.scm b/gnu/system/installer/misc.scm
index 0503424..aa30bdd 100644
--- a/gnu/system/installer/misc.scm
+++ b/gnu/system/installer/misc.scm
@@ -30,5 +30,5 @@
(define time-zone "")
-(define host-name #f)
+(define host-name "")
diff --git a/gnu/system/installer/new.scm b/gnu/system/installer/new.scm
index b1e0196..a9acbfe 100644
--- a/gnu/system/installer/new.scm
+++ b/gnu/system/installer/new.scm
@@ -59,15 +59,15 @@
`(
(disk . ,(make-task partition-menu-title
'()
- (lambda () #t)
+ (lambda () #f)
(lambda (page)
(make-disk-page
page
partition-menu-title))))
(filesystems . ,(make-task filesystem-menu-title
- '()
- (lambda () #t)
+ '(disk)
+ (lambda () (not (null? mount-points)))
(lambda (page)
(make-filesystem-page
page
@@ -75,7 +75,7 @@
(network . ,(make-task network-menu-title
'()
- (lambda () #t)
+ (lambda () #f)
(lambda (page)
(make-network-page
page
@@ -83,17 +83,16 @@
(timezone . ,(make-task timezone-menu-title
'()
- (lambda () #t)
+ (lambda () (not (equal? "" time-zone)))
(lambda (page)
(make-tz-browser
page
(getenv "TZDIR")
page-stack))))
-
(hostname . ,(make-task hostname-menu-title
'()
- (lambda () #t)
+ (lambda () (not (equal? "" host-name)))
(lambda (page)
(make-host-name-page
page
@@ -101,8 +100,8 @@
(generate . ,(make-task
(N_ "Generate the configuration")
- '()
- (lambda () #t)
+ '(filesystems hostname timezone)
+ (lambda () #f)
(lambda (page)
(make-dialog
page
@@ -174,29 +173,42 @@
(set! page-stack (cons p page-stack))
((page-refresh p) p)))))))
+(define (do-task task-name page)
+ "Queue the task whose name is TASK-NAME and any dependencies"
+ (let ((task (assoc-ref main-options task-name)))
+ (set! page-stack (cons ((task-init task) page) page-stack))
+ (do-task-list (task-dependencies task) page)))
+
+(define (do-task-list task-name-list page)
+ "Queue the tasks whose names are the members of TASK-NAME-LIST"
+
+ (for-each
+ (lambda (task-name)
+ (let ((task (assoc-ref main-options task-name)))
+ (if (not ((task-complete? task)))
+ (do-task task-name page))))
+ task-name-list))
+
(define (main-page-key-handler page ch)
(let ((main-menu (page-datum page 'menu)))
(std-menu-key-handler main-menu ch)
(cond
((eq? ch #\newline)
- (let ((mi (menu-current-item main-menu))
- (item (menu-get-current-item main-menu)))
-
- (let ((direct-page ((task-init (cdr item)) page)))
- (set! page-stack (cons direct-page page-stack))
- ((page-refresh (car page-stack)) (car page-stack))))))))
-
+ (let ((item (menu-get-current-item main-menu)))
+ (do-task (car item) page)
+ ((page-refresh (car page-stack)) (car page-stack)))))))
(define (main-page-init page)
(let* ((frame (make-boxed-window (page-surface page) (lines) (cols) 0 0
- #:title (page-title page)))
- (background (car frame)))
+ #:title (page-title page)))
+ (background (car frame)))
(let ((win (derwin background (- (getmaxy background) 3)
(- (getmaxx background) 2) 0 1 #:panel #f))
(main-menu (make-menu main-options
#:disp-proc (lambda (datum row)
- (format #f "~a" (task-title (cdr
datum)))))))
+ (format #f "~a"
+ (task-title (cdr
datum)))))))
(page-set-wwin! page frame)
(page-set-datum! page 'menu main-menu)
@@ -241,7 +253,6 @@
(curs-set 0)
-
(let ((page (make-page
stdscr (gettext "GuixSD Installer")
main-page-refresh main-page-key-handler)))
- 14/21: installer: Add alternate method of finding TZDIR., (continued)
- 14/21: installer: Add alternate method of finding TZDIR., John Darrington, 2016/12/22
- 21/21: gnu: guix: Add dependency: guile-ncurses., John Darrington, 2016/12/22
- 17/21: installer: Add new procedure to get the list of volumes., John Darrington, 2016/12/22
- 18/21: installer: Add completion predicate for disk task., John Darrington, 2016/12/22
- 04/21: installer: Fix broken timezone menu., John Darrington, 2016/12/22
- 11/21: installer: Change "interfaces" from a variable to a procedure., John Darrington, 2016/12/22
- 13/21: installer: Use call-with-temporary-output-file., John Darrington, 2016/12/22
- 08/21: installer: Add IETF contraints for hostname in entry form., John Darrington, 2016/12/22
- 19/21: installer: Handle the 'back' action in the filesystems task., John Darrington, 2016/12/22
- 12/21: installer: Add gurses modules., John Darrington, 2016/12/22
- 10/21: installer: Perform a task's dependencies prior to the task itself.,
John Darrington <=
- 09/21: installer: Use a record instead of a list to contain tasks., John Darrington, 2016/12/22
- 16/21: installer: Use %default-subsitute-urls instead of our own variable., John Darrington, 2016/12/22
- 15/21: installer: Add procedures to replace car/cdr since these are frounded upon by Guile gurus., John Darrington, 2016/12/22
- 01/21: gnu: Add graphical installer, John Darrington, 2016/12/22