]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Run grand-replace (issue 3765)
[lilypond.git] / scm / music-functions.scm
index eed6f7cd0a4a4c4a0cf04e2ec20e7f83b717ff68..05352b0953038c23babc807a6746b9a539453038 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -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)
@@ -137,7 +138,7 @@ For instance,
                                                                   (string-length "-markup")))))))
   (define (transform-arg arg)
     (cond ((and (pair? arg) (markup? (car arg))) ;; a markup list
-           (apply append (map inner-markup->make-markup arg)))
+           (append-map inner-markup->make-markup arg))
           ((and (not (string? arg)) (markup? arg)) ;; a markup
            (inner-markup->make-markup arg))
           (else                                  ;; scheme arg
@@ -164,12 +165,12 @@ equivalent to @var{obj}, that is, for a music expression, a
          (ly:music? obj)
          `(make-music
            ',(ly:music-property obj 'name)
-           ,@(apply append (map (lambda (prop)
-                                  `(',(car prop)
-                                    ,(music->make-music (cdr prop))))
-                                (remove (lambda (prop)
-                                          (eqv? (car prop) 'origin))
-                                        (ly:music-mutable-properties obj))))))
+           ,@(append-map (lambda (prop)
+                           `(',(car prop)
+                             ,(music->make-music (cdr prop))))
+                         (remove (lambda (prop)
+                                   (eqv? (car prop) 'origin))
+                                 (ly:music-mutable-properties obj)))))
         (;; moment
          (ly:moment? obj)
          `(ly:make-moment ,(ly:moment-main-numerator obj)
@@ -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.
 
@@ -503,6 +524,28 @@ in @var{grob}."
     TupletBracket
     TrillSpanner))
 
+(define general-grace-settings
+  `((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)))
+
+(define-public score-grace-settings
+  (append
+    `((Voice Stem direction ,UP)
+      (Voice Slur direction ,DOWN))
+    general-grace-settings))
+
 (define-safe-public (make-voice-props-set n)
   (make-sequential-music
    (append
@@ -510,26 +553,9 @@ in @var{grob}."
                                              (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-property-set 'graceSettings general-grace-settings)
      (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))))))
 
