Mole: The Scheme Code Digger Transforms Scheme programm to SXML document and generates some reports from it. $Id: mole.scm,v 3.7 2002/09/03 19:55:11 kl Exp kl $
read test-suite
Wrapper for next-token which remove break-character from input stream
Map children elements of the given nodeset using corresponding handlers for subnodes in accordance to their types. Each handler is a pair whose car is a tag name and cdr is a function of one argument to apply. If an element has a type which is supported by one of handlers then it is mapped using the function of this handler. If where is no handler for some element then it is omitted from the result. Sample call ((map-on-type `(tag . ,tag-handler) `(tag1 . ,tag1-handler)) c)
Modified version of Oleg Kiselyov's string->goodHTML Given a string, check to make sure it does not contain characters such as '<' or '&' that require encoding. While original version return either the original string, or a list of string fragments with special characters replaced by appropriate character entities, this function always returns a list.
Returns a hash value (as a string) for the given string
This functions read the Scheme code, parse it to its structural elements, and store it in the SXML tree.
This predicate is #t if the provided <str> is a "milestone"
of the specified kind.
This means that:
it starts with "(" character or
its first character is ";" and its
second character is member of <spec-chars> list provided
Returns two values: SXML node (comment ...) and next line read
Returns desription of a given s-expression Possible types of chunk: function macro app
Readers for chunks, sections, chapters and entire source file. Beginning of each structural part in the source file is marked with the special comment line, which begins with: ";=" - chapter ";-" - section "; " - chunk
The part of the source file till the next "milestone" is considered as one "chunk"
Reads xtest until ")" in first position of the line
This functions generate different kinds of reports about the Scheme program stored in the SXML tree
Display out verbatim content of textual subnode in HTML-ized form
Extract function declaration
Extract macro declaration
Unit entry in the table of content <toc-str> is a prefix in TOC <a-str> is used in "name" and "href" attributes
Produce a HTML document with the report generated from given Scheme source code in SXML format <dtree> If <rtype>'s possible are: 'nosrc 'src
Chapter entry in the table of content
Chapter content
Section entry in the table of content
Section content
Function entry in the table of content
Generate a function documentation. Source code is not included.
Generate a function documentation. Source code is included.
Generates test suite for a function.
Macro entry in the table of content
Generate a macro documentation. Source code is not included.
Generate a macro documentation. Source code is included.
Application entry in the table of content
Generate an applicaion documentation. Source code is not included.
Generate an application documentation. Source code is included.
configuration pool defined and options acceptable specified
Auxiliary options handling
If a custom report is requested, load the file with its description and call 'custom-report' function defined in this file with SXML tree parsed as its only parameter
Generate a report requested
read test-suite
(define (read-tests p)
(let rpt ((l (read p)) (rzt '()))
(if (eof-object? l)
rzt
(rpt (read p) (cons l rzt)))))
Wrapper for next-token which remove break-character from input stream
(define (next-token-closed prefix-skipped-chars break-chars)
(let ((token
(next-token prefix-skipped-chars break-chars)))
(read-char (current-input-port))
token))
Map children elements of the given nodeset using corresponding handlers for subnodes in accordance to their types. Each handler is a pair whose car is a tag name and cdr is a function of one argument to apply. If an element has a type which is supported by one of handlers then it is mapped using the function of this handler. If where is no handler for some element then it is omitted from the result. Sample call ((map-on-type `(tag . ,tag-handler) `(tag1 . ,tag1-handler)) c)
(define (map-on-type . handlers)
(lambda(node)
(map
(lambda(x)
((cdr (assq (sxml:name x) handlers)) x))
((select-kids
(ntype-names?? (map car handlers))) node))
))
Modified version of Oleg Kiselyov's string->goodHTML Given a string, check to make sure it does not contain characters such as '<' or '&' that require encoding. While original version return either the original string, or a list of string fragments with special characters replaced by appropriate character entities, this function always returns a list.
(define (string->goodHTML-list x)
(let ((rez (sxml:sxml->html x)))
(if (list? rez)
rez
(list rez))))
Returns a hash value (as a string) for the given string
(define (hash str)
(let ((len (string-length str))
(range ; hash range
(cond
(((if-car-sxpath '(hash *text*)) cfg-pool)
=> string->number)
(else 65535))))
(let rpt ((hash-value 0) (i (- len 1)))
(if (>= i 0)
(let ((x (+ (* hash-value 256)
(char->integer (string-ref str i)))))
(rpt (modulo x range) (- i 1)))
(number->string hash-value)))))
configuration pool defined and options acceptable specified
(define cfg-pool (argv->sxml (command-line)
'("V" "h" "--help" "l" "--custom" "--rep" "--tf" "--hash" "--title") ))
; ; Default command line options
; (for-each
; (lambda(var)
; (sxml:insert-unique! cfg-pool var))
; '((rep "html")
; (title "Automatically Generated Documentation")
; ))
Auxiliary options handling
(cond
; -v
(((if-sxpath '(v)) cfg-pool)
(cout "$Id: mole.scm,v 3.7 2002/09/03 19:55:11 kl Exp kl $" nl)
(exit 0))
; -l
(((if-sxpath '(l)) cfg-pool)
(cout nl "Copyright (C) 1999-2001 Kirill Lisovsky" nl nl
"This software is free, MIT-style license may be found in file COPYRIGHT"
nl nl)
(exit 0))
; -h --help
(((if-sxpath '((or@ h help))) cfg-pool)
(cout nl "Mole - The Scheme Code Digger" nl nl
"mole [ -v | -h | -l ]" nl;"mole [-rep *] [-stub] [-ndoc] [+|-fn *] [-hash *]" nl
"mole [--rep=... | --custom=...] [--hash=...] [--tf[=...]]" nl
" -h This help screen" nl
" -V Version information" nl
" -l License information" nl
" --tf[='file'] Include test fixture from 'file'" nl
" --custom='file' Customized report definition file name" nl
" --rep='type' The type of standard report to generate: " nl
;" --scm Scheme code" nl
" sxml SXML" nl
" xml XML" nl
" html (default) HTML doc with source code included" nl
" htmld HTML doc w/o source code" nl
;" --stub Just stubs for functions (for '--scm' only)" nl
;" --ndoc Do not include comments (for '--scm' only)" nl
;" --fi Including specified function (for '--scm' only)" nl
;" --fe Excluding specified function (for '--scm' only)" nl
" --title='title' Document title" nl
" --hash='range' Hash range (default: 65535) (for '-html*' only)" nl
) (exit 0)))
(define custom-report pp)
If a custom report is requested, load the file with its description and call 'custom-report' function defined in this file with SXML tree parsed as its only parameter
(cond
(((if-car-sxpath '(custom *text*)) cfg-pool)
=>
(lambda (fname)
(load fname)
(custom-report (read-scm-src))
(exit 0))))
(define test-fixture
(cond
(((if-car-sxpath '(tf)) cfg-pool)
=> (lambda(tfx)
(with-input-from-file
(cond
(((if-car-sxpath '(*text*)) tfx))
(else "test/xtest-fixture.scm"))
read-fixture)))
(else #f)))
Generate a report requested
(case
(cond
(((if-car-sxpath '(rep *text*)) cfg-pool)
=> string->symbol)
(else 'html))
((sxml)
(pp (read-scm-src)))
((xml)
(set! sxml:write-content
(lambda(content)
(cout "<![CDATA[" content "]" "]>")))
(sxml:write-xml (read-scm-src)))
((htmld)
(html-report (read-scm-src) 'nosrc)) ; ex #f -> 'nosrc
((html)
(html-report (read-scm-src) 'src)) ; ex #t
(else (cerr nl "Unsupported report type" nl) (exit -1)))
(exit 0)
This predicate is #t if the provided <str> is a "milestone"
of the specified kind.
This means that:
it starts with "(" character or
its first character is ";" and its
second character is member of <spec-chars> list provided
(define (milestone? str spec-chars sexpr?)
(and (> (string-length str) 1)
(or
(and sexpr?
(char=? (string-ref str 0) #\()) ;)
(and
(char=? (string-ref str 0) #\;)
(member (string-ref str 1) spec-chars)))))
Returns two values: SXML node (comment ...) and next line read
(define (read-scm-comment str-line)
(let rpt ((rzt "") (lnr str-line))
(let ((lnl (string-length lnr)))
(cond
; recursion
((and (not (eof-object? lnr))
(> lnl 0)
(char=? (string-ref lnr 0) #\;))
(rpt (string-append rzt
(skip-prefix '(#\; #\space) lnr))
(read-whole-line)))
; exit
(else (values rzt
lnr))))))
Returns desription of a given s-expression Possible types of chunk: function macro app
(define (expr-type expr)
(let ((expr-specializer ; extract the expression specializer
(lambda (expr)
(if (pair? (cadr expr)) (caadr expr) (cadr expr)))))
(cond
((not (pair? expr))
(cerr nl "Unexpected expression: " expr)
;(exit -1)
(list 'surprise expr)
)
((symbol? (car expr))
(case (car expr)
((define define-opt) `(function ,(expr-specializer expr)))
((define-macro) `(macro ,(expr-specializer expr)))
;((declare) expr) ; deprecated?
;((include) expr) ; deprecated?
(else
; (if (substring? "def" (symbol->string (car expr)))
; (list 'define-other (expr-specializer expr))
(list 'app (car expr)))))
;)
(else (list 'app (car expr))))
))
(define (read-scm-src)
(let rpt ((rzt '())
(lnr (read-whole-line)))
(cond
((eof-object? lnr)
`(*TOP* (module ,@(reverse rzt))))
; ";=" -> dive into a chapter
((milestone? lnr '(#\=) #f)
(call-with-values
read-scm-chapter
(lambda (r l) (rpt (cons r rzt) l))))
; ";-" -> dive into a section
((milestone? lnr '(#\-) #f)
(call-with-values
read-scm-section
(lambda (r l) (rpt (cons r rzt) l))))
; "; " -> dive into a chunk of code
((milestone? lnr '(#\space) #f)
(call-with-values
(lambda () (read-scm-chunk lnr))
(lambda (r l) (rpt (cons `(comment ,r) rzt) l))))
; ";;" -> dive into a comment
((milestone? lnr '(#\;) #f)
(call-with-values
(lambda () (read-scm-comment lnr))
(lambda (r l) (rpt (cons `(comment ,r) rzt) l))))
; recursion
(else
(rpt rzt (read-whole-line))))))
(define (read-scm-chapter)
(let ((title-line (next-token-closed '(#\space #\;) '(#\newline *eof*))))
(let-values*
(((descr nextl)
(read-scm-comment (read-whole-line))))
(let rpt ((rzt '())
(lnr nextl))
(cond
((or (eof-object? lnr)
(milestone? lnr '(#\= #\@) #f))
(values
`(chapter
(title ,title-line)
(description ,descr)
,@(reverse rzt))
lnr))
; dive into a section
((milestone? lnr '(#\-) #f)
(call-with-values
read-scm-section
(lambda (r l) (rpt (cons r rzt) l))))
; dive into a chunk
; dive on "^(" = #t
((milestone? lnr '(#\space) #t)
(call-with-values
(lambda () (read-scm-chunk lnr))
(lambda (r l) (rpt (cons r rzt) l))))
; ";;" -> dive into a comment
((milestone? lnr '(#\;) #f)
(call-with-values
(lambda () (read-scm-comment lnr))
(lambda (r l) (rpt (cons `(comment ,r) rzt) l))))
; recursion
(else
(rpt rzt (read-whole-line))))))))
(define (read-scm-section)
(let ((title-line (next-token-closed '(#\space #\;) '(#\newline *eof*))))
(let-values*
(((descr nextl)
(read-scm-comment (read-whole-line))))
(let rpt ((rzt '())
(lnr nextl))
(cond
; end of section
((or (eof-object? lnr)
(milestone? lnr '(#\= #\- #\^) #f))
(values
`(section
(title ,title-line)
(description ,descr)
,@(reverse rzt))
lnr))
; dive into a chunk
((milestone? lnr '(#\space) #t)
(call-with-values
(lambda () (read-scm-chunk lnr))
(lambda (r l) (rpt (cons r rzt) l))))
; ";;" -> dive into a comment
((milestone? lnr '(#\;) #f)
(call-with-values
(lambda () (read-scm-comment lnr))
(lambda (r l) (rpt (cons `(comment ,r) rzt) l))))
; recursion
(else
(rpt rzt (read-whole-line))))))))
The part of the source file till the next "milestone" is considered as one "chunk"
(define (read-scm-chunk name)
(let-values*
(((descr nextl)
(if (char=? (string-ref name 0) #\() ; if the chunk starts with "("
(values #f name) ; then it has no description
(read-scm-comment name))))
(let rpt ((rzt '())
(lnr nextl))
(cond
; end of chunk
((or (eof-object? lnr)
(milestone? lnr '(#\= #\- #\space #\; #\^) (not (null? rzt))))
(let* ((code-str (list-to-string (reverse rzt) ""))
(exprs (expr-type
(call-with-input-string code-str read))))
(values
`(,(car exprs)
; convert name to string
;(name ,(symbol->string (cadr exprs)))
; version below is eof-safe
(name ,(if (eof-object? (cadr exprs))
(cadr exprs)
(symbol->string (cadr exprs))))
,@(if descr (list `(description ,descr)) '())
(code ,code-str)
)
lnr )))
; recursion
(else
(rpt
; remove empty lines between chunk description and code
(if (and (null? rzt)
(zero? (string-length
(skip-prefix '(#\space #\tab #\newline) lnr)
)))
rzt
(cons lnr rzt))
(read-whole-line)))))))
Reads xtest until ")" in first position of the line
(define (read-xtest line)
(let-values*
(((key line-in)
(if (string-prefix? ";@" line)
(values
(symbol->string
(call-with-input-string
(substring line 2 (string-length line)) read))
(read-whole-line))
(values #f line)))
((descr nextl)
(if (char=? (string-ref line-in 0) #\() ; if the xtest starts with "("
(values #f line-in) ; then it has no description
(read-scm-comment line-in))))
(let rpt ((rzt '())
(lnr nextl))
(cond
; end of xtest
((or (eof-object? lnr)
(string-prefix? ")" lnr)
(milestone? lnr '(#\$) #f))
(let* ((rezult (if (string-prefix? ")" lnr)
(cons ")" rzt)
rzt))
(code-str (list-to-string (reverse rezult) ""))
(sexpr
(call-with-input-string code-str read)))
(values
`(testcase
; convert name to string
(@ (name ,(cond ((eof-object? sexpr) sexpr)
(key)
((symbol? (caddr sexpr))
(symbol->string (caddr sexpr)))
(else
(cerr nl "Testcase parsing failed." nl
"Please specify explicit name "
"for test-case :" nl (caddr sexpr) nl)
(exit -1)
))))
,@(if descr (list `(description ,descr)) '())
(code ,code-str)
)
lnr ))
)
; recursion
(else
(rpt
; remove empty lines between xtest description and code
(if (and (null? rzt)
(zero? (string-length
(skip-prefix '(#\space #\tab #\newline) lnr)
)))
rzt
(cons lnr rzt))
(read-whole-line)))))))
(define (read-fixture)
(let rpt ((rzt '())
(lnr (read-whole-line)))
(cond
((or (eof-object? lnr)
(milestone? lnr '(#\$) #f))
`(*TOP* (fixture ,@(reverse rzt))))
; "; " -> dive into a chunk of code
((milestone? lnr '(#\space #\@) #t)
(call-with-values
(lambda () (read-xtest lnr))
(lambda (r l) (rpt (cons r rzt) l))))
; recursion
(else
(rpt rzt (read-whole-line))))))
Display out verbatim content of textual subnode in HTML-ized form
(define (pre-text nd tag)
(cond
(((if-car-sxpath `(,tag *text*)) nd)
=> (lambda(x)
(if (not (string? x))
(cerr nl "Got it!" nl))
(cout nl "<pre>")
(apply cout (string->goodHTML-list x))
(cout "</pre>")
))))
Extract function declaration
(define (function-declaration s-expr)
(string->goodHTML-list
(call-with-output-string
(lambda(sp)
(cond
((pair? (cadr s-expr))
(begin
(display "(define " sp)
(display (cadr s-expr) sp)))
(else
(begin
(display "(define ")
(display (cadr s-expr) sp)
(display " " sp)
(if (and (pair? (caddr s-expr)) (eq? 'lambda (caaddr s-expr)))
(begin
(display "(" sp)
(display (caaddr s-expr) sp)
(display " " sp)
(display (cadr (caddr s-expr)) sp)))
)))
))))
Extract macro declaration
(define (macro-declaration s-expr)
(let ((sp (open-output-string)))
(cond
((pair? (cadr s-expr))
(begin
(display "(define-macro " sp)
(display (cadr s-expr) sp)))
(else
(begin
(display "(define-macro ")
(display (cadr s-expr) sp)
(display " " sp)
(if (and (pair? (caddr s-expr)) (eq? 'lambda (caaddr s-expr)))
(begin
(display "(" sp)
(display (caaddr s-expr) sp)
(display " " sp)
(display (cadr (caddr s-expr)) sp)))
)))
(string->goodHTML-list (close-output-port sp))
))
(define (report-header title) (string-append "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"" "\"http://www.w3.org/TR/html401/loose.dtd\">" "<html><head>" "<meta name=\"GENERATOR\" content=\"Mole: The Scheme Source Code Digger\">" "<title>" title "</title>" "<meta name='keywords' content=''></head>" "<body bgcolor='#ffffff' text='#384412' link='#11af05' vlink='#728b09'>" ))
(define report-footer "</body></html>")
Unit entry in the table of content <toc-str> is a prefix in TOC <a-str> is used in "name" and "href" attributes
(define (toc-entry name toc-str a-str)
(let ((hash-val (hash name)))
(cout nl toc-str)
(cond
((not test-fixture))
(((if-sxpath `(fixture (testcase (@ (equal?
(name ,name))))))
test-fixture)
=> (lambda(tc)
(cout "[ <a href='#test" a-str hash-val
"' style='text-decoration:none'>+</a> ] ")))
(else (cout " [ = ] ")))
(cout " <a name='toc" a-str hash-val
"' href='#doc" a-str hash-val "' style='text-decoration:none'>"
name
"</a><br>" nl)))
Produce a HTML document with the report generated from given Scheme source code in SXML format <dtree> If <rtype>'s possible are: 'nosrc 'src
(define (html-report dtree rtype)
(let ((doc-title (cond
(((if-car-sxpath '(title *text*)) cfg-pool))
(else "Automatically generated documentation"))))
(cout (report-header doc-title) nl)
(cout "<center><h1>" doc-title "</h1></center>" nl))
; Head Comment
(pre-text ((sxpath '(*)) dtree) 'comment)
(cout "<p><br>" nl)
(cout "<!-- Table of content -->" nl "<p><dl>" nl)
((map-on-type `(chapter . ,toc-chapter))
((sxpath '(*)) dtree))
(cout "</dl>" nl)
; Documentation itself
((map-on-type `(chapter . ,doc-chapter))
((sxpath '(*)) dtree))
; Include source code?
(case rtype
((src)
(cout "<center><h1>Code</h1></center>" nl)
(for-each
(lambda(x)
(case (sxml:name x)
((function)
(code-function x))
((macro)
(code-macro x))
((app)
(code-app x))
))
((sxpath '(// (or@ macro function app))) dtree))
))
; Include test suits?
(if test-fixture
(begin
(cout "<center><h1>Test suits</h1></center>" nl)
(for-each
(lambda(x)
(cond
(((sxpath `(fixture (testcase (@ (equal?
(name ,((car-sxpath '(name *text*))
x))))))) test-fixture)
=> (lambda(ts) (test-fun x ts)))
(else #f)))
((sxpath '(// function)) dtree))
))
(cout report-footer nl)
)
Chapter entry in the table of content
(define (toc-chapter c)
(let*
((chapter-title ((car-sxpath '(title *text*)) c))
(chapter-hash (hash chapter-title)))
(cout "<p><dt><a name='tocchapt" chapter-hash
"' href='#chapt" chapter-hash "'><b>"
chapter-title
"</b></a><dd>" nl))
((map-on-type `(section . ,toc-section)
`(app . ,toc-app)
`(macro . ,toc-macro)
`(function . ,toc-function)
) c)
)
Chapter content
(define (doc-chapter c)
(let*
((chapter-title ((car-sxpath '(title *text*)) c))
(chapter-hash (hash chapter-title)))
(cout "<hr height='5'><center><h3><a name='chapt" chapter-hash
"' href='#tocchapt" chapter-hash "'>"
chapter-title
"</a></h3></center>" nl))
(pre-text c 'description)
((map-on-type `(section . ,doc-section)
`(app . ,doc-app)
`(macro . ,doc-macro)
`(function . ,doc-function)) c)
)
Section entry in the table of content
(define (toc-section s)
(let*
((section-title ((car-sxpath '(title *text*)) s))
(section-hash (hash section-title)))
(cout nl "<dl><dt><a name='tocsect" section-hash
"' href='#sect" section-hash "'><b>"
section-title
"</b></a><dd>" nl)
((map-on-type s
`(macro . ,toc-macro)
`(function . ,toc-function)) s)
(cout "</dl>" nl)
))
Section content
(define (doc-section s)
(let*
((section-title ((car-sxpath '(title *text*)) s))
(section-hash (hash section-title)))
(cout nl "<hr width='40%' align='center'>"
"<center><h3><a name='sect" section-hash
"' href='#tocsect" section-hash "'>"
section-title
"</a></h3></center>" nl)
(pre-text s 'description)
((map-on-type s
`(macro . ,doc-macro)
`(function . ,doc-function)) s)
))
Function entry in the table of content
(define (toc-function f) (toc-entry ((car-sxpath '(name *text*)) f) "f: " "func"))
(define (link-to-test name hash-val a-str)
(cond
((not test-fixture))
(((if-sxpath `(fixture (testcase (@ (equal?
(name ,name))))))
test-fixture)
=> (lambda(tc)
(cout "<p><i><a href='#test" a-str hash-val
"'>Test suite</a></i>")))
(else #f)))
Generate a function documentation. Source code is not included.
(define (doc-function f)
(let*
((function-name ((car-sxpath '(name *text*)) f))
(function-hash (hash function-name)))
(cout nl ;"<hr width='20%' align='center'>"
"<h4><a name='docfunc" function-hash
"' href='#tocfunc" function-hash "'>"
function-name
"</a></h4>" nl)
(apply cout
(function-declaration
(call-with-input-string ((car-sxpath '(code *text*)) f) read)))
(cout "<i><br> ... <a href='#codefunc" function-hash
"'>Full Code</a> ... )</i>")
(link-to-test function-name function-hash "func")
(pre-text f 'description)
(cout "<p><br>" nl)
))
Generate a function documentation. Source code is included.
(define (code-function f)
(let*
((function-name ((car-sxpath '(name *text*)) f))
(function-hash (hash function-name)))
(cout nl "<h4><a name='codefunc" function-hash
"' href='#docfunc" function-hash "'>"
function-name
"</a></h4>" nl
"<i><a href='#tocfunc" function-hash
"'>Index</a></i><br>" nl)
(link-to-test function-name function-hash "func")
(pre-text f 'description)
; Source code
(pre-text f 'code)
))
Generates test suite for a function.
(define (test-fun f ts)
(let*
((function-name ((car-sxpath '(name *text*)) f))
(function-hash (hash function-name)))
(cout nl "<h4>Test suite for <a name='testfunc" function-hash
"' href='#docfunc" function-hash "'>"
function-name
"</a></h4>" nl
"<i><a href='#codefunc" function-hash
"'>Code</a></i>"
"<br><i> <a href='#tocfunc" function-hash
"'> Index</a></i><br>" nl)
(for-each
(lambda(tcase)
(cout nl "<p>Test case: <pre>")
(apply cout (string->goodHTML-list
((car-sxpath '(code *text*)) tcase)))
(cout "</pre>" nl ))
ts)
))
Macro entry in the table of content
(define (toc-macro m) (toc-entry ((car-sxpath '(name *text*)) m) "m: " "macro"))
Generate a macro documentation. Source code is not included.
(define (doc-macro m)
(let*
((name ((car-sxpath '(name *text*)) m))
(hash-val (hash name)))
(cout nl
"<h4><a name='docmacro" hash-val
"' href='#tocmacro" hash-val "'>"
name
"</a></h4>" nl)
(apply cout
(macro-declaration
(call-with-input-string ((car-sxpath '(code *text*)) m) read)))
(cout "<i><br> ... <a href='#codemacro" hash-val
"'>Full Code</a> ... )</i>")
(pre-text m 'description)
(cout "<p><br>" nl)
))
Generate a macro documentation. Source code is included.
(define (code-macro m)
(let*
((name ((car-sxpath '(name *text*)) m))
(hash-val (hash name)))
(cout nl "<h5><a name='codemacro" hash-val
"' href='#docmacro" hash-val "'>"
name
"</a></h5>" nl
"<i><a href='#tocmacro" hash-val
"'>Index</a></i><br>" nl)
(pre-text m 'description)
; Source code
(pre-text m 'code)
))
Application entry in the table of content
(define (toc-app a) (toc-entry ((car-sxpath '(name *text*)) a) "a: " "app"))
Generate an applicaion documentation. Source code is not included.
(define (doc-app a)
(let*
((name ((car-sxpath '(name *text*)) a))
(hash-val (hash name)))
(cout nl
"<h4><a name='docapp" hash-val
"' href='#tocapp" hash-val "'>"
name
"</a></h4>" nl)
(cout "<i>... <a href='#codeapp" hash-val
"'>Source Code</a> ... </i>")
(pre-text a 'description)
(cout "<p><br>" nl)
))
Generate an application documentation. Source code is included.
(define (code-app a)
(let*
((name ((car-sxpath '(name *text*)) a))
(hash-val (hash name)))
(cout nl "<h5><a name='codeapp" hash-val
"' href='#docapp" hash-val "'>"
name
"</a></h5>" nl
"<i><a href='#tocapp" hash-val
"'>Index</a></i><br>" nl)
(pre-text a 'description)
; Source code
(pre-text a 'code)
))