From 31634a53495ec6fb350da6a2cefbbc401f388599 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 28 Sep 2002 01:12:45 +0000 Subject: [PATCH] * scm/music-documentation-lib.scm: dump music expressions and music subtypes. * scm/documentation-lib.scm: complete revision. Use GOOPS objects to store document tree explicitly. Cleanedup and sped up doco generation a lot. --- lily/translator-scheme.cc | 33 +++++ scm/backend-documentation-lib.scm | 209 +++++++++----------------- scm/documentation-lib.scm | 158 +++++++++++++------- scm/engraver-documentation-lib.scm | 227 ++++++++++++++++------------- scm/function-documentation.scm | 12 +- scm/generate-documentation.scm | 83 ++++------- scm/lily.scm | 6 +- scm/music-documentation-lib.scm | 122 +++++++++++++--- scm/music-types.scm | 131 ++++++++++++++++- 9 files changed, 595 insertions(+), 386 deletions(-) create mode 100644 lily/translator-scheme.cc diff --git a/lily/translator-scheme.cc b/lily/translator-scheme.cc new file mode 100644 index 0000000000..b501c555a4 --- /dev/null +++ b/lily/translator-scheme.cc @@ -0,0 +1,33 @@ +#include "translator.hh" + +#include "translator-group.hh" +#include "lily-guile.hh" + +LY_DEFINE(ly_get_context_property, + "ly-get-context-property", 2, 0, 0, + (SCM context, SCM name), + "retrieve the value of @var{name} from context @var{context}") +{ + Translator *t = unsmob_translator (context); + Translator_group* tr= dynamic_cast (t); + SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group"); + SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol"); + + return tr->internal_get_property (name); + +} + +LY_DEFINE(ly_set_context_property, + "ly-set-context-property", 3, 0, 0, + (SCM context, SCM name, SCM val), + "set value of property @var{name} in context @var{context} to @var{val}. +") +{ + Translator *t = unsmob_translator (context); + Translator_group* tr= dynamic_cast (t); + + SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context"); + tr->internal_set_property (name, val); + + return SCM_UNSPECIFIED; +} diff --git a/scm/backend-documentation-lib.scm b/scm/backend-documentation-lib.scm index 1fa2f47d56..1a4144f3c3 100644 --- a/scm/backend-documentation-lib.scm +++ b/scm/backend-documentation-lib.scm @@ -15,137 +15,64 @@ ;;;;;; TODO: use flatten write iso. string-append; might be possible to fold ;;;;;; in symbol->string integrally. -(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))) - - - (if (equal? desc #f) - (error "Unknown property " sym) - - (cons (string-append "@code{" name "} " - "(" typename ")" - ": " - -; index gets too messy -; "@vindex " name "\n" - ) - desc)))) - -(define (document-grob-property sym grob-description ) - "Document SYM, filling in default values." - (let* ((handle (assoc sym grob-description)) - (defval (if (eq? handle #f) - "(unset)" - (scm->texi (cdr handle)))) - (propdoc (backend-property->texi sym))) - - (cons (car propdoc) (string-append (cdr propdoc) - "\nDefault value: " - defval))) - ) - -(define (document-interface where interface grob-description) - - (let* ((level (if (eq? where 'grob) 3 2)) - (name (car interface)) +(define (interface-doc-string interface grob-description) + (let* ((name (car interface)) (desc (cadr interface)) (props (sort (caddr interface) symbolstring name))) - (eq? where 'grob)) ;gur. + (document-property + pr 'backend grob-description ))) + (propdocs (map docfunc props))) + desc - (description-list->texi docs)))) + (description-list->texi propdocs))) ;; First level Interface description -(define (document-separate-interface interface) +(define (interface-doc interface) (let ((name (symbol->string (car interface)))) - (processing name) - (string-append - (node (interface-name name)) - (document-interface 'self interface '())))) - + (make + #:name name + #:text (interface-doc-string (cdr interface) #f)))) ;; First level grob description -(define (document-grob iname description) - (processing iname) - (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) - (document-interface 'grob iface description)) - (reverse ifaces))) - ) - - - (string-append - (node (grob-name name)) - (texi-section 2 (grob-name name) #f) - "\n" - (let* ((grob name) - (engravers (filter-list - (lambda (x) (engraver-makes-grob? name x)) all-engravers-list)) - (engraver-names (map ly-translator-name engravers)) - ) - - (string-append - (symbol->string name) " grobs are created by: " - (human-listify (map ref-ify - (map engraver-name engraver-names))))) - - (apply string-append ifacedoc)))) - +(define (grob-doc description) + (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) + (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 + #: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 (engraver-makes-grob? name-symbol grav) (memq name-symbol (assoc 'grobs-created (ly-translator-description grav))) ) -(define (document-all-grobs name) - (let* ((doc (apply string-append - (map (lambda (x) - (document-grob (symbol->string (car x)) (cdr x))) - all-grob-descriptions))) - (names (map symbol->string (map car all-grob-descriptions)))) - - (string-append - (texi-node-menu name (map (lambda (x) (cons (grob-name x) "")) - names)) - doc))) - -;; ugh, this works standalone, but not anymore with lily -(if (not (defined? 'standalone)) - (begin - - (load "standalone.scm") - - (define (number-pair? x) - (and (pair? x) (number? (car x)) (number? (cdr x)))) - (define (ly-grob? x) #f) - (define (ly-input-location? x) #f) - (define (dir? x) #f) - (define (moment? x) #f) - )) - -(use-modules (ice-9 string-fun)) - -(if standalone - (begin - (display "(define (list-interface-names) '") - (write (ugh-standalone-list-interface-names)) - (display ")") - (exit 0))) - +(define (all-grobs-doc) + (make + #: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 (hash-fold @@ -166,7 +93,7 @@ (define (check-dangling-properties prop) (if (not (object-property prop 'iface-marked)) - (error "\nDangling property: " prop)) + (error "\nDangling property: " prop)) ) (map check-dangling-properties all-backend-properties) @@ -184,32 +111,38 @@ entry )) -;(write (map car interface-description-alist) (current-error-port)) -;(display (lookup-interface 'accidental-placement-interface)) -;(display (document-all-grobs "OO" )) - -(define (document-all-interfaces name) - (string-append - (texi-node-menu name (map (lambda (x) - (cons (interface-name (symbol->string x)) "")) - (map cadr interface-description-alist))) - (apply string-append - (map document-separate-interface - (map cdr interface-description-alist))))) +(define (all-interfaces-doc) + (make + #:name "Graphical Object Interfaces" + #:desc "Building blocks of graphical objects" + #:children + (map interface-doc interface-description-alist) + )) -(define (document-all-backend-properties name) +(define (all-backend-properties-doc) (let* ( (ps (sort (map symbol->string all-backend-properties) stringtexi (string->symbol prop))) + (document-property (string->symbol prop) 'backend #f)) ps)) (texi (description-list->texi descs)) ) - - texi - ) - ) - -;;;;;;;;;;;;;;;; - + (make + #: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 + #:name "Backend" + #:desc "Reference for the layout engine" + #:children + (list + (all-grobs-doc) + (all-interfaces-doc) + (all-backend-properties-doc) + ) + )) diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index 626f2fc250..af8a0fbe82 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -6,6 +6,44 @@ ;;; (c) 2000--2001 Han-Wen Nienhuys ;;; Jan Nieuwenhuizen +(use-modules (oop goops)) + +(define-class () + (children #:init-value '() #:accessor node-children #:init-keyword #:children) + (text #:init-value "" #:accessor node-text #:init-keyword #:text) + (name #:init-value "" #:accessor node-name #:init-keyword #:name) + (description #:init-value "" #:accessor node-desc #:init-keyword #:desc) + ) + +(define (menu-entry x) + (cons + (node-name x) + (node-desc x)) + ) + +(define (dump-node node port level) + (display + (string-append + "\n@html" + "\n
" + "\n@end html\n@node " + (node-name node) + "\n\n" + (texi-section-command level) " " + (node-name node) + "\n\n" + (node-text node) + "\n\n" + (if (pair? (node-children node)) + (texi-menu + (map (lambda (x) (menu-entry x) ) + (node-children node))) + "")) + port) + (map (lambda (x) (dump-node x port (+ 1 level))) + (node-children node)) + ) + (define (processing name) (display (string-append "\nProcessing " name " ... ") (current-error-port))) @@ -14,14 +52,6 @@ (define (texify x) x) -;; (let* -;; ((x1 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post)) -;; ((x2 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post)) -;; ((x3 (regexp-substitute/global #f "\([^@]\)@" x 'pre "\1@@" 'post)) -;; ) -;; x2)) - - (define (scm->texi x) (string-append "@code{" (texify (scm->string x)) "}") @@ -39,15 +69,9 @@ (call-with-output-string (lambda (port) (display val port))) ))) -(define (node name) - (string-append - "\n@html" - "\n
" - "\n@end html" - "\n@node " name)) -(define texi-section-alist - '( +(define (texi-section-command level) + (cdr (assoc level '( ;; Hmm, texinfo doesn't have ``part'' (0 . "@top") (1 . "@unnumbered") @@ -55,20 +79,7 @@ (3 . "@unnumberedsubsec") (4 . "@unnumberedsubsubsec") (5 . "@unnumberedsubsubsec") - )) - -(define (texi-section level name ref) - "texi sectioning command (lower LEVEL means more significant). -Add a ref if REF is set -" - - (string-append - "\n" (cdr (assoc level texi-section-alist)) " " - (if ref - (ref-ify name) - name) - "\n")) - + )))) (define (one-item->texi label-desc-pair) "Document one (LABEL . DESC); return empty string if LABEL is empty string. @@ -80,7 +91,8 @@ Add a ref if REF is set (define (description-list->texi items-alist) - "Document ITEMS-ALIST in a table. entries contain (item-label . string-to-use) + "Document ITEMS-ALIST in a table. entries contain (item-label +. string-to-use) " (string-append "\n@table @samp\n" @@ -88,6 +100,7 @@ Add a ref if REF is set "\n@end table\n")) (define (texi-menu items-alist) + "Generate what is between @menu and @end menu." (let ( (maxwid (apply max (map (lambda (x) (string-length (car x))) @@ -118,17 +131,9 @@ Add a ref if REF is set "\n@end ignore\n"))) -(define (texi-node-menu name items-alist) - (string-append - (node name) - (texi-section 1 name #f) - (texi-menu items-alist))) - -(define (texi-file-head name file-name top items-alist) - - +(define (texi-file-head name file-name top) (string-append "\\input texinfo @c -*-texinfo-*-" "\n@setfilename " file-name ".info" @@ -138,21 +143,6 @@ Add a ref if REF is set ;; prepend GNU for dir, must be unique "\n* GNU " name ": (" file-name "). " name "." "\n@end direntry" - ;; ugh, prev and next should be settable, of course - (node "Top") ",(lilypond)Index,(lilypond)Full Grob interface list," top - "\n@top" - (texi-section 1 name #f) - (texi-menu items-alist) - "\n@contents" - )) - -(define (itexi-file-head name file-name top items-alist) - (string-append - "@c -*-texinfo-*-" - (node name) ",,," top - (texi-section 1 name #f) - (texi-menu items-alist) - "\n@contents" )) @@ -171,6 +161,7 @@ Add a ref if REF is set name) (define (ref-ify x) + "Add ref to X" (string-append "@ref{" x "}")) (define (human-listify l) @@ -185,3 +176,60 @@ Add a ref if REF is set (define (writing-wip x) (display (string-append "\nWriting " x " ... ") (current-error-port))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; property stuff. + +(define (property->texi where sym) + "Document SYM for WHERE (which can be translation, backend, music)" + (let* ( + (name (symbol->string sym)) + (type?-name (string->symbol + (string-append (symbol->string where) "-type?"))) + (doc-name (string->symbol + (string-append (symbol->string where) "-doc"))) + (type (object-property sym type?-name)) + (typename (type-name type)) + (desc (object-property sym doc-name))) + + (if (eq? desc #f) + (error "No description for property ~S" sym) + ) + (cons + (string-append "@code{" name "} " + "(" typename ")") + desc) + + )) + +(define (document-property-value sym alist) + "Extract value for SYM from ALIST, return as texi string" + (let* ((handle (assoc sym alist))) + (if (eq? handle #f) + "(unset)" + (scm->texi (cdr handle))))) + + +(define (backend-property->texi sym) + (property->texi 'backend sym)) + +(define (document-property sym where alist) + "Document SYM. If GROB-DESCRIPTION is not #f, it's an alist +containing default values." + (let* + ((without (property->texi where sym)) + (rv + + (cons (car without) + (if (eq? alist #f) + (cdr without) + (string-append + (cdr without) + "\nDefault value: " + (document-property-value sym alist))))) + + ) +; (display rv) + rv )) diff --git a/scm/engraver-documentation-lib.scm b/scm/engraver-documentation-lib.scm index 9484bf11d7..b793ae133b 100644 --- a/scm/engraver-documentation-lib.scm +++ b/scm/engraver-documentation-lib.scm @@ -8,22 +8,14 @@ -;; alist of translater descriptions -(define (document-translator-property sym) - (cons - (string-append - "@code{" (symbol->string sym) "} " - "(" (type-name (object-property sym 'translation-type?)) "):") - (object-property sym 'translation-doc))) ;; First level Engraver description and ;; second level Context description -(define (document-engraver where engraver) - +(define (engraver-doc-string engraver) (let* ( - (level (if (eq? where 'context) 3 2)) (propsr (cdr (assoc 'properties-read (ly-translator-description engraver)))) - (propsw (cdr (assoc 'properties-written (ly-translator-description engraver)))) + (propsw (cdr (assoc 'properties-written (ly-translator-description engraver)))) + (accepted (cdr (assoc 'events-accepted (ly-translator-description engraver)))) (name (ly-translator-name engraver)) (name-sym (string->symbol name)) (desc (cdr (assoc 'description (ly-translator-description engraver)))) @@ -31,21 +23,33 @@ ) (string-append - (texi-section level (engraver-name name) (eq? where 'context)) desc "\n\n" - (if (null? propsr) - "" + (if (pair? accepted) (string-append - (texi-section (+ level 1) "Properties (read)" #f) + "Music types accepted:\n\n" + (human-listify + (map (lambda (x) + (string-append + "@ref{" + (symbol->string x) + "}")) accepted) + )) + "") + "\n\n" + (if (pair? propsr) + (string-append + "Properties (read)" (description-list->texi - (map (lambda (x) (document-translator-property x)) propsr)))) + (map (lambda (x) (document-property x 'translation #f)) propsr))) + "") + (if (null? propsw) "" (string-append - (texi-section (+ level 1) "Properties (write)" #f) + "Properties (write)" (description-list->texi - (map (lambda (x) (document-translator-property x)) propsw)))) + (map (lambda (x) (document-property x 'translation #f)) propsw)))) (if (null? grobs) "" (string-append @@ -76,31 +80,35 @@ (human-listify (map ref-ify (map context-name contexts)))))))) + + ;; First level Engraver description -(define (document-separate-engraver top grav) - (let ((name (ly-translator-name grav))) - (processing name) - (string-append - (node (engraver-name name)) - (document-engraver 'self grav)))) +(define (engraver-doc grav) + (make + #:name (ly-translator-name grav) + #:text (engraver-doc-string grav) + )) ;; Second level, part of Context description -(define (find-engraver-by-name name list) - (if (null? list) - #f - (if (equal? name (ly-translator-name (car list))) - (car list) - (find-engraver-by-name name (cdr list))))) + +(define name->engraver-table (make-vector 61 '())) +(map + (lambda (x) + (hash-set! name->engraver-table (ly-translator-name x) x)) + (ly-get-all-translators)) + +(define (find-engraver-by-name name) + (hash-ref name->engraver-table name #f)) (define (document-engraver-by-name name) (let* ( - (eg (find-engraver-by-name name all-engravers-list)) + (eg (find-engraver-by-name name )) ) (if (eq? eg #f) (string-append "Engraver " name ", not documented.\n") - (document-engraver 'context eg) + (engraver-doc-string eg) ) )) @@ -143,8 +151,7 @@ )) - -(define (context-doc-string context-desc) +(define (context-doc context-desc) (let* ( (name (cdr (assoc 'type-name context-desc))) @@ -161,39 +168,40 @@ (grobs (context-grobs context-desc)) (grob-refs (map (lambda (x) (ref-ify x)) grobs)) ) - - (string-append - desc - "\n\nThis context creates the following grobs: \n\n" - (human-listify (uniq-list (sort grob-refs string + #:name name + #:text + (string-append + desc + "\n\nThis context creates the following grobs: \n\n" + (human-listify (uniq-list (sort grob-refs stringstring l) (symbol->string r))) -(define (document-paper name) - (let* ((paper-alist +(define (all-contexts-doc) + (let* ( + (paper-alist (sort (My_lily_parser::paper_description) (lambda (x y) (symbolstring (map car paper-alist)) string + #:name "Contexts" + #:desc "Complete descriptions of all contexts" + #:children + (map context-doc contexts) + ) + )) + +(define (all-engravers-doc) + (make + #:name "Engravers" + #:desc "All separate engravers" + #:children + (map engraver-doc (ly-get-all-translators)))) (define all-engravers-list (ly-get-all-translators)) -(define (document-all-engravers name) - (let* ((gravs all-engravers-list) - (names (map ly-translator-name gravs)) - (doc (apply string-append - (map (lambda (x) (document-separate-engraver name x)) - gravs)))) - (string-append - (texi-node-menu name (map (lambda (x) (cons (engraver-name x) "")) - names)) - doc))) - -(define (document-all-engraver-properties name) - (let* ((ps (sort (map symbol->string all-translation-properties) stringsymbol ps)) - (propdescs (map document-translator-property sortedsyms)) - (texi (description-list->texi propdescs))) - - (string-append - (node name) - (texi-section 1 name #f) - texi))) +(define (all-translation-properties-doc) + + (let* + ( + (ps (sort (map symbol->string all-translation-properties) stringsymbol ps)) + (propdescs + (map + (lambda (x) (document-property x 'translation #f)) + sortedsyms)) + (texi (description-list->texi propdescs)) + ) + + (make + #:name "Translation properties" + #:desc "All translation properties" + #:text texi) + )) + + +;(dump-node (all-contexts-doc) (current-output-port) 0 ) + +(define (translation-doc-node) + (make + #:name "Translation" + #:desc "From music to layout" + #:children + (list + (all-contexts-doc) + (all-engravers-doc) + (all-translation-properties-doc) + ) + )) diff --git a/scm/function-documentation.scm b/scm/function-documentation.scm index e2d8c9df9e..6a1e7b6f40 100644 --- a/scm/function-documentation.scm +++ b/scm/function-documentation.scm @@ -23,7 +23,7 @@ '() (ly-get-all-function-documentation)) ) -(define (document-all-scheme-functions) +(define (all-scheme-functions-doc) (let* ( @@ -35,8 +35,14 @@ (sfdocs (sort fdocs string + #:name "Scheme functions" + #:desc "Primitive functions exported by LilyPond" + #:text + (apply string-append sfdocs) + ) )) +; (dump-node (all-scheme-functions-doc) (current-output-port) 0 ) diff --git a/scm/generate-documentation.scm b/scm/generate-documentation.scm index 860301dd68..6cc1cd99a5 100644 --- a/scm/generate-documentation.scm +++ b/scm/generate-documentation.scm @@ -23,7 +23,7 @@ "music-documentation-lib.scm" "backend-documentation-lib.scm" )) -(map load-from-path load-files) +(map ly-load load-files) ;;(define no-copies #t) ; from 490 to 410K, but doesn't look nice yet @@ -33,54 +33,29 @@ ;; are described... (define no-copies #f) -(let* ((doc (string-append - (document-music "Music properties") - (document-paper "Contexts") - (document-all-engravers "Engravers") - (document-all-engraver-properties "Context properties") - (document-all-grobs "Grob overview") - (document-all-interfaces "Interfaces") - - (node "Backend properties") - (texi-section 1 "Backend properties" #f) - - (document-all-backend-properties "Backend properties") - - (node "Function documentation") - (texi-section 1 "Function documentation" #f) - - (document-all-scheme-functions) - - ) - ) - (name "lilypond-internals") - (outname (string-append name ".texi")) - (out (open-output-file outname))) - - (writing-wip outname) - (display - (string-append - (texi-file-head - - ;; we can't use (dir) and top if we're included by lilypond.tely - "LilyPond internals" name "(lilypond.info)" - '( - ("Music properties" . "properties for Music representation") - ("Contexts" . "Hierarchy and grouping of Engravers") - ("Engravers" . "Engravers create Grobs") - ("Context properties" . "context properties") - ("Grob overview" . "Detailed description of all Grobs") - ("Interfaces" . "Grob Interfaces") - ("Backend properties" . "Grob properties") - ("Function documentation" . "All embedded functions") - ("Index" . "index") - )) - - - - doc - - "@node Index +(define file-name "lilypond-internals") +(define outname (string-append file-name ".texi")) +(define out-port (open-output-file outname)) + +(writing-wip outname) + +(display + (string-append + "@c -*-texinfo-*-" + (texi-file-head "LilyPond internals" outname "(lilypond.info)")) out-port) + +(define top-node + (make + #:name "Top" + #:children + (list + (music-doc-node) + (translation-doc-node) + (backend-doc-node) + (all-scheme-functions-doc) + (make + #:name "Index" + #:text " @unnumbered Concept index @printindex cp @@ -93,10 +68,12 @@ @printindex fn -" +\n@bye" - - "\n@bye") - out)) + + ) + ))) + +(dump-node top-node out-port 0) (newline (current-error-port)) diff --git a/scm/lily.scm b/scm/lily.scm index 4bc71012e9..b4554475ac 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -12,9 +12,9 @@ ;;; General settings ;; debugging evaluator is slower. -;(debug-enable 'debug) +(debug-enable 'debug) ;(debug-enable 'backtrace) -;(read-enable 'positions) +(read-enable 'positions) (define-public (line-column-location line col file) @@ -158,7 +158,7 @@ is the first to satisfy CRIT (string-append str (make-string (max (- wid (string-length str)) 0) #\ )) ) -(define (ly-load x) +(define-public (ly-load x) (let* ((fn (%search-load-path x))) (if (ly-verbose) (format (current-error-port) "[~A]" fn)) diff --git a/scm/music-documentation-lib.scm b/scm/music-documentation-lib.scm index f4dc0ccfe5..5be708e768 100644 --- a/scm/music-documentation-lib.scm +++ b/scm/music-documentation-lib.scm @@ -1,30 +1,106 @@ -(define (music-property->texi sym) - (let* ((name (symbol->string sym)) - (type (object-property sym 'music-type?)) - (typename (type-name type)) - (desc (object-property sym 'music-doc))) - - (cons (string-append "@code{" name "} " - "(" typename ")" - ": " - ) - desc))) - -(define (document-music name) + +(define (music-props-doc) + (make + #:name "Music properties" + #:desc "All music properties, including descriptions" + #:text (let* ( - (ps (sort (map symbol->string all-music-properties) stringtexi (string->symbol prop))) - ps)) - (texi (description-list->texi descs)) - ) - + (ps (sort (map symbol->string all-music-properties) stringtexi 'music (string->symbol prop))) + ps)) + (texi (description-list->texi descs)) + ) + texi) + )) + +(define music-types->names (make-vector 61 '())) +(map (lambda (entry) + (let* + ( + (types (assoc 'types (cdr entry) )) + ) + (map (lambda (type) + (hashq-set! music-types->names type + (cons (car entry) + (hashq-ref music-types->names type '()))) + + ) types) + + )) + music-descriptions) + + +(define (hash-table->alist t) + "Convert table t to list" + (apply append + (vector->list t) + + )) + +(define (strip-description x) + (cons (symbol->string (car x)) + "")) + +(define (music-type-doc entry) + (make + #:name (symbol->string (car entry)) + #:text (string-append - (node name) - (texi-section 1 name #f) - texi) + "\nMusic event type @code{" + (symbol->string (car entry)) + "} is in Music objects of type " + (human-listify + (sort + (map (lambda (x) (ref-ify (symbol->string x))) + (cdr entry)) string + #:name "Music classes" + #:children + (map music-type-doc + (sort + (hash-table->alist music-types->names) alist + #:name (symbol->string (car obj)) + #:text (string-append + (object-property (car obj) 'music-description) + "\n\nProperties: \n" + (description-list->texi + (map + (lambda (x) (document-property x 'music (cdr obj))) + (map car (cdr obj)))) + )) +) + +(define (music-expressions-doc) + (make + #:name "Music expressions" + #:desc "Objects that represent music." + #:children + (map music-object-doc music-descriptions) )) + +(define (music-doc-node) + (make + #:name "Music definitions" + #:desc "Definition of the Input data structures" + #:children + (list + (music-expressions-doc) + (music-types-doc) + (music-props-doc)) + )) + + + diff --git a/scm/music-types.scm b/scm/music-types.scm index 4fde12c372..b2392bd2c2 100644 --- a/scm/music-types.scm +++ b/scm/music-types.scm @@ -3,22 +3,28 @@ `( (AbortEvent . ( + (description . "Abort currently running spanners.") (internal-class-name . "Span_req") (span-type . "abort") (types . (general-music event abort-event)) )) (ArpeggioEvent . ( + (description . "Make an arpeggio on this note.") (internal-class-name . "Request") (types . (general-music arpeggio-event event)) )) (ArticulationEvent . ( + (description . "") + (internal-class-name . "Articulation_req") (types . (general-music event articulation-event script-event)) )) (BassFigureEvent . ( + (description . "") + (internal-class-name . "Request") (compress-procedure . ,music-duration-compress) (length . ,music-duration-length) @@ -26,83 +32,115 @@ )) (BeamEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music event beam-event span-event)) )) (BreakEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music break-event event)) )) (BreathingSignEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music event breathing-event)) )) (BusyPlayingEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music event busy-playing-event)) )) (ExtenderEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music extender-event event)) )) (GlissandoEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music glissando-event event)) )) (GraceMusic . ( + (description . "") + (internal-class-name . "Grace_music") (iterator-ctor . ,Grace_iterator::constructor) (types . (grace-music music-wrapper-music general-music)) )) (HyphenEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music hyphen-event event)) )) (KeyChangeEvent . ( + (description . "") + (internal-class-name . "Key_change_req") (types . (general-music key-change-event event)) )) (LyricEvent . ( + (description . "") + (internal-class-name . "Lyric_req") (types . (general-music rhythmic-event event)) )) (LigatureEvent . ( + (description . "") + (internal-class-name . "Request") (span-type . ligature) (types . (general-music event span-event ligature-event)) )) (MarkEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music mark-event event)) )) (MelismaEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music span-event melisma-playing-event event)) )) (MelismaPlayingEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music event)) )) (Music . ( + (description . "") + (internal-class-name . "Music") (types . (general-music)) )) (NoteEvent . ( + (description . "") + (internal-class-name . "Request") (length . ,music-duration-length) (compress-procedure . ,music-duration-compress) @@ -110,22 +148,30 @@ )) (PorrectusEvent . ( + (description . "") + (internal-class-name . "Porrectus_req") (types . (general-music event)) )) (RepeatedMusic . ( + (description . "") + (internal-class-name . "Repeated_music") (type . repeated-music) (types . (general-music repeat-music)) )) (Request . ( + (description . "") + (internal-class-name . "Request") (types . (general-music event)) )) (RestEvent . ( + (description . "") + (internal-class-name . "Request") (length . ,music-duration-length) (compress-procedure . ,music-duration-compress) @@ -133,6 +179,8 @@ )) (RhythmicEvent . ( + (description . "") + (internal-class-name . "Rhythmic_req") (length . ,music-duration-length) (compress-procedure . ,music-duration-compress) @@ -140,12 +188,16 @@ )) (SequentialMusic . ( + (description . "") + (internal-class-name . "Sequential_music") (iterator-ctor . ,Sequential_music_iterator::constructor) (types . (general-music sequential-music)) )) (SimultaneousMusic . ( + (description . "") + (internal-class-name . "Simultaneous_music") (iterator-ctor . ,Simultaneous_music_iterator::constructor) @@ -153,6 +205,8 @@ )) (PropertySet . ( + (description . "") + (internal-class-name . "Music") (types . (layout-instruction general-music)) (iterator-ctor . ,Property_iterator::constructor) @@ -160,6 +214,8 @@ ) (PropertyUnset . ( + (description . "") + (internal-class-name . "Music") (types . (layout-instruction general-music)) (iterator-ctor . ,Property_unset_iterator::constructor) @@ -167,23 +223,31 @@ ) (VoiceSeparator . ( + (description . "") + (internal-class-name . "Music") (types . (separator general-music)) )) (BarCheck . ( + (description . "") + (internal-class-name . "Music") (types . (general-music bar-check)) (iterator-ctor . ,Bar_check_iterator::constructor) )) (OverrideProperty . ( + (description . "") + (internal-class-name . "Music") (types . (general-music layout-instruction)) (iterator-ctor . , Push_property_iterator::constructor) )) (RevertProperty . ( + (description . "") + (internal-class-name . "Music") (types . (general-music layout-instruction)) (iterator-ctor . , Pop_property_iterator::constructor) @@ -191,59 +255,79 @@ (OutputPropertySetMusic . ( + (description . "") + (internal-class-name . "Music") (iterator-ctor . ,Output_property_music_iterator::constructor) (types . (general-music layout-instruction)) )) (ContextSpeccedMusic . ( + (description . "") + (internal-class-name . "Context_specced_music") (types . (context-specification general-music music-wrapper-music)) )) (AutoChangeMusic . ( + (description . "") + (internal-class-name . "Music_wrapper") (iterator-ctor . ,Auto_change_iterator::constructor) (types . (general-music music-wrapper-music auto-change-instruction)) )) (TranslatorChange . ( + (description . "") + (internal-class-name . "Music") (iterator-ctor . , Change_iterator::constructor) (types . (general-music translator-change-instruction)) )) (TimeScaledMusic . ( + (description . "") + (internal-class-name . "Time_scaled_music") (iterator-ctor . ,Time_scaled_music_iterator::constructor) (types . (time-scaled-music music-wrapper-music general-music)) )) (TransposedMusic . ( + (description . "") + (internal-class-name . "Transposed_music") (types . (music-wrapper-music general-music transposed-music)) )) (UntransposableMusic . ( + (description . "") + (internal-class-name . "Untransposable_music") (types . (music-wrapper-music general-music untransposable-music)) )) (UnrelativableMusic . ( + (description . "") + (internal-class-name . "Un_relativable_music") (types . (music-wrapper-music general-music unrelativable-music)) )) (RelativeOctaveMusic . ( + (description . "") + (internal-class-name . "Relative_octave_music") (types . (music-wrapper-music general-music relative-octave-music)) )) (LyricCombineMusic . ( + (description . "") + (internal-class-name . "Lyric_combine_music") (types . (general-music lyric-combine-music)) (iterator-ctor . ,Lyric_combine_music_iterator::constructor) @@ -251,12 +335,16 @@ (PartCombineMusic . ( + (description . "") + (internal-class-name . "Part_combine_music") (types . (general-music part-combine-music)) (iterator-ctor . ,Part_combine_music_iterator::constructor) )) (RequestChord . ( + (description . "") + (internal-class-name . "Request_chord") (iterator-ctor . ,Request_chord_iterator::constructor) (types . (general-music simultaneous-music)) @@ -265,11 +353,15 @@ (ScriptEvent . ( + (description . "") + (internal-class-name . "Script_req") (types . (general-music event)) )) (SkipEvent . ( + (description . "") + (internal-class-name . "Request") (length . ,music-duration-length) (compress-procedure . ,music-duration-compress) @@ -277,50 +369,75 @@ )) (SpanEvent . ( + (description . "") + (internal-class-name . "Span_req") (types . (general-music event)) )) (DecrescendoEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music dynamic-event decrescendo-event event)) )) (CrescendoEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music dynamic-event crescendo-event event)) )) (StringNumberEvent . ( + (description . "") + (internal-class-name . "Request") - (types . (general-music event)) + (types . (general-music string-number-event event)) )) (TempoEvent . ( + (description . "") + (internal-class-name . "Request") (types . (general-music tempo-event event)) )) (TextScriptEvent . ( + (description . "") (internal-class-name . "Text_script_req") (types . (general-music script-event text-script-event event)) )) (TieEvent . ( + (description . "A tie. Entered as ~.") (internal-class-name . "Request") (types . (general-music tie-event event)) )) )) - +(set! music-descriptions + (sort music-descriptions alist