1 ;;;; document-markup.scm -- part of generated backend documentation
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 1998--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 ;;;; Jan Nieuwenhuizen <janneke@gnu.org>
9 (define (doc-markup-function-properties func)
10 (let ((properties (hashq-ref markup-functions-properties func))
11 (prop-strings (list)))
12 (for-each (lambda (prop-spec)
15 ;; either (prop value) or (prop)
16 (cons (if (null? (cdr prop-spec))
17 (format #f "@item @code{~a}\n" (car prop-spec))
18 (format #f "@item @code{~a} (~a)\n"
20 (let ((default (cadr prop-spec)))
21 (if (and (list? default)
26 ;; a markup command: get its properties
27 ;; FIXME: avoid cyclical references
28 (append (doc-markup-function-properties prop-spec)
30 (or properties (list)))
33 (define (doc-markup-function func)
34 (let* ((doc-str (procedure-documentation func))
35 (f-name (symbol->string (procedure-name func)))
36 (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name 'pre "" 'post))
37 (sig (object-property func 'markup-signature))
38 (arg-names (let ((arg-list (cadr (procedure-source func))))
40 (map symbol->string (cddr arg-list))
41 (make-list (length sig) "arg"))))
42 (sig-type-names (map type-name sig))
45 (map (lambda (x) (string-append
46 "@var{" (car x) "} (" (cadr x) ")" ))
47 (zip arg-names sig-type-names))
51 "\n\n@item @code{\\" c-name "} " signature-str
52 "\n@funindex \\" c-name "\n"
53 "\n@cindex \\" c-name "\n"
57 (let ((prop-strings (doc-markup-function-properties func)))
58 (if (null? prop-strings)
60 (string-append "\n\n\nUsed properties:\n@itemize\n"
61 (apply string-append prop-strings)
62 "@end itemize\n"))))))
64 (define (markup-function<? a b)
65 (string<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
67 (define (markup-category-doc-node category)
68 (let* ((category-string (symbol->string category))
69 (category-name (string-capitalize (regexp-substitute/global #f
70 "-" category-string 'pre " " 'post)))
71 (markup-functions (hashq-ref markup-functions-by-category
80 (map doc-markup-function
81 (sort markup-functions markup-function<?)))
84 (define (markup-list-doc-string)
88 (map doc-markup-function
89 (sort markup-list-function-list markup-function<?)))
92 (define (markup-doc-node)
95 #:name "Text markup commands"
97 #:text "The following commands can all be used inside @code{\\markup @{ @}}."
98 #:children (let* (;; when a new category is defined, update `ordered-categories'
99 (ordered-categories '(font align graphic music instrument-specific-markup other))
100 (raw-categories (hash-fold (lambda (category functions categories)
101 (cons category categories))
103 markup-functions-by-category))
104 (categories (append ordered-categories
105 (filter (lambda (cat)
106 (not (memq cat ordered-categories)))
108 (map markup-category-doc-node categories))))
110 (define (markup-list-doc-node)
113 #:name "Text markup list commands"
115 #:text (string-append
116 "The following commands can all be used with @code{\\markuplines}.\n"
117 (markup-list-doc-string))))