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\]"
}
