]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/part-combiner.scm
Issue 4483: parser.yy: reimplement MAKE_SYNTAX using with_location
[lilypond.git] / scm / part-combiner.scm
index a2ebda492cff8c30ce8e6360f1df56d16020e84d..b8661afe2bf9fbfb3207921d6e2ac11e502e7ac9 100644 (file)
              (note-events vs))
         note<?))
 
-(define-method (rest-and-skip-events (vs <Voice-state>))
-  (define (f? x)
-    (or (ly:in-event-class? x 'rest-event)
-        (ly:in-event-class? x 'skip-event)))
-  (filter f? (events vs)))
+(define-method (rest-or-skip-events (vs <Voice-state>))
+  (define (filtered-events event-class)
+    (filter (lambda(x) (ly:in-event-class? x event-class))
+            (events vs)))
+  (let ((result (filtered-events 'rest-event)))
+    ;; There may be skips in the same part with rests for various
+    ;; reasons.  Regard the skips only if there are no rests.
+    (if (and (not (pair? result)) (not (any-mmrest-events vs)))
+        (set! result (filtered-events 'skip-event)))
+  result))
 
 (define-method (any-mmrest-events (vs <Voice-state>))
   (define (f? x)
@@ -294,11 +299,11 @@ LilyPond version 2.8 and earlier."
      global)
     context-list))
 
-(define-public (make-part-combine-music parser music-list direction chord-range)
+(define-public (make-part-combine-music music-list direction chord-range)
   (let* ((m (make-music 'PartCombineMusic))
          (m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
          (m2  (make-non-relative-music  (context-spec-music (second music-list) 'Voice "two")))
-         (listener (ly:parser-lookup parser 'partCombineListener))
+         (listener (ly:parser-lookup 'partCombineListener))
          (evs2 (recording-group-emulate m2 listener))
          (evs1 (recording-group-emulate m1 listener)))
 
@@ -477,8 +482,8 @@ Only set if not set previously.
                  (vs2 (cdr (voice-states now-state))))
 
             (define (analyse-synced-silence)
-              (let ((rests1 (if vs1 (rest-and-skip-events vs1) '()))
-                    (rests2 (if vs2 (rest-and-skip-events vs2) '())))
+              (let ((rests1 (if vs1 (rest-or-skip-events vs1) '()))
+                    (rests2 (if vs2 (rest-or-skip-events vs2) '())))
                 (cond
 
                  ;; multi-measure rests (probably), which the
@@ -616,8 +621,8 @@ the mark when there are no spanners active.
         (let* ((now-state (vector-ref result result-idx))
                (vs1 (current-voice-state now-state 1))
                (vs2 (current-voice-state now-state 2))
-               (rests1 (if vs1 (rest-and-skip-events vs1) '()))
-               (rests2 (if vs2 (rest-and-skip-events vs2) '()))
+               (rests1 (if vs1 (rest-or-skip-events vs1) '()))
+               (rests2 (if vs2 (rest-or-skip-events vs2) '()))
                (prev-state (if (> result-idx 0)
                                (vector-ref result (- result-idx 1))
                                #f))
@@ -800,13 +805,13 @@ the mark when there are no spanners active.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-public (add-quotable parser name mus)
+(define-public (add-quotable name mus)
   (let* ((tab (eval 'musicQuotes (current-module)))
          (voicename (get-next-unique-voice-name))
          ;; recording-group-emulate returns an assoc list (reversed!), so
          ;; hand it a proper unique context name and extract that key:
          (ctx-spec (context-spec-music mus 'Voice voicename))
-         (listener (ly:parser-lookup parser 'partCombineListener))
+         (listener (ly:parser-lookup 'partCombineListener))
          (context-list (reverse (recording-group-emulate ctx-spec listener)))
          (raw-voice (assoc voicename context-list))
          (quote-contents (if (pair? raw-voice) (cdr raw-voice) '())))