X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdocument-backend.scm;h=b70b1d6969b249b4a887a0b5fb5cc8f3ea94fba8;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=45d7cf7d4ae814ba3f9a7252cc9080b1a821ee0a;hpb=c2d44e3a71b2d031305abede97a53f6e5fcf832b;p=lilypond.git diff --git a/scm/document-backend.scm b/scm/document-backend.scm index 45d7cf7d4a..b70b1d6969 100644 --- a/scm/document-backend.scm +++ b/scm/document-backend.scm @@ -1,206 +1,196 @@ -;;; 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--2008 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@subsubheading User settable properties:\n" + (description-list->texi user-propdocs #t)) + "") + + (if (pair? iprops) + (string-append + "\n\n@subsubheading Internal properties:\n" + (description-list->texi internal-propdocs #t)) + "")))) (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 (define (interface-doc interface) - (let ((name (symbol->string (car interface)))) + (let* ((name (symbol->string (car interface))) + (interface-list (human-listify + (map ref-ify + (sort + (map symbol->string + (hashq-ref iface->grob-table + (car interface) + '())) + string #:name name #:text (string-append (interface-doc-string (cdr interface) '()) "\n\n" - "This grob interface is used in the following graphical objects: " - - (human-listify - (map ref-ify - (sort - (map symbol->string - (hashq-ref iface->grob-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) - ))) - + #t))) (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))) + (engraver-list (human-listify + (map ref-ify + (map engraver-name engraver-names))))) (make #:name namestr #:text (string-append - namestr " objects are created by: " - (human-listify (map ref-ify - (map engraver-name engraver-names))) - "\n\nStandard settings: \n\n" + namestr " objects " + (if (equal? engraver-list "none") + "are not created by any engraver" + (string-append + "are created by: " + engraver-list)) + "." + + "\n\nStandard settings:\n\n" (grob-alist->texi description) - "\n\nThis object supports the following interfaces: \n" + "\n\nThis object supports the following interface(s):\n" (human-listify ifacedoc) - )) - )) + ".")))) (define (all-grobs-doc) (make #:name "All layout objects" - #:desc "Description and defaults for all Grobs" + #:desc "Description and defaults for all graphical objects (grobs)." #:children (map (lambda (x) (grob-doc (cdr x))) all-grob-descriptions))) (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" + #: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 #f))) 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" - #:desc "Reference for the layout engine" + #:desc "Reference for the layout engine." #:children (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)))))