LSR: Update.
[lilypond.git] / scm / document-markup.scm
blob77ee9b97dce4fee30b81c818af65d53c310b1f56
1 ;;;; document-markup.scm -- part of generated backend documentation
2 ;;;;
3 ;;;;  source file of the GNU LilyPond music typesetter
4 ;;;; 
5 ;;;; (c) 1998--2007 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)
13                 (set! prop-strings
14                       (if (list? 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"
19                                             (car prop-spec)
20                                             (let ((default (cadr prop-spec)))
21                                               (if (and (list? default)
22                                                        (null? default))
23                                                   "'()"
24                                                   default))))
25                                 prop-strings)
26                           ;; a markup command: get its properties
27                           ;; FIXME: avoid cyclical references
28                           (append (doc-markup-function-properties prop-spec)
29                                   prop-strings))))
30               (or properties (list)))
31     prop-strings))
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))))
39                       (if (list? arg-list)
40                           (map symbol->string (cddr arg-list))
41                           (make-list (length sig) "arg"))))
42          (sig-type-names (map type-name sig))
43          (signature-str
44           (string-join
45            (map (lambda (x) (string-append
46                              "@var{" (car x) "} ("  (cadr x) ")" ))
47                 (zip arg-names  sig-type-names))
48            " " )))
49     
50     (string-append
51      "\n\n@item @code{\\" c-name "} " signature-str
52      "\n@findex \\" f-name "\n"
53      
54      (if (string? doc-str)
55          doc-str
56          "")
57      (let ((prop-strings (doc-markup-function-properties func)))
58        (if (null? prop-strings)
59            "\n"
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          (match (string-match "-" category-string))
70          (category-name (string-capitalize
71                          (if match
72                              (regexp-substitute #f match 'pre " " 'post)
73                              category-string)))
74         (markup-functions (hashq-ref markup-functions-by-category
75                                           category)))
76     (make <texi-node>
77       #:name category-name
78       #:desc ""
79       #:text (string-append
80               "@table @asis"
81               (apply string-append
82                      (map doc-markup-function
83                           (sort markup-functions markup-function<?)))
84               "\n@end table"))))
86 (define (markup-list-doc-string)
87   (string-append
88    "@table @asis"
89    (apply string-append
90           (map doc-markup-function
91                (sort markup-list-function-list markup-function<?)))
92    "\n@end table"))
94 (define (markup-doc-node)
95   (make <texi-node>
96     #:name "Text markup commands"
97     #:desc ""
98     #:text "The following commands can all be used inside @code{\\markup @{ @}}."
99     #:children (let* (;; when a new category is defined, update `ordered-categories'
100                       (ordered-categories '(font align graphic music fret-diagram other))
101                       (raw-categories (hash-fold (lambda (category functions categories)
102                                                    (cons category categories))
103                                                  (list)
104                                                  markup-functions-by-category))
105                       (categories (append ordered-categories
106                                           (filter (lambda (cat)
107                                                     (not (memq cat ordered-categories)))
108                                                   raw-categories))))
109                  (map markup-category-doc-node categories))))
111 (define (markup-list-doc-node)
112   (make <texi-node>
113     #:name "Text markup list commands"
114     #:desc ""
115     #:text (string-append
116             "The following commands can all be used with @code{\\markuplines}.\n"
117             (markup-list-doc-string))))