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