Posted to tcl by auriocus at Tue May 16 06:56:19 GMT 2017view raw
- # print the window name under the mouse cursor
- proc pickwin {} {
- after 1000 {
- set pickwidget [winfo containing {*}[winfo pointerxy .]]
- if { $pickwidget != {} } {
- puts $pickwidget
- foreach option [$pickwidget configure] {
- # leave out synonym options
- if { [llength $option] != 5 } { continue }
- lassign $option name dbname dbclass defvalue currentvalue
- if { $defvalue != $currentvalue } { puts " $name $currentvalue" }
- }
- } else { puts "No widget under cursor." }
- }
- }