[PD-cvs] pd/src desire.tk,1.1.2.472,1.1.2.473

[Mathieu Bouchard]

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