Initial revision

diff --git a/menus_list.tcl b/menus_list.tcl
new file mode 100644 (file)
index 0000000..6ebf071
--- /dev/null
+++ b/menus_list.tcl
@@ -0,0 +1,33 @@
+#
+# $Id$
+#
+
+widget menus_list {
+    object_include tkinspect_list
+    param title "Menus"
+    method get_item_name {} { return menu }
+    method update {target} {
+       $self clear
+       foreach w [$slot(main) windows_info get_windows] {
+           if {[$slot(main) windows_info get_class $target $w] == "Menu"} {
+               $self append $w
+           }
+       }
+    }
+    method retrieve {target menu} {
+       set end [send $target $menu index end]
+       if {$end == "none"} { set end 0 } else { incr end }
+       set result "# menu $menu has $end entries\n"
+       for {set i 0} {$i < $end} {incr i} {
+           append result "$menu entryconfigure $i"
+           foreach spec [send $target [list $menu entryconfig $i]] {
+               append result " \\\n\t[lindex $spec 0] [list [lindex $spec 4]]"
+           }
+           append result "\n"
+       }
+       return $result
+    }
+    method send_filter {value} {
+       return $value
+    }
+}

diff --git a/windows_info.tcl b/windows_info.tcl
new file mode 100644 (file)
index 0000000..be0c399
--- /dev/null
+++ b/windows_info.tcl
@@ -0,0 +1,43 @@
+#
+# $Id$
+#
+# Maintains the list of windows, and caches window class information.
+# (the list is shared between windows_list and menus_list.)
+#
+
+object_class windows_info {
+    member windows {}
+    method clear {} {
+       foreach w $slot(windows) {
+           unset slot($w.class)
+       }
+       set slot(windows) {}
+    }
+    method get_windows {} { return $slot(windows) }
+    method append_windows {target result_var parent} {
+       upvar $result_var result
+       foreach w [send $target winfo children $parent] {
+           lappend slot(windows) $w
+           $self append_windows $target result $w
+       }
+    }
+    method update {target} {
+       $self clear
+       set slot(windows) [send $target winfo children .]
+       feedback .feedback -title "Getting Windows" \
+           -steps [llength $slot(windows)]
+       .feedback grab
+       foreach w $slot(windows) {
+           $self append_windows $target windows $w
+           .feedback step
+           update idletasks
+       }
+       destroy .feedback
+    }
+    method get_class {target w} {
+       if ![info exists slot($w.class)] {
+           set slot($w.class) [send $target [list winfo class $w]]
+       }
+       return $slot($w.class)
+    }
+}