-% -*-Scheme-*-
-
-\version "2.12.0"
+%%%% -*- Mode: Scheme -*-
+
+%%%% This file is part of LilyPond, the GNU music typesetter.
+%%%%
+%%%% Copyright (C) 2003--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+%%%% Jan Nieuwenhuizen <janneke@gnu.org>
+%%%%
+%%%% LilyPond is free software: you can redistribute it and/or modify
+%%%% it under the terms of the GNU General Public License as published by
+%%%% the Free Software Foundation, either version 3 of the License, or
+%%%% (at your option) any later version.
+%%%%
+%%%% LilyPond is distributed in the hope that it will be useful,
+%%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+%%%% GNU General Public License for more details.
+%%%%
+%%%% You should have received a copy of the GNU General Public License
+%%%% along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+
+\version "2.13.29"
-#(define-music-function
- (parser location main grace)
- (ly:music? ly:music?)
-
- (let*
- ((main-length (ly:music-length main))
- (fraction (ly:parser-lookup parser 'afterGraceFraction)))
-
- (make-simultaneous-music
- (list
- main
- (make-sequential-music
- (list
-
- (make-music 'SkipMusic
- 'duration (ly:make-duration
- 0 0
- (* (ly:moment-main-numerator main-length)
- (car fraction))
- (* (ly:moment-main-denominator main-length)
- (cdr fraction)) ))
- (make-music 'GraceMusic
- 'element grace)))))))
+#(define-music-function (parser location main grace) (ly:music? ly:music?)
+ (_i "Create @var{grace} note(s) after a @var{main} music expression.")
+ (let ((main-length (ly:music-length main))
+ (fraction (ly:parser-lookup parser 'afterGraceFraction)))
+ (make-simultaneous-music
+ (list
+ main
+ (make-sequential-music
+ (list
+
+ (make-music 'SkipMusic
+ 'duration (ly:make-duration
+ 0 0
+ (* (ly:moment-main-numerator main-length)
+ (car fraction))
+ (* (ly:moment-main-denominator main-length)
+ (cdr fraction))))
+ (make-music 'GraceMusic
+ 'element grace)))))))
+
+
+%% music identifiers not allowed at top-level,
+%% so this is a music-function instead.
+allowPageTurn =
+#(define-music-function (location parser) ()
+ (_i "Allow a page turn. May be used at toplevel (ie between scores or
+markups), or inside a score.")
+ (make-music 'EventChord
+ 'page-marker #t
+ 'page-turn-permission 'allow
+ 'elements (list (make-music 'PageTurnEvent
+ 'break-permission 'allow))))
+
+applyContext =
+#(define-music-function (parser location proc) (procedure?)
+ (_i "Modify context properties with Scheme procedure @var{proc}.")
+ (make-music 'ApplyContext
+ 'origin location
+ 'procedure proc))
- (let*
- ((elts (ly:music-property music 'elements))
- (start-span-evs (filter (lambda (ev)
- (and (music-has-type ev 'span-event)
- (equal? (ly:music-property ev 'span-direction)
- START)))
- elts))
- (stop-span-evs
- (map (lambda (m)
- (let* ((c (music-clone m)))
- (set! (ly:music-property c 'span-direction) STOP)
- c))
- start-span-evs))
- (end-ev-chord (make-music 'EventChord
- 'elements stop-span-evs))
- (total (make-music 'SequentialMusic
- 'elements (list music
- end-ev-chord))))
+ (let* ((elts (ly:music-property music 'elements))
+ (start-span-evs (filter (lambda (ev)
+ (and (music-has-type ev 'span-event)
+ (equal? (ly:music-property ev 'span-direction)
+ START)))
+ elts))
+ (stop-span-evs
+ (map (lambda (m)
+ (let ((c (music-clone m)))
+ (set! (ly:music-property c 'span-direction) STOP)
+ c))
+ start-span-evs))
+ (end-ev-chord (make-music 'EventChord
+ 'elements stop-span-evs))
+ (total (make-music 'SequentialMusic
+ 'elements (list music
+ end-ev-chord))))
-%% Parser used to read page-layout file, and then retreive score tweaks.
-#(define page-layout-parser #f)
-
-includePageLayoutFile =
-#(define-music-function (parser location) ()
- (_i "Include the file @var{<basename>-page-layout.ly}. Deprecated as
-part of two-pass spacing.")
- (if (not (ly:get-option 'dump-tweaks))
- (let ((tweak-filename (format #f "~a-page-layout.ly"
- (ly:parser-output-name parser))))
- (if (access? tweak-filename R_OK)
- (begin
- (ly:message "Including tweak file ~a" tweak-filename)
- (set! page-layout-parser (ly:parser-clone parser))
- (ly:parser-parse-string page-layout-parser
- (format #f "\\include \"~a\""
- tweak-filename))))))
- (make-music 'SequentialMusic 'void #t))
-oldaddlyrics =
-#(define-music-function (parser location music lyrics) (ly:music? ly:music?)
+%% noPageBreak and noPageTurn are music functions (not music indentifiers),
+%% because music identifiers are not allowed at top-level.
+noPageBreak =
+#(define-music-function (location parser) ()
+ (_i "Forbid a page break. May be used at toplevel (i.e., between scores or
+markups), or inside a score.")
+ (make-music 'EventChord
+ 'page-marker #t
+ 'page-break-permission 'forbid
+ 'elements (list (make-music 'PageBreakEvent
+ 'break-permission '()))))
+
+noPageTurn =
+#(define-music-function (location parser) ()
+ (_i "Forbid a page turn. May be used at toplevel (i.e., between scores or
+markups), or inside a score.")
+ (make-music 'EventChord
+ 'page-marker #t
+ 'page-turn-permission 'forbid
+ 'elements (list (make-music 'PageTurnEvent
+ 'break-permission '()))))
+
+
+
+octaveCheck =
+#(define-music-function (parser location pitch-note) (ly:music?)
+ (_i "Octave check.")
+ (make-music 'RelativeOctaveCheck
+ 'origin location
+ 'pitch (pitch-of-note pitch-note)))
+
+ottava =
+#(define-music-function (parser location octave) (integer?)
+ (_i "Set the octavation.")
+ (make-music 'OttavaMusic
+ 'ottava-number octave))
-noPageTurn =
-#(define-music-function (location parser) ()
- (_i "Forbid a page turn. May be used at toplevel (ie between scores or
-markups), or inside a score.")
- (make-music 'EventChord
- 'page-marker #t
- 'page-turn-permission 'forbid
- 'elements (list (make-music 'PageTurnEvent
- 'break-permission '()))))
-
-allowPageTurn =
-#(define-music-function (location parser) ()
- (_i "Allow a page turn. May be used at toplevel (ie between scores or
-markups), or inside a score.")
- (make-music 'EventChord
- 'page-marker #t
- 'page-turn-permission 'allow
- 'elements (list (make-music 'PageTurnEvent
- 'break-permission 'allow))))
-
-%% Todo:
-%% doing
-%% define-music-function in a .scm causes crash.
-
-octaveCheck =
-#(define-music-function (parser location pitch-note) (ly:music?)
- (_i "octave check")
-
- (make-music 'RelativeOctaveCheck
- 'origin location
- 'pitch (pitch-of-note pitch-note)
- ))
-
-ottava = #(define-music-function (parser location octave) (number?)
- (_i "set the octavation ")
- (make-ottava-set octave))
-
-partcombine =
-#(define-music-function (parser location part1 part2) (ly:music? ly:music?)
- (make-part-combine-music parser
- (list part1 part2)))
-
-
-pitchedTrill =
-#(define-music-function
- (parser location main-note secondary-note)
- (ly:music? ly:music?)
- (let*
- ((get-notes (lambda (ev-chord)
- (filter
- (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
- (ly:music-property ev-chord 'elements))))
- (sec-note-events (get-notes secondary-note))
- (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event))
- (ly:music-property main-note 'elements))))
-
- (if (pair? sec-note-events)
- (begin
- (let*
- ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
- (forced (ly:music-property (car sec-note-events ) 'force-accidental)))
-
- (if (ly:pitch? trill-pitch)
- (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
- trill-events)
- (begin
- (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
- (display sec-note-events)))
-
- (if (eq? forced #t)
- (for-each (lambda (m) (ly:music-set-property! m 'force-accidental forced))
- trill-events)))))
- main-note))
-
-
-
-%% for lambda*
-#(use-modules (ice-9 optargs))
-
- (list-set! current-voices 0 (cons (make-music 'SequentialMusic
- 'elements (reverse! current-sequence))
- (car current-voices)))
- (set! current-sequence (list))
- (set! current-voices (cdr current-voices)))
- (define (bar-check? m)
- "Checks whether m is a bar check."
- (eq? (ly:music-property m 'name) 'BarCheck))
- (define (music-origin music)
- "Recursively search an origin location stored in music."
- (cond ((null? music) #f)
- ((not (null? (ly:music-property music 'origin)))
- (ly:music-property music 'origin))
- (else (or (music-origin (ly:music-property music 'element))
- (let ((origins (remove not (map music-origin
- (ly:music-property music 'elements)))))
- (and (not (null? origins)) (car origins)))))))
- ;;
- ;; first, split the music and fill in voices
- (map-in-order (lambda (m)
- (push-music m)
- (if (bar-check? m) (change-voice)))
- (ly:music-property music 'elements))
- (if (not (null? current-sequence)) (change-voice))
- ;; un-circularize `voices' and reorder the voices
- (set! voices (map-in-order (lambda (dummy seqs)
- (reverse! seqs))
- voice-ids voices))
- ;;
- ;; set origin location of each sequence in each voice
- ;; for better type error tracking
- (for-each (lambda (voice)
- (for-each (lambda (seq)
- (set! (ly:music-property seq 'origin)
- (or (music-origin seq) location)))
- voice))
- voices)
- ;;
- ;; check sequence length
- (apply for-each (lambda* (#:rest seqs)
- (let ((moment-reference (ly:music-length (car seqs))))
- (for-each (lambda (seq moment)
- (if (not (equal? moment moment-reference))
- (ly:music-message seq
- "Bars in parallel music don't have the same length")))
- seqs (map-in-order ly:music-length seqs))))
- voices)
- ;;
- ;; bind voice identifiers to the voices
- (map (lambda (voice-id voice)
- (ly:parser-define! parser voice-id
- (make-music 'SequentialMusic
- 'origin location
- 'elements voice)))
- voice-ids voices))
- ;; Return an empty sequence. this function is actually a "void" function.
- (make-music 'SequentialMusic 'void #t))
-
-
+ (list-set! current-voices 0 (cons (make-music 'SequentialMusic
+ 'elements (reverse! current-sequence))
+ (car current-voices)))
+ (set! current-sequence (list))
+ (set! current-voices (cdr current-voices)))
+ (define (bar-check? m)
+ "Checks whether m is a bar check."
+ (eq? (ly:music-property m 'name) 'BarCheck))
+ (define (music-origin music)
+ "Recursively search an origin location stored in music."
+ (cond ((null? music) #f)
+ ((not (null? (ly:music-property music 'origin)))
+ (ly:music-property music 'origin))
+ (else (or (music-origin (ly:music-property music 'element))
+ (let ((origins (remove not (map music-origin
+ (ly:music-property music 'elements)))))
+ (and (not (null? origins)) (car origins)))))))
+ ;;
+ ;; first, split the music and fill in voices
+ (map-in-order (lambda (m)
+ (push-music m)
+ (if (bar-check? m) (change-voice)))
+ (ly:music-property music 'elements))
+ (if (not (null? current-sequence)) (change-voice))
+ ;; un-circularize `voices' and reorder the voices
+ (set! voices (map-in-order (lambda (dummy seqs)
+ (reverse! seqs))
+ voice-ids voices))
+ ;;
+ ;; set origin location of each sequence in each voice
+ ;; for better type error tracking
+ (for-each (lambda (voice)
+ (for-each (lambda (seq)
+ (set! (ly:music-property seq 'origin)
+ (or (music-origin seq) location)))
+ voice))
+ voices)
+ ;;
+ ;; check sequence length
+ (apply for-each (lambda* (#:rest seqs)
+ (let ((moment-reference (ly:music-length (car seqs))))
+ (for-each (lambda (seq moment)
+ (if (not (equal? moment moment-reference))
+ (ly:music-message seq
+ "Bars in parallel music don't have the same length")))
+ seqs (map-in-order ly:music-length seqs))))
+ voices)
+ ;;
+ ;; bind voice identifiers to the voices
+ (map (lambda (voice-id voice)
+ (ly:parser-define! parser voice-id
+ (make-music 'SequentialMusic
+ 'origin location
+ 'elements voice)))
+ voice-ids voices))
+ ;; Return an empty sequence. This function is actually a "void" function.
+ (make-music 'SequentialMusic 'void #t))
- ; arg is an EventChord -> set the parenthesize property on all child notes and rests
- (map
- (lambda (ev)
- (if (or (memq 'note-event (ly:music-property ev 'types))
- (memq 'rest-event (ly:music-property ev 'types)))
- (set! (ly:music-property ev 'parenthesize) #t)))
- (ly:music-property arg 'elements))
- ; No chord, simply set property for this expression:
- (set! (ly:music-property arg 'parenthesize) #t))
+ ;; arg is an EventChord -> set the parenthesize property
+ ;; on all child notes and rests
+ (map
+ (lambda (ev)
+ (if (or (memq 'note-event (ly:music-property ev 'types))
+ (memq 'rest-event (ly:music-property ev 'types)))
+ (set! (ly:music-property ev 'parenthesize) #t)))
+ (ly:music-property arg 'elements))
+ ;; No chord, simply set property for this expression:
+ (set! (ly:music-property arg 'parenthesize) #t))
+partcombine =
+#(define-music-function (parser location part1 part2) (ly:music? ly:music?)
+ (_i "Take the music in @var{part1} and @var{part2} and typeset so
+that they share a staff.")
+ (make-part-combine-music parser
+ (list part1 part2)))
+
+#(define (symbol-or-boolean? x) (or (symbol? x) (boolean? x)))
+partcombineForce =
+#(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
+ (_i "Override the part-combiner.")
+ (make-music 'EventChord
+ 'elements (list (make-music 'PartCombineForceEvent
+ 'forced-type type
+ 'once once))))
+partcombineApart = \partcombineForce #'apart ##f
+partcombineApartOnce = \partcombineForce #'apart ##t
+partcombineChords = \partcombineForce #'chords ##f
+partcombineChordsOnce = \partcombineForce #'chords ##t
+partcombineUnisono = \partcombineForce #'unisono ##f
+partcombineUnisonoOnce = \partcombineForce #'unisono ##t
+partcombineSoloI = \partcombineForce #'solo1 ##f
+partcombineSoloIOnce = \partcombineForce #'solo1 ##t
+partcombineSoloII = \partcombineForce #'solo2 ##f
+partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
+partcombineAutomatic = \partcombineForce ##f ##f
+partcombineAutomaticOnce = \partcombineForce ##f ##t
+quoteDuring =
+#(define-music-function (parser location what main-music) (string? ly:music?)
+ (_i "Indicate a section of music to be quoted. @var{what} indicates the name
+of the quoted voice, as specified in an @code{\\addQuote} command.
+@var{main-music} is used to indicate the length of music to be quoted;
+usually contains spacers or multi-measure rests.")
+ (make-music 'QuoteMusic
+ 'element main-music
+ 'quoted-music-name what
+ 'origin location))
+
+removeWithTag =
+#(define-music-function (parser location tag music) (symbol? ly:music?)
+ (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
+ (music-filter
+ (lambda (m)
+ (let* ((tags (ly:music-property m 'tags))
+ (res (memq tag tags)))
+ (not res)))
+ music))
+
+resetRelativeOctave =
+#(define-music-function (parser location reference-note) (ly:music?)
+ (_i "Set the octave inside a \\relative section.")
+
+ (let* ((notes (ly:music-property reference-note 'elements))
+ (pitch (ly:music-property (car notes) 'pitch)))
+
+ (set! (ly:music-property reference-note 'elements) '())
+ (set! (ly:music-property reference-note 'to-relative-callback)
+ (lambda (music last-pitch)
+ pitch))
+
+ reference-note))
+
+revertTimeSignatureSettings =