[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
10/155: installer: Perform a task's dependencies prior to the task itsel
From: |
John Darrington |
Subject: |
10/155: installer: Perform a task's dependencies prior to the task itself. |
Date: |
Wed, 21 Dec 2016 20:48:30 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit e67e5489a540399c734b5e07f9c99f661712183a
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)))
- 34/155: import cran: Do not use "or later" licenses by default., (continued)
- 34/155: import cran: Do not use "or later" licenses by default., John Darrington, 2016/12/21
- 36/155: import cran: Handle BSD licenses with LICENSE file., John Darrington, 2016/12/21
- 15/155: doc: "Nar" now means "normalized archive"., John Darrington, 2016/12/21
- 14/155: Revert "gnu: kmod: Update to 23.", John Darrington, 2016/12/21
- 22/155: gnu: Add Greek Aspell dictionary, John Darrington, 2016/12/21
- 12/155: installer: Add gurses modules., John Darrington, 2016/12/21
- 35/155: import cran: Translate MIT to the Expat license., John Darrington, 2016/12/21
- 27/155: gnu: Add emacs-bui., John Darrington, 2016/12/21
- 47/155: gnu: sane-backends: Disable backend generation., John Darrington, 2016/12/21
- 17/155: gnu: tor: Recommend torsocks., John Darrington, 2016/12/21
- 10/155: installer: Perform a task's dependencies prior to the task itself.,
John Darrington <=
- 28/155: gnu: Add emacs-guix., John Darrington, 2016/12/21
- 30/155: gnu: star: Update to 2.5.2b., John Darrington, 2016/12/21
- 46/155: gnu: pinentry: Update to 1.0.0., John Darrington, 2016/12/21
- 52/155: gnu: r: Update to 3.3.2., John Darrington, 2016/12/21
- 44/155: import cran: Handle HTTP errors., John Darrington, 2016/12/21
- 26/155: gnu: imagemagick: Update to 6.9.6-8., John Darrington, 2016/12/21
- 40/155: import cran: Ignore default R packages., John Darrington, 2016/12/21
- 50/155: gnu: sane-backends: Remove timestamps from the output., John Darrington, 2016/12/21
- 39/155: import cran: description->package: Also return package dependencies., John Darrington, 2016/12/21
- 45/155: gnu: npth: Update to 1.3., John Darrington, 2016/12/21