Artifact d011b07faecc7d1f73bd7e2ad424aec40f12aa36

File tools/cvs2fossil/lib/dot.tcl part of check-in [b679ca3356] - Code cleanup. Removed trailing whitespace across the board. by aku on 2007-11-25 07:54:09.

## -*- 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