Fossil SCM

fossil-scm / tools / cvs2fossil / symboltree

Source Blame History 88 lines

b8c3542…	aku	1	#!/bin/sh
b8c3542…	aku	2	## -- tcl -- \
b8c3542…	aku	3	exec tclsh "$0" ${1+"$@"}
b8c3542…	aku	4
b8c3542…	aku	5	# # ## ### ##### ######## ############# #####################
b8c3542…	aku	6	## Copyright (c) 2007 Andreas Kupries.
b8c3542…	aku	7	#
b8c3542…	aku	8	# This software is licensed as described in the file LICENSE, which
b8c3542…	aku	9	# you should have received as part of this distribution.
b8c3542…	aku	10	#
b8c3542…	aku	11	# This software consists of voluntary contributions made by many
b8c3542…	aku	12	# individuals. For exact contribution history, see the revision
b8c3542…	aku	13	# history and logs, available at http://fossil-scm.hwaci.com/fossil
b8c3542…	aku	14	# # ## ### ##### ######## ############# #####################
b8c3542…	aku	15
b8c3542…	aku	16	## Command line application to extract the tree of symbols (tags and
b8c3542…	aku	17	## branches) from a state database and show it graphically. The code
b8c3542…	aku	18	## uses GraphViz's 'dot' to do the layouting and conversion into an
b8c3542…	aku	19	## image.
b8c3542…	aku	20
b8c3542…	aku	21	# # ## ### ##### ######## ############# #####################
b8c3542…	aku	22	## Requirements, extended package management for local packages.
b8c3542…	aku	23
b8c3542…	aku	24	lappend auto_path [file join [file dirname [info script]] lib]
b8c3542…	aku	25
b8c3542…	aku	26	package require Tcl 8.4 ; # Required runtime.
b8c3542…	aku	27	package require struct::graph ; # Graph handling.
b8c3542…	aku	28	package require struct::list ; # Higher order list ops.
b8c3542…	aku	29	package require vc::fossil::import::cvs::state ; # State storage.
b8c3542…	aku	30	package require vc::tools::dot ; # Graph export to DOT.
b8c3542…	aku	31
b8c3542…	aku	32	namespace import ::vc::fossil::import::cvs::state
b8c3542…	aku	33	namespace import ::vc::tools::dot
b8c3542…	aku	34
b8c3542…	aku	35	# Process the command line. Get the database to access.
b8c3542…	aku	36
b8c3542…	aku	37	state use [lindex $argv 0]
b8c3542…	aku	38	state reading symbol
b8c3542…	aku	39	state reading parent
b8c3542…	aku	40
b8c3542…	aku	41	# Get the data of all symbols in the state as a list for iteration,
b8c3542…	aku	42	# and as array for random access of neighbouring symbols.
b8c3542…	aku	43
b8c3542…	aku	44	foreach {sid name} [set symbols [state run { SELECT sid, name FROM symbol }]] {
b8c3542…	aku	45	set sym($sid) [list $name]
b8c3542…	aku	46	}
b8c3542…	aku	47	foreach {sid lod} [state run { SELECT sid, lod FROM tag }] {
b8c3542…	aku	48	lappend sym($sid) $lod $sym($lod) box Tag
b8c3542…	aku	49	}
b8c3542…	aku	50	foreach {sid lod} [state run { SELECT sid, lod FROM branch }] {
b8c3542…	aku	51	lappend sym($sid) $lod $sym($lod) diamond Branch
b8c3542…	aku	52	}
b8c3542…	aku	53
b8c3542…	aku	54	# Start the graph
b8c3542…	aku	55
b8c3542…	aku	56	struct::graph dg
b8c3542…	aku	57
b8c3542…	aku	58	# Convert the symbols into nodes of the graph, and use node attributes
b8c3542…	aku	59	# to highlight various pieces of interest for the dot conversion.
b8c3542…	aku	60	# Label => Symbol name.
b8c3542…	aku	61
b8c3542…	aku	62	foreach sid [array names sym] {
b8c3542…	aku	63	dg node insert $sid
b8c3542…	aku	64	struct::list assign $sym($sid) name lod lodname shape what
b8c3542…	aku	65	if {$shape eq ""} { set shape circle }
b8c3542…	aku	66	if {$what ne ""} { append what " " }
b8c3542…	aku	67	dg node set $sid label "$what$name"
b8c3542…	aku	68	dg node set $sid shape $shape
b8c3542…	aku	69	}
b8c3542…	aku	70
b8c3542…	aku	71	# Go through the symbols a second time, now set up the arcs based on
b8c3542…	aku	72	# their parent choices. Use arc attributes to highlight interesting
b8c3542…	aku	73	# things (...).
b8c3542…	aku	74
b8c3542…	aku	75	foreach sid [array names sym] {
b8c3542…	aku	76	struct::list assign $sym($sid) name lod lodname shape
b8c3542…	aku	77	if {$lod eq ""} continue ; # Root has no parent.
b8c3542…	aku	78	dg arc insert $sid $lod
b8c3542…	aku	79	}
b8c3542…	aku	80
b8c3542…	aku	81	# Convert the graph to dot, then run the layouter and convert to png,
b8c3542…	aku	82	# at last show the image.
b8c3542…	aku	83
b8c3542…	aku	84	vc::tools::dot layout png dg SymbolTree st.png
b8c3542…	aku	85	exec display st.png
b8c3542…	aku	86	file delete st.png
b8c3542…	aku	87	exit
b8c3542…	aku	88

Fossil SCM

Keyboard Shortcuts