b8c3542172 2007-11-22       aku: #!/bin/sh
b8c3542172 2007-11-22       aku: ## -*- tcl -*- \
b8c3542172 2007-11-22       aku: exec tclsh "$0" ${1+"$@"}
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # # ## ### ##### ######## ############# #####################
b8c3542172 2007-11-22       aku: ## Copyright (c) 2007 Andreas Kupries.
b8c3542172 2007-11-22       aku: #
b8c3542172 2007-11-22       aku: # This software is licensed as described in the file LICENSE, which
b8c3542172 2007-11-22       aku: # you should have received as part of this distribution.
b8c3542172 2007-11-22       aku: #
b8c3542172 2007-11-22       aku: # This software consists of voluntary contributions made by many
b8c3542172 2007-11-22       aku: # individuals.  For exact contribution history, see the revision
b8c3542172 2007-11-22       aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil
b8c3542172 2007-11-22       aku: # # ## ### ##### ######## ############# #####################
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: ## Command line application to extract the tree of symbols (tags and
b8c3542172 2007-11-22       aku: ## branches) from a state database and show it graphically. The code
b8c3542172 2007-11-22       aku: ## uses GraphViz's 'dot' to do the layouting and conversion into an
b8c3542172 2007-11-22       aku: ## image.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # # ## ### ##### ######## ############# #####################
b8c3542172 2007-11-22       aku: ## Requirements, extended package management for local packages.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: lappend auto_path [file join [file dirname [info script]] lib]
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: package require Tcl 8.4                               ; # Required runtime.
b8c3542172 2007-11-22       aku: package require struct::graph                         ; # Graph handling.
b8c3542172 2007-11-22       aku: package require struct::list                          ; # Higher order list ops.
b8c3542172 2007-11-22       aku: package require vc::fossil::import::cvs::state        ; # State storage.
b8c3542172 2007-11-22       aku: package require vc::tools::dot                        ; # Graph export to DOT.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: namespace import ::vc::fossil::import::cvs::state
b8c3542172 2007-11-22       aku: namespace import ::vc::tools::dot
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Process the command line. Get the database to access.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: state use [lindex $argv 0]
b8c3542172 2007-11-22       aku: state reading symbol
b8c3542172 2007-11-22       aku: state reading parent
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Get the data of all symbols in the state as a list for iteration,
b8c3542172 2007-11-22       aku: # and as array for random access of neighbouring symbols.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: foreach {sid name} [set symbols [state run { SELECT sid, name FROM symbol }]] {
b8c3542172 2007-11-22       aku:     set sym($sid) [list $name]
b8c3542172 2007-11-22       aku: }
b8c3542172 2007-11-22       aku: foreach {sid lod} [state run { SELECT sid, lod FROM tag }] {
b8c3542172 2007-11-22       aku:     lappend sym($sid) $lod $sym($lod) box Tag
b8c3542172 2007-11-22       aku: }
b8c3542172 2007-11-22       aku: foreach {sid lod} [state run { SELECT sid, lod FROM branch }] {
b8c3542172 2007-11-22       aku:     lappend sym($sid) $lod $sym($lod) diamond Branch
b8c3542172 2007-11-22       aku: }
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Start the graph
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: struct::graph dg
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Convert the symbols into nodes of the graph, and use node attributes
b8c3542172 2007-11-22       aku: # to highlight various pieces of interest for the dot conversion.
b8c3542172 2007-11-22       aku: # Label => Symbol name.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: foreach sid [array names sym] {
b8c3542172 2007-11-22       aku:     dg node insert $sid
b8c3542172 2007-11-22       aku:     struct::list assign $sym($sid) name lod lodname shape what
b8c3542172 2007-11-22       aku:     if {$shape eq ""} { set shape circle }
b8c3542172 2007-11-22       aku:     if {$what ne ""} { append what " " }
b8c3542172 2007-11-22       aku:     dg node set $sid label "$what$name"
b8c3542172 2007-11-22       aku:     dg node set $sid shape $shape
b8c3542172 2007-11-22       aku: }
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Go through the symbols a second time, now set up the arcs based on
b8c3542172 2007-11-22       aku: # their parent choices. Use arc attributes to highlight interesting
b8c3542172 2007-11-22       aku: # things (...).
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: foreach sid [array names sym] {
b8c3542172 2007-11-22       aku:     struct::list assign $sym($sid) name lod lodname shape
b8c3542172 2007-11-22       aku:     if {$lod eq ""} continue ; # Root has no parent.
b8c3542172 2007-11-22       aku:     dg arc insert $sid $lod
b8c3542172 2007-11-22       aku: }
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: # Convert the graph to dot, then run the layouter and convert to png,
b8c3542172 2007-11-22       aku: # at last show the image.
b8c3542172 2007-11-22       aku: 
b8c3542172 2007-11-22       aku: vc::tools::dot layout png dg SymbolTree st.png
b8c3542172 2007-11-22       aku: exec display st.png
b8c3542172 2007-11-22       aku: file delete st.png
b8c3542172 2007-11-22       aku: exit
b8c3542172 2007-11-22       aku: