X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbackend-documentation-lib.scm;h=20a24dcc158d09c7600af48635d63aa09b56f8b7;hb=04e206e924920be3028b1c31001e75e8f27e26ee;hp=0667b1bc49abdb87fabb04c8aed4f39941aa8def;hpb=df4a7c4a55148e065d878dcc2f7e09ac27ea9c32;p=lilypond.git

diff --git a/scm/backend-documentation-lib.scm b/scm/backend-documentation-lib.scm
index 0667b1bc49..20a24dcc15 100644
--- a/scm/backend-documentation-lib.scm
+++ b/scm/backend-documentation-lib.scm
@@ -2,7 +2,7 @@
 ;;;
 ;;; source file of the GNU LilyPond music typesetter
 ;;; 
-;;; (c) 2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;; (c) 2000--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 ;;; Jan Nieuwenhuizen <janneke@gnu.org>
 
 
@@ -10,188 +10,197 @@
 
 ;; alist of property descriptions
 
+;;
+"
+TODO:
 
-(define (backend-property->texi sym)
-  (let* (
-	(name (symbol->string sym))
-	(type (object-property sym 'backend-type?))
-	(typename (type-name type))
-	(desc (object-property sym 'backend-doc))
-	)
 
-    (cons (string-append "@code{" name "} "
-		       "(" typename ")"
-		       ":" )
-	  desc)
-    ))
+Grob bla
 
-(define (document-element-property sym element-description only-doc-if-set)
-  (let*
-      (
-       (handle (assoc sym element-description))
-       (defval (if (eq? handle #f)
-		   ""
-		   (scm->texi (cdr handle))
-		   ))
-       (propdoc (backend-property->texi sym))
-       )
+Created by:
 
-    (if (and only-doc-if-set  (eq? handle #f) )
-	'("" . "")
-	(cons (car propdoc) (string-append (cdr propdoc)
-					   "\nDefault value: "
-					   defval)))
-    ))
+  * preset properties + explanation
+
+Interfaces:
 
-(define (document-interface where interface element-description)
-  "
+  * properties available.
 
 "
-  (let* ((level (if (eq? where 'element) 3 2))
-	 (name (car interface))
-	 (desc (cadr interface))
-	 (props (caddr interface))
-	 (docfunc  (lambda (x)
-		    (document-element-property
-		     x element-description (eq? where 'element))))
-	 (docs (map docfunc props))
-	 )
 
-    (string-append
-     (texi-section level (string-append (interface-name (symbol->string name))) (eq? where 'element)) ;gur.
-     desc
-     
-     (description-list->texi docs)
-     )))
 
-;; First level Interface description
-(define (document-separate-interface interface)
-  (let ((name (car interface)))
-    (processing name)
-    (string-append
-     (node (interface-name name))
-     (document-interface 'self interface '()))))
-
-;; First level element description
-(define (document-element iname description)
-  (processing iname)
-  (let* ((metah (assoc 'meta description))
-	 
-	 (meta (if (pair? metah)
-		   (cdr metah)
-		   '((properties . ()) (name . "huh?"))
-		   ))
-	 
-	 (name (cdr (assoc 'name meta)))
-	 (ifaces (cdr (assoc 'interface-descriptions meta)))
-	 (ifacedoc (map (lambda (x) (document-interface 'element x description))
-			(reverse ifaces))))
+(define (interface-doc-string interface grob-description)
+  (let*
+      (
+       (name (car interface))
+       (desc (cadr interface))
+       (props (sort (caddr interface) symbol<?))
+       (docfunc (lambda (pr)
+		  (document-property
+		   pr 'backend grob-description )))
+       (propdocs (map docfunc props))
+       )
     
     (string-append
-     (node (element-name name))
-     (texi-section 2 (element-name name) #f)
-     "\n"
-
-     (let* ((element (string->symbol name))
-	    (engravers
-	     (apply append
-		    (map (lambda (x)
-			   (let ((engraver (car x))
-				 (objs (cadddr x)))
-			     (if (member element objs)
-				 (list engraver)
-				 '())))
-			 engraver-description-alist))))
-       (string-append
-	name " elements are created by: "
-	(human-listify (map reffy (map engraver-name engravers)))))
-
-     (apply string-append ifacedoc))))
-     
-
-(define (document-all-elements name)
-  (let* ((doc (apply string-append
-		     (map (lambda (x) (document-element (car x) (cdr x)))
-			  all-element-descriptions)))
-	 (names (map car all-element-descriptions)))
+     desc
+     "\n\n"
+     (description-list->texi propdocs))
 
-    (string-append
-     (texi-node-menu name (map (lambda (x) (cons (element-name x) ""))
-			       names))
-     doc)))
-
-;; testin.. -- how to do this
-(eval-string (ly-gulp-file "interface.scm"))
-(define xinterface-description-alist
-  `(
-    (general-element . ,general-element-interface)
-    (beam . ,beam-interface)
-    (clef . ,clef-interface)
-    (slur . ,slur-interface)
     ))
 
-;; burp, need these for running outside of LilyPond
-(if #f
-    (begin
 
-      (debug-enable 'backtrace)
+(define iface->grob-table (make-vector 61 '()))
+;; extract ifaces, and put grob into the hash table.
+(map
+ (lambda (x)
+   (let*
+       (
+	(metah (assoc 'meta (cdr x)))
+	(meta (cdr metah))
+	(ifaces (cdr (assoc 'interfaces meta)))
+	)
 
-      (define (number-pair?  x)
-	(and (pair? x) (number? (car x)) (number? (cdr x))))
-      
-      (define (ly-gulp-file x) "")
-      (define (ly-grob? x) #f)
-      (define (ly-input-location? x) #f)
-      (define (dir? x) #f)
-      (define (moment? x) #f)
-      (load "lily.scm")))
+     (map (lambda (iface)
+	    (hashq-set!
+	     iface->grob-table iface
+	     (cons (car x)
+		   (hashq-ref iface->grob-table iface '())
+		   )))
+	  ifaces)
+     ))
+ all-grob-descriptions)
 
-(use-modules (ice-9 string-fun))
+;; First level Interface description
+(define (interface-doc interface)
+  (let ((name (symbol->string (car interface))))
+    (make <texi-node>
+      #:name name
+      #:text (string-append
+	      (interface-doc-string (cdr interface) #f)
+	      "\n\n"
+	      "This grob interface is used in the following graphical objects: "
+
+	      (human-listify
+	       (map ref-ify
+		    (map symbol->string
+			 (hashq-ref iface->grob-table (car interface) '() )))))
+
+      )))
+
+(define (grob-doc description)
+  "Given a property alist DESCRIPTION, make a documentation
+node."
+  
+  (let*
+      (
+       (metah (assoc 'meta description))
+       
+       (meta (cdr metah))
+       (name (cdr (assoc 'name meta)))
+       (ifaces (map lookup-interface (cdr (assoc 'interfaces meta))))
+       (ifacedoc (map (lambda (iface)
+			(string-append
+"@html
+<hr>
+@end html
+
+@subsubheading "
+(ref-ify (symbol->string (car iface)))
+
+"\n\n"
+			(interface-doc-string iface description)))
+		      (reverse ifaces)))
+       (engravers (filter-list
+		   (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
+       (namestr (symbol->string name))
+       (engraver-names (map ly:translator-name engravers))
+       )
+
+    (make <texi-node>
+      #:name namestr
+      #:text
+      (string-append
+       namestr " grobs are created by: "
+       (human-listify (map ref-ify
+			   (map engraver-name engraver-names)))
+       (apply string-append ifacedoc)
+       ))
+    ))
 
-(define interface-file-str (string-append (ly-gulp-file "interface.scm") "\n(define "))
+(define (all-grobs-doc)
+  (make <texi-node>
+    #:name "All Graphical objects"
+    #:desc "Description and defaults for all Grobs"
+    #:children
+    (map (lambda (x) (grob-doc (cdr x)))  all-grob-descriptions)))
 
-(define (list-interface-names)
-  (let* ((text interface-file-str)
-	 (r (make-regexp 
-	     "\n[(](define *([a-z-]*-interface)*)*[^\n]*"))
-	 (t (regexp-substitute/global #f r text 2 " " 'post))
-	 (ugh (regexp-substitute/global #f "#f *" t 'pre 'post))
-	 (l (separate-fields-discarding-char #\  ugh list)))
-    (reverse (cdr (reverse l)))))
+(define interface-description-alist
+  (hash-fold
+   (lambda (key val prior)
+     (cons (cons key val)  prior)
+     )
+   '() (ly:all-grob-interfaces)))
 
+(set! interface-description-alist (sort interface-description-alist alist<?))
 
 
+;;;;;;;;;; check for dangling backend properties.
+(define (mark-interface-properties entry)
+  (map (lambda (x) (set-object-property! x  'iface-marked #t)) (caddr (cdr entry)))
+  )
 
-(eval (ly-gulp-file "interface.scm"))
+(map mark-interface-properties interface-description-alist)
 
-(define interface-description-alist
-  (map (lambda (x) (cons (string->symbol x) (eval-string x)))
-	     (list-interface-names)))
+(define (check-dangling-properties prop)
+  (if (not (object-property prop 'iface-marked))
+      (error  "\ngrob-property-description.scm: Can't find interface for property:" prop)))
 
-(set! interface-description-alist (sort interface-description-alist alist<?))
+(map check-dangling-properties all-backend-properties)
 
-(define (document-all-interfaces name)
-  (string-append
-   (texi-node-menu name (map (lambda (x) (cons (interface-name x) ""))
-			     (map cadr interface-description-alist)))
-   (apply string-append
-	  (map document-separate-interface
-	       (map cdr interface-description-alist)))))
+;;;;;;;;;;;;;;;;
 
-(define (document-all-backend-properties name)
+(define (lookup-interface name)
+  (let*  (
+	  (entry  (hashq-ref (ly:all-grob-interfaces) name #f))
+	  )
+
+    (if (equal? entry #f)
+	(error "Unknown interface" name))
+    
+    entry
+))
+
+(define (all-interfaces-doc)
+  (make <texi-node>
+    #:name "Graphical Object Interfaces"
+    #:desc "Building blocks of graphical objects"
+    #:children
+    (map interface-doc interface-description-alist)
+    ))
+
+(define (all-backend-properties-doc)
   (let*
       (
        (ps (sort (map symbol->string all-backend-properties) string<?))
        (descs (map (lambda (prop)
-		     (backend-property->texi (string->symbol prop)))
+		     (document-property (string->symbol prop) 'backend #f))
 		   ps))
        (texi (description-list->texi descs))
        )
-    
-    (string-append
-     (node name)
-     (texi-section 1 name #f)
-     texi)
-  )
-  )
-  
+    (make <texi-node>
+      #:name "backend properties"
+      #:desc "all the properties in use as grob properties"
+      #:text texi)
+  ))
+
+;(dump-node (grob-doc (cdadr all-grob-descriptions))  (current-output-port) 0 )
+(define (backend-doc-node)
+  (make <texi-node>
+    #:name "Backend"
+    #:desc "Reference for the layout engine"
+    #:children
+    (list
+     (all-grobs-doc)
+     (all-interfaces-doc)
+     (all-backend-properties-doc)
+     )
+  ))