scm/document-translation.scm

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