--- /dev/null
+#
+# $Id$
+#
+# Handle the about box.
+#
+
+dialog about {
+ param obliqueFont -*-helvetica-medium-o-*-*-12-* Font
+ param font -*-helvetica-medium-r-*-*-12-* Font
+ param boldFont -*-helvetica-bold-r-*-*-18-* Font
+ method create {} {
+ global tkinspect tkinspect_library
+ wm withdraw $self
+ wm transient $self .
+ pack [frame $self.border -relief ridge -bd 4]
+ label $self.title -text "tkinspect" -font $slot(boldFont)
+ label $self.ver \
+ -text "Release $tkinspect(release) ($tkinspect(release_date))" \
+ -font $slot(font)
+ label $self.com -text "Send comments, suggestions, bugs to:" \
+ -font $slot(obliqueFont)
+ frame $self.mug -bd 4
+ label $self.mug.l -text "Sam Shen <slshen@lbl.gov>"
+ label $self.mug.bm -bitmap @$tkinspect_library/sls.xbm -bd 2 \
+ -relief sunken
+ pack $self.mug.l $self.mug.bm -in $self.mug \
+ -side left -fill both -expand yes
+ button $self.ok -text "Ok" -command "destroy $self"
+ pack $self.title $self.ver $self.com $self.mug \
+ -in $self.border -side top -fill x
+ pack $self.ok -in $self.border -side bottom -pady 5
+ bind $self <Return> "destroy $self"
+ }
+ method reconfig {} {
+ }
+ method run {} {
+ wm deiconify $self
+ focus $self
+ center_window $self
+ tkwait visibility $self
+ grab set $self
+ tkwait window $self
+ }
+}
--- /dev/null
+#
+# $Id$
+#
+
+proc tkinspect_default_options {} {
+ global tkinspect_default
+ option add *Scrollbar*width 12
+ option add *Label*padX 0
+ option add *Label*padY 0
+ option add *Label*borderWidth 0
+ option add *Frame.highlightThickness 0
+ option add *Frame.borderWidth 2
+ option add *Value*vname*font \
+ -adobe-courier-medium-r-*-*-*-130-*-*-*-*-iso8859-*
+ option add *Value*Text*font \
+ -adobe-courier-medium-r-*-*-*-130-*-*-*-*-iso8859-*
+ set tkinspect_default(lists) "procs_list globals_list windows_list"
+}
--- /dev/null
+#
+# $Id$
+#
+
+widget clickable_list {
+ param command {}
+ param title {}
+ param width 30
+ param height 12
+ param main
+ method create {} {
+ $self config -bd 2 -relief raised
+ pack [label $self.title -anchor w] -side top -fill x
+ scrollbar $self.sb -command "$self.list yview" -relief sunken -bd 1
+ listbox $self.list -relief sunken -exportselection 0 \
+ -yscroll "$self.sb set" -selectmode single
+ bind $self.list <1> "$self click %x %y; continue"
+ pack $self.sb -side right -fill y
+ pack $self.list -side right -fill both -expand yes
+ }
+ method reconfig {} {
+ $self.title config -text $slot(title)
+ $self.list config -width $slot(width) -height $slot(height)
+ }
+ method list args {
+ eval $self.list $args
+ }
+ method click {x y} {
+ if [string length $slot(command)] {
+ set item [$self.list get @$x,$y]
+ if [string length $item] {
+ uplevel #0 [concat $slot(command) $item]
+ }
+ }
+ }
+}
+
+widget procs_list {
+ object_include clickable_list
+ param title "Procs:"
+ method get_item_name {} { return proc }
+ method update {target} {
+ $self list delete 0 end
+ foreach proc [lsort [send $target info procs]] {
+ $self list insert end $proc
+ }
+ }
+ method retrieve {target proc} {
+ set result [list proc $proc]
+ set formals {}
+ foreach arg [send $target [list info args $proc]] {
+ if [send $target [list info default $proc $arg __tkinspect_default_arg__]] {
+ lappend formals [list $arg [send $target \
+ [list set __tkinspect_default_arg__]]]
+ } else {
+ lappend formals $arg
+ }
+ }
+ send $target catch {unset __tkinspect_default_arg__}
+ lappend result $formals
+ lappend result [send $target [list info body $proc]]
+ return $result
+ }
+ method send_filter {value} {
+ return $value
+ }
+}
+
+widget globals_list {
+ object_include clickable_list
+ param title "Globals:"
+ method get_item_name {} { return global }
+ method update {target} {
+ $self list delete 0 end
+ foreach var [lsort [send $target info globals]] {
+ $self list insert end $var
+ }
+ }
+ method retrieve {target var} {
+ if ![send $target [list array size $var]] {
+ return [list set $var [send $target [list set $var]]]
+ }
+ set result {}
+ foreach elt [lsort [send $target [list array names $var]]] {
+ append result [list set [set var]($elt) \
+ [send $target [list set [set var]($elt)]]]
+ append result "\n"
+ }
+ return $result
+ }
+ method send_filter {value} {
+ return $value
+ }
+}
+
+widget windows_list {
+ object_include clickable_list
+ param title "Windows:"
+ member mode {config}
+ method get_item_name {} { return window }
+ method get_windows {target result_var parent} {
+ upvar $result_var result
+ foreach w [send $target winfo children $parent] {
+ lappend result $w
+ $self get_windows $target result $w
+ }
+ }
+ method update {target} {
+ $self list delete 0 end
+ set windows {}
+ $self get_windows $target windows .
+ foreach w $windows {
+ $self list insert end $w
+ }
+ }
+ method set_mode {mode} {
+ set slot(mode) $mode
+ }
+ method retrieve {target window} {
+ $self retrieve_$slot(mode) $target $window
+ }
+ method retrieve_config {target window} {
+ set result "# window configuration of $window\n"
+ append result "$window config"
+ foreach spec [send $target [list $window config]] {
+ if {[llength $spec] == 2} continue
+ append result " \\\n\t[lindex $spec 0] [list [lindex $spec 4]]"
+ }
+ append result "\n"
+ set old_bg [send $target [list $window cget -background]]
+ send $target [list $window config -background #ff69b4]
+ send $target [list after 200 \
+ [list catch [list $window config -background $old_bg]]]
+ return $result
+ }
+ method retrieve_packing {target window} {
+ set result "# packing info for $window\n"
+ if [catch {send $target pack info $window} info] {
+ append result "# $info\n"
+ } else {
+ append result "pack $window $info\n"
+ }
+ return $result
+ }
+ method retrieve_slavepacking {target window} {
+ set result "# packing info for slaves of $window\n"
+ foreach slave [send $target pack slaves $window] {
+ append result "pack $window [send $target pack info $slave]\n"
+ }
+ return $result
+ }
+ method retrieve_bindings {target window} {
+ set result "# bindings of $window"
+ foreach sequence [send $target bind $window] {
+ append result "\nbind $window $sequence "
+ lappend result [send $target bind $window $sequence]
+ }
+ append result "\n"
+ return $result
+ }
+ method retrieve_classbindings {target window} {
+ set class [send $target winfo class $window]
+ set result "# class bindings for $window\n# class: $class"
+ foreach sequence [send $target bind $class] {
+ append result "\nbind $class $sequence "
+ lappend result [send $target bind $class $sequence]
+ }
+ append result "\n"
+ return $result
+ }
+ method send_filter {value} {
+ if [$slot(main) cget -filter_empty_window_configs] {
+ regsub -all {[ \t]*-[^ \t]+[ \t]+{}([ \t]*\\?\n?)?} $value {\1} \
+ value
+ }
+ if [$slot(main) cget -filter_window_class_config] {
+ regsub -all "(\n)\[ \t\]*-class\[ \t\]+\[^ \\\n\]*\n?" $value \
+ "\\1" value
+ }
+ return $value
+ }
+}
--- /dev/null
+#!@wish@ -f
+#
+# $Id$
+#
+
+set tkinspect(counter) -1
+set tkinspect(main_window_count) 0
+set tkinspect(release) 5
+set tkinspect(release_date) "Jan 30, 1995"
+
+wm withdraw .
+
+if [file exists @stl_library@/tclIndex] {
+ lappend auto_path @stl_library@
+} else {
+ lappend auto_path /usr/local/lib/stl
+ lappend auto_path /vol/pub/stl-0.2/lib/stl
+}
+
+if [file exists @tkinspect_library@/tclIndex] {
+ lappend auto_path [set tkinspect_library @tkinspect_library@]
+} else {
+ lappend auto_path [set tkinspect_library .]
+}
+
+
+proc tkinspect_exit {} {
+ destroy .
+ exit 0
+}
+
+proc tkinspect_widgets_init {} {
+ global tkinspect_library
+ foreach file {lists.tcl about.tcl value.tcl} {
+ source $tkinspect_library/$file
+ }
+}
+
+proc tkinspect_about {} {
+ catch {destroy .about}
+ about .about
+ .about run
+}
+
+dialog tkinspect_main {
+ member lists {}
+ member counter -1
+ member target
+ member window_info_type config
+ param filter_empty_window_configs 1
+ param get_window_info 1
+ param filter_window_class_config 1
+ method create {} {
+ global tkinspect_default
+ $self config -highlightthickness 0 -bd 2
+ pack [frame $self.menu -bd 2 -relief raised] -side top -fill x
+ menubutton $self.menu.file -menu $self.menu.file.m -text "File" \
+ -bd 0
+ pack $self.menu.file -side left
+ set m [menu $self.menu.file.m]
+ $m add cascade -label "Select Interpreter" \
+ -menu $self.menu.file.m.interps -command "$self fill_interp_menu"
+ $m add command -label "New Window" -command create_main_window
+ $m add command -label "Update Lists" -command "$self update_lists"
+ $m add separator
+ $m add command -label "Close Window" -command "$self close"
+ $m add command -label "Exit" -command tkinspect_exit
+ menu $self.menu.file.m.interps
+ menubutton $self.menu.options -menu $self.menu.options.m \
+ -text "Options" -bd 0
+ set m [menu $self.menu.options.m]
+ $m add radiobutton -variable [object_slotname window_info_type] \
+ -value config -label "Window Configuration" -underline 7 \
+ -command "$self change_window_info_type"
+ $m add radiobutton -variable [object_slotname window_info_type] \
+ -value packing -label "Window Packing" -underline 7 \
+ -command "$self change_window_info_type"
+ $m add radiobutton -variable [object_slotname window_info_type] \
+ -value slavepacking -label "Slave Window Packing" -underline 1 \
+ -command "$self change_window_info_type"
+ $m add radiobutton -variable [object_slotname window_info_type] \
+ -value bindings -label "Window Bindings" -underline 7 \
+ -command "$self change_window_info_type"
+ $m add radiobutton -variable [object_slotname window_info_type] \
+ -value classbindings -label "Window Class Bindings" -underline 8 \
+ -command "$self change_window_info_type"
+ $m add separator
+ $m add checkbutton \
+ -variable [object_slotname filter_empty_window_configs] \
+ -label "Filter Empty Window Options" -underline 0
+ $m add checkbutton \
+ -variable [object_slotname filter_window_class_config] \
+ -label "Filter Window -class Options" -underline 0
+ $m add checkbutton \
+ -variable [object_slotname get_window_info] \
+ -label "Get Window Information" -underline 0
+ pack $self.menu.options -side left
+ menubutton $self.menu.help -menu $self.menu.help.m -text "Help" \
+ -bd 0
+ pack $self.menu.help -side right
+ set m [menu $self.menu.help.m]
+ $m add command -label "About..." -command tkinspect_about
+ pack [frame $self.lists -bd 0] -side top -fill both -expand 1
+ set slot(lists) ""
+ set i -1
+ foreach list_class $tkinspect_default(lists) {
+ set list $self.lists.l[incr i]
+ $list_class $list -command "$self list_item_click $list" \
+ -main $self
+ lappend slot(lists) $list
+ pack $list -side left -fill y -expand 1
+ }
+ value $self.value -main $self
+ pack $self.value -side top -fill both -expand 1
+ pack [frame $self.status] -side top -fill x
+ label $self.status.l -bd 2 -relief sunken -anchor w
+ pack $self.status.l -side left -fill x -expand 1
+ wm iconname $self "Tkinspect"
+ wm title $self "Tkinspect:"
+ $self status "Ready."
+ }
+ method reconfig {} {
+ }
+ method close {} {
+ global tkinspect
+ after 0 destroy $self
+ if {[incr tkinspect(main_window_count) -1] == 0} tkinspect_exit
+ }
+ method set_target {target} {
+ set slot(target) $target
+ $self update_lists
+ $self status "Remote interpreter is \"$target\""
+ wm title $self "Tkinspect: $target"
+ }
+ method update_lists {} {
+ foreach list $slot(lists) {
+ $list update $slot(target)
+ }
+ }
+ method change_window_info_type {} {
+ foreach list $slot(lists) {
+ if {[$list cget -class] == "Windows_list"} {
+ $list set_mode $slot(window_info_type)
+ }
+ }
+ }
+ method list_item_click {list item} {
+ $self.value set_value "[$list get_item_name] $item" \
+ [$list retrieve $slot(target) $item]
+ $self.value set_send_filter [list $list send_filter]
+ }
+ method fill_interp_menu {} {
+ set m $self.menu.file.m.interps
+ catch {$m delete 0 last}
+ foreach interp [winfo interps] {
+ $m add command -label $interp \
+ -command [list $self set_target $interp]
+ }
+ }
+ method status {msg} {
+ $self.status.l config -text $msg
+ }
+ method target {} {
+ return $slot(target)
+ }
+}
+
+proc create_main_window {} {
+ global tkinspect
+ tkinspect_main .main[incr tkinspect(counter)]
+ incr tkinspect(main_window_count)
+}
+
+widgets_init
+tkinspect_widgets_init
+tkinspect_default_options
+if [file exists ~/.tkinspect_opts] {
+ source ~/.tkinspect_opts
+}
+create_main_window
--- /dev/null
+#
+# $Id$
+#
+
+widget value {
+ param width 80
+ param height 20
+ param main
+ method create {} {
+ $self config -bd 2 -relief raised -highlightthickness 0
+ pack [frame $self.title] -side top -fill x
+ pack [label $self.title.l -text "Value: "] -side left
+ label $self.title.vname -anchor w \
+ -textvariable [object_slotname value_name]
+ pack $self.title.vname -fill x
+ scrollbar $self.sb -relief sunken -bd 1 -command "$self.t yview"
+ text $self.t -yscroll "$self.sb set"
+ pack $self.sb -side right -fill y
+ pack $self.t -side right -fill both -expand 1
+ bind $self.t <Control-x><Control-s> "$self send_value"
+ }
+ method reconfig {} {
+ $self.t config -width $slot(width) -height $slot(height)
+ }
+ method set_value {name value} {
+ $self.t delete 1.0 end
+ $self.t insert 1.0 $value
+ set slot(value_name) $name
+ }
+ method set_send_filter {command} {
+ set slot(send_filter) $command
+ }
+ method send_value {} {
+ send [$slot(main) target] \
+ [eval $slot(send_filter) [list [$self.t get 1.0 end]]]
+ $slot(main) status "Value sent"
+ }
+}
projects / tkinspect / commitdiff