X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fto-xml.scm;h=ea7ce7a0fcc33763c927980234ae9afdcf0c2ca0;hb=2f84bbe9a6dc6ca2d9a49eae0bf094744e47f11d;hp=b53b2f5e5fc1dfdc48b307452e14e45cfb7cac96;hpb=fd58a98a46a3def26b80a895f1f7b81c92590fc3;p=lilypond.git diff --git a/scm/to-xml.scm b/scm/to-xml.scm index b53b2f5e5f..ea7ce7a0fc 100644 --- a/scm/to-xml.scm +++ b/scm/to-xml.scm @@ -1,6 +1,26 @@ +;;;; This file is part of LilyPond, the GNU music typesetter. +;;;; +;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . + +(define-module (scm to-xml)) (use-modules (ice-9 regex) (srfi srfi-1) + (lily) (oop goops)) " @@ -12,14 +32,14 @@ That is much cleaner: building the document, and dumping it to output is then separated. - foo = \score { ... } + foo = \\score { ... } #(as-xml foo) - - + + " @@ -41,25 +61,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 @@ -86,33 +100,20 @@ is then separated. (numer . ,(car (ly:duration-factor d))) (denom . ,(cdr (ly:duration-factor d)))))) -(define (musicxml-pitch->xml-node p) - (make - #:name 'pitch - #:children - (list - (make - #:name 'step - #:value (list-ref '("C" "D" "E" "F" "G" "A" "B") - (ly:pitch-notename p))) - (make - #:name 'octave - #:value (number->string (ly:pitch-octave p)))))) - (define (pitch->xml-node p) (make #:name 'pitch #:attributes `((octave . ,(ly:pitch-octave p)) (notename . ,(ly:pitch-notename p)) (alteration . ,(ly:pitch-alteration p))))) - + (define (music->xml-node music) - (let* ((name (ly:get-mus-property music 'name)) - (e (ly:get-mus-property music 'element)) - (es (ly:get-mus-property music 'elements)) - (mprops (ly:get-mutable-properties music)) - (d (ly:get-mus-property music 'duration)) - (p (ly:get-mus-property music 'pitch)) + (let* ((name (ly:music-property music 'name)) + (e (ly:music-property music 'element)) + (es (ly:music-property music 'elements)) + (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))) (make @@ -135,8 +136,8 @@ is then separated. ]> ")) - - + + ;; as computed from input/trip.ly, by ;; http://www.pault.com/pault/dtdgenerator/ @@ -187,7 +188,7 @@ is then separated. (define (assert x) (if x #t - (error "assertion failed"))) + (ly:error (_ "assertion failed: ~S") x))) (define (re-sub re to string) (regexp-substitute/global #f re string 'pre to 'post)) @@ -210,20 +211,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) @@ -234,9 +231,9 @@ is then separated. (string-append "string name) ">")) (define-public (music-to-xml music port) - "Dump XML-ish stuff to PORT." + "Dump XML-ish stuff to @var{port}." - ;; dtd contains # -- This confuses tex during make web. + ;; dtd contains # -- This confuses tex during make doc. ;; ;; (display (dtd-header) port) @@ -245,13 +242,12 @@ is then separated. (display (close-tag 'music) port)) (define-public (music-to-musicxml music port) - "Dump MusicXML-ish stuff to PORT." + "Dump MusicXML-ish stuff to @var{port}." - ;; dtd contains # -- This confuses tex during make web. + ;; dtd contains # -- This confuses tex during make doc. ;; ;; (display (dtd-header) port) - (define pitch->xml-node musicxml-pitch->xml-node) (define duration->xml-node musicxml-duration->xml-node) (display (open-tag 'music '((type . score)) '()) port)