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-sym  (ly:translator-name engraver))
  33          (name (symbol->string name-sym))
  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 'context-name x)))
  83                                      (consists (append
  84                                                 (list (cdr (assoc 'group-type x)))
  85                                                 (cdr (assoc 'consists x))
  86                                                 )))
  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 (symbol->string (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   "NAME is a symbol."
 118   (hash-ref name->engraver-table name #f))
 119
 120 (define (document-engraver-by-name name)
 121   "NAME is a symbol."
 122   (let*
 123       (
 124        (eg (find-engraver-by-name name ))
 125        )
 126
 127     (cons (symbol->string name )
 128           (engraver-doc-string eg #f)
 129      )
 130     ))
 131
 132 (define (document-property-operation op)
 133   (let
 134       ((tag (car op))
 135        (body (cdr op))
 136        (sym (cadr op))
 137        )
 138
 139   (cond
 140    ((equal?  tag 'push)
 141     (string-append
 142      "@item "
 143      (if (null? (cddr body))
 144          "Revert "
 145          "Set "
 146          )
 147      "grob-property @code{"
 148      (symbol->string (cadr body))
 149      "} in @ref{" (symbol->string sym)
 150      "}"
 151      (if (not (null? (cddr body)))
 152          (string-append " to @code{" (scm->texi (cadr (cdr body))) "}" )
 153          )
 154     "\n"
 155      )
 156
 157     )
 158    ((equal? (object-property sym 'is-grob?) #t) "")
 159    ((equal? (car op) 'assign)
 160     (string-append
 161      "@item Set translator property @code{"
 162      (symbol->string (car body))
 163      "} to @code{"
 164      (scm->texi (cadr body))
 165      "}\n"
 166      )
 167      )
 168    )
 169   ))
 170
 171
 172 (define (context-doc context-desc)
 173   (let*
 174       (
 175        (name-sym (cdr (assoc 'context-name context-desc)))
 176        (name (symbol->string name-sym))
 177        (aliases (map symbol->string (cdr (assoc 'aliases context-desc))))
 178        (desc-handle (assoc 'description context-desc))
 179        (desc (if (and  (pair? desc-handle) (string? (cdr desc-handle)))
 180                  (cdr desc-handle) "(not documented)"))
 181
 182        (accepts (cdr (assoc 'accepts context-desc)))
 183        (consists (append
 184                   (list (cdr (assoc 'group-type context-desc)))
 185                   (cdr (assoc 'consists context-desc))
 186                   ))
 187        (props (cdr (assoc 'property-ops context-desc)))
 188        (grobs  (context-grobs context-desc))
 189        (grob-refs (map (lambda (x) (ref-ify x)) grobs)) )
 190
 191     (make <texi-node>
 192       #:name name
 193       #:text
 194       (string-append
 195        desc
 196        "\n\n This context is also known as: \n\n"
 197        (human-listify aliases)
 198        "\n\nThis context creates the following grobs: \n\n"
 199        (human-listify (uniq-list (sort grob-refs string<? )))
 200        "."
 201        (if (pair? props)
 202            (string-append
 203             "\n\nThis context sets the following properties:\n"
 204             "@itemize @bullet\n"
 205             (apply string-append (map document-property-operation props))
 206             "@end itemize\n"
 207             )
 208            ""
 209            )
 210
 211        (if (null? accepts)
 212            "\n\nThis context is a `bottom' context; it can not contain other contexts."
 213            (string-append
 214             "\n\nContext "
 215             name " can contain \n"
 216             (human-listify (map ref-ify (map symbol->string accepts)))))
 217
 218        "\n\nThis context is built from the following engravers: "
 219        (description-list->texi
 220               (map document-engraver-by-name consists))
 221        ))))
 222
 223 (define (engraver-grobs  grav)
 224   (let* ((eg (if (symbol? grav)
 225                  (find-engraver-by-name grav)
 226                  grav)))
 227
 228     (if (eq? eg #f)
 229         '()
 230         (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg)))))
 231   ))
 232
 233 (define (context-grobs context-desc)
 234   (let* ((consists (append
 235                     (list (cdr (assoc 'group-type context-desc)))
 236                     (cdr (assoc 'consists context-desc))
 237                     ))
 238          (grobs  (apply append
 239                   (map engraver-grobs consists))
 240          ))
 241     grobs
 242     ))
 243
 244 (define (symbol<? l r)
 245   (string<? (symbol->string l) (symbol->string r)))
 246
 247 (define (all-contexts-doc)
 248   (let* (
 249          (paper-alist
 250           (sort (My_lily_parser::paper_description)
 251                 (lambda (x y) (symbol<? (car x) (car y)))))
 252          (names (sort (map symbol->string (map car paper-alist)) string<?))
 253          (contexts (map cdr paper-alist))
 254          )
 255
 256     (make <texi-node>
 257       #:name "Contexts"
 258       #:desc "Complete descriptions of all contexts"
 259       #:children
 260       (map context-doc contexts)
 261       )
 262     ))
 263
 264
 265 (define all-engravers-list  (ly:get-all-translators))
 266 (set! all-engravers-list
 267       (sort all-engravers-list
 268             (lambda (a b) (string<? (symbol->string (ly:translator-name a))
 269                                     (symbol->string (ly:translator-name b))))))
 270
 271 (define (all-engravers-doc)
 272   (make <texi-node>
 273     #:name "Engravers"
 274     #:desc "All separate engravers"
 275     #:children
 276     (map engraver-doc all-engravers-list)))
 277
 278 (define (all-translation-properties-doc)
 279
 280   (let*
 281       (
 282        (ps (sort (map symbol->string all-translation-properties) string<?))
 283        (sortedsyms (map string->symbol ps))
 284        (propdescs
 285         (map
 286          (lambda (x) (document-property x 'translation #f))
 287          sortedsyms))
 288        (texi (description-list->texi propdescs))
 289        )
 290
 291     (make <texi-node>
 292       #:name "Context properties"
 293       #:desc "All  context properties"
 294       #:text texi)
 295     ))
 296
 297
 298 ;(dump-node (all-contexts-doc) (current-output-port) 0 )
 299
 300 (define (translation-doc-node)
 301   (make <texi-node>
 302     #:name "Translation"
 303     #:desc "From music to layout"
 304     #:children
 305     (list
 306      (all-contexts-doc)
 307      (all-engravers-doc)
 308      (all-translation-properties-doc)
 309      )
 310   ))