X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=60a38b0f5639ed629aee0176c96c44d30020bf0e;hb=1d2eff6548862f1ab76ef6c08f46a737fcceb1fb;hp=9a3a4c10691cfb1bb14ac43910c2fdf562a42895;hpb=18b1975ebc7601abf5fb49df87d5a965c53fce9b;p=lilypond.git

diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index 9a3a4c1069..60a38b0f56 100644
--- a/scm/define-music-display-methods.scm
+++ b/scm/define-music-display-methods.scm
@@ -1,7 +1,7 @@
 ;;; define-music-display-methods.scm -- data for displaying music
 ;;; expressions using LilyPond notation.
 ;;;
-;;; (c) 2005--2009 Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2009 Nicolas Sceaux  <nicolas.sceaux@free.fr>
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -81,7 +81,7 @@
     (if (and (car alist) (test item (cdar alist)))
 	(set! result (car alist)))))
 
-(define (note-name->lily-string ly-pitch parser)
+(define-public (note-name->lily-string ly-pitch parser)
   ;; here we define a custom pitch= function, since we do not want to
   ;; test whether octaves are also equal. (otherwise, we would be using equal?)
   (define (pitch= pitch1 pitch2)
@@ -92,7 +92,7 @@
 	(car result)
 	#f)))
 
-(define (octave->lily-string pitch)
+(define-public (octave->lily-string pitch)
   (let ((octave (ly:pitch-octave pitch)))
     (cond ((>= octave 0)
 	   (make-string (1+ octave) #\'))
@@ -103,7 +103,7 @@
 ;;;
 ;;; durations
 ;;;
-(define* (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
+(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*)))
@@ -134,33 +134,34 @@
 ;;; post events
 ;;;
 
-(define post-event? (make-music-type-predicate
-		     'StringNumberEvent
-		     'ArticulationEvent
-		     'FingeringEvent
-		     'TextScriptEvent
-		     'MultiMeasureTextEvent
-		     'HyphenEvent
-		     'ExtenderEvent
-		     'BeamEvent
-		     'SlurEvent
-		     'TieEvent
-		     'CrescendoEvent
-		     'DecrescendoEvent
-		     'PhrasingSlurEvent
-		     'TremoloEvent
-		     'SustainEvent
-		     'SostenutoEvent
-		     'TextSpanEvent
-		     'HarmonicEvent
-		     'BeamForbidEvent
-		     'AbsoluteDynamicEvent
-		     'TupletSpanEvent
-		     'TrillSpanEvent
-		     'GlissandoEvent
-		     'ArpeggioEvent
-		     'NoteGroupingEvent
-		     'UnaCordaEvent))
+(define post-event?
+  (make-music-type-predicate
+    'AbsoluteDynamicEvent
+    'ArpeggioEvent
+    'ArticulationEvent
+    'BeamEvent
+    'BeamForbidEvent
+    'CrescendoEvent
+    'DecrescendoEvent
+    'ExtenderEvent
+    'FingeringEvent
+    'GlissandoEvent
+    'HarmonicEvent
+    'HyphenEvent
+    'MultiMeasureTextEvent
+    'NoteGroupingEvent
+    'PhrasingSlurEvent
+    'SlurEvent
+    'SostenutoEvent
+    'StringNumberEvent
+    'SustainEvent
+    'TextScriptEvent
+    'TextSpanEvent
+    'TieEvent
+    'TremoloEvent
+    'TrillSpanEvent
+    'TupletSpanEvent
+    'UnaCordaEvent))
 
 (define* (event-direction->lily-string event #:optional (required #t))
   (let ((direction (ly:music-property event 'direction)))
@@ -960,11 +961,11 @@ Otherwise, return #f."
 								 symbol 'clefOctavation)
 							  (music 'ApplyContext
 								 procedure ly:set-middle-C!)))))
-    (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
+    (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
 				 clef-name-alist)))
-      (if clef-prop+name
+      (if clef-name
 	  (format #f "\\clef \"~a~{~a~a~}\"~a"
-		  (cdr clef-prop+name)
+		  clef-name
 		  (cond ((= 0 ?clef-octavation)
 			 (list "" ""))
 			((> ?clef-octavation 0)
@@ -977,32 +978,37 @@ Otherwise, return #f."
 ;;; \time
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a time signature set, return \"\\time ...\".
-Otherwise, return #f."
-  (with-music-match (expr (music
-			   'ContextSpeccedMusic
-			   element (music
-				    'ContextSpeccedMusic
-				    context-type 'Timing
-				    element (music
-					     'SequentialMusic
-					     elements ((music
-							'PropertySet
-							value ?num+den
-							symbol 'timeSignatureFraction)
-						       (music
-							'PropertySet
-							symbol 'beatLength)
-						       (music
-							'PropertySet
-							symbol 'measureLength)
-						       (music
-							'PropertySet
-							value ?grouping
-							symbol 'beatGrouping))))))
-    (if (null? ?grouping)
-	(format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
-	(format #f "#(set-time-signature ~a ~a '~s)~a"
-		(car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
+Otherwise, return #f.  Note: default grouping is not available."
+  (with-music-match
+   (expr (music
+           'ContextSpeccedMusic
+	   element (music
+	            'ContextSpeccedMusic
+		    context-type 'Timing
+		    element (music
+			     'SequentialMusic
+			     elements ?elts))))
+   (and
+    (> (length ?elts) 2)
+    (with-music-match ((cadr ?elts)
+                       (music 'PropertySet
+                              symbol 'beatLength))
+       #t)
+    (with-music-match ((caddr ?elts)
+                       (music 'PropertySet
+                              symbol 'measureLength))
+       #t)
+    (with-music-match ((car ?elts)
+                       (music 'PropertySet
+                              value ?num+den
+                              symbol 'timeSignatureFraction))
+       (if (eq? (length ?elts) 3)
+           (format
+             #f "\\time ~a/~a~a"
+             (car ?num+den) (cdr ?num+den) (new-line->lily-string))
+           (format
+             #f "#(set-time-signature ~a ~a '(<grouping-specifier>))~a"
+             (car ?num+den) (cdr ?num+den)  (new-line->lily-string)))))))
 
 ;;; \bar
 (define-extra-display-method ContextSpeccedMusic (expr parser)
@@ -1027,6 +1033,7 @@ Otherwise, return #f."
 	     ((= i dots) m)
 	   (set! m (+ m delta)))
 	 factor))))
+
 (define moment-duration-alist (map (lambda (duration)
 				     (cons (duration->moment duration)
 					   duration))
@@ -1037,9 +1044,7 @@ Otherwise, return #f."
 					       (list 0 1 2 3 4))))
 
 (define (moment->duration moment)
-  (let ((result (assoc (- moment) moment-duration-alist =)))
-    (and result
-	 (cdr result))))
+  (assoc-get (- moment) moment-duration-alist))
 
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a partial measure, return \"\\partial ...\".