Imported Upstream version 2.18.2

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 4329e1c400fce5da4c4edf59be467f257b4f4056..e73ffe22011dfdffe2a27aec16527c402f40285a 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -20,6 +20,7 @@
 (use-modules (scm safe-utility-defs))
 
 (use-modules (ice-9 optargs))
+(use-modules (srfi srfi-11))
 
 ;;; ly:music-property with setter
 ;;; (ly:music-property my-music 'elements)
@@ -382,6 +383,26 @@ beats to be distinguished."
               (unfold-repeats e)))
     music))
 
+(define-public (unfold-repeats-fully music)
+  "Unfolds repeats and expands the resulting @code{unfolded-repeated-music}."
+  (map-some-music
+   (lambda (m)
+     (and (music-is-of-type? m 'unfolded-repeated-music)
+          (make-sequential-music
+           (ly:music-deep-copy
+            (let ((n (ly:music-property m 'repeat-count))
+                  (alts (ly:music-property m 'elements))
+                  (body (ly:music-property m 'element)))
+              (cond ((<= n 0) '())
+                    ((null? alts) (make-list n body))
+                    (else
+                     (concatenate
+                      (zip (make-list n body)
+                           (append! (make-list (max 0 (- n (length alts)))
+                                               (car alts))
+                                    alts))))))))))
+   (unfold-repeats music)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property setting music objs.
 
@@ -728,7 +749,8 @@ duration is replaced with the specified @var{duration}."
         (set! (ly:music-property repeat-chord 'articulations)
               (append!
                (set-origin! (ly:music-deep-copy arts))
-               (ly:music-property repeat-chord 'articulations))))))
+               (ly:music-property repeat-chord 'articulations)))))
+  repeat-chord)
 
 
 (define-public (expand-repeat-chords! event-types music)
@@ -747,8 +769,7 @@ respective predecessor chord."
                 last-chord))
            (last-chord
             (set! (ly:music-property music 'duration) '())
-            (copy-repeat-chord last-chord music chord-repeat event-types)
-            music)
+            (copy-repeat-chord last-chord music chord-repeat event-types))
            (else
             (ly:music-warning music (_ "Bad chord repetition"))
             #f)))
@@ -1879,6 +1900,37 @@ yourself."
   (map (lambda (x) (ly:music-property x 'pitch))
        (event-chord-notes event-chord)))
 
+(define-public (event-chord-reduce music)
+  "Reduces event chords in @var{music} to their first note event,
+retaining only the chord articulations.  Returns the modified music."
+  (map-some-music
+   (lambda (m)
+     (and (music-is-of-type? m 'event-chord)
+          (let*-values (((notes arts) (partition
+                                       (lambda (mus)
+                                         (music-is-of-type? mus 'rhythmic-event))
+                                       (ly:music-property m 'elements)))
+                        ((dur) (ly:music-property m 'duration))
+                        ((full-arts) (append arts
+                                             (ly:music-property m 'articulations)))
+                        ((first-note) (and (pair? notes) (car notes))))
+            (cond (first-note
+                   (set! (ly:music-property first-note 'articulations)
+                         full-arts)
+                   first-note)
+                  ((ly:duration? dur)
+                   ;; A repeat chord. Produce an unpitched note.
+                   (make-music 'NoteEvent
+                               'duration dur
+                               'articulations full-arts))
+                  (else
+                   (ly:music-error m (_ "Missing duration"))
+                   (make-music 'NoteEvent
+                               'duration (ly:make-duration 2 0 0)
+                               'articulations full-arts))))))
+   music))
+
+
 (defmacro-public make-relative (variables reference music)
   "The list of pitch or music variables in @var{variables} is used as
 a sequence for creating relativable music from @var{music}.