From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Sat, 4 Jan 2003 02:22:14 +0000 (+0000)
Subject: 	* scm/chord-name.scm (set-chord-name-style): new function.
X-Git-Tag: release/1.7.11~18
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=f26384366ad0f8715db53a7a78f3971f1233012d;p=lilypond.git

	* scm/chord-name.scm (set-chord-name-style): new function.
	(new-chord-name-brew-molecule): revise to interpret markup only
	(new-chord->markup): cleanuppish rewrite. To be called from the
	new engraver.

	* lily/new-chord-name-engraver.cc: new engraver: call Chord ->
	Markup earlier, during interpreting.

	* input/test/{banter,jazz,american}-chords.ly (scheme): update
	style settings. Rename to chord-names-*.ly
---

diff --git a/ChangeLog b/ChangeLog
index 6872ada4eb..9cd6beae4d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,18 @@
-2002-12-30  Jan Nieuwenhuizen  <janneke@gnu.org>
+2003-01-04  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
 
-	* test.
+	* scripts/convert-ly.py	(FatalConversionError.conv): add style
+	covnersion rule. 
+
+	* scm/chord-name.scm (set-chord-name-style): new function.
+	(new-chord-name-brew-molecule): revise to interpret markup only
+	(new-chord->markup): cleanuppish rewrite. To be called from the
+	new engraver.
+
+	* lily/new-chord-name-engraver.cc: new engraver: call Chord ->
+	Markup earlier, during interpreting.
+
+	* input/test/{banter,jazz,american}-chords.ly (scheme): update
+	style settings. Rename to chord-names-*.ly
 
 2002-12-30  Juergen Reuter  <reuter@ipd.uka.de>
 
