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-name)
  11
  12   (let*
  13       (
  14        (eg (assoc (string->symbol engraver-name) engraver-description-alist))
  15        (engraver-descr (if (eq? eg #f) '() (cdr eg)))
  16        )
  17
  18
  19     (if (eq? eg #f)
  20         (string-append "<hr>Engraver " engraver-name ", not documented.\n")
  21         (string-append
  22          "<hr><h2><code>" (car engraver-descr) "</code></h2>\n"
  23          "<h3>Description</h3>"
  24          (cadr engraver-descr)
  25          "<p>This engraver creates the following elements:\n "
  26          (human-listify (map urlfy (caddr engraver-descr)))
  27          "<ul>\n"
  28          (apply string-append
  29                 (map (lambda (x) (document-trans-property x))
  30                      (car (cdddr engraver-descr)))
  31                 )
  32          "</ul>\n"
  33          )
  34
  35         )
  36     )
  37   )
  38
  39 (define (urlfy x)
  40   (string-append "<a href=" x ".html>" x "</a>"))
  41
  42 (define (human-listify l)
  43   (cond
  44    ((null? l) "none")
  45    ((null? (cdr l)) (car l))
  46    ((null? (cddr l)) (string-append (car l) " and " (cadr l)))
  47    (else (string-append (car l) ", " (human-listify (cdr l))))
  48    ))
  49
  50
  51
  52
  53 (define (context-doc-string context-desc)
  54   (let*
  55       (
  56        (nm (cdr (assoc 'type-name context-desc)))
  57        (accepts (cdr (assoc 'accepts context-desc)))
  58        (consists (append
  59                   (cdr (assoc 'consists context-desc))
  60                   (cdr (assoc 'end-consists  context-desc))
  61                   ))
  62        )
  63
  64     (string-append
  65      "<h1>" nm "</h1>\n"
  66      "accepts:\n"
  67      (human-listify (map urlfy accepts))
  68      "<hr>\n"
  69      (apply string-append
  70             (map document-engraver consists)
  71             )
  72      )
  73     )
  74   )
  75
  76 ;; FIXME element ChordNames overwrites context ChordNames.
  77 (define (document-context context-desc)
  78     (let*
  79         (
  80          (name (cdr (assoc 'type-name context-desc)))
  81          (docstr (context-doc-string context-desc))
  82          (outname (string-append name ".html"))
  83          (out (open-output-file outname))
  84          )
  85
  86       (display (string-append "Writing " outname " ... \n") (current-error-port))
  87       (display
  88        (string-append "<title>LilyPond Context " name " </title>"
  89                       docstr)
  90        out
  91        )
  92      outname)
  93     )
  94
  95
  96
  97 (define (document-paper paper-alist)
  98   (let*
  99       (
 100        (ufiles (map (lambda (x) (document-context  x )) paper-alist))
 101        (files (sort ufiles string<?))
 102        (outname  (string-append "translation.html"))
 103        (out (open-output-file outname))
 104        (l (map (lambda (x) (string-append
 105                             "<li><a href=" x ">" x "</a>\n"))
 106                files))
 107        )
 108     (write files)
 109     (display
 110      (string-append
 111       "<title>LilyPond music translation documentation</title>"
 112       "<h1>LilyPond music translation documentation</h1>"
 113       "<ul>"
 114       (apply string-append l)
 115       "</ul>"
 116       )
 117      out
 118      )
 119    )
 120   )
 121
 122 ; (display (document-engraver 'Stem_engraver))
 123
 124 (document-paper (My_lily_parser::paper_description))
 125
 126 ;(display (human-listify '("a" "b" "c")))