Fix the linking of files from lilypond by lilypond-book.

[lilypond.git] / scm / music-functions.scm

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 9ff13189d22b089586d192d86a33c701abae7577..559eae3c3ff300e04e2a0eed635ea678e32d37ff 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -424,6 +424,33 @@ in @var{grob}."
     TrillSpanner))
 
 (define-safe-public (make-voice-props-set n)
+  (make-sequential-music
+   (append
+    (map (lambda (x) (make-grob-property-set x 'direction
+                                                 (if (odd? n) -1 1)))
+        direction-polyphonic-grobs)
+    (list
+     (make-property-set 'graceSettings
+                       ;; TODO: take this from voicedGraceSettings or similar.
+                       '((Voice Stem font-size -3)
+                         (Voice Flag font-size -3)
+                         (Voice NoteHead font-size -3)
+                         (Voice TabNoteHead font-size -4)
+                         (Voice Dots font-size -3)
+                         (Voice Stem length-fraction 0.8)
+                         (Voice Stem no-stem-extend #t)
+                         (Voice Beam beam-thickness 0.384)
+                         (Voice Beam length-fraction 0.8)
+                         (Voice Accidental font-size -4)
+                         (Voice AccidentalCautionary font-size -4)
+                         (Voice Script font-size -3)
+                         (Voice Fingering font-size -8)
+                         (Voice StringNumber font-size -8)))
+
+     (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
+     (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+
+(define-safe-public (make-voice-props-override n)
   (make-sequential-music
    (append
     (map (lambda (x) (make-grob-property-override x 'direction
@@ -626,7 +653,11 @@ respective predecessor chord."
        (let ((chord-repeat (ly:music-property music 'duration)))
          (cond
           ((not (ly:duration? chord-repeat))
-           music)
+           (if (any (lambda (m) (ly:duration?
+                                 (ly:music-property m 'duration)))
+                    (ly:music-property music 'elements))
+               music
+               last-chord))
           (last-chord
            (set! (ly:music-property music 'duration) '())
            (copy-repeat-chord last-chord music chord-repeat event-types)
@@ -954,7 +985,7 @@ set to the @code{location} parameter."
                      (if (null? clef)
                          (make-music 'Music)
                          (make-cue-clef-set clef))
-                     (context-spec-music (make-voice-props-set cue-voice) 'CueVoice "cue")
+                     (context-spec-music (make-voice-props-override cue-voice) 'CueVoice "cue")
                      quote-music
                      (context-spec-music (make-voice-props-revert) 'CueVoice "cue")
                      (if (null? clef)
@@ -963,7 +994,7 @@ set to the @code{location} parameter."
              (set! main-music
                    (make-sequential-music
                     (list
-                     (make-voice-props-set main-voice)
+                     (make-voice-props-override main-voice)
                      main-music
                      (make-voice-props-revert))))
              (set! (ly:music-property quote-music 'element) main-music)))
@@ -1613,21 +1644,41 @@ and only recurse if this returns @code{#f}."
                    (map loop arts)))
          music))))
 
+(define-public (for-some-music stop? music)
+  "Walk through @var{music}, process all elements calling @var{stop?}
+and only recurse if this returns @code{#f}."
+  (let loop ((music music))
+    (if (not (stop? music))
+       (let ((elt (ly:music-property music 'element)))
+         (if (ly:music? elt)
+             (loop elt))
+         (for-each loop (ly:music-property music 'elements))
+         (for-each loop (ly:music-property music 'articulations))))))
+
+(define-public (fold-some-music pred? proc init music)
+  "This works recursively on music like @code{fold} does on a list,
+calling @samp{(@var{pred?} music)} on every music element.  If
+@code{#f} is returned for an element, it is processed recursively
+with the same initial value of @samp{previous}, otherwise
+@samp{(@var{proc} music previous)} replaces @samp{previous}
+and no recursion happens.
+The top @var{music} is processed using @var{init} for @samp{previous}."
+  (let loop ((music music) (previous init))
+    (if (pred? music)
+       (proc music previous)
+       (fold loop
+             (fold loop
+                   (let ((elt (ly:music-property music 'element)))
+                     (if (null? elt)
+                         previous
+                         (loop elt previous)))
+                   (ly:music-property music 'elements))
+             (ly:music-property music 'articulations)))))
+
 (define-public (extract-music music pred?)
   "Return a flat list of all music matching @var{pred?} inside of
 @var{music}, not recursing into matches themselves."
-  (reverse!
-   (let loop ((music music) (res '()))
-     (if (pred? music)
-        (cons music res)
-        (fold loop
-              (fold loop
-                    (let ((elt (ly:music-property music 'element)))
-                      (if (null? elt)
-                          res
-                          (loop elt res)))
-                    (ly:music-property music 'elements))
-              (ly:music-property music 'articulations))))))
+  (reverse! (fold-some-music pred? cons '() music)))
 
 (define-public (extract-named-music music music-name)
   "Return a flat list of all music named @var{music-name} (either a