How can one execute an object method as a variable?
oo::class create handlerTest {
method onEvent {} {
puts "onEvent method"
}
}
set testObj [handlerTest new]
#set wrapper {$testObj onEvent}
#set wrapper {$testObj::my onEvent}
#set wrapper [namespace code {$testObj onEvent}]
#set wrapper "eval testObj onEvent
#set wrapper {[eval testObj onEvent]}
$wrapper
All of the above attempts appear to execute $wrapper as a single command, not a command with args.
As I am using an external library that calls the defined wrapper, I can't change how the wrapper is called (i.e. {*}$wrapper).
Is there a way to do this?
Or:
proc theWrapper {} [
upvar 1 testObj testObj
tailcall $testObj onEvent
}
set wrapper theWrapper
$wrapper
The only way to rewrite the command name itself is via an unknown handler (defaults to being called unknown in the global namespace; you probably want to use that default). Some care needs to be taken when doing this, as the default handler does things that some code needs to have present; a bit of shuffling around with rename should do the trick.
# only want special treatment for some commands
set autoexpanded [list $testObj]
# save for later
rename unknown _original_unknown
proc unknown args {
global autoexpanded
# if we want to expand the first word...
if {[catch {lindex $args 0 0} cmd] == 0 && $cmd in $autoexpanded} {
# delegate to the expanded command (tailcall is perfect here)
set args [lassign $args cmd]
tailcall {*}$cmd {*}$args
} else {
# delegate to the original unknown
tailcall _original_unknown {*}$args
}
}
Be aware that this is not a fast dispatch mechanism. It is only used when the only other alternative is throwing an error because the command doesn't exist (also slow, but error paths are never optimal or heavily optimized).
The easiest method that comes to mind, is to generate a name for an alias and put that in the variable:
set testObj [handlerTest new]
set wrapper [interp alias {} wrapper[incr wrapperid] {} $testObj onEvent]
$wrapper
=> onEvent method
Related
I am new to the TCL scripting .I have a script called "Sample.tcl". In the Sample.tcl I have a variable called $name. How can I assign a value to the variable if there exist a specific argv i.e.
Sample.tcl -step xyz
Only if I specify -step then $name should be xyz.
I'm not sure what $name might be in this context (it's a really unusual name for a variable, and using variable variable names is typically a bad idea) but under the guess that you're trying to set step to xyz in this case, you can put this in your script:
apply {{} {
# For each pair of values in the arguments (after the script name)
global argv
foreach {key value} $argv {
# Safety-check: if the key starts with a hyphen...
if {[string match -* $key]} {
# ... strip the leading hyphen(s)
set varname [string trimleft $key "-"]
# ... bind that global var name to a local name
upvar 1 $varname var
# ... and set the variable to the value we've got.
set var $value
}
}
}}
It's done in an apply so that we don't pollute the global namespace with all our working variables (key, value, varname and var) and because we don't really need to make a procedure for something we're only going to do once.
This isn't a safe piece of code, not by any means, but it is a useful and flexible way to get something working.
In general, parsing command line arguments can take quite a bit of thought to get perfectly right and there's various packages to help out, but that's only really important when writing code for other people to run. When it's just for yourself, you can be a lot sloppier and get the job done in a few minutes.
Using the cmdline package from tcllib you could write:
#!/usr/bin/env tclsh
package require cmdline
set options {
{step.arg "" "Set the step value"}
}
try {
array set params [cmdline::getoptions argv $options]
} on error e {
puts stderr $e
exit 1
}
if {$params(step) ne ""} {
set name $params(step)
}
if {[info exists name]} {
puts "name = $name"
} else {
puts "name is not set"
}
So I have the following situation:
$ ls -l
-r--r----- 1.tcl
-rw-rw---- 2.tcl
$ cat 1.tcl
proc foo {args} {
puts "$bar"
}
and I need to make 1.tcl print something other than "can't read \"bar\"". In a good programming language, the obvious solution would be
$ cat > 2.tcl
set -global bar "hello, world"
foo
What would be a reasonable workaround in TCL? Unfortunately the real foo is a long function that I can't really make a copy of or sed to a temporary file at runtime.
You can do this for your specific example
$ cat 2.tcl
source 1.tcl
set bar "Hello, bar!"
# add a "global bar" command to the foo procedure
proc foo [info args foo] "global bar; [info body foo]"
foo
$ tclsh 2.tcl
Hello, bar!
Clearly this doesn't scale very well.
If the variable is simply undefined, the easiest way would be to patch the procedure with a definition:
proc foo [info args foo] "set bar \"hello, world\" ; [info body foo]"
You can also accomplish this using a read trace and a helper command. This removes the problem I mentioned above, where local assignments destroy the value you wanted to inject.
The original procedure, with an added command that sets the local variable to a value which is later printed.
proc foo args {
set bar foobar
puts "$bar"
}
% foo
foobar
Create a global variable (it doesn't matter if the name is the same or not).
set bar "hello, world"
Create a helper command that gets the name of the local variable, links to it, and assigns the value of the global variable to it. Since we already know the name we could hardcode it in the procedure, but this is more flexible.
proc readbar {name args} {
upvar 1 $name var
global bar
set var $bar
}
Add the trace to the body of the foo procedure. The trace will fire whenever the local variable bar is read, i.e. something attempts to retrieve its value. When the trace fires, the command readbar is called: it overwrites the current value of the variable with the globally set value.
proc foo [info args foo] "trace add variable bar read readbar; [info body foo]"
% foo
hello, world
If one doesn't want to pollute the namespace with the helper command, one can use an anonymous function instead:
proc foo [info args foo] [format {trace add variable bar read {apply {{name args} {
upvar 1 $name var
global bar
set var $bar
}}} ; %s} [info body foo]]
Documentation:
apply,
format,
global,
info,
proc,
puts,
set,
trace,
upvar,
Syntax of Tcl regular expressions
source 1.tcl
try {
foo
} on error {err res} {
set einfo [dict get $res -errorinfo]
if { [regexp {no such variable} $einfo] } {
puts "hello, world"
return -code 0
} else {
puts $einfo
return -code [dict get $res -code]
}
}
Tcl's procedures do not resolve variables to anything other than local variables by default. You have to explicitly ask for them to refer to something else (e.g., with global, variable or upvar). This means that it's always possible to see at a glance whether non-local things are happening, and that the script won't work.
It's possible to override this behaviour with a variable resolver, but Tcl doesn't really expose that API in its script interface. Some extensions do more. For example, it might work to use [incr Tcl] (i.e., itcl) as that does that sort of thing for variables in its objects. I can't remember if Expect also does this, or if that uses special-cased code for handling its variables.
Of course, you could get really sneaky and override the behaviour of proc.
rename proc real_proc
real_proc proc {name arguments body} {
uplevel 1 [list real_proc $name $arguments "global bar;$body"]
}
That's rather nasty though.
I'm trying to write a TclOO wrapper around the http package. The idea is to create an object passing the arguments that you would normally pass to http::geturl and have code, data, ncode and meta methods to return the same data as the corresponding http:: proc. To avoid lots of typing, I hit upon the following:
oo::class create myHttp {
constructor {url args} {
set responses {data code ncode meta}
foreach response $responses {
oo::objdefine [self object] variable -append m_$response
oo::objdefine [self object] method $response {} [subst -nocommands {
puts stdout [lsort [info vars *]]
return [set m_$response]
}]
}
set tok [http::geturl $url {*}$args]
foreach response $responses {
set m_$response [http::$response $tok]
}
http::cleanup $tok
}
Sadly it doesn't work.
% set h [myHttp new http://www.google.co.uk]
% $h code
m_code m_data m_meta m_ncode
can't read "m_code": no such variable
What's going on here? The output of [info vars] suggests that m_code exists, but the error says it doesn't. Accessing the variables directly from the [info object namespace $h] namespace shows that they all exist and have the expected values but all the accessor methods fail with the same error.
Is there a better way to "auto-generate" the methods and variables? I freely admit that I haven't quite got my head around defining methods using oo::objdefine rather than in an oo::class create statement, and I've tried adding, semi-randomly, my variable m_$response and variable m_$response statements in the $reponse methods to no avail. I'm concerned to find myself using subst here as I've usually found on later review that a simple list would have worked adequately and less opaquely.
For completeness, I'm using Tcl 8.6.4 using an ActiveState distribution on Windows 7, and debugging with TkCon.
I'd write it as
oo::class create myHttp {
variable tok
constructor {url args} {
set tok [http::geturl $url {*}$args]
foreach response {data code ncode meta} {
oo::objdefine [self] forward $response http::$response $tok
}
}
destructor {
http::cleanup $tok
}
}
but if you really need the variables for some purpose, that obviously won't work.
Consider the following situation:
namespace eval ::mydialog {}
proc ::mydialog::show {w varName args} {
upvar 1 $varName theVar
# now I can access theVar
# (1)
# code defining/creating my window
# here some widgets for user interaction are created,
# some of which will call ::mydialog::_someCallback
wm protocol $w WM_DELETE_WINDOW [list ::mydialog::close $w]
}
proc ::mydialog::_someCallback {} {
# how do I access theVar here?
# (2)
}
proc ::mydialog::close { w } {
# here some changes are supposed to be written back into varName in the calling scope,
# how do I do that?!
# (3)
destroy $w
}
Im trying to figure out how to (a) get a variable from the calling scope (b) have it available in all three procs and (c) writing any changes back into said variable.
(a) I would normally solve using 'upvar 1 $varName theVar'
(b) I would normally solve with a namespace variable
(c) As long as we only have one proc that would happen automaticly with (a) due to the fact that we would be working on a local alias of that variable
The problem is that upvar only works (at least as intended) in (1).
I could use upvar in (1) and save/copy into a namespace variable, that would solve (a) and (b), but not (c).
I would be gratefull if someone could point me in the right direction here.
Also, as I'm relativly new to Tcl/Tk my concept might not be ideal, suggestions toward a better design are welcome too.
I suggest you use a namespace variable that keeps the name of the variable, and upvar using the global scope.
namespace eval ::mydialog {
variable varName
}
proc ::mydialog::show {w _varName args} {
variable varName $_varName
upvar #0 $varName theVar
}
proc ::mydialog::_someCallback {} {
variable varName
upvar #0 $varName theVar
puts $theVar
}
proc ::mydialog::close { w } {
variable varName
upvar #0 $varName theVar
set theVar newval
}
set globalvar oldval
# => oldval
::mydialog::show {} globalvar
::mydialog::_someCallback
# => oldval
::mydialog::close {}
# => newval
puts $globalvar
# => newval
Note that the syntax highlighting fails: #0 $varName theVar isn't really a comment.
This works with namespace variables too: if you have a variable called nsvar in the ::foobar namespace you can use it like this:
set ::foobar::nsvar oldval
::mydialog::show {} ::foobar::nsvar
::mydialog::_someCallback
::mydialog::close {}
puts $::foobar::nsvar
with the same effects.
You can't, however, use variables local to some procedure this way.
One way to make this really simple is to use Snit widgets instead of collections of Tcl procedures.
Documentation: namespace, proc, puts, set, upvar, variable
Snit documentation: man page, faq (the faq serves as a kind of introduction as well)
Suppose the following code declarations:
itcl::class ObjectA {
private variable m_ownedObject
private variable m_someVariable
constructor {} \
{
set m_ownedObject [ObjectA #auto]
}
protected method SetSomeVariable {newVal} {
set m_someVariable $newVal
}
public method SomeMethod{} {
$m_ownedObject SetSomeVariable 5
}
}
This is the only way I know how to modify m_someVariable from within SomeMethod on m_ownedObject. In other languages (say C/C++/C#/Java to name a few), I'm pretty sure I could just say something like:
m_ownedObject.m_someVariable = 5
Is there a way to do something like this in tcl, or do I always need to create protected getters and setters? Hopefully this is reasonably clear.
You cannot directly do what you're asking for in itcl. However, this being Tcl, you can work around that, and directly set the member variable from anywhere. I use a helper routine called memv which you pass an instance and a variable name, and it returns a "reference" to that variable.
This obviously bypasses the private/protected mechanisms that Itcl set up, so you're violating abstractions using them. It's your call whether you want to use it. I find it invaluable for debugging, but don't it in production code.
The example usage is:
set [memv m_ownedObject m_someVariable] 5
The code for memv is:
proc memv {obj varname} {
# have to look up the variable, which might be in a base class
# so do 'info variable' to get that, and the full name is the 3rd element
# next two lines handle pulling apart an array
set aindex ""
regexp -- {^(.+)\((.+)\)$} $varname ignore varname aindex
set var [lindex [$obj info variable $varname] 2]
if {$aindex == ""} {
return [list #itcl $obj $var]
} else {
return [list #itcl $obj $var\($aindex\)]
}
}
Similarly, I have a helper routine named memv which allows you to call any method (including private and protected methods). It's usage is similar
[memf m_ownedObject SetSomeVariable] 5
And it's code is:
proc memf {obj fcnname} {
set f [$obj info function $fcnname]
if {[llength $f] != 5} {
error "expected '$obj info function $fcnname' to return something like 'private proc ::namespace::name args {...}' but got: $f"
}
set fullname [lindex [$obj info function $fcnname] 2]
set namespace [namespace qualifiers $fullname]
set function [namespace tail $fullname]
return [itcl::code -namespace $namespace $obj $function]
}
$m_ownedObject configure -m_someVariable 5
If you're declaring a variable as private, means that can be only accessed from within the class. And that's also valid for C/C++/Java ... so I'm not sure what are you expecting.
Anyway Tcl is a dynamic language, so you can do something like that.
itcl::class tclass {
foreach v {time distance} {
method get$v {} [subst -nocommands { return [subst $$v] }]
method set$v nuval [subst -nocommands { set $v \$nuval } ]
protected variable $v "Var $v"
}
}
And it will create all the getters and setters that you need ;)
You can find more info here: http://wiki.tcl.tk/17667