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