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