X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ly%2Fmusic-functions-init.ly;h=a25198f3e01dfaa06fd4cc76aee9e4d5a837d9e8;hb=94dc452301cc0d1e9983f5aeb784884f7fe8c964;hp=df5d8a500523c5504bb4e6eec9ea325daef3de91;hpb=522c1d8305e1fae10e90084d9f757b63b1fab58e;p=lilypond.git

diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index df5d8a5005..a25198f3e0 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -18,7 +18,7 @@
 %%%% You should have received a copy of the GNU General Public License
 %%%% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
-\version "2.17.6"
+\version "2.17.11"
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -31,6 +31,14 @@
 
 %% TODO: using define-music-function in a .scm causes crash.
 
+absolute =
+#(define-music-function (parser location music)
+   (ly:music?)
+   (_i "Make @var{music} absolute.  This does not actually change the
+music itself but rather hides it from surrounding @code{\\relative}
+commands.")
+   (make-music 'RelativeOctaveMusic 'element music))
+
 acciaccatura =
 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
    (_i "Create an acciaccatura from the following music expression"))
@@ -178,14 +186,16 @@ balloonGrobText =
    (symbol? number-pair? markup?)
    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset}
  (use like @code{\\once})")
-   (make-music 'AnnotateOutputEvent
-	       'symbol grob-name
-	       'X-offset (car offset)
-	       'Y-offset (cdr offset)
-	       'text text))
+   (make-event-chord
+    (list
+     (make-music 'AnnotateOutputEvent
+                 'symbol grob-name
+                 'X-offset (car offset)
+                 'Y-offset (cdr offset)
+                 'text text))))
 
 balloonText =
-#(define-music-function (parser location offset text) (number-pair? markup?)
+#(define-event-function (parser location offset text) (number-pair? markup?)
    (_i "Attach @var{text} at @var{offset} (use like @code{\\tweak})")
    (make-music 'AnnotateOutputEvent
 	       'X-offset (car offset)
@@ -262,11 +272,11 @@ as @code{\\compoundMeter #'((3 2 8))} or shorter
   #{
     \once \override Staff.TimeSignature.stencil = #(lambda (grob)
       (grob-interpret-markup grob (format-compound-time args)))
-    \set Timing.timeSignatureFraction = $timesig
-    \set Timing.baseMoment = $beat
-    \set Timing.beatStructure = $beatGrouping
+    \set Timing.timeSignatureFraction = #timesig
+    \set Timing.baseMoment = #beat
+    \set Timing.beatStructure = #beatGrouping
     \set Timing.beamExceptions = #'()
-    \set Timing.measureLength = $mlen
+    \set Timing.measureLength = #mlen
   #} ))
 
 crossStaff =
@@ -275,7 +285,7 @@ crossStaff =
   #{
   \temporary \override Stem.cross-staff = #cross-staff-connect
   \temporary \override Flag.style = #'no-flag
-  $notes
+  #notes
   \revert Stem.cross-staff
   \revert Flag.style
 #})
@@ -344,10 +354,8 @@ without the need of a specific end spanner.")
 				  (extract-typed-music music 'span-event)))
 	  (stop-span-evs
 	   (map (lambda (m)
-		  (let ((c (music-clone m)))
-		    (set! (ly:music-property c 'span-direction) STOP)
-		    c))
-		start-span-evs))
+		  (music-clone m 'span-direction STOP))
+                start-span-evs))
 	  (end-ev-chord (make-music 'EventChord
 				    'elements stop-span-evs))
 	  (total (make-music 'SequentialMusic
@@ -381,6 +389,15 @@ featherDurations=
 
      argument))
 
+finger =
+#(define-event-function (parser location finger) (number-or-markup?)
+   (_i "Apply @var{finger} as a fingering indication.")
+
+   (make-music
+            'FingeringEvent
+            (if (number? finger) 'digit 'text)
+            finger))
+
 footnote =
 #(define-music-function (parser location mark offset footnote item)
    ((markup?) number-pair? markup? symbol-list-or-music?)
@@ -431,12 +448,10 @@ harmonics played on a fretted instrument by touching the strings at @var{fret}."
   #{
     \set harmonicDots = ##t
     \temporary \override TabNoteHead.stencil = #(tab-note-head::print-custom-fret-label (number->string fret))
-    \temporary \override NoteHead.Y-extent = #(ly:make-unpure-pure-container ly:grob::stencil-height
-                                       (lambda (grob start end)
-                                               (ly:grob::stencil-height grob)))
+    \temporary \override NoteHead.Y-extent = #grob::always-Y-extent-from-stencil
     \temporary \override NoteHead.stencil = #(lambda (grob) (ly:grob-set-property! grob 'style 'harmonic-mixed)
                                             (ly:note-head::print grob))
-    $(make-harmonic
+    #(make-harmonic
        (calc-harmonic-pitch (fret->pitch (number->string fret)) music))
     \unset harmonicDots
     \revert TabNoteHead.stencil
@@ -456,7 +471,7 @@ given through @var{ratio}.")
                                                (ly:grob::stencil-height grob)))
     \temporary \override NoteHead.stencil = #(lambda (grob) (ly:grob-set-property! grob 'style 'harmonic-mixed)
                                             (ly:note-head::print grob))
-    $(make-harmonic
+    #(make-harmonic
       (calc-harmonic-pitch (ratio->pitch ratio) music))
     \unset harmonicDots
     \revert TabNoteHead.stencil
@@ -474,8 +489,8 @@ If @var{item} is a symbol list of form @code{GrobName} or
 specified by it.  If @var{item} is a music expression, the result is
 the same music expression with an appropriate tweak applied to it.")
    (if (ly:music? item)
-       #{ \tweak transparent ##t $item #}
-       #{ \override $item #'transparent = ##t #}))
+       #{ \tweak transparent ##t #item #}
+       #{ \override #item . transparent = ##t #}))
 
 inStaffSegno =
 #(define-music-function (parser location) ()
@@ -682,8 +697,8 @@ If @var{item} is a symbol list of form @code{GrobName} or
 specified by it.  If @var{item} is a music expression, the result is
 the same music expression with an appropriate tweak applied to it.")
    (if (ly:music? item)
-       #{ \tweak stencil ##f $item #}
-       #{ \override $item #'stencil = ##f #}))
+       #{ \tweak stencil ##f #item #}
+       #{ \override #item . stencil = ##f #}))
 
 once =
 #(define-music-function (parser location music) (ly:music?)
@@ -736,10 +751,8 @@ with subproperties given as well.")
                        (if (equal?
                             (cdr (assoc 'name (ly:grob-property grob 'meta)))
                             (second p))
-                         (if (null? (cdddr p))
-                             (ly:grob-set-property! grob (caddr p) value)
-                             (ly:grob-set-nested-property!
-                              grob (cddr p) value)))))
+                           (ly:grob-set-nested-property!
+                            grob (cddr p) value))))
          (make-music 'Music))))
 
 
@@ -799,93 +812,102 @@ Example:
   C = { e e | f f | }
 @end verbatim
 ")
-   (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
-	  (current-voices voices)
-	  (current-sequence (list))
-	  (original music)
-	  (wrapper #f))
-     ;;
-     ;; utilities
-     (define (push-music m)
-       "Push the music expression into the current sequence"
-       (set! current-sequence (cons m current-sequence)))
-     (define (change-voice)
-       "Stores the previously built sequence into the current voice and
+   (define (bar-check? m)
+     "Checks whether m is a bar check."
+     (eq? (ly:music-property m 'name) 'BarCheck))
+   (define (recurse-and-split music)
+     "This returns either a list of music split along barchecks, or
+@code{#f}."
+     (let ((elt (ly:music-property music 'element))
+           (elts (ly:music-property music 'elements)))
+       (cond ((ly:music? elt)
+              (let ((lst (recurse-and-split elt)))
+                (and lst
+                     (map
+                      (lambda (x)
+                        (let ((res (music-clone music 'element x)))
+                          (if (ly:input-location?
+                               (ly:music-property x 'origin))
+                              (set! (ly:music-property res 'origin)
+                                    (ly:music-property x 'origin)))
+                          res))
+                      lst))))
+             ((any bar-check? elts)
+              (let* ((voices (apply circular-list
+                                    (make-list (length voice-ids)
+                                               '())))
+                     (current-voices voices)
+                     (current-sequence '()))
+                ;;
+                ;; utilities
+                (define (push-music m)
+                  "Push the music expression into the current sequence"
+                  (set! current-sequence (cons m current-sequence)))
+                (define (change-voice)
+                  "Stores the previously built sequence into the current voice and
        change to the following voice."
-       (list-set! current-voices 0 (cons (make-music 'SequentialMusic
-						     'elements (reverse! current-sequence))
-					 (car current-voices)))
-       (set! current-sequence (list))
-       (set! current-voices (cdr current-voices)))
-     (define (bar-check? m)
-       "Checks whether m is a bar check."
-       (eq? (ly:music-property m 'name) 'BarCheck))
-     (define (music-origin music)
-       "Recursively search an origin location stored in music."
-       (cond ((null? music) #f)
-	     ((not (null? (ly:music-property music 'origin)))
-	      (ly:music-property music 'origin))
-	     (else (or (music-origin (ly:music-property music 'element))
-		       (let ((origins (remove not (map music-origin
-						       (ly:music-property music 'elements)))))
-			 (and (not (null? origins)) (car origins)))))))
-     (while (music-is-of-type? music 'music-wrapper-music)
-	    (set! wrapper music)
-	    (set! music (ly:music-property wrapper 'element)))
-     (if wrapper
-	 (set! (ly:music-property wrapper 'element)
-				  (make-music 'SequentialMusic
-					      'origin location))
-	 (set! original
-	       (make-music 'SequentialMusic
-			   'origin location)))
-     ;;
-     ;; first, split the music and fill in voices
-     ;; We flatten direct layers of SequentialMusic since they are
-     ;; pretty much impossible to avoid when writing music functions.
-     (let rec ((music music))
-       (for-each (lambda (m)
-		   (if (eq? (ly:music-property m 'name) 'SequentialMusic)
-		       (rec m)
-		       (begin
-			 (push-music m)
-			 (if (bar-check? m) (change-voice)))))
-		 (ly:music-property music 'elements)))
-     (if (not (null? current-sequence)) (change-voice))
-     ;; un-circularize `voices' and reorder the voices
-     (set! voices (map-in-order (lambda (dummy seqs)
-				  (reverse! seqs))
-				voice-ids voices))
-     ;;
-     ;; set origin location of each sequence in each voice
-     ;; for better type error tracking
-     (for-each (lambda (voice)
-		 (for-each (lambda (seq)
-			     (set! (ly:music-property seq 'origin)
-				   (or (music-origin seq) location)))
-			   voice))
-	       voices)
-     ;;
-     ;; check sequence length
-     (apply for-each (lambda* (#:rest seqs)
-			      (let ((moment-reference (ly:music-length (car seqs))))
-				(for-each (lambda (seq moment)
-					    (if (not (equal? moment moment-reference))
-						(ly:music-warning seq
-								  "Bars in parallel music don't have the same length")))
-					  seqs (map-in-order ly:music-length seqs))))
-	    voices)
-     ;;
-     ;; bind voice identifiers to the voices
-     (for-each (lambda (voice-id voice)
-	    (ly:parser-define! parser voice-id
-			       (let ((v (ly:music-deep-copy original)))
-				 (set! (ly:music-property
-					(car (extract-named-music
-					      v 'SequentialMusic))
-					'elements) voice)
-				 v)))
-	  voice-ids voices)))
+                  (set-car! current-voices
+                            (cons (reverse! current-sequence)
+                                  (car current-voices)))
+                  (set! current-sequence '())
+                  (set! current-voices (cdr current-voices)))
+                (for-each (lambda (m)
+                            (let ((split? (recurse-and-split m)))
+                              (if split?
+                                  (for-each
+                                   (lambda (m)
+                                     (push-music m)
+                                     (change-voice))
+                                   split?)
+                                  (begin
+                                    (push-music m)
+                                    (if (bar-check? m) (change-voice))))))
+                          elts)
+                (if (pair? current-sequence) (change-voice))
+                ;; un-circularize `voices' and reorder the voices
+
+                (set! voices (map reverse!
+                                  (list-head voices (length voice-ids))))
+
+                ;; check sequence length
+                (apply for-each (lambda seqs
+                                  (define (seq-len seq)
+                                    (reduce ly:moment-add
+                                            (ly:make-moment 0)
+                                            (map ly:music-length seq)))
+                                  (let ((moment-reference (seq-len (car seqs))))
+                                    (for-each (lambda (seq)
+                                                (if (not (equal? (seq-len seq)
+                                                                 moment-reference))
+                                                    (ly:music-warning
+                                                     (if (pair? seq)
+                                                         (last seq)
+                                                         (caar seqs))
+                                                     (_ "Bars in parallel music don't have the same length"))))
+                                              seqs)))
+                       voices)
+                (map
+                 (lambda (lst)
+                   (set! lst (concatenate! lst))
+                   (let ((res (music-clone music 'elements lst)))
+                     (if (and (pair? lst)
+                              (ly:input-location? (ly:music-property
+                                                   (car lst)
+                                                   'origin)))
+                         (set! (ly:music-property res 'origin)
+                               (ly:music-property (car lst) 'origin)))
+                     res))
+                 voices)))
+             (else #f))))
+   (let ((voices (recurse-and-split music)))
+     (if voices
+         ;;
+         ;; bind voice identifiers to the voices
+         (for-each (lambda (voice-id voice)
+                     (ly:parser-define! parser voice-id voice))
+	  voice-ids voices)
+         (ly:music-warning music
+                           (_ "ignoring parallel music without barchecks")))))
 
 parenthesize =
 #(define-music-function (parser loc arg) (ly:music?)
@@ -1010,9 +1032,23 @@ usually contains spacers or multi-measure rests.")
 
 relative =
 #(define-music-function (parser location pitch music)
-   ((ly:pitch? (ly:make-pitch 0 0 0)) ly:music?)
-   (_i "Make @var{music} relative to @var{pitch} (default @code{c'}).")
-   (ly:make-music-relative! music pitch)
+   ((ly:pitch?) ly:music?)
+   (_i "Make @var{music} relative to @var{pitch}.  If @var{pitch} is
+omitted, the first note in @var{music} is given in absolute pitch.")
+   ;; When \relative has no clear decision (can only happen with
+   ;; scales with an even number of steps), it goes down (see
+   ;; pitch.cc).  The following formula puts out f for both the normal
+   ;; 7-step scale as well as for a "shortened" scale missing the
+   ;; final b.  In either case, a first note of c will end up as c,
+   ;; namely pitch (-1, 0, 0).
+   (ly:make-music-relative! music
+                            (or pitch
+                                (ly:make-pitch
+                                 -1
+                                 (quotient
+                                  ;; size of current scale:
+                                  (ly:pitch-steps (ly:make-pitch 1 0))
+                                  2))))
    (make-music 'RelativeOctaveMusic
 	       'element music))
 
@@ -1056,13 +1092,12 @@ for time signatures of @var{time-signature}.")
    (revert-time-signature-setting time-signature))
 
 rightHandFinger =
-#(define-event-function (parser location finger) (number-or-string?)
+#(define-event-function (parser location finger) (number-or-markup?)
    (_i "Apply @var{finger} as a fingering indication.")
 
    (make-music
             'StrokeFingerEvent
-            'origin location
-            (if (string? finger) 'text 'digit)
+            (if (number? finger) 'digit 'text)
             finger))
 
 scaleDurations =
@@ -1179,8 +1214,7 @@ single =
 #(define-music-function (parser location overrides music)
    (ly:music? ly:music?)
    (_i "Convert @var{overrides} to tweaks and apply them to @var{music}.
-This does not convert @code{\\revert}, @code{\\set} or @code{\\unset}
-and ignores nested overrides.")
+This does not convert @code{\\revert}, @code{\\set} or @code{\\unset}.")
    (set! (ly:music-property music 'tweaks)
          (fold-some-music
           (lambda (m) (eq? (ly:music-property m 'name)
@@ -1190,12 +1224,12 @@ and ignores nested overrides.")
                       ((ly:music-property m 'grob-property #f) => list)
                       (else
                        (ly:music-property m 'grob-property-path)))))
-              (if (pair? (cdr p))
-                  tweaks ;ignore nested properties
-                  (acons (cons (ly:music-property m 'symbol) ;grob name
-                               (car p)) ;grob property
-                         (ly:music-property m 'grob-value)
-                         tweaks))))
+              (acons (cons (ly:music-property m 'symbol) ;grob name
+                           (if (pair? (cdr p))
+                               p ;grob property path
+                               (car p))) ;grob property
+                     (ly:music-property m 'grob-value)
+                     tweaks)))
           (ly:music-property music 'tweaks)
           overrides))
    music)
@@ -1327,6 +1361,8 @@ as a first or second voice.")
 	       'quoted-context-id "cue"
 	       'quoted-music-name what
 	       'quoted-voice-direction dir
+               ;; following is inverse of instrumentTransposition for
+               ;; historical reasons
 	       'quoted-transposition pitch))
 
 transposition =
@@ -1334,10 +1370,48 @@ transposition =
    (_i "Set instrument transposition")
 
    (context-spec-music
-    (make-property-set 'instrumentTransposition
-                       (ly:pitch-negate pitch))
+    (make-property-set 'instrumentTransposition pitch)
     'Staff))
 
+tuplet =
+#(define-music-function (parser location ratio tuplet-span music)
+   (fraction? (ly:duration? '()) ly:music?)
+   (_i "Scale the given @var{music} to tuplets.  @var{ratio} is a
+fraction that specifies how many notes are played in place of the
+nominal value: it will be @samp{3/2} for triplets, namely three notes
+being played in place of two.  If the optional duration
+@var{tuplet-span} is specified, it is used instead of
+@code{tupletSpannerDuration} for grouping the tuplets.
+For example,
+@example
+\\tuplet 3/2 4 @{ c8 c c c c c @}
+@end example
+will result in two groups of three tuplets, each group lasting for a
+quarter note.")
+   (make-music 'TimeScaledMusic
+               'element (ly:music-compress
+                         music
+                         (ly:make-moment (cdr ratio) (car ratio)))
+               'numerator (cdr ratio)
+               'denominator (car ratio)
+               'duration tuplet-span))
+
+tupletSpan =
+#(define-music-function (parser location tuplet-span)
+   ((ly:duration?))
+   (_i "Set @code{tupletSpannerDuration}, the length into which
+@code{\\tuplet} without an explicit @samp{tuplet-span} argument of its
+own will group its tuplets, to the duration @var{tuplet-span}.  To
+revert to the default of not subdividing the contents of a @code{\\tuplet}
+command without explicit @samp{tuplet-span}, use
+@example
+\\tupletSpan \\default
+@end example
+")
+   (if tuplet-span
+       #{ \set tupletSpannerDuration = #(ly:duration-length tuplet-span) #}
+       #{ \unset tupletSpannerDuration #}))
+
 tweak =
 #(define-music-function (parser location prop value item)
    (symbol-list-or-symbol? scheme? symbol-list-or-music?)
@@ -1354,18 +1428,21 @@ are affected.
 As a special case, @var{item} may be a symbol list specifying a grob
 path, in which case @code{\\once\\override} is called on it instead of
 creating tweaked music.  This is mainly useful when using
-@code{\\tweak} as as a component for building other functions.")
+@code{\\tweak} as as a component for building other functions.
+
+@var{prop} can contain additional elements in which case a nested
+property (inside of an alist) is tweaked.")
    (if (ly:music? item)
        (let ((p (check-grob-path prop parser location
                                  #:start 1
                                  #:default #t
-                                 #:min 2
-                                 #:max 2)))
+                                 #:min 2)))
          (if p
              (set! (ly:music-property item 'tweaks)
-                   (acons (if (eq? (car p) #t)
-                              (cadr p)
-                              (cons (car p) (cadr p)))
+                   (acons (cond ((pair? (cddr p)) p)
+                                ((symbol? (car p))
+                                 (cons (car p) (cadr p)))
+                                (else (cadr p)))
                           value
                           (ly:music-property item 'tweaks))))
          item)