release: 1.3.103

[lilypond.git] / scm / generate-engraver-documentation.scm

diff --git a/scm/generate-engraver-documentation.scm b/scm/generate-engraver-documentation.scm
index 2925d1c73b89abf2a1296b703a9e6c9ba592d23f..9ab114fb6da83aef44cdef7241693a50bbd7dc66 100644 (file)
--- a/scm/generate-engraver-documentation.scm
+++ b/scm/generate-engraver-documentation.scm
@@ -7,72 +7,85 @@
                  )
    )
 
-(define (document-engraver engraver-name)
-  
-  (let*
-      (
-       (eg (assoc (string->symbol engraver-name) engraver-description-alist))
-       (engraver-descr (if (eq? eg #f) '() (cdr eg)))
-       )
-
-    
-    (if (eq? eg #f)
-       (string-append "<hr>Engraver " engraver-name ", not documented.\n")
-       (string-append
-        "<hr><h2><code>" (car engraver-descr) "</code></h2>\n"
-        "<h3>Description</h3>"
-        (cadr engraver-descr)
-        "<p>This engraver creates the following elements:\n "
-        (human-listify (map urlfy (caddr engraver-descr)))
-        "<ul>\n"
-        (apply string-append 
-               (map (lambda (x) (document-trans-property x))
-                    (car (cdddr engraver-descr)))
-               )
-        "</ul>\n"       
+(define (document-engraver engraver-descr)
+ 
+  (let* (
+        (props (car (cdddr engraver-descr)))
+        (name (car engraver-descr))
+        (desc (cadr engraver-descr))
+        (objs (caddr engraver-descr))
         )
-       
-       )
+    (string-append
+     "<hr><h2>" name "</h2><p>\n"
+     desc
+     "<p>"
+     (if (null? props)
+        ""
+        (string-append
+         "<h3>Properties</h3>\n<ul>\n"
+         (apply string-append 
+                (map (lambda (x) (document-trans-property x)) props)
+                )
+         "</ul>\n")
+        )
+     (if  (null? objs)
+         ""
+         (string-append
+          "This engraver creates \n "
+          (human-listify (map urlfy objs))
+          " objects")
+         )
+     )
     )
   )
 
-(define (urlfy x)
-  (string-append "<a href=" x ".html>" x "</a>"))
-
-(define (human-listify l)
-  (cond
-   ((null? l) "none")
-   ((null? (cdr l)) (car l))
-   ((null? (cddr l)) (string-append (car l) " and " (cadr l)))
-   (else (string-append (car l) ", " (human-listify (cdr l))))
-   ))
-
 
+(define (document-engraver-by-name name)
+  (let*
+      (
+       (eg (assoc (string->symbol name) engraver-description-alist))
+       )
 
+    (if (eq? eg #f)
+       (string-append "Engraver " name ", not documented.\n")
+       (document-engraver (cdr eg))
+       )
+))
 
 (define (context-doc-string context-desc)
   (let*
       (
-       (nm (cdr (assoc 'type-name context-desc)))
+       (name (cdr (assoc 'type-name context-desc)))
+       (desc-handle (assoc (string->symbol name) context-description-alist))
+       (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
+       
        (accepts (cdr (assoc 'accepts context-desc)))
        (consists (append
+                 (list (cdr (assoc 'group-type context-desc)))
                  (cdr (assoc 'consists context-desc))
                  (cdr (assoc 'end-consists  context-desc))
                  ))
        )
     
     (string-append 
-     "<h1>" nm "</h1>\n"
-     "accepts:\n"
-     (human-listify (map urlfy accepts))
-     "<hr>\n"
+     "<h1>Context " name "</h1>\n"
+     desc
+     
+     (if (null? accepts)
+        "This context is a `bottom' context; it can not contain other contexts."
+        (string-append
+         name " can contain \n"
+         (human-listify (map urlfy accepts))
+         ))
+     "<p>This context is built from the following engravers\n"
      (apply string-append 
-           (map document-engraver consists)
+           (map document-engraver-by-name consists)
            )
      )
     )
   )
 
+
 ;; FIXME element ChordNames overwrites context ChordNames.
 (define (document-context context-desc)
     (let*
@@ -83,7 +96,7 @@
         (out (open-output-file outname))
         )
 
-      (display (string-append "Writing " outname " ... \n") (current-error-port))
+      (writing-wip outname)
       (display
        (string-append "<title>LilyPond Context " name " </title>"
                      docstr)
@@ -95,21 +108,23 @@
 
 
 (define (document-paper paper-alist)
+;  (write paper-alist)
   (let*
       (
-       (ufiles (map (lambda (x) (document-context  x )) paper-alist))
-       (files (sort ufiles string<?))
-       (outname  (string-append "translation.html"))
+       (names (sort (map car paper-alist) string<?))
+       (contexts (map cdr paper-alist))
+       (files (map document-context contexts))
+       (outname  (string-append "contexts.html"))
        (out (open-output-file outname))
        (l (map (lambda (x) (string-append
-                           "<li><a href=" x ">" x "</a>\n"))
-              files))
+                           "<li>" (urlfy x)))
+                      names))
        )
-    (write files)
+
     (display
      (string-append
-      "<title>LilyPond music translation documentation</title>"
-      "<h1>LilyPond music translation documentation</h1>"
+      "<title>LilyPond interpretation context documentation</title>"
+      "<h1>LilyPond interpretation context documentation</h1>"
       "<ul>"
       (apply string-append l)
       "</ul>"
@@ -119,8 +134,46 @@
    )
   )
 
+(define (document-engraver-separately desc)
+  (let* (
+        (name (car desc))
+        (outname (string-append name ".html"))
+        (out (open-output-file outname))
+        (doc (document-engraver desc))
+        )
+
+    (writing-wip outname)
+    (display doc out)
+    outname
+    ))
+
+(define (document-all-engravers)
+  (let*
+      (
+       (descs  (map cdr engraver-description-alist))
+       (names  (map car engraver-description-alist))
+       (fnames (map document-engraver-separately descs))
+       (outname  "engravers.html")
+       (out (open-output-file outname))
+       )
+
+    (display 
+    (string-append
+     "<title>All LilyPond engravers</title>"
+     "<h1>All LilyPond engravers</h1>"
+     "<ul>"
+     (apply string-append
+           (map (lambda (x) (string-append "<li>" x))
+                (map urlfy names)))
+     "</ul>"
+     ) out)
+  ))
+
 ; (display (document-engraver 'Stem_engraver))
 
-(document-paper (My_lily_parser::paper_description))
+
 
 ;(display (human-listify '("a" "b" "c"))) 
+
+(document-paper (My_lily_parser::paper_description))
+(document-all-engravers)