version wingo@pobox.com-20070608115513-otkosq3sy6buolre 111 2d091585a5d8e8c37f562d0089944a20ef409372 wingo@pobox.com-20070608115513-otkosq3sy6buolre #!/bin/sh wingo@pobox.com-20070608115513-otkosq3sy6buolre # -*- scheme -*- wingo@pobox.com-20070608115513-otkosq3sy6buolre exec guile --debug -s $0 "$@" wingo@pobox.com-20070608115513-otkosq3sy6buolre !# wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (use-modules (texinfo reflection) wingo@pobox.com-20070608115513-otkosq3sy6buolre (texinfo html) wingo@pobox.com-20070608115513-otkosq3sy6buolre (sxml simple) wingo@pobox.com-20070608115513-otkosq3sy6buolre (sxml transform) wingo@pobox.com-20070608115513-otkosq3sy6buolre ((srfi srfi-13) :select (string-join))) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (makedirs path) wingo@pobox.com-20070608115513-otkosq3sy6buolre (let loop ((path ".") (components (string-split path #\/))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (if (not (null? components)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (let ((sub-path (string-append path "/" (car components)))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (if (or (not (file-exists? sub-path)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (not (file-is-directory? sub-path))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (mkdir sub-path)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (loop sub-path (cdr components)))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (wrap-html title root-path scm-url body) wingo@pobox.com-20070608115513-otkosq3sy6buolre `(html (@ (xmlns "http://www.w3.org/1999/xhtml")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (head wingo@pobox.com-20070608115513-otkosq3sy6buolre (title ,title) wingo@pobox.com-20070608115513-otkosq3sy6buolre (meta (@ (name "Generator") wingo@pobox.com-20070608115513-otkosq3sy6buolre (content "The Guile SXML Toolkit"))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (style (@ (type "text/css") (media "screen")) wingo@pobox.com-20070608115513-otkosq3sy6buolre "@import url(" wingo@pobox.com-20070608115513-otkosq3sy6buolre ,(string-append root-path "base.css") wingo@pobox.com-20070608115513-otkosq3sy6buolre ");")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (body wingo@pobox.com-20070608115513-otkosq3sy6buolre (div (@ (id "body")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (h1 (@ (id "heading")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (a (@ (href ,root-path)) "guile-lib")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (div (@ (id "text")) wingo@pobox.com-20070608115513-otkosq3sy6buolre (h2 (@ (class "centered")) ,title) wingo@pobox.com-20070608115513-otkosq3sy6buolre ,@body) wingo@pobox.com-20070608115513-otkosq3sy6buolre (div (@ (id "footer")) wingo@pobox.com-20070608115513-otkosq3sy6buolre "powered by sxml"))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define xhtml-doctype wingo@pobox.com-20070608115513-otkosq3sy6buolre (string-append wingo@pobox.com-20070608115513-otkosq3sy6buolre "\n\n")) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (module->str scm) wingo@pobox.com-20070608115513-otkosq3sy6buolre (call-with-output-string (lambda (p) (display scm p)))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (module->ustr scm) wingo@pobox.com-20070608115513-otkosq3sy6buolre (string-append (string-join (map symbol->string scm) ".") "/")) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (make-html-index) wingo@pobox.com-20070608115513-otkosq3sy6buolre (with-output-to-file "html/index.html" wingo@pobox.com-20070608115513-otkosq3sy6buolre (lambda () wingo@pobox.com-20070608115513-otkosq3sy6buolre (display xhtml-doctype) wingo@pobox.com-20070608115513-otkosq3sy6buolre (sxml->xml wingo@pobox.com-20070608115513-otkosq3sy6buolre (pre-post-order wingo@pobox.com-20070608115513-otkosq3sy6buolre (stexi->shtml wingo@pobox.com-20070608115513-otkosq3sy6buolre `(texinfo wingo@pobox.com-20070608115513-otkosq3sy6buolre (% (title "unused")) wingo@pobox.com-20070608115513-otkosq3sy6buolre ,@(cdr wingo@pobox.com-20070608115513-otkosq3sy6buolre (package-stexi-standard-copying wingo@pobox.com-20070608115513-otkosq3sy6buolre *name* *version* *updated* *years* *copyright-holder* wingo@pobox.com-20070608115513-otkosq3sy6buolre *permissions*)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (table wingo@pobox.com-20070608115513-otkosq3sy6buolre (% (formatter (bold))) wingo@pobox.com-20070608115513-otkosq3sy6buolre ,@(map wingo@pobox.com-20070608115513-otkosq3sy6buolre (lambda (module description) wingo@pobox.com-20070608115513-otkosq3sy6buolre `(entry wingo@pobox.com-20070608115513-otkosq3sy6buolre (% (heading wingo@pobox.com-20070608115513-otkosq3sy6buolre (uref (% (url ,(module->ustr module)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (title ,(module->str module)))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre ,@description)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (map car *modules*) (map cdr *modules*))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre `((html . ,(lambda (tag attrs head body) wingo@pobox.com-20070608115513-otkosq3sy6buolre (wrap-html wingo@pobox.com-20070608115513-otkosq3sy6buolre *name* wingo@pobox.com-20070608115513-otkosq3sy6buolre *html-relative-root-path* wingo@pobox.com-20070608115513-otkosq3sy6buolre "index.scm" wingo@pobox.com-20070608115513-otkosq3sy6buolre (cdr body)))) ;; cdr past the 'body tag wingo@pobox.com-20070608115513-otkosq3sy6buolre (*text* . ,(lambda (tag text) text)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (*default* . ,(lambda args args)))))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (make-html-module-pages) wingo@pobox.com-20070608115513-otkosq3sy6buolre (for-each wingo@pobox.com-20070608115513-otkosq3sy6buolre (lambda (module) wingo@pobox.com-20070608115513-otkosq3sy6buolre (let* ((ustr (string-append "./html/" (module->ustr module))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (port (begin wingo@pobox.com-20070608115513-otkosq3sy6buolre (makedirs ustr) wingo@pobox.com-20070608115513-otkosq3sy6buolre (open-output-file (string-append ustr "index.html"))))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (display xhtml-doctype port) wingo@pobox.com-20070608115513-otkosq3sy6buolre (sxml->xml wingo@pobox.com-20070608115513-otkosq3sy6buolre (pre-post-order wingo@pobox.com-20070608115513-otkosq3sy6buolre (stexi->shtml (module-stexi-documentation module)) wingo@pobox.com-20070608115513-otkosq3sy6buolre `((html . ,(lambda (tag attrs head body) wingo@pobox.com-20070608115513-otkosq3sy6buolre (wrap-html wingo@pobox.com-20070608115513-otkosq3sy6buolre (module->str module) wingo@pobox.com-20070608115513-otkosq3sy6buolre (string-append "../" *html-relative-root-path*) wingo@pobox.com-20070608115513-otkosq3sy6buolre "../index.scm" wingo@pobox.com-20070608115513-otkosq3sy6buolre (cdr body)))) ;; cdr past the 'body tag wingo@pobox.com-20070608115513-otkosq3sy6buolre (*text* . ,(lambda (tag text) text)) wingo@pobox.com-20070608115513-otkosq3sy6buolre (*default* . ,(lambda args args)))) wingo@pobox.com-20070608115513-otkosq3sy6buolre port))) wingo@pobox.com-20070608115513-otkosq3sy6buolre (map car *modules*))) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (define (main config-scm) wingo@pobox.com-20070608115513-otkosq3sy6buolre (load config-scm) wingo@pobox.com-20070608115513-otkosq3sy6buolre (makedirs "./html") wingo@pobox.com-20070608115513-otkosq3sy6buolre (make-html-index) wingo@pobox.com-20070608115513-otkosq3sy6buolre (make-html-module-pages)) wingo@pobox.com-20070608115513-otkosq3sy6buolre wingo@pobox.com-20070608115513-otkosq3sy6buolre (apply main (cdr (command-line))) end wingo@pobox.com-20070608115513-otkosq3sy6buolre version wingo@pobox.com-20070608154800-lcici2flg28w3a3o 2 46c8563a14a7413fb23c3142e9ac6d9bb8c51c6c 33,34,1 wingo@pobox.com-20070608154800-lcici2flg28w3a3o (a (@ (href ,root-path)) ,*name*)) end wingo@pobox.com-20070608154800-lcici2flg28w3a3o