+(define-class <xml-node> ()
+ (name #:init-value "" #:accessor node-name #:init-keyword #:name)
+ (value #:init-value "" #:accessor node-value #:init-keyword #:value)
+ (attributes #:init-value '()
+ #:accessor node-attributes
+ #:init-keyword #:attributes)
+ (children #:init-value '()
+ #:accessor node-children
+ #:init-keyword #:children))
+
+(define node-names
+ '((NoteEvent . note)
+ (SequentialMusic . measure)
+
+ ;;ugh
+ (pitch . pitch)
+ (duration . duration)
+ (octave . octave)
+ (step . step)))
+
+(define (musicxml-node->string node)
+ (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" "")
+ (string-concatenate (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
+ "\n"
+ (open-tag (node-name node) (node-attributes node) '())
+ (if (equal? (node-value node) "")
+ (string-concatenate (map xml-node->string (node-children node)))
+ (node-value node))
+ "\n"
+ (close-tag (node-name node))))
+
+(define (musicxml-duration->xml-node d)
+ (make <xml-node>
+ #:name 'duration
+ #:value (number->string (ash 1 (ly:duration-log d)))))
+
+(define (duration->xml-node d)
+ (make <xml-node>
+ #:name 'duration
+ ;; #:value (number->string (ash 1 (ly:duration-log d)))))
+ #:attributes `((log . ,(ly:duration-log d))
+ (dots . ,(ly:duration-dot-count d))
+ (numer . ,(car (ly:duration-factor d)))
+ (denom . ,(cdr (ly:duration-factor d))))))
+
+(define (pitch->xml-node p)
+ (make <xml-node>
+ #: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: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 <xml-node>
+ #:name name
+ #:children
+ (apply
+ append
+ (if (ly:pitch? p) (list (pitch->xml-node p)) '())
+ (if (ly:duration? d) (list (duration->xml-node d)) '())
+ (if (pair? es) (map music->xml-node es) '())
+ (if (ly:music? e) (list (music->xml-node e)) '())
+ '()))))