Fossil SCM
Extended the dot graph exporter to allow the export of a subgraph specified through a set of nodes. Default is the export of the whole graph, as before.
Commit
86f3319041f2b26b6121b35001cb4bb7bdf3e1e2
Parent
64d0019e0fdc297…
1 file changed
+35
-25
+35
-25
| --- tools/cvs2fossil/lib/dot.tcl | ||
| +++ tools/cvs2fossil/lib/dot.tcl | ||
| @@ -25,43 +25,36 @@ | ||
| 25 | 25 | |
| 26 | 26 | snit::type ::vc::tools::dot { |
| 27 | 27 | # # ## ### ##### ######## ############# |
| 28 | 28 | ## Public API, Methods |
| 29 | 29 | |
| 30 | - typemethod format {g name} { | |
| 30 | + typemethod format {g name {subgraph {}}} { | |
| 31 | 31 | lappend lines "digraph \"$name\" \{" |
| 32 | 32 | |
| 33 | - foreach n [$g nodes] { | |
| 34 | - set cmd "\"$n\"" | |
| 35 | - set sep " " | |
| 36 | - set head " \[" | |
| 37 | - set tail "" | |
| 38 | - foreach {gattr nodekey} { | |
| 39 | - label label | |
| 40 | - shape shape | |
| 41 | - } { | |
| 42 | - if {![$g node keyexists $n $nodekey]} continue | |
| 43 | - append cmd "$head$sep${gattr}=\"[$g node get $n $nodekey]\"" | |
| 44 | - | |
| 45 | - set sep ", " | |
| 46 | - set head "" | |
| 47 | - set tail " \]" | |
| 48 | - } | |
| 49 | - | |
| 50 | - append cmd ${tail} ";" | |
| 51 | - lappend lines $cmd | |
| 52 | - } | |
| 53 | - foreach a [$g arcs] { | |
| 54 | - lappend lines "\"[$g arc source $a]\" -> \"[$g arc target $a]\";" | |
| 33 | + if {![llength $subgraph]} { | |
| 34 | + set nodes [$g nodes] | |
| 35 | + set arcs [$g arcs] | |
| 36 | + } else { | |
| 37 | + set nodes $subgraph | |
| 38 | + set arcs [eval [linsert $subgraph 0 $g arcs -inner]] | |
| 39 | + } | |
| 40 | + | |
| 41 | + foreach n $nodes { | |
| 42 | + set style [Style $g node $n {label label shape shape}] | |
| 43 | + lappend lines "\"$n\" ${style};" | |
| 44 | + } | |
| 45 | + foreach a $arcs { | |
| 46 | + set style [Style $g arc $a {color color}] | |
| 47 | + lappend lines "\"[$g arc source $a]\" -> \"[$g arc target $a]\" ${style};" | |
| 55 | 48 | } |
| 56 | 49 | |
| 57 | 50 | lappend lines "\}" |
| 58 | 51 | return [join $lines \n] |
| 59 | 52 | } |
| 60 | 53 | |
| 61 | - typemethod write {g name file} { | |
| 62 | - fileutil::writeFile $file [$type format $g $name] | |
| 54 | + typemethod write {g name file {subgraph {}}} { | |
| 55 | + fileutil::writeFile $file [$type format $g $name $subgraph] | |
| 63 | 56 | return |
| 64 | 57 | } |
| 65 | 58 | |
| 66 | 59 | typemethod layout {format g name file} { |
| 67 | 60 | set f [fileutil::tempfile c2fdot_] |
| @@ -71,10 +64,27 @@ | ||
| 71 | 64 | return |
| 72 | 65 | } |
| 73 | 66 | |
| 74 | 67 | # # ## ### ##### ######## ############# |
| 75 | 68 | ## Internal, state |
| 69 | + | |
| 70 | + proc Style {graph x y dict} { | |
| 71 | + set sep " " | |
| 72 | + set head " \[" | |
| 73 | + set tail "" | |
| 74 | + set style "" | |
| 75 | + foreach {gattr key} $dict { | |
| 76 | + if {![$graph $x keyexists $y $key]} continue | |
| 77 | + append style "$head$sep${gattr}=\"[$graph $x get $y $key]\"" | |
| 78 | + set sep ", " | |
| 79 | + set head "" | |
| 80 | + set tail " \]" | |
| 81 | + } | |
| 82 | + | |
| 83 | + append style ${tail} | |
| 84 | + return $style | |
| 85 | + } | |
| 76 | 86 | |
| 77 | 87 | # # ## ### ##### ######## ############# |
| 78 | 88 | ## Internal, helper methods (formatting, dispatch) |
| 79 | 89 | |
| 80 | 90 | # # ## ### ##### ######## ############# |
| 81 | 91 |
| --- tools/cvs2fossil/lib/dot.tcl | |
| +++ tools/cvs2fossil/lib/dot.tcl | |
| @@ -25,43 +25,36 @@ | |
| 25 | |
| 26 | snit::type ::vc::tools::dot { |
| 27 | # # ## ### ##### ######## ############# |
| 28 | ## Public API, Methods |
| 29 | |
| 30 | typemethod format {g name} { |
| 31 | lappend lines "digraph \"$name\" \{" |
| 32 | |
| 33 | foreach n [$g nodes] { |
| 34 | set cmd "\"$n\"" |
| 35 | set sep " " |
| 36 | set head " \[" |
| 37 | set tail "" |
| 38 | foreach {gattr nodekey} { |
| 39 | label label |
| 40 | shape shape |
| 41 | } { |
| 42 | if {![$g node keyexists $n $nodekey]} continue |
| 43 | append cmd "$head$sep${gattr}=\"[$g node get $n $nodekey]\"" |
| 44 | |
| 45 | set sep ", " |
| 46 | set head "" |
| 47 | set tail " \]" |
| 48 | } |
| 49 | |
| 50 | append cmd ${tail} ";" |
| 51 | lappend lines $cmd |
| 52 | } |
| 53 | foreach a [$g arcs] { |
| 54 | lappend lines "\"[$g arc source $a]\" -> \"[$g arc target $a]\";" |
| 55 | } |
| 56 | |
| 57 | lappend lines "\}" |
| 58 | return [join $lines \n] |
| 59 | } |
| 60 | |
| 61 | typemethod write {g name file} { |
| 62 | fileutil::writeFile $file [$type format $g $name] |
| 63 | return |
| 64 | } |
| 65 | |
| 66 | typemethod layout {format g name file} { |
| 67 | set f [fileutil::tempfile c2fdot_] |
| @@ -71,10 +64,27 @@ | |
| 71 | return |
| 72 | } |
| 73 | |
| 74 | # # ## ### ##### ######## ############# |
| 75 | ## Internal, state |
| 76 | |
| 77 | # # ## ### ##### ######## ############# |
| 78 | ## Internal, helper methods (formatting, dispatch) |
| 79 | |
| 80 | # # ## ### ##### ######## ############# |
| 81 |
| --- tools/cvs2fossil/lib/dot.tcl | |
| +++ tools/cvs2fossil/lib/dot.tcl | |
| @@ -25,43 +25,36 @@ | |
| 25 | |
| 26 | snit::type ::vc::tools::dot { |
| 27 | # # ## ### ##### ######## ############# |
| 28 | ## Public API, Methods |
| 29 | |
| 30 | typemethod format {g name {subgraph {}}} { |
| 31 | lappend lines "digraph \"$name\" \{" |
| 32 | |
| 33 | if {![llength $subgraph]} { |
| 34 | set nodes [$g nodes] |
| 35 | set arcs [$g arcs] |
| 36 | } else { |
| 37 | set nodes $subgraph |
| 38 | set arcs [eval [linsert $subgraph 0 $g arcs -inner]] |
| 39 | } |
| 40 | |
| 41 | foreach n $nodes { |
| 42 | set style [Style $g node $n {label label shape shape}] |
| 43 | lappend lines "\"$n\" ${style};" |
| 44 | } |
| 45 | foreach a $arcs { |
| 46 | set style [Style $g arc $a {color color}] |
| 47 | lappend lines "\"[$g arc source $a]\" -> \"[$g arc target $a]\" ${style};" |
| 48 | } |
| 49 | |
| 50 | lappend lines "\}" |
| 51 | return [join $lines \n] |
| 52 | } |
| 53 | |
| 54 | typemethod write {g name file {subgraph {}}} { |
| 55 | fileutil::writeFile $file [$type format $g $name $subgraph] |
| 56 | return |
| 57 | } |
| 58 | |
| 59 | typemethod layout {format g name file} { |
| 60 | set f [fileutil::tempfile c2fdot_] |
| @@ -71,10 +64,27 @@ | |
| 64 | return |
| 65 | } |
| 66 | |
| 67 | # # ## ### ##### ######## ############# |
| 68 | ## Internal, state |
| 69 | |
| 70 | proc Style {graph x y dict} { |
| 71 | set sep " " |
| 72 | set head " \[" |
| 73 | set tail "" |
| 74 | set style "" |
| 75 | foreach {gattr key} $dict { |
| 76 | if {![$graph $x keyexists $y $key]} continue |
| 77 | append style "$head$sep${gattr}=\"[$graph $x get $y $key]\"" |
| 78 | set sep ", " |
| 79 | set head "" |
| 80 | set tail " \]" |
| 81 | } |
| 82 | |
| 83 | append style ${tail} |
| 84 | return $style |
| 85 | } |
| 86 | |
| 87 | # # ## ### ##### ######## ############# |
| 88 | ## Internal, helper methods (formatting, dispatch) |
| 89 | |
| 90 | # # ## ### ##### ######## ############# |
| 91 |