scm/document-translation.scm

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