wiki2html.scm

#!/bin/sh
#| -*- scheme -*-
exec csi -s $0 "$@"
|#

(cond-expand
 (chicken-4
  (use qwiki utils svnwiki-sxml sxml-transforms))
 (chicken-5
  (import (chicken format)
          (chicken pathname)
          (chicken port)
          (chicken process-context)
          (chicken string))
  (import qwiki svnwiki-sxml sxml-transforms srfi-1 srfi-13))
 (else
  (error "Unsupported CHICKEN version.")))

(define sxml->html
  (let ((rules `((literal *preorder* . ,(lambda (t b) b))
                 . ,universal-conversion-rules*)))
    (lambda (sxml)
      (with-output-to-string
        (lambda ()
          (SRV:send-reply (pre-post-order* sxml rules)))))))

(define (read-wiki-file file)
  (with-output-to-string
    (lambda ()
      (write-content
       (call-with-input-file file svnwiki->sxml)))))

(define (wiki->html file #!key title css menu)
  (sxml->html
   `((literal "<!DOCTYPE html>")
     (html
      (head
       (title ,(or title "CHICKEN Scheme"))
       (meta (@ (http-equiv "Content-Type")
                (content "application/xhtml+xml; charset=utf-8")))
       (link (@ (rel "stylesheet")
                (href ,(if css
                           css
                           "http://wiki.call-cc.org/chicken.css"))
                (type "text/css")))
       (link (@ (rel "icon")
                (href "http://call-cc.org/favicon.ico")
                (type "image/x-icon"))))
      ,(if menu
           `(div (@ (id "menu"))
                 (literal ,(read-wiki-file menu)))
           '())
      (div (@ (id "content"))
           (literal ,(read-wiki-file file)))))))

(define (usage #!optional exit-code)
  (let ((port (if (and exit-code (not (zero? exit-code)))
                  (current-error-port)
                  (current-output-port))))
    (fprintf port
             "~a [--css <css URI>] [--title <page title>] [--menu <menu file>] <wiki-file>\n"
             (pathname-strip-directory (program-name)))
    (when exit-code (exit exit-code))))


(let ((wiki-file #f)
      (css #f)
      (title #f)
      (menu-file #f))
  (let loop ((args (command-line-arguments)))
    (if (null? args)
        (if wiki-file
            (print (wiki->html wiki-file
                               css: css
                               title: title
                               menu: menu-file))
            (usage 1))
        (let ((arg (car args)))
          (cond ((or (equal? arg "-h")
                     (equal? arg "--help"))
                 (usage 0))
                ((equal? arg "--css")
                 (set! css (cadr args))
                 (loop (cddr args)))
                ((equal? arg "--title")
                 (set! title (cadr args))
                 (loop (cddr args)))
                ((equal? arg "--menu")
                 (set! menu (cadr args))
                 (loop (cddr args)))
                (else
                 (set! wiki-file arg)
                 (loop (cdr args))))))))