Some parameters were not set from command line flags. I moved the
code that does this setting into option-unit, so a single macro is used to mark a parameter as settable by flags. This is so this will not happen again in the future. svn: r9793
This commit is contained in:
parent
87375f0c85
commit
96e9e6e10c
|
@ -1,28 +1,44 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require scheme/unit "option-sig.ss")
|
(require scheme/unit "option-sig.ss")
|
||||||
|
|
||||||
(provide setup:option@)
|
(provide setup:option@ set-flag-params)
|
||||||
|
|
||||||
|
;; a way to define a parameter that is set from an alist of names and values
|
||||||
|
(define defined-flag-params (make-parameter '()))
|
||||||
|
(define-syntax-rule (define-flag-param name default)
|
||||||
|
(define name
|
||||||
|
(let ([param (make-parameter default)])
|
||||||
|
(defined-flag-params (cons (cons 'name param) (defined-flag-params)))
|
||||||
|
param)))
|
||||||
|
(define (set-flag-params* flags flag-params)
|
||||||
|
(for ([name+param flag-params])
|
||||||
|
(cond [(assq (car name+param) flags)
|
||||||
|
=> (lambda (x) ((cdr name+param) (cadr x)))])))
|
||||||
|
;; this macro is used to actually do the setting, `more ...' is for additional
|
||||||
|
;; parameters to set
|
||||||
|
(define-syntax-rule (set-flag-params flags more ...)
|
||||||
|
(set-flag-params* flags (list* (cons 'more more) ... (defined-flag-params))))
|
||||||
|
|
||||||
(define-unit setup:option@
|
(define-unit setup:option@
|
||||||
(import)
|
(import)
|
||||||
(export setup-option^)
|
(export setup-option^)
|
||||||
|
|
||||||
(define verbose (make-parameter #f))
|
(define-flag-param verbose #f)
|
||||||
(define make-verbose (make-parameter #f))
|
(define-flag-param make-verbose #f)
|
||||||
(define compiler-verbose (make-parameter #f))
|
(define-flag-param compiler-verbose #f)
|
||||||
(define clean (make-parameter #f))
|
(define-flag-param clean #f)
|
||||||
(define compile-mode (make-parameter #f))
|
(define-flag-param compile-mode #f)
|
||||||
(define make-zo (make-parameter #t))
|
(define-flag-param make-zo #t)
|
||||||
(define make-launchers (make-parameter #t))
|
(define-flag-param make-launchers #t)
|
||||||
(define make-info-domain (make-parameter #t))
|
(define-flag-param make-info-domain #t)
|
||||||
(define make-docs (make-parameter #t))
|
(define-flag-param make-docs #t)
|
||||||
(define make-user (make-parameter #t))
|
(define-flag-param make-user #t)
|
||||||
(define make-planet (make-parameter #t))
|
(define-flag-param make-planet #t)
|
||||||
(define call-install (make-parameter #t))
|
(define-flag-param call-install #t)
|
||||||
(define call-post-install (make-parameter #t))
|
(define-flag-param call-post-install #t)
|
||||||
(define pause-on-errors (make-parameter #f))
|
(define-flag-param pause-on-errors #f)
|
||||||
(define force-unpacks (make-parameter #f))
|
(define-flag-param force-unpacks #f)
|
||||||
(define doc-pdf-dest (make-parameter #f))
|
(define-flag-param doc-pdf-dest #f)
|
||||||
|
|
||||||
(define specific-collections (make-parameter null))
|
(define specific-collections (make-parameter null))
|
||||||
(define specific-planet-dirs (make-parameter null))
|
(define specific-planet-dirs (make-parameter null))
|
||||||
|
|
|
@ -21,27 +21,9 @@
|
||||||
main-collects-parent-dir))))
|
main-collects-parent-dir))))
|
||||||
|
|
||||||
;; Converting parse-cmdline results into parameter settings:
|
;; Converting parse-cmdline results into parameter settings:
|
||||||
(define (do-flag name param)
|
(set-flag-params x-flags
|
||||||
(cond [(assq name x-flags) => (lambda (a) (param (cadr a)))]))
|
;; these are not defined in option-unit
|
||||||
(define-syntax all-flags
|
all-users trust-existing-zos)
|
||||||
(syntax-rules () [(_ f ...) (begin (do-flag 'f f) ...)]))
|
|
||||||
(all-flags clean
|
|
||||||
make-zo
|
|
||||||
call-install
|
|
||||||
call-post-install
|
|
||||||
make-launchers
|
|
||||||
verbose
|
|
||||||
make-verbose
|
|
||||||
trust-existing-zos
|
|
||||||
pause-on-errors
|
|
||||||
force-unpacks
|
|
||||||
all-users
|
|
||||||
compile-mode
|
|
||||||
make-docs
|
|
||||||
make-user
|
|
||||||
make-planet
|
|
||||||
doc-pdf-dest)
|
|
||||||
|
|
||||||
(specific-collections x-specific-collections)
|
(specific-collections x-specific-collections)
|
||||||
(archives x-archives)
|
(archives x-archives)
|
||||||
(specific-planet-dirs x-specific-planet-packages)
|
(specific-planet-dirs x-specific-planet-packages)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user