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

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 2712fc21f3..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--2014 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))))))
 
@@ -206,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)
@@ -225,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.
@@ -234,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