Implement shorten-pair for Hairpin

[lilypond.git] / scm / define-music-display-methods.scm

diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index 01eae4bfbbfef9e7128a72af8b4c634115a9138e..a5ccd9284928289f37284e44b63b870280973c39 100644 (file)
--- a/scm/define-music-display-methods.scm
+++ b/scm/define-music-display-methods.scm
@@ -89,8 +89,7 @@ expression."
   (define (pitch= pitch1 pitch2)
     (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
          (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
-  (let* ((pitches (ly:parser-lookup 'pitchnames))
-         (result (rassoc ly-pitch pitches pitch=)))
+  (let* ((result (rassoc ly-pitch pitchnames pitch=)))
     (and result (car result))))
 
 (define-public (octave->lily-string pitch)
@@ -126,8 +125,7 @@ expression."
 ;;; post events
 ;;;
 
-(define (post-event? m)
-  (music-is-of-type? m 'post-event))
+(define post-event? (music-type-predicate 'post-event))
 
 (define* (event-direction->lily-string event #:optional (required #t))
   (let ((direction (ly:music-property event 'direction)))
@@ -418,7 +416,7 @@ Otherwise, return #f."
          (chord-repeat (ly:music-property chord 'duration)))
     (call-with-values
         (lambda ()
-          (partition (lambda (m) (music-is-of-type? m 'rhythmic-event))
+          (partition (music-type-predicate 'rhythmic-event)
                      elements))
       (lambda (chord-elements other-elements)
         (cond ((pair? chord-elements)
@@ -630,7 +628,7 @@ Otherwise, return #f."
                       (format #f "~s" string)
                       string))
                 (markup->lily-string text)))
-          (map-in-order (lambda (m) (music->lily-string m))
+          (map-in-order music->lily-string
                         (ly:music-property lyric 'articulations))))
 
 (define-display-method BreathingEvent (event)
@@ -810,7 +808,8 @@ Otherwise, return #f."
             (new-line->lily-string))))
 
 (define-display-method PropertyUnset (expr)
-  (format #f "\\unset ~a~a~a"
+  (format #f "~a\\unset ~a~a~a"
+          (if (ly:music-property expr 'once #f) "\\once " "")
           (if (eqv? (*current-context*) 'Bottom)
               ""
               (format #f "~a . " (*current-context*)))
@@ -840,8 +839,11 @@ Otherwise, return #f."
 (define-display-method RevertProperty (expr)
   (let* ((symbol (ly:music-property expr 'symbol))
          (properties (ly:music-property expr 'grob-property-path
-                                        (list (ly:music-property expr 'grob-property)))))
-    (format #f "\\revert ~{~a~^.~}~a"
+                                        (list (ly:music-property expr
+                                                                 'grob-property))))
+         (once (ly:music-property expr 'once #f)))
+    (format #f "~a\\revert ~{~a~^.~}~a"
+            (if once "\\once " "")
             (if (eqv? (*current-context*) 'Bottom)
                 (cons symbol properties)
                 (cons* (*current-context*) symbol properties))
@@ -857,7 +859,11 @@ Otherwise, return #f."
                 num den
                 (new-line->lily-string))
         (format #f
-                "\\time #'~a ~a/~a~a"
+                ;; This is silly but the latter will also work for #f
+                ;; and other
+                (if (key-list? structure)
+                    "\\time ~{~a~^,~} ~a/~a~a"
+                    "\\time #'~a ~a/~a~a")
                 structure num den
                 (new-line->lily-string)))))
 
@@ -1120,7 +1126,10 @@ Otherwise, return #f."
                                  elements ((music 'ContextSpeccedMusic
                                                   context-id "up"
                                                   context-type 'Staff
-                                                  element (music 'SimultaneousMusic elements (?ac-music)))
+                                                  element ?ac-music)
+                                           (music 'ContextSpeccedMusic
+                                                  context-id "up"
+                                                  context-type 'Staff)
                                            (music 'ContextSpeccedMusic
                                                   context-id "down"
                                                   context-type 'Staff))))