]> git.donarmstrong.com Git - lilypond.git/blob - scm/document-translation.scm
Doc: Appendix - Articulations and Ornamentation - part 3
[lilypond.git] / scm / document-translation.scm
1 ;;;; This file is part of LilyPond, the GNU music typesetter.
2 ;;;;
3 ;;;; Copyright (C) 2000--2014 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 (define (engraver-makes-grob? name-symbol grav)
20   (memq name-symbol (assoc 'grobs-created (ly:translator-description grav))))
21
22 (define (engraver-accepts-music-type? name-symbol grav)
23   (memq name-symbol (assoc 'events-accepted (ly:translator-description grav))))
24
25 (define (engraver-accepts-music-types? types grav)
26   (if (null? types)
27       #f
28       (or
29        (engraver-accepts-music-type? (car types) grav)
30        (engraver-accepts-music-types? (cdr types) grav))))
31
32 (define (engraver-doc-string engraver in-which-contexts)
33   (let* ((propsr (assoc-get 'properties-read (ly:translator-description engraver)))
34          (propsw (assoc-get 'properties-written (ly:translator-description engraver)))
35          (accepted  (assoc-get 'events-accepted (ly:translator-description engraver)))
36          (name-sym  (ly:translator-name engraver))
37          (name-str (symbol->string name-sym))
38          (desc (assoc-get 'description (ly:translator-description engraver)))
39          (grobs (engraver-grobs engraver)))
40
41     (string-append
42      desc
43      "\n\n"
44      (if (pair? accepted)
45          (string-append
46           "Music types accepted:\n\n"
47           (human-listify
48            (map ref-ify (sort (map symbol->string accepted) ly:string-ci<?))))
49          "")
50      "\n\n"
51      (if (pair? propsr)
52          (string-append
53           "Properties (read)"
54           (description-list->texi
55            (map (lambda (x) (property->texi 'translation x '()))
56                 (sort propsr ly:symbol-ci<?))
57            #t))
58          "")
59
60      (if (null? propsw)
61          ""
62          (string-append
63           "Properties (write)"
64           (description-list->texi
65            (map (lambda (x) (property->texi 'translation x '()))
66                 (sort propsw ly:symbol-ci<?))
67            #t)))
68      (if  (null? grobs)
69           ""
70           (string-append
71            "\n\nThis engraver creates the following layout object(s):\n\n"
72            (human-listify (map ref-ify (uniq-list (sort grobs ly:string-ci<?))))
73            "."))
74
75      "\n\n"
76
77      (if in-which-contexts
78          (let* ((layout-alist (ly:output-description $defaultlayout))
79                 (context-description-alist (map cdr layout-alist))
80                 (contexts
81                  (append-map
82                   (lambda (x)
83                     (let* ((context (assoc-get 'context-name x))
84                            (group (assq-ref x 'group-type))
85                            (consists (append
86                                       (if group
87                                           (list group)
88                                           '())
89                                       (assoc-get 'consists x))))
90                       (if (member name-sym consists)
91                           (list context)
92                           '())))
93                   context-description-alist))
94                 (context-list (human-listify (map ref-ify
95                                                   (sort
96                                                    (map symbol->string contexts)
97                                                    ly:string-ci<?)))))
98            (string-append
99             "@code{" name-str "} "
100             (if (equal? context-list "none")
101                 "is not part of any context"
102                 (string-append
103                  "is part of the following context(s): "
104                  context-list))
105             "."))
106          ""))))
107
108 ;; First level Engraver description
109 (define (engraver-doc grav)
110   (make <texi-node>
111     #:name (symbol->string (ly:translator-name grav))
112     #:text (engraver-doc-string grav #t)))
113
114 ;; Second level, part of Context description
115 (define name->engraver-table (make-hash-table 61))
116 (for-each
117  (lambda (x)
118    (hash-set! name->engraver-table (ly:translator-name x) x))
119  (ly:get-all-translators))
120
121 (define (find-engraver-by-name name)
122   "NAME is a symbol."
123   (hash-ref name->engraver-table name #f))
124
125 (define (document-engraver-by-name name)
126   "NAME is a symbol."
127
128   (let* ((eg (find-engraver-by-name name)))
129
130     (cons (string-append "@code{" (ref-ify (symbol->string name)) "}")
131           (engraver-doc-string eg #f))))
132
133 (define (document-property-operation op)
134   (let ((tag (car op))
135         (context-sym (cadr op))
136         (args (cddr op))
137         )
138
139     (cond
140      ((equal?  tag 'push)
141       (let*
142           ((value (car args))
143            (path (cdr args)))
144
145         (string-append
146          (format #f "@item Set grob-property @code{~a} "
147                  (string-join (map symbol->string path) " "))
148          (format #f "in @ref{~a} to" context-sym)
149          (if (pretty-printable? value)
150            (format #f ":~a\n" (scm->texi value))
151            (format #f " ~a.\n" (scm->texi value))))))
152      ((equal? (object-property context-sym 'is-grob?) #t) "")
153      ((equal? tag 'assign)
154       (string-append
155         (format #f "@item Set translator property @code{~a} to" context-sym)
156         (if (pretty-printable? (car args))
157           (format #f ":~a\n" (scm->texi (car args)))
158           (format #f " ~a.\n" (scm->texi (car args)))))))))
159
160
161 (define (context-doc context-desc)
162   (let* ((name-sym (assoc-get 'context-name context-desc))
163          (name (symbol->string name-sym))
164          (aliases (map symbol->string (assoc-get 'aliases context-desc)))
165          (desc (assoc-get 'description context-desc "(not documented"))
166          (accepts (assoc-get 'accepts context-desc))
167          (consists (assoc-get 'consists context-desc))
168          (props (assoc-get 'property-ops context-desc))
169          (grobs  (context-grobs context-desc))
170          (grob-refs (map ref-ify (sort grobs ly:string-ci<?))))
171
172     (make <texi-node>
173       #:name name
174       #:text
175       (string-append
176        desc
177        (if (pair? aliases)
178            (string-append
179             "\n\nThis context also accepts commands for the following context(s):\n\n"
180             (human-listify (sort aliases ly:string-ci<?))
181             ".")
182            "")
183
184        "\n\nThis context creates the following layout object(s):\n\n"
185        (human-listify (uniq-list grob-refs))
186        "."
187
188        (if (and (pair? props) (not (null? props)))
189            (let ((str (string-concatenate
190                        (sort (map document-property-operation props)
191                              ly:string-ci<?))))
192              (if (string-null? str)
193                  ""
194                  (string-append
195                   "\n\nThis context sets the following properties:\n\n"
196                   "@itemize @bullet\n"
197                   str
198                   "@end itemize\n")))
199            "")
200
201        (if (null? accepts)
202            "\n\nThis context is a `bottom' context; it cannot contain other contexts."
203            (string-append
204             "\n\nContext "
205             name
206             " can contain\n"
207             (human-listify (map ref-ify (sort (map symbol->string accepts)
208                                               ly:string-ci<?)))
209             "."))
210
211        (if (null? consists)
212            ""
213            (string-append
214             "\n\nThis context is built from the following engraver(s):"
215             (description-list->texi
216              (map document-engraver-by-name (sort consists ly:symbol-ci<?))
217              #t)))))))
218
219 (define (engraver-grobs grav)
220   (let* ((eg (if (symbol? grav)
221                  (find-engraver-by-name grav)
222                  grav)))
223     (if (eq? eg #f)
224         '()
225         (map symbol->string (assoc-get 'grobs-created (ly:translator-description eg))))))
226
227 (define (context-grobs context-desc)
228   (let* ((group (assq-ref context-desc 'group-type))
229          (consists (append
230                     (if group
231                         (list group)
232                         '())
233                     (assoc-get 'consists context-desc)))
234          (grobs (append-map engraver-grobs consists)))
235     grobs))
236
237 (define (all-contexts-doc)
238   (let* ((layout-alist
239           (sort (ly:output-description $defaultlayout)
240                 (lambda (x y) (ly:symbol-ci<? (car x) (car y)))))
241          (names (sort (map symbol->string (map car layout-alist)) ly:string-ci<?))
242          (contexts (map cdr layout-alist)))
243
244     (make <texi-node>
245       #:name "Contexts"
246       #:desc "Complete descriptions of all contexts."
247       #:children
248       (map context-doc contexts))))
249
250 (define all-engravers-list  (ly:get-all-translators))
251 (set! all-engravers-list
252       (sort all-engravers-list
253             (lambda (a b) (ly:string-ci<? (symbol->string (ly:translator-name a))
254                                           (symbol->string (ly:translator-name b))))))
255
256 (define (all-engravers-doc)
257   (make <texi-node>
258     #:name "Engravers and Performers"
259     #:desc "All separate engravers and performers."
260     #:text "See @ruser{Modifying context plug-ins}."
261     #:children
262     (map engraver-doc all-engravers-list)))
263
264 (define (translation-properties-doc-string lst)
265   (let* ((ps (sort (map symbol->string lst) ly:string-ci<?))
266          (sortedsyms (map string->symbol ps))
267          (propdescs
268           (map
269            (lambda (x) (property->texi 'translation  x '()))
270            sortedsyms))
271          (texi (description-list->texi propdescs #f)))
272     texi))
273
274 (define (translation-doc-node)
275   (make <texi-node>
276     #:name "Translation"
277     #:desc "From music to layout."
278     #:children
279     (list
280      (all-contexts-doc)
281      (all-engravers-doc)
282      (make <texi-node>
283        #:name "Tunable context properties"
284        #:desc "All tunable context properties."
285        #:text (translation-properties-doc-string
286                all-user-translation-properties))
287
288      (make <texi-node>
289        #:name "Internal context properties"
290        #:desc "All internal context properties."
291        #:text (translation-properties-doc-string
292                all-internal-translation-properties)))))