From a982b5419c9be31b649ce847ca6fcf60a0823883 Mon Sep 17 00:00:00 2001
From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Thu, 29 Mar 2007 16:23:18 -0300
Subject: [PATCH] clean up graphviz for inclusion in regtest.

---
 input/regression/graphviz.ly         | 27 +++++++++++++++++++++++++++
 lily/grob-property.cc                | 16 ++++++++++------
 ly/{graphviz.ly => graphviz-init.ly} |  2 +-
 scm/graphviz.scm                     | 20 +++++++++++---------
 4 files changed, 49 insertions(+), 16 deletions(-)
 create mode 100644 input/regression/graphviz.ly
 rename ly/{graphviz.ly => graphviz-init.ly} (96%)

diff --git a/input/regression/graphviz.ly b/input/regression/graphviz.ly
new file mode 100644
index 0000000000..1e00e99581
--- /dev/null
+++ b/input/regression/graphviz.ly
@@ -0,0 +1,27 @@
+\header {
+  texidoc = "The graphviz feature draws dependency graphs for grob properties."
+
+  }
+
+\version "2.11.21"
+\include "graphviz-init.ly"
+
+#(whitelist-grob 'NoteHead)
+#(whitelist-grob 'Stem)
+#(whitelist-grob "NoteHead")
+#(whitelist-grob "Stem")
+
+#(map whitelist-symbol '(stencil style duration-log
+			 stem-attachment end-position staff-position
+			 glyph-name direction))
+
+
+\book { \score {
+  c'4
+} }
+
+
+#(graph-write graph (current-error-port))
+#(ly:set-grob-modification-callback #f)
+#(ly:set-property-cache-callback #f)
+
diff --git a/lily/grob-property.cc b/lily/grob-property.cc
index 4034eb8297..e4dad5f235 100644
--- a/lily/grob-property.cc
+++ b/lily/grob-property.cc
@@ -38,6 +38,13 @@ print_property_callback_stack ()
 static SCM modification_callback = SCM_EOL;
 static SCM cache_callback = SCM_EOL;
 
+
+/*
+
+FIXME: this should use ly:set-option interface instead.
+
+*/
+
 LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback",
 	   1, 0, 0, (SCM cb),
 	   "Specify a procedure that will be called every time lilypond modifies "
@@ -49,9 +56,7 @@ LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback
 	   "the property to be changed and "
 	   "the new value for the property.")
 {
-  LY_ASSERT_TYPE (ly_is_procedure, cb, 1);
-
-  modification_callback = cb;
+  modification_callback =  (ly_is_procedure (cb)) ? cb : SCM_BOOL_F;
   return SCM_UNSPECIFIED;
 }
 
@@ -65,13 +70,12 @@ LY_DEFINE (ly_set_property_cache_callback, "ly:set-property-cache-callback",
 	   "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;
+  cache_callback =  (ly_is_procedure (cb)) ? cb : SCM_BOOL_F;
   return SCM_UNSPECIFIED;
 }
 #endif
 
+
 void
 Grob::instrumented_set_property (SCM sym, SCM v,
 				 char const *file,
diff --git a/ly/graphviz.ly b/ly/graphviz-init.ly
similarity index 96%
rename from ly/graphviz.ly
rename to ly/graphviz-init.ly
index aafd30d72d..3623d0ace8 100644
--- a/ly/graphviz.ly
+++ b/ly/graphviz-init.ly
@@ -22,7 +22,7 @@
 #(define (whitelist-grob str)
   (set! grob-whitelist (cons str grob-whitelist)))
 
-#(define graph (make-graph "graph.dot"))
+#(define graph (make-graph (format "~a.dot" (ly:parser-output-name parser))))
 
 #(define (grob-name g)
   (let* ((meta (ly:grob-property g 'meta))
diff --git a/scm/graphviz.scm b/scm/graphviz.scm
index 8ad3600ffa..f5db38b7a8 100644
--- a/scm/graphviz.scm
+++ b/scm/graphviz.scm
@@ -7,14 +7,17 @@
 
 (define-module (scm graphviz)
   #:use-module (lily)
-  #:export (make-graph add-node add-edge add-cluster))
+  #:export
+  (make-graph add-node add-edge add-cluster
+	      graph-write
+	      ))
 
 (define (make-graph filename)
-  (let ((empty-graph (list->vector (list filename '() '() '()))))
-    (ly:atexit write-graph (list empty-graph))
-    empty-graph))
+   #(() () () ()))
 
-(define (filename g) (vector-ref g 0))
+
+;; fixme: use structs/records.
+;; fixme add & use setters.
 (define (nodes g) (vector-ref g 1))
 (define (edges g) (vector-ref g 2))
 (define (clusters g) (vector-ref g 3))
@@ -41,12 +44,11 @@
 (define (add-edge graph node1 node2)
   (vector-set! graph 2 (cons `(,node1 . ,node2) (edges graph))))
 
-(define (write-graph graph)
-  (let ((out (open-file (filename graph) "w"))
-	(ns (nodes graph))
+(define (graph-write graph out)
+  (let ((ns (nodes graph))
 	(es (edges graph))
 	(cs (clusters graph)))
-    (ly:message (format "writing graph ~s..." (filename graph)))
+    (ly:message (format (_ "Writing graph `~a'...") (port-filename out)))
     (display "digraph G {\nrankdir=\"LR\"\nnode [shape=rectangle]\n" out)
     (map (lambda (n) (display (format "~a [label=\"~a\"]\n" (car n) (cdr n)) out))
 	 ns)
-- 
2.39.5