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