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 + #}