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