1 # Implements script-based implementations of various namespace
4 # (c) 2011 Steve Bennett <steveb@workware.net.au>
7 proc {namespace delete
} {args
} {
9 if {$name ni
{:: ""}} {
10 set name
[uplevel 1 [list ::namespace canon
$name]]
11 foreach i
[info commands
${name
}::*] { rename $i "" }
12 uplevel #0 [list unset {*}[info globals ${name}::*]]
17 proc {namespace origin
} {name
} {
18 set nscanon
[uplevel 1 [list ::namespace canon
$name]]
19 if {[exists
-alias $nscanon]} {
20 tailcall
{namespace origin
} [info alias
$nscanon]
22 if {[exists
-command $nscanon]} {
25 if {[exists
-command $name]} {
29 return -code error "invalid command name \"$name\""
32 proc {namespace which
} {{type
-command} name
} {
33 set nsname
::[uplevel 1 [list ::namespace canon
$name]]
34 if {$type eq
"-variable"} {
37 if {$type eq
"-command"} {
38 if {[exists
-command $nsname]} {
40 } elseif
{[exists
-command ::$name]} {
45 return -code error {wrong
# args: should be "namespace which ?-command? ?-variable? name"}
49 proc {namespace code
} {arg
} {
50 if {[string first
"::namespace inscope " $arg] == 0} {
54 list ::namespace inscope
[uplevel 1 ::namespace current
] $arg
57 proc {namespace inscope
} {name arg args
} {
58 tailcall
namespace eval $name $arg $args
61 proc {namespace import
} {args
} {
62 set current
[uplevel 1 ::namespace canon
]
64 foreach pattern
$args {
65 foreach cmd
[info commands
[namespace canon
$current $pattern]] {
66 alias
${current
}::[namespace tail
$cmd] $cmd
71 # namespace-aware info commands: procs, channels, globals, locals, vars
72 proc {namespace info} {cmd
{pattern
*}} {
73 set current
[uplevel 1 ::namespace canon
]
74 # Now we may need to strip $pattern
75 if {[string first
:: $pattern] == 0} {
80 set clen
[string length
$current]
83 set fqp
[namespace canon
$current $pattern]
84 switch -glob -- $cmd {
87 set result
[info $cmd $fqp]
89 # Add commands in the current namespace
91 foreach c
[info $cmd $fqp] {
92 dict
set r
[string range
$c $clen end
] 1
94 if {[string match co
* $cmd]} {
95 # Now in the global namespace
96 foreach c
[info -nons commands
$pattern] {
100 set result
[dict keys
$r]
104 set result
[info channels
$pattern]
107 #puts "uplevel #0 info gvars $fqp"
108 set result
[uplevel #0 info -nons vars $fqp]
111 set result
[info globals
$fqp]
114 set result
[uplevel 1 info -nons locals
$pattern]
118 set result
[lmap p
$result { set p
$prefix$p }]
123 proc {namespace upvar} {ns args
} {
124 set nscanon
::[uplevel 1 [list ::namespace canon
$ns]]
125 set script
[list upvar 0]
126 foreach {other local
} $args {
127 lappend script
${nscanon
}::$other $local