X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fsong-util.scm;h=31cb1e8d48c2d35565127a0117d9d77e4ae0f0d7;hb=01b15679731ac5fcaf8edac1ad5bce6acba10ff0;hp=9a65d44c8eea934ca42b0248fc4031aea257110d;hpb=1528c75809ebc59d93018dbf59559436f75f082b;p=lilypond.git diff --git a/scm/song-util.scm b/scm/song-util.scm index 9a65d44c8e..31cb1e8d48 100644 --- a/scm/song-util.scm +++ b/scm/song-util.scm @@ -77,15 +77,14 @@ (lambda (record) ((record-predicate ,record) record))) (set! ,$make-record (lambda* (#:key ,@slots) - ((record-constructor ,record) ,@(map car slots*)))) + ((record-constructor ,record) ,@(map car slots*)))) (set! ,$copy-record (lambda (record) - (,$make-record ,@(apply - append - (map (lambda (slot) - (list (symbol->keyword slot) - (list (make-symbol reader-format slot) 'record))) - (map car slots*)))))) + (,$make-record ,@(append-map + (lambda (slot) + (list (symbol->keyword slot) + (list (make-symbol reader-format slot) 'record))) + (map car slots*))))) ,@(map (lambda (s) `(set! ,(make-symbol reader-format (car s)) (record-accessor ,record (quote ,(car s))))) @@ -159,10 +158,13 @@ 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))) - (if (not (null? elt)) - (cons elt elts) - elts))) + (elts (ly:music-property music 'elements)) + (arts (ly:music-property music 'articulations))) + (if (pair? arts) + (set! elts (append elts arts))) + (if (null? elt) + elts + (cons elt elts)))) (define-public (find-child music predicate) "Find the first node in @var{music} that satisfies @var{predicate}." @@ -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)))