X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fchord-name.scm;h=0542893cc02726e42a400f494d861d8dec90ce66;hb=6f6ea6500252a574985dd7550e7f01a84827cdd7;hp=06b11784596c609c5b95b64e37ac6afb7a14d01a;hpb=1c846b2c2348b4e0ca4a3c2e8fb267047ba2d203;p=lilypond.git

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 06b1178459..0542893cc0 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -60,7 +60,7 @@
 	))))
 
 (define-public (note-name->markup pitch lowercase?)
-  "Return pitch markup for PITCH."
+  "Return pitch markup for @var{pitch}."
   (make-line-markup
    (list
     (make-simple-markup
@@ -107,9 +107,10 @@
 	   (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a)))))))))
 
 (define-public ((chord-name->italian-markup re-with-eacute) pitch lowercase?)
-  "Return pitch markup for PITCH, using italian/french note names.
-   If re-with-eacute is set to #t, french 'ré' is returned for D instead of 're'
-"
+  "Return pitch markup for @var{pitch}, using Italian/@/French note names.
+If @var{re-with-eacute} is set to @code{#t}, french `ré' is returned for
+pitch@tie{}D instead of `re'."
+
   (let* ((name (ly:pitch-notename pitch))
          (alt (ly:pitch-alteration pitch)))
     (make-line-markup
@@ -169,3 +170,31 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
 	 (alist (map chord-to-exception-entry elts)))
     (filter (lambda (x) (cdr x)) alist)))
 
+(define-public (capo-handler pitches bass inversion context)
+  (let ((chord-function
+          (ly:context-property context 'chordNameFunction 'jazz-chord-names))
+        (capo-pitch (ly:context-property context 'capoPitch #f)))
+    (if (not capo-pitch)
+        (chord-function pitches bass inversion context)  ;; call the chordNameFunction as of old
+        (let* ((new-pitches   ;; else transpose the pitches and do the chord twice
+               (map (lambda (p)
+                       (ly:pitch-transpose p capo-pitch))
+                    pitches))
+               (new-bass
+                 (if (ly:pitch? bass)
+                     (ly:pitch-transpose bass capo-pitch)
+                     '()))
+               (new-inversion
+                 (if (ly:pitch? inversion)
+                     (ly:pitch-transpose inversion capo-pitch)
+                     '()))
+               (capo-markup
+                 (make-parenthesize-markup
+                   (chord-function new-pitches new-bass new-inversion context)))
+               (name-markup (chord-function pitches bass  inversion context))
+               (capo-vertical (ly:context-property context 'capoVertical #f)))
+          (if capo-vertical
+              (make-column-markup (list name-markup capo-markup))
+              (make-line-markup (list name-markup
+                                      (make-hspace-markup 1)
+                                      capo-markup)))))))