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