[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.42,1.1.1.4.2.7.4.43

[Mathieu Bouchard]

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

Modified Files:
      Tag: impd_0_37
	u_main.tk 
Log Message:
bugfix


Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.1.1.4.2.7.4.42
retrieving revision 1.1.1.4.2.7.4.43
diff -C2 -d -r1.1.1.4.2.7.4.42 -r1.1.1.4.2.7.4.43
*** u_main.tk	17 Apr 2004 06:04:01 -0000	1.1.1.4.2.7.4.42
--- u_main.tk	19 Apr 2004 02:30:48 -0000	1.1.1.4.2.7.4.43
***************
*** 825,833 ****
      set cy [$canvas canvasy $y]
      set edit 0; switch $_($self:mode) { edit { set edit 1 } }
-     pd [canvastosym $canvas] mouse $cx $cy $b $f \;
      foreach {type id} [identify_target $canvas $x $y $b $f "click"] {}
      switch $type {
        object {
! 	pd "$self click-on-object $id $cx $cy $b $f;"
  	if {$edit && [llength [$canvas bbox ${id}BASE]]} {
  	    set wire_from [list $cx $cy]
--- 825,833 ----
      set cy [$canvas canvasy $y]
      set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      foreach {type id} [identify_target $canvas $x $y $b $f "click"] {}
      switch $type {
        object {
! 	puts "$self click-on-object x$id $cx $cy $b $f;"
! 	pd "$self click-on-object x$id $cx $cy $b $f;"
  	if {$edit && [llength [$canvas bbox ${id}BASE]]} {
  	    set wire_from [list $cx $cy]
***************
*** 836,845 ****
  	        set outs 0
  		catch {set outs $_($id:outlets)}
! 		if {$outs==0} return
! 		set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! 	        foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
! 	        wire_draw lnew $canvas 1 $cx $cy $cx $cy
! 		$canvas itemconfigure lnew -dash "4 4 4 4"
! 		set wire_from [list $id $out]
  	    }
  	}
--- 836,847 ----
  	        set outs 0
  		catch {set outs $_($id:outlets)}
! 		if {$outs} {
! 			set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! 			foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
! 			wire_draw lnew $canvas 1 $cx $cy $cx $cy
! 			$canvas itemconfigure lnew -dash "4 4 4 4"
! 			set wire_from [list $id $out]
! 			return
! 		}
  	    }
  	}
***************
*** 847,856 ****
--- 849,861 ----
        wire {
  	pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;"
+ 	return
        }
      }
+     pd "[canvastosym $canvas] mouse $cx $cy $b $f ;"
  }
  
  set dehighlight {}
  set wire_from {}
+ set wire_to {}
  
  proc pdtk_canvas_motion {canvas x y mods} {
***************
*** 870,874 ****
      set current_x $cx
      set current_y $cy
-     pd [canvastosym $canvas] motion $x $y $mods \;
      foreach {type id} [identify_target $canvas $x $y -1 -1 "move "] {}
      switch $type {
--- 875,878 ----
***************
*** 888,891 ****
--- 892,896 ----
  		set dehighlight "$canvas delete ${id}i${port}b; set wire_to {}"
  		set wire_to [list $id $port]
+ 		return
  	    }
  	  } {
***************
*** 895,904 ****
  	        set ports 0
  		catch {set ports $_($id:outlets)}
! 		if {$ports==0} return
! 		set port [expr int(($cx-$x1)*$ports/($x2-$x1))]
! 		$canvas create rectangle \
! 			[l+ [$canvas coords ${id}o${port}] {-4 -4 +4 +4}] \
! 			-outline $look(outletfg) -width 1 -tags ${id}o${port}b
! 		set dehighlight "$canvas delete ${id}o${port}b"
  	    }
  	  }
--- 900,910 ----
  	        set ports 0
  		catch {set ports $_($id:outlets)}
