ly/music-functions-init.ly

   1 %%%% -*- Mode: Scheme -*-
   2
   3 %%%% This file is part of LilyPond, the GNU music typesetter.
   4 %%%%
   5 %%%% Copyright (C) 2003--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 %%%%                          Jan Nieuwenhuizen <janneke@gnu.org>
   7 %%%%
   8 %%%% LilyPond is free software: you can redistribute it and/or modify
   9 %%%% it under the terms of the GNU General Public License as published by
  10 %%%% the Free Software Foundation, either version 3 of the License, or
  11 %%%% (at your option) any later version.
  12 %%%%
  13 %%%% LilyPond is distributed in the hope that it will be useful,
  14 %%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 %%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 %%%% GNU General Public License for more details.
  17 %%%%
  18 %%%% You should have received a copy of the GNU General Public License
  19 %%%% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 \version "2.19.25"
  22
  23
  24 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  25 %% this file is alphabetically sorted.
  26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  27
  28 %% need SRFI-1 for filter; optargs for lambda*
  29 #(use-modules (srfi srfi-1)
  30               (ice-9 optargs))
  31
  32 absolute =
  33 #(define-music-function (music)
  34    (ly:music?)
  35    (_i "Make @var{music} absolute.  This does not actually change the
  36 music itself but rather hides it from surrounding @code{\\relative}
  37 and @code{\\fixed} commands.")
  38    (make-music 'RelativeOctaveMusic 'element music))
  39
  40 acciaccatura =
  41 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
  42    (_i "Create an acciaccatura from the following music expression"))
  43
  44 %% keep these two together
  45 instrument-definitions = #'()
  46 addInstrumentDefinition =
  47 #(define-void-function
  48    (name lst) (string? list?)
  49    (_i "Create instrument @var{name} with properties @var{list}.")
  50    (set! instrument-definitions (acons name lst instrument-definitions)))
  51
  52 addQuote =
  53 #(define-void-function (name music) (string? ly:music?)
  54    (_i "Define @var{music} as a quotable music expression named
  55 @var{name}")
  56    (add-quotable name music))
  57
  58 %% keep these two together
  59 afterGraceFraction = 3/4
  60 afterGrace =
  61 #(define-music-function (fraction main grace) ((fraction?) ly:music? ly:music?)
  62    (_i "Create @var{grace} note(s) after a @var{main} music expression.
  63
  64 The musical position of the grace expression is after a
  65 given fraction of the main note's duration has passed.  If
  66 @var{fraction} is not specified as first argument, it is taken from
  67 @code{afterGraceFraction} which has a default value of @code{3/4}.")
  68    (let ((main-length (ly:music-length main))
  69          (fraction (or fraction (ly:parser-lookup 'afterGraceFraction))))
  70      (make-simultaneous-music
  71       (list
  72        main
  73        (make-sequential-music
  74         (list
  75
  76          (make-music 'SkipMusic
  77                      'duration (ly:make-duration
  78                                 0 0
  79                                 (* (ly:moment-main main-length)
  80                                    (/ (car fraction) (cdr fraction)))))
  81          (make-music 'GraceMusic
  82                      'element grace)))))))
  83
  84
  85 %% music identifiers not allowed at top-level,
  86 %% so this is a music-function instead.
  87 allowPageTurn =
  88 #(define-music-function () ()
  89    (_i "Allow a page turn. May be used at toplevel (ie between scores or
  90 markups), or inside a score.")
  91    (make-music 'EventChord
  92                'page-marker #t
  93                'page-turn-permission 'allow
  94                'elements (list (make-music 'PageTurnEvent
  95                                            'break-permission 'allow))))
  96
  97 alterBroken =
  98 #(define-music-function (property arg item)
  99   (key-list-or-symbol? list? key-list-or-music?)
 100   (_i "Override @var{property} for pieces of broken spanner @var{item}
 101 with values @var{arg}.  @var{item} may either be music in the form of
 102 a starting spanner event, or a symbol list in the form
 103 @samp{Context.Grob} or just @samp{Grob}.  Iff @var{item} is in the
 104 form of a spanner event, @var{property} may also have the form
 105 @samp{Grob.property} for specifying a directed tweak.")
 106   (if (ly:music? item)
 107       (if (or (eqv? (ly:music-property item 'span-direction) START)
 108               (music-is-of-type? item 'tie-event))
 109           (tweak property (value-for-spanner-piece arg) item)
 110           (begin
 111             (ly:music-warning item (_ "not a spanner"))
 112             item))
 113       (let* ((p (check-grob-path item (*location*)
 114                                  #:default 'Bottom
 115                                  #:min 2
 116                                  #:max 2))
 117              (name (and p (second p)))
 118              (description
 119               (and name (assoc-get name all-grob-descriptions))))
 120         (if (and description
 121                  (member 'spanner-interface
 122                          (assoc-get 'interfaces
 123                                     (assoc-get 'meta description))))
 124             (propertyOverride (append item (if (symbol? property)
 125                                        (list property)
 126                                        property))
 127                       (value-for-spanner-piece arg))
 128             (begin
 129               (ly:input-warning (*location*) (_ "not a spanner name, `~a'") name)
 130               (make-music 'Music))))))
 131
 132 appendToTag =
 133 #(define-music-function (tag more music)
 134    (symbol? ly:music? ly:music?)
 135    (_i "Append @var{more} to the @code{elements} of all music
 136 expressions in @var{music} that are tagged with @var{tag}.")
 137    (music-map (lambda (m)
 138                 (if (memq tag (ly:music-property m 'tags))
 139                     (set! (ly:music-property m 'elements)
 140                           (append (ly:music-property m 'elements)
 141                                   (list more))))
 142                 m)
 143               music))
 144
 145 applyContext =
 146 #(define-music-function (proc) (procedure?)
 147    (_i "Modify context properties with Scheme procedure @var{proc}.")
 148    (make-music 'ApplyContext
 149                'procedure proc))
 150
 151 applyMusic =
 152 #(define-music-function (func music) (procedure? ly:music?)
 153    (_i"Apply procedure @var{func} to @var{music}.")
 154    (func music))
 155
 156 applyOutput =
 157 #(define-music-function (target proc) (symbol-list-or-symbol? procedure?)
 158    (_i "Apply function @code{proc} to every layout object matched by
 159 @var{target} which takes the form @code{Context} or @code{Context.Grob}.")
 160    (let ((p (check-grob-path target (*location*) #:max 2)))
 161      (if p
 162          (make-music 'ApplyOutputEvent
 163                      'procedure proc
 164                      'context-type (car p)
 165                      (if (pair? (cdr p))
 166                          (list (cons 'symbol (cadr p)))
 167                          '()))
 168          (make-music 'Music))))
 169
 170 appoggiatura =
 171 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
 172    (_i "Create an appoggiatura from @var{music}"))
 173
 174 % for regression testing purposes.
 175 assertBeamQuant =
 176 #(define-music-function (l r) (pair? pair?)
 177    (_i "Testing function: check whether the beam quants @var{l} and @var{r} are correct")
 178    (make-grob-property-override 'Beam 'positions (check-quant-callbacks l r)))
 179
 180 % for regression testing purposes.
 181 assertBeamSlope =
 182 #(define-music-function (comp) (procedure?)
 183    (_i "Testing function: check whether the slope of the beam is the same as @code{comp}")
 184    (make-grob-property-override 'Beam 'positions (check-slope-callbacks comp)))
 185
 186 autochange =
 187 #(define-music-function (pitch clef-1 clef-2 music)
 188   ((ly:pitch? (ly:make-pitch 0 0)) (ly:context-mod?)(ly:context-mod?) ly:music?)
 189   (_i "Make voices that switch between staves automatically.  As an option the
 190 pitch where to switch staves may be specified.  The clefs for the staves are
 191 optional as well.  Setting clefs  works only for implicitly instantiated
 192 staves.")
 193   (let ;; keep the contexts alive for the full duration
 194        ((skip (make-duration-of-length (ly:music-length music)))
 195         (clef-1 (or clef-1 #{ \with { \clef "treble" } #}))
 196         (clef-2 (or clef-2 #{ \with { \clef "bass" } #})))
 197     (make-simultaneous-music
 198      (list
 199       (descend-to-context (make-autochange-music pitch music) 'Staff
 200                           "up" clef-1)
 201       (context-spec-music (make-skip-music skip) 'Staff
 202                           "up" clef-1)
 203       (context-spec-music (make-skip-music skip) 'Staff
 204                           "down" clef-2)))))
 205
 206 balloonGrobText =
 207 #(define-music-function (grob-name offset text)
 208    (symbol? number-pair? markup?)
 209    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset}
 210  (use like @code{\\once})")
 211    (make-event-chord
 212     (list
 213      (make-music 'AnnotateOutputEvent
 214                  'symbol grob-name
 215                  'X-offset (car offset)
 216                  'Y-offset (cdr offset)
 217                  'text text))))
 218
 219 balloonText =
 220 #(define-event-function (offset text) (number-pair? markup?)
 221    (_i "Attach @var{text} at @var{offset} (use like @code{\\tweak})")
 222    (make-music 'AnnotateOutputEvent
 223                'X-offset (car offset)
 224                'Y-offset (cdr offset)
 225                'text text))
 226
 227 bar =
 228 #(define-music-function (type) (string?)
 229    (_i "Insert a bar line of type @var{type}")
 230    (context-spec-music
 231     (make-property-set 'whichBar type)
 232     'Timing))
 233
 234 barNumberCheck =
 235 #(define-music-function (n) (integer?)
 236    (_i "Print a warning if the current bar number is not @var{n}.")
 237    (make-music 'ApplyContext
 238                'procedure
 239                (lambda (c)
 240                  (let ((cbn (ly:context-property c 'currentBarNumber)))
 241                    (if (and  (number? cbn) (not (= cbn n)))
 242                        (ly:input-warning (*location*)
 243                                          "Barcheck failed got ~a expect ~a"
 244                                          cbn n))))))
 245
 246 beamExceptions =
 247 #(define-scheme-function (music) (ly:music?)
 248    (_i "Extract a value suitable for setting
 249 @code{Timing.beamExceptions} from the given pattern with explicit
 250 beams in @var{music}.  A bar check @code{|} has to be used between
 251 bars of patterns in order to reset the timing.")
 252    (extract-beam-exceptions music))
 253
 254 bendAfter =
 255 #(define-event-function (delta) (real?)
 256    (_i "Create a fall or doit of pitch interval @var{delta}.")
 257    (make-music 'BendAfterEvent
 258                'delta-step delta))
 259
 260 bookOutputName =
 261 #(define-void-function (newfilename) (string?)
 262    (_i "Direct output for the current book block to @var{newfilename}.")
 263    (set! (paper-variable #f 'output-filename) newfilename))
 264
 265 bookOutputSuffix =
 266 #(define-void-function (newsuffix) (string?)
 267    (_i "Set the output filename suffix for the current book block to
 268 @var{newsuffix}.")
 269    (set! (paper-variable #f 'output-suffix) newsuffix))
 270
 271 %% \breathe is defined as a music function rather than an event identifier to
 272 %% ensure it gets useful input location information: as an event identifier,
 273 %% it would have to be wrapped in an EventChord to prevent it from being
 274 %% treated as a post_event by the parser
 275 breathe =
 276 #(define-music-function () ()
 277    (_i "Insert a breath mark.")
 278    (make-music 'BreathingEvent))
 279
 280 clef =
 281 #(define-music-function (type) (string?)
 282    (_i "Set the current clef to @var{type}.")
 283    (make-clef-set type))
 284
 285
 286 compoundMeter =
 287 #(define-music-function (args) (pair?)
 288   (_i "Create compound time signatures. The argument is a Scheme list of
 289 lists. Each list describes one fraction, with the last entry being the
 290 denominator, while the first entries describe the summands in the
 291 enumerator. If the time signature consists of just one fraction,
 292 the list can be given directly, i.e. not as a list containing a single list.
 293 For example, a time signature of (3+1)/8 + 2/4 would be created as
 294 @code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
 295 as @code{\\compoundMeter #'((3 2 8))} or shorter
 296 @code{\\compoundMeter #'(3 2 8)}.")
 297   (let* ((mlen (calculate-compound-measure-length args))
 298          (beat (calculate-compound-base-beat args))
 299          (beatGrouping (calculate-compound-beat-grouping args))
 300          (timesig (cons (ly:moment-main-numerator mlen)
 301                         (ly:moment-main-denominator mlen))))
 302   #{
 303     \once \override Timing.TimeSignature.stencil = #(lambda (grob)
 304       (grob-interpret-markup grob (make-compound-meter-markup args)))
 305     \set Timing.timeSignatureFraction = #timesig
 306     \set Timing.baseMoment = #beat
 307     \set Timing.beatStructure = #beatGrouping
 308     \set Timing.beamExceptions = #'()
 309     \set Timing.measureLength = #mlen
 310   #} ))
 311
 312 compressMMRests =
 313 #(define-music-function (music) (ly:music?)
 314   (_i "Remove the empty bars created by multi-measure rests,
 315 leaving just the first bar containing the MM rest itself.")
 316    (music-map
 317     (lambda (m)
 318       (if (eq? 'MultiMeasureRestMusic (ly:music-property m 'name))
 319           #{ \once \set Score.skipBars = ##t #m #}
 320           #{ #m #} ))
 321     music))
 322
 323 crossStaff =
 324 #(define-music-function (notes) (ly:music?)
 325   (_i "Create cross-staff stems")
 326   #{
 327   \temporary \override Stem.cross-staff = #cross-staff-connect
 328   \temporary \override Flag.style = #'no-flag
 329   #notes
 330   \revert Stem.cross-staff
 331   \revert Flag.style
 332 #})
 333
 334 cueClef =
 335 #(define-music-function (type) (string?)
 336   (_i "Set the current cue clef to @var{type}.")
 337   (make-cue-clef-set type))
 338
 339 cueClefUnset =
 340 #(define-music-function () ()
 341   (_i "Unset the current cue clef.")
 342   (make-cue-clef-unset))
 343
 344 cueDuring =
 345 #(define-music-function
 346    (what dir main-music) (string? ly:dir? ly:music?)
 347    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 348 in a CueVoice oriented by @var{dir}.")
 349    (make-music 'QuoteMusic
 350                'element main-music
 351                'quoted-context-type 'CueVoice
 352                'quoted-context-id "cue"
 353                'quoted-music-name what
 354                'quoted-voice-direction dir))
 355
 356 cueDuringWithClef =
 357 #(define-music-function
 358    (what dir clef main-music) (string? ly:dir? string? ly:music?)
 359    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 360 in a CueVoice oriented by @var{dir}.")
 361    (make-music 'QuoteMusic
 362                'element main-music
 363                'quoted-context-type 'CueVoice
 364                'quoted-context-id "cue"
 365                'quoted-music-name what
 366                'quoted-music-clef clef
 367                'quoted-voice-direction dir))
 368
 369
 370
 371 displayLilyMusic =
 372 #(define-music-function (port music) ((output-port?) ly:music?)
 373    (_i "Display the LilyPond input representation of @var{music}
 374 to @var{port}, defaulting to the console.")
 375    (let ((port (or port (current-output-port))))
 376      (newline port)
 377      (display-lily-music music port))
 378    music)
 379
 380 displayMusic =
 381 #(define-music-function (port music) ((output-port?) ly:music?)
 382    (_i "Display the internal representation of @var{music} to
 383 @var{port}, default to the console.")
 384    (let ((port (or port (current-output-port))))
 385      (newline port)
 386      (display-scheme-music music port))
 387    music)
 388
 389 displayScheme =
 390 #(define-scheme-function (port expr) ((output-port?) scheme?)
 391    (_i "Display the internal representation of @var{expr} to
 392 @var{port}, default to the console.")
 393    (let ((port (or port (current-output-port))))
 394      (newline port)
 395      (display-scheme-music expr port))
 396    expr)
 397
 398
 399
 400 endSpanners =
 401 #(define-music-function (music) (ly:music?)
 402    (_i "Terminate the next spanner prematurely after exactly one note
 403 without the need of a specific end spanner.")
 404    (let* ((start-span-evs (filter (lambda (ev)
 405                                     (equal? (ly:music-property ev 'span-direction)
 406                                             START))
 407                                   (extract-typed-music music 'span-event)))
 408           (stop-span-evs
 409            (map (lambda (m)
 410                   (music-clone m 'span-direction STOP))
 411                 start-span-evs))
 412           (end-ev-chord (make-music 'EventChord
 413                                     'elements stop-span-evs))
 414           (total (make-music 'SequentialMusic
 415                              'elements (list music
 416                                              end-ev-chord))))
 417      total))
 418
 419 eventChords =
 420 #(define-music-function (music) (ly:music?)
 421    (_i "Compatibility function wrapping @code{EventChord} around
 422 isolated rhythmic events occuring since version 2.15.28, after
 423 expanding repeat chords @samp{q}.")
 424    (event-chord-wrap! music))
 425
 426 featherDurations=
 427 #(define-music-function (factor argument) (ly:moment? ly:music?)
 428    (_i "Adjust durations of music in @var{argument} by rational @var{factor}.")
 429    (let ((orig-duration (ly:music-length argument))
 430          (multiplier (ly:make-moment 1 1)))
 431
 432      (for-each
 433       (lambda (mus)
 434         (if (< 0 (ly:moment-main-denominator (ly:music-length mus)))
 435             (begin
 436               (ly:music-compress mus multiplier)
 437               (set! multiplier (ly:moment-mul factor multiplier)))))
 438       (extract-named-music argument '(EventChord NoteEvent RestEvent SkipEvent)))
 439      (ly:music-compress
 440       argument
 441       (ly:moment-div orig-duration (ly:music-length argument)))
 442
 443      argument))
 444
 445 finger =
 446 #(define-event-function (finger) (number-or-markup?)
 447    (_i "Apply @var{finger} as a fingering indication.")
 448
 449    (make-music
 450             'FingeringEvent
 451             (if (number? finger) 'digit 'text)
 452             finger))
 453
 454 fixed =
 455 #(define-music-function (pitch music)
 456    (ly:pitch? ly:music?)
 457    (_i "Use the octave of @var{pitch} as the default octave for @var{music}.")
 458    (let ((octave-marks (1+ (ly:pitch-octave pitch))))
 459      (cond ((not (= 0 octave-marks))
 460             (ly:music-transpose music (ly:make-pitch octave-marks 0 0))
 461             ;;In order to leave unchanged the notes in any enclosed
 462             ;; \absolute or \fixed or \relative, make a cancelling shift
 463             (map (lambda (m)
 464                    (ly:music-transpose m (ly:make-pitch (- octave-marks) 0 0)))
 465                  (extract-named-music music 'RelativeOctaveMusic)))))
 466    (make-music 'RelativeOctaveMusic 'element music))
 467
 468 footnote =
 469 #(define-music-function (mark offset footnote item)
 470    ((markup?) number-pair? markup? symbol-list-or-music?)
 471    (_i "Make the markup @var{footnote} a footnote on @var{item}.  The
 472 footnote is marked with a markup @var{mark} moved by @var{offset} with
 473 respect to the marked music.
 474
 475 If @var{mark} is not given or specified as @var{\\default}, it is
 476 replaced by an automatically generated sequence number.  If @var{item}
 477 is a symbol list of form @samp{Grob} or @samp{Context.Grob}, then
 478 grobs of that type will be marked at the current time step in the
 479 given context (default @code{Bottom}).
 480
 481 If @var{item} is music, the music will get a footnote attached to a
 482 grob immediately attached to the event, like @var{\\tweak} does.  For
 483 attaching a footnote to an @emph{indirectly} caused grob, write
 484 @code{\\single\\footnote}, use @var{item} to specify the grob, and
 485 follow it with the music to annotate.
 486
 487 Like with @code{\\tweak}, if you use a footnote on a following
 488 post-event, the @code{\\footnote} command itself needs to be attached
 489 to the preceding note or rest as a post-event with @code{-}.")
 490    (let ((mus (make-music
 491                'FootnoteEvent
 492                'X-offset (car offset)
 493                'Y-offset (cdr offset)
 494                'automatically-numbered (not mark)
 495                'text (or mark (make-null-markup))
 496                'footnote-text footnote)))
 497      (once (propertyTweak 'footnote-music mus item))))
 498
 499 grace =
 500 #(def-grace-function startGraceMusic stopGraceMusic
 501    (_i "Insert @var{music} as grace notes."))
 502
 503 grobdescriptions =
 504 #(define-scheme-function (descriptions) (list?)
 505    (_i "Create a context modification from @var{descriptions}, a list
 506 in the format of @code{all-grob-descriptions}.")
 507    (ly:make-context-mod
 508     (map (lambda (p)
 509            (list 'assign (car p) (ly:make-grob-properties (cdr p))))
 510          descriptions)))
 511
 512 harmonicByFret = #(define-music-function (fret music) (number? ly:music?)
 513   (_i "Convert @var{music} into mixed harmonics; the resulting notes resemble
 514 harmonics played on a fretted instrument by touching the strings at @var{fret}.")
 515   #{
 516     \set harmonicDots = ##t
 517     \temporary \override TabNoteHead.stencil = #(tab-note-head::print-custom-fret-label (number->string fret))
 518     \temporary \override NoteHead.Y-extent = #grob::always-Y-extent-from-stencil
 519     \temporary \override NoteHead.stencil = #(lambda (grob) (ly:grob-set-property! grob 'style 'harmonic-mixed)
 520                                             (ly:note-head::print grob))
 521     #(make-harmonic
 522        (calc-harmonic-pitch (fret->pitch (number->string fret)) music))
 523     \unset harmonicDots
 524     \revert TabNoteHead.stencil
 525     \revert NoteHead.Y-extent
 526     \revert NoteHead.stencil
 527   #})
 528
 529 harmonicByRatio = #(define-music-function (ratio music) (number? ly:music?)
 530     (_i "Convert @var{music} into mixed harmonics; the resulting notes resemble
 531 harmonics played on a fretted instrument by touching the strings at the point
 532 given through @var{ratio}.")
 533   #{
 534     \set harmonicDots = ##t
 535     \temporary \override TabNoteHead.stencil = #(tab-note-head::print-custom-fret-label (ratio->fret ratio))
 536     \temporary \override NoteHead.Y-extent = #(ly:make-unpure-pure-container ly:grob::stencil-height)
 537     \temporary \override NoteHead.stencil = #(lambda (grob) (ly:grob-set-property! grob 'style 'harmonic-mixed)
 538                                             (ly:note-head::print grob))
 539     #(make-harmonic
 540       (calc-harmonic-pitch (ratio->pitch ratio) music))
 541     \unset harmonicDots
 542     \revert TabNoteHead.stencil
 543     \revert NoteHead.Y-extent
 544     \revert NoteHead.stencil
 545   #})
 546
 547 hide =
 548 #(define-music-function (item) (symbol-list-or-music?)
 549    (_i "Set @var{item}'s @samp{transparent} property to @code{#t},
 550 making it invisible while still retaining its dimensions.
 551
 552 If @var{item} is a symbol list of form @code{GrobName} or
 553 @code{Context.GrobName}, the result is an override for the grob name
 554 specified by it.  If @var{item} is a music expression, the result is
 555 the same music expression with an appropriate tweak applied to it.")
 556    (propertyTweak 'transparent #t item))
 557
 558 inStaffSegno =
 559 #(define-music-function () ()
 560    (_i "Put the segno variant 'varsegno' at this position into the staff,
 561 compatible with the repeat command.")
 562    (make-music 'ApplyContext
 563                'procedure
 564                (lambda (ctx)
 565                  (let ((score-ctx (ly:context-find ctx 'Score)))
 566                    (if (ly:context? score-ctx)
 567                      (let ((old-rc (ly:context-property score-ctx 'repeatCommands '())))
 568                        (if (eq? (memq 'segno-display old-rc) #f)
 569                          (ly:context-set-property! score-ctx 'repeatCommands (cons 'segno-display old-rc)))))))))
 570
 571 instrumentSwitch =
 572 #(define-music-function
 573    (name) (string?)
 574    (_i "Switch instrument to @var{name}, which must be predefined with
 575 @code{\\addInstrumentDefinition}.")
 576    (let* ((handle (assoc name instrument-definitions))
 577           (instrument-def (if handle (cdr handle) '())))
 578
 579      (if (not handle)
 580          (ly:input-warning (*location*) "No such instrument: ~a" name))
 581      (context-spec-music
 582       (make-music 'SimultaneousMusic
 583                   'elements
 584                   (map (lambda (kv)
 585                          (make-property-set
 586                           (car kv)
 587                           (cdr kv)))
 588                        instrument-def))
 589       'Staff)))
 590
 591
 592
 593 keepWithTag =
 594 #(define-music-function (tags music)
 595    (symbol-list-or-symbol? ly:music?)
 596    (_i "Include only elements of @var{music} that are tagged with one
 597 of the tags in @var{tags}.  @var{tags} may be either a single symbol
 598 or a list of symbols.
 599
 600 Each tag may be declared as a member of at most one tag group (defined
 601 with @code{\\tagGroup}).  If none of a @var{music} element's tags
 602 share a tag group with one of the specified @var{tags}, the element is
 603 retained.")
 604    (music-filter
 605     (tags-keep-predicate tags)
 606     music))
 607
 608 key =
 609 #(define-music-function (tonic pitch-alist)
 610    ((ly:pitch? '()) (list? '()))
 611    (_i "Set key to @var{tonic} and scale @var{pitch-alist}.
 612 If both are null, just generate @code{KeyChangeEvent}.")
 613    (cond ((null? tonic) (make-music 'KeyChangeEvent))
 614          ((null? pitch-alist)
 615           (ly:parser-error (_ "second argument must be pitch list")
 616                            (*location*))
 617           (make-music 'SequentialMusic 'void #t))
 618          (else
 619           (ly:music-transpose
 620            (make-music 'KeyChangeEvent
 621                 'tonic (ly:make-pitch 0 0 0)
 622                 'pitch-alist pitch-alist)
 623            tonic))))
 624
 625 killCues =
 626 #(define-music-function (music) (ly:music?)
 627    (_i "Remove cue notes from @var{music}.")
 628    (music-map
 629     (lambda (mus)
 630       (if (and (string? (ly:music-property mus 'quoted-music-name))
 631                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
 632           (ly:music-property mus 'element)
 633           mus))
 634     music))
 635
 636
 637
 638 label =
 639 #(define-music-function (label) (symbol?)
 640    (_i "Create @var{label} as a bookmarking label.")
 641    (make-music 'EventChord
 642                'page-marker #t
 643                'page-label label
 644                'elements (list (make-music 'LabelEvent
 645                                            'page-label label))))
 646
 647
 648 language =
 649 #(define-void-function (language) (string?)
 650    (_i "Set note names for language @var{language}.")
 651    (note-names-language language))
 652
 653 languageSaveAndChange =
 654 #(define-void-function (language) (string?)
 655   (_i "Store the previous pitchnames alist, and set a new one.")
 656   (set! previous-pitchnames pitchnames)
 657   (note-names-language language))
 658
 659 languageRestore =
 660 #(define-void-function () ()
 661    (_i "Restore a previously-saved pitchnames alist.")
 662    (if previous-pitchnames
 663        (begin
 664         (set! pitchnames previous-pitchnames)
 665         (ly:parser-set-note-names pitchnames))
 666       (ly:input-warning (*location*) (_ "No other language was defined previously. Ignoring."))))
 667
 668
 669 magnifyMusic =
 670 #(define-music-function (mag music) (positive? ly:music?)
 671    (_i "Magnify the notation of @var{music} without changing the
 672 staff-size, using @var{mag} as a size factor.  Stems, beams,
 673 slurs, ties, and horizontal spacing are adjusted automatically.")
 674
 675    ;; these props are NOT allowed to shrink below default size
 676    (define unshrinkable-props
 677      '(
 678        ;; stems
 679        (Stem thickness)
 680
 681        ;; slurs
 682        (Slur line-thickness)
 683        (Slur thickness)
 684        (PhrasingSlur line-thickness)
 685        (PhrasingSlur thickness)
 686
 687        ;; ties
 688        (Tie line-thickness)
 689        (Tie thickness)
 690        (LaissezVibrerTie line-thickness)
 691        (LaissezVibrerTie thickness)
 692        (RepeatTie line-thickness)
 693        (RepeatTie thickness)
 694        ))
 695
 696    ;; these props ARE allowed to shrink below default size
 697    (define shrinkable-props
 698      (let ((baseline-skip-props
 699              (find-named-props 'baseline-skip all-grob-descriptions))
 700            (word-space-props
 701              (find-named-props 'word-space all-grob-descriptions)))
 702        (append
 703          baseline-skip-props
 704          word-space-props
 705          '(
 706            ;; TODO: uncomment spacing-increment here once Issue 3987 is fixed
 707            ;; override at the 'Score level
 708            ;(SpacingSpanner spacing-increment)
 709
 710            ;; lengths and heights
 711            (Beam length-fraction)
 712            (Stem length-fraction)
 713            (Stem beamlet-default-length)
 714            (Stem double-stem-separation)
 715            (Slur height-limit)
 716            (Slur minimum-length)
 717            (PhrasingSlur height-limit)
 718            (PhrasingSlur minimum-length)
 719
 720            ;; Beam.beam-thickness is dealt with separately below
 721            ))))
 722    #{
 723      \context Bottom {
 724        %% TODO: uncomment \newSpacingSection once Issue 3990 is fixed
 725        %\newSpacingSection
 726        #(scale-fontSize 'magnifyMusic mag)
 727        #(scale-props    'magnifyMusic mag #f unshrinkable-props)
 728        #(scale-props    'magnifyMusic mag #t shrinkable-props)
 729        #(scale-beam-thickness mag)
 730
 731        #music
 732
 733        %% TODO: uncomment \newSpacingSection once Issue 3990 is fixed
 734        %\newSpacingSection
 735        %% reverse engineer the former fontSize value instead of using \unset
 736        #(revert-fontSize 'magnifyMusic mag)
 737        #(revert-props    'magnifyMusic mag (append unshrinkable-props
 738                                                    shrinkable-props
 739                                                    '((Beam beam-thickness))))
 740      }
 741    #})
 742
 743 magnifyStaff =
 744 #(define-music-function (mag) (positive?)
 745    (_i "Change the size of the staff, adjusting notation size and
 746 horizontal spacing automatically, using @var{mag} as a size factor.")
 747
 748    ;; these props are NOT allowed to shrink below default size
 749    (define unshrinkable-props
 750      '((StaffSymbol thickness)))
 751
 752    ;; these props ARE allowed to shrink below default size
 753    (define shrinkable-props
 754      (let* ((baseline-skip-props
 755               (find-named-props 'baseline-skip all-grob-descriptions))
 756             (word-space-props
 757               (find-named-props 'word-space all-grob-descriptions))
 758             (space-alist-props
 759               (find-named-props 'space-alist all-grob-descriptions)))
 760        (append
 761          baseline-skip-props
 762          word-space-props
 763          space-alist-props
 764          '(
 765            ;; override at the 'Score level
 766            (SpacingSpanner spacing-increment)
 767
 768            (StaffSymbol staff-space)
 769            (BarLine kern)
 770            (BarLine segno-kern)
 771            (BarLine hair-thickness)
 772            (BarLine thick-thickness)
 773            (Stem beamlet-default-length)
 774            (Stem double-stem-separation)
 775            ))))
 776
 777    #{
 778      \stopStaff
 779
 780      %% revert settings from last time
 781      %% (but only if \magnifyStaff has already been used
 782      %% and the staff magnification is changing)
 783      #(revert-fontSize 'magnifyStaff mag)
 784      #(revert-props    'magnifyStaff mag (append unshrinkable-props
 785                                                  shrinkable-props))
 786
 787      %% scale settings
 788      %% (but only if staff magnification is changing
 789      %% and does not equal 1)
 790      #(scale-fontSize 'magnifyStaff mag)
 791      #(scale-props    'magnifyStaff mag #f unshrinkable-props)
 792      #(scale-props    'magnifyStaff mag #t shrinkable-props)
 793
 794      %% this might cause problems until Issue 3990 is fixed
 795      \newSpacingSection
 796
 797      \startStaff
 798      \set Staff.magnifyStaffValue = #mag
 799    #})
 800
 801 makeClusters =
 802 #(define-music-function (arg) (ly:music?)
 803    (_i "Display chords in @var{arg} as clusters.")
 804    (music-map note-to-cluster arg))
 805
 806 modalInversion =
 807 #(define-music-function (around to scale music)
 808     (ly:pitch? ly:pitch? ly:music? ly:music?)
 809     (_i "Invert @var{music} about @var{around} using @var{scale} and
 810 transpose from @var{around} to @var{to}.")
 811     (let ((inverter (make-modal-inverter around to scale)))
 812       (change-pitches music inverter)
 813       music))
 814
 815 modalTranspose =
 816 #(define-music-function (from to scale music)
 817     (ly:pitch? ly:pitch? ly:music? ly:music?)
 818     (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
 819 using @var{scale}.")
 820     (let ((transposer (make-modal-transposer from to scale)))
 821       (change-pitches music transposer)
 822       music))
 823
 824 inversion =
 825 #(define-music-function
 826    (around to music) (ly:pitch? ly:pitch? ly:music?)
 827    (_i "Invert @var{music} about @var{around} and
 828 transpose from @var{around} to @var{to}.")
 829    (music-invert around to music))
 830
 831 mark =
 832 #(define-music-function
 833    (label) ((number-or-markup?))
 834   "Make the music for the \\mark command."
 835   (let* ((set (and (integer? label)
 836                    (context-spec-music (make-property-set 'rehearsalMark label)
 837                                       'Score)))
 838          (ev (make-music 'MarkEvent
 839                          'origin (*location*))))
 840
 841     (if set
 842         (make-sequential-music (list set ev))
 843         (begin
 844           (if label (set! (ly:music-property ev 'label) label))
 845           ev))))
 846
 847 markupMap =
 848 #(define-music-function (path markupfun music)
 849    (symbol-list-or-symbol? markup-function? ly:music?)
 850    (_i "This applies the given markup function @var{markupfun} to all markup
 851 music properties matching @var{path} in @var{music}.
 852
 853 For example,
 854 @example
 855 \\new Voice @{ g'2 c'' @}
 856 \\addlyrics @{
 857   \\markupMap LyricEvent.text
 858              \\markup \\with-color #red \\etc
 859              @{ Oh yes! @}
 860 @}
 861 @end example
 862 ")
 863    (let* ((p (check-music-path path (*location*)))
 864           (name (and p (car p)))
 865           (prop (and p (cadr p))))
 866      (if p
 867          (for-some-music
 868           (lambda (m)
 869             (if (or (not name) (eq? (ly:music-property m 'name) name))
 870                 (let ((text (ly:music-property m prop)))
 871                   (if (markup? text)
 872                       (set! (ly:music-property m prop)
 873                             (list markupfun text)))))
 874             #f)
 875           music)))
 876    music)
 877
 878 musicMap =
 879 #(define-music-function (proc mus) (procedure? ly:music?)
 880    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
 881    (music-map proc mus))
 882
 883 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 884 %% because music identifiers are not allowed at top-level.
 885 noPageBreak =
 886 #(define-music-function () ()
 887    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
 888 markups), or inside a score.")
 889    (make-music 'EventChord
 890                'page-marker #t
 891                'page-break-permission 'forbid
 892                'elements (list (make-music 'PageBreakEvent
 893                                            'break-permission '()))))
 894
 895 noPageTurn =
 896 #(define-music-function () ()
 897    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
 898 markups), or inside a score.")
 899    (make-music 'EventChord
 900                'page-marker #t
 901                'page-turn-permission 'forbid
 902                'elements (list (make-music 'PageTurnEvent
 903                                            'break-permission '()))))
 904
 905
 906
 907 octaveCheck =
 908 #(define-music-function (pitch) (ly:pitch?)
 909    (_i "Octave check.")
 910    (make-music 'RelativeOctaveCheck
 911                'pitch pitch))
 912
 913 offset =
 914 #(define-music-function (property offsets item)
 915   (symbol-list-or-symbol? scheme? key-list-or-music?)
 916    (_i "Offset the default value of @var{property} of @var{item} by
 917 @var{offsets}.  If @var{item} is a string, the result is
 918 @code{\\override} for the specified grob type.  If @var{item} is
 919 a music expression, the result is the same music expression with an
 920 appropriate tweak applied.")
 921   (if (ly:music? item)
 922       ; In case of a tweak, grob property path is Grob.property
 923       (let ((prop-path (check-grob-path
 924                          (if (symbol? property)
 925                              (list property)
 926                              property) (*location*)
 927                          #:start 1 #:default #t #:min 2 #:max 2)))
 928         (if prop-path
 929             ; If the head of the grob property path is a symbol--i.e.,
 930             ; a grob name, produce a directed tweak.  Otherwise, create
 931             ; an ordinary tweak.
 932             (if (symbol? (car prop-path))
 933                 (tweak prop-path (offsetter (second prop-path) offsets) item)
 934                 (tweak (second prop-path)
 935                        (offsetter (second prop-path) offsets)
 936                        item))
 937             item))
 938       ; In case of an override, grob property path is Context.Grob.property.
 939       (let ((prop-path (check-grob-path
 940                          (append item
 941                                  (if (symbol? property)
 942                                      (list property)
 943                                      property)) (*location*)
 944                          #:default 'Bottom #:min 3 #:max 3)))
 945         (if prop-path
 946             (propertyOverride prop-path (offsetter (third prop-path) offsets))
 947             (make-music 'Music)))))
 948
 949 omit =
 950 #(define-music-function (item) (symbol-list-or-music?)
 951    (_i "Set @var{item}'s @samp{stencil} property to @code{#f},
 952 effectively omitting it without taking up space.
 953
 954 If @var{item} is a symbol list of form @code{GrobName} or
 955 @code{Context.GrobName}, the result is an override for the grob name
 956 specified by it.  If @var{item} is a music expression, the result is
 957 the same music expression with an appropriate tweak applied to it.")
 958    (propertyTweak 'stencil #f item))
 959
 960 once =
 961 #(define-music-function (music) (ly:music?)
 962    (_i "Set @code{once} to @code{#t} on all layout instruction events
 963 in @var{music}.  This will complain about music with an actual
 964 duration.  As a special exception, if @var{music} contains
 965 @samp{tweaks} it will be silently ignored in order to allow for
 966 @code{\\once \\propertyTweak} to work as both one-time override and proper
 967 tweak.")
 968    (if (not (pair? (ly:music-property music 'tweaks)))
 969        (for-some-music
 970         (lambda (m)
 971           (cond ((music-is-of-type? m 'layout-instruction-event)
 972                  (set! (ly:music-property m 'once) #t)
 973                  #t)
 974                 ((ly:duration? (ly:music-property m 'duration))
 975                  (ly:music-warning m (_ "Cannot apply \\once to timed music"))
 976                  #t)
 977                 (else #f)))
 978         music))
 979    music)
 980
 981 ottava =
 982 #(define-music-function (octave) (integer?)
 983    (_i "Set the octavation.")
 984    (make-music 'OttavaMusic
 985                'ottava-number octave))
 986
 987 overrideTimeSignatureSettings =
 988 #(define-music-function
 989    (time-signature base-moment beat-structure beam-exceptions)
 990    (fraction? fraction? list? list?)
 991
 992    (_i "Override @code{timeSignatureSettings}
 993 for time signatures of @var{time-signature} to have settings
 994 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 995
 996    ;; TODO -- add warning if largest value of grouping is
 997    ;;       greater than time-signature.
 998   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
 999     (override-time-signature-setting time-signature setting)))
1000
1001 overrideProperty =
1002 #(define-music-function (grob-property-path value)
1003    (key-list? scheme?)
1004
1005    (_i "Set the grob property specified by @var{grob-property-path} to
1006 @var{value}.  @var{grob-property-path} is a symbol list of the form
1007 @code{Context.GrobName.property} or @code{GrobName.property}, possibly
1008 with subproperties given as well.
1009
1010 As opposed to @code{\\override} which overrides the context-dependent
1011 defaults with which a grob is created, this command uses
1012 @code{Output_property_engraver} at the grob acknowledge stage.  This
1013 may be necessary for overriding values set after the initial grob
1014 creation.")
1015    (let ((p (check-grob-path grob-property-path (*location*)
1016                              #:default 'Bottom
1017                              #:min 3)))
1018      (if p
1019          (make-music 'ApplyOutputEvent
1020                      'context-type (first p)
1021                      'symbol (second p)
1022                      'procedure
1023                      (lambda (grob orig-context context)
1024                        (ly:grob-set-nested-property! grob (cddr p) value)))
1025          (make-music 'Music))))
1026
1027
1028
1029
1030
1031
1032 %% pageBreak and pageTurn are music functions (iso music indentifiers),
1033 %% because music identifiers are not allowed at top-level.
1034 pageBreak =
1035 #(define-music-function () ()
1036    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
1037 markups), or inside a score.")
1038    (make-music 'EventChord
1039                'page-marker #t
1040                'line-break-permission 'force
1041                'page-break-permission 'force
1042                'elements (list (make-music 'LineBreakEvent
1043                                            'break-permission 'force)
1044                                (make-music 'PageBreakEvent
1045                                            'break-permission 'force))))
1046
1047 pageTurn =
1048 #(define-music-function () ()
1049    (_i "Force a page turn between two scores or top-level markups.")
1050    (make-music 'EventChord
1051                'page-marker #t
1052                'line-break-permission 'force
1053                'page-break-permission 'force
1054                'page-turn-permission 'force
1055                'elements (list (make-music 'LineBreakEvent
1056                                            'break-permission 'force)
1057                                (make-music 'PageBreakEvent
1058                                            'break-permission 'force)
1059                                (make-music 'PageTurnEvent
1060                                            'break-permission 'force))))
1061
1062 parallelMusic =
1063 #(define-void-function (voice-ids music) (list? ly:music?)
1064    (_i "Define parallel music sequences, separated by '|' (bar check signs),
1065 and assign them to the identifiers provided in @var{voice-ids}.
1066
1067 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
1068
1069 @var{music}: a music sequence, containing BarChecks as limiting expressions.
1070
1071 Example:
1072
1073 @verbatim
1074   \\parallelMusic #'(A B C) {
1075     c c | d d | e e |
1076     d d | e e | f f |
1077   }
1078 <==>
1079   A = { c c | d d }
1080   B = { d d | e e }
1081   C = { e e | f f }
1082 @end verbatim
1083
1084 The last bar checks in a sequence are not copied to the result in
1085 order to facilitate ending the last entry at non-bar boundaries.
1086 ")
1087    (define voice-count (length voice-ids))
1088    (define (bar-check? m)
1089      "Checks whether m is a bar check."
1090      (eq? (ly:music-property m 'name) 'BarCheck))
1091    (define (recurse-and-split-list lst)
1092      "Return either a list of music lists split along barchecks, or @code{#f}."
1093      (if (any bar-check? lst)
1094          (let* ((voices (apply circular-list (make-list voice-count '())))
1095                 (current-voices voices)
1096                 (current-sequence '()))
1097            ;;
1098            ;; utilities
1099            (define (push-music m)
1100              "Push the music expression into the current sequence"
1101              (set! current-sequence (cons m current-sequence)))
1102            (define (change-voice)
1103              "Store the previously built sequence into the current voice and
1104 change to the following voice."
1105              (set-car! current-voices
1106                        (cons current-sequence
1107                              (car current-voices)))
1108              (set! current-sequence '())
1109              (set! current-voices (cdr current-voices)))
1110            (for-each (lambda (m)
1111                        (let ((split? (recurse-and-split m)))
1112                          (if split?
1113                              (for-each
1114                               (lambda (m)
1115                                 (push-music m)
1116                                 (change-voice))
1117                               split?)
1118                              (begin
1119                                (push-music m)
1120                                (if (bar-check? m) (change-voice))))))
1121                      lst)
1122            (if (pair? current-sequence) (change-voice))
1123            ;; Un-circularize voices
1124            (set! voices (list-head voices voice-count))
1125
1126            ;; Remove trailing bar checks to facilitate ending a
1127            ;; sequence on a non-bar, reverse partial sequences and sequences
1128            (set! voices (map!
1129                          (lambda (l)
1130                            (map! reverse!
1131                                  (reverse!
1132                                   (if (and (pair? l) (pair? (car l))
1133                                            (bar-check? (caar l)))
1134                                       (cons (cdar l) (cdr l))
1135                                       l))))
1136                          voices))
1137
1138            ;; check sequence length
1139            (apply for-each (lambda seqs
1140                              (define (seq-len seq)
1141                                (reduce ly:moment-add
1142                                        (ly:make-moment 0)
1143                                        (map ly:music-length seq)))
1144                              (let ((moment-reference (seq-len (car seqs))))
1145                                (for-each (lambda (seq)
1146                                            (if (not (equal? (seq-len seq)
1147                                                             moment-reference))
1148                                                (ly:music-warning
1149                                                 (if (pair? seq)
1150                                                     (last seq)
1151                                                     (caar seqs))
1152                                                 (_ "Bars in parallel music don't have the same length"))))
1153                                          seqs)))
1154                   voices)
1155            (map concatenate! voices))
1156          (let ((deeper (map recurse-and-split lst)))
1157            (and (any pair? deeper)
1158                 (apply zip (map
1159                             (lambda (m split)
1160                               (or split
1161                                   (ly:music-deep-copy (make-list voice-count m))))
1162                             lst deeper))))))
1163    (define (recurse-and-split music)
1164      "This returns either a list of music split along barchecks, or
1165 @code{#f}."
1166      (let* ((elt (ly:music-property music 'element))
1167             (elts (ly:music-property music 'elements))
1168             (split-elt (and (ly:music? elt) (recurse-and-split elt)))
1169             (split-elts (and (pair? elts) (recurse-and-split-list elts))))
1170        (and (or split-elt split-elts)
1171             (map
1172              (lambda (e es)
1173                (let ((m (ly:music-deep-copy music
1174                        ;;; reassigning the origin of the parent only
1175                        ;;; makes sense if the first expression in the
1176                        ;;; result is from a distributed origin
1177                                             (or (and (ly:music? e) e)
1178                                                 (and (pair? es) (car es))))))
1179                  (if (ly:music? e)
1180                      (set! (ly:music-property m 'element) e))
1181                  (if (pair? es)
1182                      (set! (ly:music-property m 'elements) es))
1183                  m))
1184              (or split-elt (circular-list #f))
1185              (or split-elts (circular-list #f))))))
1186    (let ((voices (recurse-and-split music)))
1187      (if voices
1188          ;;
1189          ;; bind voice identifiers to the voices
1190          (for-each (lambda (voice-id voice)
1191                      (ly:parser-define! voice-id voice))
1192                    voice-ids voices)
1193          (ly:music-warning music
1194                            (_ "ignoring parallel music without barchecks")))))
1195
1196 parenthesize =
1197 #(define-music-function (arg) (ly:music?)
1198    (_i "Tag @var{arg} to be parenthesized.")
1199
1200    (if (memq 'event-chord (ly:music-property arg 'types))
1201        ;; arg is an EventChord -> set the parenthesize property
1202        ;; on all child notes and rests
1203        (for-each
1204         (lambda (ev)
1205           (if (or (memq 'note-event (ly:music-property ev 'types))
1206                   (memq 'rest-event (ly:music-property ev 'types)))
1207               (set! (ly:music-property ev 'parenthesize) #t)))
1208         (ly:music-property arg 'elements))
1209        ;; No chord, simply set property for this expression:
1210        (set! (ly:music-property arg 'parenthesize) #t))
1211    arg)
1212
1213 #(define (make-directed-part-combine-music direction chord-range part1 part2
1214           one-context-settings
1215           two-context-settings
1216           shared-context-settings)
1217
1218    (let* ((pc-music (make-music 'PartCombineMusic))
1219           (m1 (context-spec-music (make-non-relative-music part1) 'Voice "one"))
1220           (m2 (context-spec-music (make-non-relative-music part2) 'Voice "two"))
1221           (listener (ly:parser-lookup 'partCombineListener))
1222           (evs2 (recording-group-emulate m2 listener))
1223           (evs1 (recording-group-emulate m1 listener))
1224           (split-list
1225            (if (and (assoc "one" evs1) (assoc "two" evs2))
1226                (determine-split-list (reverse! (assoc-get "one" evs1) '())
1227                                      (reverse! (assoc-get "two" evs2) '())
1228                                      chord-range)
1229                '()))
1230           (L1 (ly:music-length part1))
1231           (L2 (ly:music-length part2))
1232           ;; keep the contexts alive for the full duration
1233           (skip (make-skip-music (make-duration-of-length
1234                                   (if (ly:moment<? L1 L2) L2 L1)))))
1235
1236      (set! (ly:music-property pc-music 'elements)
1237            (list (make-music
1238                   'PartCombinePartMusic
1239                   'element m1
1240                   'context-change-list
1241                   (make-part-combine-context-changes
1242                    default-part-combine-context-change-state-machine-one
1243                    split-list))
1244                  (make-music
1245                   'PartCombinePartMusic
1246                   'element m2
1247                   'context-change-list
1248                   (make-part-combine-context-changes
1249                    default-part-combine-context-change-state-machine-two
1250                    split-list))))
1251
1252      (set! (ly:music-property pc-music 'direction) direction)
1253
1254      #{ \context Staff <<
1255           \context Voice = "one" \with #one-context-settings { #skip }
1256           \context Voice = "two" \with #two-context-settings { #skip }
1257           \context Voice = "shared" \with #shared-context-settings { #skip }
1258           \context Voice = "solo" { #skip }
1259           \context NullVoice = "null" { #skip }
1260           #pc-music
1261           #(make-part-combine-marks
1262             default-part-combine-mark-state-machine split-list)
1263         >> #} ))
1264
1265 partcombine =
1266 #(define-music-function (chord-range part1 part2)
1267    ((number-pair? '(0 . 8)) ly:music? ly:music?)
1268    (_i "Take the music in @var{part1} and @var{part2} and return
1269 a music expression containing simultaneous voices, where @var{part1}
1270 and @var{part2} are combined into one voice where appropriate.
1271 Optional @var{chord-range} sets the distance in steps between notes
1272 that may be combined into a chord or unison.")
1273    (make-directed-part-combine-music #f chord-range part1 part2
1274     #{ \with { \voiceOne \override DynamicLineSpanner.direction = #UP } #}
1275     #{ \with { \voiceTwo \override DynamicLineSpanner.direction = #DOWN } #}
1276     #{ #} ))
1277
1278 partcombineUp =
1279 #(define-music-function (chord-range part1 part2)
1280    ((number-pair? '(0 . 8)) ly:music? ly:music?)
1281    (_i "Take the music in @var{part1} and @var{part2} and typeset so
1282 that they share a staff with stems directed upward.")
1283    (make-directed-part-combine-music UP chord-range part1 part2
1284     #{ \with { \voiceOne \override DynamicLineSpanner.direction = #UP } #}
1285     #{ \with { \voiceThree \override DynamicLineSpanner.direction = #UP } #}
1286     #{ \with { \voiceOne \override DynamicLineSpanner.direction = #UP } #} ))
1287
1288 partcombineDown =
1289 #(define-music-function (chord-range part1 part2)
1290    ((number-pair? '(0 . 8)) ly:music? ly:music?)
1291    (_i "Take the music in @var{part1} and @var{part2} and typeset so
1292 that they share a staff with stems directed downward.")
1293    (make-directed-part-combine-music DOWN chord-range part1 part2
1294     #{ \with { \voiceFour \override DynamicLineSpanner.direction = #DOWN } #}
1295     #{ \with { \voiceTwo \override DynamicLineSpanner.direction = #DOWN } #}
1296     #{ \with { \voiceTwo \override DynamicLineSpanner.direction = #DOWN } #} ))
1297
1298 %% Part combine forcing to be found in ly/property-init.ly
1299
1300 partial =
1301 #(define-music-function (dur) (ly:duration?)
1302   (_i "Make a partial measure.")
1303
1304   ;; We use `descend-to-context' here instead of `context-spec-music' to
1305   ;; ensure \partial still works if the Timing_translator is moved
1306     (descend-to-context
1307      (context-spec-music (make-music 'PartialSet
1308                                      'origin (*location*)
1309                                      'duration dur)
1310                          'Timing)
1311      'Score))
1312
1313 pitchedTrill =
1314 #(define-music-function
1315    (main-note secondary-note)
1316    (ly:music? ly:music?)
1317    (_i "Print a trill with @var{main-note} as the main note of the trill and
1318 print @var{secondary-note} as a stemless note head in parentheses.")
1319    (let* ((get-notes (lambda (ev-chord)
1320                        (extract-named-music ev-chord 'NoteEvent)))
1321           (sec-note-events (get-notes secondary-note))
1322           (trill-events (extract-named-music main-note 'TrillSpanEvent)))
1323      (if (pair? sec-note-events)
1324          (begin
1325            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
1326                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
1327
1328              (if (ly:pitch? trill-pitch)
1329                  (for-each (lambda (m)
1330                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
1331                  (begin
1332                    (ly:input-warning (*location*) (_ "Second argument of \\pitchedTrill should be single note: "))
1333                    (display sec-note-events)))
1334
1335              (if (eq? forced #t)
1336                  (for-each (lambda (m)
1337                              (ly:music-set-property! m 'force-accidental forced))
1338                            trill-events)))))
1339      main-note))
1340
1341 propertyOverride =
1342 #(define-music-function (grob-property-path value)
1343    (key-list? scheme?)
1344    (_i "Set the grob property specified by @var{grob-property-path} to
1345 @var{value}.  @var{grob-property-path} is a symbol list of the form
1346 @code{Context.GrobName.property} or @code{GrobName.property}, possibly
1347 with subproperties given as well.  This music function is mostly intended
1348 for use from Scheme as a substitute for the built-in @code{\\override}
1349 command.")
1350    (let ((p (check-grob-path grob-property-path (*location*)
1351                              #:default 'Bottom
1352                              #:min 3)))
1353      (if p
1354          (context-spec-music
1355           (make-music 'OverrideProperty
1356                       'symbol (cadr p)
1357                       'origin (*location*)
1358                       'grob-value value
1359                       'grob-property-path (cddr p)
1360                       'pop-first #t)
1361           (car p))
1362          (make-music 'Music))))
1363
1364 propertyRevert =
1365 #(define-music-function (grob-property-path)
1366    (key-list?)
1367    (_i "Revert the grob property specified by @var{grob-property-path} to
1368 its previous value.  @var{grob-property-path} is a symbol list of the form
1369 @code{Context.GrobName.property} or @code{GrobName.property}, possibly
1370 with subproperties given as well.  This music function is mostly intended
1371 for use from Scheme as a substitute for the built-in @code{\\revert}
1372 command.")
1373    (let ((p (check-grob-path grob-property-path (*location*)
1374                              #:default 'Bottom
1375                              #:min 3)))
1376      (if p
1377          (context-spec-music
1378           (make-music 'RevertProperty
1379                       'symbol (cadr p)
1380                       'origin (*location*)
1381                       'grob-property-path (cddr p))
1382           (car p))
1383          (make-music 'Music))))
1384
1385 propertySet =
1386 #(define-music-function (property-path value)
1387    (symbol-list-or-symbol? scheme?)
1388    (_i "Set the context property specified by @var{property-path} to
1389 @var{value}.  This music function is mostly intended for use from
1390 Scheme as a substitute for the built-in @code{\\set} command.")
1391    (let ((p (check-context-path property-path (*location*))))
1392      (if p
1393          (context-spec-music
1394           (make-music 'PropertySet
1395                       'symbol (cadr p)
1396                       'value value
1397                       'origin (*location*))
1398           (car p))
1399          (make-music 'Music))))
1400
1401 propertyTweak =
1402 #(define-music-function (prop value item)
1403    (key-list-or-symbol? scheme? key-list-or-music?)
1404    (_i "Add a tweak to the following @var{item}, usually music.
1405 This generally behaves like @code{\\tweak} but will turn into an
1406 @code{\\override} when @var{item} is a symbol list.
1407
1408 In that case, @var{item} specifies the grob path to override.  This is
1409 mainly useful when using @code{\\propertyTweak} as as a component for
1410 building other functions like @code{\\omit}.  It is not the default
1411 behavior for @code{\\tweak} since many input strings in
1412 @code{\\lyricmode} can serve equally as music or as symbols which
1413 causes surprising behavior when tweaking lyrics using the less
1414 specific semantics of @code{\\propertyTweak}.
1415
1416 @var{prop} can contain additional elements in which case a nested
1417 property (inside of an alist) is tweaked.")
1418    ;; Why not instead make the parser treat strings preferably as
1419    ;; music in lyrics mode rather than as symbol?  Because then
1420    ;;
1421    ;; \tweak text "whatever" mylyrics
1422    ;;
1423    ;; will try putting a lyric event with text "whatever" in the text
1424    ;; property of lyrics.  So we want expressions allowing both
1425    ;; strings and lyrics to deliver strings: more complex conversions
1426    ;; should only be attempted when the simple uses don't match the
1427    ;; given predicate.
1428    (if (ly:music? item)
1429        (if (music-is-of-type? item 'context-specification)
1430            ;; This is essentially dealing with the case
1431            ;; \propertyTweak color #red \propertyTweak font-size #3 NoteHead
1432            ;; namely when stacked tweaks end in a symbol list
1433            ;; rather than a music expression.
1434            ;;
1435            ;; We have a tweak here to convert into an override,
1436            ;; so we need to know the grob to apply it to.  That's
1437            ;; easy if we have a directed tweak, and otherwise we
1438            ;; need to find the symbol in the expression itself.
1439            (let* ((p (check-grob-path prop (*location*)
1440                                       #:start 1
1441                                       #:default #t
1442                                       #:min 2))
1443                   (elt (ly:music-property item 'element))
1444                   (seq (if (music-is-of-type? elt 'sequential-music)
1445                            elt
1446                            (make-sequential-music (list elt))))
1447                   (elts (ly:music-property seq 'elements))
1448                   (symbol (if (symbol? (car p))
1449                               (car p)
1450                               (and (pair? elts)
1451                                    (ly:music-property (car elts)
1452                                                       'symbol)))))
1453              (if (symbol? symbol)
1454                  (begin
1455                    (set! (ly:music-property seq 'elements)
1456                          (cons (make-music 'OverrideProperty
1457                                            'symbol symbol
1458                                            'grob-property-path (cdr p)
1459                                            'pop-first #t
1460                                            'grob-value value
1461                                            'origin (*location*))
1462                                elts))
1463                    (set! (ly:music-property item 'element) seq))
1464                  (begin
1465                    (ly:parser-error (_ "Cannot \\propertyTweak")
1466                                     (*location*))
1467                    (ly:music-message item (_ "untweakable"))))
1468              item)
1469            (tweak prop value item))
1470        (propertyOverride (append item (if (symbol? prop) (list prop) prop))
1471                          value)))
1472
1473 propertyUnset =
1474 #(define-music-function (property-path)
1475    (symbol-list-or-symbol?)
1476    (_i "Unset the context property specified by @var{property-path}.
1477 This music function is mostly intended for use from Scheme as a
1478 substitute for the built-in @code{\\unset} command.")
1479    (let ((p (check-context-path property-path (*location*))))
1480      (if p
1481          (context-spec-music
1482           (make-music 'PropertyUnset
1483                       'symbol (cadr p)
1484                       'origin (*location*))
1485           (car p))
1486          (make-music 'Music))))
1487
1488 pushToTag =
1489 #(define-music-function (tag more music)
1490    (symbol? ly:music? ly:music?)
1491    (_i "Add @var{more} to the front of @code{elements} of all music
1492 expressions in @var{music} that are tagged with @var{tag}.")
1493    (music-map (lambda (m)
1494                 (if (memq tag (ly:music-property m 'tags))
1495                     (set! (ly:music-property m 'elements)
1496                           (cons more (ly:music-property m 'elements))))
1497                 m)
1498               music))
1499
1500 quoteDuring =
1501 #(define-music-function (what main-music) (string? ly:music?)
1502    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
1503 of the quoted voice, as specified in an @code{\\addQuote} command.
1504 @var{main-music} is used to indicate the length of music to be quoted;
1505 usually contains spacers or multi-measure rests.")
1506    (make-music 'QuoteMusic
1507                'element main-music
1508                'quoted-music-name what))
1509
1510 reduceChords =
1511 #(define-music-function (music) (ly:music?)
1512    (_i "Reduce chords contained in @var{music} to single notes,
1513 intended mainly for reusing music in RhythmicStaff.  Does not
1514 reduce parallel music.")
1515    (event-chord-reduce music))
1516
1517 relative =
1518 #(define-music-function (pitch music)
1519    ((ly:pitch?) ly:music?)
1520    (_i "Make @var{music} relative to @var{pitch}.  If @var{pitch} is
1521 omitted, the first note in @var{music} is given in absolute pitch.")
1522    ;; When \relative has no clear decision (can only happen with
1523    ;; scales with an even number of steps), it goes down (see
1524    ;; pitch.cc).  The following formula puts out f for both the normal
1525    ;; 7-step scale as well as for a "shortened" scale missing the
1526    ;; final b.  In either case, a first note of c will end up as c,
1527    ;; namely pitch (-1, 0, 0).
1528    (ly:make-music-relative! music
1529                             (or pitch
1530                                 (ly:make-pitch
1531                                  -1
1532                                  (quotient
1533                                   ;; size of current scale:
1534                                   (ly:pitch-steps (ly:make-pitch 1 0))
1535                                   2))))
1536    (make-music 'RelativeOctaveMusic
1537                'element music))
1538
1539 removeWithTag =
1540 #(define-music-function (tags music)
1541    (symbol-list-or-symbol? ly:music?)
1542    (_i "Remove elements of @var{music} that are tagged with one of the
1543 tags in @var{tags}.  @var{tags} may be either a single symbol or a list
1544 of symbols.")
1545    (music-filter
1546     (tags-remove-predicate tags)
1547     music))
1548
1549 resetRelativeOctave =
1550 #(define-music-function (pitch) (ly:pitch?)
1551    (_i "Set the octave inside a \\relative section.")
1552
1553    (make-music 'SequentialMusic
1554                'to-relative-callback
1555                (lambda (music last-pitch) pitch)))
1556
1557 retrograde =
1558 #(define-music-function (music)
1559     (ly:music?)
1560     (_i "Return @var{music} in reverse order.")
1561     (retrograde-music
1562      (expand-repeat-notes!
1563       (expand-repeat-chords!
1564        (cons 'rhythmic-event
1565              (ly:parser-lookup '$chord-repeat-events))
1566        music))))
1567
1568 revertTimeSignatureSettings =
1569 #(define-music-function
1570    (time-signature)
1571    (pair?)
1572
1573    (_i "Revert @code{timeSignatureSettings}
1574 for time signatures of @var{time-signature}.")
1575    (revert-time-signature-setting time-signature))
1576
1577 rightHandFinger =
1578 #(define-event-function (finger) (number-or-markup?)
1579    (_i "Apply @var{finger} as a fingering indication.")
1580
1581    (make-music
1582             'StrokeFingerEvent
1583             (if (number? finger) 'digit 'text)
1584             finger))
1585
1586 scaleDurations =
1587 #(define-music-function (fraction music)
1588    (fraction? ly:music?)
1589    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
1590    (ly:music-compress music
1591                       (ly:make-moment (car fraction) (cdr fraction))))
1592
1593 settingsFrom =
1594 #(define-scheme-function (ctx music)
1595    ((symbol?) ly:music?)
1596    (_i "Take the layout instruction events from @var{music}, optionally
1597 restricted to those applying to context type @var{ctx}, and return
1598 a context modification duplicating their effect.")
1599    (let ((mods (ly:make-context-mod)))
1600      (define (musicop m)
1601        (if (music-is-of-type? m 'layout-instruction-event)
1602            (ly:add-context-mod
1603             mods
1604             (case (ly:music-property m 'name)
1605               ((PropertySet)
1606                (list 'assign
1607                      (ly:music-property m 'symbol)
1608                      (ly:music-property m 'value)))
1609               ((PropertyUnset)
1610                (list 'unset
1611                      (ly:music-property m 'symbol)))
1612               ((OverrideProperty)
1613                (cons* 'push
1614                       (ly:music-property m 'symbol)
1615                       (ly:music-property m 'grob-value)
1616                       (cond
1617                        ((ly:music-property m 'grob-property #f) => list)
1618                        (else
1619                         (ly:music-property m 'grob-property-path)))))
1620               ((RevertProperty)
1621                (cons* 'pop
1622                       (ly:music-property m 'symbol)
1623                       (cond
1624                        ((ly:music-property m 'grob-property #f) => list)
1625                        (else
1626                         (ly:music-property m 'grob-property-path)))))))
1627            (case (ly:music-property m 'name)
1628              ((ApplyContext)
1629               (ly:add-context-mod mods
1630                                   (list 'apply
1631                                         (ly:music-property m 'procedure))))
1632              ((ContextSpeccedMusic)
1633               (if (or (not ctx)
1634                       (eq? ctx (ly:music-property m 'context-type)))
1635                   (musicop (ly:music-property m 'element))))
1636              (else
1637               (let ((callback (ly:music-property m 'elements-callback)))
1638                 (if (procedure? callback)
1639                     (for-each musicop (callback m))))))))
1640      (musicop music)
1641      mods))
1642
1643 shape =
1644 #(define-music-function (offsets item)
1645    (list? key-list-or-music?)
1646    (_i "Offset control-points of @var{item} by @var{offsets}.  The
1647 argument is a list of number pairs or list of such lists.  Each
1648 element of a pair represents an offset to one of the coordinates of a
1649 control-point.  If @var{item} is a string, the result is
1650 @code{\\once\\override} for the specified grob type.  If @var{item} is
1651 a music expression, the result is the same music expression with an
1652 appropriate tweak applied.")
1653    (define (shape-curve grob coords)
1654      (let* ((orig (ly:grob-original grob))
1655             (siblings (if (ly:spanner? grob)
1656                           (ly:spanner-broken-into orig) '()))
1657             (total-found (length siblings)))
1658        (define (offset-control-points offsets)
1659          (if (null? offsets)
1660              coords
1661              (map coord-translate coords offsets)))
1662
1663        (define (helper sibs offs)
1664          (if (pair? offs)
1665              (if (eq? (car sibs) grob)
1666                  (offset-control-points (car offs))
1667                  (helper (cdr sibs) (cdr offs)))
1668              coords))
1669
1670        ;; we work with lists of lists
1671        (if (or (null? offsets)
1672                (not (list? (car offsets))))
1673            (set! offsets (list offsets)))
1674
1675        (if (>= total-found 2)
1676            (helper siblings offsets)
1677            (offset-control-points (car offsets)))))
1678    (once (propertyTweak 'control-points
1679                         (grob-transformer 'control-points shape-curve)
1680                         item)))
1681
1682 shiftDurations =
1683 #(define-music-function (dur dots arg)
1684    (integer? integer? ly:music?)
1685    (_i "Change the duration of @var{arg} by adding @var{dur} to the
1686 @code{durlog} of @var{arg} and @var{dots} to the @code{dots} of @var{arg}.")
1687
1688    (shift-duration-log arg dur dots))
1689
1690 single =
1691 #(define-music-function (overrides music)
1692    (ly:music? ly:music?)
1693    (_i "Convert @var{overrides} to tweaks and apply them to @var{music}.
1694 This does not convert @code{\\revert}, @code{\\set} or @code{\\unset}.")
1695    (set! (ly:music-property music 'tweaks)
1696          (fold-some-music
1697           (lambda (m) (eq? (ly:music-property m 'name)
1698                            'OverrideProperty))
1699           (lambda (m tweaks)
1700             (let ((p (cond
1701                       ((ly:music-property m 'grob-property #f) => list)
1702                       (else
1703                        (ly:music-property m 'grob-property-path)))))
1704               (acons (cons (ly:music-property m 'symbol) ;grob name
1705                            (if (pair? (cdr p))
1706                                p ;grob property path
1707                                (car p))) ;grob property
1708                      (ly:music-property m 'grob-value)
1709                      tweaks)))
1710           (ly:music-property music 'tweaks)
1711           overrides))
1712    music)
1713
1714 skip =
1715 #(define-music-function (dur) (ly:duration?)
1716   (_i "Skip forward by @var{dur}.")
1717   (make-music 'SkipMusic
1718               'duration dur))
1719
1720
1721 slashedGrace =
1722 #(def-grace-function startSlashedGraceMusic stopSlashedGraceMusic
1723    (_i "Create slashed graces (slashes through stems, but no slur) from
1724 the following music expression"))
1725
1726 spacingTweaks =
1727 #(define-music-function (parameters) (list?)
1728    (_i "Set the system stretch, by reading the 'system-stretch property of
1729 the `parameters' assoc list.")
1730    (overrideProperty
1731     '(Score NonMusicalPaperColumn line-break-system-details)
1732     (list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
1733           (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))))
1734
1735 styledNoteHeads =
1736 #(define-music-function (style heads music)
1737    (symbol? symbol-list-or-symbol? ly:music?)
1738    (_i "Set @var{heads} in @var{music} to @var{style}.")
1739    (style-note-heads heads style music))
1740
1741 tag =
1742 #(define-music-function (tags music) (symbol-list-or-symbol? ly:music?)
1743    (_i "Tag the following @var{music} with @var{tags} and return the
1744 result, by adding the single symbol or symbol list @var{tags} to the
1745 @code{tags} property of @var{music}.")
1746
1747    (set!
1748     (ly:music-property music 'tags)
1749     ((if (symbol? tags) cons append)
1750      tags
1751      (ly:music-property music 'tags)))
1752    music)
1753
1754 tagGroup =
1755 #(define-void-function (tags) (symbol-list?)
1756    (_i "Define a tag group comprising the symbols in the symbol list
1757 @var{tags}.  Tag groups must not overlap.")
1758    (let ((err (define-tag-group tags)))
1759      (if err (ly:parser-error err (*location*)))))
1760
1761 temporary =
1762 #(define-music-function (music)
1763    (ly:music?)
1764    (_i "Make any @code{\\override} in @var{music} replace an existing
1765 grob property value only temporarily, restoring the old value when a
1766 corresponding @code{\\revert} is executed.  This is achieved by
1767 clearing the @samp{pop-first} property normally set on
1768 @code{\\override}s.
1769
1770 An @code{\\override}/@/@code{\\revert} sequence created by using
1771 @code{\\temporary} and @code{\\undo} on the same music containing
1772 overrides will cancel out perfectly or cause a@tie{}warning.
1773
1774 Non-property-related music is ignored, warnings are generated for any
1775 property-changing music that isn't an @code{\\override}.")
1776    (define warned #f)
1777    (for-some-music
1778     (lambda (m)
1779       (and (or (music-is-of-type? m 'layout-instruction-event)
1780                (music-is-of-type? m 'context-specification)
1781                (music-is-of-type? m 'apply-context)
1782                (music-is-of-type? m 'time-signature-music))
1783            (case (ly:music-property m 'name)
1784              ((OverrideProperty)
1785               (if (ly:music-property m 'pop-first #f)
1786                   (set! (ly:music-property m 'pop-first) '()))
1787               (if (ly:music-property m 'once #f)
1788                   (set! (ly:music-property m 'once) '()))
1789               #t)
1790              ((ContextSpeccedMusic)
1791               #f)
1792              (else
1793               (if (not warned)
1794                   (begin
1795                     (ly:input-warning (*location*) (_ "Cannot make ~a revertible")
1796                                       (ly:music-property m 'name))
1797                     (set! warned #t)))
1798               #t))))
1799     music)
1800    music)
1801
1802 time =
1803 #(define-music-function (beat-structure fraction)
1804    ((number-list? '()) fraction?)
1805    (_i "Set @var{fraction} as time signature, with optional
1806 number list @var{beat-structure} before it.")
1807   (make-music 'TimeSignatureMusic
1808               'numerator (car fraction)
1809               'denominator (cdr fraction)
1810               'beat-structure beat-structure))
1811
1812 times =
1813 #(define-music-function (fraction music)
1814    (fraction? ly:music?)
1815    (_i "Scale @var{music} in time by @var{fraction}.")
1816   (make-music 'TimeScaledMusic
1817               'element (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction)))
1818               'numerator (car fraction)
1819               'denominator (cdr fraction)))
1820
1821 transpose =
1822 #(define-music-function
1823    (from to music)
1824    (ly:pitch? ly:pitch? ly:music?)
1825
1826    (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}.")
1827    (make-music 'TransposedMusic
1828                'element (ly:music-transpose music (ly:pitch-diff to from))))
1829
1830 transposedCueDuring =
1831 #(define-music-function
1832    (what dir pitch main-music)
1833    (string? ly:dir? ly:pitch? ly:music?)
1834
1835    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
1836 using the transposition defined by @var{pitch}.  This happens
1837 simultaneously with @var{main-music}, which is usually a rest.  The
1838 argument @var{dir} determines whether the cue notes should be notated
1839 as a first or second voice.")
1840
1841    (make-music 'QuoteMusic
1842                'element main-music
1843                'quoted-context-type 'CueVoice
1844                'quoted-context-id "cue"
1845                'quoted-music-name what
1846                'quoted-voice-direction dir
1847                ;; following is inverse of instrumentTransposition for
1848                ;; historical reasons
1849                'quoted-transposition pitch))
1850
1851 transposition =
1852 #(define-music-function (pitch) (ly:pitch?)
1853    (_i "Set instrument transposition")
1854
1855    (context-spec-music
1856     (make-property-set 'instrumentTransposition pitch)
1857     'Staff))
1858
1859 tuplet =
1860 #(define-music-function (ratio tuplet-span music)
1861    (fraction? (ly:duration? '()) ly:music?)
1862    (_i "Scale the given @var{music} to tuplets.  @var{ratio} is a
1863 fraction that specifies how many notes are played in place of the
1864 nominal value: it will be @samp{3/2} for triplets, namely three notes
1865 being played in place of two.  If the optional duration
1866 @var{tuplet-span} is specified, it is used instead of
1867 @code{tupletSpannerDuration} for grouping the tuplets.
1868 For example,
1869 @example
1870 \\tuplet 3/2 4 @{ c8 c c c c c @}
1871 @end example
1872 will result in two groups of three tuplets, each group lasting for a
1873 quarter note.")
1874    (make-music 'TimeScaledMusic
1875                'element (ly:music-compress
1876                          music
1877                          (ly:make-moment (cdr ratio) (car ratio)))
1878                'numerator (cdr ratio)
1879                'denominator (car ratio)
1880                'duration tuplet-span))
1881
1882 tupletSpan =
1883 #(define-music-function (tuplet-span)
1884    ((ly:duration?))
1885    (_i "Set @code{tupletSpannerDuration}, the length into which
1886 @code{\\tuplet} without an explicit @samp{tuplet-span} argument of its
1887 own will group its tuplets, to the duration @var{tuplet-span}.  To
1888 revert to the default of not subdividing the contents of a @code{\\tuplet}
1889 command without explicit @samp{tuplet-span}, use
1890 @example
1891 \\tupletSpan \\default
1892 @end example
1893 ")
1894    (if tuplet-span
1895        #{ \set tupletSpannerDuration = #(ly:duration-length tuplet-span) #}
1896        #{ \unset tupletSpannerDuration #}))
1897
1898 tweak =
1899 #(define-music-function (prop value music)
1900    (key-list-or-symbol? scheme? ly:music?)
1901    (_i "Add a tweak to the following @var{music}.
1902 Layout objects created by @var{music} get their property @var{prop}
1903 set to @var{value}.  If @var{prop} has the form @samp{Grob.property}, like with
1904 @example
1905 \\tweak Accidental.color #red cis'
1906 @end example
1907 an indirectly created grob (@samp{Accidental} is caused by
1908 @samp{NoteHead}) can be tweaked; otherwise only directly created grobs
1909 are affected.
1910
1911 @var{prop} can contain additional elements in which case a nested
1912 property (inside of an alist) is tweaked.")
1913    (let ((p (check-grob-path prop (*location*)
1914                              #:start 1
1915                              #:default #t
1916                              #:min 2)))
1917      (cond ((not p))
1918            ;; p now contains at least two elements.  The first
1919            ;; element is #t when no grob has been explicitly
1920            ;; specified, otherwise it is a grob name.
1921            (else
1922             (set! (ly:music-property music 'tweaks)
1923                   (acons (cond ((pair? (cddr p)) p)
1924                                ((symbol? (car p))
1925                                 (cons (car p) (cadr p)))
1926                                (else (cadr p)))
1927                          value
1928                          (ly:music-property music 'tweaks)))))
1929      music))
1930
1931
1932 undo =
1933 #(define-music-function (music)
1934    (ly:music?)
1935    (_i "Convert @code{\\override} and @code{\\set} in @var{music} to
1936 @code{\\revert} and @code{\\unset}, respectively.  Any reverts and
1937 unsets already in @var{music} cause a warning.  Non-property-related music is ignored.")
1938    (define warned #f)
1939    (let loop
1940        ((music music))
1941      (let
1942          ((lst
1943            (fold-some-music
1944             (music-type-predicate '(layout-instruction-event
1945                                     context-specification
1946                                     apply-context
1947                                     time-signature-music))
1948             (lambda (m overrides)
1949               (case (ly:music-property m 'name)
1950                 ((OverrideProperty)
1951                  (cons
1952                   (make-music 'RevertProperty
1953                               'symbol (ly:music-property m 'symbol)
1954                               'grob-property-path
1955                               (cond
1956                                ((ly:music-property m 'grob-property #f) => list)
1957                                (else
1958                                 (ly:music-property m 'grob-property-path))))
1959                   overrides))
1960                 ((PropertySet)
1961                  (cons
1962                   (make-music 'PropertyUnset
1963                               'symbol (ly:music-property m 'symbol))
1964                   overrides))
1965                 ((ContextSpeccedMusic)
1966                  (cons
1967                   (make-music 'ContextSpeccedMusic
1968                               'element (loop (ly:music-property m 'element))
1969                               'context-type (ly:music-property m 'context-type))
1970                   overrides))
1971                 (else
1972                  (if (not warned)
1973                      (begin
1974                        (ly:input-warning (*location*) (_ "Cannot revert ~a")
1975                                          (ly:music-property m 'name))
1976                        (set! warned #t)))
1977                  overrides)))
1978             '()
1979             music)))
1980        (cond
1981         ((null? lst) (make-music 'Music))
1982         ((null? (cdr lst)) (car lst))
1983         (else (make-sequential-music lst))))))
1984
1985 unfoldRepeats =
1986 #(define-music-function (types music)
1987    ((symbol-list-or-symbol? '()) ly:music?)
1988    (_i "Force @code{\\repeat volta}, @code{\\repeat tremolo} or
1989 @code{\\repeat percent} commands in @var{music} to be interpreted
1990 as @code{\\repeat unfold}, if specified in the optional symbol-list @var{types}.
1991 The default for @var{types} is an empty list, which will force any of those
1992 commands in @var{music} to be interpreted as @code{\\repeat unfold}.  Possible
1993 entries are @code{volta}, @code{tremolo} or @code{percent}.  Multiple entries
1994 are possible.")
1995    (unfold-repeats types music))
1996
1997 void =
1998 #(define-void-function (arg) (scheme?)
1999    (_i "Accept a scheme argument, return a void expression.
2000 Use this if you want to have a scheme expression evaluated
2001 because of its side-effects, but its value ignored."))
2002
2003 withMusicProperty =
2004 #(define-music-function (sym val music)
2005    (symbol? scheme? ly:music?)
2006    (_i "Set @var{sym} to @var{val} in @var{music}.")
2007
2008    (set! (ly:music-property music sym) val)
2009    music)