Namespace variables 2

Martin Lemburg: here some procedures ...
... to get the full qualified name of ...
... to check the existence of ...
... to connect (with upvar) to ...
... a variable in the current or any parent namespace
 proc getFullNspcVarName {args} {
    switch -exact -- [llength $args] {
       1   {
          set nspc    [uplevel namespace current];
          set varname [lindex $args 0];
       }
       2   {
          foreach {nspc varname} $args {break;}
          
          if {[catch {namespace parent $nspc}]} {
             error "no such namespace \"$nspc\"";
          }
       }
       default   {
          error "wrong # args: should be \"getFullNspcVarName ?namespace? varname\"";
       }
    }
    
    while {![info exists ${nspc}::$varname]} {
       if {$nspc == "::"} {
          return "";
       }

       set nspc [namespace parent $nspc];
    }

    return ${nspc}::$varname;
 }

 proc varExistsInNspc {args} {
    if {[catch {set result [uplevel getFullNspcVarName $args]} reason]} {
       error $reason;
    }

    if {$result == ""} {
       return 0;
    }

    return 1;
 }

 proc nspcVar2LocalVar {args} {
    if {[catch {set result [uplevel getFullNspcVarName $args]} reason]} {
       error $reason;
    }

    if {$result == ""} {
       return 0;
    }

    set varname [namespace tail $result];

    if {[uplevel info exists $varname]} {
       error "namespace var \"$result\" already exists";
    }
    
    uplevel upvar $result $varname;

    return 1;
 }

 # demo and test:

 if {[file tail [info script]] == [file tail $argv0]} {
    namespace eval a {
       variable a1;
       variable a2;
       variable a3;

       set a1 "a1 is a var of ::a";
       set a2 "a2 is a var of ::a";
       set a3 "a3 is a var of ::a";

       namespace eval b {
          variable b1;
          variable a2;

          set b1 "b1 is a var of ::a::b";
          set a2 "a2 is a var of ::a::b";

          puts "varExistsInNspc b1    = [varExistsInNspc b1]";
          puts "getFullNspcVarName b1 = [getFullNspcVarName b1]";
          puts "varExistsInNspc a1    = [varExistsInNspc a1]";
          puts "getFullNspcVarName a1 = [set var [getFullNspcVarName a1]]";

          if {[nspcVar2LocalVar a1]} {
             puts "connected \"$var\" to \"a1\"";
             puts "a1 = $a1";
          } else {
             puts stderr "couldn't connect to \"a1\"";
          }

          nspcVar2LocalVar a2;
       }
    }
 }
Category Introspection