Tcl: How to get namespace and procedures of calling namespace? - tcl

I have some generic procedure. I would like this procedure to be able to get the name of the namespace and names of the procedures within the namespace where this procedure is called.
I have tried following code:
proc register {} {
puts [info procs]
puts [namespace current]
}
namespace eval Foo {
proc bar {} {
puts bar
}
proc _baz {} {
puts baz
}
register
}
However, this prints results for the namespace where register is defined, not for the namespace where it is executed. It looks like there are no dedicated commands for these tasks or at least these are not info or namespace commands.

To get information about the calling context, use uplevel:
proc register {} {
puts [uplevel 1 [list info procs]]
puts [uplevel 1 [list namespace current]]
}

Related

How do you access a procedure's local variables in a namespace eval {} inside that same procedure?

I'm sure I'm just being stupid but would you please tell me how to get access to $name inside the namespace in order to set variable n to $name? I can only find how to do this when the procedure is in the namespace but not the other way 'round. No matter what I try, this errors stating no such variable name. Thank you.
proc getNS {name} {
namespace eval ns::$name {
variable n $name
}
}
This works but isn't really an answer unless the answer is simply that it cannot be done directly. Got it from this SO question. Bryan Oakley gave the answer but used [list set...] instead of [list variable...] and that will fail if there is a global variable of the same name. (It will modify the global rather than creating a new variable in the namespace.) It may have been different, of course, in 2009 when that answer was provided.
proc getNS {name} {
namespace eval ns::$name [list variable n $name]
namespace eval ns::$name {
variable a abc
}
}
set n xyz
getNS WEBS
chan puts stdout "ns n: $ns::WEBS::n; a $ns::WEBS::a, global n: $n"
# => ns n: WEBS; a: abc; global n: xyz
You can just use set with a fully qualified variable name that uses the desired namespace:
proc getNS {name} {
namespace eval ns::$name {} ;# Create namespace if it doesn't already exist
set ns::${name}::n $name
}
getNS foo
puts $ns::foo::n ;# foo
Another way is to use uplevel to refer to the scope of the proc that calls namespace eval:
proc getNS {name} {
namespace eval ns::$name {
set n [uplevel 1 {set name}]
}
}

Can TclOO objects be shared/aliases between interpreters?

I'm implementing DSL processing. I'm using a safe interpreter to source the input file.
As part of the processing, I'm building an object.
something like:
set interp [interp create -safe]
interp expose $interp source
interp eval $interp {
oo::class create Graph { # ...
}
# add domain-specific commands here
proc graph {definition} {
global graph
$graph add $definition
}
# and so on
set graph [Graph new]
}
interp eval $interp source $graphFile
Is there a mechanism to alias the $graph object into the main interpreter?
Aliases are commands, not objects. However, for calling (as opposed to modifying definitions or making subclasses, etc.) you can set an alias that points to the object in the other interpreter:
oo::class create Example {
variable count
method bar {} { return "this is [self] in the method bar, call [incr count]" }
}
Example create foo
interp create xyz
interp alias xyz foo {} foo
xyz eval {
puts [foo bar]
}
# this is ::foo in the method bar, call 1
Individual methods can also go across interpreters (with some limitations) if you forward the method call to an alias that crosses the interpreter boundary. This allows for all sorts of shenanigans.
oo::class create Example {
variable count
method bar {caller} { return "this is $caller in the method bar, call [incr count]" }
}
Example create foo
interp create xyz
interp alias xyz _magic_cmd_ {} foo bar
interp eval xyz {
oo::class create Example {
forward bar _magic_cmd_ pqr
}
Example create grill
grill bar
}
# this is pqr in the method bar, call 1
What I ended up with:
oo::class create Graph { # ...
}
set graph [Graph new]
set interp [interp create -safe]
interp expose $interp source
interp alias $interp graphObj {} $graph
interp eval $interp {
# add domain-specific commands here
proc graph {definition} {
graphObj add $definition
}
# and so on
}
interp eval $interp source $graphFile
puts [$graph someMethod]

how to declare a variable globally which is used only in proc

