about summary refs log tree commit diff stats
path: root/wikme.scm
blob: 3b9a5ae606b3d68f494dd4ceb22f78c4dde1e075 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
;;; Wikme --- executable bit
;; wikme [options...] [source-directory]

(cond-expand
  (r7rs)
  (chicken-5
   (import (r7rs))))

(import (wikme)
        (scheme)
        (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)
  (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))