diff --git a/input/test/american-chords.ly b/input/test/american-chords.ly
deleted file mode 100644
index 287066c091..0000000000
--- a/input/test/american-chords.ly
+++ /dev/null
@@ -1,65 +0,0 @@
-\version "1.7.6"
-\header {
-    texidoc = "Chord names in american styles, according to one of our users.
-
-
-FIXME
-
-"
-}
-
-\include "english.ly"
-
-
-%%FIXME:
-
-% DON'T  do this in the test file, it messes up all other files in the directory.
-
-% #(set! chord::names-alist-american
-%     (append 
-%     '(
-%	 ;; any changes here, see scm/chord-name.scm
-%	)
-%      chord::names-alist-american))
-
-scheme = \chords {
-  c         % Major triad
-  cs:m      % Minor triad
-  df:m5-    % Diminished triad
-  c:5^3     % Root-fifth chord
-  c:4^3     % Suspended fourth triad
-  c:5+      % Augmented triad
-  c:2^3     % "2" chord
-  c:m5-.7-  % Diminished seventh
-  c:7+      % Major seventh
-  c:7.4^3   % Dominant seventh suspended fourth
-  c:5+.7    % Augmented dominant seventh
-  c:m5-.7   % "Half" diminished seventh
-  c:5-.7    % Dominant seventh flat fifth
-  c:5-.7+   % Major seventh flat fifth
-  c:m7+     % Minor-major seventh
-  c:m7      % Minor seventh
-  c:7       % Dominant seventh
-  c:6       % Major sixth
-  c:m6      % Minor sixth
-  c:9^7     % Major triad w/added ninth
-  c:6.9^7   % Six/Nine chord
-  c:9       % Dominant ninth 
-  c:7+.9    % Major ninth
-  c:m7.9    % Minor ninth
-}
-
-\score {
-  \notes <
-    \context ChordNames \scheme
-    \context Staff \transpose c c' \scheme
-  >
-  \paper {
-    \translator { 
-      \ChordNamesContext
-      ChordName \override #'word-space = #1 
-      ChordName \override #'style = #'american
-    }
-  }
-}
-%% new-chords-done %%
diff --git a/input/test/banter-chords.ly b/input/test/banter-chords.ly
deleted file mode 100644
index 51539b3087..0000000000
--- a/input/test/banter-chords.ly
+++ /dev/null
@@ -1,90 +0,0 @@
-\version "1.7.6"
-
-
-\header{
-texidoc =  "banter  chords
-
-
-FIXME
-
-"
-}
-
-% test German (Banter) naming
-% for more conventional naming, comment scm stuff out
-
-% urg, 
-% this shows a serious shortcoming with our guile approach:
-% we can't (easily) display banter/non banter chords alongside
-% eachother.  These guile lists are fixed in the guile environment
-% when this file has been parsed...
-
-%{
-
-
-%% FIXME: 
-
-#;(define chord::names-alist-banter '())
-#(set! chord::names-alist-banter
-      (append 
-      '(
-        (((0 . 0) (2 . -1) (4 . -1)) . (("m" ("5-" . (type . "super")))))
-	 Co iso Cm5-7-
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("o" (type "super")))
-	)))
-
-% German note names:
-% Urg, this will break again, in time
-% Is this correct, anyway?
-
-#(define (pitch->text pitch)
-  (if (and (= (modulo (cadr pitch) 7) 6)
-	      (= (caddr pitch) -1))
-      (cons (make-string 1 (integer->char 66)) '())
-      (cons
-       (if (= (modulo (cadr pitch) 7) 6)
-	   (make-string 1 (integer->char 72))
-	   (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))))
-       (if (= (caddr pitch) 0)
-	   '()
-	   (list (list (string-append "accidentals-" 
-				      (number->string (caddr pitch)))
-		       '(font . "feta")))))))
-
-%}
-
-chord =  \notes\transpose c' c''\chords{
-	% dim modifier means: lower all implicit additions
-	c:dim9
-	c:dim
-	c:dim7
-	% explicit additions are taken as entered:
-	c:m5-.7-
-	% note that 7 is a special case: it's always lowered by 1...
-	c:dim7-.9
-	c:dim9-.11
-
-	% test German names
-	b:dim7
-	bes:m5-
-
-	\break
-
-	c:sus2  %?
-	c:sus4
-	c^3
-	c^3.5
-	c:2.6^5
-	c:dim^5-
-	c:dim7^5-
-	cis:m5-
-}
-
-\score{
-	<
-		\context ChordNames \chord
-		\context Staff \chord
-	>
-}
-
-%% new-chords-done %%
diff --git a/input/test/jazz-chords.ly b/input/test/jazz-chords.ly
deleted file mode 100644
index 7c6db2ad30..0000000000
--- a/input/test/jazz-chords.ly
+++ /dev/null
@@ -1,69 +0,0 @@
-\version "1.7.6"
-
-
-
-%% This should only be necessary if your kpathsea setup is broken
-%
-% Make sure the correct msamxx.tfm is where lily can find it
-% (ie cwd or lily's tfm dir).
-%
-% For normal (20pt) paper, do
-%
-%   cp locate `msam9.tfm` LILYPONDPREFIXxtfm
-%
-
-scheme = \chords {
-  % major chords
-  c
-  c:6		% 6 = major triad with added sixth
-  c:maj		% triangle = maj
-  c:6.9^7	% 6/9 
-  c:9^7		% add9
-
-  % minor chords
-  c:m		% m = minor triad
-  c:m.6		% m6 = minor triad with added sixth
-  c:m.7+	% m triangle = minor major seventh chord
-  c:3-.6.9^7	% m6/9 
-  c:m.7		% m7
-  c:3-.9	% m9
-  c:3-.9^7	% madd9
-
-  % dominant chords
-  c:7		% 7 = dominant
-  c:7.5+	% +7 = augmented dominant
-  c:7.5-	% 7b5 = hard diminished dominant
-  c:9		% 7(9)
-  c:9-		% 7(b9)
-  c:9+		% 7(#9)
-  c:13^9.11 	% 7(13)
-  c:13-^9.11 	% 7(b13)
-  c:13^11	% 7(9,13)
-  c:13.9-^11	% 7(b9,13)
-  c:13.9+^11	% 7(#9,13)
-  c:13-^11	% 7(9,b13)
-  c:13-.9-^11	% 7(b9,b13)
-  c:13-.9+^11	% 7(#9,b13)
-
-  % half diminished chords
-  c:m5-.7		% slashed o = m7b5
-  c:9.3-.5-	% o/7(pure 9)
-
-  % diminished chords
-  c:m5-.7-	% o = diminished seventh chord
-}
-
-\score {
-  \notes <
-    \context ChordNames \scheme
-    \context Staff \transpose c c' \scheme
-  >
-  \paper {
-    \translator { 
-      \ChordNamesContext
-      ChordName \override #'word-space = #1 
-      ChordName \override #'style = #'jazz
-    }
-  }
-}
-%% new-chords-done %%
diff --git a/lily/new-chord-name-engraver.cc b/lily/new-chord-name-engraver.cc
new file mode 100644
index 0000000000..e0be6ccf72
--- /dev/null
+++ b/lily/new-chord-name-engraver.cc
@@ -0,0 +1,129 @@
+/*
+  chord-name-engraver.cc -- implement New_chord_name_engraver
+
+  source file of the GNU LilyPond music typesetter
+
+  (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
+*/
+
+#include "engraver.hh"
+#include "chord-name.hh"
+#include "chord.hh"
+#include "event.hh"
+#include "paper-def.hh"
+#include "font-interface.hh"
+#include "paper-def.hh"
+#include "main.hh"
+#include "dimensions.hh"
+#include "item.hh"
+#include "pitch.hh"
+#include "protected-scm.hh"
+
+class New_chord_name_engraver : public Engraver 
+{
+  TRANSLATOR_DECLARATIONS( New_chord_name_engraver);
+protected:
+  virtual void stop_translation_timestep ();
+  virtual void process_music ();
+  virtual bool try_music (Music *);
+
+private:
+  void add_note (Music *);
+  
+  Item* chord_name_;
+  Link_array<Music> notes_;
+  
+  Protected_scm last_chord_;
+};
+
+
+
+New_chord_name_engraver::New_chord_name_engraver ()
+{
+  chord_name_ = 0;
+  last_chord_ = SCM_EOL;
+}
+
+void
+New_chord_name_engraver::add_note (Music * n)
+{
+  notes_.push (n);
+}
+
+void
+New_chord_name_engraver::process_music ()
+{
+  if (!notes_.size() )
+    return;
+  
+  SCM bass = SCM_EOL;
+  SCM inversion = SCM_EOL;
+  SCM pitches = SCM_EOL;
+
+  for (int i =0 ; i < notes_.size (); i++)
+    {
+      Music *n = notes_[i];
+      SCM p = n->get_mus_property ("pitch");;
+      if (n->get_mus_property ("inversion") == SCM_BOOL_T)
+	inversion = p;
+      else if (n->get_mus_property ("bass") == SCM_BOOL_T)
+	bass = p;
+      else
+	pitches = gh_cons (p, pitches);
+    }
+
+  pitches = scm_sort_list (pitches, Pitch::less_p_proc);
+
+  SCM name_proc = get_property ("chordNameFunction");
+  SCM exceptions = get_property ("chordNameExceptions");
+  SCM markup = scm_call_4 (name_proc, pitches, bass, inversion, exceptions);
+
+  /*
+    Ugh. 
+   */
+  SCM chord_as_scm = gh_cons (pitches, gh_cons (bass, inversion));
+  
+  chord_name_ = new Item (get_property ("ChordName"));
+  chord_name_->set_grob_property("text", markup);
+  announce_grob(chord_name_, SCM_EOL);
+  SCM s = get_property ("chordChanges");
+  if (to_boolean (s) && ly_car (last_chord_) != SCM_EOL
+      && gh_equal_p (chord_as_scm, last_chord_))
+    chord_name_->set_grob_property ("begin-of-line-visible", SCM_BOOL_T);
+
+  last_chord_ = chord_as_scm;
+}
+
+bool
+New_chord_name_engraver::try_music (Music* m)
+{
+  /*
+    hmm. Should check? 
+   */
+  if (m->is_mus_type ("note-event"))
+    {
+      add_note (m);
+      return true;
+    }
+  return false;
+}
+
+void
+New_chord_name_engraver::stop_translation_timestep ()
+{
+  if (chord_name_)
+    {
+      typeset_grob (chord_name_);
+    }
+  chord_name_ = 0;
+  notes_.clear ();
+}
+
+ENTER_DESCRIPTION(New_chord_name_engraver,
+/* descr */       "Catch note-events "
+"and generate the appropriate chordname.",
+/* creats*/       "ChordName",
+/* accepts */     "note-event",
+/* acks  */      "",
+/* reads */       "chordChanges chordNameExceptions chordNameFunction",
+/* write */       "");
diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index 7058c1de07..0ed7f41b04 100644
--- a/ly/engraver-init.ly
+++ b/ly/engraver-init.ly
@@ -298,12 +298,9 @@ ChordNamesContext = \translator {
 	\type "Engraver_group_engraver"
 	\name ChordNames
 
-
-
-
 	\consists "Output_property_engraver"	
 	\consists "Separating_line_group_engraver"
-	\consists "Chord_name_engraver"
+	\consists "New_chord_name_engraver"
 	\consists "Skip_req_swallow_translator"
 	\consistsend "Axis_group_engraver"
 	minimumVerticalExtent = ##f
@@ -445,6 +442,8 @@ ScoreContext = \translator {
 	  custos
 	)
 	barCheckSynchronize = ##t
+	chordNameFunction = #chord->markup-banter
+	chordNameExceptions = #chord::names-alist-banter
 
 	\grobdescriptions #all-grob-descriptions
 }
@@ -519,5 +518,7 @@ TabStaffContext = \translator {
       \remove Key_engraver
       stringTunings   = #guitar-tunings
       tablatureFormat = #fret-number-tablature-format
+
+
 }
    
diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 803b693f5a..ac8ffa7c44 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -15,9 +15,13 @@
    )
 
 
-;; debugging.
-;;(define (write-me x) (write x) (newline) x)
-(define (write-me x) x)
+(define-public (write-me x)
+  "Write and return X. For debugging purposes. "
+  (write x) (newline) x)
+
+;(define (dbg x) (write-me x))
+(define (dbg x) x)
+
 ;;(define (write-me x) (write x) (newline) x)
 ;;(define (write-me-2 x y) (write "FOO") (write x) (write y) (newline) y)
 
@@ -38,7 +42,7 @@ dump reinterpret the markup as a molecule. " ; "
 ;;
 ;; note = (notename . alteration)
 ;;
-;; text = scm markup text -- see font.scm and input/test/markup.ly
+;; markup = markup text -- see font.scm and input/test/markup.ly
 
 
 ;; TODO
@@ -58,7 +62,7 @@ dump reinterpret the markup as a molecule. " ; "
 ;;
 ;; * doc strings
 
-(define chord::names-alist-banter
+(define-public chord::names-alist-banter
        `(
 	; C iso C.no3.no5
 	(((0 . 0)) . ,empty-markup)
@@ -84,8 +88,8 @@ dump reinterpret the markup as a molecule. " ; "
 	(((0 . 0) (2 . -1) (4 . -1) (6 . -1))
 	 . ,(make-line-markup
 	     (list
-	     (make-simple-markup "m")
-	     (make-super-markup (make-simple-markup "5-/7 ")))))
+	      (make-simple-markup "m")
+	      (make-super-markup (make-simple-markup "5-/7 ")))))
 	; Co iso C:m5-/7-
         (((0 . 0) (2 . -1) (4 . -1) (6 . -2))
 	 . ,(make-super-markup (make-simple-markup "o ")))
@@ -93,7 +97,7 @@ dump reinterpret the markup as a molecule. " ; "
 	(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1))
 	 . ,(make-line-markup
 	     (list (make-simple-markup "dim")
-		   (make-simple-markup "9 "))))
+		   (make-super-markup (make-simple-markup "9 ")))))
 	(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1))
 	 . ,(make-line-markup
 	     (list (make-simple-markup "dim")
@@ -102,8 +106,23 @@ dump reinterpret the markup as a molecule. " ; "
 	
 	))
 
-;;;;;;;;;;
-
+(define (accidental->textp acc pos)
+  (if (= acc 0)
+      '()
+      (if (equal? pos 'columns)
+        (list '(music (font-relative-size . -1))
+                   (list (string-append "accidentals-" (number->string acc))))
+        (if (equal? pos 'super)
+          (list '(music (raise . 2) (font-relative-size . -1))
+                   (list (string-append "accidentals-" (number->string acc))))
+          (list '(music (raise . -1) (font-relative-size . -1))
+                   (list (string-append "accidentals-" (number->string acc))))))))
+
+(define (accidental->text acc) (accidental->textp acc 'columns))
+(define (accidental->text-super acc) (accidental->textp acc 'super))
+(define (accidental->text-sub acc) (accidental->textp acc 'sub))
+
+; pitch->note-name: drops octave
 (define (pitch->note-name pitch)
   (cons (cadr pitch) (caddr pitch)))
 
@@ -115,11 +134,14 @@ dump reinterpret the markup as a molecule. " ; "
 			    (string-append "accidentals-"
 					   (number->string acc))))))
 
+;;
+;; TODO: invent sensible way to make note name tweaking possible?
+;;
 (define (pitch->markup pitch)
   (make-line-markup
    (list
     (make-simple-markup
-     (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))))
+     (vector-ref #("C" "D" "E" "F" "G" "A" "B")  (cadr pitch)))
     ;; undefined?
     ;; (make-normal-size-superscript-markup
     (make-super-markup
@@ -191,11 +213,9 @@ dump reinterpret the markup as a molecule. " ; "
 (define (pitch::note-pitch pitch)
   (+ (* (car pitch) 7) (cadr pitch)))
 
-;; markup: list of word
-;; word: string + optional list of property
-;; property: axis, kern, font (?), size
 
-(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
+; what's this? 
+(define chord::minor-major-vec #(0 -1 -1 0 -1 -1 0))
 
 ;; FIXME: unLOOP
 ;; compute the relative-to-tonic pitch that goes with 'step'
@@ -312,11 +332,9 @@ dump reinterpret the markup as a molecule. " ; "
 
 ;; FIXME: merge this function with inner-name-jazz, -american
 ;;        iso using chord::bass-and-inversion->markup-banter,
-;;        call (chord::restyle 'chord::bass-and-inversion->markup- style)
 ;;        See: chord::exceptions-lookup
 (define (chord::inner-name-banter tonic exception-part additions subtractions
 				  bass-and-inversion steps)
-
   "
         
  Banter style
@@ -347,7 +365,7 @@ dump reinterpret the markup as a molecule. " ; "
       (make-raise-markup
        0.3
        (make-line-markup (list adds-markup subs-markup)))
-     b+i-markup))))
+      b+i-markup))))
 
 (define (c++-pitch->scm p)
   (if (ly:pitch? p)
@@ -356,74 +374,53 @@ dump reinterpret the markup as a molecule. " ; "
 
 (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-module (current-module))
-(define (chord::restyle name style)
-  ;;   "UGGHGUGHUGHG"
-  (eval
-   (string->symbol
-    (string-append (symbol->string name)
-		   (symbol->string style)))
-   chord-module
-   ))
+  (let ((additions (chord::additions unmatched-steps))
+	(subtractions (chord::subtractions unmatched-steps)))
+    
+    (chord::inner-name-banter tonic exception-part additions subtractions
+			      bass-and-inversion steps)))
 
 
-;; this is unintelligible.
-;;
-
-;
-; - what's a helper, and why isn't it inside another function?
-;
-; what is going out, what is coming in, howcome it produces #f 
-;  in some cases?
-;
+;; see above.
+(define (chord::exceptions-lookup exceptions steps)
+  "
+   return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
+   BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
 
-(define (chord::exceptions-lookup-helper
-	 exceptions-alist try-steps unmatched-steps exception-part)
-	 "
+"
+  ;; this is unintelligible.
+  ;;
+  (define (chord::exceptions-lookup-helper
+	   exceptions-alist try-steps unmatched-steps exception-part)
+    "
 
  check exceptions-alist for biggest matching part of try-steps
  return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
 
 "
-  (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)))
+    (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
-	       exceptions-alist
-	       (reverse (cdr r))
-	       (cons (car r) unmatched-steps) #f))))
-      (cons exception-part unmatched-steps)))
-
-;; see above.
-
-(define (chord::exceptions-lookup style steps)
-  "
-   return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
-   BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
-
-"
+	       #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)))
 
   (let* ((result (chord::exceptions-lookup-helper
-		  (chord::restyle 'chord::names-alist- style)
+		  exceptions
 		  steps '() #f))
 	   (exception-part (car result))
 	   (unmatched-steps (cdr result))
@@ -440,597 +437,409 @@ dump reinterpret the markup as a molecule. " ; "
     (list exception-part unmatched-with-1-3-5)))
 
 
-(define (chord::name->markup style tonic steps bass-and-inversion)
-  (write-me tonic)
-  (write-me steps)
-  (let* ((lookup (write-me (chord::exceptions-lookup style steps)))
-	 (exception-part (write-me (car lookup)))
-	 (unmatched-steps (cadr lookup))
-	 (func (chord::restyle 'chord::name- style))
-	 )
 
-    
-    (func 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-public (chord->markup 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->markup 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,
-;; such as maj7, maj9, etc.
-;;
 ;; See input/test/american-chords.ly
 ;;
-;; James Hammons, <jlhamm@pacificnet.net>
-;;
+;; Original Version by James Hammons, <jlhamm@pacificnet.net>
+;; Complete rewrite by Amelie Zapf, <amy@loueymoss.com>
 
 ;; DONT use non-ascii characters, even if ``it works'' in Windows
-
-
-(define chord::names-alist-american
-      
-       `(
-	 (((0 . 0)) . ,empty-markup)
-	 (((0 . 0) (2 . 0)) . ,empty-markup)
-	 ;; Root-fifth chord
-	 (((0 . 0) (4 . 0)) . ,(make-simple-markup "5"))
-	 ;; Common triads
-	 (((0 . 0) (2 . -1)) . ,(make-simple-markup  "m"))
-	 (((0 . 0) (3 . 0) (4 . 0)) . ,(make-simple-markup "sus"))
-	 (((0 . 0) (2 . -1) (4 . -1)) . ,(make-simple-markup "dim"))
-;Alternate:	 (((0 . 0) (2 . -1) (4 . -1)) . ("" (super "o")))
-	 (((0 . 0) (2 . 0) (4 . 1)) . ,(make-simple-markup "aug"))
-;Alternate:	 (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
-	 (((0 . 0) (1 . 0) (4 . 0)) . ,(make-simple-markup "2"))
-	 ;; Common seventh chords
-	 (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .
-	  ,(make-line-markup
-	    (list
-	     (make-super-markup (make-simple-markup "o"))
-	     (make-simple-markup " 7"))))
-	 (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ,(make-simple-markup "maj7"))
-	 ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
-	 (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ,(make-simple-markup "m7"))
-	 (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ,(make-simple-markup "7"))
-	 (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ,(make-simple-markup "m(maj7)"))
-	 ;jazz: the delta, see jazz-chords.ly
-	 ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2))
-	 ;; .  (super ((font-family . math) "N"))
-	 ;; slashed o
-	 (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) .
-	  ,(make-line-markup
-	    (list
-	     (make-super-markup
-	      (make-combine-markup (make-simple-markup "o")
-				   (make-simple-markup "/")))
-	     (make-simple-markup " 7"))))
-	 (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ,(make-simple-markup "aug7"))
-	 (((0 . 0) (2 . 0) (4 . -1) (6 . 0))
-	  . ,(make-line-markup
-	      (list
-	       (make-simple-markup "maj7")
-	       (make-small-markup
-		(make-raise-markup 0.2 (accidental-markup -1)))
-	       (make-simple-markup "5"))))
-	 (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) .
-	  ,(make-line-markup
-	    (list
-	     (make-simple-markup "7")
-	     (make-small-markup (make-raise-markup 0.2 (accidental-markup -1)))
-	     (make-simple-markup "5"))))
-	 (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ,(make-simple-markup "7sus4"))
-	 ;; Common ninth chords
-	 (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0))
-	  . ,(make-simple-markup "6/9")) ;; we don't want the '/no7'
-	 (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ,(make-simple-markup "6"))
-	 (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ,(make-simple-markup "m6"))
-	 (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ,(make-simple-markup "add9"))
-	 (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0))
-	  . ,(make-simple-markup "maj9"))
-	 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0))
-	  . ,(make-simple-markup "9"))
-	 (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0))
-	  . ,(make-simple-markup "m9"))
-
-	 ))
-
-;; American style chordnames use no "no",
-;; but otherwise very similar to banter for now
-(define-public (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 bass.
-;;	Some defs take up more than one line,
-;; be carefull when messing with ;'s!!
-
-
-;; FIXME
-;;
-;; This is getting out-of hand?  Only exceptional chord names that
-;; cannot be generated should be here.
-;; Maybe we should have inner-name-jazz and inner-name-american functions;
-;; 
-;;       
-;;
 ;; DONT use non-ascii characters, even if ``it works'' in Windows
 
+;;a white triangle
 (define mathm-markup-object
   (make-override-markup '(font-family . math) (make-simple-markup "M")))
 
-(define mraise-arg `(make-line-markup
-		     (list
-		      ,(make-simple-markup "m")
-		      (make-raise-markup 0.5 (make-simple-markup arg)))))
-
-(define (raise-some-for-jazz arg-list)
-  (define (do-one x)
-    (case x
-      ("@"  (make-raise-markup 0.3 ,(accidental-markup -1)))
-      ("#"  (make-raise-markup 0.3 ,(accidental-markup 1)))
-      (else (make-raise-markup 0.8 ,x))))
-
-  (make-line-markup
-   (list (map do-one arg-list))))
-
-(define chord::names-alist-jazz 
-  (append 
-      '(
-	;; major chords
-	; major sixth chord = 6
- 	(((0 . 0) (2 . 0) (4 . 0) (5 . 0)) .
-	 ,(make-raise-markup 0.5 (make-simple-markup "6")))
-	; major seventh chord = triangle
-	;; shouldn't this be a filled black triange, like this:  ? --jcn
-	;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "N"))))
-	(((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .
-	 ,(make-raise-markup 0.5 mathm-markup-object))
-	
-	; major chord add nine = add9
-	(((0 . 0) (2 . 0) (4 . 0) (1 . 0))
-	 . ,(make-raise-markup 0.5 (make-simple-markup "add9")))
-	; major sixth chord with nine = 6/9
-	(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0))
-	 . ,(make-raise-markup 0.5 (make-simple-markup "add9")))
-
-	;; minor chords
-	; minor sixth chord = m6
- 	(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) .
-	 ,(mraise-arg "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)) . (columns ("m") ((raise . 0.5)((font-family . math) "N"))))
-	(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) .
-	 ,(make-line-markup
-	   (list ((make-simple-markup "m") mathm-markup-object))))
-	; minor seventh chord = m7
-	(((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ,(mraise-arg "7"))
-	; minor sixth nine chord = m6/9
-	(((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . ,(mraise-arg "6/9"))
-
-					; minor with added nine chord = madd9
-	(((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . ,(mraise-arg "madd9"))
-
-					; minor ninth chord = m9
-	(((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ,(mraise-arg "add9"))
-
-	;; dominant chords
-	; dominant seventh = 7
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1))
-	 . ,(make-raise-markup 0.5 (make-simple-markup "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)) .
-	 ,(make-line-markup
-	   (list
-	    (make-simple-markup "+")
-	    ;; +7 with 7 raised
-	    (make-raise-markup 0.5 (make-simple-markup "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)"))); 7(#5)
-	; dominant flat 5 = 7(b5)
-	
-	(((0 . 0) (2 . 0) (4 . -1) (6 . -1))
-	 . ,(raise-some-for-jazz '( "7(" "@" "5)" )))
-	
-					; dominant 9 = 7(9)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) .
-	 ,(raise-some-for-jazz '("7(9)")))
-	; dominant flat 9 = 7(b9)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) .
-	 ,(raise-some-for-jazz '("7(" "@" "9)")))
-	
-	; dominant sharp 9 = 7(#9)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) .
-	 ,(raise-some-for-jazz '("7(" "#" "9)")))
-
-					; dominant 13 = 7(13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) .
-	 ,(raise-some-for-jazz "7(13)"))
-	; dominant flat 13 = 7(b13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) .
-	 ,(raise-some-for-jazz '( "7(" "@" "13)")))
-
-					; dominant 9, 13 = 7(9,13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) .
-	 ,(raise-some-for-jazz '("7(9, 13)")))
-	; dominant flat 9, 13 = 7(b9,13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) .
-	 ,(raise-some-for-jazz '("7(" "@" "9, 13)")))
-	
-	; dominant sharp 9, 13 = 7(#9,13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) .
-	 ,(raise-some-for-jazz '("7(" "#" "9,13)")))
+;a black triangle
+(define mathn-markup-object
+  (make-override-markup '(font-family . math) (make-simple-markup "N")))
+
+(define-public chord::names-alist-american 
+  `(
+    (((0 . 0)) . ,empty-markup)
+    (((0 . 0)) . ,empty-markup)
+    (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
+    (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
+    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+					;choose your symbol for the fully diminished chord
+    (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim"))
+					;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list empty-markup (make-super-markup (make-simple-markup "o")))))
+    )
+  )
+
+(define (step->markup-accidental pitch)
+    (case (caddr pitch)
+      ((-2) (accidental-markup -2))
+      ((-1) (accidental-markup -1))
+      ((0) empty-markup)
+      ((1) (accidental-markup 1))
+      ((2) (accidental-markup 2)))
+    (make-simple-markup (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))
+
+(define (step->markup-american pitch)
+  (case (cadr pitch)
+    ((6) (case (caddr pitch)
+	   ((-2) (make-line-markup (list (accidental-markup -1) (make-simple-markup "7"))))
+	   ((-1) (make-simple-markup "7"))
+	   ((0) (make-simple-markup "maj7"))
+	   ((1) (make-line-markup (list (accidental-markup 1) (make-simple-markup "7"))))
+	   ((2) (make-line-markup (list (accidental-markup 2) (make-simple-markup "7"))))))
+    ((4) (case (caddr pitch)
+	   ((-2) (make-line-markup (list (accidental-markup -2) (make-simple-markup "5"))))
+	   ;;choose your symbol for the diminished fifth
+	   ((-1) (make-simple-markup "-5"))
+	   ;;((-1) (make-line-markup (list (accidental-markup -1) (make-simple-markup "5")))))
+	   ((0) empty-markup)
+	   ;;choose your symbol for the augmented fifth
+	   ;;((1) (make-simple-markup "aug"))
+	   ;;((1) (make-line-markup (list (accidental-markup 1) (make-simple-markup "5")))))
+	   ((1) (make-simple-markup "+5"))
+	   ((2) (make-line-markup (list (accidental-markup 2) (make-simple-markup "5"))))))
+    (else (if (and (= (car pitch) 0)
+		   (= (cadr pitch) 3)
+		   (= (caddr pitch) 0))
+	      (make-simple-markup "sus4")
+	      (step->markup-accidental pitch)))))
+  
+(define (chord::additions->markup-american additions subtractions)
+  (if (pair? additions)
+     ; I don't like all this reasoning here, when we're actually typesetting.
+     (if(and(pair? (cdr additions)) ;a further addition left over
+	    (or(and(= 0 (caddr(car additions))) ;this addition natural
+ 		   (not(= 6 (cadr(car additions)))))
+ 	       (and(= -1 (caddr(car additions)))
+ 		   (= 6 (cadr(car additions)))))
+ 	    (or(and(= 0 (caddr(cadr additions))) ;the following addition natural
+ 		   (not(= 6 (cadr(cadr additions)))))
+ 	       (and(= -1 (caddr(cadr additions)))
+ 		   (= 6 (cadr(cadr additions)))))
+ 	    (or(and(= (car(car additions)) (car(cadr additions))) ;both a third apart
+ 		   (= 2 (- (cadr(cadr additions)) (cadr(car additions)))))
+ 	       (and(= 1 (- (car(cadr additions)) (car(car additions))))
+ 		   (= 5 (- (cadr(car additions)) (cadr(cadr additions))))))
+ 	    (or(null? subtractions) ;this or clause protects the "adds"
+ 	       (and (pair? subtractions)
+ 		    (or (< (car(cadr additions)) (car(car subtractions)))
+ 			(and(= (car(cadr additions)) (car(car subtractions)))
+ 			    (< (cadr(cadr additions)) (cadr(car subtractions))))))))
+	(chord::additions->markup-american (cdr additions) subtractions)
+	(make-line-markup
+	 (list
+	  (let ((step (step->markup-american (car additions))))
+	    (if (or (pair? (cdr additions))
+		    (pair? subtractions))
+		(if (and (pair? (cdr additions))
+			 (or(< 3 (- (cadr(cadr additions)) (cadr(car additions))))
+			    (and(< 0 (- (car(cadr additions)) (car(car additions))))
+				(> 4 (- (cadr(car additions)) (cadr(cadr additions)))))))
+		    (make-line-markup (list step (make-simple-markup " add")))
+		    ;; tweak your favorite separator here
+		    ;; (make-line-markup (list step (make-simple-markup "/")))
+		    (make-line-markup (list step (make-simple-markup " "))))
+		step))
+	  (chord::additions->markup-american (cdr additions) subtractions))))
+     empty-markup))
+
+(define (chord::inner-name-american tonic exception-part additions subtractions
+				  bass-and-inversion steps)
+  (let* ((tonic-markup (pitch->chord-name-markup-banter tonic steps))
+	 (except-markup (if exception-part exception-part empty-markup))  ;;(make-simple-markup "")
+	 (sep-markup (if (and (string-match "super" (format "~s" except-markup))
+			    (or (pair? additions)
+				(pair? subtractions)))
+		       (make-super-markup (make-simple-markup "/"))
+		       empty-markup))
+	 ;this list contains all the additions that go "in line"
+	 (prefixes
+	  (filter-list (lambda (x)
+			 (let ((o (car x)) (n (cadr x)) (a (caddr x)))
+			   (and (not (and (= 0 o) (= 2 n))) ;gets rid of unwanted thirds
+				;change this if you want it differently
+				(not (and (= 0 o) (= 3 n) (= 0 a))) ;sus4
+				(not (and (= 0 o) (= 4 n) (!= 0 a)))))) ;alt5
+		       additions))
+	 ;this list contains all the additions that are patched onto the end
+	 ;of the chord symbol, usually sus4 and altered 5ths.
+	 (suffixes
+	  ;take out the reverse if it bothers you in a pathological chord
+	  (reverse (filter-list (lambda (x)
+			 (let ((o (car x)) (n (cadr x)) (a (caddr x)))
+			   (and(not (and (= 0 o) (= 2 n))) ;gets rid of unwanted thirds
+			   ;change this correspondingly
+			       (or(and (= 0 o) (= 3 n) (= 0 a)) ;sus4
+				  (and (= 0 o) (= 4 n) (!= 0 a)))))) ;alt5
+		       additions)))
+	 (relevant-subs (filter-list (lambda (x) ;catches subtractions higher than 5th
+				       (let((o (car x)) (n (cadr x)))
+					 (or (> o 0)
+					     (> n 4))))
+				     subtractions))
+	 (pref-markup (chord::additions->markup-american prefixes relevant-subs))
+	 (suff-markup (chord::additions->markup-american suffixes relevant-subs))
+	 (b+i-markup (chord::bass-and-inversion->markup-banter bass-and-inversion)))
+    (make-line-markup
+     (list
+      tonic-markup except-markup sep-markup
+      (make-raise-markup
+       0.3
+       (make-line-markup
+	(list pref-markup suff-markup)))
+      b+i-markup))))
 
-					; dominant 9, flat 13 = 7(9,b13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) .
-	 ,(raise-some-for-jazz "7(9, " "@" "13)"))
-	
-	; dominant flat 9, flat 13 = 7(b9,b13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) .
-	 ,(raise-some-for-jazz '("7(" "@" "9, " "@" "13)")))
-	 
-	; dominant sharp 9, flat 13 = 7(#9,b13)
-	(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) .
-	 ,(raise-some-for-jazz '("7(" "#" "9, " "@" "13)")))
+(define (chord::additions-american steps)
+  (let ((evens (filter-list (lambda (x) (!= 0 (modulo (cadr x) 2))) steps))
+	;we let all the unevens pass for now, we'll fix that later.
+	(unevens
+	 (filter-list (lambda (x)
+			(let ((n (cadr x)) (a (caddr x)))
+			  (or (and (= 6 n) (!= -1 a))
+			      (and (< 3 n)
+				   (= 0 (modulo n 2))))))
+		      steps))
+	(highest (let ((h (car (last-pair steps))))
+		   (if (and (not (null? h))
+			    (or (> 4 (cadr h))
+				(!= 0 (caddr h))))
+		       (list (list h))
+		       '()))))
+    (uniq-list (sort (apply append evens unevens highest)
+		     pitch::<))))
 
-	;; diminished chord(s)
-	; diminished seventh chord =  o
+  ;; American style chordnames use no "no",
+  ;; but otherwise very similar to banter for now
+  (define-public (chord::name-american tonic exception-part unmatched-steps
+  			      bass-and-inversion steps)
+  (let ((additions (chord::additions-american unmatched-steps))
+	(subtractions (chord::subtractions unmatched-steps)))
+    (chord::inner-name-american tonic exception-part additions subtractions
+  			      bass-and-inversion steps)))
+
+  ;;; Jazz style
+  ;;;
+;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
+;; Complete rewrite by Amelie Zapf (amy@loueymoss.com)
 
+(define-public chord::names-alist-jazz 
+  `(
+    (((0 . 0)) . ,empty-markup)
+    (((0 . 0)) . ,empty-markup)
+    (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
+    (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
+    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+					;choose your symbol for the fully diminished chord
+					;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim"))
+    (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list (make-simple-markup "") (make-super-markup (make-simple-markup "o")))))
+    ))
 
-	;; DONT use non-ascii characters, even if ``it works'' in Windows
-	
- 	;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
- 	(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .
-	 ,(make-super-markup (make-simple-markup "o")))
-
-	;; 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)) .
-	 ,(make-line-markup
-	   (list
-	    (make-super-markup
-	     (make-combine-markup
-	      (make-simple-markup "o") (make-simple-markup "/")))
-	    (make-simple-markup "  7"))))
-	; half diminished seventh chord  with major 9 = slashed o cancelation 9
-	(((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) .
-	 ,(raise-some-for-jazz '("/o(" "!" "9)")))
-
-;; Missing jazz chord definitions go here (note new syntax: see american for hints)
-
-	)
-      chord::names-alist-american))
-
-(define (step->markup-alternate-jazz pitch)
-  (make-line-markup
-   (list
-    (accidental-markup (caddr pitch))
-    (make-simple-markup
-     (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))))
 
 (define (step->markup-jazz pitch)
-  (if (= (cadr pitch) 6)
-      (case (caddr pitch)
-	;; sharp 7 only included for completeness?
-	((-2) (make-line-markup
-	       (list
-		(accidental-markup  -1)
-		(make-simple-markup "7"))))
-	((-1) (make-simple-markup "7"))
-	((0) (make-simple-markup "maj7"))
-	;;((0) (make-line-markup
-	;;      (list (make-simple-markup "maj7"))))
-	((1) (make-line-markup
-	      (list
-	       (accidental-markup 1) (make-simple-markup "7"))))
-	((2) (make-line-markup
-	      (list (accidental-markup 1)
-		    (make-simple-markup "7")))))
-      (step->markup-alternate-jazz pitch)))
-
-;; removeme ?
-(define (xchord::additions->markup-jazz additions subtractions)
-  (if (pair? additions)
-      (make-line-markup
-       (list
-	(let ((step (step->markup-jazz (car additions))))
-	  (if (or (pair? (cdr additions))
-		  (pair? subtractions))
-	      (make-line-markup (list step (make-simple-markup "/")))
-	      step))
-	(chord::additions->markup-jazz (cdr additions) subtractions)))
-      empty-markup))
-
-(define (chord::>5? x)
-  (or (> (car x) 0)
-      (> (cadr x) 4)))
-
+  (case (cadr pitch)
+    ((6) (case (caddr pitch)
+	   ((-2) (make-line-markup (list (accidental-markup -1) (make-simple-markup "7"))))
+	   ((-1) (make-simple-markup "7"))
+					;Pick your favorite maj7
+	   ((0) mathm-markup-object)  ;;a white triangle
+	   ;;((0) mathn-markup-object) ;;a black triangle
+	   ;;((0) (make-simple-markup "maj7")) ;;good old maj7
+	   ((1) (make-line-markup (list (accidental-markup 1) (make-simple-markup "7"))))
+	   ((2) (make-line-markup (list (accidental-markup 2) (make-simple-markup "7"))))))
+    ((4) (case (caddr pitch)
+	   ((-2) (make-line-markup (list (accidental-markup -2) (make-simple-markup "5"))))
+	   ;;choose your symbol for the diminished fifth
+	   ;;((-1) '("-5"))
+	   ((-1) (make-line-markup (list (accidental-markup -1) (make-simple-markup "5"))))
+	   ((0) (make-simple-markup ""))
+					;choose your symbol for the augmented fifth
+					;;;((1) (make-simple-markup "aug"))
+	   ((1) (make-line-markup (list (accidental-markup 1) (make-simple-markup "5"))))
+	   ;;((1) (make-simple-markup "+5"))
+	   ((2) (make-line-markup (list (accidental-markup 2) (make-simple-markup "5"))))))
+    (else (if (and (= (car pitch) 0)
+		   (= (cadr pitch) 3)
+		   (= (caddr pitch) 0))
+	      (make-simple-markup "sus4")
+	      (step->markup-accidental pitch)))))
 
-;; FIXME:
-;; Perhaps all logic like this should be done earlier,
-;; so that in this markup-construction printing phase
-;; we can just blindly create markup from all additions.
-;;
-;; 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->markup-jazz additions subtractions)
-      ;; FIXME
-  (make-line-markup
-   (list
-    (chord::additions<=5->markup-jazz
-     (filter-out-list chord::>5? additions)
-     (filter-out-list chord::>5? subtractions))
-    (chord::additions>5->markup-jazz
-     (filter-list chord::>5? additions)
-     (filter-list chord::>5? subtractions)))))
-
-
-;; FIXME
-(define (chord::additions<=5->markup-jazz additions subtractions)
-  (let ((sus (chord::sus-four-jazz additions)))
-    (if (pair? sus)
-	(make-line-markup
-	 (list (make-simple-markup "sus")
-	       (step->markup-jazz (car sus))))
-	empty-markup)))
-
-
-(define (chord::additions>5->markup-jazz additions subtractions)
-  "
-Compose markup 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
-  "
-  
-  (make-line-markup
-   (list
-    (if (not (null? subtractions))
-	(make-simple-markup "add")
-	empty-markup)
-    ;; this is totally incomprehensible. Fix me, and docme.
-
-    ;; The function >5markup-jazz-helper cdrs through the list
-    ;; of additions in reverse order, ie, for c 7 9+:
-    ;;   (1 1 1), (0 6 0),  done
-    
-    ;; For each step, it creates a markup, if necessary, and
-    ;; cons's it to the list.
-    
-    ;; The list is reversed.
-    (let* ((radds (reverse additions))
-	   (rmarkups (chord::additions>5->markup-jazz-helper
-		      radds
-		      subtractions
-		      (if (or (null? subtractions) (null? radds))
-			  #f (car radds)))))
-      (if (null? rmarkups)
-	  empty-markup
-	  (make-line-markup (reverse rmarkups)))))))
-	      
-
-
-(define (chord::additions>5->markup-jazz-helper additions subtractions list-step)
-  "
-Create markups 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->markup-jazz list-step)
-	       
-	       (chord::additions>5->markup-jazz-helper
-		additions
-		subtractions
-		(chord::get-create-step additions
-					(- (cadr list-step) 2))))
-	      
-	      (list (step->markup-jazz list-step)))
-
-	  '())
-      
-      (if (pair? additions)
-	  (let ((step (car additions)))
-	    (cons
-	     (step->markup-jazz step)
-	     
-	     (chord::additions>5->markup-jazz-helper
-	      (cdr additions)
-	      subtractions
-	      (if ;;; possible fix --jcn
-	       (and list-step
-		    (or (and (!= 6 (cadr step)) (!= 0 (caddr step)))
-			(and (= 6 (cadr step)) (!= -1 (caddr step))))
-		    ) ;;; possible fix --jcn
-		  (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 (null? found)
-	(if (!= i 6)
-	    (list 0 i 0)
-	    (list 0 6 -1))
-	(car found))))
-  
-(define (chord::subtractions->markup-jazz subtractions)	 
-  (if (pair? subtractions)
-      (make-line-markup
-       (list
-	(if (= 5 (cadr (car subtractions)))
-	    (make-line-markup
-	     (list
-	      (make-simple-markup "omit")
-		 (let ((step (step->markup-jazz (car subtractions))))
-		   (if (pair? (cdr subtractions))
-		       (make-line-markup
-			(list (step (make-simple-markup "/"))))
-		       step))))
-	    empty-markup)
-	(chord::subtractions->markup-jazz (cdr subtractions))))
+  (if (pair? additions)
+					; I don't like all this reasoning here, when we're actually typesetting.
+      (if(and(pair? (cdr additions)) ;a further addition left over
+	     (or(and(= 0 (caddr(car additions))) ;this addition natural
+		    (not(= 6 (cadr(car additions)))))
+		(and(= -1 (caddr(car additions)))
+		    (= 6 (cadr(car additions)))))
+	     (or(and(= 0 (caddr(cadr additions))) ;the following addition natural
+		    (not(= 6 (cadr(cadr additions)))))
+		(and(= -1 (caddr(cadr additions)))
+		    (= 6 (cadr(cadr additions)))))
+	     (or(and(= (car(car additions)) (car(cadr additions))) ;both a third apart
+		    (= 2 (- (cadr(cadr additions)) (cadr(car additions)))))
+		(and(= 1 (- (car(cadr additions)) (car(car additions))))
+		    (= 5 (- (cadr(car additions)) (cadr(cadr additions))))))
+	     (or(null? subtractions) ;this or clause protects the "adds"
+		(and (pair? subtractions)
+		     (or (< (car(cadr additions)) (car(car subtractions)))
+			 (and(= (car(cadr additions)) (car(car subtractions)))
+			     (< (cadr(cadr additions)) (cadr(car subtractions))))))))
+	 (chord::additions->markup-jazz (cdr additions) subtractions)
+	 (make-line-markup
+	  (list
+	   (let ((step (step->markup-jazz (car additions))))
+	     (if (or (pair? (cdr additions))
+		     (pair? subtractions))
+		 (if (and (pair? (cdr additions))
+			  (or(< 3 (- (cadr(cadr additions)) (cadr(car additions))))
+			     (and(< 0 (- (car(cadr additions)) (car(car additions))))
+				 (> 4 (- (cadr(car additions)) (cadr(cadr additions)))))))
+		     (make-line-markup (list step (make-simple-markup " add")))
+		     ;; tweak your favorite separator here
+		     ;; (make-line-markup (list step "/"))
+		     (make-line-markup (list step (make-simple-markup " "))))
+		 step))
+	   (chord::additions->markup-jazz (cdr additions) subtractions))))
       empty-markup))
 
-;; 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)
-  (make-line-markup
-   (list
-    (pitch->chord-name-markup-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)))
-	(make-super-markup (make-simple-markup "/"))
-	empty-markup)
-   
-    (make-super-markup
-     (make-line-markup
-      (list
-       (chord::additions->markup-jazz additions subtractions)
-       (chord::subtractions->markup-jazz subtractions))))
-      
-   (chord::bass-and-inversion->markup-banter bass-and-inversion))))
-
-;; Jazz style--basically similar to american with minor changes
-;;
-;; 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-public (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)))
+				bass-and-inversion steps)
+  (let* ((tonic-markup (pitch->chord-name-markup-banter tonic steps))
+	 (except-markup (if exception-part exception-part empty-markup))  ;;(make-simple-markup "")
+	 (sep-markup (if (and (string-match "super" (format "~s" except-markup))
+			      (or (pair? additions)
+				  (pair? subtractions)))
+			 (make-super-markup (make-simple-markup "/"))
+			 empty-markup))
+					;this list contains all the additions that go "in line"
+	 (prefixes
+	  (filter-list (lambda (x)
+			 (let ((o (car x)) (n (cadr x)) (a (caddr x)))
+			   (and (not (and (= 0 o) (= 2 n))) ;gets rid of unwanted thirds
+					;change this if you want it differently
+				(not (and (= 0 o) (= 3 n) (= 0 a))) ;sus4
+				(not (and (= 0 o) (= 4 n) (!= 0 a)))))) ;alt5
+		       additions))
+					;this list contains all the additions that are patched onto the end
+					;of the chord symbol, usually sus4 and altered 5ths.
+	 (suffixes
+					;take out the reverse if it bothers you in a pathological chord
+	  (reverse (filter-list (lambda (x)
+				  (let ((o (car x)) (n (cadr x)) (a (caddr x)))
+				    (and(not (and (= 0 o) (= 2 n))) ;gets rid of unwanted thirds
+					;change this correspondingly
+					(or(and (= 0 o) (= 3 n) (= 0 a)) ;sus4
+					   (and (= 0 o) (= 4 n) (!= 0 a)))))) ;alt5
+				additions)))
+	 (relevant-subs (filter-list (lambda (x) ;catches subtractions higher than 5th
+				       (let((o (car x)) (n (cadr x)))
+					 (or (> o 0)
+					     (> n 4))))
+				     subtractions))
+	 (pref-markup (chord::additions->markup-jazz prefixes relevant-subs))
+	 (suff-markup (chord::additions->markup-jazz suffixes relevant-subs))
+	 (b+i-markup (chord::bass-and-inversion->markup-banter bass-and-inversion)))
+    (make-line-markup
+     (list
+      tonic-markup
+      except-markup
+      sep-markup
+      (make-raise-markup
+       0.33
+       (make-line-markup (list pref-markup suff-markup)))
+      b+i-markup))))
 
+(define (chord::name-jazz tonic exception-part unmatched-steps
+			  bass-and-inversion steps)
+  (let ((additions (chord::additions-american unmatched-steps))
+	(subtractions (chord::subtractions unmatched-steps)))
     (chord::inner-name-jazz tonic exception-part additions subtractions
-	     bass-and-inversion steps)))
+			    bass-and-inversion steps)))
 
-;; wip (set! chord::names-alist-jazz
-(define chord::names-alist-jazz
-      (append
-       `(
-        (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
 
-	;; some fixups -- jcn
-	; major seventh chord = triangle
-	(((0 . 0) (2 . 0) (4 . 0) (6 . 0))
-	 . ,(make-raise-markup 0.5 mathm-markup-object))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 
-	 ;; minor major seventh chord = m triangle
-	(((0 . 0) (2 . -1) (4 . 0) (6 . 0))
-	 . ,(make-line-markup
-	     (list
-	     (make-simple-markup "m")
-	     (make-raise-markup 0.5 mathm-markup-object))))
-	;; (((0 . 0) (2 . -1) (4 . 0) (6 . 0))
-	;; . (columns ("m") ((raise . 0.5)((font-family . math) "M"))))
-	
-	)
-      ;; '()))
-      chord::names-alist-american))
+(define-public (new-chord->markup func ly-pitches bass inversion exceptions)
+  "Entry point for New_chord_name_engraver. See chord-name.scm for the
+signature of FUNC.  LY-PITCHES, BASS and INVERSION are lily
+pitches. EXCEPTIONS is an alist (see scm file).
+ "
+  
+  (let* ((pitches (map c++-pitch->scm ly-pitches))
+	 (bass-and-inversion 
+	  (cons (c++-pitch->scm bass)
+		(c++-pitch->scm inversion)))
+	 (diff (pitch::diff '(0 0 0) (car pitches)))
+	 (steps (if (cdr pitches) (map (lambda (x)
+					 (pitch::transpose x diff))
+				       (cdr pitches))
+		    '()))
+	 (lookup (dbg (chord::exceptions-lookup exceptions steps)))
+	 (exception-part (dbg (car lookup)))
+	 (unmatched-steps (cadr lookup))
+	 (tonic (car pitches))	 
+	 )
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      (func tonic exception-part unmatched-steps bass-and-inversion steps)
+      ))
+    
+(define-public (chord->markup-jazz . args)
+  (apply new-chord->markup (cons chord::name-jazz args))
+  )
+
+(define-public (chord->markup-american . args)
+  (apply new-chord->markup (cons chord::name-american args))
+  )
 
+(define-public (chord->markup-banter . args)
+  (apply new-chord->markup (cons chord::name-banter args))
+  )
 
 (define-public (new-chord-name-brew-molecule grob)
   (let*
       (
-       (style-prop (ly:get-grob-property grob 'style))
-       (style (if (symbol? style-prop) style-prop  'banter))
-       (chord (ly:get-grob-property grob 'chord))
-       (chordf (ly:get-grob-property grob 'chord-name-function))
        (ws (ly:get-grob-property grob 'word-space))
-       (markup (chordf style chord))
+       (markup (ly:get-grob-property grob 'text))
        (molecule (interpret-markup grob
 				   (cons '((word-space . 0.0))
 					 (Font_interface::get_property_alist_chain grob))
 				   markup))
        )
 
-
-    ;;;  TODO: BUG : word-space is in local staff-space (?)
+    ;;
+    ;; chord names aren't in staffs, so WS is in global staff space.
     (if (number? ws)
-	(ly:combine-molecule-at-edge  molecule
+	(ly:combine-molecule-at-edge
+	 molecule
 	 X RIGHT (ly:make-molecule "" (cons 0 ws) '(-1 . 1) )
 	 0.0)
 	molecule)
-	))
+    ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (set-chord-name-style sym)
+  "Return music expressions that set the chord naming style. For
+inline use in .ly file"
+  
+  (define (chord-name-style-setter function exceptions)
+    (context-spec-music
+     (make-sequential-music 
+      (list (make-property-set 'chordNameFunction function)
+	    (make-property-set 'chordNameExceptions exceptions)))
+     "ChordNames"
+     )
+    )
+
+  (ly:export
+   (case sym
+     ((jazz)
+      (chord-name-style-setter chord->markup-jazz chord::names-alist-jazz))
+     ((banter)
+      (chord-name-style-setter chord->markup-banter chord::names-alist-banter))
+     ((american)
+      (chord-name-style-setter chord->markup-american chord::names-alist-american))
+     )))
+
 
diff --git a/scm/grob-description.scm b/scm/grob-description.scm
index e208d4eb9d..3fad39566d 100644
--- a/scm/grob-description.scm
+++ b/scm/grob-description.scm
@@ -246,7 +246,7 @@
      . (
 	(molecule-callback . ,new-chord-name-brew-molecule)
 	(after-line-breaking-callback . ,Chord_name::after_line_breaking)
-	(chord-name-function . ,chord->markup)
+	(word-space . 1.0)
 	(font-family . roman)
 	(meta . ((interfaces . (font-interface text-interface chord-name-interface item-interface ))))
 	))
diff --git a/scm/grob-property-description.scm b/scm/grob-property-description.scm
index e2d176375f..f7034298fd 100644
--- a/scm/grob-property-description.scm
+++ b/scm/grob-property-description.scm
@@ -605,7 +605,6 @@ functions set spanner positions.")
 (grob-property-description 'delta-pitch number? "DOCME")
 (grob-property-description 'head-width number? "DOCME")
 (grob-property-description 'primitive number? "DOCME")
-(grob-property-description 'chord-name-function procedure? "DOCME")
 (grob-property-description 'minimum-beam-collision-distance number?
 "Minimum distance to beam for a rest collision.")
 
diff --git a/scm/translator-property-description.scm b/scm/translator-property-description.scm
index a560876d72..861fe5917e 100644
--- a/scm/translator-property-description.scm
+++ b/scm/translator-property-description.scm
@@ -165,6 +165,12 @@ part-combining.  Usually unset or zero when combining threads into one
 voice, and 1 (or the duration of one measure) when combining voices
 into one staff.")
 
+(translator-property-description
+ 'chordNameFunction procedure?
+ "The function that converts lists of pitches to chord names.")
+(translator-property-description
+ 'chordNameExceptions list?
+ "Alist of chord exceptions. Contains (CHORD . MARKUP) entries.")
 (translator-property-description 'chordChanges boolean? "Only show changes in chords scheme?")
 (translator-property-description 'clefGlyph string? "Name of the symbol within the music font")
 (translator-property-description 'clefOctavation integer? "Add