release: 1.5.29

[lilypond.git] / scm / chord-name.scm

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 98a92708750095693e34a96c3b0568ce404ce7de..004aededa266461b6e0171626f8d5b80a3df96a9 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -52,7 +52,11 @@
        (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4") " " ))
        ;; Cdim iso Cm5-
        (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
-       ; Co iso Cm5-7-
+       ; URG: Simply C:m5-/maj7 iso Cdim maj7
+       (((0 . 0) (2 . -1) (4 . -1) (6 . 0)) . ("m" (super "5-/maj7" " ")))
+       ; URG: Simply C:m5-/7 iso Cdim7
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . ("m" (super "5-/7" " ")))
+       ; Co iso C:m5-/7-
         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") " "))
        ; Cdim9
        (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9") " "))
@@ -218,7 +222,6 @@
    * TODO: any uneven step that's lower than an uneven step which is
      chromatically altered
   "
-  (write-me "adds: " 
   (let ((evens (filter-list (lambda (x) (!= 0 (modulo (cadr x) 2))) steps))
        (altered-unevens
         (filter-list (lambda (x)
@@ -236,13 +239,13 @@
                       '()))))
     ;; Hmm, what if we have a step twice, can we ignore that?
     (uniq-list (sort (apply append evens altered-unevens highest)
-                    pitch::<)))))
+                    pitch::<))))
        
      
 ;; FIXME: unLOOP, see ::additions
 ;; find the pitches that are missing from `normal' chord
 (define (chord::subtractions chord-pitches)
-  (write-me "subs: " (let ((tonic (car chord-pitches)))
+  (let ((tonic (car chord-pitches)))
     (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
       (if (pair? pitches)
        (let* ((pitch (car pitches))
@@ -265,7 +268,7 @@
            (if (= p-step step)
              (loop (+ step 2) (cdr pitches) subtractions)
              (loop step (cdr pitches) subtractions)))))
-       (reverse subtractions))))))
+       (reverse subtractions)))))
 
 (define (chord::additions->text-banter additions subtractions)
   (if (pair? additions)
@@ -309,18 +312,19 @@
 ;; additions, subtractions and bass or inversion into chord name
 (define (chord::inner-name-banter tonic exception-part additions subtractions
                                  bass-and-inversion steps)
-  (let ((tonic-text (pitch->chord-name-text-banter tonic steps))
-       (except-text exception-part)
-       (sep-text (if (and (string-match "super" (format "~s" exception-part))
+  (let* ((tonic-text (pitch->chord-name-text-banter tonic steps))
+        (except-text exception-part)
+        (sep-text (if (and (string-match "super" (format "~s" except-text))
                            (or (pair? additions)
                                (pair? subtractions)))
                       (list simple-super "/")))
-       (adds-text (chord::additions->text-banter additions subtractions))
-       (subs-text (chord::subtractions->text-banter subtractions))
-       (b+i-text (chord::bass-and-inversion->text-banter bass-and-inversion)))
+        (adds-text (chord::additions->text-banter additions subtractions))
+        (subs-text (chord::subtractions->text-banter subtractions))
+        (b+i-text (chord::bass-and-inversion->text-banter bass-and-inversion)))
     (text-append
-     tonic-text except-text sep-text
-     (list (list simple-super) adds-text subs-text)
+     tonic-text except-text " " sep-text
+     ;;(list (list simple-super) adds-text subs-text)
+     (list (list '((raise . 1) (font-relative-size . -1))) adds-text subs-text)
      b+i-text)))
 
 (define (chord::name-banter tonic exception-part unmatched-steps
@@ -344,7 +348,7 @@
                              bass-and-inversion steps)))
 
 (define (chord::restyle name style)
-  (ly-eval (string->symbol
+  (primitive-eval (string->symbol
            (string-append (symbol->string name)
                           (symbol->string style)))))
 
@@ -376,7 +380,7 @@
 ;; return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
 ;; BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
 (define (chord::exceptions-lookup style steps)
-  (write-me "xl: " (let* ((result (chord::exceptions-lookup-helper
+  (let* ((result (chord::exceptions-lookup-helper
                  (chord::restyle 'chord::names-alist- style)
                  steps '() #f))
           (exception-part (car result))
@@ -391,7 +395,7 @@
                        ((= i 0) base)
                      ())
                    unmatched-steps)))
-    (list exception-part unmatched-with-1-3-5))))
+    (list exception-part unmatched-with-1-3-5)))
 
 
 (define (chord::name->text style tonic steps bass-and-inversion)