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 context-name 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 (cdr (assoc 'type-name context-desc)))
 175        (desc-handle (assoc 'description context-desc))
 176        (desc (if (and  (pair? desc-handle) (string? (cdr desc-handle)))
 177                  (cdr desc-handle) "(not documented)"))
 178
 179        (accepts (cdr (assoc 'accepts context-desc)))
 180        (consists (append
 181                   (list (cdr (assoc 'group-type context-desc)))
 182                   (cdr (assoc 'consists context-desc))
 183                   (cdr (assoc 'end-consists  context-desc))
 184                   ))
 185        (props (cdr (assoc 'property-ops context-desc)))
 186        (grobs  (context-grobs context-desc))
 187        (grob-refs (map (lambda (x) (ref-ify x)) grobs))
 188        )
 189     (make <texi-node>
 190       #:name name
 191       #:text
 192       (string-append
 193        desc
 194        "\n\nThis context creates the following grobs: \n\n"
 195        (human-listify (uniq-list (sort grob-refs string<? )))
 196        "."
 197        (if (pair? props)
 198            (string-append
 199             "\n\nThis context sets the following properties:\n"
 200             "@itemize @bullet\n"
 201             (apply string-append (map document-property-operation props))
 202             "@end itemize\n"
 203             )
 204            ""
 205            )
 206
 207        (if (null? accepts)
 208            "\n\nThis context is a `bottom' context; it can not contain other contexts."
 209            (string-append
 210             "\n\nContext "
 211             name " can contain \n"
 212             (human-listify (map ref-ify (map context-name accepts)))))
 213
 214        "\n\nThis context is built from the following engravers: "
 215        (description-list->texi
 216               (map document-engraver-by-name consists))
 217        ))))
 218
 219 (define (engraver-grobs  grav)
 220   (let* (
 221          (eg (if (string? grav)
 222                  (find-engraver-by-name grav)
 223                  grav))
 224
 225              )
 226
 227     (if (eq? eg #f)
 228         '()
 229         (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg))))
 230         )
 231   ))
 232
 233 (define (context-grobs context-desc)
 234   (let* (
 235          (consists (append
 236                     (list (cdr (assoc 'group-type context-desc)))
 237                     (cdr (assoc 'consists context-desc))
 238                     (cdr (assoc 'end-consists  context-desc))
 239                     ))
 240          (grobs  (apply append
 241                   (map engraver-grobs consists))
 242          )
 243          )
 244     grobs
 245     ))
 246
 247 (define (symbol<? l r)
 248   (string<? (symbol->string l) (symbol->string r)))
 249
 250 (define (all-contexts-doc)
 251   (let* (
 252          (paper-alist
 253           (sort (My_lily_parser::paper_description)
 254                 (lambda (x y) (symbol<? (car x) (car y)))))
 255          (names (sort (map symbol->string (map car paper-alist)) string<?))
 256          (contexts (map cdr paper-alist))
 257          )
 258
 259     (make <texi-node>
 260       #:name "Contexts"
 261       #:desc "Complete descriptions of all contexts"
 262       #:children
 263       (map context-doc contexts)
 264       )
 265     ))
 266
 267
 268 (define all-engravers-list  (ly:get-all-translators))
 269 (set! all-engravers-list
 270       (sort all-engravers-list
 271             (lambda (a b) (string<? (ly:translator-name a)
 272                                     (ly:translator-name b)))))
 273
 274 (define (all-engravers-doc)
 275   (make <texi-node>
 276     #:name "Engravers"
 277     #:desc "All separate engravers"
 278     #:children
 279     (map engraver-doc all-engravers-list)))
 280
 281 (define (all-translation-properties-doc)
 282
 283   (let*
 284       (
 285        (ps (sort (map symbol->string all-translation-properties) string<?))
 286        (sortedsyms (map string->symbol ps))
 287        (propdescs
 288         (map
 289          (lambda (x) (document-property x 'translation #f))
 290          sortedsyms))
 291        (texi (description-list->texi propdescs))
 292        )
 293
 294     (make <texi-node>
 295       #:name "Translation properties"
 296       #:desc "All translation properties"
 297       #:text texi)
 298     ))
 299
 300
 301 ;(dump-node (all-contexts-doc) (current-output-port) 0 )
 302
 303 (define (translation-doc-node)
 304   (make <texi-node>
 305     #:name "Translation"
 306     #:desc "From music to layout"
 307     #:children
 308     (list
 309      (all-contexts-doc)
 310      (all-engravers-doc)
 311      (all-translation-properties-doc)
 312      )
 313   ))