Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4592
Modified Files: Tag: desiredata poe.tcl Log Message: doesn't use proc unknown anymore. (i hope that's not slower.)
Index: poe.tcl =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/poe.tcl,v retrieving revision 1.1.2.2.2.1 retrieving revision 1.1.2.2.2.2 diff -C2 -d -r1.1.2.2.2.1 -r1.1.2.2.2.2 *** poe.tcl 6 Dec 2006 08:46:06 -0000 1.1.2.2.2.1 --- poe.tcl 6 Dec 2006 18:17:39 -0000 1.1.2.2.2.2 *************** *** 75,88 **** incr nextid set _($self:_class) $self ! eval [concat [list $self init] $args] return $self " proc ${self}_new_as {self args} " global _ ! if {[info exists _($self:_class)]} {error "object '\$self' already exists" } set _($self:_class) $self ! eval [concat [list $self init] $args] return $self " }
--- 75,91 ---- incr nextid set _($self:_class) $self ! setup_dispatcher $self ! eval [concat [list $self init] $args] return $self " proc ${self}_new_as {self args} " global _ ! if {[info exists _($self:_class)]} {error "object '\$self' already exists" } set _($self:_class) $self ! setup_dispatcher $self ! eval [concat [list $self init] $args] return $self " + setup_dispatcher $self }
*************** *** 98,116 **** }
- rename unknown unknown2 # TODO: use {expand} ! set unknown { global _ __ ! set self [lindex $args 0] ! if {[llength [array names _ $self:_class]] == 0} { ! return [uplevel 1 [linsert $args 0 unknown2]] ! } ! set methods {} ! set ancestors {} ! set selector [lindex $args 1] ! set class $_($self:_class) if {[info exists __($class:$selector)]} { set methods $__($class:$selector) } { lookup_method $_($self:_class) $selector methods ancestors set __($class:$selector) $methods --- 101,112 ---- }
# TODO: use {expand} ! set dispatch { global _ __ ! set methods {}; set ancestors {}; set class $_($self:_class); set self $self if {[info exists __($class:$selector)]} { set methods $__($class:$selector) } { + #puts "self=$self class=$_($self:_class)" lookup_method $_($self:_class) $selector methods ancestors set __($class:$selector) $methods *************** *** 122,130 **** } if {$tcl_version >= 8.5} { ! append unknown {[lindex $methods $i] $self {expand}[lrange $args 2 end]} } else { ! append unknown {eval [concat [list [lindex $methods $i] $self] [lrange $args 2 end]]} } - proc unknown {args} $unknown
set super { --- 118,130 ---- } if {$tcl_version >= 8.5} { ! append dispatch {[lindex $methods $i] $self {expand}$args} } else { ! append dispatch {eval [concat [list [lindex $methods $i] $self] $args]} ! } ! proc setup_dispatcher {self} { ! #puts "setup_dispatcher $self" ! proc $self {selector args} [regsub -all {$self} $::dispatch $self] ! #puts [regsub -all {$self} $::dispatch $self] }
set super {