X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fly-syntax-constructors.scm;h=2d243ab8abf1ae3daf1f8419b8eb0b86704dd89a;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=5f1583589b849aee878a79a8d045b47614855cdd;hpb=bd751630011a6fbfcf069ec1fc41a8eaed8a6b87;p=lilypond.git

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 5f1583589b..2d243ab8ab 100644
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2006--2012 Erik Sandberg <mandolaerik@gmail.com>
+;;;; Copyright (C) 2006--2015 Erik Sandberg <mandolaerik@gmail.com>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -64,7 +64,8 @@
           (if good
               (ly:parser-error parser
                                (format #f (_ "~a function cannot return ~a")
-                                       (type-name pred) m)
+                                       (type-name pred)
+                                       (value->lily-string m parser))
                                loc))
           (and (pair? (car sig)) (cdar sig))))))
 
@@ -73,7 +74,7 @@
    parser
    (format #f
            (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
-           n (type-name pred) arg)
+           n (type-name pred) (music->make-music arg))
    location))
 
 (define-ly-syntax-simple (void-music)
@@ -98,12 +99,6 @@
               'change-to-type type
               'change-to-id id))
 
-(define-ly-syntax-simple (voice-separator)
-  (make-music 'VoiceSeparator))
-
-(define-ly-syntax-simple (bar-check)
-  (make-music 'BarCheck))
-
 (define-ly-syntax (tempo parser location text . rest)
   (let* ((unit (and (pair? rest)
                     (car rest)))
@@ -140,9 +135,8 @@
   "Extract @code{'direction} and @code{'text} from @var{music}, and transform
 into a @code{MultiMeasureTextEvent}."
 
-  (if (memq 'script-event (ly:music-property music 'types))
-      (apply make-music 'MultiMeasureTextEvent
-             (flatten-alist (ly:music-mutable-properties music)))
+  (if (music-is-of-type? music 'script-event)
+      (make-music 'MultiMeasureTextEvent music)
       music))
 
 (define-ly-syntax (multi-measure-rest parser location duration articulations)
@@ -158,8 +152,7 @@ into a @code{MultiMeasureTextEvent}."
               'origin location))
 
 (define-ly-syntax-simple (context-specification type id ops create-new mus)
-  (let* ((type-sym (if (symbol? type) type (string->symbol type)))
-         (csm (context-spec-music mus type-sym id)))
+  (let ((csm (context-spec-music mus type id)))
     (set! (ly:music-property csm 'property-operations) ops)
     (if create-new (set! (ly:music-property csm 'create-new) #t))
     csm))
@@ -214,15 +207,20 @@ into a @code{MultiMeasureTextEvent}."
                 'context-type ctx
                 'origin location)))
 
-;; TODO: It seems that this function rarely returns anything useful.
-(define (get-first-context-id type mus)
-  "Find the name of a ContextSpeccedMusic with given type"
+(define (get-first-context-id! mus)
+  "Find the name of a ContextSpeccedMusic, possibly naming it"
   (let ((id (ly:music-property mus 'context-id)))
-    (if (and (eq? (ly:music-property mus 'type) 'ContextSpeccedMusic)
-             (eq? (ly:music-property mus 'context-type) type)
-             (string? id)
-             (not (string-null? id)))
-        id
+    (if (eq? (ly:music-property mus 'name) 'ContextSpeccedMusic)
+        (if (and (string? id)
+                 (not (string-null? id)))
+            id
+            ;; We may reliably give a new context a unique name, but
+            ;; not an existing one
+            (if (ly:music-property mus 'create-new #f)
+                (let ((id (get-next-unique-voice-name)))
+                  (set! (ly:music-property mus 'context-id) id)
+                  id)
+                '()))
         '())))
 
 (define unique-counter -1)
@@ -233,7 +231,7 @@ into a @code{MultiMeasureTextEvent}."
 (define-ly-syntax-simple (lyric-event text duration)
   (make-lyric-event text duration))
 
-(define (lyric-combine-music sync music loc)
+(define (lyric-combine-music sync sync-type music loc)
   ;; CompletizeExtenderEvent is added following the last lyric in MUSIC
   ;; to signal to the Extender_engraver that any pending extender should
   ;; be completed if the lyrics end before the associated voice.
@@ -242,26 +240,29 @@ into a @code{MultiMeasureTextEvent}."
   (make-music 'LyricCombineMusic
               'element music
               'associated-context sync
+              'associated-context-type sync-type
               'origin loc))
 
-(define-ly-syntax (lyric-combine parser location voice music)
-  (lyric-combine-music voice music location))
+(define-ly-syntax (lyric-combine parser location voice typ music)
+  (lyric-combine-music voice typ music location))
 
 (define-ly-syntax (add-lyrics parser location music addlyrics-list)
-  (let* ((existing-voice-name (get-first-context-id 'Voice music))
+  (let* ((existing-voice-name (get-first-context-id! music))
          (voice-name (if (string? existing-voice-name)
                          existing-voice-name
                          (get-next-unique-voice-name)))
          (voice (if (string? existing-voice-name)
-                    (music)
+                    music
                     (make-music 'ContextSpeccedMusic
                                 'element music
                                 'context-type 'Voice
                                 'context-id voice-name
                                 'origin (ly:music-property music 'origin))))
+         (voice-type (ly:music-property voice 'context-type))
          (lyricstos (map (lambda (mus)
                            (let* ((loc (ly:music-property mus 'origin))
-                                  (lyr (lyric-combine-music voice-name mus loc)))
+                                  (lyr (lyric-combine-music
+                                        voice-name voice-type mus loc)))
                              (make-music 'ContextSpeccedMusic
                                          'create-new #t
                                          'context-type 'Lyrics