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