[PATCH 1/3] Add capo-handler function for guitar chords

[Wol <anthony@xxxxxxxxxxxxxxx>]

---
 scm/chord-name.scm |   24 ++++++++++++++++++++++++
 1 files changed, 24 insertions(+), 0 deletions(-)

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 79b0189..6910044 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -170,3 +170,27 @@ 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 #f))
+    (capo-pitch (ly:context-property context 'capoPitch #f))
+    (if  (not (capo-pitch))                 ;; if there's no capo pitch or no chord
+      (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
+            (and (ly:pitch? bass)
+              (ly:pitch-transpose bass capo-pitch)))
+          (new-inversion
+            (and (ly:pitch? inversion)
+              (ly:pitch-transpose inversion
+          capo-pitch)))
+
+          (capo-markup (make-parenthesize-markup (chord-function new-pitches new-bass new-inversion context)))
+          (markup (chord-function pitches bass  inversion context))
+
+          (capo-vertical (ly:context-property context 'capoVertical #f))
+          (if (capo-vertical)
+            (make-column-markup (list markup capo-markup))
+            (make-line-markup (list markup (make-hspace-markup 1) capo-markup))))))))
-- 
1.7.3.4


--------------070902060703040007030606
Content-Type: text/plain;
 name="0002-Add-capo-properties-to-define-context-properties.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename*0="0002-Add-capo-properties-to-define-context-properties.patch"