scm/generate-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))
  24   )
  25
  26 (define (type-name  predicate)
  27   (cond
  28    ((eq? predicate dir?) "direction")
  29    ((eq? predicate ly-element?) "graphic element")
  30    ((eq? predicate pair?) "pair")
  31    ((eq? predicate integer?) "integer")
  32    ((eq? predicate list?) "list")
  33    ((eq? predicate symbol?) "symbol")
  34    ((eq? predicate string?) "string")
  35    ((eq? predicate boolean?) "string")
  36    ((eq? predicate number?) "number")
  37    ((eq? predicate char?) "char")
  38    ((eq? predicate input-port?) "input port")
  39    ((eq? predicate output-port?) "output port")
  40    ((eq? predicate vector?) "vector")
  41    ((eq? predicate procedure?) "procedure")
  42    (else "(unknown)")
  43   ))
  44
  45 (define (htmlfy x)
  46   (let*
  47       ((x1 (regexp-substitute/global #f ">" x 'pre "&gt;" 'post))
  48        (x2 (regexp-substitute/global #f "<" x1 'pre "&lt;" 'post))
  49        )
  50     x2))
  51
  52 (define (scm->string val)
  53   (string-append
  54    (if (self-evaluating? val) "" "'")
  55    (htmlfy
  56     (call-with-output-string (lambda (port) (display val port))))
  57   ))
  58
  59 (define (document-property prop desc)
  60   (let ((handle (assoc (car prop) desc)))
  61     (string-append
  62      "\n<li><code>" (symbol->string (car prop)) "</code> (" (type-name (cadr prop)) ") -- "
  63      (caddr prop)
  64      "<br>default value:  <code>"
  65      (if (pair? handle)
  66          (scm->string (cdr handle))
  67          "not set"
  68          )
  69      "</code>\n"
  70   )
  71   ))
  72
  73 (define (document-interface interface elt-description)
  74   (let* ((name (car interface))
  75          (desc (cadr interface))
  76          (props (caddr interface))
  77          (docs (map (lambda (x) (document-property x elt-description))
  78                     props))
  79          )
  80
  81     (string-append
  82      "<hr>"
  83      "<h2>Interface: " (symbol->string name) "</h2>\n"
  84      desc
  85      "<hr>\n<ul>"
  86      (apply string-append docs)
  87      "</ul>"
  88      )
  89     ))
  90
  91 ;
  92 ; generate HTML, return filename.
  93 ;
  94 (define (document-element description)
  95   (let* ((metah (assoc 'meta description))
  96          (meta (if (pair? metah)
  97                    (cdr metah)
  98                    '((properties . ()) (name . "huh?"))
  99                    ))
 100
 101          (name (cdr (assoc 'name meta)))
 102          (ifaces (cdr (assoc 'interface-descriptions meta)))
 103          (ifacedoc (map (lambda (x) (document-interface x description))
 104                                 ifaces))
 105          (outname  (string-append name ".html"))
 106          (out (open-output-file outname))
 107          )
 108     (display (string-append "Writing " outname " ... \n") (current-error-port))
 109     (display
 110      (string-append "<title>LilyPond Element " name " </title>"
 111                     "<h1>" name "</h1>"
 112                     (apply string-append ifacedoc))
 113      out)
 114     outname
 115     )
 116   )
 117
 118 (define (document-elements elts)
 119   (let* ((files (map (lambda (x) (document-element (cdr x)))
 120                     elts))
 121         (outname  (string-append "backend.html"))
 122         (out (open-output-file outname))
 123         (l (map (lambda (x) (string-append
 124                              "<li><a href=" x ">" x "</a>\n"))
 125                 files))
 126         )
 127
 128         (display
 129          (string-append
 130           "<title>LilyPond backend documentation</title>"
 131           "<h1>LilyPond backend documentation</h1>"
 132           "<ul>"
 133           (apply string-append l)
 134           "</ul>"
 135         )
 136          out
 137          )
 138    ))
 139
 140 ; (display (document-interface stem-interface '()))
 141 ; (define b (cdr (assoc 'Beam all-element-descriptions)))
 142 ;(display b)
 143
 144 ;(document-element  b)
 145
 146 (document-elements all-element-descriptions)
 147