lily in scm, using music variables

[Nicolas Sceaux]

Hello, 

A patch is attached that allows the use of various types of values inside
a #{ ... #} expression. Example:

  #(defmacro set-elements (music-symbol new-music)
     `(lambda (,music-symbol)
        (set! (ly:music-property ,music-symbol 'elements)
              (ly:music-property ,new-music 'elements))
        ,music-symbol))
  
  \score {
      \notes {
          \apply #(set-elements music #{ \notes { c'4^"hello" d' $music d'4 
c'2^\trill } #})
          { e'2^\prall \appoggiatura f'8 e'4^\markup \bold "world" }
      }
      \paper { raggedright = ##t }
  }

A function was introduced, that can be useful for debugging or
simply finding out how a music expression can be built

guile> (music->make-music #{ \notes c'^"hello" #})
(make-music 'SequentialMusic
  'elements (list (make-music 'EventChord 
                    'elements (list (make-music 'NoteEvent 
                                      'duration (ly:make-duration 2 0 1 1)
                                      'pitch (ly:make-pitch 0 0 0))
                                    (make-music 'TextScriptEvent
                                      'direction 1
                                      'text (markup #:simple "hello"))))))

(slightly re-worked output)


May I commit?

nicolas

Index: ChangeLog
===================================================================
RCS file: /cvsroot/lilypond/lilypond/ChangeLog,v
retrieving revision 1.2139
diff -u -r1.2139 ChangeLog
--- ChangeLog   3 May 2004 23:16:21 -0000       1.2139
+++ ChangeLog   4 May 2004 14:28:03 -0000
@@ -1,3 +1,12 @@
+2004-05-04  Nicolas Sceaux  <address@hidden>
+
+       * scm/new-markup.scm (compile-markup-expression): when an argument
+       is a string, use `make-simple-markup'.
+
+       * scm/ly-from-scheme.scm (read-lily-expression): A variable
+       refering to a music expression can be used in lily-inside-scheme:
+       #{ $music #}
+
 2004-05-04  Han-Wen Nienhuys   <address@hidden>
 
        * cygwin/lily-wins.py: update for the lily-wins.py script.
Index: scm/ly-from-scheme.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/ly-from-scheme.scm,v
retrieving revision 1.2
diff -u -r1.2 ly-from-scheme.scm
--- scm/ly-from-scheme.scm      29 Apr 2004 14:49:52 -0000      1.2
+++ scm/ly-from-scheme.scm      4 May 2004 14:29:27 -0000
@@ -29,6 +29,59 @@
              music-sym str music-sym (module-name module) music-sym music-sym))
   (eval `,music-sym module)))
 
+(define-public (music->make-music music)
+  "Generate a (make-music 'ThisKindOfMusic 'property1 value1 ...) expression
+that, if evaluated, would return an equivalent music expression."
+  `(make-music ',(ly:music-property music 'name)
+               ,@(apply append
+                        (map (lambda (prop)
+                               `(',(car prop) ,(make-readable-form (cdr 
prop))))
+                             (remove (lambda (prop)
+                                       (eqv? (car prop) 'origin))
+                                     (ly:music-mutable-properties music))))))
+
+(define*-public (markup->make-markup markup-expression)
+  "Generate a expression that, when evaluated, return an equivalent markup
+expression"
+  (define (inner-markup->make-markup mrkup)
+    (let ((cmd (car mrkup))
+          (args (cdr mrkup)))
+      `(,(proc->command cmd) ,@(map transform-arg args))))
+  (define (proc->command proc)
+    (let ((cmd-markup (symbol->string (procedure-name proc))))
+      (symbol->keyword (string->symbol (substring cmd-markup 0 (- 
(string-length cmd-markup)
+                                                                  
(string-length "-markup")))))))
+  (define (transform-arg arg)
+    (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
+           (apply append (map inner-markup->make-markup arg)))
+          ((pair? arg)                         ;; markup
+           (inner-markup->make-markup arg))
+          (else                                ;; scheme arg
+           arg)))
+  `(markup ,@(inner-markup->make-markup markup-expression)))
+
+;;; FIXME: can goops do this dispatch in a more eleguant fashion?
+(define-public (make-readable-form obj)
+  "Return a transformation of `obj' which printed representation can be read 
back."
+  (cond ((and (list? obj) (ly:music-list? obj))
+         (cons 'list (map music->make-music obj)))
+        ((ly:music? obj) (music->make-music obj))
+        ((symbol? obj) `(quote ,obj))
+        ((ly:duration? obj)
+         `(ly:make-duration ,(ly:duration-log obj)
+                            ,(ly:duration-dot-count obj)
+                            ,(car (ly:duration-factor obj))
+                            ,(cdr (ly:duration-factor obj))))
+        ((ly:pitch? obj)
+         `(ly:make-pitch ,(ly:pitch-octave obj)
+                         ,(ly:pitch-notename obj)
+                         ,(ly:pitch-alteration obj)))
+        ;;((ly:moment? obj) ...)
+        ((and (list? obj) (markup-function? (car obj))) ;; a markup expression
+         (markup->make-markup obj))
+        ((procedure? obj) (procedure-name obj))
+        (else obj)))
+
 (define-public (read-lily-expression chr port)
   "Read a #{ lily music expression #} from port and return
 the scheme music expression. The $ character may be used to introduce
@@ -45,8 +98,12 @@
                                         (not (char=? (peek-char port) #\$)))
                                    ;; a $variable
                                    (display "~a")
-                                   (set! format-args (cons (read port) 
-format-args)))
+                                   (set! format-args (cons `(let ((expr ,(read 
port)))
+                                                              (cond 
((ly:music? expr)
+                                                                     (format 
#f "#(ly:export ~a)" (make-readable-form expr)))
+                                                                    
((procedure? expr) (procedure-name obj))
+                                                                    (else 
expr)))
+                                                           format-args)))
                                   ((and (char=? c #\$)
                                         (char=? (peek-char port) #\$))
                                    ;; just a $ character
Index: scm/new-markup.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/new-markup.scm,v
retrieving revision 1.75
diff -u -r1.75 new-markup.scm
--- scm/new-markup.scm  22 Mar 2004 14:55:36 -0000      1.75
+++ scm/new-markup.scm  4 May 2004 14:29:27 -0000
@@ -175,8 +175,11 @@
          ;; expr === ((#:COMMAND arg1 ...) ...)
          (receive (m r) (compile-markup-expression (car expr))
                   (values m (cdr expr))))
+        ((and (pair? expr)
+              (string? (car expr))) ;; expr === ("string" ...)
+         (values `(make-simple-markup ,(car expr)) (cdr expr)))
         (else
-         ;; expr === (symbol ...) or ("string" ...) or ((funcall ...) ...)
+         ;; expr === (symbol ...) or ((funcall ...) ...)
          (values (car expr)
                  (cdr expr)))))