;;;
;;; 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>
;; alist of property descriptions
-
-(define (document-element-property property-def element-description only-doc-if-set)
- "
+;;
"
- (let* (
- (handle (assoc (car property-def) element-description))
- (def-val-str (if (eq? handle #f)
- "not set"
- (scm->texi (cdr handle))))
-
- (name (symbol->string (car property-def)))
- (type (type-name (cadr property-def)))
- (desc (caddr property-def))
- )
+TODO:
- (if (and (eq? handle #f) only-doc-if-set)
- '("" . "")
- (cons (string-append "@code{" name "} "
- "(" type ")"
- ":" )
- (string-append desc
- "\nDefault value: "
- def-val-str))
- ))
- )
-(define (document-interface where interface element-description)
- "
+Grob bla
+
+Created by:
+
+ * preset properties + explanation
+
+Interfaces:
+
+ * properties available.
"
- (let* ((level (if (eq? where 'element) 3 2))
- (name (car interface))
- (desc (cadr interface))
- (props (caddr interface))
- (docfun (lambda (x)
- (document-element-property
- x element-description (eq? where 'element))))
- (docs (map docfun 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 (number-pair? x)
- (and (pair? x) (number? (car x)) (number? (cdr x))))
-
- (define (ly-gulp-file x) "")
- (define (ly-element? x) #f)
- (define (ly-input-location? x) #f)
- (define (dir? x) #f)
- (define (moment? x) #f)
- (load "lily.scm")))
+(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)))
+ )
-(use-modules (ice-9 string-fun))
+ (map (lambda (iface)
+ (hashq-set!
+ iface->grob-table iface
+ (cons (car x)
+ (hashq-ref iface->grob-table iface '())
+ )))
+ ifaces)
+ ))
+ all-grob-descriptions)
-(define interface-file-str (string-append (ly-gulp-file "interface.scm") "\n(define "))
-(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)))))
+;; 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)
+ ))
+ ))
-(eval (ly-gulp-file "interface.scm"))
+(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 interface-description-alist
- (map (lambda (x) (cons (string->symbol x) (eval-string x)))
- (list-interface-names)))
+ (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)))
+ )
+
+(map mark-interface-properties interface-description-alist)
+
+(define (check-dangling-properties prop)
+ (if (not (object-property prop 'iface-marked))
+ (error "\ngrob-property-description.scm: Can't find interface for property:" prop)))
+
+(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 (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)
+ (document-property (string->symbol prop) 'backend #f))
+ ps))
+ (texi (description-list->texi descs))
+ )
+ (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)
+ )
+ ))
projects / lilypond.git / blobdiff