Extract command-line help information.

command-line.scm

@@ -33,6 +33,7 @@
  (import scheme
 	 (chicken base)
 	 (chicken process-context)
+	 (chicken format)
 	 testing)
 
  ;; Consumes given number of arguments from the list and returns the
@@ -75,9 +76,35 @@
 	   (apply proc aargs)
 	   (loop args))))))
 
+ ;; String representation of procedure arguments.
+ (define (procedure->argstring proc)
+   (let* ((info (procedure-information proc))
+	  (args (cdr info))
+	  (argss (sprintf "~A" args)))
+     (substring
+      (substring argss 0 (- (string-length argss) 1))
+      1)))
+
  ;; Prints options descriptions.
  (define (command-line:print-options specs)
-   (print "options"))
+   (let* ((descrs (map (lambda (spec)
+			 (list (car spec)
+			       (procedure->argstring (caddr spec))
+			       (cadr spec)))
+		       specs))
+	  (owidth (apply max (map (lambda (desc)
+				    (string-length (car desc)))
+				  descrs)))
+	  (awidth (apply max (map (lambda (desc)
+				    (string-length (cadr desc)))
+				  descrs))))
+     (let loop ((descrs descrs))
+       (when (not (null? descrs))
+	 (let ((desc (car descrs)))
+	   (print (car desc)
+		  (cadr desc)
+		  (caddr desc))
+	   (loop (cdr descrs)))))))
 
  ;; Syntax for expanding various types of options.
  (define-syntax make-option
@@ -109,6 +136,9 @@
     (test-equal? consume-args (consume-args '(1 2 3 4) 2) '((3 4) (1 2)))
     (test-equal? get-command-line-arguments (get-command-line-arguments 1 2 3) '(2 3))
     (test-equal? get-command-line-arguments (get-command-line-arguments 1 "--" 2 3) '(2 3))
+    (test-equal? procedure->argstring (procedure->argstring (lambda (x . y) 1)) "x . y")
+    (test-equal? procedure->argstring (procedure->argstring (lambda (x) 1)) "x")
+    (test-equal? procedure->argstring (procedure->argstring (lambda () 1)) "")
     ))
 
  )