Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7612
Modified Files: Tag: devel_0_39 objective.tcl Log Message: uhoh
Index: objective.tcl =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/objective.tcl,v retrieving revision 1.1.2.4 retrieving revision 1.1.2.5 diff -C2 -d -r1.1.2.4 -r1.1.2.5 *** objective.tcl 2 Nov 2005 11:49:05 -0000 1.1.2.4 --- objective.tcl 5 Dec 2005 01:08:11 -0000 1.1.2.5 *************** *** 12,19 **** --- 12,46 ---- # note, the toplevel class is called "thing".
+ if {$tcl_version < 8.5} {source pre8.5.tcl} set nextid 0 set _(class:_class) class set _(class:_super) {thing}
+ proc proc* {name args body} { + set argl {} + foreach arg $args {set arg [lindex $arg 0]; lappend argl "$arg=$$arg"} + proc $name $args "puts "CALL TO PROC $name [join $argl " "]"; $body" + } + + #proc class_def {self selector args body} { + # global _; if {![info exists _($self:_class)]} {error "unknown class '$self'"} + # proc ${self}_$selector "self $args" "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" + #} + #proc class_def* {self selector args body} { + # global _; if {![info exists _($self:_class)]} {error "unknown class '$self'"} + # proc* ${self}_$selector "self $args" "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" + #} + #proc def {class selector args body} {$class def $selector $args $body} + #proc def* {class selector args body} {$class def* $selector $args $body} + + proc def {self selector args body} { + global _; if {![info exists _($self:_class)]} {error "unknown class '$self'"} + proc ${self}_$selector "self $args" "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" + } + proc def* {self selector args body} { + global _; if {![info exists _($self:_class)]} {error "unknown class '$self'"} + proc* ${self}_$selector "self $args" "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" + } + proc class_new {self {super {thing}}} { global _ *************** *** 37,60 **** }
- proc proc* {name args body} { - set argl {} - foreach arg $args {set arg [lindex $arg 0]; lappend argl "$arg=$$arg"} - proc $name $args "puts "CALL TO PROC $name [join $argl " "]"; $body" - } - - proc def {class selector args body} { - global _ - if {![info exists _($class:_class)]} {error "unknown class '$class'"} - proc ${class}_$selector "self $args" \ - "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" - } - - proc def* {class selector args body} { - global _ - if {![info exists _($class:_class)]} {error "unknown class '$class'"} - proc* ${class}_$selector "self $args" \ - "global _; [regsub -all @([\w\?]+) $body _($self:\1)]" - } - proc lookup_method {class selector methodsv ancestorsv} { global _ --- 64,67 ---- *************** *** 106,107 **** --- 113,115 ---- def* thing _delete {} {}
+ #-----------------------------------------------------------------------------------#