Nitpick: ly:spanner-bound grob name slur -> spanner.
[lilypond.git] / scm / documentation-lib.scm
blobba434f1947e89bcbbb907c18ffa97371e290274b
1 ;;;;
2 ;;;; documentation-lib.scm -- Assorted Functions for generated documentation
3 ;;;;
4 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; 
6 ;;;; (c) 2000--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
7 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
9 (use-modules (oop goops)
10              (srfi srfi-13)
11              (srfi srfi-1))
13 (define-class <texi-node> ()
14   (appendix #:init-value #f #:accessor appendix? #:init-keyword #:appendix)
15   (children #:init-value '() #:accessor node-children #:init-keyword #:children)
16   (text #:init-value "" #:accessor node-text #:init-keyword #:text)
17   (name #:init-value "" #:accessor node-name #:init-keyword #:name)
18   (description #:init-value "" #:accessor node-desc #:init-keyword #:desc))
20 (define (menu-entry x)
21   (cons
22    (node-name x)
23    (node-desc x)))
25 (define* (dump-node node port level)
26   (display
27    (string-append
28     "\n@node "
29     (if (= level 0) "Top" (node-name node))
30     "\n"
31     (if (appendix? node)
32         (texi-appendix-section-command level)
33         (texi-section-command level))
34     " "
35     (node-name node)
36     "\n\n"
37     (node-text node)
38     "\n\n"
39     (if (pair? (node-children node))
40         (texi-menu
41          (map (lambda (x) (menu-entry x))
42               (node-children node)))
43         ""))
44    port)
45   (map (lambda (x) (dump-node x port (+ 1 level)))
46        (node-children node)))
48 (define (processing name)
49   (ly:message (_ "Processing ~S...") name))
51 (define (self-evaluating? x)
52   (or (number? x) (string? x) (procedure? x) (boolean? x)))
54 (define (texify x)
55   x)
57 (define (scm->texi x)
58   (string-append "@code{" (texify (scm->string x)) "}"))
62 (define (texi-section-command level)
63   (cdr (assoc level '(
64                       ;; Hmm, texinfo doesn't have ``part''
65                       (0 . "@top")
66                       (1 . "@chapter")
67                       (2 . "@section")
68                       (3 . "@subsection")
69                       (4 . "@unnumberedsubsubsec")
70                       (5 . "@unnumberedsubsubsec")))))
72 (define (texi-appendix-section-command level)
73   (cdr (assoc level '((0 . "@top")
74                       (1 . "@appendix")
75                       (2 . "@appendixsec")
76                       (3 . "@appendixsubsec")
77                       (4 . "@appendixsubsubsec")
78                       (5 . "@appendixsubsubsec")))))
80 (define (one-item->texi label-desc-pair)
81   "Document one (LABEL . DESC); return empty string if LABEL is empty string."
82   (if (eq? (car label-desc-pair) "")
83       ""
84       (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))))
87 (define (description-list->texi items-alist quote?)
88   "Document ITEMS-ALIST in a table; entries contain (item-label .
89 string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
90   (string-append
91    "\n"
92    (if quote? "@quotation\n" "")
93    "@table @asis\n"
94    (apply string-append (map one-item->texi items-alist))
95    "\n"
96    "@end table\n"
97    (if quote? "@end quotation\n" "")))
99 (define (texi-menu items-alist)
100   "Generate what is between @menu and @end menu."
101   (let ((maxwid
102          (apply max (map (lambda (x) (string-length (car x))) items-alist))))
103     
104     (string-append
105      "\n@menu"
106      (apply string-append
107             (map (lambda (x)
108                    (string-append
109                     (string-pad-right 
110                      (string-append "\n* " (car x) ":: ")
111                      (+ maxwid 8))
112                     (cdr x)))
113                  items-alist))
114      "\n@end menu\n"
115      ;; Menus don't appear in html, so we make a list ourselves
116      "\n@ignore\n"
117      "\n@ifhtml\n"
118      (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
119                                   items-alist)
120                              #t)
121      "\n@end ifhtml\n"
122      "\n@end ignore\n")))
124 (define (texi-file-head name file-name top)
125   (string-append
126    "\\input texinfo @c -*-texinfo-*-"
127    "\n@setfilename " file-name ".info"
128    "\n@settitle " name
129    "\n@dircategory LilyPond"
130    "\n@direntry"
131    ;; prepend GNU for dir, must be unique
132    "\n* GNU " name ": (" file-name ").          " name "."
133    "\n@end direntry\n"
134    "@documentlanguage en\n"
135    "@documentencoding utf-8\n"))
137 (define (context-name name)
138   name)
140 (define (engraver-name name)
141   name)
143 (define (grob-name name)
144   (if (symbol? name)
145       (symbol->string name)
146       name))
148 (define (interface-name name)
149   name)
151 (define (ref-ify x)
152   "Add ref to X"
153   (string-append "@ref{" x "}"))
155 (define (human-listify lst)
156   "Produce a textual enumeration from LST, a list of strings"
157   
158   (cond
159    ((null? lst) "none")
160    ((null? (cdr lst)) (car lst))
161    ((null? (cddr lst)) (string-append (car lst) " and " (cadr lst)))
162    (else (string-append (car lst) ", " (human-listify (cdr lst))))))
164 (define (writing-wip x)
165   (ly:message (_ "Writing ~S...") x))
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169 ;; property  stuff.
171 (define (property->texi where sym . rest)
172   "Document SYM for WHERE (which can be translation, backend, music),
173 with init values from ALIST (1st optional argument)
175   (let* ((name (symbol->string sym))
176          (alist (if (pair? rest) (car rest) '()))
177          (type?-name (string->symbol
178                       (string-append (symbol->string where) "-type?")))
179          (doc-name (string->symbol                  
180                     (string-append (symbol->string where) "-doc")))
181          (type (object-property sym type?-name))
182          (typename (type-name type))
183          (desc (object-property sym doc-name))
184          (handle (assoc sym alist)))
186     (if (eq? desc #f)
187         (ly:error (_ "cannot find description for property ~S (~S)") sym where))
188     
189     (cons
190      (string-append "@code{" name "} "
191                     "(" typename ")"
192                     (if handle
193                         (string-append
194                          ":\n\n"
195                          (scm->texi (cdr handle))
196                          "\n\n")
197                         ""))
198      desc)))