pd/src poe.tcl,1.1.2.2.2.3,1.1.2.2.2.4 - Pd-cvs

6 Dec 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19492
Modified Files:
      Tag: desiredata
    poe.tcl 
Log Message:
super small dispatcher
Index: poe.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/poe.tcl,v
retrieving revision 1.1.2.2.2.3
retrieving revision 1.1.2.2.2.4
diff -C2 -d -r1.1.2.2.2.3 -r1.1.2.2.2.4
*** poe.tcl	6 Dec 2006 18:29:00 -0000	1.1.2.2.2.3
--- poe.tcl	6 Dec 2006 18:57:30 -0000	1.1.2.2.2.4
***************
*** 101,115 ****
  }
! set dispatch {
    global _ __
! 	set i 0; set methods {}; set class $_($self:_class); set self $self
! 	if {[catch {set methods $__($class:$selector)}]} {
! 		set ancestors {}
! 		lookup_method $class $selector methods ancestors
! 		set __($class:$selector) $methods
! 	}
! 	if {![llength $methods]} {
! 		error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
! 	}
  }
  if {$tcl_version >= 8.5} {
--- 101,121 ----
  }
! proc dispatch_error {self args} {
! 	upvar 1 selector selector class class
! 	error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
! }
! 
! proc cache_method {class selector} {
    global _ __
! 	set methods {}; set ancestors {}
! 	lookup_method $class $selector methods ancestors
! 	if {![llength $methods]} {set methods {dispatch_error}}
! 	set __($class:$selector) $methods
! 	return $methods
! }
! 
! set dispatch {
! 	global _ __; set i 0; set class $_($self:_class)
! 	if {[catch {set methods $__($class:$selector)}]} {set methods [cache_method $class $selector]}
  }
  if {$tcl_version >= 8.5} {
***************
*** 119,130 ****
  }
  proc setup_dispatcher {self} {
- 	#puts "setup_dispatcher $self"
- 	#puts [time {proc $self {selector args} [regsub -all {$self} $::dispatch $self]}]
    proc $self {selector args} [regsub -all {$self} $::dispatch $self]
- 	#puts [regsub -all {$self} $::dispatch $self]
  }
set super {
! 	upvar 2 methods methods self self i oi
    set i [expr {1+$oi}]
    if {[llength $methods] < $i} {error "no more supermethods"}
--- 125,134 ----
  }
  proc setup_dispatcher {self} {
    proc $self {selector args} [regsub -all {$self} $::dispatch $self]
  }
set super {
! 	upvar 1 self self
! 	upvar 2 methods methods i oi
    set i [expr {1+$oi}]
    if {[llength $methods] < $i} {error "no more supermethods"}