Allows optional octavation for clefs

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

diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm
index f0a79c518f0e31ff6fc9f32500dd7b82d9d91c18..b2c6dc20849a47eddc2a73fa02c45860bdff88cd 100644 (file)
--- a/scm/parser-clef.scm
+++ b/scm/parser-clef.scm
@@ -124,23 +124,36 @@
   (let ((e '())
        (c0 0)
        (oct 0)
-       (match (string-match "^(.*)([_^])([1-9][0-9]*)$" clef-name)))
+       (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 3)) 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* ((musics (map make-prop-set
-                           `(((symbol . clefGlyph) (value . ,(car e)))
-                             ((symbol . middleCClefPosition)
-                              (value . ,(+ oct
-                                           (cadr e)
-                                           (assoc-get (car e) c0-pitch-alist))))
-                             ((symbol . clefPosition) (value . ,(cadr e)))
-                             ((symbol . clefOctavation) (value . ,(- oct))))))
+       (let* ((prop-list `(((symbol . clefGlyph) (value . ,(car e)))
+                            ((symbol . middleCClefPosition)
+                             (value . ,(+ oct
+                                          (cadr e)
+                                          (assoc-get (car e) c0-pitch-alist))))
+                            ((symbol . clefPosition) (value . ,(cadr e)))
+                            ((symbol . clefOctavation) (value . ,(- oct)))))
+               ;; the clefOctavationStyle property is set only when
+               ;; not 'default to calm display-lily-tests.scm
+               (prop-list (if (eq? style 'default)
+                              prop-list
+                              (append
+                                prop-list
+                                `(((symbol . clefOctavationStyle)
+                                   (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))))
@@ -164,23 +177,34 @@
   (let ((e '())
        (c0 0)
        (oct 0)
-       (match (string-match "^(.*)([_^])([1-9][0-9]*)$" clef-name)))
+       (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 3)) 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* ((musics (map make-prop-set
-                           `(((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))))))
+       (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))))
@@ -205,7 +229,8 @@
                        `((symbol . cueClefGlyph)
                          (symbol . middleCCuePosition)
                          (symbol . cueClefPosition)
-                         (symbol . cueClefOctavation))))
+                         (symbol . cueClefOctavation)
+                         (symbol . cueClefOctavationStyle))))
         (recalc-mid-C (make-music 'ApplyContext))
         (seq (make-music 'SequentialMusic
                          'elements (append musics (list recalc-mid-C))))