scm/generate-backend-documentation.scm

   1
   2 ;;;;
   3 ;
   4 ; This file generates documentation for the backend of lilypond.
   5 ;
   6 ;;;;
   7
   8
   9 (define (uniqued-alist  alist acc)
  10   (if (null? alist) acc
  11       (if (assoc (caar alist) acc)
  12           (uniqued-alist (cdr alist) acc)
  13           (uniqued-alist (cdr alist) (cons (car alist) acc)
  14   ))))
  15
  16 ;;; TODO
  17
  18 (define (wordwrap string)
  19   ""
  20   )
  21
  22 (define (self-evaluating? x)
  23   (or (number? x) (string? x) (procedure? x) (boolean? x))
  24   )
  25
  26
  27 (define (htmlfy x)
  28   (let*
  29       ((x1 (regexp-substitute/global #f ">" x 'pre "&gt;" 'post))
  30        (x2 (regexp-substitute/global #f "<" x1 'pre "&lt;" 'post))
  31        )
  32     x2))
  33
  34 (define (scm->string val)
  35   (string-append
  36    (if (self-evaluating? val) "" "'")
  37    (htmlfy
  38     (call-with-output-string (lambda (port) (display val port))))
  39   ))
  40
  41 (define (document-property prop desc)
  42   (let ((handle (assoc (car prop) desc)))
  43     (string-append
  44      "\n<li><code>" (symbol->string (car prop)) "</code> (" (type-name (cadr prop)) ") -- "
  45      (caddr prop)
  46      "<br>default value:  <code>"
  47      (if (pair? handle)
  48          (scm->string (cdr handle))
  49          "not set"
  50          )
  51      "</code>\n"
  52   )
  53   ))
  54
  55 (define (document-interface interface elt-description)
  56   (let* ((name (car interface))
  57          (desc (cadr interface))
  58          (props (caddr interface))
  59          (docs (map (lambda (x) (document-property x elt-description))
  60                     props))
  61          )
  62
  63     (string-append
  64      "<hr>"
  65      "<h2>Interface: " (symbol->string name) "</h2>\n"
  66      desc
  67      "<hr>\n<ul>"
  68      (apply string-append docs)
  69      "</ul>"
  70      )
  71     ))
  72
  73 ;
  74 ; generate HTML, return filename.
  75 ;
  76 (define (document-element iname description)
  77   (display (string-append "Processing " iname " ... ") (current-error-port))
  78   (let* ((metah (assoc 'meta description))
  79
  80          (meta (if (pair? metah)
  81                    (cdr metah)
  82                    '((properties . ()) (name . "huh?"))
  83                    ))
  84
  85          (name (cdr (assoc 'name meta)))
  86          (ifaces (cdr (assoc 'interface-descriptions meta)))
  87          (ifacedoc (map (lambda (x) (document-interface x description))
  88                                 (reverse ifaces)))
  89          (outname  (string-append name ".html"))
  90          (out (open-output-file outname))
  91          )
  92     (writing-wip outname)
  93     (display
  94      (string-append "<title>LilyPond Element " name " </title>"
  95                     "<h1>" name "</h1>"
  96                     (apply string-append ifacedoc))
  97      out)
  98     outname
  99     )
 100   )
 101
 102 (define (document-elements elts)
 103   (let* ((files (map (lambda (x) (document-element (car x) (cdr x)))
 104                     elts))
 105          (names (map car elts))
 106         (outname  (string-append "backend.html"))
 107         (out (open-output-file outname))
 108         (l (map (lambda (x) (string-append "<li>"
 109                                            (urlfy x))) names))
 110         )
 111     (writing-wip outname)
 112     (display
 113      (string-append
 114       "<title>LilyPond backend documentation</title>"
 115       "<h1>LilyPond backend documentation</h1>"
 116       "<ul>"
 117       (apply string-append l)
 118       "</ul>"
 119       )
 120      out
 121      )
 122     ))
 123
 124 ; (display (document-interface stem-interface '()))
 125 ; (define b (cdr (assoc 'Dyna all-element-descriptions)))
 126 ;(display b)
 127
 128 ;(document-element  b)
 129
 130 (document-elements all-element-descriptions)
 131