X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fchord-name.scm;h=c47b803a284e3e3b05636ae5a9e322f41068eb8c;hb=48631a04b6181cd7be65702574eaaa6c52284bd2;hp=8261fe0b3ca38554e239c6a050718c537c536b56;hpb=b9c65b122d107a6f7c1a44d3041f6cfeb78fc4a2;p=lilypond.git

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 8261fe0b3c..c47b803a28 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -14,25 +14,28 @@
    (ice-9 string-fun)
    )
 
+;; pitch = (octave notename accidental)
 ;;
-;; (octave notename accidental)
+;; note = (notename . accidental)
 ;;
+;; text = scm markup text -- see font.scm and input/test/markup.ly
 
-;;
-;; text: scm markup text -- see font.scm and input/test/markup.ly
-;;
 
 ;; TODO
 ;;
-;; * clean split of base/banter/american stuff
-;; * text definition is rather ad-hoc
-;; * do without format module
-;; * finish and check american names
-;; * make notename (tonic) configurable from lilypond
-;; * fix append/cons stuff in inner-name-banter
-;; * doc strings.
-
-;;;;;;;;;
+;; * easier tweakability:
+;;    - split chord::names-alists up into logical bits,
+;;      such as chord::exceptions-delta, exceptions-oslash
+;;    - iso just the 'style parameter, use a list, eg:
+;;      \property ChordNames.ChordName \set
+;;        #'style = #'(jazz delta oslash german-tonic german-Bb)
+;;
+;; * fix FIXMEs
+;;
+;; * clean split/merge of bass/banter/american stuff
+;;
+;; * doc strings
+
 (define chord::names-alist-banter '())
 (set! chord::names-alist-banter
       (append 
@@ -44,19 +47,385 @@
 	; Cm iso Cm.no5
 	(((0 . 0) (2 . -1)) . ("m"))
 	; C2 iso C2.no3
-	(((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2")))
+	(((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2") " "))
 	; C4 iso C4.no3
-	(((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4")))
+	(((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4") " " ))
 	;; Cdim iso Cm5-
 	(((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
-	; Co iso Cm5-7-
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
+	; 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")))
-	(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11")))
+	(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9") " "))
+	(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11") " "))
 	)
       chord::names-alist-banter))
 
+;;;;;;;;;;
+(define simple-super
+;; duh, no docstrings for 
+;;  "No real superscript, just raised and small"
+  '((raise . 1) (font-relative-size . -2)))
+
+(define (accidental->textp acc pos)
+  (if (= acc 0)
+      '()
+      (list '(music (font-relative-size . -2))
+		   (list pos (string-append "accidentals-" (number->string acc))))))
+
+(define (accidental->text acc) (accidental->textp acc 'columns))
+(define (accidental->text-super acc) (accidental->textp acc 'simple-super))
+(define (accidental->text-sub acc) (accidental->textp acc 'sub))
+
+(define (pitch->note-name pitch)
+  (cons (cadr pitch) (caddr pitch)))
+
+(define (pitch->text pitch)
+  (text-append
+   (list
+    '(font-relative-size . 2)
+    (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))))
+   (accidental->text-super (caddr pitch))))
+
+
+;;; Hooks to override chord names and note names, 
+;;; see input/tricks/german-chords.ly
+
+(define (pitch->text-banter pitch)
+  (pitch->text pitch))
+
+;; We need also steps, to allow for Cc name override,
+;; see input/test/Cc-chords.ly
+(define (pitch->chord-name-text-banter pitch steps)
+  (pitch->text-banter pitch))
+
+(define (pitch->note-name-text-banter pitch)
+  (pitch->text-banter pitch))
+
+(define (step->text pitch)
+  (list (string-append
+    (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
+    (case (caddr pitch)
+      ((-2) "--")
+      ((-1) "-")
+      ((0) "")
+      ((1) "+")
+      ((2) "++")))))
+  
+(define (step->text-banter pitch)
+  (if (= (cadr pitch) 6)
+      (case (caddr pitch)
+	((-2) '("7-"))
+	((-1) '("7"))
+	((0) '("maj7"))
+	((1) '("7+"))
+	((2) '("7+")))
+      (step->text pitch)))
+
+(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
+
+(define (pitch::semitone pitch)
+  (+ (* (car pitch) 12) 
+     (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7)) 
+     (caddr pitch)))
+
+(define (pitch::< l r)
+  (< (pitch::semitone l) (pitch::semitone r)))
+  
+(define (pitch::transpose pitch delta)
+  (let ((simple-octave (+ (car pitch) (car delta)))
+	(simple-notename (+ (cadr pitch) (cadr delta))))
+    (let ((octave (+ simple-octave (quotient simple-notename 7)))
+	   (notename (modulo simple-notename 7)))
+      (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
+			   (pitch::semitone `(,octave ,notename 0)))))
+	`(,octave ,notename ,accidental)))))
+    
+(define (pitch::diff pitch tonic)
+  (let ((simple-octave (- (car pitch) (car tonic)))
+	(simple-notename (- (cadr pitch) (cadr tonic))))
+    (let ((octave (+ simple-octave (quotient simple-notename 7)
+		     (if (< simple-notename 0) -1 0)))
+	  (notename (modulo simple-notename 7)))
+      (let ((accidental (- (pitch::semitone pitch)
+			  (pitch::semitone tonic) 
+			  (pitch::semitone `(,octave ,notename 0)))))
+	`(,octave ,notename ,accidental)))))
+
+(define (pitch::note-pitch pitch)
+  (+ (* (car pitch) 7) (cadr pitch)))
+
+(define (chord::text? text)
+  (not (or (not text) (empty? text) (unspecified? text))))
+
+;; FIXME: remove need for me, use text-append throughout
+(define (chord::text-cleanup dirty)
+  "
+   Recursively remove '() #f, and #<unspecified> from markup text tree.
+   This allows us to leave else parts of (if # #) off.
+   Otherwise, you'd have to do (if # # '()), and you'd have to
+   filter-out the '() anyway.
+  "
+  (if (pair? dirty)
+      (let ((r (car dirty)))
+	(if (chord::text? r)
+	    (cons (if (pair? r) (chord::text-cleanup r) r)
+		  (chord::text-cleanup (cdr dirty)))
+	    (chord::text-cleanup (cdr dirty))))
+      (if (chord::text? dirty)
+	  dirty
+	  '())))
+
+(define (text-append l . r)
+  (if (not (chord::text? r))
+      l
+      (if (not (chord::text? l))
+	  r
+	  (if (empty? (cdr r))
+	      (list 'columns l (car r))
+	      (text-append (list 'columns l (car r)) (cdr r))))))
+	   
+(define (chord::step tonic pitch)
+ (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
+
+;; text: list of word
+;; word: string + optional list of property
+;; property: align, kern, font (?), size
+
+(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
+
+;; FIXME: unLOOP
+;; compute the relative-to-tonic pitch that goes with 'step'
+(define (chord::step-pitch tonic step)
+  ;; urg, we only do this for thirds
+  (if (= (modulo step 2) 0)
+    '(0 0 0)
+    (let loop ((i 1) (pitch tonic))
+      (if (= i step) pitch
+	(loop (+ i 2) 
+	      (pitch::transpose 
+		pitch `(0 2 ,(vector-ref chord::minor-major-vec 
+		;; -1 (step=1 -> vector=0) + 7 = 6
+		(modulo (+ i 6) 7)))))))))
+
+(define (chord::additions steps)
+" Return:
+   * any even step (2, 4, 6)
+   * any uneven step that is chromatically altered,
+     (where 7-- == -1, 7- == 0, 7 == +1)
+   * highest step
+
+?and jazz needs also:
+
+   * TODO: any uneven step that's lower than an uneven step which is
+     chromatically altered
+  "
+  (let ((evens (filter-list (lambda (x) (!= 0 (modulo (cadr x) 2))) steps))
+	(altered-unevens
+	 (filter-list (lambda (x)
+			(let ((n (cadr x)) (a (caddr x)))
+			  (or (and (= 6 n) (!= -1 a))
+			      (and (!= 6 n)
+				   (= 0 (modulo n 2))
+				   (!= 0 a)))))
+		      steps))
+	(highest (let ((h (car (last-pair steps))))
+		   (if (and (not (empty? h))
+			    (or (> 4 (cadr h))
+				(!= 0 (caddr h))))
+		       (list (list h))
+		       '()))))
+    ;; Hmm, what if we have a step twice, can we ignore that?
+    (uniq-list (sort (apply append evens altered-unevens highest)
+		     pitch::<))))
+	
+     
+;; FIXME: unLOOP, see ::additions
+;; find the pitches that are missing from `normal' chord
+(define (chord::subtractions chord-pitches)
+  (let ((tonic (car chord-pitches)))
+    (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
+      (if (pair? pitches)
+	(let* ((pitch (car pitches))
+	       (p-step (+ (- (pitch::note-pitch pitch)
+			     (pitch::note-pitch tonic))
+			  1)))
+	  ;; pitch is an subtraction if 
+	  ;; a step is missing or
+	  (if (> p-step step)
+	    (loop (+ step 2) pitches
+		(cons (chord::step-pitch tonic step) subtractions))
+	  ;; there are no pitches left, but base thirds are not yet done and
+	  (if (and (<= step 5)
+		   (= (length pitches) 1))
+	    ;; present pitch is not missing step
+	    (if (= p-step step)
+	      (loop (+ step 2) pitches subtractions)
+	      (loop (+ step 2) pitches 
+		    (cons (chord::step-pitch tonic step) subtractions)))
+	    (if (= p-step step)
+	      (loop (+ step 2) (cdr pitches) subtractions)
+	      (loop step (cdr pitches) subtractions)))))
+	(reverse subtractions)))))
+
+(define (chord::additions->text-banter additions subtractions)
+  (if (pair? additions)
+      (text-append
+       (let ((step (step->text-banter (car additions))))
+	 (if (or (pair? (cdr additions))
+		 (pair? subtractions))
+	     (text-append step "/")
+	     step))
+      (chord::additions->text-banter (cdr additions) subtractions))
+  '()))
+
+(define (chord::subtractions->text-banter subtractions)	 
+  (if (pair? subtractions)
+      (text-append
+       '("no")
+       (let ((step (step->text-jazz (car subtractions))))
+	 (if (pair? (cdr subtractions))
+			(text-append step "/")
+			step))
+       (chord::subtractions->text-banter (cdr subtractions)))
+      '()))
+
+(define (chord::bass-and-inversion->text-banter bass-and-inversion)
+  (if (and (pair? bass-and-inversion)
+	   (or (car bass-and-inversion)
+	       (cdr bass-and-inversion)))
+      (list "/" (if (car bass-and-inversion)
+		    (pitch->note-name-text-banter
+		     (car bass-and-inversion))
+		    (pitch->note-name-text-banter
+		     (cdr bass-and-inversion))))))
+
+;; FIXME: merge this function with inner-name-jazz, -american
+;;        iso using chord::bass-and-inversion->text-banter,
+;;        call (chord::restyle 'chord::bass-and-inversion->text- style)
+;;        See: chord::exceptions-lookup
+;;        
+;; Banter style
+;; Combine tonic, exception-part of chord name,
+;; 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" 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)))
+    (text-append
+     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 (c++-pitch->scm p)
+  (if (pitch? p)
+      (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
+      #f))
+
+(define (chord::name-banter tonic exception-part unmatched-steps
+			    bass-and-inversion steps)
+   (let ((additions (chord::additions unmatched-steps))
+	 (subtractions (chord::subtractions unmatched-steps)))
+     (chord::inner-name-banter tonic exception-part additions subtractions
+			       bass-and-inversion steps)))
+
+
+(define (chord::restyle name style)
+  (primitive-eval (string->symbol
+	    (string-append (symbol->string name)
+			   (symbol->string style)))))
+
+;; check exceptions-alist for biggest matching part of try-steps
+;; return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
+(define (chord::exceptions-lookup-helper
+	 exceptions-alist try-steps unmatched-steps exception-part)
+  (if (pair? try-steps)
+      ;; FIXME: junk '(0 . 0) from exceptions lists?
+      ;;        if so: how to handle first '((0 . 0) . #f) entry?
+      ;;
+      ;; FIXME: either format exceptions list as real pitches, ie,
+      ;;        including octave '((0 2 -1) ..), or drop octave
+      ;;        from rest of calculations, 
+      (let ((entry (assoc
+		    (map (lambda (x) (pitch->note-name x))
+			 (append '((0 0 0)) try-steps))
+		    exceptions-alist)))
+	(if entry
+	    (chord::exceptions-lookup-helper
+	     #f '() unmatched-steps (cdr entry))
+	    (let ((r (reverse try-steps)))
+	      (chord::exceptions-lookup-helper
+	       exceptions-alist
+	       (reverse (cdr r))
+	       (cons (car r) unmatched-steps) #f))))
+      (cons exception-part unmatched-steps)))
+
+;; return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
+;; BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
+(define (chord::exceptions-lookup style steps)
+  (let* ((result (chord::exceptions-lookup-helper
+		  (chord::restyle 'chord::names-alist- style)
+		  steps '() #f))
+	   (exception-part (car result))
+	   (unmatched-steps (cdr result))
+	   (matched-steps (if (= (length unmatched-steps) 0)
+			      3
+			      (+ 1 (- (length steps)
+				      (length unmatched-steps)))))
+	   (unmatched-with-1-3-5
+	    (append (do ((i matched-steps (- i 1))
+			 (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
+			((= i 0) base)
+		      ())
+		    unmatched-steps)))
+    (list exception-part unmatched-with-1-3-5)))
+
+
+(define (chord::name->text style tonic steps bass-and-inversion)
+  (let* ((lookup (chord::exceptions-lookup style steps))
+	 (exception-part (car lookup))
+	 (unmatched-steps (cadr lookup)))
+    (chord::text-cleanup
+     ((chord::restyle 'chord::name- style)
+      tonic exception-part unmatched-steps bass-and-inversion steps))))
+
+;; C++ entry point
+;; 
+;; Check for each subset of chord, full chord first, if there's a
+;; user-override.  Split the chord into user-overridden and to-be-done
+;; parts, complete the missing user-override matched part with normal
+;; chord to be name-calculated.
+;;
+;; CHORD: (pitches (bass . inversion))
+(define (default-chord-name-function style chord)
+  (let* ((pitches (map c++-pitch->scm (car chord)))
+	 (modifiers (cdr chord))
+	 (bass-and-inversion (if (pair? modifiers)
+				 (cons (c++-pitch->scm (car modifiers))
+				       (c++-pitch->scm (cdr modifiers)))
+				 '(() . ())))
+	 (diff (pitch::diff '(0 0 0) (car pitches)))
+	 (steps (if (cdr pitches) (map (lambda (x)
+					 (pitch::transpose x diff))
+				       (cdr pitches))
+		    '())))
+    (chord::name->text style (car pitches) steps bass-and-inversion)))
+
+;;;
+;;; American style
+;;;
+
 
 ;; NOTE: Duplicates of chord names defined elsewhere occur in this list
 ;; in order to prevent spurious superscripting of various chord names,
@@ -87,20 +456,20 @@
 ;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)) . ("" (super "o") "7"))
+	 (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") " " "7"))
 	 (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
+	 ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
 	 (((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)) .  (super ((font-family . math) "N"))
-	 ;; ugh, kludge slashed o
-	 ;; (((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
-	 (((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
+	 ;; slashed o
+	 (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") " " "7"))
 
 	 (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
-	 (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
-	 (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
+	 (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (columns "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
+	 (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (columns "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "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'
@@ -114,8 +483,26 @@
 	 )
       chord::names-alist-american))
 
+
+;; American style chordnames use no "no",
+;; but otherwise very similar to banter for now
+(define (chord::name-american tonic exception-part unmatched-steps
+			      bass-and-inversion steps)
+  (let ((additions (chord::additions unmatched-steps))
+	(subtractions #f))
+    (chord::inner-name-banter tonic exception-part additions subtractions
+			      bass-and-inversion steps)))
+
+
+
+;;; 
+;;; Jazz style
+;;;
+
+
+
 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
-;; NBs:	This uses the american list as a base.
+;; NBs:	This uses the american list as a bass.
 ;;	Some defs take up more than one line,
 ;; be carefull when messing with ;'s!!
 
@@ -124,7 +511,7 @@
 ;;
 ;; This is getting out-of hand?  Only exceptional chord names that
 ;; cannot be generated should be here.
-;; Maybe we should have inner-jazz-name and inner-american-name functions;
+;; Maybe we should have inner-name-jazz and inner-name-american functions;
 ;; 
 ;;       
 ;;
@@ -148,31 +535,31 @@
 
 	;; minor chords
 	; minor sixth chord = m6
- 	(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
+ 	(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (columns("m")((raise . 0.5) "6")))
 	;; minor major seventh chord = m triangle
 	;; shouldn't this be a filled black triange, like this:  ? --jcn
-	;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "N"))))
-	(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "M"))))
+	;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "N"))))
+	(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "M"))))
 	; minor seventh chord = m7
-	(((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
+	(((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (columns("m")((raise . 0.5) "7")))
 	; minor sixth nine chord = m6/9
-	(((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9")))
+	(((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (columns("m")((raise . 0.5) "6/9")))
 	; minor with added nine chord = madd9
-	(((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
+	(((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (columns("m")((raise . 0.5) "add9")))
 	; minor ninth chord = m9
-	(((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
+	(((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (columns("m")((raise . 0.5) "9")))
 
 	;; dominant chords
 	; dominant seventh = 7
 	(((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
 	; augmented dominant = +7
 	;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised
-	(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised
-	;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
+	(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (columns("+")((raise . 0.5) "7"))) ; +7 with 7 raised
+	;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (columns((raise . 0.5) "7(")
 	;	((raise . 0.3)(music (named ("accidentals-1"))))
 	;	((raise . 0.5) "5)"))); 7(#5)
 	; dominant flat 5 = 7(b5)
-	(((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
+	(((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (columns((raise . 0.5) "7(")
 		((raise . 0.3)(music (named ("accidentals--1"))))
 		((raise . 0.5) "5)")))
 	; dominant 9 = 7(9)
@@ -238,7 +625,7 @@
 	;; half diminshed chords
 	;; half diminished seventh chord = slashed o
 	;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
-        (((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
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") " " "7")) ; slashed o
 
 	; half diminished seventh chord  with major 9 = slashed o cancelation 9
 	(((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
@@ -251,298 +638,205 @@
 	)
       chord::names-alist-american))
 
-;;;;;;;;;;
-
-
-(define (pitch->note-name pitch)
-  (cons (cadr pitch) (caddr pitch)))
-  
-
-(define (accidental->text acc)
-    (if (= acc 0)
-      '()
-      (list
-       (append '(music)
-	       (list
-		(append '(named)
-			(list
-			  (append '((font-relative-size . -2))
-				(list (append '((raise . 0.6))
-				  (list
-				   (string-append "accidentals-" 
-                                                 (number->string acc))))))))))))
-)
-
-(define (pitch->text pitch)
-  (cons
-    (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
-    (accidental->text (caddr pitch))
-  )
-)
-
-;;; Hooks to override chord names and note names, 
-;;; see input/tricks/german-chords.ly
-
-(define (pitch->text-banter pitch)
-  (pitch->text pitch))
-
-(define (pitch->chord-name-text-banter pitch)
-  (pitch->text-banter pitch))
-
-(define (pitch->note-name-text-banter pitch)
-  (pitch->text-banter pitch))
+(define (step->text-alternate-jazz pitch)
+  (text-append
+   (accidental->text (caddr pitch))
+   (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))
 
-(define (step->text pitch)
-  (string-append
-    (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
-    (case (caddr pitch)
-      ((-2) "--")
-      ((-1) "-")
-      ((0) "")
-      ((1) "+")
-      ((2) "++"))))
-  
-(define (step->text-banter pitch)
+(define (step->text-jazz pitch)
   (if (= (cadr pitch) 6)
       (case (caddr pitch)
-	((-2) "7-")
-	((-1) "7")
-	((0) "maj7")
-	((1) "7+")
-	((2) "7+"))
-      (step->text pitch)))
-
-(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
-
-(define (pitch::semitone pitch)
-  (+ (* (car pitch) 12) 
-     (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7)) 
-     (caddr pitch)))
-
-(define (pitch::transpose pitch delta)
-  (let ((simple-octave (+ (car pitch) (car delta)))
-	(simple-notename (+ (cadr pitch) (cadr delta))))
-    (let ((octave (+ simple-octave (quotient simple-notename 7)))
-	   (notename (modulo simple-notename 7)))
-      (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
-			   (pitch::semitone `(,octave ,notename 0)))))
-	`(,octave ,notename ,accidental)))))
-    
-(define (pitch::diff pitch tonic)
-  (let ((simple-octave (- (car pitch) (car tonic)))
-	(simple-notename (- (cadr pitch) (cadr tonic))))
-    (let ((octave (+ simple-octave (quotient simple-notename 7)
-		     (if (< simple-notename 0) -1 0)))
-	  (notename (modulo simple-notename 7)))
-      (let ((accidental (- (pitch::semitone pitch)
-			  (pitch::semitone tonic) 
-			  (pitch::semitone `(,octave ,notename 0)))))
-	`(,octave ,notename ,accidental)))))
-
-(define (pitch::note-pitch pitch)
-  (+ (* (car pitch) 7) (cadr pitch)))
-
-(define (chord::step tonic pitch)
- (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
-
-;; text: list of word
-;; word: string + optional list of property
-;; property: align, kern, font (?), size
-
-(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
-
-;; compute the relative-to-tonic pitch that goes with 'step'
-(define (chord::step-pitch tonic step)
-  ;; urg, we only do this for thirds
-  (if (= (modulo step 2) 0)
-    '(0 0 0)
-    (let loop ((i 1) (pitch tonic))
-      (if (= i step) pitch
-	(loop (+ i 2) 
-	      (pitch::transpose 
-		pitch `(0 2 ,(vector-ref chord::minor-major-vec 
-		;; -1 (step=1 -> vector=0) + 7 = 6
-		(modulo (+ i 6) 7)))))))))
-
-;; find the pitches that are not part of `normal' chord
-(define (chord::additions chord-pitches)
-  (let ((tonic (car chord-pitches)))
-    ;; walk the chord steps: 1, 3, 5
-    (let loop ((step 1) (pitches chord-pitches) (additions '()))
-      (if (pair? pitches)
-	(let* ((pitch (car pitches))
-	       (p-step (+ (- (pitch::note-pitch pitch)
-			     (pitch::note-pitch tonic))
-			  1)))
-	  ;; pitch is an addition if 
-	  (if (or 
-		;; it comes before this step or
-		(< p-step step)
-		;; its step is even or
-		(= (modulo p-step 2) 0)
-		;; has same step, but different accidental or
-		(and (= p-step step)
-		     (not (equal? pitch (chord::step-pitch tonic step))))
-		;; is the last of the chord and not one of base thirds
-		(and (> p-step  5)
-		     (= (length pitches) 1)))
-	    (loop step (cdr pitches) (cons pitch additions))
-	  (if (= p-step step)
-	    (loop step (cdr pitches) additions)
-	    (loop (+ step 2) pitches additions))))
-      (reverse additions)))))
-
-;; find the pitches that are missing from `normal' chord
-(define (chord::subtractions chord-pitches)
-  (let ((tonic (car chord-pitches)))
-    (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
-      (if (pair? pitches)
-	(let* ((pitch (car pitches))
-	       (p-step (+ (- (pitch::note-pitch pitch)
-			     (pitch::note-pitch tonic))
-			  1)))
-	  ;; pitch is an subtraction if 
-	  ;; a step is missing or
-	  (if (> p-step step)
-	    (loop (+ step 2) pitches
-		(cons (chord::step-pitch tonic step) subtractions))
-	  ;; there are no pitches left, but base thirds are not yet done and
-	  (if (and (<= step 5)
-		   (= (length pitches) 1))
-	    ;; present pitch is not missing step
-	    (if (= p-step step)
-	      (loop (+ step 2) pitches subtractions)
-	      (loop (+ step 2) pitches 
-		    (cons (chord::step-pitch tonic step) subtractions)))
-	    (if (= p-step step)
-	      (loop (+ step 2) (cdr pitches) subtractions)
-	      (loop step (cdr pitches) subtractions)))))
-	(reverse subtractions)))))
-
-;; combine tonic, user-specified chordname,
-;; additions, subtractions and base or inversion to chord name
+	;; sharp 7 only included for completeness?
+	((-2) (text-append (accidental->text -1) '("7")))
+	((-1) '("7"))
+	((0) '("maj7"))
+	((1) (text-append (accidental->text-super 1) '("7")))
+	((2) (text-append (accidental->text-super 2) '("7"))))
+      (step->text-alternate-jazz pitch)))
+
+(define (xchord::additions->text-jazz additions subtractions)
+  (if (pair? additions)
+      (text-append
+       (let ((step (step->text-jazz (car additions))))
+	 (if (or (pair? (cdr additions))
+		 (pair? subtractions))
+	     (text-append step "/")
+	     step))
+      (chord::additions->text-jazz (cdr additions) subtractions))
+  '()))
+
+(define (chord::>5? x)
+  (or (> (car x) 0)
+      (> (cadr x) 4)))
+
+
+;; FIXME:
+;; Perhaps all logic like this should be done earlier,
+;; so that in this text-construction printing phase
+;; we can just blindly create text from all additions.
 ;;
-(define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)
-  (apply append
-	 '(rows)
-	 (pitch->chord-name-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))
-		  (or (pair? additions)
-		      (pair? subtractions)))
-	     '((super "/"))
-	     '())
-	 (let loop ((from additions) (to '()))
-	   (if (pair? from)
-	       (let ((p (car from)))
-		 (loop (cdr from) 
-		       (append to
-			       (cons
-				(list 'super (step->text-banter p))
-				(if (or (pair? (cdr from))
-					(pair? subtractions))
-				    '((super "/"))
-				    '())))))
-	       to))
-	 (let loop ((from subtractions) (to '()))
-	   (if (pair? from)
-		 (let ((p (car from)))
-		   (loop (cdr from) 
-			 (append to
-				 (cons '(super "no")
-				       (cons
-					(list 'super (step->text-banter p))
-					(if (pair? (cdr from))
-					    '((super "/"))
-					    '())))))) ; nesting?
-		 to))
-	 (if (and (pair? base-and-inversion)
-		  (or (car base-and-inversion)
-		      (cdr base-and-inversion)))
-	     (cons "/" (append
-			(if (car base-and-inversion)
-			    (pitch->note-name-text-banter 
-			     (car base-and-inversion))
-			    (pitch->note-name-text-banter
-			     (cdr base-and-inversion)))
-			'()))
-	     '())
-	 '()))
-
-(define (chord::name-banter tonic user-name pitches base-and-inversion)
-  (let ((additions (chord::additions pitches))
-	(subtractions (chord::subtractions pitches)))
-    (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
-
-;; american chordnames use no "no",
-;; but otherwise very similar to banter for now
-(define (chord::name-american tonic user-name pitches base-and-inversion)
-  (let ((additions (chord::additions pitches))
-	(subtractions #f))
-    (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
-
-;; Jazz style--basically similar to american with minor changes
-(define (chord::name-jazz tonic user-name pitches base-and-inversion)
-  (let ((additions (chord::additions pitches))
-	(subtractions #f))
-    (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
-
-(define (new-to-old-pitch p)
-  (if (pitch? p)
-      (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
-      #f
-  ))
-
+;; This depends maybe on the fact of code sharing,
+;; in this layout, we can share the functions chord::additions
+;; and chord::subtractions with banter.
+(define (chord::additions->text-jazz additions subtractions)
+  (text-append
+   (chord::additions<=5->text-jazz (filter-out-list chord::>5? additions)
+				   (filter-out-list chord::>5? subtractions))
+   (chord::additions>5->text-jazz (filter-list chord::>5? additions)
+				  (filter-list chord::>5? subtractions))))
 
+;; FIXME
+(define (chord::additions<=5->text-jazz additions subtractions)
+  (let ((sus (chord::sus-four-jazz additions)))
+    (if (pair? sus)
+	(text-append '("sus") (step->text-jazz (car sus)))
+	'())))
+
+(define (chord::additions>5->text-jazz additions subtractions)
+  "
+Compose text of all additions
+
+  * if there's a subtraction:
+    - add `add'
+    - list all up to highest
+  * list all steps that are below an chromatically altered step
+  "
+  (text-append
+   (if (not (empty? subtractions)) "add" '())
+   (let ((radds (reverse additions)))
+     (reverse (chord::additions>5->text-jazz-helper
+	       radds
+	       subtractions
+	       (if (or (empty? subtractions) (empty? radds))
+		   #f (car radds)))))))
+
+(define (chord::additions>5->text-jazz-helper additions subtractions list-step)
+  "
+Create texts for all additions
+If list-step != #f, list all steps down to 5
+If we encounter a chromatically altered step, turn on list-step
+"
+
+  (if list-step
+      (if (not (member list-step subtractions))
+	  (if (> 5 (cadr list-step))
+	      (cons (step->text-jazz list-step)
+		    (chord::additions>5->text-jazz-helper
+		     additions
+		     subtractions
+		     (chord::get-create-step additions
+					     (- (cadr list-step) 2))))
+	      (step->text-jazz list-step))
+	  (chord::get-create-step additions (- (cadr list-step) 2)))
+      (if (pair? additions)
+	  (let ((step (car additions)))
+	    (cons (step->text-jazz step)
+		  (chord::additions>5->text-jazz-helper
+		   (cdr additions)
+		   subtractions
+		   (if (or (and (!= 6 (cadr step)) (!= 0 (caddr step)))
+			   (and (= 6 (cadr step)) (!= -1 (caddr step))))
+		       (chord::get-create-step additions (- (cadr step) 2))
+		       #f))))
+	  '())))
+
+(define (chord::sus-four-jazz chord-pitches)
+  "List of pitches that are step 2 or step 4"
+  (filter-list (lambda (x)
+		 (and (= 0 (car x))
+		      (or (= 1 (cadr x)) (= 3 (cadr x))))) chord-pitches))
+
+(define (chord::get-create-step steps n)
+  (let* ((i (if (< n 0) (+ n 7) n))
+	 (found (filter-list (lambda (x) (= i (cadr x))) steps)))
+    (if (empty? found)
+	(if (!= i 6)
+	    (list 0 i 0)
+	    (list 0 6 -1))
+	(car found))))
+  
+(define (chord::subtractions->text-jazz subtractions)	 
+  (if (pair? subtractions)
+      (text-append
+       (if (= 5 (cadr (car subtractions)))
+	   (text-append
+	    '("omit")
+	    (let ((step (step->text-jazz (car subtractions))))
+	      (if (pair? (cdr subtractions))
+		  (text-append step "/")
+		  step)))
+	   '())
+       (chord::subtractions->text-jazz (cdr subtractions)))
+      '()))
+
+
+;; TODO: maybe merge with inner-name-banter
+;; Combine tonic, exception-part of chord name,
+;; additions, subtractions and bass or inversion into chord name
+(define (chord::inner-name-jazz tonic exception-part additions subtractions
+				  bass-and-inversion steps)
+    (text-append
+     (pitch->chord-name-text-banter tonic steps)
+     exception-part
+     ;; why does list->string not work, format seems only hope...
+     (if (and (string-match "super" (format "~s" exception-part))
+	      (or (pair? additions)
+		  (pair? subtractions)))
+	 (list simple-super "/"))
+     
+     (list `(,simple-super)
+	   (chord::additions->text-jazz additions subtractions)
+	   (chord::subtractions->text-jazz subtractions))
+     (chord::bass-and-inversion->text-banter bass-and-inversion)))
 
-;; C++ entry point
-;; 
-;; Check for each subset of chord, full chord first, if there's a
-;; user-override.  Split the chord into user-overridden and to-be-done
-;; parts, complete the missing user-override matched part with normal
-;; chord to be name-calculated.
+;; Jazz style--basically similar to american with minor changes
 ;;
-;; CHORD: (pitches (base . inversion))
-(define (default-chord-name-function style chord)
-  (let* ((style-string (symbol->string style))
-	 (pitches (map new-to-old-pitch (car chord)))
-	 (modifiers (cdr chord))
-	 (base-and-inversion (if (pair? modifiers)
-				 (cons (new-to-old-pitch (car modifiers))
-				       (new-to-old-pitch (cdr modifiers)))
-				 '(() . ())))
-	 (diff (pitch::diff '(0 0 0) (car pitches)))
-	 (name-func 
-	  (ly-eval (string->symbol (string-append "chord::name-" style-string))))
-	 (names-alist 
-	  (ly-eval (string->symbol (string-append "chord::names-alist-" style-string)))))
-  (let loop ((note-names (reverse pitches))
-	     (chord '())
-	     (user-name #f))
-    (if (pair? note-names)
-      (let ((entry (assoc 
-		     (reverse 
-		       (map (lambda (x) 
-			      (pitch->note-name (pitch::transpose x diff)))
-			    note-names))
-		     names-alist)))
-	(if entry
-	  ;; urg? found: break loop
-	  (loop '() chord (cdr entry))
-	  (loop (cdr note-names) (cons (car note-names) chord) #f)))
-      (let* ((transposed (if pitches 
-			   (map (lambda (x) (pitch::transpose x diff)) chord)
-			   '()))
-	     (matched (if (= (length chord) 0)
-			  3
-			  (- (length pitches) (length chord))))
-	     (completed 
-	      (append (do ((i matched (- i 1))
-			   (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
-			   ((= i 0) base)
-			   ())
-		  transposed)))
-      (name-func (car pitches) user-name completed base-and-inversion))))))
+;; Consider Dm6.  When we get here:
+;;     tonic =  '(0 1 0) (note d=2)
+;;     steps =  '((0 0 0) '(0 2 -1) (0 4 0) (0 5 0))
+;;               steps are transposed for tonic c, octave 0,
+;;               so (car steps) is always (0 0 0)
+;;     except  = ("m")
+;;               assuming that the exceptions-alist has an entry
+;;               '(((0 . 0) (2 . -1)) . ("m"))
+;;               (and NOT the full chord, like std jazz list, ugh)
+;;     unmatch = '((0 0 0) (0 2 0) (0 4 0) (0 5 0))
+;;     subtract= '()
+;;
+;; You can look very easily what happens, if you add some write-me calls,
+;; and run lilypond on a simple file, eg, containing only the chord c:m6:
+;;
+;;   (let ((additions (write-me "adds: "
+;;                 (chord::additions (write-me "unmatched:"
+;;                 unmatched-steps))))
+;;
+;; If you set subtract #f, the chord::inner-name-jazz does not see any
+;; subtractions, ever, so they don't turn up in the chord name.
+;;
+(define (chord::name-jazz tonic exception-part unmatched-steps
+			  bass-and-inversion steps)
+  (let ((additions (chord::additions unmatched-steps))
+	;; get no 'omit' or 'no'
+	;; (subtractions #f))
+    	(subtractions (chord::subtractions unmatched-steps)))
+    (chord::inner-name-jazz tonic exception-part additions subtractions
+	     bass-and-inversion steps)))
+
+;; wip (set! chord::names-alist-jazz
+(define chord::names-alist-jazz
+      (append
+      '(
+        (((0 . 0) (2 . -1)) . ("m"))
 
+	;; some fixups -- jcn
+	; major seventh chord = triangle
+	(((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "N"))))
+	;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "M"))))
 
+	;; minor major seventh chord = m triangle
+	(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "N"))))
+	;; (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "M"))))
+	
+	)
+      ;; '()))
+      chord::names-alist-american))