96e9e6e10c
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
52 lines
1.8 KiB
Scheme
52 lines
1.8 KiB
Scheme
#lang scheme/base
|
|
(require scheme/unit "option-sig.ss")
|
|
|
|
(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@
|
|
(import)
|
|
(export setup-option^)
|
|
|
|
(define-flag-param verbose #f)
|
|
(define-flag-param make-verbose #f)
|
|
(define-flag-param compiler-verbose #f)
|
|
(define-flag-param clean #f)
|
|
(define-flag-param compile-mode #f)
|
|
(define-flag-param make-zo #t)
|
|
(define-flag-param make-launchers #t)
|
|
(define-flag-param make-info-domain #t)
|
|
(define-flag-param make-docs #t)
|
|
(define-flag-param make-user #t)
|
|
(define-flag-param make-planet #t)
|
|
(define-flag-param call-install #t)
|
|
(define-flag-param call-post-install #t)
|
|
(define-flag-param pause-on-errors #f)
|
|
(define-flag-param force-unpacks #f)
|
|
(define-flag-param doc-pdf-dest #f)
|
|
|
|
(define specific-collections (make-parameter null))
|
|
(define specific-planet-dirs (make-parameter null))
|
|
|
|
(define archives (make-parameter null))
|
|
|
|
(define current-target-directory-getter (make-parameter current-directory))
|
|
(define current-target-plt-directory-getter
|
|
(make-parameter
|
|
(lambda (preferred main-collects-parent-dir choices) preferred))))
|