From d07c49222e33f245f890b69c78b61738e53bb3aa Mon Sep 17 00:00:00 2001
From: sls <sls>
Date: Wed, 21 Jun 1995 09:36:00 +0000
Subject: [PATCH] Initial revision

---
 menus_list.tcl   | 33 +++++++++++++++++++++++++++++++++
 windows_info.tcl | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+)
 create mode 100644 menus_list.tcl
 create mode 100644 windows_info.tcl

diff --git a/menus_list.tcl b/menus_list.tcl
new file mode 100644
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
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)
+    }
+}
-- 
2.23.0