! 		if {$ports} {
! 			set port [expr int(($cx-$x1)*$ports/($x2-$x1))]
! 			$canvas create rectangle \
! 				[l+ [$canvas coords ${id}o${port}] {-4 -4 +4 +4}] \
! 				-outline $look(outletfg) -width 1 -tags ${id}o${port}b
! 			set dehighlight "$canvas delete ${id}o${port}b"
! 		}
  	    }
  	  }
***************
*** 919,923 ****
--- 925,931 ----
  	lappend l $cx $cy
  	$canvas coords lnew $l
+ 	return
      }
+     pd "[canvastosym $canvas] motion $x $y $mods ;"
  }
  
***************
*** 934,942 ****
      global pdtk_canvas_mouseup wire_from wire_to
      set self [canvastosym $name]
-     pd "$self mouseup [$name canvasx $x] [$name canvasy $y] $b ;"
      if {[llength $wire_from]} {
! 	pd "$self add-wire $wire_from $wire_to ;"
  	set wire_from {}
      }
      set size [$name bbox all]
      if {$size != ""} {
--- 942,956 ----
      global pdtk_canvas_mouseup wire_from wire_to
      set self [canvastosym $name]
      if {[llength $wire_from]} {
!         if {[llength $wire_to]} {
! 		pd "$self add-wire $wire_from $wire_to ;"
! 	}
  	set wire_from {}
+ 	set wire_to {}
+ 	$name delete lnew
+ 	#return
      }
+     pd "$self mouseup [$name canvasx $x] [$name canvasy $y] $b ;"
+ 
      set size [$name bbox all]
      if {$size != ""} {
***************
*** 961,966 ****
      }
      pdtk_canvas_checkgeometry [canvastosym $name]
-     set canvas $name
-     if {[llength [$canvas gettags lnew]]} {$canvas delete lnew}
  }
  
--- 975,978 ----
***************
*** 1276,1290 ****
  }
  
! proc pdtk_gatom_dialog {id initwidth initlo inithi \
! wherelabel label symfrom symto} {
      global _
      set self [string trimleft $id .]
!     set _($self:width) $initwidth
!     set _($self:lo) $initlo
!     set _($self:hi) $inithi
      set _($self:wherelabel) $wherelabel
!     set _($self:label) [gatom_unescape $label]
      set _($self:symfrom) [gatom_unescape $symfrom]
!     set _($self:symto) [gatom_unescape $symto]
      toplevel $id
      wm title $id "Atom"
--- 1288,1301 ----
  }
  
! proc pdtk_gatom_dialog {id width lo hi wherelabel label symfrom symto} {
      global _
      set self [string trimleft $id .]
!     set _($self:width) $width
!     set _($self:lo) $lo
!     set _($self:hi) $hi
      set _($self:wherelabel) $wherelabel
!     set _($self:label)   [gatom_unescape $label]
      set _($self:symfrom) [gatom_unescape $symfrom]
!     set _($self:symto)   [gatom_unescape $symto]
      toplevel $id
      wm title $id "Atom"
***************
*** 2224,2228 ****
  proc tcl_eval {} {
  	set l [.tcl.entry get]
! 	post_to_gui "tcl: $l\nreturns: [eval $l]\n"
  	listener_append .tcl [.tcl.entry get]
  	.tcl.entry delete 0 end
--- 2235,2239 ----
  proc tcl_eval {} {
  	set l [.tcl.entry get]
! 	post "tcl: $l\nreturns: [eval $l]"
  	listener_append .tcl [.tcl.entry get]
  	.tcl.entry delete 0 end
***************
*** 2231,2237 ****
  global cmdline
  after 1 {
! if {$cmdline(console) != 0} {
  	listener_new .tcl "Tcl" {tcl_eval}
! }}
  
  ############ button bar
--- 2242,2249 ----
  global cmdline
  after 1 {
! #    if {$cmdline(console) != 0} {
  	listener_new .tcl "Tcl" {tcl_eval}
! #    }
! }
  
  ############ button bar