click.scm \
click/constant.scm \
click/display.scm \
- click/util.scm
+ click/util.scm \
+ click/value.scm
TESTS = \
tests/util.scm
display-help))
-(define (get-option-type option)
+(define (get-type-description option)
"Return allowed type for the value in the option"
- (let ((default (option-property option 'default)))
- (cond ((not default)
- "TEXT")
- ((integer? default)
- "INTEGER")
- ((number? default)
- "NUMBER")
- (else
- "TEXT"))))
+ (assoc-ref (option-type option) 'description))
(define (display-help procedure option-spec)
(format #t "Usage: ~a [OPTIONS]
(let ((value
(not (option-property option 'flag))))
(if value
- (format #f " ~a" (get-option-type option))
+ (format #f " ~a" (get-type-description option))
"")))
(option-property option 'help "")))
option-spec))
(string-length (car option)))
options)))))
(for-each (lambda (option)
- (format #t " ~a~v_~a~%" (car option) (- sep (string-length (car option))) (cdr option)))
+ (format #t
+ " ~a~v_~a~%"
+ (car option)
+ (- sep (string-length (car option)))
+ (cdr option)))
options)))
(define (display-error wrong-option)
(define-module (click util)
- #:use-module (ice-9 getopt-long)
- #:use-module (ice-9 readline)
#:use-module (click constant)
#:export (getopt-long-option-spec
option-property
+ option-type
program-name
%program-name))
(define (program-name)
(fluid-ref %program-name))
+
(define (getopt-long-option-spec option-spec)
+ "Transform click option spec into getopt-long format"
(map (lambda (option)
(cons (car option)
(cons (list 'value (not (option-property option 'flag)))
(cdr option)))))
option-spec))
+
(define* (option-property option property-name #:optional (default #f))
+ "Return the option property with a given name"
(let ((property (assq property-name (cdr option))))
(if property
(cadr property)
default)))
+
+
+;; Types
+(define TYPE-TEXT
+ `((description . "TEXT")
+ (convert . ,identity)))
+(define TYPE-INTEGER
+ `((description . "INTEGER")
+ (convert . ,string->number)))
+(define TYPE-NUMBER
+ `((description . "NUMBER")
+ (convert . ,string->number)))
+
+(define (option-type option)
+ "Return allowed type for the value in the option"
+ (let ((default (option-property option 'default)))
+ (cond ((not default)
+ TYPE-TEXT)
+ ((integer? default)
+ TYPE-INTEGER)
+ ((number? default)
+ TYPE-NUMBER)
+ (else
+ TYPE-TEXT))))
(else
(let* ((option (car option-spec))
(option-name (car option))
- (value (or (option-ref values option-name #f)
- (get-option-default-value option))))
+ (value (get-normalized-value values option option-name)))
(cons (cons option-name value)
(get-values (cdr option-spec) values))))))
+(define (get-normalized-value values option option-name)
+ "Get value for option, converting from string to the appropriate value"
+ (let ((convert-proc (assoc-ref (option-type option) 'convert))
+ (value (option-ref values option-name #f)))
+ (cond ((and value (not (option-property option 'flag)))
+ (convert-proc value))
+ (value
+ value)
+ (else
+ (get-option-default-value option)))))
+
+
(define* (get-option-default-value option #:optional (no-prompt #f))
- "Get value for option, asking user if prompt property is set"
+ "Get default value for option, asking user if prompt property is set"
(let ((default (option-property option 'default)))
(if (not default)
(let ((prompt (option-property option 'prompt)))