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