]> git.donarmstrong.com Git - lilypond.git/blob - ly/music-functions-init.ly
Docs: run convert-ly for 2.14.0.
[lilypond.git] / 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-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 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                'symbol grob-name
350                'X-offset (car offset)
351                'Y-offset (cdr offset)
352                'text text
353                'footnote-text footnote))
354
355 footnote =
356 #(define-music-function (parser location offset text footnote)
357    (number-pair? markup? markup?)
358    (_i "Attach @var{text} at @var{offset} with @var{text} referring
359  to @var{footnote} (use like @code{\\tweak})")
360    (make-music 'FootnoteEvent
361                'X-offset (car offset)
362                'Y-offset (cdr offset)
363                'text text
364                'footnote-text footnote))
365
366 grace =
367 #(def-grace-function startGraceMusic stopGraceMusic
368    (_i "Insert @var{music} as grace notes."))
369
370 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
371   (let* ((fret (number->string fret))
372          (pitch (fret->pitch fret)))
373         (make-sequential-music
374          (list
375           #{
376             \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
377           #}
378           (make-harmonic
379             (calc-harmonic-pitch pitch music))
380           #{
381             \revert TabNoteHead #'stencil
382           #}))))
383
384 harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?)
385   (let ((pitch (ratio->pitch ratio))
386         (fret (ratio->fret ratio)))
387        (make-sequential-music
388         (list
389          #{
390            \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
391          #}
392          (make-harmonic
393            (calc-harmonic-pitch pitch music))
394          #{
395             \revert TabNoteHead #'stencil
396          #}))))
397
398 instrumentSwitch =
399 #(define-music-function
400    (parser location name) (string?)
401    (_i "Switch instrument to @var{name}, which must be predefined with
402 @code{\\addInstrumentDefinition}.")
403    (let* ((handle (assoc name instrument-definitions))
404           (instrument-def (if handle (cdr handle) '())))
405
406      (if (not handle)
407          (ly:input-message location "No such instrument: ~a" name))
408      (context-spec-music
409       (make-music 'SimultaneousMusic
410                   'elements
411                   (map (lambda (kv)
412                          (make-property-set
413                           (car kv)
414                           (cdr kv)))
415                        instrument-def))
416       'Staff)))
417
418
419
420 keepWithTag =
421 #(define-music-function (parser location tag music) (symbol? ly:music?)
422    (_i "Include only elements of @var{music} that are tagged with @var{tag}.")
423    (music-filter
424     (lambda (m)
425       (let* ((tags (ly:music-property m 'tags))
426              (res (memq tag tags)))
427         (or
428          (eq? tags '())
429          res)))
430     music))
431
432 killCues =
433 #(define-music-function (parser location music) (ly:music?)
434    (_i "Remove cue notes from @var{music}.")
435    (music-map
436     (lambda (mus)
437       (if (and (string? (ly:music-property mus 'quoted-music-name))
438                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
439           (ly:music-property mus 'element)
440           mus))
441     music))
442
443
444
445 label =
446 #(define-music-function (parser location label) (symbol?)
447    (_i "Create @var{label} as a bookmarking label.")
448    (make-music 'EventChord
449                'page-marker #t
450                'page-label label
451                'elements (list (make-music 'LabelEvent
452                                            'page-label label))))
453
454
455 language =
456 #(define-music-function (parser location language) (string?)
457    (_i "Set note names for language @var{language}.")
458    (note-names-language parser language)
459    (make-music 'Music 'void #t))
460
461 languageSaveAndChange =
462 #(define-music-function (parser location language) (string?)
463   (_i "Store the previous pitchnames alist, and set a new one.")
464   (set! previous-pitchnames pitchnames)
465   (note-names-language parser language)
466   (make-music 'Music 'void #t))
467
468 languageRestore =
469 #(define-music-function (parser location) ()
470    (_i "Restore a previously-saved pitchnames alist.")
471    (if previous-pitchnames
472        (begin
473         (set! pitchnames previous-pitchnames)
474         (ly:parser-set-note-names parser pitchnames))
475       (ly:warning (_ "No other language was defined previously. Ignoring.")))
476    (make-music 'Music 'void #t))
477
478
479 makeClusters =
480 #(define-music-function (parser location arg) (ly:music?)
481    (_i "Display chords in @var{arg} as clusters.")
482    (music-map note-to-cluster arg))
483
484 modalInversion =
485 #(define-music-function (parser location around to scale music)
486     (ly:music? ly:music? ly:music? ly:music?)
487     (_i "Invert @var{music} about @var{around} using @var{scale} and
488 transpose from @var{around} to @var{to}.")
489     (let ((inverter (make-modal-inverter around to scale)))
490       (change-pitches music inverter)
491       music))
492
493 modalTranspose =
494 #(define-music-function (parser location from to scale music)
495     (ly:music? ly:music? ly:music? ly:music?)
496     (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
497 using @var{scale}.")
498     (let ((transposer (make-modal-transposer from to scale)))
499       (change-pitches music transposer)
500       music))
501
502 inversion =
503 #(define-music-function
504    (parser location around to music) (ly:music? ly:music? ly:music?)
505    (_i "Invert @var{music} about @var{around} and
506 transpose from @var{around} to @var{to}.")
507    (music-invert around to music))
508
509 musicMap =
510 #(define-music-function (parser location proc mus) (procedure? ly:music?)
511    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
512    (music-map proc mus))
513
514 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
515 %% because music identifiers are not allowed at top-level.
516 noPageBreak =
517 #(define-music-function (location parser) ()
518    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
519 markups), or inside a score.")
520    (make-music 'EventChord
521                'page-marker #t
522                'page-break-permission 'forbid
523                'elements (list (make-music 'PageBreakEvent
524                                            'break-permission '()))))
525
526 noPageTurn =
527 #(define-music-function (location parser) ()
528    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
529 markups), or inside a score.")
530    (make-music 'EventChord
531                'page-marker #t
532                'page-turn-permission 'forbid
533                'elements (list (make-music 'PageTurnEvent
534                                            'break-permission '()))))
535
536
537
538 octaveCheck =
539 #(define-music-function (parser location pitch-note) (ly:music?)
540    (_i "Octave check.")
541    (make-music 'RelativeOctaveCheck
542                'pitch (pitch-of-note pitch-note)))
543
544 ottava =
545 #(define-music-function (parser location octave) (integer?)
546    (_i "Set the octavation.")
547    (make-music 'OttavaMusic
548                'ottava-number octave))
549
550 overrideTimeSignatureSettings =
551 #(define-music-function
552    (parser location time-signature base-moment beat-structure beam-exceptions)
553    (pair? pair? cheap-list? cheap-list?)
554
555    (_i "Override @code{timeSignatureSettings}
556 for time signatures of @var{time-signature} to have settings
557 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
558
559    ;; TODO -- add warning if largest value of grouping is
560    ;;       greater than time-signature.
561   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
562     (override-time-signature-setting time-signature setting)))
563
564 overrideProperty =
565 #(define-music-function (parser location name property value)
566    (string? symbol? scheme?)
567
568    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
569 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
570 or @code{\"GrobName\"}.")
571
572    (let ((name-components (string-split name #\.))
573          (context-name 'Bottom)
574          (grob-name #f))
575
576      (if (> 2 (length name-components))
577          (set! grob-name (string->symbol (car name-components)))
578          (begin
579            (set! grob-name (string->symbol (list-ref name-components 1)))
580            (set! context-name (string->symbol (list-ref name-components 0)))))
581
582      (make-music 'ApplyOutputEvent
583                  'context-type context-name
584                  'procedure
585                  (lambda (grob orig-context context)
586                    (if (equal?
587                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
588                         grob-name)
589                        (set! (ly:grob-property grob property) value))))))
590
591
592
593 %% pageBreak and pageTurn are music functions (iso music indentifiers),
594 %% because music identifiers are not allowed at top-level.
595 pageBreak =
596 #(define-music-function (location parser) ()
597    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
598 markups), or inside a score.")
599    (make-music 'EventChord
600                'page-marker #t
601                'line-break-permission 'force
602                'page-break-permission 'force
603                'elements (list (make-music 'LineBreakEvent
604                                            'break-permission 'force)
605                                (make-music 'PageBreakEvent
606                                            'break-permission 'force))))
607
608 pageTurn =
609 #(define-music-function (location parser) ()
610    (_i "Force a page turn between two scores or top-level markups.")
611    (make-music 'EventChord
612                'page-marker #t
613                'line-break-permission 'force
614                'page-break-permission 'force
615                'page-turn-permission 'force
616                'elements (list (make-music 'LineBreakEvent
617                                            'break-permission 'force)
618                                (make-music 'PageBreakEvent
619                                            'break-permission 'force)
620                                (make-music 'PageTurnEvent
621                                            'break-permission 'force))))
622
623 parallelMusic =
624 #(define-music-function (parser location voice-ids music) (list? ly:music?)
625    (_i "Define parallel music sequences, separated by '|' (bar check signs),
626 and assign them to the identifiers provided in @var{voice-ids}.
627
628 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
629
630 @var{music}: a music sequence, containing BarChecks as limiting expressions.
631
632 Example:
633
634 @verbatim
635   \\parallelMusic #'(A B C) {
636     c c | d d | e e |
637     d d | e e | f f |
638   }
639 <==>
640   A = { c c | d d | }
641   B = { d d | e e | }
642   C = { e e | f f | }
643 @end verbatim
644 ")
645    (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
646           (current-voices voices)
647           (current-sequence (list)))
648      ;;
649      ;; utilities
650      (define (push-music m)
651        "Push the music expression into the current sequence"
652        (set! current-sequence (cons m current-sequence)))
653      (define (change-voice)
654        "Stores the previously built sequence into the current voice and
655        change to the following voice."
656        (list-set! current-voices 0 (cons (make-music 'SequentialMusic
657                                                      'elements (reverse! current-sequence))
658                                          (car current-voices)))
659        (set! current-sequence (list))
660        (set! current-voices (cdr current-voices)))
661      (define (bar-check? m)
662        "Checks whether m is a bar check."
663        (eq? (ly:music-property m 'name) 'BarCheck))
664      (define (music-origin music)
665        "Recursively search an origin location stored in music."
666        (cond ((null? music) #f)
667              ((not (null? (ly:music-property music 'origin)))
668               (ly:music-property music 'origin))
669              (else (or (music-origin (ly:music-property music 'element))
670                        (let ((origins (remove not (map music-origin
671                                                        (ly:music-property music 'elements)))))
672                          (and (not (null? origins)) (car origins)))))))
673      ;;
674      ;; first, split the music and fill in voices
675      (map-in-order (lambda (m)
676                      (push-music m)
677                      (if (bar-check? m) (change-voice)))
678                    (ly:music-property music 'elements))
679      (if (not (null? current-sequence)) (change-voice))
680      ;; un-circularize `voices' and reorder the voices
681      (set! voices (map-in-order (lambda (dummy seqs)
682                                   (reverse! seqs))
683                                 voice-ids voices))
684      ;;
685      ;; set origin location of each sequence in each voice
686      ;; for better type error tracking
687      (for-each (lambda (voice)
688                  (for-each (lambda (seq)
689                              (set! (ly:music-property seq 'origin)
690                                    (or (music-origin seq) location)))
691                            voice))
692                voices)
693      ;;
694      ;; check sequence length
695      (apply for-each (lambda* (#:rest seqs)
696                               (let ((moment-reference (ly:music-length (car seqs))))
697                                 (for-each (lambda (seq moment)
698                                             (if (not (equal? moment moment-reference))
699                                                 (ly:music-message seq
700                                                                   "Bars in parallel music don't have the same length")))
701                                           seqs (map-in-order ly:music-length seqs))))
702             voices)
703      ;;
704      ;; bind voice identifiers to the voices
705      (map (lambda (voice-id voice)
706             (ly:parser-define! parser voice-id
707                                (make-music 'SequentialMusic
708                                            'origin location
709                                            'elements voice)))
710           voice-ids voices))
711    ;; Return an empty sequence.  This function is actually a "void" function.
712    (make-music 'SequentialMusic 'void #t))
713
714 parenthesize =
715 #(define-music-function (parser loc arg) (ly:music?)
716    (_i "Tag @var{arg} to be parenthesized.")
717
718    (if (memq 'event-chord (ly:music-property arg 'types))
719        ;; arg is an EventChord -> set the parenthesize property
720        ;; on all child notes and rests
721        (map
722         (lambda (ev)
723           (if (or (memq 'note-event (ly:music-property ev 'types))
724                   (memq 'rest-event (ly:music-property ev 'types)))
725               (set! (ly:music-property ev 'parenthesize) #t)))
726         (ly:music-property arg 'elements))
727        ;; No chord, simply set property for this expression:
728        (set! (ly:music-property arg 'parenthesize) #t))
729    arg)
730
731 partcombine =
732 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
733    (_i "Take the music in @var{part1} and @var{part2} and typeset so
734 that they share a staff.")
735    (make-part-combine-music parser
736                             (list part1 part2)))
737
738 partcombineForce =
739 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
740    (_i "Override the part-combiner.")
741    (make-music 'EventChord
742                'elements (list (make-music 'PartCombineForceEvent
743                                            'forced-type type
744                                            'once once))))
745 partcombineApart = \partcombineForce #'apart ##f
746 partcombineApartOnce = \partcombineForce #'apart ##t
747 partcombineChords = \partcombineForce #'chords ##f
748 partcombineChordsOnce = \partcombineForce #'chords ##t
749 partcombineUnisono = \partcombineForce #'unisono ##f
750 partcombineUnisonoOnce = \partcombineForce #'unisono ##t
751 partcombineSoloI = \partcombineForce #'solo1 ##f
752 partcombineSoloIOnce = \partcombineForce #'solo1 ##t
753 partcombineSoloII = \partcombineForce #'solo2 ##f
754 partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
755 partcombineAutomatic = \partcombineForce ##f ##f
756 partcombineAutomaticOnce = \partcombineForce ##f ##t
757
758
759 pitchedTrill =
760 #(define-music-function
761    (parser location main-note secondary-note)
762    (ly:music? ly:music?)
763    (_i "Print a trill with @var{main-note} as the main note of the trill and
764 print @var{secondary-note} as a stemless note head in parentheses.")
765    (let* ((get-notes (lambda (ev-chord)
766                        (filter
767                         (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
768                         (ly:music-property ev-chord 'elements))))
769           (sec-note-events (get-notes secondary-note))
770           (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event))
771                                 (ly:music-property main-note 'elements))))
772
773      (if (pair? sec-note-events)
774          (begin
775            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
776                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
777
778              (if (ly:pitch? trill-pitch)
779                  (for-each (lambda (m)
780                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
781                  (begin
782                    (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
783                    (display sec-note-events)))
784
785              (if (eq? forced #t)
786                  (for-each (lambda (m)
787                              (ly:music-set-property! m 'force-accidental forced))
788                            trill-events)))))
789      main-note))
790
791 quoteDuring =
792 #(define-music-function (parser location what main-music) (string? ly:music?)
793    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
794 of the quoted voice, as specified in an @code{\\addQuote} command.
795 @var{main-music} is used to indicate the length of music to be quoted;
796 usually contains spacers or multi-measure rests.")
797    (make-music 'QuoteMusic
798                'element main-music
799                'quoted-music-name what))
800
801 removeWithTag =
802 #(define-music-function (parser location tag music) (symbol? ly:music?)
803    (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
804    (music-filter
805     (lambda (m)
806       (let* ((tags (ly:music-property m 'tags))
807              (res (memq tag tags)))
808         (not res)))
809     music))
810
811 resetRelativeOctave =
812 #(define-music-function (parser location reference-note) (ly:music?)
813    (_i "Set the octave inside a \\relative section.")
814
815    (let* ((notes (ly:music-property reference-note 'elements))
816           (pitch (ly:music-property (car notes) 'pitch)))
817
818      (set! (ly:music-property reference-note 'elements) '())
819      (set! (ly:music-property reference-note 'to-relative-callback)
820            (lambda (music last-pitch)
821              pitch))
822
823      reference-note))
824
825 retrograde =
826 #(define-music-function (parser location music)
827     (ly:music?)
828     (_i "Return @var{music} in reverse order.")
829     (retrograde-music music))
830
831 revertTimeSignatureSettings =
832 #(define-music-function
833    (parser location time-signature)
834    (pair?)
835
836    (_i "Revert @code{timeSignatureSettings}
837 for time signatures of @var{time-signature}.")
838    (revert-time-signature-setting time-signature))
839
840 rightHandFinger =
841 #(define-music-function (parser location finger) (number-or-string?)
842    (_i "Apply @var{finger} as a fingering indication.")
843
844    (apply make-music
845           (append
846            (list
847             'StrokeFingerEvent
848             'origin location)
849            (if  (string? finger)
850                 (list 'text finger)
851                 (list 'digit finger)))))
852
853
854
855 scaleDurations =
856 #(define-music-function (parser location fraction music)
857    (number-pair? ly:music?)
858    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
859    (ly:music-compress music
860                       (ly:make-moment (car fraction) (cdr fraction))))
861
862 shiftDurations =
863 #(define-music-function (parser location dur dots arg)
864    (integer? integer? ly:music?)
865    (_i "Scale @var{arg} up by a factor of @var{2^dur*(2-(1/2)^dots)}.")
866
867    (music-map
868     (lambda (x)
869       (shift-one-duration-log x dur dots)) arg))
870
871 spacingTweaks =
872 #(define-music-function (parser location parameters) (list?)
873    (_i "Set the system stretch, by reading the 'system-stretch property of
874 the `parameters' assoc list.")
875    #{
876      \overrideProperty #"Score.NonMusicalPaperColumn"
877      #'line-break-system-details
878      #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
879              (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))
880    #})
881
882 styledNoteHeads =
883 #(define-music-function (parser location style heads music)
884    (symbol? list-or-symbol? ly:music?)
885    (_i "Set @var{heads} in @var{music} to @var{style}.")
886    (style-note-heads heads style music))
887
888
889
890 tabChordRepetition =
891 #(define-music-function (parser location) ()
892    (_i "Include the string information in a chord repetition.")
893    (ly:parser-set-repetition-function parser tab-repeat-chord)
894    (make-music 'SequentialMusic 'void #t))
895
896 tag =
897 #(define-music-function (parser location tag arg) (symbol? ly:music?)
898
899    (_i "Add @var{tag} to the @code{tags} property of @var{arg}.")
900
901    (set!
902     (ly:music-property arg 'tags)
903     (cons tag
904           (ly:music-property arg 'tags)))
905    arg)
906
907 transposedCueDuring =
908 #(define-music-function
909    (parser location what dir pitch-note main-music)
910    (string? ly:dir? ly:music? ly:music?)
911
912    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
913 using the transposition defined by @var{pitch-note}.  This happens
914 simultaneously with @var{main-music}, which is usually a rest.  The
915 argument @var{dir} determines whether the cue notes should be notated
916 as a first or second voice.")
917
918    (make-music 'QuoteMusic
919                'element main-music
920                'quoted-context-type 'Voice
921                'quoted-context-id "cue"
922                'quoted-music-name what
923                'quoted-voice-direction dir
924                'quoted-transposition (pitch-of-note pitch-note)))
925
926 transposition =
927 #(define-music-function (parser location pitch-note) (ly:music?)
928    (_i "Set instrument transposition")
929
930    (context-spec-music
931     (make-property-set 'instrumentTransposition
932                        (ly:pitch-negate (pitch-of-note pitch-note)))
933     'Staff))
934
935 tweak =
936 #(define-music-function (parser location sym val arg)
937    (symbol? scheme? ly:music?)
938    (_i "Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
939
940    (if (equal? (object-property sym 'backend-type?) #f)
941        (begin
942          (ly:warning (_ "cannot find property type-check for ~a") sym)
943          (ly:warning (_ "doing assignment anyway"))))
944    (set!
945     (ly:music-property arg 'tweaks)
946     (acons sym val
947            (ly:music-property arg 'tweaks)))
948    arg)
949
950
951
952 unfoldRepeats =
953 #(define-music-function (parser location music) (ly:music?)
954    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
955 @code{\\repeat percent} commands in @var{music} to be interpreted
956 as @code{\\repeat unfold}.")
957    (unfold-repeats music))
958
959
960
961 withMusicProperty =
962 #(define-music-function (parser location sym val music)
963    (symbol? scheme? ly:music?)
964    (_i "Set @var{sym} to @var{val} in @var{music}.")
965
966    (set! (ly:music-property music sym) val)
967    music)