scm/generate-engraver-documentation.scm

   1 (eval-string (ly-gulp-file "translator-description.scm"))
   2
   3 (define (document-trans-property prop-desc)
   4    (string-append "<li><code>" (car prop-desc) "</code>"
   5                   " (" (type-name (cadr prop-desc)) "):"
   6                   (caddr prop-desc)
   7                   )
   8    )
   9
  10 (define (document-engraver engraver-descr)
  11
  12   (let* (
  13          (props (car (cdddr engraver-descr)))
  14          (name (car engraver-descr))
  15          (desc (cadr engraver-descr))
  16          (objs (caddr engraver-descr))
  17          )
  18     (string-append
  19      "<hr><h2>" name "</h2><p>\n"
  20      desc
  21      "<p>"
  22      (if (null? props)
  23          ""
  24          (string-append
  25           "<h3>Properties</h3>\n<ul>\n"
  26           (apply string-append
  27                  (map (lambda (x) (document-trans-property x)) props)
  28                  )
  29           "</ul>\n")
  30          )
  31      (if  (null? objs)
  32           ""
  33           (string-append
  34            "This engraver creates \n "
  35            (human-listify (map urlfy objs))
  36            " objects")
  37           )
  38      )
  39     )
  40   )
  41
  42
  43 (define (document-engraver-by-name name)
  44   (let*
  45       (
  46        (eg (assoc (string->symbol name) engraver-description-alist))
  47        )
  48
  49     (if (eq? eg #f)
  50         (string-append "Engraver " name ", not documented.\n")
  51         (document-engraver (cdr eg))
  52         )
  53 ))
  54
  55 (define (context-doc-string context-desc)
  56   (let*
  57       (
  58        (name (cdr (assoc 'type-name context-desc)))
  59        (desc-handle (assoc (string->symbol name) context-description-alist))
  60        (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
  61
  62        (accepts (cdr (assoc 'accepts context-desc)))
  63        (consists (append
  64                   (list (cdr (assoc 'group-type context-desc)))
  65                   (cdr (assoc 'consists context-desc))
  66                   (cdr (assoc 'end-consists  context-desc))
  67                   ))
  68        )
  69
  70     (string-append
  71      "<h1>Context " name "</h1>\n"
  72      desc
  73
  74      (if (null? accepts)
  75          "This context is a `bottom' context; it can not contain other contexts."
  76          (string-append
  77           name " can contain \n"
  78           (human-listify (map urlfy accepts))
  79           ))
  80      "<p>This context is built from the following engravers\n"
  81      (apply string-append
  82             (map document-engraver-by-name consists)
  83             )
  84      )
  85     )
  86   )
  87
  88
  89 ;; FIXME element ChordNames overwrites context ChordNames.
  90 (define (document-context context-desc)
  91     (let*
  92         (
  93          (name (cdr (assoc 'type-name context-desc)))
  94          (docstr (context-doc-string context-desc))
  95          (outname (string-append name ".html"))
  96          (out (open-output-file outname))
  97          )
  98
  99       (writing-wip outname)
 100       (display
 101        (string-append "<title>LilyPond Context " name " </title>"
 102                       docstr)
 103        out
 104        )
 105      outname)
 106     )
 107
 108
 109
 110 (define (document-paper paper-alist)
 111 ;  (write paper-alist)
 112   (let*
 113       (
 114        (names (sort (map car paper-alist) string<?))
 115        (contexts (map cdr paper-alist))
 116        (files (map document-context contexts))
 117        (outname  (string-append "contexts.html"))
 118        (out (open-output-file outname))
 119        (l (map (lambda (x) (string-append
 120                             "<li>" (urlfy x)))
 121                        names))
 122        )
 123
 124     (display
 125      (string-append
 126       "<title>LilyPond interpretation context documentation</title>"
 127       "<h1>LilyPond interpretation context documentation</h1>"
 128       "<ul>"
 129       (apply string-append l)
 130       "</ul>"
 131       )
 132      out
 133      )
 134    )
 135   )
 136
 137 (define (document-engraver-separately desc)
 138   (let* (
 139          (name (car desc))
 140          (outname (string-append name ".html"))
 141          (out (open-output-file outname))
 142          (doc (document-engraver desc))
 143          )
 144
 145     (writing-wip outname)
 146     (display doc out)
 147     outname
 148     ))
 149
 150 (define (document-all-engravers)
 151   (let*
 152       (
 153        (descs  (map cdr engraver-description-alist))
 154        (names  (map car engraver-description-alist))
 155        (fnames (map document-engraver-separately descs))
 156        (outname  "engravers.html")
 157        (out (open-output-file outname))
 158        )
 159
 160     (display
 161     (string-append
 162      "<title>All LilyPond engravers</title>"
 163      "<h1>All LilyPond engravers</h1>"
 164      "<ul>"
 165      (apply string-append
 166             (map (lambda (x) (string-append "<li>" x))
 167                  (map urlfy names)))
 168      "</ul>"
 169      ) out)
 170   ))
 171
 172 ; (display (document-engraver 'Stem_engraver))
 173
 174
 175
 176 ;(display (human-listify '("a" "b" "c")))
 177
 178 (document-paper (My_lily_parser::paper_description))
 179 (document-all-engravers)