scm/engraver-documentation-lib.scm

   1
   2 ;;; engraver-doumentation-lib.scm -- Functions for engraver documentation
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c) 2000--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 ;;; Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9
  10
  11 ;; alist of translater descriptions
  12 (define (document-translator-property sym)
  13    (cons
  14     (string-append
  15      "@code{" (symbol->string sym) "} "
  16      "(" (type-name (object-property sym 'translation-type?)) "):")
  17     (object-property sym 'translation-doc)))
  18
  19 ;; First level Engraver description and
  20 ;; second level Context description
  21 (define (document-engraver where engraver)
  22
  23   (let* (
  24          (level (if (eq? where 'context) 3 2))
  25          (propsr (cdr (assoc 'properties-read (ly-translator-description engraver))))
  26          (propsw (cdr (assoc 'properties-written (ly-translator-description engraver))))
  27          (name (ly-translator-name engraver))
  28          (name-sym (string->symbol name))
  29          (desc (cdr (assoc 'description (ly-translator-description engraver))))
  30          (grobs (engraver-grobs engraver))
  31          )
  32
  33     (string-append
  34      (texi-section level (engraver-name name) (eq? where 'context))
  35      desc
  36      "\n\n"
  37      (if (null? propsr)
  38          ""
  39          (string-append
  40           (texi-section (+ level 1) "Properties (read)" #f)
  41           (description-list->texi
  42            (map (lambda (x) (document-translator-property x)) propsr))))
  43      (if (null? propsw)
  44          ""
  45          (string-append
  46           (texi-section (+ level 1) "Properties (write)" #f)
  47           (description-list->texi
  48            (map (lambda (x) (document-translator-property x)) propsw))))
  49      (if  (null? grobs)
  50           ""
  51           (string-append
  52            "This engraver creates the following grobs: \n "
  53            (human-listify (map ref-ify (uniq-list (sort  grobs string<? ))))
  54            ".")
  55           )
  56
  57      "\n\n"
  58
  59      (let* ((paper-alist (My_lily_parser::paper_description))
  60             (context-description-alist (map cdr paper-alist))
  61             (contexts
  62              (apply append
  63                     (map (lambda (x)
  64                            (let ((context (cdr (assoc 'type-name x)))
  65                                  (consists (append
  66                                             (list (cdr (assoc 'group-type x)))
  67                                             (cdr (assoc 'consists x))
  68                                             (cdr (assoc 'end-consists x)))))
  69
  70                              (if (member name consists)
  71                                  (list context)
  72                                  '())))
  73                          context-description-alist))))
  74        (string-append
  75         name " is part of contexts: "
  76         (human-listify (map ref-ify (map context-name contexts))))))))
  77
  78
  79 ;; First level Engraver description
  80 (define (document-separate-engraver top grav)
  81   (let ((name (ly-translator-name grav)))
  82     (processing name)
  83     (string-append
  84      (node (engraver-name name))
  85      (document-engraver 'self grav))))
  86
  87 ;; Second level, part of Context description
  88 (define (find-engraver-by-name name list)
  89   (if (null? list)
  90       #f
  91       (if (equal? name (ly-translator-name (car list)))
  92           (car list)
  93           (find-engraver-by-name name (cdr list)))))
  94
  95 (define (document-engraver-by-name name)
  96   (let*
  97       (
  98        (eg (find-engraver-by-name name all-engravers-list))
  99        )
 100
 101     (if (eq? eg #f)
 102         (string-append "Engraver " name ", not documented.\n")
 103         (document-engraver 'context eg)
 104         )
 105     ))
 106
 107 (define (document-property-operation op)
 108   (let
 109       ((tag (car op))
 110        (body (cdr op))
 111        (sym (cadr op))
 112        )
 113
 114   (cond
 115    ((equal?  tag 'push)
 116     (string-append
 117      "@item "
 118      (if (null? (cddr body))
 119          "Revert "
 120          "Set "
 121          )
 122      "grob-property "
 123      (symbol->string (cadr body))
 124      " in " (symbol->string sym)
 125      (if (not (null? (cddr body)))
 126          (string-append " to " (scm->texi (cadr (cdr body))))
 127          )
 128     "\n"
 129      )
 130
 131     )
 132    ((equal? (object-property sym 'is-grob?) #t) "")
 133    ((equal? (car op) 'assign)
 134     (string-append
 135      "@item Set translator property "
 136      (symbol->string (car body))
 137      " to "
 138      (scm->texi (cadr body))
 139      "\n"
 140      )
 141      )
 142    )
 143   ))
 144
 145
 146
 147 (define (context-doc-string context-desc)
 148   (let*
 149       (
 150        (name (cdr (assoc 'type-name context-desc)))
 151        (desc-handle (assoc (string->symbol name) context-description-alist))
 152        (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
 153
 154        (accepts (cdr (assoc 'accepts context-desc)))
 155        (consists (append
 156                   (list (cdr (assoc 'group-type context-desc)))
 157                   (cdr (assoc 'consists context-desc))
 158                   (cdr (assoc 'end-consists  context-desc))
 159                   ))
 160        (props (cdr (assoc 'property-ops context-desc)))
 161        (grobs  (context-grobs context-desc))
 162        (grob-refs (map (lambda (x) (ref-ify x)) grobs))
 163        )
 164
 165     (string-append
 166      desc
 167      "\n\nThis context creates the following grobs: \n\n"
 168      (human-listify (uniq-list (sort grob-refs string<? )))
 169      "."
 170      (if (pair? props)
 171          (string-append
 172           "\n\nThis context sets the following properties:\n"
 173           "@itemize @bullet\n"
 174           (apply string-append (map document-property-operation props))
 175           "@end itemize\n"
 176          )
 177          ""
 178          )
 179
 180      (if (null? accepts)
 181          "\n\nThis context is a `bottom' context; it can not contain other contexts."
 182          (string-append
 183           "\n\nContext "
 184           name " can contain \n"
 185           (human-listify (map ref-ify (map context-name accepts)))))
 186
 187      "\n\nThis context is built from the following engravers: "
 188      (if no-copies
 189          (human-listify (map ref-ify (map engraver-name consists)))
 190          (apply string-append
 191                 (map document-engraver-by-name consists))))))
 192
 193 (define (engraver-grobs  grav)
 194   (let* (
 195          (eg (if (string? grav)
 196                  (find-engraver-by-name grav all-engravers-list)
 197                  grav))
 198
 199              )
 200
 201     (if (eq? eg #f)
 202         '()
 203         (map symbol->string (cdr (assoc 'grobs-created (ly-translator-description eg))))
 204         )
 205   ))
 206
 207 (define (context-grobs context-desc)
 208   (let* (
 209          (consists (append
 210                     (list (cdr (assoc 'group-type context-desc)))
 211                     (cdr (assoc 'consists context-desc))
 212                     (cdr (assoc 'end-consists  context-desc))
 213                     ))
 214          (grobs  (apply append
 215                   (map engraver-grobs consists))
 216          )
 217          )
 218     grobs
 219     ))
 220
 221
 222 ;; First level Context description
 223 (define (document-context top context-desc)
 224   (let ((name (cdr (assoc 'type-name context-desc)))
 225         (doc (context-doc-string context-desc)))
 226     (processing name)
 227     (string-append
 228      (node (context-name name))
 229      (texi-section 2 (context-name name) #f)
 230       doc)))
 231
 232 (define (symbol<? l r)
 233   (string<? (symbol->string l) (symbol->string r)))
 234
 235 (define (document-paper name)
 236   (let* ((paper-alist
 237           (sort (My_lily_parser::paper_description)
 238                 (lambda (x y) (symbol<? (car x) (car y)))))
 239          (names (sort (map symbol->string (map car paper-alist)) string<?))
 240          (contexts (map cdr paper-alist))
 241          (doc (apply string-append
 242                      (map (lambda (x) (document-context name x)) contexts))))
 243
 244     (string-append
 245      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 246                                names))
 247      doc)))
 248
 249 (define all-engravers-list  (ly-get-all-translators))
 250 (define (document-all-engravers name)
 251   (let* ((gravs all-engravers-list)
 252          (names (map ly-translator-name gravs))
 253          (doc (apply string-append
 254                      (map (lambda (x) (document-separate-engraver name x))
 255                           gravs))))
 256     (string-append
 257      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 258                                names))
 259      doc)))
 260
 261 (define (document-all-engraver-properties name)
 262   (let* ((ps (sort (map symbol->string all-translation-properties) string<?))
 263          (sortedsyms (map string->symbol ps))
 264          (propdescs (map document-translator-property sortedsyms))
 265          (texi (description-list->texi propdescs)))
 266
 267   (string-append
 268           (node name)
 269           (texi-section 1 name #f)
 270           texi)))