From b6bb535cc7165548f1f498866a64cd7e43fdb110 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Mon, 21 Oct 2002 22:43:14 +0000 Subject: [PATCH] Fix for bug #624268 - namespace qualify sent commands --- ChangeLog | 12 ++++++++++++ afters_list.tcl | 4 ++-- classes_list.tcl | 14 +++++++------- globals_list.tcl | 20 ++++++++++---------- images_list.tcl | 26 +++++++++++++------------- names.tcl | 15 ++++++++------- objects_list.tcl | 4 ++-- procs_list.tcl | 10 +++++----- tkinspect.tcl | 4 ++-- windows_list.tcl | 18 +++++++++--------- 10 files changed, 70 insertions(+), 57 deletions(-) diff --git a/ChangeLog b/ChangeLog index 03f00c0..deb365d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +Mon Oct 21 22:42:34 2002 Pat Thoyts + + * afters_list.tcl: + * classes_list.tcl: + * globals_list.tcl: + * images_list.tcl: + * names.tcl: + * objects_list.tcl: + * procs_list.tcl: + * windows_list.tcl: bug # 624268 - always namespace qualify commands + sent to the inspectee to avoid name clashes. + Wed Oct 09 01:27:43 2002 Pat Thoyts * tkinspect.tcl: diff --git a/afters_list.tcl b/afters_list.tcl index 12e7769..90eeba8 100644 --- a/afters_list.tcl +++ b/afters_list.tcl @@ -8,12 +8,12 @@ widget afters_list { method get_item_name {} { return after } method update {target} { $self clear - foreach after [lsort [send $target after info]] { + foreach after [lsort [send $target ::after info]] { $self append $after } } method retrieve {target after} { - set cmd [list after info $after] + set cmd [list ::after info $after] set retcode [catch [list send $target $cmd] msg] if {$retcode != 0} { set result "Error: $msg\n" diff --git a/classes_list.tcl b/classes_list.tcl index b43d9cb..070c3d7 100644 --- a/classes_list.tcl +++ b/classes_list.tcl @@ -22,10 +22,10 @@ widget class_list { method update {target} { $self clear # Need info on older itcl version to do this properly. - set cmd [list if {[info command itcl_info] != {}} {itcl_info classes}] + set cmd [list if {[::info command itcl_info] != {}} {::itcl_info classes}] set classes [lsort [send $target $cmd]] if {$classes != {}} { - set slot(itcl_version) [send $target package provide Itcl] + set slot(itcl_version) [send $target ::package provide Itcl] } foreach class $classes { $self append $class @@ -120,7 +120,7 @@ widget class_list { method retrieve_new {target class} { set res "itcl::class $class {\n" - set cmd [list namespace eval $class {info inherit}] + set cmd [list ::namespace eval $class {info inherit}] set inh [send $target $cmd] if {$inh != ""} { append res " inherit $inh\n\n" @@ -128,10 +128,10 @@ widget class_list { append res "\n" } - set vars [send $target namespace eval $class {info variable}] + set vars [send $target ::namespace eval $class {info variable}] foreach var $vars { set name [namespace tail $var] - set cmd [list namespace eval $class \ + set cmd [list ::namespace eval $class \ [list info variable $name -protection -type -name -init]] set text [send $target $cmd] append res " $text\n" @@ -139,12 +139,12 @@ widget class_list { append res "\n" - set funcs [send $target [list namespace eval $class {info function}]] + set funcs [send $target [list ::namespace eval $class {info function}]] foreach func [lsort $funcs] { set qualclass "::[string trimleft $class :]" if {[string first $qualclass $func] == 0} { set name [namespace tail $func] - set cmd [list namespace eval $class [list info function $name]] + set cmd [list ::namespace eval $class [list info function $name]] set text [send $target $cmd] if {![string match "@itcl-builtin*" [lindex $text 4]]} { diff --git a/globals_list.tcl b/globals_list.tcl index a8b1c5d..c44e3d0 100644 --- a/globals_list.tcl +++ b/globals_list.tcl @@ -31,7 +31,7 @@ dialog variable_trace { pack $self.sb -side right -fill y pack $self.t -side right -fill both -expand 1 set where [set ::[subst $slot(main)](target,self)] - if {![send $slot(target) array exists $slot(variable)]} { + if {![send $slot(target) ::array exists $slot(variable)]} { set slot(trace_cmd) "send $where $self update_scalar" $self update_scalar "" "" w set slot(is_array) 0 @@ -43,7 +43,7 @@ dialog variable_trace { } $self check_remote_send send $slot(target) \ - [list trace variable $slot(variable) wu $slot(trace_cmd)] + [list ::trace variable $slot(variable) wu $slot(trace_cmd)] wm title $self "$title: $slot(target)/$slot(variable)" wm iconname $self "$title: $slot(target)/$slot(variable)" } @@ -52,14 +52,14 @@ dialog variable_trace { } method destroy {} { send $slot(target) \ - [list trace vdelete $slot(variable) wu $slot(trace_cmd)] + [list ::trace vdelete $slot(variable) wu $slot(trace_cmd)] } method update_scalar {args} { set op [lindex $args end] if {$op == "w"} { $self.t insert end-1c \ [list set $slot(variable) \ - [send $slot(target) [list set $slot(variable)]]] + [send $slot(target) [list ::set $slot(variable)]]] } else { $self.t insert end-1c [list unset $slot(variable)] } @@ -78,7 +78,7 @@ dialog variable_trace { if {$op == "w"} { $self.t insert end-1c \ [list set [set slot(variable)]([set n2]) \ - [send $slot(target) [list set [set slot(variable)]([set n2])]]] + [send $slot(target) [list ::set [set slot(variable)]([set n2])]]] } elseif {[info exists n2]} { $self.t insert end-1c [list unset [set slot(variable)]([set n2])] } else { @@ -107,7 +107,7 @@ dialog variable_trace { method check_remote_send {} { # ensure that the current target has a valid send command # This is commonly not the case under Windows. - set cmd [send $slot(target) [list info commands ::send]] + set cmd [send $slot(target) [list ::info commands ::send]] set type [set ::[subst $slot(main)](target,type)] # If we called in using 'comm' then even if we do have a built @@ -133,7 +133,7 @@ dialog variable_trace { switch -exact -- $type { winsend { set script { - proc ::send {app args} { + ::proc ::send {app args} { eval winsend send [list $app] $args } } @@ -141,7 +141,7 @@ dialog variable_trace { } dde { set script { - proc send {app args} { + ::proc ::send {app args} { eval dde eval [list $app] $args } } @@ -190,13 +190,13 @@ widget globals_list { } } set result {} - set names [lsort [send $target [list array names $var]]] + set names [lsort [send $target [list ::array names $var]]] if {[llength $names] == 0} { append result "array set $var {}\n" } else { foreach elt $names { append result [list set [set var]($elt) \ - [send $target [list set [set var]($elt)]]] + [send $target [list ::set [set var]($elt)]]] append result "\n" } } diff --git a/images_list.tcl b/images_list.tcl index 08161cc..e818a16 100644 --- a/images_list.tcl +++ b/images_list.tcl @@ -20,14 +20,14 @@ widget images_list { } method update {target} { $self clear - set cmd [list if {[info command image] != {}} {image names}] + set cmd [list if {[::info command image] != {}} {::image names}] foreach image [lsort [send $target $cmd]] { $self append $image } } method retrieve {target image} { set result "# image configuration for [list $image]\n" - append result "# ([send $target image width $image]x[send $target image height $image] [send $target image type $image] image)\n" + append result "# ([send $target ::image width $image]x[send $target ::image height $image] [send $target ::image type $image] image)\n" append result "$image config" foreach spec [send $target [list $image config]] { if {[llength $spec] == 2} continue @@ -45,20 +45,20 @@ widget images_list { tkinspect_failure \ "No image has been selected. Please select one first." } - if ![send $target info exists __tkinspect_image_counter__] { - send $target set __tkinspect_image_counter__ 0 + if ![send $target ::info exists __tkinspect_image_counter__] { + send $target ::set __tkinspect_image_counter__ 0 } - while {[send $target winfo exists .tkinspect_image\$__tkinspect_image_counter__]} { - send $target incr __tkinspect_image_counter__ + while {[send $target ::winfo exists .tkinspect_image\$__tkinspect_image_counter__]} { + send $target ::incr __tkinspect_image_counter__ } - set w .tkinspect_image[send $target set __tkinspect_image_counter__] - send $target [subst { - toplevel $w - button $w.close -text "Close $slot(current_item)" \ + set w .tkinspect_image[send $target ::set __tkinspect_image_counter__] + send $target [::subst { + ::toplevel $w + ::button $w.close -text "Close $slot(current_item)" \ -command "destroy $w" - label $w.img -image $slot(current_item) - pack $w.close $w.img -side top - wm title $w "tkinspect $slot(current_item)" + ::label $w.img -image $slot(current_item) + ::pack $w.close $w.img -side top + ::wm title $w "tkinspect $slot(current_item)" }] } } diff --git a/names.tcl b/names.tcl index 05c7aae..369e769 100644 --- a/names.tcl +++ b/names.tcl @@ -13,7 +13,7 @@ namespace eval names { proc names {target {name ::}} { set result $name - foreach n [send $target namespace children $name] { + foreach n [send $target ::namespace children $name] { append result " " [names $target $n] } return $result @@ -25,7 +25,7 @@ namespace eval names { } set result {} foreach n $names { - foreach p [send $target namespace eval $n ::info procs] { + foreach p [send $target ::namespace eval $n ::info procs] { lappend result "$n\::$p" } } @@ -39,13 +39,14 @@ namespace eval names { set defaultvar "__tkinspect:default_arg__" foreach arg $args { if [send $target [list ::info default $proc $arg $defaultvar]] { - lappend result [list $arg [send $target [list set $defaultvar]]] + lappend result [list $arg [send $target \ + [list ::set $defaultvar]]] } else { lappend result $arg } } - send $target catch unset $defaultvar + send $target ::catch ::unset $defaultvar return [list proc [namespace tail $proc] $result {} ] } @@ -65,10 +66,10 @@ namespace eval names { proc value {target var} { set tail [namespace tail $var] - if {[send $target [list array exists $var]]} { + if {[send $target [list ::array exists $var]]} { return "variable $tail ; # $var is an array\n" ; # dump it out? } - set cmd [list set $var] + set cmd [list ::set $var] set retcode [catch [list send $target $cmd] msg] if {$retcode != 0} { return "variable $tail ; # $var not defined\n" @@ -78,7 +79,7 @@ namespace eval names { } proc exports {target namespace} { - set result [send $target namespace eval $namespace ::namespace export] + set result [send $target ::namespace eval $namespace ::namespace export] return [unqualify $result] } diff --git a/objects_list.tcl b/objects_list.tcl index 0c9ae24..230ec35 100644 --- a/objects_list.tcl +++ b/objects_list.tcl @@ -21,10 +21,10 @@ widget object_list { method update {target} { $self clear - set cmd [list if {[info command itcl_info] != {}} {itcl_info objects}] + set cmd [list if {[::info command itcl_info] != {}} {itcl_info objects}] set objects [lsort [send $target $cmd]] if {$objects != {}} { - set slot(itcl_version) [send $target package provide Itcl] + set slot(itcl_version) [send $target ::package provide Itcl] } foreach object $objects { $self append $object diff --git a/procs_list.tcl b/procs_list.tcl index 76bdf13..18ee077 100644 --- a/procs_list.tcl +++ b/procs_list.tcl @@ -15,17 +15,17 @@ widget procs_list { 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__]] { + 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__]]] + [list ::set __tkinspect_default_arg__]]] } else { lappend formals $arg } } - send $target catch {unset __tkinspect_default_arg__} + send $target ::catch {::unset __tkinspect_default_arg__} lappend result $formals - lappend result [send $target [list info body $proc]] + lappend result [send $target [list ::info body $proc]] return $result } method send_filter {value} { diff --git a/tkinspect.tcl b/tkinspect.tcl index 51af45b..09a2dea 100644 --- a/tkinspect.tcl +++ b/tkinspect.tcl @@ -240,7 +240,7 @@ dialog tkinspect_main { foreach cmdline $slot(cmdlines) { $cmdline set_target $target } - set name [file tail [send $target set argv0]] + set name [file tail [send $target ::set argv0]] $self status "Remote interpreter is \"$target\" ($name)" wm title $self "$tkinspect(title): $target ($name)" } @@ -306,7 +306,7 @@ dialog tkinspect_main { if [string match [comm::comm self] $interp] { set label "$interp (self)" } else { - set label "$interp ([file tail [send $interp set argv0]])" + set label "$interp ([file tail [send $interp ::set argv0]])" } $m add command -label $label \ -command [list $self set_target $interp comm] diff --git a/windows_list.tcl b/windows_list.tcl index ef8bd28..a7e7cb5 100644 --- a/windows_list.tcl +++ b/windows_list.tcl @@ -102,7 +102,7 @@ widget windows_list { } method retrieve_packing {target window} { set result "# packing info for [list $window]\n" - if [catch {send $target [list pack info $window]} info] { + if [catch {send $target [list ::pack info $window]} info] { append result "# $info\n" } else { $self format_packing_info result $window $info @@ -111,7 +111,7 @@ widget windows_list { } method retrieve_slavepacking {target window} { set result "# packing info for slaves of [list $window]\n" - foreach slave [send $target [list pack slaves $window]] { + foreach slave [send $target [list ::pack slaves $window]] { $self format_packing_info result $slave \ [send $target [list pack info $slave]] } @@ -119,18 +119,18 @@ widget windows_list { } method retrieve_bindtags {target window} { set result "# bindtags of [list $window]\n" - set tags [send $target [list bindtags $window]] + set tags [send $target [list ::bindtags $window]] append result [list bindtags $window $tags] append result "\n" return $result } method retrieve_bindtagsplus {target window} { set result "# bindtags of [list $window]\n" - set tags [send $target [list bindtags $window]] + set tags [send $target [list ::bindtags $window]] append result [list bindtags $window $tags] append result "\n# bindings (in bindtag order)..." foreach tag $tags { - foreach sequence [send $target [list bind $tag]] { + foreach sequence [send $target [list ::bind $tag]] { append result "\nbind $tag $sequence " lappend result [send $target [list bind $tag $sequence]] } @@ -140,9 +140,9 @@ widget windows_list { } method retrieve_bindings {target window} { set result "# bindings of [list $window]" - foreach sequence [send $target [list bind $window]] { + foreach sequence [send $target [list ::bind $window]] { append result "\nbind $window $sequence " - lappend result [send $target [list bind $window $sequence]] + lappend result [send $target [list ::bind $window $sequence]] } append result "\n" return $result @@ -150,9 +150,9 @@ widget windows_list { method retrieve_classbindings {target window} { set class [$slot(main) windows_info get_class $target $window] set result "# class bindings for $window\n# class: $class" - foreach sequence [send $target [list bind $class]] { + foreach sequence [send $target [list ::bind $class]] { append result "\nbind $class $sequence " - lappend result [send $target [list bind $class $sequence]] + lappend result [send $target [list ::bind $class $sequence]] } append result "\n" return $result -- 2.23.0