+ (else (if (ly:music? e) (check-start-chords e)))))
+ music)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; setting stuff for grace context.
+;;
+
+(define (vector-extend v x)
+ "Make a new vector consisting of V, with X added to the end."
+ (let*
+ ((n (vector-length v))
+ (nv (make-vector (+ n 1) '())))
+ (vector-move-left! v 0 n nv 0)
+ (vector-set! nv n x)
+ nv))
+
+(define (vector-map f v)
+ "Map F over V. This function returns nothing."
+ (do ((n (vector-length v))
+ (i 0 (+ i 1)))
+ ((>= i n))
+ (f (vector-ref v i))))
+
+(define (vector-reverse-map f v)
+ "Map F over V, N to 0 order. This function returns nothing."
+ (do ((i (- (vector-length v) 1) (- i 1)))
+ ((< i 0))
+ (f (vector-ref v i))))
+
+;; TODO: make a remove-grace-property too.
+(define-public (add-grace-property context-name grob sym val)
+ "Set SYM=VAL for GROB in CONTEXT-NAME. "
+ (define (set-prop context)
+ (let* ((where (ly:context-property-where-defined context 'graceSettings))
+ (current (ly:context-property where 'graceSettings))
+ (new-settings (vector-extend current (list context-name grob sym val))))
+ (ly:context-set-property! where 'graceSettings new-settings)))
+ (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
+
+
+(define-public (set-start-grace-properties context)
+ (define (execute-1 x)
+ (let ((tr (ly:context-find context (car x))))
+ (if (ly:context? tr)
+ (ly:context-pushpop-property tr (cadr x) (caddr x) (cadddr x)))))
+
+ (let ((props (ly:context-property context 'graceSettings)))
+ (if (vector? props)
+ (vector-map execute-1 props))))
+
+(define-public (set-stop-grace-properties context)
+ (define (execute-1 x)
+ (let ((tr (ly:context-find context (car x))))
+ (if (ly:context? tr)
+ (ly:context-pushpop-property tr (cadr x) (caddr x)))))
+
+ (let ((props (ly:context-property context 'graceSettings)))
+ (if (vector? props)
+ (vector-reverse-map execute-1 props))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; switch it on here, so parsing and init isn't checked (too slow!)
+;;
+;; automatic music transformations.
+
+(define (switch-on-debugging m)
+ (set-debug-cell-accesses! 15000)
+ m)
+
+(define-public toplevel-music-functions
+ (list
+ ;; check-start-chords ; ; no longer needed with chord syntax.
+ voicify-music
+ (lambda (x) (music-map glue-mm-rest-texts x))
+ ;; switch-on-debugging
+ ))
+
+;;;;;;;;;;;;;;;;;
+;; lyrics
+
+(define (apply-durations lyric-music durations)
+ (define (apply-duration music)
+ (if (and (not (equal? (ly:music-length music) ZERO-MOMENT))
+ (ly:duration? (ly:music-property music 'duration)))
+ (begin
+ (set! (ly:music-property music 'duration) (car durations))
+ (set! durations (cdr durations)))))
+
+ (music-map apply-duration lyric-music))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+(define-public ((add-balloon-text object-name text off) grob orig-context cur-context)
+ "Usage: see input/regression/balloon.ly "
+ (let* ((meta (ly:grob-property grob 'meta))
+ (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))
+ (cb (ly:grob-property grob 'print-function)))
+ (if (equal? nm object-name)
+ (begin
+ (set! (ly:grob-property grob 'print-function) Balloon_interface::print)
+ (set! (ly:grob-property grob 'balloon-original-callback) cb)
+ (set! (ly:grob-property grob 'balloon-text) text)
+ (set! (ly:grob-property grob 'balloon-text-offset) off)
+ (set! (ly:grob-property grob 'balloon-text-props) '((font-family . roman)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; accidentals
+
+(define-public (set-accidentals-properties extra-natural
+ auto-accs auto-cauts
+ context)
+ (context-spec-music
+ (make-sequential-music
+ (append (if (boolean? extra-natural)
+ (list (make-property-set 'extraNatural extra-natural))
+ '())
+ (list (make-property-set 'autoAccidentals auto-accs)
+ (make-property-set 'autoCautionaries auto-cauts))))
+ context))
+
+(define-public (set-accidental-style style . rest)
+ "Set accidental style to STYLE. Optionally takes a context argument,
+eg. 'Staff or 'Voice. The context defaults to Voice, except for piano styles, which
+use PianoStaff as a context. "
+ (let ((context (if (pair? rest)
+ (car rest) 'Staff))
+ (pcontext (if (pair? rest)
+ (car rest) 'PianoStaff)))
+ (ly:export
+ (cond
+ ;; accidentals as they were common in the 18th century.
+ ((equal? style 'default)
+ (set-accidentals-properties #t '(Staff (same-octave . 0))
+ '() context))
+ ;; accidentals from one voice do NOT get cancelled in other voices
+ ((equal? style 'voice)
+ (set-accidentals-properties #t '(Voice (same-octave . 0))
+ '() context))
+ ;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
+ ;; This includes all the default accidentals, but accidentals also needs cancelling
+ ;; in other octaves and in the next measure.
+ ((equal? style 'modern)
+ (set-accidentals-properties #f '(Staff (same-octave . 0) (any-octave . 0) (same-octave . 1))
+ '() context))
+ ;; the accidentals that Stone adds to the old standard as cautionaries
+ ((equal? style 'modern-cautionary)
+ (set-accidentals-properties #f '(Staff (same-octave . 0))
+ '(Staff (any-octave . 0) (same-octave . 1))
+ context))
+ ;; Multivoice accidentals to be read both by musicians playing one voice
+ ;; and musicians playing all voices.
+ ;; Accidentals are typeset for each voice, but they ARE cancelled across voices.
+ ((equal? style 'modern-voice)
+ (set-accidentals-properties #f
+ '(Voice (same-octave . 0) (any-octave . 0) (same-octave . 1)
+ Staff (same-octave . 0) (any-octave . 0) (same-octave . 1))
+ '()
+ context))
+ ;; same as modernVoiceAccidental eccept that all special accidentals are typeset
+ ;; as cautionaries
+ ((equal? style 'modern-voice-cautionary)
+ (set-accidentals-properties #f
+ '(Voice (same-octave . 0) )
+ '(Voice (any-octave . 0) (same-octave . 1)
+ Staff (same-octave . 0) (any-octave . 0) (same-octave . 1))
+ context))
+ ;; stone's suggestions for accidentals on grand staff.
+ ;; Accidentals are cancelled across the staves in the same grand staff as well
+ ((equal? style 'piano)
+ (set-accidentals-properties #f
+ '( Staff (same-octave . 0) (any-octave . 0) (same-octave . 1)
+ PianoStaff (any-octave . 0) (same-octave . 1))
+ '()
+ pcontext))
+ ((equal? style 'piano-cautionary)
+ (set-accidentals-properties #f
+ '(Staff (same-octave . 0))
+ '(Staff (any-octave . 0) (same-octave . 1)
+ PianoStaff (any-octave . 0) (same-octave . 1))
+ pcontext))
+ ;; do not set localKeySignature when a note alterated differently from
+ ;; localKeySignature is found.
+ ;; Causes accidentals to be printed at every note instead of
+ ;; remembered for the duration of a measure.
+ ;; accidentals not being remembered, causing accidentals always to be typeset relative to the time signature
+ ((equal? style 'forget)
+ (set-accidentals-properties '()
+ '(Staff (same-octave . -1))
+ '() context))
+ ;; Do not reset the key at the start of a measure. Accidentals will be
+ ;; printed only once and are in effect until overridden, possibly many
+ ;; measures later.
+ ((equal? style 'no-reset)
+ (set-accidentals-properties '()
+ '(Staff (same-octave . #t))
+ '()
+ context))
+ (else
+ (ly:warn (string-append "Unknown accidental style: " (symbol->string style)))
+ (make-sequential-music '()))))))