]> git.donarmstrong.com Git - lilypond.git/blob - scm/document-markup.scm
Doc: CG: add warning about non-sequential reading.
[lilypond.git] / scm / document-markup.scm
1 ;;;; This file is part of LilyPond, the GNU music typesetter.
2 ;;;;
3 ;;;; Copyright (C) 1998--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
4 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;;
6 ;;;; LilyPond is free software: you can redistribute it and/or modify
7 ;;;; it under the terms of the GNU General Public License as published by
8 ;;;; the Free Software Foundation, either version 3 of the License, or
9 ;;;; (at your option) any later version.
10 ;;;;
11 ;;;; LilyPond is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;;; GNU General Public License for more details.
15 ;;;;
16 ;;;; You should have received a copy of the GNU General Public License
17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
18
19
20 (define (doc-markup-function-properties func)
21   (let ((properties (hashq-ref markup-functions-properties func))
22         (prop-strings (list)))
23     (for-each (lambda (prop-spec)
24                 (set! prop-strings
25                       (if (list? prop-spec)
26                           ;; either (prop value) or (prop)
27                           (cons (if (null? (cdr prop-spec))
28                                     (format #f "@item @code{~a}\n" (car prop-spec))
29                                     (format #f "@item @code{~a} (~a)\n"
30                                             (car prop-spec)
31                                             (let ((default (cadr prop-spec)))
32                                               (if (and (list? default)
33                                                        (null? default))
34                                                   "'()"
35                                                   default))))
36                                 prop-strings)
37                           ;; a markup command: get its properties
38                           ;; FIXME: avoid cyclical references
39                           (append (doc-markup-function-properties prop-spec)
40                                   prop-strings))))
41               (or properties (list)))
42     prop-strings))
43
44 (define (doc-markup-function func)
45   (let* ((doc-str  (procedure-documentation func))
46          (f-name (symbol->string (procedure-name  func)))
47          (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name  'pre "" 'post))
48          (sig (object-property func 'markup-signature))
49          (arg-names (let ((arg-list (cadr (procedure-source func))))
50                       (if (list? arg-list)
51                           (map symbol->string (cddr arg-list))
52                           (make-list (length sig) "arg"))))
53          (sig-type-names (map type-name sig))
54          (signature-str
55           (string-join
56            (map (lambda (x) (string-append
57                              "@var{" (car x) "} ("  (cadr x) ")" ))
58                 (zip arg-names  sig-type-names))
59            " " )))
60     
61     (string-append
62      "\n\n@item @code{\\" c-name "} " signature-str
63      "\n@funindex \\" c-name "\n"
64      "\n@cindex \\" c-name "\n"    
65      (if (string? doc-str)
66          doc-str
67          "")
68      (let ((prop-strings (doc-markup-function-properties func)))
69        (if (null? prop-strings)
70            "\n"
71            (string-append "\n\n\nUsed properties:\n@itemize\n"
72                           (apply string-append prop-strings)
73                           "@end itemize\n"))))))
74
75 (define (markup-function<? a b)
76   (ly:string-ci<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
77  
78 (define (markup-category-doc-node category)
79   (let* ((category-string (symbol->string category))
80          (category-name (string-capitalize (regexp-substitute/global #f
81                                         "-" category-string 'pre " " 'post)))
82         (markup-functions (hashq-ref markup-functions-by-category
83                                           category)))
84     (make <texi-node>
85       #:appendix #t
86       #:name category-name
87       #:desc ""
88       #:text (string-append
89               "@table @asis"
90               (apply string-append
91                      (map doc-markup-function
92                           (sort markup-functions markup-function<?)))
93               "\n@end table"))))
94
95 (define (markup-list-doc-string)
96   (string-append
97    "@table @asis"
98    (apply string-append
99           (map doc-markup-function
100                (sort markup-list-function-list markup-function<?)))
101    "\n@end table"))
102
103 (define (markup-doc-node)
104   (make <texi-node>
105     #:appendix #t
106     #:name "Text markup commands"
107     #:desc ""
108     #:text "The following commands can all be used inside @code{\\markup @{ @}}."
109     #:children (let* (;; when a new category is defined, update `ordered-categories'
110                       (ordered-categories '(font align graphic music instrument-specific-markup other))
111                       (raw-categories (hash-fold (lambda (category functions categories)
112                                                    (cons category categories))
113                                                  (list)
114                                                  markup-functions-by-category))
115                       (categories (append ordered-categories
116                                           (filter (lambda (cat)
117                                                     (not (memq cat ordered-categories)))
118                                                   raw-categories))))
119                  (map markup-category-doc-node categories))))
120
121 (define (markup-list-doc-node)
122   (make <texi-node>
123     #:appendix #t
124     #:name "Text markup list commands"
125     #:desc ""
126     #:text (string-append
127             "The following commands can all be used with @code{\\markuplines}.\n"
128             (markup-list-doc-string))))