Allows for framing comments in LilyPond backends. (issue 5450086)

[mtsolo]

Reviewers: ,

Message:
Hey all,

I'm working on a piece w/ scripted SVG, and this'll make it easier for
me to parse the file in Python and move things around.  Try it with:

\relative c' {
  \override NoteHead #'framing-comments =
  #'("NoteHead coming up." . "NoteHead finished.")
  \repeat unfold 16 { f }
}

Then use the svg or ps backend and look for these comments.

Cheers,
MS

Description:
Allows for framing comments in LilyPond backends.

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

Affected files:
  M lily/grob.cc
  M lily/stencil-interpret.cc
  M scm/define-grob-properties.scm
  M scm/framework-svg.scm
  M scm/output-ps.scm
  M scm/output-svg.scm


Index: lily/grob.cc
diff --git a/lily/grob.cc b/lily/grob.cc
index  
567bd0015f4309d8c77f75933347b7d082d11d05..b4c7b0c9a65cd20343a9b41d044ed0dd04c131a4  
100644
--- a/lily/grob.cc
+++ b/lily/grob.cc
@@ -170,6 +170,17 @@ Grob::get_print_stencil () const
             = *unsmob_stencil (scm_call_1 (ly_lily_module_constant  
("stencil-whiteout"),
                                            retval.smobbed_copy ()));
         }
+
+      SCM framing_comments = get_property ("framing-comments");
+      if (scm_is_pair (framing_comments))
+        {
+          SCM expr = scm_list_3 (ly_symbol2scm ("framing-comments"),
+                                 framing_comments,
+                                 retval.expr ());
+
+          retval = Stencil (retval.extent_box (), expr);
+        }
+
     }

   return retval;
@@ -779,6 +790,7 @@ ADD_INTERFACE (Grob,
                "avoid-slur "
                "axis-group-parent-X "
                "axis-group-parent-Y "
+               "framing-comments "
                "before-line-breaking "
                "cause "
                "color "
Index: lily/stencil-interpret.cc
diff --git a/lily/stencil-interpret.cc b/lily/stencil-interpret.cc
index  
e85ad90f43a2904374d7d9c402890036c24b4611..b8754b814a2dadc903fdae21969e30c149d17a91  
100644
--- a/lily/stencil-interpret.cc
+++ b/lily/stencil-interpret.cc
@@ -74,6 +74,18 @@ interpret_stencil_expression (SCM expr,

           return;
         }
+      else if (head == ly_symbol2scm ("framing-comments"))
+        {
+          SCM framing_comments = scm_cadr (expr);
+          string head_comment = ly_scm2string (scm_car (framing_comments));
+          string tail_comment = ly_scm2string (scm_cdr (framing_comments));
+
+          (*func) (func_arg, scm_list_2 (ly_symbol2scm ("comment"),  
ly_string2scm (head_comment)));
+          interpret_stencil_expression (scm_caddr (expr), func, func_arg,  
o);
+          (*func) (func_arg, scm_list_2 (ly_symbol2scm ("comment"),  
ly_string2scm (tail_comment)));
+
+          return;
+        }
       else if (head == ly_symbol2scm ("rotate-stencil"))
         {
           SCM args = scm_cadr (expr);
Index: scm/define-grob-properties.scm
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index  
c26bd3cae19a503c10ee9e3eb7c586e8498adc9a..7114f9e253da3e643f207ff76201a4d31c56414a  
100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -306,6 +306,8 @@ note.  This is used by  
@rinternals{note-collision-interface}.")
 various ligature engravers.")
      (fraction ,fraction? "Numerator and denominator of a time
 signature object.")
+     (framing-comments ,pair? "A pair of comments to go around the
+stencilfied of a grob in a given backend.")
      (french-beaming ,boolean? "Use French beaming style for this
 stem.  The stem stops at the innermost beams.")
      (fret-diagram-details ,list? "An alist of detailed grob
Index: scm/framework-svg.scm
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index  
ad707a7b894f924bf42198fe222345b16761ec14..678ac7a385c7e44737c3dec006088f91f2abc59b  
100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -113,6 +113,11 @@ src: url('~a');
    (ec 'style)
    (ec 'defs)))

+;; code dup from output-svg.scm, but necessary because comment
+;; is a stencil and cannot use define-public
+(define (comment s)
+  (string-append "<!--" s "-->\n"))
+
 (define (dump-page paper filename page page-number page-count)
   (let* ((outputter (ly:make-paper-outputter (open-file  
filename "wb") 'svg))
         (dump (lambda (str) (display str (ly:outputter-port outputter))))
@@ -132,7 +137,7 @@ src: url('~a');
        (module-remove! (ly:outputter-module outputter) 'paper))
     (if (ly:get-option 'svg-woff)
        (dump (woff-header paper (dirname filename))))
-    (dump (comment (format #f "Page: ~S/~S" page-number page-count)))
+    (dump (comment (format #f " Page: ~S/~S " page-number page-count)))
     (ly:outputter-output-scheme outputter
                                `(begin (set! lily-unit-length ,unit-length)
                                        ""))
Index: scm/output-ps.scm
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index  
3e376bbe672186e6f3bf35b69d59a3607d3d0f42..6cf9f8a9e5980b430ea00d4c5bb40aed46c1bddf  
100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -77,6 +77,9 @@
      "false")
    radius thick))

+(define (comment s)
+  (string-append "%" s "\n"))
+
 (define (dashed-line thick on off dx dy phase)
   (ly:format "~4f ~4f ~4f [ ~4f ~4f ] ~4f draw_dashed_line"
    dx
@@ -248,6 +251,12 @@
 ;; restore color from stack
 (define (resetcolor) "grestore\n")

+;; open a node
+(define (open-node n) n)
+
+;; close a node
+(define (close-node n) n)
+
 ;; rotation around given point
 (define (setrotation ang x y)
   (ly:format "gsave ~4l translate ~a rotate ~4l translate\n"
Index: scm/output-svg.scm
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index  
d993c356358c94fa21fe70f57c09e28cce49687b..6df9bc8b68df9673fc2c13813bdd516f2169e0e4  
100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -70,8 +70,8 @@
   "c = close"
   (format #f "</~S>\n" entity))

-(define-public (comment s)
-  (string-append "<!-- " s " -->\n"))
+(define (comment s)
+  (string-append "<!--" s "-->\n"))

 (define-public (entity entity string . attributes-alist)
   (if (equal? string "")
@@ -300,7 +300,7 @@
         (char-lookup (format #f "&#~S;" charcode))
         (glyph-by-name (eoc 'altglyph `(glyphname . ,expr)))
         (apparently-broken
-         (comment "FIXME: how to select glyph by name, altglyph is broken?"))
+         (comment " FIXME: how to select glyph by name, altglyph is broken? "))
         (text (string-regexp-substitute "\n" ""
                (string-append glyph-by-name apparently-broken char-lookup))))
   (define alist '())
@@ -469,7 +469,7 @@
             (char-lookup (format #f "&#~S;" charcode))
             (glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
             (apparently-broken
-	      (comment "XFIXME: how to select glyph by name, altglyph is  
broken?")))
+	      (comment " XFIXME: how to select glyph by name, altglyph is  
broken? ")))
        ;; what is W?
        (ly:format
         "<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"