scm/chord-name.scm

   1 ;;;
   2 ;;; chord-name.scm -- Compile chord name
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c) 2000--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8
   9
  10 (use-modules
  11    (ice-9 debug)
  12    (ice-9 format)
  13    (ice-9 regex)
  14    (ice-9 string-fun)
  15    )
  16
  17 ;;
  18 ;; (octave notename accidental)
  19 ;;
  20
  21 ;;
  22 ;; text: scm markup text -- see font.scm and input/test/markup.ly
  23 ;;
  24
  25 ;; TODO
  26 ;;
  27 ;; * clean split of base/banter/american stuff
  28 ;; * text definition is rather ad-hoc
  29 ;; * do without format module
  30 ;; * finish and check american names
  31 ;; * make notename (tonic) configurable from lilypond
  32 ;; * fix append/cons stuff in inner-name-banter
  33 ;; * doc strings.
  34
  35 ;;;;;;;;;
  36 (define chord::names-alist-banter '())
  37 (set! chord::names-alist-banter
  38       (append
  39         '(
  40         ; C iso C.no3.no5
  41         (((0 . 0)) . #f)
  42         ; C iso C.no5
  43         (((0 . 0) (2 . 0)) . #f)
  44         ; Cm iso Cm.no5
  45         (((0 . 0) (2 . -1)) . ("m"))
  46         ; C2 iso C2.no3
  47         (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2")))
  48         ; C4 iso C4.no3
  49         (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4")))
  50         ;; Cdim iso Cm5-
  51         (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
  52         ; Co iso Cm5-7-
  53         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
  54         ; Cdim9
  55         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9")))
  56         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11")))
  57         )
  58       chord::names-alist-banter))
  59
  60
  61 ;; NOTE: Duplicates of chord names defined elsewhere occur in this list
  62 ;; in order to prevent spurious superscripting of various chord names,
  63 ;; such as maj7, maj9, etc.
  64 ;;
  65 ;; See input/test/american-chords.ly
  66 ;;
  67 ;; James Hammons, <jlhamm@pacificnet.net>
  68 ;;
  69
  70 ;; DONT use non-ascii characters, even if ``it works'' in Windows
  71
  72 (define chord::names-alist-american '())
  73
  74 (set! chord::names-alist-american
  75       (append
  76        '(
  77          (((0 . 0)) . #f)
  78          (((0 . 0) (2 . 0)) . #f)
  79          ;; Root-fifth chord
  80          (((0 . 0) (4 . 0)) . ("5"))
  81          ;; Common triads
  82          (((0 . 0) (2 . -1)) . ("m"))
  83          (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
  84          (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
  85 ;Alternate:      (((0 . 0) (2 . -1) (4 . -1)) . ("" (super "o")))
  86          (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
  87 ;Alternate:      (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
  88          (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
  89          ;; Common seventh chords
  90          (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") "7"))
  91          (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
  92          (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
  93          (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
  94          (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
  95          ;jazz: the delta, see jazz-chords.ly
  96          ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (super ((font-family . math) "N"))
  97          ;; ugh, kludge slashed o
  98          ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((kern . -0.85) ((raise . 0.57) ((font-relative-size . -3) "/"))) "7")) ; slashed o
  99          (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") (((kern . -0.85) (raise . 1.1) (font-relative-size . -2)) "/") "7")) ; slashed o
 100
 101          (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
 102          (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
 103          (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
 104          (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
 105          ;; Common ninth chords
 106          (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7'
 107          (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6"))
 108          (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
 109          (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
 110          (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
 111          (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
 112          (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
 113
 114          )
 115       chord::names-alist-american))
 116
 117 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
 118 ;; NBs: This uses the american list as a base.
 119 ;;      Some defs take up more than one line,
 120 ;; be carefull when messing with ;'s!!
 121
 122
 123 ;; FIXME
 124 ;;
 125 ;; This is getting out-of hand?  Only exceptional chord names that
 126 ;; cannot be generated should be here.
 127 ;; Maybe we should have inner-jazz-name and inner-american-name functions;
 128 ;;
 129 ;;
 130 ;;
 131 ;; DONT use non-ascii characters, even if ``it works'' in Windows
 132
 133 (define chord::names-alist-jazz '())
 134 (set! chord::names-alist-jazz
 135       (append
 136       '(
 137         ;; major chords
 138         ; major sixth chord = 6
 139         (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6")))
 140         ; major seventh chord = triangle
 141         ;; shouldn't this be a filled black triange, like this:  ? --jcn
 142         ;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "N"))))
 143         (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "M"))))
 144         ; major chord add nine = add9
 145         (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9")))
 146         ; major sixth chord with nine = 6/9
 147         (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9")))
 148
 149         ;; minor chords
 150         ; minor sixth chord = m6
 151         (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
 152         ;; minor major seventh chord = m triangle
 153         ;; shouldn't this be a filled black triange, like this:  ? --jcn
 154         ;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "N"))))
 155         (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "M"))))
 156         ; minor seventh chord = m7
 157         (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
 158         ; minor sixth nine chord = m6/9
 159         (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9")))
 160         ; minor with added nine chord = madd9
 161         (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
 162         ; minor ninth chord = m9
 163         (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
 164
 165         ;; dominant chords
 166         ; dominant seventh = 7
 167         (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
 168         ; augmented dominant = +7
 169         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised
 170         (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised
 171         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
 172         ;       ((raise . 0.3)(music (named ("accidentals-1"))))
 173         ;       ((raise . 0.5) "5)"))); 7(#5)
 174         ; dominant flat 5 = 7(b5)
 175         (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
 176                 ((raise . 0.3)(music (named ("accidentals--1"))))
 177                 ((raise . 0.5) "5)")))
 178         ; dominant 9 = 7(9)
 179         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)")))
 180         ; dominant flat 9 = 7(b9)
 181         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . (
 182                 ((raise . 0.8)"7(")
 183                 ((raise . 0.3)(music (named ("accidentals--1"))))
 184                 ((raise . 0.8)"9)")))
 185         ; dominant sharp 9 = 7(#9)
 186         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . (
 187                 ((raise . 0.8)"7(")
 188                 ((raise . 0.3)(music (named ("accidentals-1"))))
 189                 ((raise . 0.8)"9)")))
 190         ; dominant 13 = 7(13)
 191         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)")))
 192         ; dominant flat 13 = 7(b13)
 193         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . (
 194                 ((raise . 0.8)"7(")
 195                 ((raise . 0.3)(music (named ("accidentals--1"))))
 196                 ((raise . 0.8)"13)")))
 197         ; dominant 9, 13 = 7(9,13)
 198         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)")))
 199         ; dominant flat 9, 13 = 7(b9,13)
 200         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . (
 201                 ((raise . 0.8)"7(")
 202                 ((raise . 0.3)(music (named ("accidentals--1"))))
 203                 ((raise . 0.8)"9, 13)")))
 204         ; dominant sharp 9, 13 = 7(#9,13)
 205         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . (
 206                 ((raise . 0.8)"7(")
 207                 ((raise . 0.3)(music (named ("accidentals-1"))))
 208                 ((raise . 0.8)"9, 13)")))
 209         ; dominant 9, flat 13 = 7(9,b13)
 210         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . (
 211                 ((raise . 0.8)"7(9, ")
 212                 ((raise . 0.3)(music (named ("accidentals--1"))))
 213                 ((raise . 0.8)"13)")))
 214         ; dominant flat 9, flat 13 = 7(b9,b13)
 215         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . (
 216                 ((raise . 0.8)"7(")
 217                 ((raise . 0.3)(music (named ("accidentals--1"))))
 218                 ((raise . 0.8)"9, ")
 219                 ((raise . 0.3)(music (named ("accidentals--1"))))
 220                 ((raise . 0.8)"13)")))
 221         ; dominant sharp 9, flat 13 = 7(#9,b13)
 222         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . (
 223                 ((raise . 0.8)"7(")
 224                 ((raise . 0.3)(music (named ("accidentals-1"))))
 225                 ((raise . 0.8)"9, ")
 226                 ((raise . 0.3)(music (named ("accidentals--1"))))
 227                 ((raise . 0.8)"13)")))
 228
 229         ;; diminished chord(s)
 230         ; diminished seventh chord =  o
 231
 232
 233         ;; DONT use non-ascii characters, even if ``it works'' in Windows
 234
 235         ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
 236         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
 237
 238         ;; half diminshed chords
 239         ;; half diminished seventh chord = slashed o
 240         ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
 241         (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") (((kern . -0.85) (raise . 1.1) (font-relative-size . -2)) "/") "7")) ; slashed o
 242
 243         ; half diminished seventh chord  with major 9 = slashed o cancelation 9
 244         (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
 245                 ((raise . 0.8)"/o(")
 246                 ((raise . 0.3)(music (named ("accidentals-0"))))
 247                 ((raise . 0.8)"9)")));
 248
 249 ;; Missing jazz chord definitions go here (note new syntax: see american for hints)
 250
 251         )
 252       chord::names-alist-american))
 253
 254 ;;;;;;;;;;
 255
 256
 257 (define (pitch->note-name pitch)
 258   (cons (cadr pitch) (caddr pitch)))
 259
 260 (define (accidental->text acc)
 261     (if (= acc 0)
 262       '()
 263       (list
 264        (append '(music)
 265                (list
 266                 (append '(named)
 267                         (list
 268                           (append '((font-relative-size . -2))
 269                                 (list (append '((raise . 0.6))
 270                                   (list
 271                                    (string-append "accidentals-"
 272                                                   (number->string acc))))))))))))
 273 )
 274
 275 (define (pitch->text pitch)
 276   (cons
 277     (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
 278     (accidental->text (caddr pitch))
 279   )
 280 )
 281
 282 ;;; Hooks to override chord names and note names,
 283 ;;; see input/tricks/german-chords.ly
 284
 285 (define (pitch->text-banter pitch)
 286   (pitch->text pitch))
 287
 288 (define (pitch->chord-name-text-banter pitch)
 289   (pitch->text-banter pitch))
 290
 291 (define (pitch->note-name-text-banter pitch)
 292   (pitch->text-banter pitch))
 293
 294 (define (step->text pitch)
 295   (string-append
 296     (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
 297     (case (caddr pitch)
 298       ((-2) "--")
 299       ((-1) "-")
 300       ((0) "")
 301       ((1) "+")
 302       ((2) "++"))))
 303
 304 (define (step->text-banter pitch)
 305   (if (= (cadr pitch) 6)
 306       (case (caddr pitch)
 307         ((-2) "7-")
 308         ((-1) "7")
 309         ((0) "maj7")
 310         ((1) "7+")
 311         ((2) "7+"))
 312       (step->text pitch)))
 313
 314 (define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
 315
 316 (define (pitch::semitone pitch)
 317   (+ (* (car pitch) 12)
 318      (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
 319      (caddr pitch)))
 320
 321 (define (pitch::transpose pitch delta)
 322   (let ((simple-octave (+ (car pitch) (car delta)))
 323         (simple-notename (+ (cadr pitch) (cadr delta))))
 324     (let ((octave (+ simple-octave (quotient simple-notename 7)))
 325            (notename (modulo simple-notename 7)))
 326       (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
 327                            (pitch::semitone `(,octave ,notename 0)))))
 328         `(,octave ,notename ,accidental)))))
 329
 330 (define (pitch::diff pitch tonic)
 331   (let ((simple-octave (- (car pitch) (car tonic)))
 332         (simple-notename (- (cadr pitch) (cadr tonic))))
 333     (let ((octave (+ simple-octave (quotient simple-notename 7)
 334                      (if (< simple-notename 0) -1 0)))
 335           (notename (modulo simple-notename 7)))
 336       (let ((accidental (- (pitch::semitone pitch)
 337                           (pitch::semitone tonic)
 338                           (pitch::semitone `(,octave ,notename 0)))))
 339         `(,octave ,notename ,accidental)))))
 340
 341 (define (pitch::note-pitch pitch)
 342   (+ (* (car pitch) 7) (cadr pitch)))
 343
 344 (define (chord::step tonic pitch)
 345  (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
 346
 347 ;; text: list of word
 348 ;; word: string + optional list of property
 349 ;; property: align, kern, font (?), size
 350
 351 (define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
 352
 353 ;; compute the relative-to-tonic pitch that goes with 'step'
 354 (define (chord::step-pitch tonic step)
 355   ;; urg, we only do this for thirds
 356   (if (= (modulo step 2) 0)
 357     '(0 0 0)
 358     (let loop ((i 1) (pitch tonic))
 359       (if (= i step) pitch
 360         (loop (+ i 2)
 361               (pitch::transpose
 362                 pitch `(0 2 ,(vector-ref chord::minor-major-vec
 363                 ;; -1 (step=1 -> vector=0) + 7 = 6
 364                 (modulo (+ i 6) 7)))))))))
 365
 366 ;; find the pitches that are not part of `normal' chord
 367 (define (chord::additions chord-pitches)
 368   (let ((tonic (car chord-pitches)))
 369     ;; walk the chord steps: 1, 3, 5
 370     (let loop ((step 1) (pitches chord-pitches) (additions '()))
 371       (if (pair? pitches)
 372         (let* ((pitch (car pitches))
 373                (p-step (+ (- (pitch::note-pitch pitch)
 374                              (pitch::note-pitch tonic))
 375                           1)))
 376           ;; pitch is an addition if
 377           (if (or
 378                 ;; it comes before this step or
 379                 (< p-step step)
 380                 ;; its step is even or
 381                 (= (modulo p-step 2) 0)
 382                 ;; has same step, but different accidental or
 383                 (and (= p-step step)
 384                      (not (equal? pitch (chord::step-pitch tonic step))))
 385                 ;; is the last of the chord and not one of base thirds
 386                 (and (> p-step  5)
 387                      (= (length pitches) 1)))
 388             (loop step (cdr pitches) (cons pitch additions))
 389           (if (= p-step step)
 390             (loop step (cdr pitches) additions)
 391             (loop (+ step 2) pitches additions))))
 392       (reverse additions)))))
 393
 394 ;; find the pitches that are missing from `normal' chord
 395 (define (chord::subtractions chord-pitches)
 396   (let ((tonic (car chord-pitches)))
 397     (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
 398       (if (pair? pitches)
 399         (let* ((pitch (car pitches))
 400                (p-step (+ (- (pitch::note-pitch pitch)
 401                              (pitch::note-pitch tonic))
 402                           1)))
 403           ;; pitch is an subtraction if
 404           ;; a step is missing or
 405           (if (> p-step step)
 406             (loop (+ step 2) pitches
 407                 (cons (chord::step-pitch tonic step) subtractions))
 408           ;; there are no pitches left, but base thirds are not yet done and
 409           (if (and (<= step 5)
 410                    (= (length pitches) 1))
 411             ;; present pitch is not missing step
 412             (if (= p-step step)
 413               (loop (+ step 2) pitches subtractions)
 414               (loop (+ step 2) pitches
 415                     (cons (chord::step-pitch tonic step) subtractions)))
 416             (if (= p-step step)
 417               (loop (+ step 2) (cdr pitches) subtractions)
 418               (loop step (cdr pitches) subtractions)))))
 419         (reverse subtractions)))))
 420
 421 ;; combine tonic, user-specified chordname,
 422 ;; additions, subtractions and base or inversion to chord name
 423 ;;
 424 (define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)
 425   (apply append
 426          '(rows)
 427          (pitch->chord-name-text-banter tonic)
 428          (if user-name user-name '())
 429          ;; why does list->string not work, format seems only hope...
 430          (if (and (string-match "super" (format "~s" user-name))
 431                   (or (pair? additions)
 432                       (pair? subtractions)))
 433              '((super "/"))
 434              '())
 435          (let loop ((from additions) (to '()))
 436            (if (pair? from)
 437                (let ((p (car from)))
 438                  (loop (cdr from)
 439                        (append to
 440                                (cons
 441                                 (list 'super (step->text-banter p))
 442                                 (if (or (pair? (cdr from))
 443                                         (pair? subtractions))
 444                                     '((super "/"))
 445                                     '())))))
 446                to))
 447          (let loop ((from subtractions) (to '()))
 448            (if (pair? from)
 449                  (let ((p (car from)))
 450                    (loop (cdr from)
 451                          (append to
 452                                  (cons '(super "no")
 453                                        (cons
 454                                         (list 'super (step->text-banter p))
 455                                         (if (pair? (cdr from))
 456                                             '((super "/"))
 457                                             '())))))) ; nesting?
 458                  to))
 459          (if (and (pair? base-and-inversion)
 460                   (or (car base-and-inversion)
 461                       (cdr base-and-inversion)))
 462              (cons "/" (append
 463                         (if (car base-and-inversion)
 464                             (pitch->note-name-text-banter
 465                              (car base-and-inversion))
 466                             (pitch->note-name-text-banter
 467                              (cdr base-and-inversion)))
 468                         '()))
 469              '())
 470          '()))
 471
 472 (define (chord::name-banter tonic user-name pitches base-and-inversion)
 473   (let ((additions (chord::additions pitches))
 474         (subtractions (chord::subtractions pitches)))
 475     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 476
 477 ;; american chordnames use no "no",
 478 ;; but otherwise very similar to banter for now
 479 (define (chord::name-american tonic user-name pitches base-and-inversion)
 480   (let ((additions (chord::additions pitches))
 481         (subtractions #f))
 482     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 483
 484 ;; Jazz style--basically similar to american with minor changes
 485 (define (chord::name-jazz tonic user-name pitches base-and-inversion)
 486   (let ((additions (chord::additions pitches))
 487         (subtractions #f))
 488     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 489
 490 (define (new-to-old-pitch p)
 491   (if (pitch? p)
 492       (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
 493       #f
 494   ))
 495
 496
 497
 498 ;; C++ entry point
 499 ;;
 500 ;; Check for each subset of chord, full chord first, if there's a
 501 ;; user-override.  Split the chord into user-overridden and to-be-done
 502 ;; parts, complete the missing user-override matched part with normal
 503 ;; chord to be name-calculated.
 504 ;;
 505 ;; CHORD: (pitches (base . inversion))
 506 (define (default-chord-name-function style chord)
 507   (let* ((style-string (symbol->string style))
 508          (pitches (map new-to-old-pitch (car chord)))
 509          (modifiers (cdr chord))
 510          (base-and-inversion (if (pair? modifiers)
 511                                  (cons (new-to-old-pitch (car modifiers))
 512                                        (new-to-old-pitch (cdr modifiers)))
 513                                  '(() . ())))
 514          (diff (pitch::diff '(0 0 0) (car pitches)))
 515          (name-func
 516           (ly-eval (string->symbol (string-append "chord::name-" style-string))))
 517          (names-alist
 518           (ly-eval (string->symbol (string-append "chord::names-alist-" style-string)))))
 519   (let loop ((note-names (reverse pitches))
 520              (chord '())
 521              (user-name #f))
 522     (if (pair? note-names)
 523       (let ((entry (assoc
 524                      (reverse
 525                        (map (lambda (x)
 526                               (pitch->note-name (pitch::transpose x diff)))
 527                             note-names))
 528                      names-alist)))
 529         (if entry
 530           ;; urg? found: break loop
 531           (loop '() chord (cdr entry))
 532           (loop (cdr note-names) (cons (car note-names) chord) #f)))
 533       (let* ((transposed (if pitches
 534                            (map (lambda (x) (pitch::transpose x diff)) chord)
 535                            '()))
 536              (matched (if (= (length chord) 0)
 537                           3
 538                           (- (length pitches) (length chord))))
 539              (completed
 540               (append (do ((i matched (- i 1))
 541                            (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
 542                            ((= i 0) base)
 543                            ())
 544                   transposed)))
 545       (name-func (car pitches) user-name completed base-and-inversion))))))
 546
 547