diff options
| -rw-r--r-- | input/regression/display-lily-tests.ly | 2 | ||||
| -rw-r--r-- | lily/music-scheme.cc | 2 | ||||
| -rw-r--r-- | lily/parser.yy | 103 | ||||
| -rw-r--r-- | ly/music-functions-init.ly | 33 | ||||
| -rw-r--r-- | scm/define-music-display-methods.scm | 184 | ||||
| -rw-r--r-- | scm/modal-transforms.scm | 15 | ||||
| -rw-r--r-- | scm/music-functions.scm | 53 | ||||
| -rw-r--r-- | scm/song-util.scm | 17 | ||||
| -rw-r--r-- | scm/song.scm | 27 |
9 files changed, 213 insertions, 223 deletions
diff --git a/input/regression/display-lily-tests.ly b/input/regression/display-lily-tests.ly index 998627b716..76bfc420c6 100644 --- a/input/regression/display-lily-tests.ly +++ b/input/regression/display-lily-tests.ly @@ -74,7 +74,7 @@ stderr of this run." %% tags \test ##[ { \tag #'foo { c4 d } } #] -\test ##[ c-\tag #'foo -\tag #'baz -^ -. #] +\test ##[ c-\tag #'foo -\tag #'baz -^-. #] %% Graces \test ##[ { \grace c8 d2 } #] % GraceMusic diff --git a/lily/music-scheme.cc b/lily/music-scheme.cc index 93fd55d9a5..ffa903b4eb 100644 --- a/lily/music-scheme.cc +++ b/lily/music-scheme.cc @@ -76,7 +76,7 @@ LY_DEFINE (ly_music_p, "ly:music?", LY_DEFINE (ly_event_p, "ly:event?", 1, 0, 0, (SCM obj), - "Is @var{obj} an event object?") + "Is @var{obj} a proper (non-rhythmic) event object?") { if (Music *m = unsmob_music (obj)) { diff --git a/lily/parser.yy b/lily/parser.yy index e59625cc36..e913d88cf1 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -201,7 +201,7 @@ while (0) scm_apply_0 (proc, args) /* Syntactic Sugar. */ #define MAKE_SYNTAX(name, location, ...) \ - LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->self_scm (), make_input (location) , ##__VA_ARGS__, SCM_UNDEFINED)); + LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->self_scm (), make_input (location) , ##__VA_ARGS__, SCM_UNDEFINED)) #define START_MAKE_SYNTAX(name, ...) \ scm_list_n (ly_lily_module_constant (name) , ##__VA_ARGS__, SCM_UNDEFINED) #define FINISH_MAKE_SYNTAX(start, location, ...) \ @@ -468,7 +468,6 @@ If we give names, Bison complains. %type <scm> embedded_scm_bare %type <scm> embedded_scm_bare_arg %type <scm> embedded_scm_closed -%type <scm> embedded_scm_chord_body %type <scm> event_function_event %type <scm> figure_list %type <scm> figure_spec @@ -513,7 +512,6 @@ If we give names, Bison complains. %type <scm> multiplied_duration %type <scm> music_function_event %type <scm> music_function_chord_body -%type <scm> music_function_chord_body_arglist %type <scm> new_chord %type <scm> new_lyrics %type <scm> number_expression @@ -776,16 +774,7 @@ identifier_init: $$ = $1; } | music { - /* Hack: Create event-chord around standalone events. - Prevents the identifier from being interpreted as a post-event. */ - Music *mus = unsmob_music ($1); - bool is_event = mus && - (scm_memq (ly_symbol2scm ("event"), mus->get_property ("types")) - != SCM_BOOL_F); - if (!is_event) - $$ = $1; - else - $$ = MAKE_SYNTAX ("event-chord", @$, scm_list_1 ($1)); + $$ = $1; } | post_event_nofinger { $$ = $1; @@ -2046,10 +2035,12 @@ scalar_closed: event_chord: - /* TODO: Create a special case that avoids the creation of - EventChords around simple_elements that have no post_events? - */ - simple_chord_elements post_events { + simple_element post_events { + // Let the rhythmic music iterator sort this mess out. + unsmob_music ($1)->set_property ("articulations", + scm_reverse_x ($2, SCM_EOL)); + } + | simple_chord_elements post_events { SCM elts = ly_append2 ($1, scm_reverse_x ($2, SCM_EOL)); Input i; @@ -2111,7 +2102,8 @@ chord_body: chord_body_elements: /* empty */ { $$ = SCM_EOL; } | chord_body_elements chord_body_element { - $$ = scm_cons ($2, $1); + if (!SCM_UNBNDP ($2)) + $$ = scm_cons ($2, $1); } ; @@ -2153,43 +2145,17 @@ chord_body_element: $$ = n->unprotect (); } | music_function_chord_body - ; - -/* We can't accept a music argument, not even a closed one, - * immediately before chord_body_elements, otherwise a function \fun - * with a signature of two music arguments can't be sorted out - * properly in a construct like - * <\fun { c } \fun { c } c> - * The second call could be interpreted either as a chord constituent - * or a music expression. - */ - -music_function_chord_body_arglist: - function_arglist_bare - | EXPECT_SCM music_function_chord_body_arglist embedded_scm_chord_body { - $$ = check_scheme_arg (parser, @3, - $3, $2, $1); - } - ; - -embedded_scm_chord_body: - embedded_scm_bare_arg - | SCM_FUNCTION music_function_chord_body_arglist { - $$ = MAKE_SYNTAX ("music-function", @$, - $1, $2); + if (!unsmob_music ($$)->is_mus_type ("rhythmic-event")) { + parser->parser_error (@$, _ ("not a rhythmic event")); + $$ = SCM_UNDEFINED; + } } - | bare_number - | fraction - | lyric_element - | chord_body_element ; music_function_chord_body: - MUSIC_FUNCTION music_function_chord_body_arglist { - $$ = MAKE_SYNTAX ("music-function", @$, - $1, $2); - } + music_function_call + | MUSIC_IDENTIFIER ; // Event functions may only take closed arglists, otherwise it would @@ -2766,10 +2732,7 @@ simple_element: ; simple_chord_elements: - simple_element { - $$ = scm_list_1 ($1); - } - | new_chord { + new_chord { if (!parser->lexer_->is_chord_state ()) parser->parser_error (@1, _ ("have to be in Chord mode for chords")); $$ = $1; @@ -2795,35 +2758,29 @@ lyric_element: lyric_element_arg: lyric_element | lyric_element multiplied_duration post_events { - SCM lyric_event = MAKE_SYNTAX ("lyric-event", @$, $1, $2); - $$ = MAKE_SYNTAX ("event-chord", @$, - scm_cons (lyric_event, - scm_reverse_x ($3, SCM_EOL))); + $$ = MAKE_SYNTAX ("lyric-event", @$, $1, $2); + unsmob_music ($$)->set_property + ("articulations", scm_reverse_x ($3, SCM_EOL)); } | lyric_element post_event post_events { - SCM lyric_event = - MAKE_SYNTAX ("lyric-event", @$, $1, - parser->default_duration_.smobbed_copy ()); - $$ = MAKE_SYNTAX ("event-chord", @$, - scm_cons2 (lyric_event, $2, - scm_reverse_x ($3, SCM_EOL))); - + $$ = MAKE_SYNTAX ("lyric-event", @$, $1, + parser->default_duration_.smobbed_copy ()); + unsmob_music ($$)->set_property + ("articulations", scm_cons ($2, scm_reverse_x ($3, SCM_EOL))); } | LYRIC_ELEMENT optional_notemode_duration post_events { - SCM lyric_event = MAKE_SYNTAX ("lyric-event", @$, $1, $2); - $$ = MAKE_SYNTAX ("event-chord", @$, - scm_cons (lyric_event, - scm_reverse_x ($3, SCM_EOL))); + $$ = MAKE_SYNTAX ("lyric-event", @$, $1, $2); + unsmob_music ($$)->set_property + ("articulations", scm_reverse_x ($3, SCM_EOL)); } ; lyric_element_music: lyric_element optional_notemode_duration post_events { - SCM lyric_event = MAKE_SYNTAX ("lyric-event", @$, $1, $2); - $$ = MAKE_SYNTAX ("event-chord", @$, - scm_cons (lyric_event, - scm_reverse_x ($3, SCM_EOL))); + $$ = MAKE_SYNTAX ("lyric-event", @$, $1, $2); + unsmob_music ($$)->set_property + ("articulations", scm_reverse_x ($3, SCM_EOL)); } ; diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 9337127362..59c452065c 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -293,13 +293,11 @@ endSpanners = #(define-music-function (parser location music) (ly:music?) (_i "Terminate the next spanner prematurely after exactly one note without the need of a specific end spanner.") - (if (eq? (ly:music-property music 'name) 'EventChord) - (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)) + (if (memq (ly:music-property music 'name) '(EventChord NoteEvent)) + (let* ((start-span-evs (filter (lambda (ev) + (equal? (ly:music-property ev 'span-direction) + START)) + (extract-typed-music music 'span-event))) (stop-span-evs (map (lambda (m) (let ((c (music-clone m))) @@ -314,7 +312,7 @@ without the need of a specific end spanner.") total) (begin - (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a" music)) + (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a") music) music))) @@ -325,16 +323,13 @@ featherDurations= (let ((orig-duration (ly:music-length argument)) (multiplier (ly:make-moment 1 1))) - (music-map + (for-each (lambda (mus) - (if (and (eq? (ly:music-property mus 'name) 'EventChord) - (< 0 (ly:moment-main-denominator (ly:music-length mus)))) + (if (< 0 (ly:moment-main-denominator (ly:music-length mus))) (begin (ly:music-compress mus multiplier) - (set! multiplier (ly:moment-mul factor multiplier)))) - mus) - argument) - + (set! multiplier (ly:moment-mul factor multiplier))))) + (extract-named-music argument '(EventChord NoteEvent RestEvent SkipEvent))) (ly:music-compress argument (ly:moment-div orig-duration (ly:music-length argument))) @@ -846,13 +841,9 @@ pitchedTrill = (_i "Print a trill with @var{main-note} as the main note of the trill and print @var{secondary-note} as a stemless note head in parentheses.") (let* ((get-notes (lambda (ev-chord) - (filter - (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) - (ly:music-property ev-chord 'elements)))) + (extract-named-music ev-chord 'NoteEvent))) (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)))) - + (trill-events (extract-named-music main-note 'TrillSpanEvent))) (if (pair? sec-note-events) (begin (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch)) diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 4546afb0ac..ac9930e138 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -108,7 +108,9 @@ expression." (define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*)) (force-duration (*force-duration*)) (time-factor-numerator (*time-factor-numerator*)) - (time-factor-denominator (*time-factor-denominator*))) + (time-factor-denominator (*time-factor-denominator*)) + remember) + (if remember (*previous-duration* ly-duration)) (let ((log2 (ly:duration-log ly-duration)) (dots (ly:duration-dot-count ly-duration)) (num+den (ly:duration-factor ly-duration))) @@ -252,24 +254,22 @@ expression." (and (with-music-match (?start (music 'SequentialMusic elements ((music - 'EventChord - elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1)) - (music - 'SlurEvent - span-direction START)))))) - #t) - (with-music-match (?stop (music - 'SequentialMusic - elements ((music - 'EventChord - elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1)) - (music - 'SlurEvent - span-direction STOP)))))) + 'SkipEvent + duration (ly:make-duration 0 0 0 1) + articulations + ((music + 'SlurEvent + span-direction START)))))) + #t) + (with-music-match (?stop (music + 'SequentialMusic + elements ((music + 'SkipEvent + duration (ly:make-duration 0 0 0 1) + articulations + ((music + 'SlurEvent + span-direction STOP)))))) (format #f "\\appoggiatura ~a" (music->lily-string ?music parser)))))) @@ -287,13 +287,12 @@ expression." (and (with-music-match (?start (music 'SequentialMusic elements ((music - 'EventChord - elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1)) - (music - 'SlurEvent - span-direction START))) + 'SkipEvent + duration (ly:make-duration 0 0 0 1) + articulations + ((music + 'SlurEvent + span-direction START))) (music 'ContextSpeccedMusic element (music @@ -310,14 +309,14 @@ expression." 'RevertProperty grob-property-path '(stroke-style) symbol 'Flag)) + (music - 'EventChord - elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1)) - (music - 'SlurEvent - span-direction STOP)))))) + 'SkipEvent + duration (ly:make-duration 0 0 0 1) + articulations + ((music + 'SlurEvent + span-direction STOP)))))) (format #f "\\acciaccatura ~a" (music->lily-string ?music parser)))))) (define-extra-display-method GraceMusic (expr parser) @@ -346,12 +345,16 @@ expression." (*max-element-number-before-break*)))) (elements (ly:music-property seq 'elements)) (chord? (make-music-type-predicate 'EventChord)) + (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent + 'LyricEvent 'RestEvent + 'ClusterNoteEvent)) (cluster? (make-music-type-predicate 'ClusterNoteEvent)) (note? (make-music-type-predicate 'NoteEvent))) (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}" (if (any (lambda (e) - (and (chord? e) - (any cluster? (ly:music-property e 'elements)))) + (or (cluster? e) + (and (chord? e) + (any cluster? (ly:music-property e 'elements))))) elements) "\\makeClusters " "") @@ -366,15 +369,17 @@ expression." "\\figuremode ") ((any (lambda (chord) (any (make-music-type-predicate 'LyricEvent) - (ly:music-property chord 'elements))) - (filter chord? elements)) + (cons chord + (ly:music-property chord 'elements)))) + (filter note-or-chord? elements)) "\\lyricmode ") ((any (lambda (chord) (any (lambda (event) (and (note? event) (not (null? (ly:music-property event 'drum-type))))) - (ly:music-property chord 'elements))) - (filter chord? elements)) + (cons chord + (ly:music-property chord 'elements)))) + (filter note-or-chord? elements)) "\\drummode ") (else ;; TODO: other modes? "")) @@ -425,7 +430,7 @@ Otherwise, return #f." (let* ((elements (ly:music-property chord 'elements)) (simple-elements (filter (make-music-type-predicate 'NoteEvent 'ClusterNoteEvent 'RestEvent - 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent) + 'SkipEvent 'LyricEvent) elements))) (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements)) ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff) @@ -433,46 +438,39 @@ Otherwise, return #f." (music->lily-string (car elements) parser) (if (and (not (null? simple-elements)) (null? (cdr simple-elements)) - ;; special case: if this simple_element has any post_events in - ;; its 'articulations list, it should be interpreted instead - ;; as a note_chord_element to prevent spurious output, e.g., - ;; \displayLilyMusic < c-1\4 >8 -> c-1\48 - (null? (filter post-event? - (ly:music-property (car simple-elements) 'articulations))) + ;; a non-empty articulation list is only possible with + ;; chord entry. + (null? (ly:music-property (car simple-elements) 'articulations)) ;; same for simple_element with \tweak (null? (ly:music-property (car simple-elements) 'tweaks))) ;; simple_element : note | figure | rest | mmrest | lyric_element | skip (let* ((simple-element (car simple-elements)) - (duration (ly:music-property simple-element 'duration)) - (lily-string (format #f "~a~a~a~{~a~^ ~}" - (music->lily-string simple-element parser) - (duration->lily-string duration) - (if (and ((make-music-type-predicate 'RestEvent) simple-element) - (ly:pitch? (ly:music-property simple-element 'pitch))) - "\\rest" - "") - (map-in-order (lambda (music) - (music->lily-string music parser)) - (filter post-event? elements))))) - (*previous-duration* duration) - lily-string) + (duration (duration->lily-string + (ly:music-property simple-element 'duration) + #:remember #t))) + (format #f "~a~a~{~a~^ ~}" + (music->lily-string simple-element parser) + duration + (map-in-order (lambda (music) + (music->lily-string music parser)) + (filter post-event? elements)))) (let ((chord-elements (filter (make-music-type-predicate 'NoteEvent 'ClusterNoteEvent 'BassFigureEvent) elements)) (post-events (filter post-event? elements))) (if (not (null? chord-elements)) ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events - (let ((lily-string (format #f "< ~{~a ~}>~a~{~a~^ ~}" - (map-in-order (lambda (music) - (music->lily-string music parser)) - chord-elements) - (duration->lily-string (ly:music-property (car chord-elements) - 'duration)) - (map-in-order (lambda (music) - (music->lily-string music parser)) - post-events)))) - (*previous-duration* (ly:music-property (car chord-elements) 'duration)) - lily-string) + (let* ((duration (duration->lily-string + (ly:music-property (car chord-elements) 'duration) + #:remember #t))) + (format #f "< ~{~a ~}>~a~{~a~^ ~}" + (map-in-order (lambda (music) + (music->lily-string music parser)) + chord-elements) + duration + (map-in-order (lambda (music) + (music->lily-string music parser)) + post-events))) ;; command_element (format #f "~{~a~^ ~}" (map-in-order (lambda (music) (music->lily-string music parser)) @@ -499,7 +497,7 @@ Otherwise, return #f." ;;; (define (simple-note->lily-string event parser) - (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations + (format #f "~a~a~a~a~a~a~{~a~}" ; pitchname octave !? octave-check duration optional_rest articulations (note-name->lily-string (ly:music-property event 'pitch) parser) (octave->lily-string (ly:music-property event 'pitch)) (let ((forced (ly:music-property event 'force-accidental)) @@ -519,6 +517,10 @@ Otherwise, return #f." (make-string (1- (* -1 octave-check)) #\,)) (else ""))) "")) + (duration->lily-string (ly:music-property event 'duration) + #:remember #t) + (if ((make-music-type-predicate 'RestEvent) event) + "\\rest" "") (map-in-order (lambda (event) (music->lily-string event parser)) (ly:music-property event 'articulations)))) @@ -527,7 +529,9 @@ Otherwise, return #f." (cond ((not (null? (ly:music-property note 'pitch))) ;; note (simple-note->lily-string note parser)) ((not (null? (ly:music-property note 'drum-type))) ;; drum - (format #f "~a" (ly:music-property note 'drum-type))) + (format #f "~a~a" (ly:music-property note 'drum-type) + (duration->lily-string (ly:music-property note 'duration) + #:remember #t))) (else ;; unknown? ""))) @@ -537,13 +541,16 @@ Otherwise, return #f." (define-display-method RestEvent (rest parser) (if (not (null? (ly:music-property rest 'pitch))) (simple-note->lily-string rest parser) - "r")) + (string-append "r" (duration->lily-string (ly:music-property rest 'duration) + #:remember #t)))) (define-display-method MultiMeasureRestEvent (rest parser) - "R") + (string-append "R" (duration->lily-string (ly:music-property rest 'duration) + #:remember #t))) (define-display-method SkipEvent (rest parser) - "s") + (string-append "s" (duration->lily-string (ly:music-property rest 'duration) + #:remember #t))) (define-display-method RepeatedChord (chord parser) (music->lily-string (ly:music-property chord 'element) parser)) @@ -615,18 +622,21 @@ Otherwise, return #f." (if (null? bracket-stop) "" "]")))) (define-display-method LyricEvent (lyric parser) - (let ((text (ly:music-property lyric 'text))) - (if (or (string? text) - (eqv? (first text) simple-markup)) - ;; a string or a simple markup - (let ((string (if (string? text) - text - (second text)))) - (if (string-match "(\"| |[0-9])" string) - ;; TODO check exactly in which cases double quotes should be used - (format #f "~s" string) - string)) - (markup->lily-string text)))) + (format "~a~{~a~^ ~}" + (let ((text (ly:music-property lyric 'text))) + (if (or (string? text) + (eqv? (first text) simple-markup)) + ;; a string or a simple markup + (let ((string (if (string? text) + text + (second text)))) + (if (string-match "(\"| |[0-9])" string) + ;; TODO check exactly in which cases double quotes should be used + (format #f "~s" string) + string)) + (markup->lily-string text))) + (map-in-order (lambda (m) (music->lily-string m parser)) + (ly:music-property lyric 'articulations)))) (define-display-method BreathingEvent (event parser) "\\breathe") diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm index 737d7e2a9f..9617329d77 100644 --- a/scm/modal-transforms.scm +++ b/scm/modal-transforms.scm @@ -126,7 +126,7 @@ LilyPond scheme pitches, e.g. @code{(ly:make-pitch 0 2 0)} (change-pitches element converter))))) -(define (extract-pitch-sequence music) +(define (make-scale music) "Recurse through @var{music}, extracting pitches. Returns a list of pitch objects, e.g @code{'((ly:make-pitch 0 2 0) (ly:make-pitch 0 4 0) ... )} @@ -140,20 +140,15 @@ Typically used to construct a scale for input to transposer-factory (cond ((ly:pitch? pitch) - pitch) + (list pitch)) ((pair? elements) - (map - (lambda (x) (extract-pitch-sequence x)) + (append-map + (lambda (x) (make-scale x)) elements)) ((ly:music? element) - (extract-pitch-sequence element))))) - -(define (make-scale music) - "Convenience wrapper for extract-pitch-sequence." - (map car (extract-pitch-sequence music))) - + (make-scale element))))) (define (make-extended-scale music) "Extend scale given by @var{music} by 5 octaves up and down." diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 1b1d07c490..6114e144d6 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -276,12 +276,12 @@ through MUSIC." (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) (if (and (equal? name "tremolo") - (or (pair? (ly:music-property main 'elements)) - (ly:music? (ly:music-property main 'element)))) + (pair? (extract-named-music main 'NoteEvent))) ;; This works for single-note and multi-note tremolos! (let* ((children (if (music-is-of-type? main 'sequential-music) ;; \repeat tremolo n { ... } - (length (extract-named-music main 'EventChord)) + (length (extract-named-music main '(EventChord + NoteEvent))) ;; \repeat tremolo n c4 1)) ;; # of dots is equal to the 1 in bitwise representation (minus 1)! @@ -311,7 +311,7 @@ if durations in @var{music} vary, allowing slash beats and double-percent beats to be distinguished." (let* ((durs (map (lambda (elt) (duration-of-note elt)) - (extract-named-music music 'EventChord))) + (extract-named-music music '(EventChord NoteEvent)))) (first-dur (car durs))) (if (every (lambda (d) (equal? d first-dur)) durs) @@ -1517,7 +1517,8 @@ Entries that conform with the current key signature are not invalidated." (define-public (duration-of-note event-chord) (let ((evs (filter (lambda (x) (music-has-type x 'rhythmic-event)) - (ly:music-property event-chord 'elements)))) + (cons event-chord + (ly:music-property event-chord 'elements))))) (and (pair? evs) (ly:music-property (car evs) 'duration)))) @@ -1526,21 +1527,33 @@ Entries that conform with the current key signature are not invalidated." (define-public (extract-named-music music music-name) "Return a flat list of all music named @var{music-name} from @var{music}." - (let ((extracted-list - (if (ly:music? music) - (if (eq? (ly:music-property music 'name) music-name) - (list music) - (let ((elt (ly:music-property music 'element)) - (elts (ly:music-property music 'elements))) - (if (ly:music? elt) - (extract-named-music elt music-name) - (if (null? elts) - '() - (map (lambda(x) - (extract-named-music x music-name )) - elts))))) - '()))) - (flatten-list extracted-list))) + (if (not (list? music-name)) + (set! music-name (list music-name))) + (if (ly:music? music) + (if (memq (ly:music-property music 'name) music-name) + (list music) + (let ((arts (ly:music-property music 'articulations))) + (append-map! + (lambda (x) (extract-named-music x music-name)) + (if (pair? arts) + arts + (cons (ly:music-property music 'element) + (ly:music-property music 'elements)))))) + '())) + +(define-public (extract-typed-music music type) + "Return a flat list of all music with @var{type} from @var{music}." + (if (ly:music? music) + (if (music-is-of-type? music type) + (list music) + (let ((arts (ly:music-property music 'articulations))) + (append-map! + (lambda (x) (extract-typed-music x type)) + (if (pair? arts) + arts + (cons (ly:music-property music 'element) + (ly:music-property music 'elements)))))) + '())) (define-public (event-chord-notes event-chord) "Return a list of all notes from @var{event-chord}." diff --git a/scm/song-util.scm b/scm/song-util.scm index 9a65d44c8e..568b967ba6 100644 --- a/scm/song-util.scm +++ b/scm/song-util.scm @@ -159,7 +159,9 @@ If it unsets the property, return @code{#f}." (define-public (music-elements music) "Return list of all @var{music}'s top-level children." (let ((elt (ly:music-property music 'element)) - (elts (ly:music-property music 'elements))) + (elts (append + (ly:music-property music 'articulations) + (ly:music-property music 'elements)))) (if (not (null? elt)) (cons elt elts) elts))) @@ -182,12 +184,17 @@ If it unsets the property, return @code{#f}." (define-public (process-music music function) "Process all nodes of @var{music} (including @var{music}) in the DFS order. Apply @var{function} on each of the nodes. If @var{function} applied on a -node returns @code{#t}, don't process the node's subtree." +node returns @code{#t}, don't process the node's subtree. + +If a non-boolean is returned, it is considered the material to recurse." (define (process-music queue) (if (not (null? queue)) (let* ((elt (car queue)) (stop (function elt))) - (process-music (if stop - (cdr queue) - (append (music-elements elt) (cdr queue))))))) + (process-music (if (boolean? stop) + (if stop + (cdr queue) + (append (music-elements elt) (cdr queue))) + ((if (cheap-list? stop) append cons) + stop (cdr queue))))))) (process-music (list music))) diff --git a/scm/song.scm b/scm/song.scm index ffa53816c2..71eb03d72f 100644 --- a/scm/song.scm +++ b/scm/song.scm @@ -214,7 +214,7 @@ (lambda (music) (cond ;; true lyrics - ((music-name? music 'EventChord) + ((music-name? music '(EventChord LyricEvent)) (let ((lyric-event (find-child-named music 'LyricEvent))) (push! (make-lyrics #:text (ly:music-property lyric-event 'text) @@ -374,7 +374,21 @@ (append (score-notes-note/rest-list last-result) (list rest-spec))) (add! (make-score-notes #:note/rest-list (list rest-spec)) result-list)))))) - #f) + (filter + (lambda (m) + (not (music-name? m '(RestEvent + NoteEvent + LyricEvent + MultiMeasureRestEvent)))) + (ly:music-property music 'elements))) + ((music-name? music '(RestEvent + NoteEvent + LyricEvent + MultiMeasureRestEvent)) + (make-music 'EventChord + 'elements + (cons music + (ly:music-property music 'articulations)))) ;; autobeaming change ((music-property? music 'autoBeaming) (set! autobeaming (property-value music)) @@ -384,10 +398,12 @@ (let ((change (if (property-value music) 1 -1))) (set! in-slur (+ in-slur change)) (if last-note-spec - (set-note-joined! last-note-spec (+ (note-joined last-note-spec) change))))) + (set-note-joined! last-note-spec (+ (note-joined last-note-spec) change)))) + #t) ;; tempo change ((music-property? music 'tempoWholesPerMinute) - (set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music)))) + (set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music))) + #t) ;; breathe ((music-name? music 'BreathingEvent) (if last-note-spec @@ -396,7 +412,8 @@ #:origin (ly:music-property music 'origin)))) (set-note-duration! last-note-spec (* note-duration (*breathe-shortage*))) (add! (make-score-notes #:note/rest-list (list rest-spec)) result-list)) - (warning music "\\\\breathe without previous note known"))) + (warning music "\\\\breathe without previous note known")) + #t) ;; anything else (else #f)))) |