@@ -420,7 +420,6 @@ (define steps (#$steps current-installer))
(dynamic-wind
(installer-init current-installer)
-
(lambda ()
(parameterize
((run-command-in-installer
@@ -439,15 +438,15 @@ (define results
(sync)
(stop-service 'root))
(_
- ;; The installation failed, exit so that it is restarted
- ;; by login.
+ ;; The installation failed, exit so that it is
+ ;; restarted by login.
#f)))
(const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
key args)
- (define dump-dir (prepare-dump key args
- #:result %current-result))
+ (define dump-dir
+ (prepare-dump key args #:result %current-result))
(define action
((installer-exit-error current-installer)
(get-string-all
@@ -458,7 +457,8 @@ (define action
(let* ((dump-files
((installer-dump-page current-installer)
dump-dir))
- (dump-archive (make-dump dump-dir dump-files)))
+ (dump-archive
+ (make-dump dump-dir dump-files)))
((installer-report-page current-installer)
dump-archive)))
(_ #f))
@@ -45,6 +45,7 @@ (define-module (gnu installer newt)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 ftw)
+ #:use-module (ice-9 match)
#:use-module (newt)
#:export (newt-installer))
@@ -71,8 +72,8 @@ (define action
#:content error
#:buttons-spec
(list
- (cons (G_ "Exit") (const 'exit))
- (cons (G_ "Dump") (const 'dump)))))
+ (cons (G_ "Dump") (const 'dump))
+ (cons (G_ "Exit") (const 'exit)))))
(newt-set-color COLORSET-ROOT "white" "blue")
action)
@@ -96,10 +97,11 @@ (define files
(scandir dump-dir (lambda (x)
(not (or (string=? x ".")
(string=? x ".."))))))
- (fold (lambda (file-choice acc)
- (if (cdr file-choice)
- (cons (car file-choice) acc)
- acc))
+ (fold (match-lambda*
+ (((file . enable?) acc)
+ (if enable?
+ (cons file acc)
+ acc)))
'()
(run-dump-page
dump-dir
@@ -144,7 +146,7 @@ (define stop-sig (status:stop-sig result))
(cons "Abort"
(lambda ()
(abort-to-prompt 'installer-step 'abort)))
- (cons "Dump"
+ (cons "Report"
(lambda ()
(raise
(condition
@@ -910,22 +910,29 @@ (define info-textbox
(define components
(map (match-lambda ((file . enabled)
(list
- (make-button -1 -1 "Edit")
+ (make-compact-button -1 -1 "Edit")
(make-checkbox -1 -1 file (if enabled #\x #\ ) " x")
file)))
file-choices))
+
+ (define sub-grid (make-grid 2 (length components)))
+
+ (for-each
+ (match-lambda* (((button checkbox _) index)
+ (set-grid-field sub-grid 0 index
+ GRID-ELEMENT-COMPONENT checkbox
+ #:anchor ANCHOR-LEFT)
+ (set-grid-field sub-grid 1 index
+ GRID-ELEMENT-COMPONENT button
+ #:anchor ANCHOR-LEFT)))
+ components (iota (length components)))
+
(define grid
- (apply vertically-stacked-grid
+ (vertically-stacked-grid
GRID-ELEMENT-COMPONENT info-textbox
- (append
- (append-map
- (match-lambda ((button checkbox _)
- (list GRID-ELEMENT-SUBGRID
- (horizontal-stacked-grid
- GRID-ELEMENT-COMPONENT checkbox
- GRID-ELEMENT-COMPONENT button))))
- components)
- (list GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create")))))
+ GRID-ELEMENT-SUBGRID sub-grid
+ GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create")))
+
(define form (make-form #:flags FLAG-NOF12))
(add-form-to-grid grid form #t)
@@ -942,13 +949,13 @@ (define prompt-tag (make-prompt-tag))
(match exit-reason
('exit-component
(let ((result
- (map (match-lambda
- ((edit checkbox filename)
- (if (components=? edit argument)
- (abort-to-prompt prompt-tag filename)
- (cons filename (eq? #\x
- (checkbox-value checkbox))))))
- components)))
+ (map (match-lambda
+ ((edit checkbox filename)
+ (if (components=? edit argument)
+ (abort-to-prompt prompt-tag filename)
+ (cons filename (eq? #\x
+ (checkbox-value checkbox))))))
+ components)))
(destroy-form-and-pop form)
result))
;; TODO
@@ -41,6 +41,7 @@ (define-record-type <secret>
(make-secret content)
secret?
(content secret-content))
+
(set-record-type-printer!
<secret>
(lambda (secret port)
@@ -108,19 +108,20 @@ (define dummy-pipe
(close-pipe dummy-pipe)))
(define (run-external-command-with-line-hooks line-hooks command)
- "Run command specified by ARGS in a child, processing each output line with
-the procedures in LINE-HOOKS. Returns the integer status value of
-the child process as returned by waitpid."
+ "Run command specified by the list COMMAND in a child, processing each
+output line with the procedures in LINE-HOOKS. Returns the integer status
+value of the child process as returned by waitpid."
(define (handler input)
- (and (and=> (get-line input)
- (lambda (line)
- (if (eof-object? line)
- #f
- (begin (for-each (lambda (f) (f line))
- (append line-hooks
- %default-installer-line-hooks))
- #t))))
- (handler input)))
+ (and
+ (and=> (get-line input)
+ (lambda (line)
+ (if (eof-object? line)
+ #f
+ (begin (for-each (lambda (f) (f line))
+ (append line-hooks
+ %default-installer-line-hooks))
+ #t))))
+ (handler input)))
(run-external-command-with-handler handler command))
(define* (run-command command)--8