i am having a following code:
proc testList {setupFile ""} {
if {$setupFile == ""} {
set setupFile location
}
}
proc run {} {
puts "$setupFile"
}
I am getting syntax error. I know if i declare the setupFile variable outside the proc i.e in the main proc then i can append it with namespace say ::65WL::setupFile to make it global but not getting how to do that if a variable itself is defined in the proc only.
You can refer to the global namespace with ::.
proc testList {{local_setupFile location}} {
# the default value is set in the arguments list.
set ::setupFile $local_setupFile
}
proc run {} {
puts $::setupFile
}
Tcl variables that are not local to a specific procedure run need to be bound to a namespace; the namespace can be the global namespace (there's a special command for that) but doesn't need to be. Thus, to have a variable that is shared between two procedures, you need to give it an exposed name:
proc testList {{setup_file ""}} {
# Use the 'eq' operator; more efficient for string equality
if {$setup_file eq ""} {
set setup_file location
}
global setupFile
set setupFile $setup_file
}
proc run {} {
global setupFile
puts "$setupFile"
}
Now, that's for sharing a full variable. There are some other alternatives provided you only want to share a value. For example, these two possibilities:
proc testList {{setup_file ""}} {
if {$setup_file eq ""} {
set setup_file location
}
# Create a procedure body at run-time
proc run {} [concat [list set setupFile $setup_file] \; {
puts "$setupFile"
}]
}
proc testList {{setup_file ""}} {
if {$setup_file eq ""} {
set setup_file location
}
# Set the value through combined use of aliases and a lambda term
interp alias {} run {} apply {setupFile {
puts "$setupFile"
}} $setup_file
}
There are more options with Tcl 8.6, but that's still in beta.
you can use uplevel, upvar and/or global
proc testList {{setupFile ""}} {
if {$setupFile eq ""} {
set setupFile location;
uplevel set setupFile $setupFile;
}
}
proc run {} {
upvar setupFile setupFile;
puts "$setupFile";
}
or
proc run {} {
global setupFile;
puts "$setupFile";
}
the first is prefered.

How can I callback Tcl commands from different namespaces without explicitly qualifying?

Basically the problem is to execute Tcl code defined in one namespace, using calls to functions in that namespace, in an eval inside another namespace.
The following code works fine:
namespace eval ::eggs {
namespace export e1 eeval
proc e1 {} { puts pe1 }
proc eeval body { puts "in cb enter"; eval $body; puts "in cb exit" }
}
namespace import ::eggs::*
namespace eval ::spam {
namespace export s1 scall
proc scb {} { puts pscb }
proc scall {} { puts "in call enter"; eeval {::spam::scb}; puts "in call exit" }
e1
scall
}
namespace import ::spam::*
and prints:
% % % % % % pe1
in call enter
in cb enter
pscb
in cb exit
in call exit
Now I want to replace the ::spam::scb with a plain scb. I would trade in a wrapper for eeval.
My use case:
The namespace eggs is a very basic library for regression testing. The namespace spam is a small library implementing nice to have functions. They shall be tested upon reload. For this scall is called and uses a special test function in eggs called eeval.
The eeval is the unit test. For convenience and "do-not-repeat-yourself" reasons I'd like to not have to use the fully qualified namespace name of any function defined in spam.
Ideally scall would look like this:
proc scall {} { puts "in call enter"; eeval {scb}; puts "in call exit" }
However, during execution the eval in ::eggs::eeval does not know where to find scb. Since eggs is just a test library I cannot import the spam namespace.
Is there any way one could e.g. devise a wrapper for e.g. eeval to make it run in the other namespace?
If you're going to pass the code to eval (possibly appending arguments) then the simplest method to generate the callback script is with namespace code:
eeval [namespace code {scb}]
That generates all the wrapping code to ensure that things work correctly, including handling all sorts of cases you've not dealt with:
% namespace eval boo {
puts [namespace code {foo bar}]
}
::namespace inscope ::boo {foo bar}
However, if you're doing the callback immediately then the most common approach is not the above, but rather to use uplevel 1 to do the callback:
proc eeval body {
puts "in cb enter"
uplevel 1 $body
puts "in cb exit"
}
This has the advantage that the called-back code really is in the stack context of the caller, allowing it to do useful things like access local variables. Since the code is running in the same context that you define it[*], it's fine using that for resolving command names.
[*] That's a big fat lie — Tcl's semantics are rather more complex than that — but everything works like what I've said is true.
namespace current is the DRYer you're probably looking for.
namespace eval ::spam {
proc scall {} {
puts {in call 2 enter}
eeval [namespace current]::scb
puts {in call 2 exit}
}
}
Or pass the current namespace to the eeval proc
proc ::eggs::eeval {body {namespace ""}} {
puts "in cb enter"
if {$namespace == ""} {
eval $body
} else {
namespace eval $namespace $body
}
puts "in cb exit"
}
proc ::spam::scall {} {
puts "in call 3 enter"
eeval scb [namespace current]
puts "in call 3 exit"
}

Unable to pass a variable to a procedure using upvar in Tcl

I need a procedure that will be able to access, read and change a variable from the namespace of the caller. The variable is called _current_selection. I have tried to do it using upvar in several different ways, but nothing worked. (I've written small test proc just to test the upvar mechanism). Here are my attempts:
call to proc:
select_shape $this _current_selection
proc:
proc select_shape {main_gui var_name} {
upvar $var_name curr_sel
puts " previously changed: $curr_sel"
set curr_sel [$curr_sel + 1]
}
For my second attempt:
call to proc:
select_shape $this
proc:
proc select_shape {main_gui} {
upvar _current_selection curr_sel
puts " previously changed: $curr_sel"
set curr_sel [$curr_sel + 1]
}
In all the attempts, once it reaches this area in the code it says can't read "curr_sel": no such variable
What am I doing wrong?
EDIT:
The call for the function is made from a bind command:
$this/zinc bind current <Button-1> [list select_shape $this _current_selection]
at start I thought that it doesn't matter. but maybe It does.
I believe that bind commands operate in the global namespace, so that's where the variable is expected to be found. This might work:
$this/zinc bind current <Button-1> \
[list select_shape $this [namespace current]::_current_selection]
for upvar to work the variable must exist in the scope that you are calling it in. consider the following:
proc t {varName} {
upvar $varName var
puts $var
}
#set x 1
t x
If you run it as it is you'll get the error you are reporting, uncomment the set x 1 line and it will work.
In the example below I've tried to cover the most variants of changing variables from other namespace. It 100% works for me. Maybe it will help.
proc select_shape {main_gui var_name} {
upvar $var_name curr_sel
puts " previously changed: $curr_sel"
incr curr_sel
}
namespace eval N {
variable _current_selection 1
variable this "some_value"
proc testN1 {} {
variable _current_selection
variable this
select_shape $this _current_selection
puts " new: $_current_selection"
}
# using absolute namespace name
proc testN2 {} {
select_shape [set [namespace current]::this] [namespace current]::_current_selection
puts " new: [set [namespace current]::_current_selection]"
}
select_shape $this _current_selection
puts " new: $_current_selection"
}
N::testN1
N::testN2
#-------------------------------------
# Example with Itcl class
package require Itcl
itcl::class C {
private variable _current_selection 10
public method testC {} {
select_shape $this [itcl::scope _current_selection]
puts " new: $_current_selection"
}
}
set c [C #auto]
$c testC