Tcl Source Code

Artifact f13371c01437a69e06af523f052aa56ec48a80be:

proc ::oo::define::classmethod {name {args {}} {body {}}} {
    set class [lindex [info level -1] 1]
    set classmy [info object namespace $class]::my
    if {[llength [info level 0]] == 4} {
	uplevel 1 [list self method $name $args $body]
    } elseif {[llength [info level 0]] == 3} {
	return -code error "wrong # args: should be\
	    \"[lindex [info level 0] 0] name ?args body?\""
    }
    uplevel 1 [list forward $name $classmy $name]
}

proc ::oo::Helpers::classvar {name args} {
    set ns [info object namespace [uplevel 1 {self class}]]
    set cmd [list namespace upvar $ns]
    foreach v [list $name {*}$args] {lappend cmd $v $v}
    uplevel 1 $cmd
}