Type conversion

diff --git a/Makefile.am b/Makefile.am
index 7246140430490fba8a782c5586cada6ad2749b18..0e24758815c53311e989d45eaf57deebeb8fd293 100644 (file)
--- a/Makefile.am
+++ b/Makefile.am
@@ -42,7 +42,8 @@ SOURCES =                                     \
   click.scm                                     \
   click/constant.scm                            \
   click/display.scm                             \
   click.scm                                     \
   click/constant.scm                            \
   click/display.scm                             \

-  click/util.scm
+  click/util.scm                                \
+  click/value.scm

 
 TESTS =                                                \
   tests/util.scm
 
 TESTS =                                                \
   tests/util.scm

diff --git a/click/display.scm b/click/display.scm
index dab99b0d25d8dfba4235b18186890d3b8102d0bc..968a063e1677df54684c2a4a3fcc18229c60af33 100644 (file)
--- a/click/display.scm
+++ b/click/display.scm
@@ -24,17 +24,9 @@
             display-help))
 
 
             display-help))
 
 

-(define (get-option-type option)
+(define (get-type-description option)

   "Return allowed type for the value in the 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]
         
 (define (display-help procedure option-spec)
   (format #t "Usage: ~a [OPTIONS]


@@ -56,7 +48,7 @@ Options:
                                        (let ((value
                                               (not (option-property option 'flag))))
                                          (if value
                                        (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))
                                              "")))
                                (option-property option 'help "")))
                        option-spec))


@@ -64,7 +56,11 @@ Options:
                                      (string-length (car option)))
                                    options)))))
     (for-each (lambda (option)
                                      (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)
               options)))
 
 (define (display-error wrong-option)

diff --git a/click/util.scm b/click/util.scm
index 8a4f771676e14e985772e1d08c8af37cc3c95e62..c3ac062cd606aeff46bf46a1bfc03cc58d35055a 100644 (file)
--- a/click/util.scm
+++ b/click/util.scm
@@ -18,11 +18,10 @@
 
 
 (define-module (click util)
 
 
 (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
   #:use-module (click constant)
   #:export (getopt-long-option-spec
             option-property

+            option-type

             program-name
             %program-name))
 
             program-name
             %program-name))
 


@@ -31,7 +30,9 @@
 (define (program-name)
   (fluid-ref %program-name))
 
 (define (program-name)
   (fluid-ref %program-name))
 

+

 (define (getopt-long-option-spec option-spec)
 (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)))
   (map (lambda (option)
          (cons (car option)
                (cons (list 'value (not (option-property option 'flag)))


@@ -40,8 +41,34 @@
                              (cdr option)))))
        option-spec))
 
                              (cdr option)))))
        option-spec))
 

+

 (define* (option-property option property-name #:optional (default #f))
 (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)))
   (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))))

diff --git a/click/value.scm b/click/value.scm
index ec00445a0ec7ac104907f35a06c18795fd1a8a21..f42eb2f3b1921a065e0a3a9202ed48e77874e16a 100644 (file)
--- a/click/value.scm
+++ b/click/value.scm
@@ -32,14 +32,25 @@
         (else
          (let* ((option (car option-spec))
                 (option-name (car option))
         (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))))))
 
 
            (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))
 (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)))
   (let ((default (option-property option 'default)))
     (if (not default)
         (let ((prompt (option-property option 'prompt)))