X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fto-xml.scm;h=5f2828a3704089de71308354bbc80c975d98d4a6;hb=63d0ac052683737e60b2268c98d480ad5ab1227c;hp=d88649315a50786d31656d9fe11c449501b63e9b;hpb=12186b6828aee7aa298076d684835d629b757f2a;p=lilypond.git diff --git a/scm/to-xml.scm b/scm/to-xml.scm index d88649315a..5f2828a370 100644 --- a/scm/to-xml.scm +++ b/scm/to-xml.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2003--2004 Han-Wen Nienhuys +;;;; (c) 2003--2006 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen (use-modules (ice-9 regex) @@ -24,8 +24,8 @@ is then separated. - - + + " @@ -47,25 +47,19 @@ is then separated. (pitch . pitch) (duration . duration) (octave . octave) - (step . step) - )) - -(define (assoc-get-default key alist default) - "Return value if KEY in ALIST, else DEFAULT." - (let ((entry (assoc key alist))) - (if entry (cdr entry) default))) + (step . step))) (define (musicxml-node->string node) - (let ((xml-name (assoc-get-default (node-name node) node-names #f))) - (string-append - (if xml-name (open-tag xml-name '() '()) "") - (if (equal? (node-value node) "") - (string-append - (if xml-name "\n" "") - (apply string-append (map musicxml-node->string (node-children node)))) - (node-value node)) - (if xml-name (close-tag xml-name) "") - (if xml-name "\n" "")))) + (let ((xml-name (assoc-get (node-name node) node-names #f))) + (string-append + (if xml-name (open-tag xml-name '() '()) "") + (if (equal? (node-value node) "") + (string-append + (if xml-name "\n" "") + (apply string-append (map musicxml-node->string (node-children node)))) + (node-value node)) + (if xml-name (close-tag xml-name) "") + (if xml-name "\n" "")))) (define (xml-node->string node) (string-append @@ -111,12 +105,12 @@ is then separated. #:attributes `((octave . ,(ly:pitch-octave p)) (notename . ,(ly:pitch-notename p)) (alteration . ,(ly:pitch-alteration p))))) - + (define (music->xml-node music) (let* ((name (ly:music-property music 'name)) (e (ly:music-property music 'element)) (es (ly:music-property music 'elements)) - (mprops (ly:get-mutable-properties music)) + (mprops (ly:music-mutable-properties music)) (d (ly:music-property music 'duration)) (p (ly:music-property music 'pitch)) (ignore-props '(origin elements duration pitch element))) @@ -141,8 +135,8 @@ is then separated. ]> ")) - - + + ;; as computed from input/trip.ly, by ;; http://www.pault.com/pault/dtdgenerator/ @@ -193,7 +187,7 @@ is then separated. (define (assert x) (if x #t - (error "assertion failed"))) + (ly:error (_ "assertion failed")))) (define (re-sub re to string) (regexp-substitute/global #f re string 'pre to 'post)) @@ -216,20 +210,16 @@ is then separated. (not (memq (car x) exceptions))) (define (dump-attr sym-val) - (let* - ( - (sym (car sym-val)) - (val (cdr sym-val)) - ) + (let* ((sym (car sym-val)) + (val (cdr sym-val))) - (string-append - "\n " - (symbol->string sym) - "=\"" - (let ((s (call-with-output-string (lambda (port) (display val port))))) - (re-sub-alist s xml-entities-alist)) - "\"" - ))) + (string-append + "\n " + (symbol->string sym) + "=\"" + (let ((s (call-with-output-string (lambda (port) (display val port))))) + (re-sub-alist s xml-entities-alist)) + "\""))) (string-append "<" (symbol->string tag)