1 ;;;; document-translation.scm -- Functions for engraver documentation
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2000--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 ;;;; Jan Nieuwenhuizen <janneke@gnu.org>
8 (define (engraver-makes-grob? name-symbol grav)
9 (memq name-symbol (assoc 'grobs-created (ly:translator-description grav))))
11 (define (engraver-accepts-music-type? name-symbol grav)
12 (memq name-symbol (assoc 'events-accepted (ly:translator-description grav))))
14 (define (engraver-accepts-music-types? types grav)
18 (engraver-accepts-music-type? (car types) grav)
19 (engraver-accepts-music-types? (cdr types) grav))))
21 (define (engraver-doc-string engraver in-which-contexts)
22 (let* ((propsr (cdr (assoc 'properties-read (ly:translator-description engraver))))
23 (propsw (cdr (assoc 'properties-written (ly:translator-description engraver))))
24 (accepted (cdr (assoc 'events-accepted (ly:translator-description engraver))))
25 (name-sym (ly:translator-name engraver))
26 (name-str (symbol->string name-sym))
27 (desc (cdr (assoc 'description (ly:translator-description engraver))))
28 (grobs (engraver-grobs engraver)))
35 "Music types accepted:\n\n"
47 (description-list->texi
48 (map (lambda (x) (property->texi 'translation x '())) propsr)
56 (description-list->texi
57 (map (lambda (x) (property->texi 'translation x '())) propsw)
62 "\n\nThis engraver creates the following layout objects:\n\n"
63 (human-listify (map ref-ify (uniq-list (sort grobs string<?))))
69 (let* ((layout-alist (ly:output-description $defaultlayout))
70 (context-description-alist (map cdr layout-alist))
75 (let* ((context (cdr (assoc 'context-name x)))
76 (group (assq-ref x 'group-type))
81 (cdr (assoc 'consists x)))))
82 (if (member name-sym consists)
85 context-description-alist))))
87 "@code{" name-str "} is part of contexts: "
88 (human-listify (map ref-ify
90 (map symbol->string contexts) string<?)))))
93 ;; First level Engraver description
94 (define (engraver-doc grav)
96 #:name (symbol->string (ly:translator-name grav))
97 #:text (engraver-doc-string grav #t)))
99 ;; Second level, part of Context description
100 (define name->engraver-table (make-vector 61 '()))
103 (hash-set! name->engraver-table (ly:translator-name x) x))
104 (ly:get-all-translators))
106 (define (find-engraver-by-name name)
108 (hash-ref name->engraver-table name #f))
110 (define (document-engraver-by-name name)
113 (let* ((eg (find-engraver-by-name name)))
115 (cons (string-append "@code{" (ref-ify (symbol->string name)) "}")
116 (engraver-doc-string eg #f))))
118 (define (document-property-operation op)
120 (context-sym (cadr op))
132 (format "grob-property @code{~a} "
133 (string-join (map symbol->string path) " "))
134 (format "in @ref{~a} to ~a."
135 context-sym (scm->texi value))
137 ((equal? (object-property context-sym 'is-grob?) #t) "")
138 ((equal? tag 'assign)
139 (format "@item Set translator property @code{~a} to ~a.\n"
141 (scm->texi (car args))))
145 (define (context-doc context-desc)
146 (let* ((name-sym (cdr (assoc 'context-name context-desc)))
147 (name (symbol->string name-sym))
148 (aliases (map symbol->string (cdr (assoc 'aliases context-desc))))
149 (desc-handle (assoc 'description context-desc))
150 (desc (if (and (pair? desc-handle) (string? (cdr desc-handle)))
151 (cdr desc-handle) "(not documented)"))
153 (accepts (cdr (assoc 'accepts context-desc)))
154 (consists (cdr (assoc 'consists context-desc)))
155 (props (cdr (assoc 'property-ops context-desc)))
156 (grobs (context-grobs context-desc))
157 (grob-refs (map (lambda (x) (ref-ify x)) grobs)))
166 "\n\nThis context also accepts commands for the following context(s):\n\n"
167 (human-listify aliases)
171 "\n\nThis context creates the following layout objects:\n\n"
172 (human-listify (uniq-list (sort grob-refs string<?)))
175 (if (and (pair? props) (not (null? props)))
176 (let ((str (apply string-append (map document-property-operation
178 (if (string-null? str)
181 "\n\nThis context sets the following properties:\n\n"
188 "\n\nThis context is a `bottom' context; it cannot contain other contexts."
193 (human-listify (map ref-ify (map symbol->string accepts)))
199 "\n\nThis context is built from the following engravers:"
200 (description-list->texi
201 (map document-engraver-by-name consists)
204 (define (engraver-grobs grav)
205 (let* ((eg (if (symbol? grav)
206 (find-engraver-by-name grav)
210 (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg)))))))
212 (define (context-grobs context-desc)
213 (let* ((group (assq-ref context-desc 'group-type))
218 (cdr (assoc 'consists context-desc))))
220 (map engraver-grobs consists))))
223 (define (all-contexts-doc)
225 (sort (ly:output-description $defaultlayout)
226 (lambda (x y) (symbol<? (car x) (car y)))))
227 (names (sort (map symbol->string (map car layout-alist)) string<?))
228 (contexts (map cdr layout-alist)))
232 #:desc "Complete descriptions of all contexts."
234 (map context-doc contexts))))
236 (define all-engravers-list (ly:get-all-translators))
237 (set! all-engravers-list
238 (sort all-engravers-list
239 (lambda (a b) (string<? (symbol->string (ly:translator-name a))
240 (symbol->string (ly:translator-name b))))))
242 (define (all-engravers-doc)
245 #:desc "All separate engravers."
246 #:text "See @ruser{Modifying context plug-ins}."
248 (map engraver-doc all-engravers-list)))
250 (define (translation-properties-doc-string lst)
251 (let* ((ps (sort (map symbol->string lst) string<?))
252 (sortedsyms (map string->symbol ps))
255 (lambda (x) (property->texi 'translation x '()))
257 (texi (description-list->texi propdescs #f)))
260 (define (translation-doc-node)
263 #:desc "From music to layout."
269 #:name "Tunable context properties"
270 #:desc "All tunable context properties."
271 #:text (translation-properties-doc-string
272 all-user-translation-properties))
275 #:name "Internal context properties"
276 #:desc "All internal context properties."
277 #:text (translation-properties-doc-string
278 all-internal-translation-properties)))))