* lily/line-spanner.cc (line_molecule): bugfix for trill style.

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

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index ea336010aa8c07c27da4d6dce9e2e9611c706965..790f20c88209b5b6ebcf6a52d78f955e9985fa08 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -4,7 +4,8 @@
 ;;; source file of the GNU LilyPond music typesetter
 ;;; 
 ;;; (c)  2000--2003 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Han-Wen Nienhuys
+;;;
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 (define (natural-chord-alteration p)
   "Return the natural alteration for step P."
@@ -77,58 +78,49 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 
-(define-public (sequential-music-to-chord-exceptions seq)
-  "Transform sequential music of <<a b c>>-\markup{ foobar } type to
- (cons ABC-PITCHES FOOBAR-MARKUP)
- "
-  
-  (define (is-req-chord? m)
-    (and
-     (memq 'event-chord (ly:get-mus-property m 'types))
-     (not (equal? (ly:make-moment 0 1) (ly:get-music-length m)))
-    ))
+;; fixme we should standardize on omit-root (or the other one.)
+;; perhaps the  default should also be reversed --hwn
+(define-public (sequential-music-to-chord-exceptions seq . rest)
+  "Transform sequential music SEQ of type <<c d e>>-\markup{ foobar }
+to (cons CDE-PITCHES FOOBAR-MARKUP), or to (cons DE-PITCHES
+FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
+"
 
   (define (chord-to-exception-entry m)
-    (let*
-       (
-        (elts   (ly:get-mus-property m 'elements))
-        (pitches (map
-                  (lambda (x)
-                    (ly:get-mus-property x 'pitch)
-                    )
-                  (filter-list
-                   (lambda (y) (memq 'note-event (ly:get-mus-property y 'types)))
-                   elts)))
-        (sorted  (sort pitches ly:pitch<? ))
-        (root (car sorted))
-        (non-root (map (lambda (x) (ly:pitch-diff x root)) (cdr sorted)))
-        (texts (map
-                (lambda (x)
-                  (ly:get-mus-property x 'text)
-                  )
-                
-                (filter-list
-                 (lambda (y)
-                   (memq 'text-script-event
-                         (ly:get-mus-property y 'types))) elts)
-                ))
-        (text (if (null? texts)
-                  #f
-                  (car texts)))
-
-        )
-      (cons non-root text)
-    ))
-
-  (let*
-    (
-     (elts (filter-list is-req-chord? (ly:get-mus-property seq 'elements)))
-     (alist (map chord-to-exception-entry elts))
-     )
-    (filter-list (lambda (x) (cdr x)) alist)
-  ))
+    (let* ((elts (ly:get-mus-property m 'elements))
+          (omit-root (and (pair? rest) (car rest)))
+          (pitches (map (lambda (x) (ly:get-mus-property x 'pitch))
+                        (filter-list
+                         (lambda (y) (memq 'note-event
+                                           (ly:get-mus-property y 'types)))
+                         elts)))
+          (sorted (sort pitches ly:pitch<?))
+          (root (car sorted))
+          
+          ;; ugh?
+          ;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
+          ;; FIXME.  This results in #<Pitch c> ...,
+          ;; but that is what we need because default octave for
+          ;; \chords has changed to c' too?
+          (diff (ly:pitch-diff root (ly:make-pitch 0 0 0)))
+          (normalized (map (lambda (x) (ly:pitch-diff x diff)) sorted))
+          (texts (map (lambda (x) (ly:get-mus-property x 'text))
+                      (filter-list
+                       (lambda (y) (memq 'text-script-event
+                                         (ly:get-mus-property y 'types)))
+                       elts)))
+
+          (text (if (null? texts) #f (if omit-root (car texts) texts))))
+      (cons (if omit-root (cdr normalized) normalized) text)))
 
+  (define (is-req-chord? m)
+    (and
+     (memq 'event-chord (ly:get-mus-property m 'types))
+     (not (equal? (ly:make-moment 0 1) (ly:get-music-length m)))))
 
+  (let* ((elts (filter-list is-req-chord? (ly:get-mus-property seq 'elements)))
+        (alist (map chord-to-exception-entry elts)))
+    (filter-list (lambda (x) (cdr x)) alist)))
 
 
 (define-public (new-chord-name-brew-molecule grob)
@@ -152,55 +144,3 @@
        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
-     ((ignatzek)
-      (chord-name-style-setter ignatzek-chord-names
-                              '()))
-     ((banter)
-      (chord-name-style-setter double-plus-new-chord->markup-banter
-       chord::exception-alist-banter))
-     
-     ((jazz)
-      (chord-name-style-setter double-plus-new-chord->markup-jazz
-       chord::exception-alist-jazz))
-     )))
-
-;; can't put this in double-plus-new-chord-name.scm, because we can't
-;; ly:load that very easily.
-(define-public (set-double-plus-new-chord-name-style style options)
-  "Return music expressions that set the chord naming style. For
-inline use in .ly file"
-  
-  (define (chord-name-style-setter function)
-    (context-spec-music
-     (make-sequential-music 
-      (list (make-property-set 'chordNameFunction function)
-
-           ;; urg , misuse of chordNameExceptions function.
-           (make-property-set 'chordNameExceptions options)))
-     "ChordNames"))
-
-  (ly:export
-   (case style
-     ((banter)
-      (chord-name-style-setter double-plus-new-chord->markup-banter))
-     
-     ((jazz)
-      (chord-name-style-setter double-plus-new-chord->markup-jazz)))))
-