X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdocument-backend.scm;h=08cc17cd33ce4d64c12e366d9a8e48e1a19ec7f7;hb=87eedcd59f4082cb0841528ad5bc82cb1d1191e3;hp=cbd9f390aa10c6dbc93219306942615a5d7e557a;hpb=4127e2952126d6084d59d7c00dae5bfb1bfbbf8e;p=lilypond.git diff --git a/scm/document-backend.scm b/scm/document-backend.scm index cbd9f390aa..08cc17cd33 100644 --- a/scm/document-backend.scm +++ b/scm/document-backend.scm @@ -1,62 +1,54 @@ -;;; backend-documentation-lib.scm -- Functions for backend documentation -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Han-Wen Nienhuys -;;; Jan Nieuwenhuizen - +;;;; backend-documentation-lib.scm -- Functions for backend documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2006 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define (interface-doc-string interface grob-description) - (let* - ((name (car interface)) - (desc (cadr interface)) - (props (sort (caddr interface) symboltexi - 'backend pr grob-description))) - (iprops (filter (lambda (x) (object-property x 'backend-internal) ) props)) - (uprops (filter (lambda (x) (not (object-property x 'backend-internal)) ) props)) - (user-propdocs (map docfunc uprops)) - (internal-propdocs (map docfunc iprops))) - - (string-append - desc - - (if (pair? uprops) - (string-append - "\n\n@unnumberedsubsubsec User settable properties:\n" - (description-list->texi user-propdocs)) - "") - - (if (pair? iprops) - (string-append - "\n\n@unnumberedsubsubsec Internal properties: \n" - (description-list->texi internal-propdocs) - ) - "") - ) - )) - + (let* ((name (car interface)) + (desc (cadr interface)) + (props (sort (caddr interface) symboltexi + 'backend pr grob-description))) + (iprops (filter (lambda (x) (object-property x 'backend-internal)) + props)) + (uprops (filter + (lambda (x) (not (object-property x 'backend-internal))) + props)) + (user-propdocs (map docfunc uprops)) + (internal-propdocs (map docfunc iprops))) + + (string-append + desc + + (if (pair? uprops) + (string-append + "\n\n@unnumberedsubsubsec User settable properties:\n" + (description-list->texi user-propdocs)) + "") + + (if (pair? iprops) + (string-append + "\n\n@unnumberedsubsubsec Internal properties: \n" + (description-list->texi internal-propdocs)) + "")))) (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))) - ) + (let* ((metah (assoc 'meta (cdr x))) + (meta (cdr metah)) + (ifaces (cdr (assoc 'interfaces meta)))) (map (lambda (iface) (hashq-set! iface->grob-table iface (cons (car x) - (hashq-ref iface->grob-table iface '()) - ))) - ifaces) - )) + (hashq-ref iface->grob-table iface '())))) + ifaces))) all-grob-descriptions) ;; First level Interface description @@ -73,57 +65,47 @@ (map ref-ify (sort (map symbol->string - (hashq-ref iface->grob-table (car interface) '() )) - stringgrob-table (car interface) '())) + stringtexi alist) - (let* - ((uprops (filter (lambda (x) (not (object-property x 'backend-internal))) - (map car alist)))) + (let* ((uprops (filter (lambda (x) (not (object-property x 'backend-internal))) + (map car alist)))) (description-list->texi (map (lambda (y) (property->texi 'backend y alist)) - uprops) - ))) - + uprops)))) (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) - (ref-ify (symbol->string (car iface))) - ) - (reverse ifaces))) - (engravers (filter - (lambda (x) (engraver-makes-grob? name x)) all-engravers-list)) - (namestr (symbol->string name)) - (engraver-names (map symbol->string (map ly:translator-name engravers))) - ) + + (let* ((metah (assoc 'meta description)) + (meta (cdr metah)) + (name (cdr (assoc 'name meta))) + ;; (bla (display name)) + (ifaces (map lookup-interface (cdr (assoc 'interfaces meta)))) + (ifacedoc (map (lambda (iface) + (if (pair? iface) + (ref-ify (symbol->string (car iface))) + (ly:error (_ "pair expected in doc ~s") name))) + (reverse ifaces))) + (engravers (filter + (lambda (x) (engraver-makes-grob? name x)) all-engravers-list)) + (namestr (symbol->string name)) + (engraver-names (map symbol->string (map ly:translator-name engravers)))) (make #:name namestr #:text (string-append - namestr " grobs are created by: " + namestr " objects are created by: " (human-listify (map ref-ify (map engraver-name engraver-names))) "\n\nStandard settings: \n\n" (grob-alist->texi description) "\n\nThis object supports the following interfaces: \n" - (human-listify ifacedoc) - )) - )) + (human-listify ifacedoc))))) (define (all-grobs-doc) (make @@ -135,60 +117,48 @@ node." (define interface-description-alist (hash-fold (lambda (key val prior) - (cons (cons key val) prior) - ) + (cons (cons key val) prior)) '() (ly:all-grob-interfaces))) (set! interface-description-alist (sort interface-description-alist alist #:name "Graphical Object Interfaces" #:desc "Building blocks of graphical objects" #:children - (map interface-doc interface-description-alist) - )) + (map interface-doc interface-description-alist))) (define (backend-properties-doc-string lst) - (let* - ( - (ps (sort (map symbol->string lst) stringtexi 'backend (string->symbol prop) '())) - ps)) - (texi (description-list->texi descs)) - ) + (let* ((ps (sort (map symbol->string lst) stringtexi 'backend (string->symbol prop) '())) ps)) + (texi (description-list->texi descs))) texi)) - -;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 ) +;;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 ) (define (backend-doc-node) (make #:name "Backend" @@ -197,12 +167,11 @@ node." (list (all-grobs-doc) (all-interfaces-doc) - (make - #:name "User backend properties" - #:desc "All tunable properties in a big list" - #:text (backend-properties-doc-string all-user-grob-properties)) - (make - #:name "Internal backend properties" - #:desc "All internal layout properties in a big list" - #:text (backend-properties-doc-string all-internal-grob-properties)) - ))) + (make + #:name "User backend properties" + #:desc "All tunable properties in a big list" + #:text (backend-properties-doc-string all-user-grob-properties)) + (make + #:name "Internal backend properties" + #:desc "All internal layout properties in a big list" + #:text (backend-properties-doc-string all-internal-grob-properties)))))