scm/chord-names.scm

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