Web-es: update NEWS.

[lilypond.git] / scm / parser-clef.scm

diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm
index b2c6dc20849a47eddc2a73fa02c45860bdff88cd..56284f9c4dc6111d41dc8691a00178553a60ff44 100644 (file)
--- a/scm/parser-clef.scm
+++ b/scm/parser-clef.scm
@@ -170,74 +170,30 @@
 (define-public (make-cue-clef-set clef-name)
   "Generate the clef setting commands for a cue clef with name
 @var{clef-name}."
-  (define (make-prop-set props)
-    (let ((m (make-music 'PropertySet)))
-      (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
-      m))
-  (let ((e '())
-       (c0 0)
-       (oct 0)
-       (style 'default)
-       (match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name)))
-    (if match
-       (begin
-         (set! clef-name (match:substring match 1))
-         (set! oct
-               (* (if (equal? (match:substring match 2) "^") -1 1)
-                  (- (string->number (match:substring match 4)) 1)))
-          (set! style
-                (cond ((equal? (match:substring match 3) "(") 'parenthesized)
-                      ((equal? (match:substring match 3) "[") 'bracketed)
-                      (else style)))))
-    (set! e (assoc-get clef-name supported-clefs))
-    (if e
-       (let* ((prop-list `(((symbol . cueClefGlyph) (value . ,(car e)))
-                            ((symbol . middleCCuePosition)
-                             (value . ,(+ oct
-                                          (cadr e)
-                                          (assoc-get (car e) c0-pitch-alist))))
-                            ((symbol . cueClefPosition) (value . ,(cadr e)))
-                            ((symbol . cueClefOctavation) (value . ,(- oct)))))
-               (prop-list (if (eq? style 'default)
-                              prop-list
-                              (append
-                                prop-list
-                                `(((symbol . cueClefOctavationStyle)
-                                   (value . ,style))))))
-              (musics (map make-prop-set prop-list))
-              (recalc-mid-C (make-music 'ApplyContext))
-              (seq (make-music 'SequentialMusic
-                               'elements (append musics (list recalc-mid-C))))
-              (csp (make-music 'ContextSpeccedMusic)))
-         (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
-         (context-spec-music seq 'Staff))
-       (begin
-         (ly:warning (_ "unknown clef type `~a'") clef-name)
-         (ly:warning (_ "supported clefs: ~a")
-                     (string-join
-                      (sort (map car supported-clefs) string<?)))
-         (make-music 'Music)))))
-
+  (define cue-clef-map
+    '((clefGlyph . cueClefGlyph)
+      (middleCClefPosition . middleCCuePosition)
+      (clefPosition . cueClefPosition)
+      (clefOctavation . cueClefOctavation)
+      (clefOctavationStyle . cueClefOctavationStyle)))
+  (let ((clef (make-clef-set clef-name)))
+    (for-each
+     (lambda (m)
+       (let ((mapped (assq-ref cue-clef-map
+                               (ly:music-property m 'symbol))))
+         (if mapped
+             (set! (ly:music-property m 'symbol) mapped))))
+     (extract-named-music clef 'PropertySet))
+    clef))
 
 (define-public (make-cue-clef-unset)
   "Reset the clef settings for a cue clef."
-  (define (make-prop-unset props)
-    (let ((m (make-music 'PropertyUnset)))
-      (set! (ly:music-property m (car props)) (cdr props))
-      m))
-  (let* ((musics (map make-prop-unset
-                       `((symbol . cueClefGlyph)
-                         (symbol . middleCCuePosition)
-                         (symbol . cueClefPosition)
-                         (symbol . cueClefOctavation)
-                         (symbol . cueClefOctavationStyle))))
-        (recalc-mid-C (make-music 'ApplyContext))
-        (seq (make-music 'SequentialMusic
-                         'elements (append musics (list recalc-mid-C))))
-        (csp (make-music 'ContextSpeccedMusic)))
-    (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
-    (context-spec-music seq 'Staff)))
-
+  (map-some-music
+   (lambda (m)
+     (and (eq? (ly:music-property m 'name) 'PropertySet)
+          (make-music 'PropertyUnset
+                      'symbol (ly:music-property m 'symbol))))
+   (make-cue-clef-set "treble_(8)")))
 
 ;; a function to add new clefs at runtime
 (define-public (add-new-clef clef-name clef-glyph clef-position octavation c0-position)