1 files changed, 108 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/dot.tcl b/tools/cvs2fossil/lib/dot.tcl
new file mode 100644
index 0000000..0081c08
--- /dev/null
+++ b/tools/cvs2fossil/lib/dot.tcl
@@ -0,0 +1,108 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007 Andreas Kupries.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals.  For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## Utility package, export graph data to dot format for formatting
+## with neato et. all
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4  ; # Required runtime
+package require snit     ; # OO system.
+package require fileutil ; # Helper commands.
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::tools::dot {
+    # # ## ### ##### ######## #############
+    ## Public API, Methods
+
+    typemethod format {g name {subgraph {}}} {
+	lappend lines "digraph \"$name\" \{"
+
+	if {![llength $subgraph]} {
+	    set nodes [$g nodes]
+	    set arcs  [$g arcs]
+	} else {
+	    set nodes $subgraph
+	    set arcs [eval [linsert $subgraph 0 $g arcs -inner]]
+	}
+
+	foreach n $nodes {
+	    set style [Style $g node $n {label label shape shape fontcolor fontcolor}]
+	    lappend lines "\"$n\" ${style};"
+	}
+	foreach a $arcs {
+	    set style [Style $g arc $a {color color}]
+	    lappend lines "\"[$g arc source $a]\" -> \"[$g arc target $a]\" ${style};"
+	}
+
+	lappend lines "\}"
+	return [join $lines \n]
+    }
+
+    typemethod write {g name file {subgraph {}}} {
+	fileutil::writeFile $file [$type format $g $name $subgraph]
+	return
+    }
+
+    typemethod layout {format g name file} {
+	set f [fileutil::tempfile c2fdot_]
+	$type write $g $name $f
+	exec dot -T $format -o $file $f
+	::file delete $f
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ## Internal, state
+
+    proc Style {graph x y dict} {
+	set sep " "
+	set head " \["
+	set tail ""
+	set style ""
+	foreach {gattr key} $dict {
+	    if {![$graph $x keyexists $y $key]} continue
+	    append style "$head$sep${gattr}=\"[$graph $x get $y $key]\""
+	    set sep ", "
+	    set head ""
+	    set tail " \]"
+	}
+
+	append style ${tail}
+	return $style
+    }
+
+    # # ## ### ##### ######## #############
+    ## Internal, helper methods (formatting, dispatch)
+
+    # # ## ### ##### ######## #############
+    ## Configuration
+
+    pragma -hasinstances   no ; # singleton
+    pragma -hastypeinfo    no ; # no introspection
+    pragma -hastypedestroy no ; # immortal
+
+    # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::tools {
+    namespace export dot
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+
+package provide vc::tools::dot 1.0
+return