Fix for bug #624268 - namespace qualify sent commands

diff --git a/ChangeLog b/ChangeLog
index 03f00c052da58766d8447e55ca3c681cd9b47ca4..deb365d5d9acfcd61b6d4edd9a1f389f9bf9fe7c 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+Mon Oct 21 22:42:34 2002  Pat Thoyts <patthoyts@users.sourceforge.net>
+
+       * 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 <patthoyts@users.sourceforge.net>
 
        * tkinspect.tcl:

diff --git a/afters_list.tcl b/afters_list.tcl
index 12e776963a91f15b6e39e5f3b9b42b33df5097d9..90eeba8217b378746cb8b7b1ba8247c4c0aa3864 100644 (file)
--- 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 b43d9cb182e8c222941097d548b02ed9fc49e233..070c3d70b2091c94b9f8c84793b36078ed7e1b2a 100644 (file)
--- 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 a8b1c5d49c2447c189ba951b552a870ffcf8c542..c44e3d0e2dc26a0d5ed968b43b65e549bd1b24c5 100644 (file)
--- 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 08161cc6a94d2617f16056b33cc021f56c4fb2e9..e818a162b2e07d7458d82ff4cc33d97dbd6cbd96 100644 (file)
--- 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 05c7aaef9053223a146f72a9e530767c469546b4..369e769fe457220dbe8d3e7ce3619e7dc24717e7 100644 (file)
--- 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 0c9ae247fd48bc8515aec85f01ecd64c71364964..230ec3518f92a142d9faa579b81ce52fa9c46d22 100644 (file)
--- 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 76bdf131cc2b8d8bd2119040aa62fa7e4d62cac1..18ee077f16622a09891c1c1d3af16d05ccd6693a 100644 (file)
--- 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 51af45b83955531ed87805bdc476a86b3a37423a..09a2deaa63712ecd938fb8b96210e7c3ee0bac0f 100644 (file)
--- 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 ef8bd286b5609fc459900e2b26257ce715fc9116..a7e7cb5539d9ba5f03350ff658982848f518faec 100644 (file)
--- 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