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--2011 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.13.29"
  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 %% TODO: using define-music-function in a .scm causes crash.
  33
  34 acciaccatura =
  35 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
  36    (_i "Create an acciaccatura from the following music expression"))
  37
  38 %% keep these two together
  39 "instrument-definitions" = #'()
  40 addInstrumentDefinition =
  41 #(define-music-function
  42    (parser location name lst) (string? list?)
  43    (_i "Create instrument @var{name} with properties @var{list}.")
  44    (set! instrument-definitions (acons name lst instrument-definitions))
  45    (make-music 'SequentialMusic 'void #t))
  46
  47 addQuote =
  48 #(define-music-function (parser location name music) (string? ly:music?)
  49    (_i "Define @var{music} as a quotable music expression named
  50 @var{name}")
  51    (add-quotable parser name music)
  52    (make-music 'SequentialMusic 'void #t))
  53
  54 %% keep these two together
  55 afterGraceFraction = #(cons 6 8)
  56 afterGrace =
  57 #(define-music-function (parser location main grace) (ly:music? ly:music?)
  58    (_i "Create @var{grace} note(s) after a @var{main} music expression.")
  59    (let ((main-length (ly:music-length main))
  60          (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
  61      (make-simultaneous-music
  62       (list
  63        main
  64        (make-sequential-music
  65         (list
  66
  67          (make-music 'SkipMusic
  68                      'duration (ly:make-duration
  69                                 0 0
  70                                 (* (ly:moment-main-numerator main-length)
  71                                    (car fraction))
  72                                 (* (ly:moment-main-denominator main-length)
  73                                    (cdr fraction))))
  74          (make-music 'GraceMusic
  75                      'element grace)))))))
  76
  77
  78 %% music identifiers not allowed at top-level,
  79 %% so this is a music-function instead.
  80 allowPageTurn =
  81 #(define-music-function (location parser) ()
  82    (_i "Allow a page turn. May be used at toplevel (ie between scores or
  83 markups), or inside a score.")
  84    (make-music 'EventChord
  85                'page-marker #t
  86                'page-turn-permission 'allow
  87                'elements (list (make-music 'PageTurnEvent
  88                                            'break-permission 'allow))))
  89
  90 applyContext =
  91 #(define-music-function (parser location proc) (procedure?)
  92    (_i "Modify context properties with Scheme procedure @var{proc}.")
  93    (make-music 'ApplyContext
  94                'procedure proc))
  95
  96 applyMusic =
  97 #(define-music-function (parser location func music) (procedure? ly:music?)
  98    (_i"Apply procedure @var{func} to @var{music}.")
  99    (func music))
 100
 101 applyOutput =
 102 #(define-music-function (parser location ctx proc) (symbol? procedure?)
 103    (_i "Apply function @code{proc} to every layout object in context @code{ctx}")
 104    (make-music 'ApplyOutputEvent
 105                'procedure proc
 106                'context-type ctx))
 107
 108 appoggiatura =
 109 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
 110    (_i "Create an appoggiatura from @var{music}"))
 111
 112 % for regression testing purposes.
 113 assertBeamQuant =
 114 #(define-music-function (parser location l r) (pair? pair?)
 115    (_i "Testing function: check whether the beam quants @var{l} and @var{r} are correct")
 116    (make-grob-property-override 'Beam 'positions
 117                                 (ly:make-simple-closure
 118                                  (ly:make-simple-closure
 119                                   (append
 120                                    (list chain-grob-member-functions `(,cons 0 0))
 121                                    (check-quant-callbacks l r))))))
 122
 123 % for regression testing purposes.
 124 assertBeamSlope =
 125 #(define-music-function (parser location comp) (procedure?)
 126    (_i "Testing function: check whether the slope of the beam is the same as @code{comp}")
 127    (make-grob-property-override 'Beam 'positions
 128                                 (ly:make-simple-closure
 129                                  (ly:make-simple-closure
 130                                   (append
 131                                    (list chain-grob-member-functions `(,cons 0 0))
 132                                    (check-slope-callbacks comp))))))
 133
 134 autochange =
 135 #(define-music-function (parser location music) (ly:music?)
 136    (_i "Make voices that switch between staves automatically")
 137    (make-autochange-music parser music))
 138
 139
 140
 141 balloonGrobText =
 142 #(define-music-function (parser location grob-name offset text)
 143    (symbol? number-pair? markup?)
 144    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset}
 145  (use like @code{\\once})")
 146    (make-music 'AnnotateOutputEvent
 147                'symbol grob-name
 148                'X-offset (car offset)
 149                'Y-offset (cdr offset)
 150                'text text))
 151
 152 balloonText =
 153 #(define-music-function (parser location offset text) (number-pair? markup?)
 154    (_i "Attach @var{text} at @var{offset} (use like @code{\\tweak})")
 155    (make-music 'AnnotateOutputEvent
 156                'X-offset (car offset)
 157                'Y-offset (cdr offset)
 158                'text text))
 159
 160 bar =
 161 #(define-music-function (parser location type) (string?)
 162    (_i "Insert a bar line of type @var{type}")
 163    (context-spec-music
 164     (make-property-set 'whichBar type)
 165     'Timing))
 166
 167 barNumberCheck =
 168 #(define-music-function (parser location n) (integer?)
 169    (_i "Print a warning if the current bar number is not @var{n}.")
 170    (make-music 'ApplyContext
 171                'procedure
 172                (lambda (c)
 173                  (let ((cbn (ly:context-property c 'currentBarNumber)))
 174                    (if (and  (number? cbn) (not (= cbn n)))
 175                        (ly:input-message location
 176                                          "Barcheck failed got ~a expect ~a"
 177                                          cbn n))))))
 178
 179 bendAfter =
 180 #(define-music-function (parser location delta) (real?)
 181    (_i "Create a fall or doit of pitch interval @var{delta}.")
 182    (make-music 'BendAfterEvent
 183                'delta-step delta))
 184
 185 bookOutputName =
 186 #(define-music-function (parser location newfilename) (string?)
 187    (_i "Direct output for the current book block to @var{newfilename}.")
 188    (set! book-filename newfilename)
 189    (make-music 'SequentialMusic 'void #t))
 190
 191 bookOutputSuffix =
 192 #(define-music-function (parser location newsuffix) (string?)
 193    (_i "Set the output filename suffix for the current book block to
 194 @var{newsuffix}.")
 195    (set! book-output-suffix newsuffix)
 196    (make-music 'SequentialMusic 'void #t))
 197
 198 %% \breathe is defined as a music function rather than an event identifier to
 199 %% ensure it gets useful input location information: as an event identifier,
 200 %% it would have to be wrapped in an EventChord to prevent it from being
 201 %% treated as a post_event by the parser
 202 breathe =
 203 #(define-music-function (parser location) ()
 204    (_i "Insert a breath mark.")
 205    (make-music 'BreathingEvent))
 206
 207
 208
 209 clef =
 210 #(define-music-function (parser location type) (string?)
 211    (_i "Set the current clef to @var{type}.")
 212    (make-clef-set type))
 213
 214
 215 compoundMeter =
 216 #(define-music-function (parser location args) (pair?)
 217   (_i "Create compound time signatures. The argument is a Scheme list of
 218 lists. Each list describes one fraction, with the last entry being the
 219 denominator, while the first entries describe the summands in the
 220 enumerator. If the time signature consists of just one fraction,
 221 the list can be given directly, i.e. not as a list containing a single list.
 222 For example, a time signature of (3+1)/8 + 2/4 would be created as
 223 @code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
 224 as @code{\\compoundMeter #'((3 2 8))} or shorter
 225 @code{\\compoundMeter #'(3 2 8)}.")
 226   (let* ((mlen (calculate-compound-measure-length args))
 227          (beat (calculate-compound-base-beat args))
 228          (beatGrouping (calculate-compound-beat-grouping args))
 229          (timesig (cons (ly:moment-main-numerator mlen)
 230                         (ly:moment-main-denominator mlen))))
 231   #{
 232     \once \override Staff.TimeSignature #'stencil = #(lambda (grob)
 233                 (grob-interpret-markup grob (format-compound-time $args)))
 234     \set Timing.timeSignatureFraction = $timesig
 235     \set Timing.baseMoment = $beat
 236     \set Timing.beatStructure = $beatGrouping
 237     \set Timing.beamExceptions = #'()
 238     \set Timing.measureLength = $mlen
 239   #} ))
 240
 241
 242 cueClef =
 243 #(define-music-function (parser location type) (string?)
 244   (_i "Set the current cue clef to @var{type}.")
 245   (make-cue-clef-set type))
 246 cueClefUnset =
 247 #(define-music-function (parser location) ()
 248   (_i "Unset the current cue clef.")
 249   (make-cue-clef-unset))
 250
 251 cueDuring =
 252 #(define-music-function
 253    (parser location what dir main-music) (string? ly:dir? ly:music?)
 254    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 255 in a CueVoice oriented by @var{dir}.")
 256    (make-music 'QuoteMusic
 257                'element main-music
 258                'quoted-context-type 'Voice
 259                'quoted-context-id "cue"
 260                'quoted-music-name what
 261                'quoted-voice-direction dir))
 262
 263 cueDuringWithClef =
 264 #(define-music-function
 265    (parser location what dir clef main-music) (string? ly:dir? string? ly:music?)
 266    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 267 in a CueVoice oriented by @var{dir}.")
 268    (make-music 'QuoteMusic
 269                'element main-music
 270                'quoted-context-type 'Voice
 271                'quoted-context-id "cue"
 272                'quoted-music-name what
 273                'quoted-music-clef clef
 274                'quoted-voice-direction dir))
 275
 276
 277
 278 displayLilyMusic =
 279 #(define-music-function (parser location music) (ly:music?)
 280    (_i "Display the LilyPond input representation of @var{music}
 281 to the console.")
 282    (newline)
 283    (display-lily-music music parser)
 284    music)
 285
 286 displayMusic =
 287 #(define-music-function (parser location music) (ly:music?)
 288    (_i "Display the internal representation of @var{music} to the console.")
 289    (newline)
 290    (display-scheme-music music)
 291    music)
 292
 293
 294
 295 endSpanners =
 296 #(define-music-function (parser location music) (ly:music?)
 297    (_i "Terminate the next spanner prematurely after exactly one note
 298 without the need of a specific end spanner.")
 299    (if (eq? (ly:music-property music 'name) 'EventChord)
 300        (let* ((elts (ly:music-property music 'elements))
 301               (start-span-evs (filter (lambda (ev)
 302                                         (and (music-has-type ev 'span-event)
 303                                              (equal? (ly:music-property ev 'span-direction)
 304                                                      START)))
 305                                       elts))
 306               (stop-span-evs
 307                (map (lambda (m)
 308                       (let ((c (music-clone m)))
 309                         (set! (ly:music-property c 'span-direction) STOP)
 310                         c))
 311                     start-span-evs))
 312               (end-ev-chord (make-music 'EventChord
 313                                         'elements stop-span-evs))
 314               (total (make-music 'SequentialMusic
 315                                  'elements (list music
 316                                                  end-ev-chord))))
 317          total)
 318
 319        (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a" music))))
 320
 321
 322
 323 featherDurations=
 324 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
 325    (_i "Adjust durations of music in @var{argument} by rational @var{factor}.")
 326    (let ((orig-duration (ly:music-length argument))
 327          (multiplier (ly:make-moment 1 1)))
 328
 329      (music-map
 330       (lambda (mus)
 331         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
 332                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
 333             (begin
 334               (ly:music-compress mus multiplier)
 335               (set! multiplier (ly:moment-mul factor multiplier))))
 336         mus)
 337       argument)
 338
 339      (ly:music-compress
 340       argument
 341       (ly:moment-div orig-duration (ly:music-length argument)))
 342
 343      argument))
 344
 345
 346
 347 grace =
 348 #(def-grace-function startGraceMusic stopGraceMusic
 349    (_i "Insert @var{music} as grace notes."))
 350
 351 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
 352   (let* ((fret (number->string fret))
 353          (pitch (fret->pitch fret)))
 354         (make-sequential-music
 355          (list
 356           #{
 357             \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 358           #}
 359           (make-harmonic
 360             (calc-harmonic-pitch pitch music))
 361           #{
 362             \revert TabNoteHead #'stencil
 363           #}))))
 364
 365 harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?)
 366   (let ((pitch (ratio->pitch ratio))
 367         (fret (ratio->fret ratio)))
 368        (make-sequential-music
 369         (list
 370          #{
 371            \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 372          #}
 373          (make-harmonic
 374            (calc-harmonic-pitch pitch music))
 375          #{
 376             \revert TabNoteHead #'stencil
 377          #}))))
 378
 379 instrumentSwitch =
 380 #(define-music-function
 381    (parser location name) (string?)
 382    (_i "Switch instrument to @var{name}, which must be predefined with
 383 @code{\\addInstrumentDefinition}.")
 384    (let* ((handle (assoc name instrument-definitions))
 385           (instrument-def (if handle (cdr handle) '())))
 386
 387      (if (not handle)
 388          (ly:input-message location "No such instrument: ~a" name))
 389      (context-spec-music
 390       (make-music 'SimultaneousMusic
 391                   'elements
 392                   (map (lambda (kv)
 393                          (make-property-set
 394                           (car kv)
 395                           (cdr kv)))
 396                        instrument-def))
 397       'Staff)))
 398
 399
 400
 401 keepWithTag =
 402 #(define-music-function (parser location tag music) (symbol? ly:music?)
 403    (_i "Include only elements of @var{music} that are tagged with @var{tag}.")
 404    (music-filter
 405     (lambda (m)
 406       (let* ((tags (ly:music-property m 'tags))
 407              (res (memq tag tags)))
 408         (or
 409          (eq? tags '())
 410          res)))
 411     music))
 412
 413 killCues =
 414 #(define-music-function (parser location music) (ly:music?)
 415    (_i "Remove cue notes from @var{music}.")
 416    (music-map
 417     (lambda (mus)
 418       (if (and (string? (ly:music-property mus 'quoted-music-name))
 419                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
 420           (ly:music-property mus 'element)
 421           mus))
 422     music))
 423
 424
 425
 426 label =
 427 #(define-music-function (parser location label) (symbol?)
 428    (_i "Create @var{label} as a bookmarking label.")
 429    (make-music 'EventChord
 430                'page-marker #t
 431                'page-label label
 432                'elements (list (make-music 'LabelEvent
 433                                            'page-label label))))
 434
 435
 436 language =
 437 #(define-music-function (parser location language) (string?)
 438    (_i "Set note names for language @var{language}.")
 439    (note-names-language parser language)
 440    (make-music 'Music 'void #t))
 441
 442 languageSaveAndChange =
 443 #(define-music-function (parser location language) (string?)
 444   (_i "Store the previous pitchnames alist, and set a new one.")
 445   (set! previous-pitchnames pitchnames)
 446   (note-names-language parser language)
 447   (make-music 'Music 'void #t))
 448
 449 languageRestore =
 450 #(define-music-function (parser location) ()
 451    (_i "Restore a previously-saved pitchnames alist.")
 452    (if previous-pitchnames
 453        (begin
 454         (set! pitchnames previous-pitchnames)
 455         (ly:parser-set-note-names parser pitchnames))
 456       (ly:warning (_ "No other language was defined previously. Ignoring.")))
 457    (make-music 'Music 'void #t))
 458
 459
 460 makeClusters =
 461 #(define-music-function (parser location arg) (ly:music?)
 462    (_i "Display chords in @var{arg} as clusters.")
 463    (music-map note-to-cluster arg))
 464
 465 modalInversion =
 466 #(define-music-function (parser location around to scale music)
 467     (ly:music? ly:music? ly:music? ly:music?)
 468     (_i "Invert @var{music} about @var{around} using @var{scale} and
 469 transpose from @var{around} to @var{to}.")
 470     (let ((inverter (make-modal-inverter around to scale)))
 471       (change-pitches music inverter)
 472       music))
 473
 474 modalTranspose =
 475 #(define-music-function (parser location from to scale music)
 476     (ly:music? ly:music? ly:music? ly:music?)
 477     (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
 478 using @var{scale}.")
 479     (let ((transposer (make-modal-transposer from to scale)))
 480       (change-pitches music transposer)
 481       music))
 482
 483 inversion =
 484 #(define-music-function
 485    (parser location around to music) (ly:music? ly:music? ly:music?)
 486    (_i "Invert @var{music} about @var{around} and
 487 transpose from @var{around} to @var{to}.")
 488    (music-invert around to music))
 489
 490 musicMap =
 491 #(define-music-function (parser location proc mus) (procedure? ly:music?)
 492    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
 493    (music-map proc mus))
 494
 495 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 496 %% because music identifiers are not allowed at top-level.
 497 noPageBreak =
 498 #(define-music-function (location parser) ()
 499    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
 500 markups), or inside a score.")
 501    (make-music 'EventChord
 502                'page-marker #t
 503                'page-break-permission 'forbid
 504                'elements (list (make-music 'PageBreakEvent
 505                                            'break-permission '()))))
 506
 507 noPageTurn =
 508 #(define-music-function (location parser) ()
 509    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
 510 markups), or inside a score.")
 511    (make-music 'EventChord
 512                'page-marker #t
 513                'page-turn-permission 'forbid
 514                'elements (list (make-music 'PageTurnEvent
 515                                            'break-permission '()))))
 516
 517
 518
 519 octaveCheck =
 520 #(define-music-function (parser location pitch-note) (ly:music?)
 521    (_i "Octave check.")
 522    (make-music 'RelativeOctaveCheck
 523                'pitch (pitch-of-note pitch-note)))
 524
 525 ottava =
 526 #(define-music-function (parser location octave) (integer?)
 527    (_i "Set the octavation.")
 528    (make-music 'OttavaMusic
 529                'ottava-number octave))
 530
 531 overrideTimeSignatureSettings =
 532 #(define-music-function
 533    (parser location time-signature base-moment beat-structure beam-exceptions)
 534    (pair? pair? cheap-list? cheap-list?)
 535
 536    (_i "Override @code{timeSignatureSettings}
 537 for time signatures of @var{time-signature} to have settings
 538 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 539
 540    ;; TODO -- add warning if largest value of grouping is
 541    ;;       greater than time-signature.
 542   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
 543     (override-time-signature-setting time-signature setting)))
 544
 545 overrideProperty =
 546 #(define-music-function (parser location name property value)
 547    (string? symbol? scheme?)
 548
 549    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
 550 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 551 or @code{\"GrobName\"}.")
 552
 553    (let ((name-components (string-split name #\.))
 554          (context-name 'Bottom)
 555          (grob-name #f))
 556
 557      (if (> 2 (length name-components))
 558          (set! grob-name (string->symbol (car name-components)))
 559          (begin
 560            (set! grob-name (string->symbol (list-ref name-components 1)))
 561            (set! context-name (string->symbol (list-ref name-components 0)))))
 562
 563      (make-music 'ApplyOutputEvent
 564                  'context-type context-name
 565                  'procedure
 566                  (lambda (grob orig-context context)
 567                    (if (equal?
 568                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
 569                         grob-name)
 570                        (set! (ly:grob-property grob property) value))))))
 571
 572
 573
 574 %% pageBreak and pageTurn are music functions (iso music indentifiers),
 575 %% because music identifiers are not allowed at top-level.
 576 pageBreak =
 577 #(define-music-function (location parser) ()
 578    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
 579 markups), or inside a score.")
 580    (make-music 'EventChord
 581                'page-marker #t
 582                'line-break-permission 'force
 583                'page-break-permission 'force
 584                'elements (list (make-music 'LineBreakEvent
 585                                            'break-permission 'force)
 586                                (make-music 'PageBreakEvent
 587                                            'break-permission 'force))))
 588
 589 pageTurn =
 590 #(define-music-function (location parser) ()
 591    (_i "Force a page turn between two scores or top-level markups.")
 592    (make-music 'EventChord
 593                'page-marker #t
 594                'line-break-permission 'force
 595                'page-break-permission 'force
 596                'page-turn-permission 'force
 597                'elements (list (make-music 'LineBreakEvent
 598                                            'break-permission 'force)
 599                                (make-music 'PageBreakEvent
 600                                            'break-permission 'force)
 601                                (make-music 'PageTurnEvent
 602                                            'break-permission 'force))))
 603
 604 parallelMusic =
 605 #(define-music-function (parser location voice-ids music) (list? ly:music?)
 606    (_i "Define parallel music sequences, separated by '|' (bar check signs),
 607 and assign them to the identifiers provided in @var{voice-ids}.
 608
 609 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
 610
 611 @var{music}: a music sequence, containing BarChecks as limiting expressions.
 612
 613 Example:
 614
 615 @verbatim
 616   \\parallelMusic #'(A B C) {
 617     c c | d d | e e |
 618     d d | e e | f f |
 619   }
 620 <==>
 621   A = { c c | d d | }
 622   B = { d d | e e | }
 623   C = { e e | f f | }
 624 @end verbatim
 625 ")
 626    (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
 627           (current-voices voices)
 628           (current-sequence (list)))
 629      ;;
 630      ;; utilities
 631      (define (push-music m)
 632        "Push the music expression into the current sequence"
 633        (set! current-sequence (cons m current-sequence)))
 634      (define (change-voice)
 635        "Stores the previously built sequence into the current voice and
 636        change to the following voice."
 637        (list-set! current-voices 0 (cons (make-music 'SequentialMusic
 638                                                      'elements (reverse! current-sequence))
 639                                          (car current-voices)))
 640        (set! current-sequence (list))
 641        (set! current-voices (cdr current-voices)))
 642      (define (bar-check? m)
 643        "Checks whether m is a bar check."
 644        (eq? (ly:music-property m 'name) 'BarCheck))
 645      (define (music-origin music)
 646        "Recursively search an origin location stored in music."
 647        (cond ((null? music) #f)
 648              ((not (null? (ly:music-property music 'origin)))
 649               (ly:music-property music 'origin))
 650              (else (or (music-origin (ly:music-property music 'element))
 651                        (let ((origins (remove not (map music-origin
 652                                                        (ly:music-property music 'elements)))))
 653                          (and (not (null? origins)) (car origins)))))))
 654      ;;
 655      ;; first, split the music and fill in voices
 656      (map-in-order (lambda (m)
 657                      (push-music m)
 658                      (if (bar-check? m) (change-voice)))
 659                    (ly:music-property music 'elements))
 660      (if (not (null? current-sequence)) (change-voice))
 661      ;; un-circularize `voices' and reorder the voices
 662      (set! voices (map-in-order (lambda (dummy seqs)
 663                                   (reverse! seqs))
 664                                 voice-ids voices))
 665      ;;
 666      ;; set origin location of each sequence in each voice
 667      ;; for better type error tracking
 668      (for-each (lambda (voice)
 669                  (for-each (lambda (seq)
 670                              (set! (ly:music-property seq 'origin)
 671                                    (or (music-origin seq) location)))
 672                            voice))
 673                voices)
 674      ;;
 675      ;; check sequence length
 676      (apply for-each (lambda* (#:rest seqs)
 677                               (let ((moment-reference (ly:music-length (car seqs))))
 678                                 (for-each (lambda (seq moment)
 679                                             (if (not (equal? moment moment-reference))
 680                                                 (ly:music-message seq
 681                                                                   "Bars in parallel music don't have the same length")))
 682                                           seqs (map-in-order ly:music-length seqs))))
 683             voices)
 684      ;;
 685      ;; bind voice identifiers to the voices
 686      (map (lambda (voice-id voice)
 687             (ly:parser-define! parser voice-id
 688                                (make-music 'SequentialMusic
 689                                            'origin location
 690                                            'elements voice)))
 691           voice-ids voices))
 692    ;; Return an empty sequence.  This function is actually a "void" function.
 693    (make-music 'SequentialMusic 'void #t))
 694
 695 parenthesize =
 696 #(define-music-function (parser loc arg) (ly:music?)
 697    (_i "Tag @var{arg} to be parenthesized.")
 698
 699    (if (memq 'event-chord (ly:music-property arg 'types))
 700        ;; arg is an EventChord -> set the parenthesize property
 701        ;; on all child notes and rests
 702        (map
 703         (lambda (ev)
 704           (if (or (memq 'note-event (ly:music-property ev 'types))
 705                   (memq 'rest-event (ly:music-property ev 'types)))
 706               (set! (ly:music-property ev 'parenthesize) #t)))
 707         (ly:music-property arg 'elements))
 708        ;; No chord, simply set property for this expression:
 709        (set! (ly:music-property arg 'parenthesize) #t))
 710    arg)
 711
 712 partcombine =
 713 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 714    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 715 that they share a staff.")
 716    (make-part-combine-music parser
 717                             (list part1 part2)))
 718
 719 partcombineForce =
 720 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
 721    (_i "Override the part-combiner.")
 722    (make-music 'EventChord
 723                'elements (list (make-music 'PartCombineForceEvent
 724                                            'forced-type type
 725                                            'once once))))
 726 partcombineApart = \partcombineForce #'apart ##f
 727 partcombineApartOnce = \partcombineForce #'apart ##t
 728 partcombineChords = \partcombineForce #'chords ##f
 729 partcombineChordsOnce = \partcombineForce #'chords ##t
 730 partcombineUnisono = \partcombineForce #'unisono ##f
 731 partcombineUnisonoOnce = \partcombineForce #'unisono ##t
 732 partcombineSoloI = \partcombineForce #'solo1 ##f
 733 partcombineSoloIOnce = \partcombineForce #'solo1 ##t
 734 partcombineSoloII = \partcombineForce #'solo2 ##f
 735 partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
 736 partcombineAutomatic = \partcombineForce ##f ##f
 737 partcombineAutomaticOnce = \partcombineForce ##f ##t
 738
 739
 740 pitchedTrill =
 741 #(define-music-function
 742    (parser location main-note secondary-note)
 743    (ly:music? ly:music?)
 744    (_i "Print a trill with @var{main-note} as the main note of the trill and
 745 print @var{secondary-note} as a stemless note head in parentheses.")
 746    (let* ((get-notes (lambda (ev-chord)
 747                        (filter
 748                         (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 749                         (ly:music-property ev-chord 'elements))))
 750           (sec-note-events (get-notes secondary-note))
 751           (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event))
 752                                 (ly:music-property main-note 'elements))))
 753
 754      (if (pair? sec-note-events)
 755          (begin
 756            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
 757                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
 758
 759              (if (ly:pitch? trill-pitch)
 760                  (for-each (lambda (m)
 761                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
 762                  (begin
 763                    (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
 764                    (display sec-note-events)))
 765
 766              (if (eq? forced #t)
 767                  (for-each (lambda (m)
 768                              (ly:music-set-property! m 'force-accidental forced))
 769                            trill-events)))))
 770      main-note))
 771
 772 quoteDuring =
 773 #(define-music-function (parser location what main-music) (string? ly:music?)
 774    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
 775 of the quoted voice, as specified in an @code{\\addQuote} command.
 776 @var{main-music} is used to indicate the length of music to be quoted;
 777 usually contains spacers or multi-measure rests.")
 778    (make-music 'QuoteMusic
 779                'element main-music
 780                'quoted-music-name what))
 781
 782 removeWithTag =
 783 #(define-music-function (parser location tag music) (symbol? ly:music?)
 784    (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
 785    (music-filter
 786     (lambda (m)
 787       (let* ((tags (ly:music-property m 'tags))
 788              (res (memq tag tags)))
 789         (not res)))
 790     music))
 791
 792 resetRelativeOctave =
 793 #(define-music-function (parser location reference-note) (ly:music?)
 794    (_i "Set the octave inside a \\relative section.")
 795
 796    (let* ((notes (ly:music-property reference-note 'elements))
 797           (pitch (ly:music-property (car notes) 'pitch)))
 798
 799      (set! (ly:music-property reference-note 'elements) '())
 800      (set! (ly:music-property reference-note 'to-relative-callback)
 801            (lambda (music last-pitch)
 802              pitch))
 803
 804      reference-note))
 805
 806 retrograde =
 807 #(define-music-function (parser location music)
 808     (ly:music?)
 809     (_i "Return @var{music} in reverse order.")
 810     (retrograde-music music))
 811
 812 revertTimeSignatureSettings =
 813 #(define-music-function
 814    (parser location time-signature)
 815    (pair?)
 816
 817    (_i "Revert @code{timeSignatureSettings}
 818 for time signatures of @var{time-signature}.")
 819    (revert-time-signature-setting time-signature))
 820
 821 rightHandFinger =
 822 #(define-music-function (parser location finger) (number-or-string?)
 823    (_i "Apply @var{finger} as a fingering indication.")
 824
 825    (apply make-music
 826           (append
 827            (list
 828             'StrokeFingerEvent
 829             'origin location)
 830            (if  (string? finger)
 831                 (list 'text finger)
 832                 (list 'digit finger)))))
 833
 834
 835
 836 scaleDurations =
 837 #(define-music-function (parser location fraction music)
 838    (number-pair? ly:music?)
 839    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
 840    (ly:music-compress music
 841                       (ly:make-moment (car fraction) (cdr fraction))))
 842
 843 shiftDurations =
 844 #(define-music-function (parser location dur dots arg)
 845    (integer? integer? ly:music?)
 846    (_i "Scale @var{arg} up by a factor of @var{2^dur*(2-(1/2)^dots)}.")
 847
 848    (music-map
 849     (lambda (x)
 850       (shift-one-duration-log x dur dots)) arg))
 851
 852 spacingTweaks =
 853 #(define-music-function (parser location parameters) (list?)
 854    (_i "Set the system stretch, by reading the 'system-stretch property of
 855 the `parameters' assoc list.")
 856    #{
 857      \overrideProperty #"Score.NonMusicalPaperColumn"
 858      #'line-break-system-details
 859      #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
 860              (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))
 861    #})
 862
 863 styledNoteHeads =
 864 #(define-music-function (parser location style heads music)
 865    (symbol? list-or-symbol? ly:music?)
 866    (_i "Set @var{heads} in @var{music} to @var{style}.")
 867    (style-note-heads heads style music))
 868
 869
 870
 871 tabChordRepetition =
 872 #(define-music-function (parser location) ()
 873    (_i "Include the string information in a chord repetition.")
 874    (ly:parser-set-repetition-function parser tab-repeat-chord)
 875    (make-music 'SequentialMusic 'void #t))
 876
 877 tag =
 878 #(define-music-function (parser location tag arg) (symbol? ly:music?)
 879
 880    (_i "Add @var{tag} to the @code{tags} property of @var{arg}.")
 881
 882    (set!
 883     (ly:music-property arg 'tags)
 884     (cons tag
 885           (ly:music-property arg 'tags)))
 886    arg)
 887
 888 transposedCueDuring =
 889 #(define-music-function
 890    (parser location what dir pitch-note main-music)
 891    (string? ly:dir? ly:music? ly:music?)
 892
 893    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
 894 using the transposition defined by @var{pitch-note}.  This happens
 895 simultaneously with @var{main-music}, which is usually a rest.  The
 896 argument @var{dir} determines whether the cue notes should be notated
 897 as a first or second voice.")
 898
 899    (make-music 'QuoteMusic
 900                'element main-music
 901                'quoted-context-type 'Voice
 902                'quoted-context-id "cue"
 903                'quoted-music-name what
 904                'quoted-voice-direction dir
 905                'quoted-transposition (pitch-of-note pitch-note)))
 906
 907 transposition =
 908 #(define-music-function (parser location pitch-note) (ly:music?)
 909    (_i "Set instrument transposition")
 910
 911    (context-spec-music
 912     (make-property-set 'instrumentTransposition
 913                        (ly:pitch-negate (pitch-of-note pitch-note)))
 914     'Staff))
 915
 916 tweak =
 917 #(define-music-function (parser location sym val arg)
 918    (symbol? scheme? ly:music?)
 919    (_i "Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
 920
 921    (if (equal? (object-property sym 'backend-type?) #f)
 922        (begin
 923          (ly:warning (_ "cannot find property type-check for ~a") sym)
 924          (ly:warning (_ "doing assignment anyway"))))
 925    (set!
 926     (ly:music-property arg 'tweaks)
 927     (acons sym val
 928            (ly:music-property arg 'tweaks)))
 929    arg)
 930
 931
 932
 933 unfoldRepeats =
 934 #(define-music-function (parser location music) (ly:music?)
 935    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
 936 @code{\\repeat percent} commands in @var{music} to be interpreted
 937 as @code{\\repeat unfold}.")
 938    (unfold-repeats music))
 939
 940
 941
 942 withMusicProperty =
 943 #(define-music-function (parser location sym val music)
 944    (symbol? scheme? ly:music?)
 945    (_i "Set @var{sym} to @var{val} in @var{music}.")
 946
 947    (set! (ly:music-property music sym) val)
 948    music)