From: Joe Neeman <joeneeman@gmail.com>
Date: Sun, 19 Nov 2006 08:04:02 +0000 (+0200)
Subject: improvements to graphing support
X-Git-Tag: release/2.11.16-1^2~17
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=7ba007f37cd2187f60ff7419ee34897ea4651239;p=lilypond.git

improvements to graphing support
(cherry picked from 9dd7454e8ea0bfe855b838dee0fcaf4348b475cc commit)
---

diff --git a/lily/main.cc b/lily/main.cc
index 728cd89508..68fc2a03cb 100644
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -649,3 +649,25 @@ main (int argc, char **argv)
   /* Only reachable if GUILE exits.  That is an error.  */
   return 1;
 }
+
+SCM atexit_list = SCM_EOL;
+
+LY_DEFINE (ly_atexit, "ly:atexit",
+	   2, 0, 0, (SCM proc, SCM args),
+	   "Just before exiting, call the procedure given. "
+"If this is called multiple times, the procedures are called "
+"in LIFO order.")
+{
+  atexit_list = scm_cons (scm_cons (proc, args), atexit_list);
+  scm_gc_protect_object (atexit_list);
+  return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_do_atexit, "ly:do-atexit",
+	   0, 0, 0, (),
+	   "Call the atexit procedures.")
+{
+  for (SCM s = atexit_list; scm_is_pair (s); s = scm_cdr (s))
+    scm_apply_0 (scm_caar (s), scm_cdar (s));
+  return SCM_UNSPECIFIED;
+}
diff --git a/scm/graphviz.scm b/scm/graphviz.scm
new file mode 100644
index 0000000000..d3a858fcef
--- /dev/null
+++ b/scm/graphviz.scm
@@ -0,0 +1,35 @@
+(define-module (scm graphviz)
+  #:use-module (lily)
+  #:export (make-graph add-node add-edge))
+
+(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))
+(define (nodes g) (vector-ref g 1))
+(define (edges g) (vector-ref g 2))
+(define (clusters g) (vector-ref g 3))
+
+(define (add-node graph label)
+  (let ((ns (nodes graph)))
+    (vector-set! graph 1 (cons `(,(length ns) . ,label) ns))
+    (length ns)))
+
+(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))
+	(es (edges graph))
+	(cc (clusters graph)))
+    (ly:message (format "writing graph ~s..." (filename graph)))
+    (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)
+    (map (lambda (e) (display (format "~a -> ~a\n" (car e) (cdr e)) out))
+	 es)
+    (display "}" out)))
+  
\ No newline at end of file
diff --git a/scm/lily.scm b/scm/lily.scm
index e71d400859..a016901bcb 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -525,6 +525,7 @@ The syntax is the same as `define*-public'."
 	  (ly:error (_ "failed files: ~S") (string-join failed))
 	  (exit 1))
 	(begin
+	  (ly:do-atexit)
 	  ;; HACK: be sure to exit with single newline
 	  (ly:message "")
 	  (exit 0)))))