Eskil

# Window structure browser
#-----------------------------------------------------------------------------
proc ::_Debug::WindowBrowser {} {
    set top .windowbrowser
    destroy $top
    ttk::toplevel $top -padx 3 -pady 3
    wm title $top "Window Browser"
    wm protocol $top WM_DELETE_WINDOW [list ::_Debug::WindowBrowserClosed $top]

    ttk::panedwindow $top.pw -orient horizontal
    pack $top.pw -fill both -expand 1
    
    # Widget Tree
    ttk::frame $top.ftree
    set tree $top.ftree.tree
    ttk::treeview $tree -height 20 -selectmode browse -show "tree" \
            -yscrollcommand "$top.ftree.sby set"
    ttk::scrollbar $top.ftree.sby -orient vertical -command "$tree yview"
    $tree column "#0" -minwidth 50 -width 200

    pack $top.ftree.sby -side right -fill y -pady 3 -padx {0 3}
    pack $tree -fill both -expand 1 -pady 3 -padx {3 0}

    # Info Text
    text $top.t -width 80 -wrap word

    set ::_Debug::WindowBrowser(treeW) $tree
    set ::_Debug::WindowBrowser(textW) $top.t
    bind $tree <<TreeviewSelect>> ::_Debug::WindowBrowserSelected

    $top.pw add $top.ftree -weight 1


    $top.pw add $top.t    -weight 2

    set ::_Debug::WindowBrowser(deselect) ""
    PopulateWindowBrowser $tree
}

proc ::_Debug::WindowBrowserClosed {top} {
    destroy $top
    if {$::_Debug::WindowBrowser(deselect) ne ""} {
        {*}$::_Debug::WindowBrowser(deselect)
        set ::_Debug::WindowBrowser(deselect) ""
    }
}

# An item was selected. Show info
proc ::_Debug::WindowBrowserSelected {} {
    $::_Debug::WindowBrowser(textW) delete 1.0 end
    if {$::_Debug::WindowBrowser(deselect) ne ""} {
        #puts "DESEL: $::_Debug::WindowBrowser(deselect)"

    } on error {err info} {
        #puts "In $interp"
        #puts "$err"
        #puts "$info"
    }
    #puts "MOO $w"
}

# Format configure data from a widget for display
proc ::_Debug::FormatConfigure {configData} {
    set first ""
    set last ""
    foreach param $configData {
        lassign $param flag _ _ def value
        if {$value ne $def} {
            # List changed values first
            append first "[list $flag $value] "
        } else {
            append last "[list $flag $value] "
        }
    }
    set first [string trim $first]
    set last  [string trim $last]

    if {$first ne ""} {
        set first "Changed Parameters:\n$first\n"
    }

    if {$last ne ""} {
        append first "Default Parameters:\n" $last
    }
    return [string trim $first]
}

# Populate
proc ::_Debug::PopulateWindowBrowser {tree} {
    $tree delete [$tree children {}]
    set todo [list . {}]
    # Outer loop for subinterps TBD
    while {[llength $todo] > 0} {
        set containers {}
        while {[llength $todo] > 0} {
            # POP

                    set parentId ""
                } else {
                    set parentId $id($interp$parent)
                }
            }

            set class [{*}$i winfo class $w]
            # Info to be displayed
            set out "$w  ($class)\n"
            set configData [{*}$i $w configure]
            append out [FormatConfigure $configData]
            foreach param $configData {
                lassign $param flag _ _ def value





                if {$flag eq "-container" && $value == 1} {
                    lappend containers $w $interp
                }
            }
            # Add grid info, if any


            try {
                set ix [{*}$i grid info $w]
                if {$ix ne ""} {
                    append out "\n\ngrid\n$ix"
                }
            } on error {} {}
            # Add pack info, if any
            try {
                set ix [{*}$i pack info $w]
                if {$ix ne ""} {
                    append out "\n\npack\n$ix"
                }
            } on error {} {}
            # Add menu info, if menu
            try {
                set last [{*}$i $w index end]
                for {set ix 0} {$ix <= $last} {incr ix} {
                    set configData [{*}$i $w entryconfigure $ix]
                    append out \n\n [FormatConfigure $configData]
                }
            } trap {TCL LOOKUP INDEX} {} {
                # Non-menu widgets will normally error out on not having the
                # "index" subcommand, which ends up here. Ignore.
            } on error {msg erri} {
                # Give some hint on other errors
                #puts "MOOO $msg\n$erri"
            }
            
            set name $w
            regexp {\.[^.]+$} $w name

            set open 1
            if {[string match "*#*" $w]} {
                set open 0
            }