[PD-cvs] pd/src poe.tcl,1.1.2.2,1.1.2.2.2.1

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19606

Modified Files:
      Tag: desiredata
	poe.tcl 
Log Message:
Tcl 8.5 specific speedup using {expand}


Index: poe.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/poe.tcl,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.2.2.1
diff -C2 -d -r1.1.2.2 -r1.1.2.2.2.1
*** poe.tcl	19 Nov 2006 05:59:13 -0000	1.1.2.2
--- poe.tcl	6 Dec 2006 08:46:06 -0000	1.1.2.2.2.1
***************
*** 87,90 ****
--- 87,91 ----
  }
  
+ # TODO: remove duplicates in lookup
  proc lookup_method {class selector methodsv ancestorsv} {
  	global _
***************
*** 98,104 ****
  
  rename unknown unknown2
! # TODO: remove duplicates in lookup
! # TODO: cache lookup for greater speed
! proc unknown {args} {
  	global _ __
  	set self [lindex $args 0]
--- 99,104 ----
  
  rename unknown unknown2
! # TODO: use {expand}
! set unknown {
  	global _ __
  	set self [lindex $args 0]
***************
*** 118,133 ****
  	set i 0
  	if {![llength $methods]} {
! 		set ancestors [Class_ancestors $class]
! 		error "no such method '$selector' for object '$self'\nwith ancestors {$ancestors}"
  	}
- 	eval [concat [list [lindex $methods $i] $self] [lrange $args 2 end]]
  }
  
! proc super {args} {
  	upvar 2 methods methods self self i oi
! 	set i [expr 1+$oi]
  	if {[llength $methods] < $i} {error "no more supermethods"}
- 	eval [concat [list [lindex $methods $i] $self] $args]
  }
  
  class_new Thing {}
--- 118,142 ----
  	set i 0
  	if {![llength $methods]} {
! 		error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
  	}
  }
+ 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 {
  	upvar 2 methods methods self self i oi
! 	set i [expr {1+$oi}]
  	if {[llength $methods] < $i} {error "no more supermethods"}
  }
+ if {$tcl_version >= 8.5} {
+ 	append super {[lindex $methods $i] $self {expand}$args}
+ } else {
+ 	append super {eval [concat [list [lindex $methods $i] $self] $args]}
+ }
+ proc super {args} $super
  
  class_new Thing {}