Generate Graphvix DOT Files from Gnocl Widget Heirarchies

The innards of complex GUI layouts are often difficult to understand. The newly added gnocl::widgetTree will generate a txt visualization of the GUI layout. These text files can then be converted to Graphvix .DOT files from which a png image be generated.  

 

# tree_to_dot.tcl 
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

#REF: tree_to_graphviz_custom_out.tcl
# Description: Converts GTK tree to DOT with stacked labels and a custom -o output option.

proc parse_tree_to_dot {input_text} {
    set lines [split [string trim $input_text] "\n"]
    set dot_output "digraph GTK_Tree \{\n"
    append dot_output "    node \[shape=box, fontname=\"Helvetica\", fontsize=10, style=\"rounded,filled\", fillcolor=\"white\"\];\n"
    append dot_output "    rankdir=LR;\n"

    array set last_node_at_level {}
    set node_counter 0

    foreach line $lines {
        if {![regexp -indices {[\w\(]} $line match]} continue
        set start_idx [lindex $match 0]
        
        set full_label [string trim [string range $line $start_idx end]]
        
        # Regex to separate Class and Name/ID for stacked labeling
        if {[regexp {^([^\s\(]+)\s*(.*)$} $full_label -> class extra]} {
            set display_label [expr {$extra ne "" ? "$class\n$extra" : $class}]
        } else {
            set display_label $full_label
        }

        set safe_label [string map {\" {\"}} $display_label]
        set current_id "node_[incr node_counter]"
        append dot_output "    $current_id \[label=\"$safe_label\"\];\n"

        set current_depth $start_idx
        set parent_id ""
        set levels [lsort -integer -decreasing [array names last_node_at_level]]
        
        foreach lvl $levels {
            if {$lvl < $current_depth} {
                set parent_id $last_node_at_level($lvl)
                break
            }
        }

        if {$parent_id ne ""} {
            append dot_output "    $parent_id -> $current_id;\n"
        }

        set last_node_at_level($current_depth) $current_id
        foreach lvl [array names last_node_at_level] {
            if {$lvl > $current_depth} { unset last_node_at_level($lvl) }
        }
    }
    append dot_output "\}"
    return $dot_output
}

# --- COMMAND LINE PROCESSING ---

set infile ""
set outfile "output.dot"

for {set i 0} {$i < [llength $argv]} {incr i} {
    set arg [lindex $argv $i]
    switch -exact -- $arg {
        "-o" {
            incr i
            set outfile [lindex $argv $i]
        }
        default {
            set infile $arg
        }
    }
}

# --- FINALIZATION & PREVIEW ---

if {$infile ne "" && [file exists $infile]} {
    set fp [open $infile r]
    set input_data [read $fp]
    close $fp
    
    set result [parse_tree_to_dot $input_data]
    
    set out_fp [open $outfile w]
    puts -nonewline $out_fp $result
    close $out_fp
    
    puts "Source: $infile"
    puts "Result: $outfile"
} else {
    puts "Usage: ./script.tcl <input_file> \[-o output_file\]"
}