Modify chord-name-engraver to call capo-handler (issue4800051)

[lemniskata . bernoullego]

Reviewers: carl.d.sorensen_gmail.com,

Description:
Modify chord-name-engraver to call capo-handler


Add capo properties to define-context-properties


Add capo-handler function for guitar chords

Please review this at http://codereview.appspot.com/4800051/

Affected files:
  M lily/chord-name-engraver.cc
  M scm/chord-name.scm
  M scm/define-context-properties.scm


Index: lily/chord-name-engraver.cc
diff --git a/lily/chord-name-engraver.cc b/lily/chord-name-engraver.cc
index  
d0ced5a395f836e99fe57970185e26793b52612f..2442cdbb95835a3f5ebb826b5507dcce5f2978d9  
100644
--- a/lily/chord-name-engraver.cc
+++ b/lily/chord-name-engraver.cc
@@ -124,8 +124,8 @@ Chord_name_engraver::process_music ()

       pitches = scm_sort_list (pitches, Pitch::less_p_proc);

-      SCM name_proc = get_property ("chordNameFunction");
-      markup = scm_call_4 (name_proc, pitches, bass, inversion,
+      SCM capo_proc = ly_lily_module_constant ("capo-handler");
+      markup = scm_call_4 (capo_proc, pitches, bass, inversion,
           context ()->self_scm ());
     }
   /*
Index: scm/chord-name.scm
diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index  
79b018992ac34650c879c3c16dfb45f29b914da5..6910044182d09673493b787d19c5125269f10a8e  
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))))))))
Index: scm/define-context-properties.scm
diff --git a/scm/define-context-properties.scm  
b/scm/define-context-properties.scm
index  
dab5211f14372444171626f23fb0ef3120175ee8..d17f72fa2c687b7dc5aff148e8d7c906a9b48c25  
100644
--- a/scm/define-context-properties.scm
+++ b/scm/define-context-properties.scm
@@ -135,6 +135,8 @@ that normally end on beats.")
      (beatStructure ,list? "List of @code{baseMoment}s that are combined
 to make beats.")

+     (capoPitch ,ly:pitch? "The pitch to transpose chords down by when  
using the capo.")
+     (capoVertical ,boolean? "Whether to display actual and transposed  
pitches above each other or not.")
      (chordChanges ,boolean? "Only show changes in chords scheme?")
      (chordNameExceptions ,list? "An alist of chord exceptions.
 Contains @code{(@var{chord} . @var{markup})} entries.")