scm/document-translation.scm

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