Eskil

Diff
Login
Annotate Patch Side-by-side Diff

Differences From Artifact [cac14001a6]:

To Artifact [c08720d0d9]:

︙
93
94
95
96
97
98
99

100




101
102
103
104
105
106
107
108
109
110

111
112
113
114
115
116
117

118
119
120

121
122
123









124
125
126
127
128
129
130

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

123



124
125
126

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142








+

+
+
+
+










+






-
+
-
-
-
+


-
+
+
+
+
+
+
+
+
+








# 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

    grid $top.ftree $top.t -sticky news
    $top.pw add $top.ftree -weight 1
    grid rowconfigure    $top 0 -weight 1
    grid columnconfigure $top 0 -weight 1
    grid columnconfigure $top 1 -weight 2
    $top.pw add $top.t    -weight 2

    set ::_Debug::WindowBrowser(deselect) ""
    PopWindowBrowser $tree
    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)"
︙
208
209
210
211
212
213
214
215


























216
217

218
219
220
221
222
223
224

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
262









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+








    } 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::PopWindowBrowser {tree} {
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
︙
242
243
244
245
246
247
248

249
250
251



252
253
254
255
256
257
258
259
260
261
262

263
264
265
266
267
268
269
270

271
272
273
274
275
276






277









278
279
280
281
282
283
284

280
281
282
283
284
285
286
287
288


289
290
291
292





293
294
295
296

297


298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332








+

-
-
+
+
+

-
-
-
-
-




-
+
-
-






+






+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+








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

            set class [{*}$i winfo class $w]
            # Info to be displayed
            set out "$w  ($class)\n"
            set delayed ""
            foreach param [{*}$i $w configure] {
            set configData [{*}$i $w configure]
            append out [FormatConfigure $configData]
            foreach param $configData {
                lassign $param flag _ _ def value
                if {$value ne $def} {
                    append out "[list $flag $value] "
                } else {
                    append delayed "[list $flag $value] "
                }
                if {$flag eq "-container" && $value == 1} {
                    lappend containers $w $interp
                }
            }
            if {$delayed ne ""} {
            # Add grid info, if any
                append out \n $delayed
            }
            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
            }
︙