blob: 0081c0822c1cca4d87c17fb49800ccc4e8d8df61 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
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
|
