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.14.0"
  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-warning 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 clef =
 208 #(define-music-function (parser location type) (string?)
 209    (_i "Set the current clef to @var{type}.")
 210    (make-clef-set type))
 211
 212
 213 compoundMeter =
 214 #(define-music-function (parser location args) (pair?)
 215   (_i "Create compound time signatures. The argument is a Scheme list of
 216 lists. Each list describes one fraction, with the last entry being the
 217 denominator, while the first entries describe the summands in the
 218 enumerator. If the time signature consists of just one fraction,
 219 the list can be given directly, i.e. not as a list containing a single list.
 220 For example, a time signature of (3+1)/8 + 2/4 would be created as
 221 @code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
 222 as @code{\\compoundMeter #'((3 2 8))} or shorter
 223 @code{\\compoundMeter #'(3 2 8)}.")
 224   (let* ((mlen (calculate-compound-measure-length args))
 225          (beat (calculate-compound-base-beat args))
 226          (beatGrouping (calculate-compound-beat-grouping args))
 227          (timesig (cons (ly:moment-main-numerator mlen)
 228                         (ly:moment-main-denominator mlen))))
 229   #{
 230     \once \override Staff.TimeSignature #'stencil = #(lambda (grob)
 231                 (grob-interpret-markup grob (format-compound-time $args)))
 232     \set Timing.timeSignatureFraction = $timesig
 233     \set Timing.baseMoment = $beat
 234     \set Timing.beatStructure = $beatGrouping
 235     \set Timing.beamExceptions = #'()
 236     \set Timing.measureLength = $mlen
 237   #} ))
 238
 239
 240 cueClef =
 241 #(define-music-function (parser location type) (string?)
 242   (_i "Set the current cue clef to @var{type}.")
 243   (make-cue-clef-set type))
 244 cueClefUnset =
 245 #(define-music-function (parser location) ()
 246   (_i "Unset the current cue clef.")
 247   (make-cue-clef-unset))
 248
 249 cueDuring =
 250 #(define-music-function
 251    (parser location what dir main-music) (string? ly:dir? ly:music?)
 252    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 253 in a CueVoice oriented by @var{dir}.")
 254    (make-music 'QuoteMusic
 255                'element main-music
 256                'quoted-context-type 'Voice
 257                'quoted-context-id "cue"
 258                'quoted-music-name what
 259                'quoted-voice-direction dir))
 260
 261 cueDuringWithClef =
 262 #(define-music-function
 263    (parser location what dir clef main-music) (string? ly:dir? string? ly:music?)
 264    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 265 in a CueVoice oriented by @var{dir}.")
 266    (make-music 'QuoteMusic
 267                'element main-music
 268                'quoted-context-type 'Voice
 269                'quoted-context-id "cue"
 270                'quoted-music-name what
 271                'quoted-music-clef clef
 272                'quoted-voice-direction dir))
 273
 274
 275
 276 displayLilyMusic =
 277 #(define-music-function (parser location music) (ly:music?)
 278    (_i "Display the LilyPond input representation of @var{music}
 279 to the console.")
 280    (newline)
 281    (display-lily-music music parser)
 282    music)
 283
 284 displayMusic =
 285 #(define-music-function (parser location music) (ly:music?)
 286    (_i "Display the internal representation of @var{music} to the console.")
 287    (newline)
 288    (display-scheme-music music)
 289    music)
 290
 291
 292
 293 endSpanners =
 294 #(define-music-function (parser location music) (ly:music?)
 295    (_i "Terminate the next spanner prematurely after exactly one note
 296 without the need of a specific end spanner.")
 297    (if (eq? (ly:music-property music 'name) 'EventChord)
 298        (let* ((elts (ly:music-property music 'elements))
 299               (start-span-evs (filter (lambda (ev)
 300                                         (and (music-has-type ev 'span-event)
 301                                              (equal? (ly:music-property ev 'span-direction)
 302                                                      START)))
 303                                       elts))
 304               (stop-span-evs
 305                (map (lambda (m)
 306                       (let ((c (music-clone m)))
 307                         (set! (ly:music-property c 'span-direction) STOP)
 308                         c))
 309                     start-span-evs))
 310               (end-ev-chord (make-music 'EventChord
 311                                         'elements stop-span-evs))
 312               (total (make-music 'SequentialMusic
 313                                  'elements (list music
 314                                                  end-ev-chord))))
 315          total)
 316
 317        (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a" music))))
 318
 319
 320
 321 featherDurations=
 322 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
 323    (_i "Adjust durations of music in @var{argument} by rational @var{factor}.")
 324    (let ((orig-duration (ly:music-length argument))
 325          (multiplier (ly:make-moment 1 1)))
 326
 327      (music-map
 328       (lambda (mus)
 329         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
 330                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
 331             (begin
 332               (ly:music-compress mus multiplier)
 333               (set! multiplier (ly:moment-mul factor multiplier))))
 334         mus)
 335       argument)
 336
 337      (ly:music-compress
 338       argument
 339       (ly:moment-div orig-duration (ly:music-length argument)))
 340
 341      argument))
 342
 343 footnoteGrob =
 344 #(define-music-function (parser location grob-name offset text footnote)
 345    (symbol? number-pair? markup? markup?)
 346    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset},
 347 with @var{text} referring to @var{footnote} (use like @code{\\once})")
 348    (make-music 'FootnoteEvent
 349                'automatically-numbered #f
 350                'symbol grob-name
 351                'X-offset (car offset)
 352                'Y-offset (cdr offset)
 353                'text text
 354                'footnote-text footnote))
 355
 356 autoFootnoteGrob =
 357 #(define-music-function (parser location grob-name offset footnote)
 358    (symbol? number-pair? markup?)
 359    (_i "Footnote @var{grob-name} with the text in @var{footnote}
 360 allowing for the footnote to be automatically numbered such that
 361 the number appears at @var{offset}.  Note that, for this to take effect,
 362 auto-numbering must be turned on in the paper block.  Otherwise, no
 363 number will appear.  Use like @code{\\once})")
 364    (make-music 'FootnoteEvent
 365                'automatically-numbered #t
 366                'symbol grob-name
 367                'X-offset (car offset)
 368                'Y-offset (cdr offset)
 369                'text (make-null-markup)
 370                'footnote-text footnote))
 371
 372
 373 footnote =
 374 #(define-music-function (parser location offset text footnote)
 375    (number-pair? markup? markup?)
 376    (_i "Attach @var{text} at @var{offset} with @var{text} referring
 377 to @var{footnote} (use like @code{\\tweak})")
 378    (make-music 'FootnoteEvent
 379                'automatically-numbered #f
 380                'X-offset (car offset)
 381                'Y-offset (cdr offset)
 382                'text text
 383                'footnote-text footnote))
 384
 385 autoFootnote =
 386 #(define-music-function (parser location offset footnote)
 387    (number-pair? markup?)
 388    (_i "Footnote the item after which this comes with the text in
 389 @var{footnote} allowing for the footnote to be automatically numbered
 390 such that the number appears at @var{offset}.  Note that, for this to
 391 take effect, auto-numbering must be turned on in the paper block.
 392 Otherwise, no number will appear.  Use like @code{\\tweak})")
 393    (make-music 'FootnoteEvent
 394                'automatically-numbered #t
 395                'X-offset (car offset)
 396                'Y-offset (cdr offset)
 397                'text (make-null-markup)
 398                'footnote-text footnote))
 399
 400 grace =
 401 #(def-grace-function startGraceMusic stopGraceMusic
 402    (_i "Insert @var{music} as grace notes."))
 403
 404 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
 405   (let* ((fret (number->string fret))
 406          (pitch (fret->pitch fret)))
 407         (make-sequential-music
 408          (list
 409           #{
 410             \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 411           #}
 412           (make-harmonic
 413             (calc-harmonic-pitch pitch music))
 414           #{
 415             \revert TabNoteHead #'stencil
 416           #}))))
 417
 418 harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?)
 419   (let ((pitch (ratio->pitch ratio))
 420         (fret (ratio->fret ratio)))
 421        (make-sequential-music
 422         (list
 423          #{
 424            \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 425          #}
 426          (make-harmonic
 427            (calc-harmonic-pitch pitch music))
 428          #{
 429             \revert TabNoteHead #'stencil
 430          #}))))
 431
 432 instrumentSwitch =
 433 #(define-music-function
 434    (parser location name) (string?)
 435    (_i "Switch instrument to @var{name}, which must be predefined with
 436 @code{\\addInstrumentDefinition}.")
 437    (let* ((handle (assoc name instrument-definitions))
 438           (instrument-def (if handle (cdr handle) '())))
 439
 440      (if (not handle)
 441          (ly:input-warning location "No such instrument: ~a" name))
 442      (context-spec-music
 443       (make-music 'SimultaneousMusic
 444                   'elements
 445                   (map (lambda (kv)
 446                          (make-property-set
 447                           (car kv)
 448                           (cdr kv)))
 449                        instrument-def))
 450       'Staff)))
 451
 452
 453
 454 keepWithTag =
 455 #(define-music-function (parser location tag music) (symbol? ly:music?)
 456    (_i "Include only elements of @var{music} that are tagged with @var{tag}.")
 457    (music-filter
 458     (lambda (m)
 459       (let* ((tags (ly:music-property m 'tags))
 460              (res (memq tag tags)))
 461         (or
 462          (eq? tags '())
 463          res)))
 464     music))
 465
 466 killCues =
 467 #(define-music-function (parser location music) (ly:music?)
 468    (_i "Remove cue notes from @var{music}.")
 469    (music-map
 470     (lambda (mus)
 471       (if (and (string? (ly:music-property mus 'quoted-music-name))
 472                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
 473           (ly:music-property mus 'element)
 474           mus))
 475     music))
 476
 477
 478
 479 label =
 480 #(define-music-function (parser location label) (symbol?)
 481    (_i "Create @var{label} as a bookmarking label.")
 482    (make-music 'EventChord
 483                'page-marker #t
 484                'page-label label
 485                'elements (list (make-music 'LabelEvent
 486                                            'page-label label))))
 487
 488
 489 language =
 490 #(define-music-function (parser location language) (string?)
 491    (_i "Set note names for language @var{language}.")
 492    (note-names-language parser language)
 493    (make-music 'Music 'void #t))
 494
 495 languageSaveAndChange =
 496 #(define-music-function (parser location language) (string?)
 497   (_i "Store the previous pitchnames alist, and set a new one.")
 498   (set! previous-pitchnames pitchnames)
 499   (note-names-language parser language)
 500   (make-music 'Music 'void #t))
 501
 502 languageRestore =
 503 #(define-music-function (parser location) ()
 504    (_i "Restore a previously-saved pitchnames alist.")
 505    (if previous-pitchnames
 506        (begin
 507         (set! pitchnames previous-pitchnames)
 508         (ly:parser-set-note-names parser pitchnames))
 509       (ly:input-warning location (_ "No other language was defined previously. Ignoring.")))
 510    (make-music 'Music 'void #t))
 511
 512
 513 makeClusters =
 514 #(define-music-function (parser location arg) (ly:music?)
 515    (_i "Display chords in @var{arg} as clusters.")
 516    (music-map note-to-cluster arg))
 517
 518 modalInversion =
 519 #(define-music-function (parser location around to scale music)
 520     (ly:music? ly:music? ly:music? ly:music?)
 521     (_i "Invert @var{music} about @var{around} using @var{scale} and
 522 transpose from @var{around} to @var{to}.")
 523     (let ((inverter (make-modal-inverter around to scale)))
 524       (change-pitches music inverter)
 525       music))
 526
 527 modalTranspose =
 528 #(define-music-function (parser location from to scale music)
 529     (ly:music? ly:music? ly:music? ly:music?)
 530     (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
 531 using @var{scale}.")
 532     (let ((transposer (make-modal-transposer from to scale)))
 533       (change-pitches music transposer)
 534       music))
 535
 536 inversion =
 537 #(define-music-function
 538    (parser location around to music) (ly:music? ly:music? ly:music?)
 539    (_i "Invert @var{music} about @var{around} and
 540 transpose from @var{around} to @var{to}.")
 541    (music-invert around to music))
 542
 543 musicMap =
 544 #(define-music-function (parser location proc mus) (procedure? ly:music?)
 545    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
 546    (music-map proc mus))
 547
 548 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 549 %% because music identifiers are not allowed at top-level.
 550 noPageBreak =
 551 #(define-music-function (location parser) ()
 552    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
 553 markups), or inside a score.")
 554    (make-music 'EventChord
 555                'page-marker #t
 556                'page-break-permission 'forbid
 557                'elements (list (make-music 'PageBreakEvent
 558                                            'break-permission '()))))
 559
 560 noPageTurn =
 561 #(define-music-function (location parser) ()
 562    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
 563 markups), or inside a score.")
 564    (make-music 'EventChord
 565                'page-marker #t
 566                'page-turn-permission 'forbid
 567                'elements (list (make-music 'PageTurnEvent
 568                                            'break-permission '()))))
 569
 570
 571
 572 octaveCheck =
 573 #(define-music-function (parser location pitch-note) (ly:music?)
 574    (_i "Octave check.")
 575    (make-music 'RelativeOctaveCheck
 576                'pitch (pitch-of-note pitch-note)))
 577
 578 ottava =
 579 #(define-music-function (parser location octave) (integer?)
 580    (_i "Set the octavation.")
 581    (make-music 'OttavaMusic
 582                'ottava-number octave))
 583
 584 overrideTimeSignatureSettings =
 585 #(define-music-function
 586    (parser location time-signature base-moment beat-structure beam-exceptions)
 587    (pair? pair? cheap-list? cheap-list?)
 588
 589    (_i "Override @code{timeSignatureSettings}
 590 for time signatures of @var{time-signature} to have settings
 591 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 592
 593    ;; TODO -- add warning if largest value of grouping is
 594    ;;       greater than time-signature.
 595   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
 596     (override-time-signature-setting time-signature setting)))
 597
 598 overrideProperty =
 599 #(define-music-function (parser location name property value)
 600    (string? symbol? scheme?)
 601
 602    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
 603 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 604 or @code{\"GrobName\"}.")
 605
 606    (let ((name-components (string-split name #\.))
 607          (context-name 'Bottom)
 608          (grob-name #f))
 609
 610      (if (> 2 (length name-components))
 611          (set! grob-name (string->symbol (car name-components)))
 612          (begin
 613            (set! grob-name (string->symbol (list-ref name-components 1)))
 614            (set! context-name (string->symbol (list-ref name-components 0)))))
 615
 616      (make-music 'ApplyOutputEvent
 617                  'context-type context-name
 618                  'procedure
 619                  (lambda (grob orig-context context)
 620                    (if (equal?
 621                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
 622                         grob-name)
 623                        (set! (ly:grob-property grob property) value))))))
 624
 625
 626
 627 %% pageBreak and pageTurn are music functions (iso music indentifiers),
 628 %% because music identifiers are not allowed at top-level.
 629 pageBreak =
 630 #(define-music-function (location parser) ()
 631    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
 632 markups), or inside a score.")
 633    (make-music 'EventChord
 634                'page-marker #t
 635                'line-break-permission 'force
 636                'page-break-permission 'force
 637                'elements (list (make-music 'LineBreakEvent
 638                                            'break-permission 'force)
 639                                (make-music 'PageBreakEvent
 640                                            'break-permission 'force))))
 641
 642 pageTurn =
 643 #(define-music-function (location parser) ()
 644    (_i "Force a page turn between two scores or top-level markups.")
 645    (make-music 'EventChord
 646                'page-marker #t
 647                'line-break-permission 'force
 648                'page-break-permission 'force
 649                'page-turn-permission 'force
 650                'elements (list (make-music 'LineBreakEvent
 651                                            'break-permission 'force)
 652                                (make-music 'PageBreakEvent
 653                                            'break-permission 'force)
 654                                (make-music 'PageTurnEvent
 655                                            'break-permission 'force))))
 656
 657 parallelMusic =
 658 #(define-music-function (parser location voice-ids music) (list? ly:music?)
 659    (_i "Define parallel music sequences, separated by '|' (bar check signs),
 660 and assign them to the identifiers provided in @var{voice-ids}.
 661
 662 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
 663
 664 @var{music}: a music sequence, containing BarChecks as limiting expressions.
 665
 666 Example:
 667
 668 @verbatim
 669   \\parallelMusic #'(A B C) {
 670     c c | d d | e e |
 671     d d | e e | f f |
 672   }
 673 <==>
 674   A = { c c | d d | }
 675   B = { d d | e e | }
 676   C = { e e | f f | }
 677 @end verbatim
 678 ")
 679    (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
 680           (current-voices voices)
 681           (current-sequence (list)))
 682      ;;
 683      ;; utilities
 684      (define (push-music m)
 685        "Push the music expression into the current sequence"
 686        (set! current-sequence (cons m current-sequence)))
 687      (define (change-voice)
 688        "Stores the previously built sequence into the current voice and
 689        change to the following voice."
 690        (list-set! current-voices 0 (cons (make-music 'SequentialMusic
 691                                                      'elements (reverse! current-sequence))
 692                                          (car current-voices)))
 693        (set! current-sequence (list))
 694        (set! current-voices (cdr current-voices)))
 695      (define (bar-check? m)
 696        "Checks whether m is a bar check."
 697        (eq? (ly:music-property m 'name) 'BarCheck))
 698      (define (music-origin music)
 699        "Recursively search an origin location stored in music."
 700        (cond ((null? music) #f)
 701              ((not (null? (ly:music-property music 'origin)))
 702               (ly:music-property music 'origin))
 703              (else (or (music-origin (ly:music-property music 'element))
 704                        (let ((origins (remove not (map music-origin
 705                                                        (ly:music-property music 'elements)))))
 706                          (and (not (null? origins)) (car origins)))))))
 707      ;;
 708      ;; first, split the music and fill in voices
 709      (map-in-order (lambda (m)
 710                      (push-music m)
 711                      (if (bar-check? m) (change-voice)))
 712                    (ly:music-property music 'elements))
 713      (if (not (null? current-sequence)) (change-voice))
 714      ;; un-circularize `voices' and reorder the voices
 715      (set! voices (map-in-order (lambda (dummy seqs)
 716                                   (reverse! seqs))
 717                                 voice-ids voices))
 718      ;;
 719      ;; set origin location of each sequence in each voice
 720      ;; for better type error tracking
 721      (for-each (lambda (voice)
 722                  (for-each (lambda (seq)
 723                              (set! (ly:music-property seq 'origin)
 724                                    (or (music-origin seq) location)))
 725                            voice))
 726                voices)
 727      ;;
 728      ;; check sequence length
 729      (apply for-each (lambda* (#:rest seqs)
 730                               (let ((moment-reference (ly:music-length (car seqs))))
 731                                 (for-each (lambda (seq moment)
 732                                             (if (not (equal? moment moment-reference))
 733                                                 (ly:music-warning seq
 734                                                                   "Bars in parallel music don't have the same length")))
 735                                           seqs (map-in-order ly:music-length seqs))))
 736             voices)
 737      ;;
 738      ;; bind voice identifiers to the voices
 739      (map (lambda (voice-id voice)
 740             (ly:parser-define! parser voice-id
 741                                (make-music 'SequentialMusic
 742                                            'origin location
 743                                            'elements voice)))
 744           voice-ids voices))
 745    ;; Return an empty sequence.  This function is actually a "void" function.
 746    (make-music 'SequentialMusic 'void #t))
 747
 748 parenthesize =
 749 #(define-music-function (parser loc arg) (ly:music?)
 750    (_i "Tag @var{arg} to be parenthesized.")
 751
 752    (if (memq 'event-chord (ly:music-property arg 'types))
 753        ;; arg is an EventChord -> set the parenthesize property
 754        ;; on all child notes and rests
 755        (map
 756         (lambda (ev)
 757           (if (or (memq 'note-event (ly:music-property ev 'types))
 758                   (memq 'rest-event (ly:music-property ev 'types)))
 759               (set! (ly:music-property ev 'parenthesize) #t)))
 760         (ly:music-property arg 'elements))
 761        ;; No chord, simply set property for this expression:
 762        (set! (ly:music-property arg 'parenthesize) #t))
 763    arg)
 764
 765 partcombine =
 766 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 767    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 768 that they share a staff.")
 769    (make-part-combine-music parser
 770                             (list part1 part2)))
 771
 772 partcombineForce =
 773 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
 774    (_i "Override the part-combiner.")
 775    (make-music 'EventChord
 776                'elements (list (make-music 'PartCombineForceEvent
 777                                            'forced-type type
 778                                            'once once))))
 779 partcombineApart = \partcombineForce #'apart ##f
 780 partcombineApartOnce = \partcombineForce #'apart ##t
 781 partcombineChords = \partcombineForce #'chords ##f
 782 partcombineChordsOnce = \partcombineForce #'chords ##t
 783 partcombineUnisono = \partcombineForce #'unisono ##f
 784 partcombineUnisonoOnce = \partcombineForce #'unisono ##t
 785 partcombineSoloI = \partcombineForce #'solo1 ##f
 786 partcombineSoloIOnce = \partcombineForce #'solo1 ##t
 787 partcombineSoloII = \partcombineForce #'solo2 ##f
 788 partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
 789 partcombineAutomatic = \partcombineForce ##f ##f
 790 partcombineAutomaticOnce = \partcombineForce ##f ##t
 791
 792
 793 pitchedTrill =
 794 #(define-music-function
 795    (parser location main-note secondary-note)
 796    (ly:music? ly:music?)
 797    (_i "Print a trill with @var{main-note} as the main note of the trill and
 798 print @var{secondary-note} as a stemless note head in parentheses.")
 799    (let* ((get-notes (lambda (ev-chord)
 800                        (filter
 801                         (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 802                         (ly:music-property ev-chord 'elements))))
 803           (sec-note-events (get-notes secondary-note))
 804           (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event))
 805                                 (ly:music-property main-note 'elements))))
 806
 807      (if (pair? sec-note-events)
 808          (begin
 809            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
 810                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
 811
 812              (if (ly:pitch? trill-pitch)
 813                  (for-each (lambda (m)
 814                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
 815                  (begin
 816                    (ly:input-warning location (_ "Second argument of \\pitchedTrill should be single note: "))
 817                    (display sec-note-events)))
 818
 819              (if (eq? forced #t)
 820                  (for-each (lambda (m)
 821                              (ly:music-set-property! m 'force-accidental forced))
 822                            trill-events)))))
 823      main-note))
 824
 825 quoteDuring =
 826 #(define-music-function (parser location what main-music) (string? ly:music?)
 827    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
 828 of the quoted voice, as specified in an @code{\\addQuote} command.
 829 @var{main-music} is used to indicate the length of music to be quoted;
 830 usually contains spacers or multi-measure rests.")
 831    (make-music 'QuoteMusic
 832                'element main-music
 833                'quoted-music-name what))
 834
 835 removeWithTag =
 836 #(define-music-function (parser location tag music) (symbol? ly:music?)
 837    (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
 838    (music-filter
 839     (lambda (m)
 840       (let* ((tags (ly:music-property m 'tags))
 841              (res (memq tag tags)))
 842         (not res)))
 843     music))
 844
 845 resetRelativeOctave =
 846 #(define-music-function (parser location reference-note) (ly:music?)
 847    (_i "Set the octave inside a \\relative section.")
 848
 849    (let* ((notes (ly:music-property reference-note 'elements))
 850           (pitch (ly:music-property (car notes) 'pitch)))
 851
 852      (set! (ly:music-property reference-note 'elements) '())
 853      (set! (ly:music-property reference-note 'to-relative-callback)
 854            (lambda (music last-pitch)
 855              pitch))
 856
 857      reference-note))
 858
 859 retrograde =
 860 #(define-music-function (parser location music)
 861     (ly:music?)
 862     (_i "Return @var{music} in reverse order.")
 863     (retrograde-music music))
 864
 865 revertTimeSignatureSettings =
 866 #(define-music-function
 867    (parser location time-signature)
 868    (pair?)
 869
 870    (_i "Revert @code{timeSignatureSettings}
 871 for time signatures of @var{time-signature}.")
 872    (revert-time-signature-setting time-signature))
 873
 874 rightHandFinger =
 875 #(define-music-function (parser location finger) (number-or-string?)
 876    (_i "Apply @var{finger} as a fingering indication.")
 877
 878    (apply make-music
 879           (append
 880            (list
 881             'StrokeFingerEvent
 882             'origin location)
 883            (if  (string? finger)
 884                 (list 'text finger)
 885                 (list 'digit finger)))))
 886
 887
 888
 889 scaleDurations =
 890 #(define-music-function (parser location fraction music)
 891    (number-pair? ly:music?)
 892    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
 893    (ly:music-compress music
 894                       (ly:make-moment (car fraction) (cdr fraction))))
 895
 896 shiftDurations =
 897 #(define-music-function (parser location dur dots arg)
 898    (integer? integer? ly:music?)
 899    (_i "Scale @var{arg} up by a factor of 2^@var{dur}*(2-(1/2)^@var{dots}).")
 900
 901    (music-map
 902     (lambda (x)
 903       (shift-one-duration-log x dur dots)) arg))
 904
 905 slashedGrace =
 906 #(def-grace-function startSlashedGraceMusic stopSlashedGraceMusic
 907    (_i "Create slashed graces (slashes through stems, but no slur) from
 908 the following music expression"))
 909
 910 spacingTweaks =
 911 #(define-music-function (parser location parameters) (list?)
 912    (_i "Set the system stretch, by reading the 'system-stretch property of
 913 the `parameters' assoc list.")
 914    #{
 915      \overrideProperty #"Score.NonMusicalPaperColumn"
 916      #'line-break-system-details
 917      #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
 918              (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))
 919    #})
 920
 921 styledNoteHeads =
 922 #(define-music-function (parser location style heads music)
 923    (symbol? list-or-symbol? ly:music?)
 924    (_i "Set @var{heads} in @var{music} to @var{style}.")
 925    (style-note-heads heads style music))
 926
 927
 928
 929 tabChordRepetition =
 930 #(define-music-function (parser location) ()
 931    (_i "Include the string information in a chord repetition.")
 932    (ly:parser-set-repetition-function parser tab-repeat-chord)
 933    (make-music 'SequentialMusic 'void #t))
 934
 935 tag =
 936 #(define-music-function (parser location tag arg) (symbol? ly:music?)
 937
 938    (_i "Add @var{tag} to the @code{tags} property of @var{arg}.")
 939
 940    (set!
 941     (ly:music-property arg 'tags)
 942     (cons tag
 943           (ly:music-property arg 'tags)))
 944    arg)
 945
 946 transpose =
 947 #(define-music-function
 948    (parser location from to music)
 949    (ly:pitch? ly:pitch? ly:music?)
 950
 951    (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}.")
 952    (make-music 'TransposedMusic
 953                'element (ly:music-transpose music (ly:pitch-diff to from))))
 954
 955 transposedCueDuring =
 956 #(define-music-function
 957    (parser location what dir pitch-note main-music)
 958    (string? ly:dir? ly:music? ly:music?)
 959
 960    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
 961 using the transposition defined by @var{pitch-note}.  This happens
 962 simultaneously with @var{main-music}, which is usually a rest.  The
 963 argument @var{dir} determines whether the cue notes should be notated
 964 as a first or second voice.")
 965
 966    (make-music 'QuoteMusic
 967                'element main-music
 968                'quoted-context-type 'Voice
 969                'quoted-context-id "cue"
 970                'quoted-music-name what
 971                'quoted-voice-direction dir
 972                'quoted-transposition (pitch-of-note pitch-note)))
 973
 974 transposition =
 975 #(define-music-function (parser location pitch-note) (ly:music?)
 976    (_i "Set instrument transposition")
 977
 978    (context-spec-music
 979     (make-property-set 'instrumentTransposition
 980                        (ly:pitch-negate (pitch-of-note pitch-note)))
 981     'Staff))
 982
 983 tweak =
 984 #(define-music-function (parser location sym val arg)
 985    (symbol? scheme? ly:music?)
 986    (_i "Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
 987
 988    (if (equal? (object-property sym 'backend-type?) #f)
 989        (begin
 990          (ly:input-warning location (_ "cannot find property type-check for ~a") sym)
 991          (ly:warning (_ "doing assignment anyway"))))
 992    (set!
 993     (ly:music-property arg 'tweaks)
 994     (acons sym val
 995            (ly:music-property arg 'tweaks)))
 996    arg)
 997
 998
 999
1000 unfoldRepeats =
1001 #(define-music-function (parser location music) (ly:music?)
1002    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
1003 @code{\\repeat percent} commands in @var{music} to be interpreted
1004 as @code{\\repeat unfold}.")
1005    (unfold-repeats music))
1006
1007
1008
1009 withMusicProperty =
1010 #(define-music-function (parser location sym val music)
1011    (symbol? scheme? ly:music?)
1012    (_i "Set @var{sym} to @var{val} in @var{music}.")
1013
1014    (set! (ly:music-property music sym) val)
1015    music)