← Back to branch summary

~ubuntu-branches/ubuntu/precise/lilypond/precise

« back to all changes in this revision

Viewing changes to scm/document-translation.scm

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Bushnell, BSG
  • Date: 2006-12-19 10:18:12 UTC
  • mfrom: (3.1.4 feisty)
  • Revision ID: james.westby@ubuntu.com-20061219101812-7awtjkp0i393wxty
Tags: 2.8.7-3
http://bugs.debian.org/400550
scripts/midi2ly.py: When setting DATADIR, find Lilypond python files
in the @TOPLEVEL_VERSION@ directory, not 'current'.  Patch thanks to
Chris Lamb (chris@chris-lamb.co.uk).  (Closes: #400550)

Show diffs side-by-side

added added

removed removed

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