release: 1.3.93

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

diff --git a/scm/chord-names.scm b/scm/chord-names.scm
index 738fdb4abed7e69bfb725f25e60fc8c2762b4af3..27f4314bfb3147cff75c0f18dfe1dc7ce922fe47 100644 (file)
--- a/scm/chord-names.scm
+++ b/scm/chord-names.scm
@@ -10,6 +10,15 @@
    (ice-9 regex)
    )
 
+;; The regex module may not be available, or may be broken.
+(define chord-use-regex
+  (let ((os (string-downcase (vector-ref (uname) 0))))
+    (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
+
+;; If you have trouble with regex, define #f
+(define chord-use-regex #t)
+;;(define chord-use-regex #f)
+
 ;;
 ;; (octave notename accidental)
 ;;
@@ -58,41 +67,50 @@
       chord::names-alist-banter))
 
 
+;; NOTE: Duplicates of chord names defined elsewhere occur in this list
+;; in order to prevent spurious superscripting of various chord names,
+;; such as maj7, maj9, etc.
+;;
+;; See input/test/american-chords.ly
+;;
+;; James Hammons, <jlhamm@pacificnet.net>
+
 (define chord::names-alist-american '())
 (set! chord::names-alist-american
       (append 
        '(
         (((0 . 0)) . #f)
         (((0 . 0) (2 . 0)) . #f)
+        ;; Root-fifth chord
+        (((0 . 0) (4 . 0)) . ("5"))
+        ;; Common triads
         (((0 . 0) (2 . -1)) . ("m"))
-        (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
-        (((0 . 0) (4 . 0)) . (("5" (type . "super"))))
         (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
-        (((0 . 0) (2 . -1) (4 . -1)) . (("o" (type . "super"))))
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o7" (type . "super"))))
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("x7" (type . "super"))))
-
+        (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
+;Alternate:     (((0 . 0) (2 . -1) (4 . -1)) . (("o" (type . "super"))))
         (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
-        (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . (("aug" ("7" (type . "super")))))
-
-        (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (("maj7" (type . "super")) ("accidentals--1" (font . "feta") (type . "super")) ("5" (type . "super"))))
-         
-        (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . (("7sus4" (type . "super"))))
-
-        (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (("maj6" (type . "super"))))
-        ;; dont need this?
-        ;(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6" . ""))
-
-        ;; c = 0, d = 1
-        ;;(((0 . 0) (2 . 0) (4 . 0) (8 . 0)) . ("add9" . ""))
-        ;;(((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("" . (("script" . "add9"))))
-
-        ;; we don't want the '/no7'
-        ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (8 . 0)) . ("6/9" . ""))
-        ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (("script" . "6/9"))))
-
-        ;;already have this?
-        ;;(((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9" . ""))
+;Alternate:     (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
+        (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
+        ;; Common seventh chords
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o" (type . "super")) "7"))
+        (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
+        (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
+        (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
+        (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
+        ;jazz: the delta, see jazz-chords.ly
+        ;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (("N" (type . "super") (style . "msam") (size . -3))))
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("o" (type . "super")) ("/" (size . -2) (offset . (-0.58 . 0.5))) "7")) ; slashed o
+        (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
+        (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (("maj7") ("accidentals--1" (font . "feta") (type . "super")) ("5")))
+        (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
+        ;; Common ninth chords
+        (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7'
+        (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("maj6"))
+        (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
+        (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
+        (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
+        (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
+        (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
 
         )
       chord::names-alist-american))
@@ -110,7 +128,8 @@
       '()
       (list (list (string-append "accidentals-" 
                                 (number->string (caddr pitch)))
-                 '(font . "feta"))))))
+                                  ;; Keep accidentals from being too large
+                 '(font . "feta") '(type . "super") )))))
 
 (define (step->text pitch)
   (string-append
@@ -249,7 +268,8 @@
     (apply append (pitch->text-banter tonic)
           (if user-name user-name '())
           ;; why does list->string not work, format seems only hope...
-          (if (and (string-match "super" (format "~s" user-name))
+          (if (and chord-use-regex
+                   (string-match "super" (format "~s" user-name))
                    (or (pair? additions)
                        (pair? subtractions)))
               '(("/" (type . "super")))
@@ -310,15 +330,15 @@
 ;; parts, complete the missing user-override matched part with normal
 ;; chord to be name-calculated.
 ;;
-(define (chord::user-name style pitches base-and-inversion)
+(define (default-chord-name-function style pitches base-and-inversion)
   ;(display "pitches:") (display  pitches) (newline)
   ;(display "style:") (display  style) (newline)
   ;(display "b&i:") (display  base-and-inversion) (newline)
   (let ((diff (pitch::diff '(0 0 0) (car pitches)))
        (name-func 
-         (eval (string->symbol (string-append "chord::name-" style))))
+         (ly-eval (string->symbol (string-append "chord::name-" style))))
        (names-alist 
-         (eval (string->symbol (string-append "chord::names-alist-" style)))))
+         (ly-eval (string->symbol (string-append "chord::names-alist-" style)))))
   (let loop ((note-names (reverse pitches))
             (chord '())
             (user-name #f))