Merge branch 'translation' into 'master'

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 019cee464d091be5477ba137a8753b98e3caf43a..9bf47d408e5f8ae36f2512e616c5729eda95bbd9 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,28 @@ 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 loop ((n (ly:music-property m 'repeat-count))
+                       (alts (ly:music-property m 'elements))
+                       (body (ly:music-property m 'element)))
+              (cond ((<= n 0) '())
+                    ((null? alts)
+                     (cons body (loop (1- n) alts body)))
+                    (else
+                     (cons* body (car alts)
+                            (loop (1- n)
+                                  (if (pair? (cdr alts))
+                                      (cdr alts)
+                                      alts)
+                                  body)))))))))
+   (unfold-repeats music)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property setting music objs.
 
@@ -614,9 +637,10 @@ in @var{grob}."
   (make-music 'PropertyUnset
               'symbol sym))
 
-(define-safe-public (make-articulation name)
-  (make-music 'ArticulationEvent
-              'articulation-type name))
+(define-safe-public (make-articulation name . properties)
+  (apply make-music 'ArticulationEvent
+         'articulation-type name
+         properties))
 
 (define-public (make-lyric-event string duration)
   (make-music 'LyricEvent
@@ -1947,6 +1971,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}.