-
 (define-safe-public (make-voice-props-override n)
   (make-sequential-music
    (append
@@ -537,25 +563,8 @@ in @var{grob}."
                                                   (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-override 'NoteColumn 'horizontal-shift (quotient n 2))
-     (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+     (make-property-set 'graceSettings general-grace-settings)
+     (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))))))
 
 (define-safe-public (make-voice-props-revert)
   (make-sequential-music
@@ -563,8 +572,7 @@ in @var{grob}."
     (map (lambda (x) (make-grob-property-revert x 'direction))
          direction-polyphonic-grobs)
     (list (make-property-unset 'graceSettings)
-          (make-grob-property-revert 'NoteColumn 'horizontal-shift)
-          (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
+          (make-grob-property-revert 'NoteColumn 'horizontal-shift)))))
 
 
 (define-safe-public (context-spec-music m context #:optional id)
@@ -627,9 +635,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
@@ -741,7 +750,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)
@@ -760,8 +770,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)))
@@ -770,6 +779,73 @@ respective predecessor chord."
                 (ly:music-property music 'elements)))))
   music)
 
+;;; This does _not_ copy any articulations.  Rationale: one main
+;;; incentive for pitch-repeating durations is after ties, such that
+;;; 4~2~8. can stand in for a 15/16 note in \partial 4 position.  In
+;;; this use case, any repeated articulations will be a nuisance.
+;;;
+;;; String assignments in TabStaff might seem like a worthwhile
+;;; exception, but they would be better tackled by the respective
+;;; engravers themselves (see issue 3662).
+;;;
+;;; Repeating chords as well seems problematic for things like
+;;; \score {
+;;;   <<
+;;;     \new Staff { c4 c c <c e> }
+;;;     \new RhythmicStaff { 4 4 4 4 }
+;;;   >>
+;;; }
+;;;
+;;; However, because of MIDI it is not advisable to use RhythmicStaff
+;;; without any initial pitch/drum-type.  For music functions taking
+;;; pure rhythms as an argument, the running of expand-repeat-notes!
+;;; at scorification time is irrelevant: at that point of time, the
+;;; music function has already run.
+
+(define-public (expand-repeat-notes! music)
+  "Walks through @var{music} and gives pitchless notes (not having a
+pitch in code{pitch} or a drum type in @code{drum-type}) the pitch(es)
+from the predecessor note/chord if available."
+  (let ((last-pitch #f))
+    (map-some-music
+     (lambda (m)
+       (define (set-and-ret last)
+         (set! last-pitch last)
+         m)
+       (cond
+        ((music-is-of-type? m 'event-chord)
+         (set-and-ret m))
+        ((music-is-of-type? m 'note-event)
+         (cond
+          ((or (ly:music-property m 'pitch #f)
+               (ly:music-property m 'drum-type #f))
+           => set-and-ret)
+          ;; ok, naked rhythm.  Go through the various cases of
+          ;; last-pitch
+          ;; nothing available: just keep as-is
+          ((not last-pitch) m)
+          ((ly:pitch? last-pitch)
+           (set! (ly:music-property m 'pitch) last-pitch)
+           m)
+          ((symbol? last-pitch)
+           (set! (ly:music-property m 'drum-type) last-pitch)
+           m)
+          ;; Ok, this is the big bad one: the reference is a chord.
+          ;; For now, we use the repeat chord logic.  That's not
+          ;; really efficient as cleaning out all articulations is
+          ;; quite simpler than what copy-repeat-chord does.
+          (else
+           (copy-repeat-chord last-pitch
+                              (make-music 'EventChord
+                                          'elements
+                                          (ly:music-property m 'articulations)
+                                          'origin
+                                          (ly:music-property m 'origin))
+                              (ly:music-property m 'duration)
+                              '(rhythmic-event)))))
+        (else #f)))
+     music)))
+
 ;;; splitting chords into voices.
 (define (voicify-list lst number)
   "Make a list of Musics.
@@ -879,17 +955,23 @@ actually fully cloned."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; warn for bare chords at start.
 
-(define-public (ly:music-message music msg)
+(define-public (ly:music-message music msg . rest)
   (let ((ip (ly:music-property music 'origin)))
     (if (ly:input-location? ip)
-        (ly:input-message ip msg)
-        (ly:message msg))))
+        (apply ly:input-message ip msg rest)
+        (apply ly:message msg rest))))
 
-(define-public (ly:music-warning music msg)
+(define-public (ly:music-warning music msg . rest)
   (let ((ip (ly:music-property music 'origin)))
     (if (ly:input-location? ip)
-        (ly:input-warning ip msg)
-        (ly:warning msg))))
+        (apply ly:input-warning ip msg rest)
+        (apply ly:warning msg rest))))
+
+(define-public (ly:event-warning event msg . rest)
+  (let ((ip (ly:event-property event 'origin)))
+    (if (ly:input-location? ip)
+        (apply ly:input-warning ip msg rest)
+        (apply ly:warning msg rest))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -920,12 +1002,12 @@ actually fully cloned."
 (define-public (add-grace-property context-name grob sym val)
   "Set @var{sym}=@var{val} for @var{grob} in @var{context-name}."
   (define (set-prop context)
-    (let* ((where (ly:context-property-where-defined context 'graceSettings))
+    (let* ((where (or (ly:context-find context context-name) context))
            (current (ly:context-property where 'graceSettings))
            (new-settings (append current
                                  (list (list context-name grob sym val)))))
       (ly:context-set-property! where 'graceSettings new-settings)))
-  (context-spec-music (make-apply-context set-prop) 'Voice))
+  (make-apply-context set-prop))
 
 (define-public (remove-grace-property context-name grob sym)
   "Remove all @var{sym} for @var{grob} in @var{context-name}."
@@ -934,7 +1016,7 @@ actually fully cloned."
          (eq? (cadr property) grob)
          (eq? (caddr property) sym)))
   (define (delete-prop context)
-    (let* ((where (ly:context-property-where-defined context 'graceSettings))
+    (let* ((where (or (ly:context-find context context-name) context))
            (current (ly:context-property where 'graceSettings))
            (prop-settings (filter
                            (lambda(x) (sym-grob-context? x sym grob context-name))
@@ -944,8 +1026,7 @@ actually fully cloned."
                   (set! new-settings (delete x new-settings)))
                 prop-settings)
       (ly:context-set-property! where 'graceSettings new-settings)))
-  (context-spec-music (make-apply-context delete-prop) 'Voice))
-
+  (make-apply-context delete-prop))
 
 
 (defmacro-public def-grace-function (start stop . docstring)
@@ -981,24 +1062,37 @@ predicates require the parameter to be entered as Scheme expression.
 predicates, to be used in case of a type error in arguments or
 result."
 
+  (define (currying-lambda args doc-string? body)
+    (if (and (pair? args)
+             (pair? (car args)))
+        (currying-lambda (car args) doc-string?
+                         `((lambda ,(cdr args) ,@body)))
+        (if doc-string?
+            `(lambda ,args ,doc-string? ,@body)
+            `(lambda ,args ,@body))))
+
   (set! signature (map (lambda (pred)
                          (if (pair? pred)
                              `(cons ,(car pred)
                                     ,(and (pair? (cdr pred)) (cadr pred)))
                              pred))
                        (cons type signature)))
-  (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
-      ;; When the music function definition contains a i10n doc string,
-      ;; (_i "doc string"), keep the literal string only
-      (let ((docstring (cadar body))
-            (body (cdr body)))
-        `(ly:make-music-function (list ,@signature)
-                                 (lambda ,args
-                                   ,docstring
-                                   ,@body)))
-      `(ly:make-music-function (list ,@signature)
-                               (lambda ,args
-                                 ,@body))))
+
+  (let ((docstring
+         (and (pair? body) (pair? (cdr body))
+              (if (string? (car body))
+                  (car body)
+                  (and (pair? (car body))
+                       (eq? '_i (caar body))
+                       (pair? (cdar body))
+                       (string? (cadar body))
+                       (null? (cddar body))
+                       (cadar body))))))
+    ;; When the music function definition contains an i10n doc string,
+    ;; (_i "doc string"), keep the literal string only
+    `(ly:make-music-function
+      (list ,@signature)
+      ,(currying-lambda args docstring (if docstring (cdr body) body)))))
 
 (defmacro-public define-music-function rest
   "Defining macro returning music functions.
@@ -1089,6 +1183,8 @@ set to the @code{location} parameter."
              (clef (ly:music-property quote-music 'quoted-music-clef #f))
              (main-voice (case dir ((1) 1) ((-1) 0) (else #f)))
              (cue-voice (and main-voice (- 1 main-voice)))
+             (cue-type (ly:music-property quote-music 'quoted-context-type #f))
+             (cue-id (ly:music-property quote-music 'quoted-context-id))
              (main-music (ly:music-property quote-music 'element))
              (return-value quote-music))
 
@@ -1110,17 +1206,15 @@ set to the @code{location} parameter."
          (delq! #f
                 (list
                  (and clef (make-cue-clef-set clef))
-
-                 ;; Need to establish CueVoice context even in #CENTER case
-                 (context-spec-music
-                  (if cue-voice
-                      (make-voice-props-override cue-voice)
-                      (make-music 'Music))
-                  'CueVoice "cue")
+                 (and cue-type cue-voice
+                      (context-spec-music
+                       (make-voice-props-override cue-voice)
+                       cue-type cue-id))
                  quote-music
-                 (and cue-voice
+                 (and cue-type cue-voice
                       (context-spec-music
-                       (make-voice-props-revert) 'CueVoice "cue"))
+                       (make-voice-props-revert)
+                       cue-type cue-id))
                  (and clef (make-cue-clef-unset))))))
       quote-music))
 
@@ -1250,12 +1344,13 @@ then revert skipTypesetting."
      (else music))))
 
 
-(define-public toplevel-music-functions
+(define-session-public toplevel-music-functions
   (list
    (lambda (music parser) (expand-repeat-chords!
                            (cons 'rhythmic-event
                                  (ly:parser-lookup parser '$chord-repeat-events))
                            music))
+   (lambda (music parser) (expand-repeat-notes! music))
    (lambda (music parser) (voicify-music music))
    (lambda (x parser) (music-map music-check-error x))
    (lambda (x parser) (music-map precompute-music-length x))
@@ -1874,38 +1969,111 @@ yourself."
   (map (lambda (x) (ly:music-property x 'pitch))
        (event-chord-notes event-chord)))
 
-(defmacro-public make-relative (pitches last-pitch music)
-  "The list of pitch-carrying variables in @var{pitches} is used as a
-sequence for creating relativable music from @var{music}.
-The variables in @var{pitches} are, when considered inside of
-@code{\\relative}, all considered to be specifications to the preceding
-variable.  The first variable is relative to the preceding musical
-context, and @var{last-pitch} specifies the pitch passed as relative
-base onto the following musical context."
+(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}.
+
+When the constructed music is used outside of @code{\\relative}, it
+just reflects plugging in the @var{variables} into @var{music}.
+
+The action inside of @code{\\relative}, however, is determined by
+first relativizing the surrogate @var{reference} with the variables
+plugged in and then using the variables relativized as a side effect
+of relativizing @var{reference} for evaluating @var{music}.
+
+Since pitches don't have the object identity required for tracing the
+effect of the reference call, they are replaced @emph{only} for the
+purpose of evaluating @var{reference} with simple pitched note events.
+
+The surrogate @var{reference} expression has to be written with that
+in mind.  In addition, it must @emph{not} contain @emph{copies} of
+music that is supposed to be relativized but rather the
+@emph{originals}.  This @emph{includes} the pitch expressions.  As a
+rule, inside of @code{#@{@dots{}#@}} variables must @emph{only} be
+introduced using @code{#}, never via the copying construct @code{$}.
+The reference expression will usually just be a sequential or chord
+expression naming all variables in sequence, implying that following
+music will be relativized according to the resulting pitch of the last
+or first variable, respectively.
+
+Since the usual purpose is to create more complex music from general
+arguments and since music expression parts must not occur more than
+once, one @emph{does} generally need to use copying operators in the
+@emph{replacement} expression @var{music} when using an argument more
+than once there.  Using an argument more than once in @var{reference},
+in contrast, does not make sense.
+
+There is another fine point to mind: @var{music} must @emph{only}
+contain freshly constructed elements or copied constructs.  This will
+be the case anyway for regular LilyPond code inside of
+@code{#@{@dots{}#@}}, but any other elements (apart from the
+@var{variables} themselves which are already copied) must be created
+or copied as well.
+
+The reason is that it is usually permitted to change music in-place as
+long as one does a @var{ly:music-deep-copy} on it, and such a copy of
+the whole resulting expression will @emph{not} be able to copy
+variables/values inside of closures where the information for
+relativization is being stored.
+"
 
   ;; pitch and music generator might be stored instead in music
   ;; properties, and it might make sense to create a music type of its
   ;; own for this kind of construct rather than using
   ;; RelativeOctaveMusic
-  (define ((make-relative::to-relative-callback pitches p->m p->p) music pitch)
-    (let* ((chord (make-event-chord
-                   (map
-                    (lambda (p)
-                      (make-music 'NoteEvent
-                                  'pitch p))
-                    pitches)))
-           (pitchout (begin
-                       (ly:make-music-relative! chord pitch)
-                       (event-chord-pitches chord))))
-      (set! (ly:music-property music 'element)
-            (apply p->m pitchout))
-      (apply p->p pitchout)))
+  (define ((make-relative::to-relative-callback variables music-call ref-call)
+           music pitch)
+    (let* ((ref-vars (map (lambda (v)
+                            (if (ly:pitch? v)
+                                (make-music 'NoteEvent 'pitch v)
+                                (ly:music-deep-copy v)))
+                          variables))
+           (after-pitch (ly:make-music-relative! (apply ref-call ref-vars) pitch))
+           (actual-vars (map (lambda (v r)
+                               (if (ly:pitch? v)
+                                   (ly:music-property r 'pitch)
+                                   r))
+                             variables ref-vars))
+           (rel-music (apply music-call actual-vars)))
+      (set! (ly:music-property music 'element) rel-music)
+      after-pitch))
   `(make-music 'RelativeOctaveMusic
                'to-relative-callback
                (,make-relative::to-relative-callback
-                (list ,@pitches)
-                (lambda ,pitches ,music)
-                (lambda ,pitches ,last-pitch))
+                (list ,@variables)
+                (lambda ,variables ,music)
+                (lambda ,variables ,reference))
                'element ,music))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1948,9 +2116,9 @@ base onto the following musical context."
                (layout (ly:grob-layout root))
                (blot (ly:output-def-lookup layout 'blot-diameter)))
           ;; Hide spanned stems
-          (map (lambda (st)
-                 (set! (ly:grob-property st 'stencil) #f))
-               stems)
+          (for-each (lambda (st)
+                      (set! (ly:grob-property st 'stencil) #f))
+                    stems)
           ;; Draw a nice looking stem with rounded corners
           (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
         ;; Nothing to connect, don't draw the span
@@ -1982,7 +2150,7 @@ other stems just because of that."
   ;; two stems at this musical moment
   (if (<= 2 (length stems))
       (let ((roots (filter stem-is-root? stems)))
-        (map (make-stem-span! stems trans) roots))))
+        (for-each (make-stem-span! stems trans) roots))))
 
 (define-public (Span_stem_engraver ctx)
   "Connect cross-staff stems to the stems above in the system"
@@ -2076,3 +2244,96 @@ Broken measures are numbered in parentheses."
                     (cdr break-alignment-L-ext))))
            X)))
     num))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following are used by the \offset function
+
+(define (find-value-to-offset prop self alist)
+  "Return the first value of the property @var{prop} in the property
+alist @var{alist} -- after having found @var{self}.  If @var{self} is
+not found, return the first value of @var{prop}."
+  (let ((segment (member (cons prop self) alist)))
+    (if (not segment)
+        (assoc-get prop alist)
+        (assoc-get prop (cdr segment)))))
+
+(define (offset-multiple-types arg offsets)
+  "Displace @var{arg} by @var{offsets} if @var{arg} is a number, a
+number pair, or a list of number pairs.  If @var{offsets} is an empty
+list or if there is a type-mismatch, @var{arg} will be returned."
+  (cond
+    ((and (number? arg) (number? offsets))
+     (+ arg offsets))
+    ((and (number-pair? arg)
+          (or (number? offsets)
+              (number-pair? offsets)))
+     (coord-translate arg offsets))
+    ((and (number-pair-list? arg) (number-pair-list? offsets))
+     (map
+       (lambda (x y) (coord-translate x y))
+       arg offsets))
+    (else arg)))
+
+(define-public (offsetter property offsets)
+  "Apply @var{offsets} to the default values of @var{property} of @var{grob}.
+Offsets are restricted to immutable properties and values of type @code{number},
+@code{number-pair}, or @code{number-pair-list}."
+  (define (self grob)
+    (let* ((immutable (ly:grob-basic-properties grob))
+           ; We need to search the basic-properties alist for our property to
+           ; obtain values to offset.  Our search is complicated by the fact that
+           ; calling the music function `offset' as an override conses a pair to
+           ; the head of the alist.  This pair must be discounted.  The closure it
+           ; contains is named `self' so it can be easily recognized.  If `offset'
+           ; is called as a tweak, the basic-property alist is unaffected.
+           (target (find-value-to-offset property self immutable))
+           ; if target is a procedure, we need to apply it to our grob to calculate
+           ; values to offset.
+           (vals
+             (if (procedure? target)
+                 (target grob)
+                 target))
+           (can-type-be-offset?
+             (or (number? vals)
+                 (number-pair? vals)
+                 (number-pair-list? vals))))
+
+      (if can-type-be-offset?
+          ; '(+inf.0 . -inf.0) would offset to itself.  This will be confusing to a
+          ; user unaware of the default value of the property, so issue a warning.
+          (if (equal? empty-interval vals)
+              (ly:warning "default '~a of ~a is ~a and can't be offset"
+                property grob vals)
+              (let* ((orig (ly:grob-original grob))
+                     (siblings
+                       (if (ly:spanner? grob)
+                           (ly:spanner-broken-into orig)
+                           '()))
+                     (total-found (length siblings))
+                     ; Since there is some flexibility in input syntax,
+                     ; structure of `offsets' is normalized.
+                     (offsets
+                       (if (or (not (pair? offsets))
+                               (number-pair? offsets)
+                               (and (number-pair-list? offsets)
+                                    (number-pair-list? vals)))
+                           (list offsets)
+                           offsets)))
+
+                (define (helper sibs offs)
+                  ; apply offsets to the siblings of broken spanners
+                  (if (pair? offs)
+                      (if (eq? (car sibs) grob)
+                          (offset-multiple-types vals (car offs))
+                          (helper (cdr sibs) (cdr offs)))
+                      vals))
+
+                (if (>= total-found 2)
+                    (helper siblings offsets)
+                    (offset-multiple-types vals (car offsets)))))
+
+              (begin
+                (ly:warning "the property '~a of ~a cannot be offset" property grob)
+                vals))))
+    ; return the closure named `self'
+    self)