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