Add command line arguments

1 files changed, 74 insertions, 4 deletions

@@ -1,9 +1,79 @@
-(import wikme
+;;; Wikme --- executable bit
+;; wikme [options...] [source-directory]
+
+(cond-expand
+  (r7rs)
+  (chicken-5
+   (import (r7rs))))
+
+(import (wikme)
         (scheme)
-        (chicken process-context))
+        (chicken port)
+        (chicken process-context)
+        (chicken string)
+        (args)
+        (utf8))
+
+(define opts
+  (list (args:make-option (o output) (required: "DIRECTORY")
+                          "Write wiki to DIRECTORY.")
+        (args:make-option (b base-url) (required: "URL")
+                          "Base url for links.")
+        (args:make-option (t template) (required: "FILE")
+                          "Template to expand wiki pages in.")
+        ;; XXX: These don't work at the moment.  The functions aren't seen by
+        ;; wikme at runtime, ugh.
+        ;; (args:make-option (S source-transformers) (required: "FUNCTION...")
+        ;;                   "Functions to transform page source code with.")
+        ;; (args:make-option (P path-transformers) (required: "FUNCTION...")
+        ;;                   "Functions to transform page paths with.")
+        (args:make-option (x extension) (required: "EXT")
+                          "Extension of source files.")
+        (args:make-option (h help) none: "Show this help and exit."
+                          (usage))))
+
+(define (usage #!optional exit-code)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (print "Usage: " (program-name) " [options...] [INPUT-DIRECTORY]")
+      (print "INPUT-DIRECTORY defaults to the current directory.")
+      (newline)
+      (print (args:usage opts))))
+  (exit 1))
 
 (define (main args)
-  (build-wiki "./test/"
-              destination: "./out/"))
+  (receive (options params) (args:parse args opts)
+    (define build-wiki-args
+      (let loop ((options options)
+                 (it '()))
+        (if (null? options)
+            it
+            (loop (cdr options)
+                  (append
+                   (let ((this (car options)))
+                     (case (car this)
+                       ((o output)
+                        `(destination: ,(cdr this)))
+                       ((b base-url)
+                        `(base-url: ,(cdr this)))
+                       ((t template)
+                        `(base-template: ,(cdr this)))
+                       ;; ((S source-transformers)
+                       ;;  `(source-transformers:
+                       ;;    ,(map (lambda (fn)
+                       ;;            (eval (string->symbol fn)))
+                       ;;          (string-split (cdr this) ","))))
+                       ;; ((P path-transformers)
+                       ;;  `(path-transformers:
+                       ;;   ,(map (lambda (fn)
+                       ;;           (eval (string->symbol fn)))
+                       ;;         (string-split (cdr this) ","))))
+                       ((x extension)
+                        `(source-extension: ,(cdr this)))))
+                   it)))))
+    (apply build-wiki (if (null? params)
+                          (current-directory)
+                          (car params))
+           build-wiki-args)))
 
 (main (command-line-arguments))