[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
10/197: installer: Perform a task's dependencies prior to the task itsel
From: |
Danny Milosavljevic |
Subject: |
10/197: installer: Perform a task's dependencies prior to the task itself. |
Date: |
Mon, 3 Jul 2017 20:36:51 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit fd77ac1704ec113abbd5de28c00b5175012a979e
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)))
- 19/197: installer: Remove unused procedure., (continued)
- 19/197: installer: Remove unused procedure., Danny Milosavljevic, 2017/07/03
- 18/197: installer: Handle the 'back' action in the filesystems task., Danny Milosavljevic, 2017/07/03
- 13/197: installer: Add alternate method of finding TZDIR., Danny Milosavljevic, 2017/07/03
- 31/197: installer: Make minumum-store-size variable global., Danny Milosavljevic, 2017/07/03
- 33/197: installer: Improve dependencies on the final task., Danny Milosavljevic, 2017/07/03
- 17/197: installer: Add completion predicate for disk task., Danny Milosavljevic, 2017/07/03
- 21/197: installer: Fix incorrect host in ping task., Danny Milosavljevic, 2017/07/03
- 20/197: installer: Return slurped lines in their correct order., Danny Milosavljevic, 2017/07/03
- 25/197: installer: Connect ethernet interfaces on selection., Danny Milosavljevic, 2017/07/03
- 03/197: installer: Remove obsolete procedures/variables, Danny Milosavljevic, 2017/07/03
- 10/197: installer: Perform a task's dependencies prior to the task itself.,
Danny Milosavljevic <=
- 22/197: installer: Make "interfaces" return an alist., Danny Milosavljevic, 2017/07/03
- 26/197: installer: Let the kernel know about (possibly) changed partitions., Danny Milosavljevic, 2017/07/03
- 27/197: installer: Deal with partition tables which are (partially) corrupt., Danny Milosavljevic, 2017/07/03
- 28/197: installer: Add a variable to represent the minimum recommended store size., Danny Milosavljevic, 2017/07/03
- 32/197: installer: Remove ad-hoc completed predicate and use standard one., Danny Milosavljevic, 2017/07/03
- 34/197: installer: Replace some instances of "car"., Danny Milosavljevic, 2017/07/03
- 40/197: installer: Turn off kernel ring messages to console., Danny Milosavljevic, 2017/07/03
- 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