X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=84055ed9addd552432c11ecba6afec558ef5a98f;hb=734f5255777e8c85676ad3f24fcd214a62a35862;hp=c31360019912c04285896b5c1e3a19381d5f8736;hpb=9a2ffbf058002a6a82acc5748a2998840885afb8;p=lilypond.git

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index c313600199..84055ed9ad 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -16,7 +16,10 @@
 ;;;; You should have received a copy of the GNU General Public License
 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
-;; (use-modules (ice-9 optargs))
+; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
+
+(use-modules (ice-9 optargs))
 
 ;;; ly:music-property with setter
 ;;; (ly:music-property my-music 'elements)
@@ -59,8 +62,9 @@ First it recurses over the children, then the function is applied to
 @var{music}."
   (let ((es (ly:music-property music 'elements))
 	(e (ly:music-property music 'element)))
-    (set! (ly:music-property music 'elements)
-	  (map (lambda (y) (music-map function y)) es))
+    (if (pair? es)
+	(set! (ly:music-property music 'elements)
+	      (map (lambda (y) (music-map function y)) es)))
     (if (ly:music? e)
 	(set! (ly:music-property music 'element)
 	      (music-map function  e)))
@@ -79,9 +83,12 @@ First it recurses over the children, then the function is applied to
 			   (inner-music-filter pred? e)
 			   e))
 	   (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
-      (set! (ly:music-property music 'element) filtered-e)
-      (set! (ly:music-property music 'elements) filtered-es)
-      (set! (ly:music-property music 'articulations) filtered-as)
+      (if (not (null? e))
+	  (set! (ly:music-property music 'element) filtered-e))
+      (if (not (null? es))
+	  (set! (ly:music-property music 'elements) filtered-es))
+      (if (not (null? as))
+	  (set! (ly:music-property music 'articulations) filtered-as))
       ;; if filtering emptied the expression, we remove it completely.
       (if (or (not (pred? music))
 	      (and (eq? filtered-es '()) (not (ly:music? e))
@@ -95,24 +102,23 @@ First it recurses over the children, then the function is applied to
       music
       (make-music 'Music)))	  ;must return music.
 
-(define-public (display-music music)
+(define*-public (display-music music #:optional (port (current-output-port)))
   "Display music, not done with @code{music-map} for clarity of
 presentation."
-
-  (display music)
-  (display ": { ")
+  (display music port)
+  (display ": { " port)
   (let ((es (ly:music-property music 'elements))
 	(e (ly:music-property music 'element)))
-    (display (ly:music-mutable-properties music))
+    (display (ly:music-mutable-properties music) port)
     (if (pair? es)
-	(begin (display "\nElements: {\n")
-	       (map display-music es)
-	       (display "}\n")))
+	(begin (display "\nElements: {\n" port)
+	       (for-each (lambda (m) (display-music m port)) es)
+	       (display "}\n" port)))
     (if (ly:music? e)
 	(begin
-	  (display "\nChild:")
-	  (display-music e))))
-  (display " }\n")
+	  (display "\nChild:" port)
+	  (display-music e port))))
+  (display " }\n" port)
   music)
 
 ;;;
@@ -203,13 +209,9 @@ equivalent to @var{obj}, that is, for a music expression, a
 (use-modules (ice-9 pretty-print))
 (define*-public (display-scheme-music obj #:optional (port (current-output-port)))
   "Displays `obj', typically a music expression, in a friendly fashion,
-which often can be read back in order to generate an equivalent expression.
-
-Returns `obj'.
-"
+which often can be read back in order to generate an equivalent expression."
   (pretty-print (music->make-music obj) port)
-  (newline)
-  obj)
+  (newline port))
 
 ;;;
 ;;; Scheme music expression --> Lily-syntax-using string translator
@@ -217,28 +219,30 @@ Returns `obj'.
 (use-modules (srfi srfi-39)
              (scm display-lily))
 
-(define*-public (display-lily-music expr parser #:key force-duration)
+(define*-public (display-lily-music expr parser #:optional (port (current-output-port))
+				    #:key force-duration)
   "Display the music expression using LilyPond syntax"
   (memoize-clef-names supported-clefs)
   (parameterize ((*indent* 0)
 		 (*previous-duration* (ly:make-duration 2))
 		 (*force-duration* force-duration))
-    (display (music->lily-string expr parser))
-    (newline)))
+    (display (music->lily-string expr parser) port)
+    (newline port)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (shift-one-duration-log music shift dot)
   "Add @var{shift} to @code{duration-log} of @code{'duration} in
-@var{music} and optionally @var{dot} to any note encountered.  This
-scales the music up by a factor `2^@var{shift} * (2 - (1/2)^@var{dot})'."
+@var{music} and optionally @var{dot} to any note encountered.
+The number of dots in the shifted music may not be less than zero."
   (let ((d (ly:music-property music 'duration)))
     (if (ly:duration? d)
 	(let* ((cp (ly:duration-factor d))
-	       (nd (ly:make-duration (+ shift (ly:duration-log d))
-				     (+ dot (ly:duration-dot-count d))
-				     (car cp)
-				     (cdr cp))))
+	       (nd (ly:make-duration
+                    (+ shift (ly:duration-log d))
+                    (max 0 (+ dot (ly:duration-dot-count d)))
+		    (car cp)
+		    (cdr cp))))
 	  (set! (ly:music-property music 'duration) nd)))
     music))
 
@@ -252,7 +256,9 @@ properly."
   (define (first-note-duration music)
     "Finds the duration of the first NoteEvent by searching depth-first
 through MUSIC."
-    (if (memq 'note-event (ly:music-property music 'types))
+    ;; NoteEvent or a non-expanded chord-repetition
+    ;; We just take anything that actually sports an announced duration.
+    (if (ly:duration? (ly:music-property music 'duration))
 	(ly:music-property music 'duration)
 	(let loop ((elts (if (ly:music? (ly:music-property music 'element))
 			     (list (ly:music-property music 'element))
@@ -273,12 +279,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 '(EventChord 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)!
@@ -306,9 +312,9 @@ through MUSIC."
 calculate the number of slashes based on the durations.  Returns @code{0}
 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)))
+  (let* ((durs (map duration-of-note
+		    (extract-named-music music '(EventChord NoteEvent
+						 RestEvent SkipEvent))))
 	 (first-dur (car durs)))
 
     (if (every (lambda (d) (equal? d first-dur)) durs)
@@ -400,10 +406,12 @@ in @var{grob}."
 	      'grob-property gprop))
 
 (define direction-polyphonic-grobs
-  '(DotColumn
+  '(AccidentalSuggestion
+    DotColumn
     Dots
     Fingering
     LaissezVibrerTie
+    LigatureBracket
     PhrasingSlur
     RepeatTie
     Rest
@@ -412,18 +420,20 @@ in @var{grob}."
     Stem
     TextScript
     Tie
-    TupletBracket))
+    TupletBracket
+    TrillSpanner))
 
 (define-safe-public (make-voice-props-set n)
   (make-sequential-music
    (append
     (map (lambda (x) (make-grob-property-set x 'direction
-					     (if (odd? n) -1 1)))
+						  (if (odd? n) -1 1)))
 	 direction-polyphonic-grobs)
     (list
      (make-property-set 'graceSettings
 			;; TODO: take this from voicedGraceSettings or similar.
 			'((Voice Stem font-size -3)
+			  (Voice Flag font-size -3)
 			  (Voice NoteHead font-size -3)
 			  (Voice TabNoteHead font-size -4)
 			  (Voice Dots font-size -3)
@@ -440,6 +450,33 @@ in @var{grob}."
      (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
      (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
 
+(define-safe-public (make-voice-props-override n)
+  (make-sequential-music
+   (append
+    (map (lambda (x) (make-grob-property-override x 'direction
+						  (if (odd? n) -1 1)))
+	 direction-polyphonic-grobs)
+    (list
+     (make-property-set 'graceSettings
+			;; TODO: take this from voicedGraceSettings or similar.
+			'((Voice Stem font-size -3)
+			  (Voice Flag font-size -3)
+			  (Voice NoteHead font-size -3)
+			  (Voice TabNoteHead font-size -4)
+			  (Voice Dots font-size -3)
+			  (Voice Stem length-fraction 0.8)
+			  (Voice Stem no-stem-extend #t)
+			  (Voice Beam beam-thickness 0.384)
+			  (Voice Beam length-fraction 0.8)
+			  (Voice Accidental font-size -4)
+			  (Voice AccidentalCautionary font-size -4)
+			  (Voice Script font-size -3)
+			  (Voice Fingering font-size -8)
+			  (Voice StringNumber font-size -8)))
+
+     (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))
+     (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+
 (define-safe-public (make-voice-props-revert)
   (make-sequential-music
    (append
@@ -510,24 +547,6 @@ in @var{grob}."
   (make-music 'PropertyUnset
 	      'symbol sym))
 
-;;; Need to keep this definition for \time calls from parser
-(define-public (make-time-signature-set num den)
-  "Set properties for time signature @var{num}/@var{den}."
-  (make-music 'TimeSignatureMusic
-              'numerator num
-              'denominator den
-              'beat-structure '()))
-
-;;; Used for calls that include beat-grouping setting
-(define-public (set-time-signature num den . rest)
-  "Set properties for time signature @var{num}/@var{den}.
-If @var{rest} is present, it is used to set @code{beatStructure}."
-  (ly:export
-   (make-music 'TimeSignatureMusic
-	       'numerator num
-	       'denominator den
-	       'beat-structure (if (null? rest) rest (car rest)))))
-
 (define-safe-public (make-articulation name)
   (make-music 'ArticulationEvent
 	      'articulation-type name))
@@ -588,6 +607,65 @@ inside of and outside of chord construct."
   (let ((ts (ly:music-property m 'types)))
     (memq 'separator ts)))
 
+;;; expanding repeat chords
+(define-public (copy-repeat-chord original-chord repeat-chord duration
+				  event-types)
+  "Copies all events in @var{event-types} (be sure to include
+@code{rhythmic-events}) from @var{original-chord} over to
+@var{repeat-chord} with their articulations filtered as well.  Any
+duration is replaced with the specified @var{duration}."
+  ;; First remove everything from event-types that can already be
+  ;; found in the repeated chord.  We don't need to look for
+  ;; articulations on individual events since they can't actually get
+  ;; into a repeat chord given its input syntax.
+  (for-each (lambda (e)
+	      (for-each (lambda (x)
+			  (set! event-types (delq x event-types)))
+			(ly:music-property e 'types)))
+	    (ly:music-property repeat-chord 'elements))
+  ;; now treat the elements
+  (set! (ly:music-property repeat-chord 'elements)
+	(append!
+	 (filter-map
+	  (lambda (m)
+	    (and (any (lambda (t) (music-is-of-type? m t)) event-types)
+		 (begin
+		   (set! m (ly:music-deep-copy m))
+		   (if (pair? (ly:music-property m 'articulations))
+		       (set! (ly:music-property m 'articulations)
+			     (filter
+			      (lambda (a)
+				(any (lambda (t) (music-is-of-type? a t))
+				     event-types))
+			      (ly:music-property m 'articulations))))
+		   (if (ly:duration? (ly:music-property m 'duration))
+		       (set! (ly:music-property m 'duration) duration))
+		   m)))
+	  (ly:music-property original-chord 'elements))
+	 (ly:music-property repeat-chord 'elements))))
+
+(define-public (expand-repeat-chords! event-types music)
+  "Walks through @var{music} and fills repeated chords (notable by
+having a duration in @code{duration}) with the notes from their
+respective predecessor chord."
+  (let loop ((music music) (last-chord #f))
+    (if (music-is-of-type? music 'event-chord)
+	(let ((chord-repeat (ly:music-property music 'duration)))
+	  (cond
+	   ((not (ly:duration? chord-repeat))
+	    music)
+	   (last-chord
+	    (set! (ly:music-property music 'duration) '())
+	    (copy-repeat-chord last-chord music chord-repeat event-types)
+	    music)
+	   (else
+	    (ly:music-warning music (_ "Bad chord repetition"))
+	    #f)))
+	(let ((elt (ly:music-property music 'element)))
+	  (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
+		(ly:music-property music 'elements)))))
+  music)
+
 ;;; splitting chords into voices.
 (define (voicify-list lst number)
   "Make a list of Musics.
@@ -630,7 +708,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
     m))
 
 (define-public (empty-music)
-  (ly:export (make-music 'Music)))
+  (make-music 'Music))
 
 ;; Make a function that checks score element for being of a specific type.
 (define-public (make-type-checker symbol)
@@ -650,21 +728,6 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
 	(set! (ly:grob-property grob symbol) val))))
 
 
-;;
-(define-public (smart-bar-check n)
-  "Make a bar check that checks for a specific bar number."
-  (let ((m (make-music 'ApplyContext)))
-    (define (checker tr)
-      (let* ((bn (ly:context-property tr 'currentBarNumber)))
-	(or (= bn n)
-	    (ly:error
-	     ;; FIXME: uncomprehensable message
-	     (_ "Bar check failed.  Expect to be at ~a, instead at ~a")
-	     n bn))))
-    (set! (ly:music-property m 'procedure) checker)
-    m))
-
-
 (define-public (skip->rest mus)
   "Replace @var{mus} by @code{RestEvent} of the same duration if it is a
 @code{SkipEvent}.  Useful for extracting parts from crowded scores."
@@ -692,12 +755,17 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; warn for bare chords at start.
 
-
 (define-public (ly:music-message music msg)
   (let ((ip (ly:music-property music 'origin)))
     (if (ly:input-location? ip)
-	(ly:input-message ip msg)
-	(ly:warning msg))))
+        (ly:input-message ip msg)
+        (ly:message msg))))
+
+(define-public (ly:music-warning music msg)
+  (let ((ip (ly:music-property music 'origin)))
+    (if (ly:input-location? ip)
+        (ly:input-warning ip msg)
+        (ly:warning msg))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -733,7 +801,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
 	   (new-settings (append current
 				 (list (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)))
+  (context-spec-music (make-apply-context set-prop) 'Voice))
 
 (define-public (remove-grace-property context-name grob sym)
   "Remove all @var{sym} for @var{grob} in @var{context-name}."
@@ -752,7 +820,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
                  (set! new-settings (delete x new-settings)))
                prop-settings)
       (ly:context-set-property! where 'graceSettings new-settings)))
-  (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice)))
+  (context-spec-music (make-apply-context delete-prop) 'Voice))
 
 
 
@@ -767,25 +835,125 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
 						      music
 						      (ly:music-deep-copy ,stop))))))
 
-(defmacro-public define-music-function (args signature . body)
+(defmacro-public define-syntax-function (type args signature . body)
   "Helper macro for `ly:make-music-function'.
 Syntax:
-  (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...)
     ...function body...)
-"
-(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+@code{result-type?} can specify a default in the same manner as
+predicates, to be used in case of a type error in arguments or
+result."
+
+  (set! signature (map (lambda (pred)
+			 (if (pair? pred)
+			     `(cons ,(car pred)
+				    ,(and (pair? (cdr pred)) (cadr pred)))
+			     pred))
+		       (cons type signature)))
+  (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
       ;; When the music function definition contains a i10n doc string,
       ;; (_i "doc string"), keep the literal string only
       (let ((docstring (cadar body))
 	    (body (cdr body)))
 	`(ly:make-music-function (list ,@signature)
-				 (lambda (,@args)
+				 (lambda ,args
 				   ,docstring
 				   ,@body)))
       `(ly:make-music-function (list ,@signature)
-			       (lambda (,@args)
+			       (lambda ,args
 				 ,@body))))
 
+(defmacro-public define-music-function rest
+  "Defining macro returning music functions.
+Syntax:
+  (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return a music expression.  The @code{origin} is automatically
+set to the @code{location} parameter."
+
+  `(define-syntax-function (ly:music? (make-music 'Music 'void #t)) ,@rest))
+
+
+(defmacro-public define-scheme-function rest
+  "Defining macro returning Scheme functions.
+Syntax:
+  (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Can return arbitrary expressions.  If a music expression is returned,
+its @code{origin} is automatically set to the @code{location}
+parameter."
+
+  `(define-syntax-function scheme? ,@rest))
+
+(defmacro-public define-void-function rest
+  "This defines a Scheme function like @code{define-scheme-function} with
+void return value (i.e., what most Guile functions with `unspecified'
+value return).  Use this when defining functions for executing actions
+rather than returning values, to keep Lilypond from trying to interpret
+the return value."
+  `(define-syntax-function (void? *unspecified*) ,@rest *unspecified*))
+
+(defmacro-public define-event-function rest
+  "Defining macro returning event functions.
+Syntax:
+  (define-event-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return an event expression.  The @code{origin} is automatically
+set to the @code{location} parameter."
+
+  `(define-syntax-function (ly:event? (make-music 'Event 'void #t)) ,@rest))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -813,7 +981,7 @@ Syntax:
 		      (if (null? clef)
 		          (make-music 'Music)
 		          (make-cue-clef-set clef))
-		      (context-spec-music (make-voice-props-set cue-voice) 'CueVoice "cue")
+		      (context-spec-music (make-voice-props-override cue-voice) 'CueVoice "cue")
 		      quote-music
 		      (context-spec-music (make-voice-props-revert) 'CueVoice "cue")
 		      (if (null? clef)
@@ -822,7 +990,7 @@ Syntax:
 	      (set! main-music
 		    (make-sequential-music
 		     (list
-		      (make-voice-props-set main-voice)
+		      (make-voice-props-override main-voice)
 		      main-music
 		      (make-voice-props-revert))))
 	      (set! (ly:music-property quote-music 'element) main-music)))
@@ -842,7 +1010,7 @@ Syntax:
 	      (set! (ly:music-property music 'quoted-events) quoted-vector)
 	      (set! (ly:music-property music 'iterator-ctor)
 		    ly:quote-iterator::constructor))
-	    (ly:warning (_ "cannot find quoted music: `~S'") quoted-name)))
+	    (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name))))
     music))
 
 
@@ -958,6 +1126,10 @@ then revert skipTypesetting."
 
 (define-public toplevel-music-functions
   (list
+   (lambda (music parser) (expand-repeat-chords!
+			   (cons 'rhythmic-event
+				 (ly:parser-lookup parser '$chord-repeat-events))
+			   music))
    (lambda (music parser) (voicify-music music))
    (lambda (x parser) (music-map music-check-error x))
    (lambda (x parser) (music-map precompute-music-length x))
@@ -1114,7 +1286,7 @@ active pitch in any octave.
 @var{laziness} states over how many bars an accidental should be remembered.
 @code{0}@tie{}is the default -- accidental lasts over 0@tie{}bar lines, that
 is, to the end of current measure.  A positive integer means that the
-accidental lasts over that many bar lines.  @code{-1} is `forget
+accidental lasts over that many bar lines.  @w{@code{-1}} is `forget
 immediately', that is, only look at key signature.  @code{#t} is `forever'."
 
   (check-pitch-against-signature context pitch barnum laziness octaveness))
@@ -1222,22 +1394,21 @@ as a context."
 		     (car rest) 'Staff))
 	(pcontext (if (pair? rest)
 		      (car rest) 'GrandStaff)))
-    (ly:export
-     (cond
+    (cond
       ;; accidentals as they were common in the 18th century.
       ((equal? style 'default)
        (set-accidentals-properties #t
 				   `(Staff ,(make-accidental-rule 'same-octave 0))
 				   '()
 				   context))
-      ;; accidentals from one voice do NOT get cancelled in other voices
+      ;; accidentals from one voice do NOT get canceled in other voices
       ((equal? style 'voice)
        (set-accidentals-properties #t
 				   `(Voice ,(make-accidental-rule '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
+      ;; This includes all the default accidentals, but accidentals also needs canceling
       ;; in other octaves and in the next measure.
       ((equal? style 'modern)
        (set-accidentals-properties #f
@@ -1302,7 +1473,7 @@ as a context."
 				   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.
+      ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
       ((equal? style 'modern-voice)
        (set-accidentals-properties  #f
 				    `(Voice ,(make-accidental-rule 'same-octave 0)
@@ -1325,7 +1496,7 @@ as a context."
 					   ,(make-accidental-rule '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
+      ;; Accidentals are canceled across the staves in the same grand staff as well
       ((equal? style 'piano)
        (set-accidentals-properties #f
 				   `(Staff ,(make-accidental-rule 'same-octave 0)
@@ -1376,7 +1547,7 @@ as a context."
 				   context))
       (else
        (ly:warning (_ "unknown accidental style: ~S") style)
-       (make-sequential-music '()))))))
+       (make-sequential-music '())))))
 
 (define-public (invalidate-alterations context)
   "Invalidate alterations in @var{context}.
@@ -1407,7 +1578,7 @@ Entries that conform with the current key signature are not invalidated."
 		   entry
 		   (cons (car entry) (cons 'clef (cddr entry))))))
 	   (ly:context-property context 'localKeySignature)))))
-  		    
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (skip-of-length mus)
@@ -1437,32 +1608,123 @@ Entries that conform with the current key signature are not invalidated."
 	 (ly:music-property (car evs) 'pitch))))
 
 (define-public (duration-of-note event-chord)
-  (let ((evs (filter (lambda (x)
-		       (music-has-type x 'rhythmic-event))
-		     (ly:music-property event-chord 'elements))))
-
-    (and (pair? evs)
-	 (ly:music-property (car evs) 'duration))))
+  (cond
+   ((pair? event-chord)
+    (or (duration-of-note (car event-chord))
+	(duration-of-note (cdr event-chord))))
+   ((ly:music? event-chord)
+    (let ((dur (ly:music-property event-chord 'duration)))
+      (if (ly:duration? dur)
+	  dur
+	  (duration-of-note (ly:music-property event-chord 'elements)))))
+   (else #f)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-public (map-some-music map? music)
+  "Walk through @var{music}, transform all elements calling @var{map?}
+and only recurse if this returns @code{#f}."
+  (let loop ((music music))
+    (or (map? music)
+	(let ((elt (ly:music-property music 'element))
+	      (elts (ly:music-property music 'elements))
+	      (arts (ly:music-property music 'articulations)))
+	  (if (ly:music? elt)
+	      (set! (ly:music-property music 'element)
+		    (loop elt)))
+	  (if (pair? elts)
+	      (set! (ly:music-property music 'elements)
+		    (map loop elts)))
+	  (if (pair? arts)
+	      (set! (ly:music-property music 'articulations)
+		    (map loop arts)))
+	  music))))
+
+(define-public (for-some-music stop? music)
+  "Walk through @var{music}, process all elements calling @var{stop?}
+and only recurse if this returns @code{#f}."
+  (let loop ((music music))
+    (if (not (stop? music))
+	(let ((elt (ly:music-property music 'element)))
+	  (if (ly:music? elt)
+	      (loop elt))
+	  (for-each loop (ly:music-property music 'elements))
+	  (for-each loop (ly:music-property music 'articulations))))))
+
+(define-public (fold-some-music pred? proc init music)
+  "This works recursively on music like @code{fold} does on a list,
+calling @samp{(@var{pred?} music)} on every music element.  If
+@code{#f} is returned for an element, it is processed recursively
+with the same initial value of @samp{previous}, otherwise
+@samp{(@var{proc} music previous)} replaces @samp{previous}
+and no recursion happens.
+The top @var{music} is processed using @var{init} for @samp{previous}."
+  (let loop ((music music) (previous init))
+    (if (pred? music)
+	(proc music previous)
+	(fold loop
+	      (fold loop
+		    (let ((elt (ly:music-property music 'element)))
+		      (if (null? elt)
+			  previous
+			  (loop elt previous)))
+		    (ly:music-property music 'elements))
+	      (ly:music-property music 'articulations)))))
+
+(define-public (extract-music music pred?)
+  "Return a flat list of all music matching @var{pred?} inside of
+@var{music}, not recursing into matches themselves."
+  (reverse! (fold-some-music pred? cons '() music)))
+
 (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)))
+  "Return a flat list of all music named @var{music-name} (either a
+single event symbol or a list of alternatives) inside of @var{music},
+not recursing into matches themselves."
+  (extract-music
+   music
+   (if (cheap-list? music-name)
+       (lambda (m) (memq (ly:music-property m 'name) music-name))
+       (lambda (m) (eq? (ly:music-property m 'name) music-name)))))
+
+(define-public (extract-typed-music music type)
+  "Return a flat list of all music with @var{type} (either a single
+type symbol or a list of alternatives) inside of @var{music}, not
+recursing into matches themselves."
+  (extract-music
+   music
+   (if (cheap-list? type)
+       (lambda (m)
+	 (any (lambda (t) (music-is-of-type? m t)) type))
+       (lambda (m) (music-is-of-type? m type)))))
+
+(define*-public (event-chord-wrap! music #:optional parser)
+  "Wrap isolated rhythmic events and non-postevent events in
+@var{music} inside of an @code{EventChord}.  If the optional
+@var{parser} argument is given, chord repeats @samp{q} are expanded
+using the default settings.  Otherwise, you need to cater for them
+yourself."
+  (map-some-music
+   (lambda (m)
+     (cond ((music-is-of-type? m 'event-chord)
+	    (if (pair? (ly:music-property m 'articulations))
+		(begin
+		  (set! (ly:music-property m 'elements)
+			(append (ly:music-property m 'elements)
+				(ly:music-property m 'articulations)))
+		  (set! (ly:music-property m 'articulations) '())))
+	    m)
+	   ((music-is-of-type? m 'rhythmic-event)
+	    (let ((arts (ly:music-property m 'articulations)))
+	      (if (pair? arts)
+		  (set! (ly:music-property m 'articulations) '()))
+	      (make-event-chord (cons m arts))))
+	   (else #f)))
+   (if parser
+       (expand-repeat-chords!
+	(cons 'rhythmic-event
+	      (ly:parser-lookup parser '$chord-repeat-events))
+	music)
+       music)))
 
 (define-public (event-chord-notes event-chord)
   "Return a list of all notes from @var{event-chord}."