#!/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 "") (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 ] [--title ] [--menu ] \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))))))))