[PD-cvs] pd/src desire.tk,1.1.2.472,1.1.2.473
Mathieu Bouchard
matju at users.sourceforge.net
Sat Sep 16 03:22:09 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32619
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
now using modified bgerror; also, split update_object
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.472
retrieving revision 1.1.2.473
diff -C2 -d -r1.1.2.472 -r1.1.2.473
*** desire.tk 16 Sep 2006 00:18:43 -0000 1.1.2.472
--- desire.tk 16 Sep 2006 01:22:06 -0000 1.1.2.473
***************
*** 37,40 ****
--- 37,41 ----
package require objective
+ package require bgerror
#if {[catch {source profdd.tcl}]} {error_dump}
***************
*** 1963,1967 ****
$x canvas= $self
}
! set dead [lwithout $@wires $wires];
foreach x $dead {
$x delete
--- 1964,1968 ----
$x canvas= $self
}
! set dead [lwithout $@wires $wires]
foreach x $dead {
$x delete
***************
*** 3358,3409 ****
#A 0 0;
proc update_object {self e ninlets noutlets} {
global _ classinfo canvas
set isnew [expr ![info exists _($self:_class)]]
! foreach mess [split $e ";"] {
! switch -- [lindex $mess 0] {
! "#N" {
! set class canvas
! if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}
! set isnew 0
! }
! "#X" {
! set i 1
! if {[lindex $mess 1] == "obj"} {set i 4}
! set class [lindex $mess $i]
! if {[info exists classinfo($class)]} {
! set _class [lindex $classinfo($class) 0]
! } {
! set class obj
! set _class ObjectBox
! # this is not the same @isnew as $isnew !
! # in the future, @isnew should go elsewhere or disappear
! set _($self:isnew) [expr [llength $mess] == 4]
! }
! #if {$isnew} {$_class new_as $self}
! if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
! switch -- $class {
! array {}
! default {$self position= [lrange $mess 2 3]}
! }
! $self pdclass= $class
! $self ninlets= $ninlets ;# bogus in case of array
! $self noutlets= $noutlets
! #!@#$ goes with the request tracking feature to be impl in the server
! if {[info exists canvas(msg_isnew)]} {
! set _($self:isnew) 1
! $self edit
! unset canvas(msg_isnew)
! }
}
! "#A" {
! post "#A: $mess"
}
! "#V" {
! post "#V: $mess"
}
- default {if {$mess != ""} {error "what you say? ($mess)"}}
}
}
- $self changed
}
--- 3359,3411 ----
#A 0 0;
proc update_object {self e ninlets noutlets} {
+ foreach mess [split $e ";"] {update_object_2 $self $mess}
+ $self ninlets= $ninlets ;# bogus in case of array
+ $self noutlets= $noutlets
+ $self changed
+ }
+
+ proc update_object_2 {self mess} {
global _ classinfo canvas
set isnew [expr ![info exists _($self:_class)]]
! switch -- [lindex $mess 0] {
! "#N" {
! set class canvas
! if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}
! }
! "#X" {
! set i 1
! if {[lindex $mess 1] == "obj"} {set i 4}
! set class [lindex $mess $i]
! if {[info exists classinfo($class)]} {
! set _class [lindex $classinfo($class) 0]
! } {
! set class obj
! set _class ObjectBox
! # this is not the same @isnew as $isnew !
! # in the future, @isnew should go elsewhere or disappear
! set _($self:isnew) [expr [llength $mess] == 4]
}
! #if {$isnew} {$_class new_as $self}
! if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
! switch -- $class {
! array {}
! default {$self position= [lrange $mess 2 3]}
}
! $self pdclass= $class
! #!@#$ goes with the request tracking feature to be impl in the server
! if {[info exists canvas(msg_isnew)]} {
! set _($self:isnew) 1
! $self edit
! unset canvas(msg_isnew)
}
}
+ "#A" {
+ post "#A: $mess"
+ }
+ "#V" {
+ post "#V: $mess"
+ }
+ default {if {$mess != ""} {error "what you say? ($mess)"}}
}
}
***************
*** 3457,3464 ****
def AtomBox draw_box {} {
global font
- mset {x1 y1} [$self xy]
$self update_size
! set x2 [expr $x1+$@xs]
! set y2 [expr $y1+$@ys]
set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
[$@canvas widget] canvasx $x1
--- 3459,3464 ----
def AtomBox draw_box {} {
global font
$self update_size
! mset {x1 y1 x2 y2} [$self bbox]
set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
[$@canvas widget] canvasx $x1
***************
*** 3972,3977 ****
$self item BASE polygon $points -fill [parse_color $@bcol] -outline [$self look frame3]
$self item BASE4 polygon $points2 -fill $color4 -outline [$self look frame3]
- #$self item NUMBER text [list $xt $yt] -anchor w -text $@text \
- # -font $font(str) -fill [parse_color $@fcol]
$self item NUMBER text [list $xt $yt] -anchor w -text $@text \
-font [$self look fontstring] -fill [parse_color $@fcol]
--- 3972,3975 ----
***************
*** 3986,3991 ****
}
-
-
def NumBox ftoa {} {
set f $@val
--- 3984,3987 ----
***************
*** 4790,4793 ****
--- 4786,4795 ----
############ class browser
+
+ class_new ServerClassDict {Observable Thing}
+ def ServerClassDict init {} {
+
+ }
+
# Completion/Browser init can be cleaned up a bit more, do it later...
class_new ClassBrowser {Dialog}
***************
*** 6354,6355 ****
--- 6356,6363 ----
error "Canvas deconstruct: that's a feature request"
}
+
+ #proc bgerror {err} {
+ # global errorInfo
+ # set info [error_dump]
+ # tk_messageBox -message "$err: $info" -type ok
+ #}
More information about the Pd-cvs
mailing list