New hooks for graphing.

diff --git a/lily/grob-property.cc b/lily/grob-property.cc
index 1473157209dc7be9c9139e6f1a923ffd5f42e508..f89d42194d04324ac4a636838552fd6af66f04d8 100644 (file)
--- a/lily/grob-property.cc
+++ b/lily/grob-property.cc
@@ -22,6 +22,7 @@
 
 #ifndef NDEBUG
 static SCM modification_callback = SCM_EOL;
+static SCM cache_callback = SCM_EOL;
 
 LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback",
           1, 0, 0, (SCM cb),
@@ -40,6 +41,22 @@ LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback
   return SCM_UNSPECIFIED;
 }
 
+LY_DEFINE (ly_set_property_cache_callback, "ly:set-property-cache-callback",
+          1, 0, 0, (SCM cb),
+          "Specify a procedure that will be called whenever lilypond calculates "
+          "a callback function and caches the result. The callback will "
+          "receive as arguments "
+          "the grob whose property it is, "
+          "the name of the property, "
+          "the name of the callback that calculated the property and "
+          "the new (cached) value of the property.")
+{
+  LY_ASSERT_TYPE (ly_is_procedure, cb, 1);
+  
+  cache_callback = cb;
+  return SCM_UNSPECIFIED;
+}
+
 void
 Grob::instrumented_set_property (SCM sym, SCM v,
                                 char const *file,
@@ -195,7 +212,18 @@ Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
        *alist = scm_assq_remove_x (*alist, marker);
     }
   else
-    internal_set_value_on_alist (alist, sym, value);
+    {
+#ifndef NDEBUG
+      if (ly_is_procedure (cache_callback))
+       scm_apply_0 (cache_callback,
+                    scm_list_n (self_scm (),
+                                sym,
+                                proc,
+                                value,
+                                SCM_UNDEFINED));
+#endif
+      internal_set_value_on_alist (alist, sym, value);
+    }
   
   return value;
 }

diff --git a/ly/graphviz.ly b/ly/graphviz.ly
index 097805337f18b42a38ee016b431cfd3619b59ce9..71956d7b02602fe056e301288f81ac29698ec790 100644 (file)
--- a/ly/graphviz.ly
+++ b/ly/graphviz.ly
@@ -16,6 +16,9 @@
 #(define file-line-whitelist
   '())
 
+#(define (blacklist-symbol sym)
+  (set! sym-blacklist (cons sym sym-blacklist)))
+
 #(define (whitelist-symbol sym)
   (set! sym-whitelist (cons sym sym-whitelist)))
 
@@ -37,21 +40,33 @@
      (not (memq prop sym-blacklist))
      (not (member file-line file-line-blacklist))))))
 
+#(define (grob-event-node grob label cluster)
+  (let ((node-id (add-node graph label cluster))
+       (prev (assv grob last-grob-action)))
+   (if (pair? prev)
+       (add-edge graph (cdr prev) node-id))
+   (set! last-grob-action (assv-set! last-grob-action grob node-id))))
+
+#(define (truncate-value val)
+  (let ((val-str (format "~a" val)))
+   (string-take val-str (min 50 (string-length val-str)))))
+
 #(define (grob-mod grob file line func prop val)
-  (let* ((prev (assv grob last-grob-action))
-         (val-str0 (format "~a" val))
-         (val-str (string-take val-str0 (min 50 (string-length val-str0))))
+  (let* ((val-str (truncate-value val))
         (label (format "~a\\n~a:~a\\n~a <- ~a" grob file line prop val-str)))
    (if (relevant? grob file line prop)
-    (let ((node-id (add-node graph label file)))
-     (if (pair? prev)
-      (add-edge graph (cdr prev) node-id))
-     (set! last-grob-action (assv-set! last-grob-action grob node-id))))))
+       (grob-event-node grob label file))))
+
+#(define (grob-cache grob prop callback value)
+  (let* ((val-str (truncate-value value))
+        (label (format "caching ~a.~a\\n~a -> ~a" grob prop callback value)))
+   (if (relevant? grob #f #f prop)
+       (grob-event-node grob label #f))))
 
 #(define (grob-create grob file line func)
-  (let* ((label (format "~a\\n~a:~a" grob file line))
-        (node-id (add-node graph label file)))
-   (set! last-grob-action (assv-set! last-grob-action grob node-id))))
+  (let ((label (format "~a\\n~a:~a" grob file line)))
+   (grob-event-node grob label file)))
 
 #(ly:set-grob-modification-callback grob-mod)
+#(ly:set-property-cache-callback grob-cache)
 %#(ly:set-grob-creation-callback grob-create)