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