Changeset 13661 in project for chicken/trunk/scripts


Ignore:
Timestamp:
03/10/09 10:46:34 (11 years ago)
Author:
felix winkelmann
Message:

wiki2html work; fixed table in manual

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/scripts/wiki2html.scm

    r13659 r13661  
    8989                (lambda (m)
    9090                  (pop-all out)
    91                   (let ((n (sub1 (string-length (second m)))))
    92                     (fprintf out "<h~a>~a</h~a>~%" n (third m) n))))
     91                  (let ((n (sub1 (string-length (second m))))
     92                        (name (clean (third m))))
     93                    (fprintf out "<a name='~a' /><h~a>~a</h~a>~%"
     94                             name n name n))))
    9395               ((string-match (rx +pre+) ln) =>
    9496                (lambda (m)
    95                   (push-tag 'pre out)))
     97                  (push-tag 'pre out)
     98                  (display (clean (car m)))))
    9699               ((string-match (rx +hr+) ln) =>
    97100                (lambda (m)
     
    154157                     "<b>" (inline (second m)) "</b>"
    155158                     (continue m))))
    156                  ((search (rx `(: bos ,+italic+)) rest) =>
     159                 ((string-search (rx `(: bos ,+italic+)) rest) =>
    157160                  (lambda (m)
    158161                    (string-append
     
    162165      str))
    163166
    164 (define (convert)
     167(define (convert name)
    165168  (let ((sxml (html->sxml (open-input-string (with-output-to-string wiki->html)))))
    166169    (define (walk n)
    167170      (match n
    168         (('*PI* . _) n)
     171        (('*PI* . _) "")
     172        (('*TOP* . n) n)
    169173        (('enscript strs ...)
    170174         `(pre ,@strs))
    171175        (('procedure strs ...)
    172          `(pre "\n [procedure] " (tt ,@strs)))
     176         `(pre "\n [procedure] " ,@strs))
    173177        (((? symbol? tag) . body)
    174178         `(,tag ,@(map walk body)))
    175179        (_ n)))
    176     (display (shtml->html (walk sxml)))))
     180    (display
     181     (shtml->html
     182      (wrap name (walk sxml))))))
     183
     184(define (wrap name body)
     185  `(html (head (title ,(string-append "The CHICKEN User's Manual - " name)))
     186         (body ,@body)))
    177187
    178188
     
    180190
    181191(define (clean str)
    182   (string-translate* str '(("<" . "&lt;") ("&" . "&amp;") ("'" . "&quot;"))))
     192  (string-translate* str '(("<" . "&lt;") ("&" . "&amp;") ("'" . "&rsquo;"))))
    183193
    184194
     
    186196
    187197(define (main args)
    188   (match args
    189     ((dir)
    190      (set! *manual-pages* (map pathname-strip-directory (directory dir)))
    191      (convert))
    192     (_ (print "usage: wiki2html MANUALDIRECTORY")
    193        (exit 1))))
     198  (let ((outdir "."))
     199    (let loop ((args args))
     200      (match args
     201        (()
     202         (print "usage: wiki2html [-o DIRECTORY] PAGEFILE ...")
     203         (exit 1))
     204        (("-o" dir . more)
     205         (set! outdir dir)
     206         (loop more))
     207        ((files ...)
     208         (let ((dirs (delete-duplicates (map pathname-directory files) string=?)))
     209           (set! *manual-pages* (map pathname-strip-directory (append-map directory dirs)))
     210           (for-each
     211            (lambda (file)
     212              (print file)
     213              (with-input-from-file file
     214                (lambda ()
     215                  (with-output-to-file (pathname-replace-directory (string-append file ".html") outdir)
     216                    (cut convert (pathname-file file))))))
     217            files)))))))
     218
    194219
    195220(main (command-line-arguments))
Note: See TracChangeset for help on using the changeset viewer.