CODEWITHSUNDEEP
tcl
Brad303
Brad303

Reputation: 1189

Tcl object method called as variable

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?

Upvotes: 1

Views: 305

Answers (3)

glenn jackman
glenn jackman

Reputation: 247142

Or:

proc theWrapper {} [
    upvar 1 testObj testObj
    tailcall $testObj onEvent
}
set wrapper theWrapper
$wrapper

Upvotes: 2

Schelte Bron
Schelte Bron

Reputation: 4813

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

Upvotes: 0

Donal Fellows
Donal Fellows

Reputation: 137767

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).

Upvotes: 0

Related Questions