#! /bin/env tclsh
package require ycl
package require ycl::context::etc
variable etc [yclprefix]::context::etc
namespace upvar $etc META META
namespace upvar $etc BLOCK BLOCK
namespace upvar $etc RETURN RETURN
namespace upvar $etc INFO_VAR_BLOCKED INFO_VAR_BLOCKED
namespace upvar $etc INFO_VAR_NAME INFO_VAR_NAME
namespace upvar $etc INFO_VAR_NS INFO_VAR_NS
namespace upvar $etc INFO_VAR_VAL INFO_VAR_VAL
namespace upvar $etc VAR_DEFAULT VAR_DEFAULT
#return the contexts of an object
proc contexts {ns} {
set res [list]
while 1 {
set context [$ns context]
if {$context eq $ns} {
return $res
} else {
lappend res $context
set ns $context
}
}
}
proc exists {ns name} {
if {[catch {$ns var $name} res]} {
return 0
} else {
return 1
}
}
#value: [list <namespace of found var> <var value> ]
proc var {ns args} {
variable META
variable BLOCK
variable RETURN
variable INFO_VAR_BLOCKED
variable INFO_VAR_NAME
variable INFO_VAR_NS
variable INFO_VAR_VAL
variable VAR_DEFAULT
variable etc
set argl [llength $args]
if {$argl == 0} {
return -code error "varName not provided: [::info level 0]"
} elseif {$argl == 1} {
#break out of ifelse
} elseif {$argl == 2} {
lassign $args var val
dict set $RETURN $INFO_VAR_NS $ns
set status [catch {namespace eval $ns [list variable $var]} catchres catchopt]
if {$status && \
[string equal [lrange [dict get $catchopt -errorcode] 0 2] \
[list TCL LOOKUP ELEMENT]]} {
#handle the array case
set name [split $var (]
namespace eval $ns [list variable $name]
}
dict set $RETURN $INFO_VAR_VAL \
[namespace eval $ns [list set $var $val]]
return [set $RETURN]
} else {
set proc [lindex [::info level 0] 0]
return -code error "wrong # args: $argl: should be [::info args $proc]"
}
lassign $args var
dict set $RETURN $INFO_VAR_NAME $var
if {[::array exists ${ns}::$var]} {
return -code error "can't read \"$var\": variable is array"
}
if [::info exists ${ns}::$var] {
set val [set ${ns}::$var]
} elseif [::info exists ${ns}::${META}::$VAR_DEFAULT] {
set val [$ns configure default var]
}
if [::info exists val] {
dict set $RETURN $INFO_VAR_NS $ns
dict set $RETURN $INFO_VAR_VAL $val
return [set $RETURN]
} elseif {[::info exists ${ns}::${META}::$BLOCK] \
&& [dict exists [set ${ns}::${META}::$BLOCK] $var] &&
[dict get [set ${ns}::${META}::$BLOCK] $var] == 1 } {
#variable is blocked
dict set $RETURN $INFO_VAR_NS {}
dict set $RETURN $INFO_VAR_BLOCKED $ns
dict set $RETURN $INFO_VAR_VAL {}
return [set $RETURN]
} else {
set context [$ns context]
if [string equal $context $ns] {
return -code error \
"variable not found in context: \"$var\""
}
return [$context info var $var]
}
}