pd/src desire.tk,1.1.2.535,1.1.2.536 - Pd-cvs

30 Oct 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9319
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
fixed bug when clicking messageboxes with Tcl 8.5
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.535
retrieving revision 1.1.2.536
diff -C2 -d -r1.1.2.535 -r1.1.2.536
*** desire.tk	30 Oct 2006 00:03:59 -0000	1.1.2.535
--- desire.tk	30 Oct 2006 02:36:05 -0000	1.1.2.536
***************
*** 676,680 ****
proc accept_pd {s addr port} {
! 	global sock canvas
    if {[llength $sock]==0} {
    	set sock $s
--- 676,680 ----
proc accept_pd {s addr port} {
! 	global sock
    if {[llength $sock]==0} {
    	set sock $s
***************
*** 790,794 ****
def Client open_file_really {filename} {
!     global pd_opendir font canvas
      set i [string last / $filename]
      set folder [string range $filename 0 [expr $i-1]]
--- 790,794 ----
def Client open_file_really {filename} {
!     global pd_opendir font
      set i [string last / $filename]
      set folder [string range $filename 0 [expr $i-1]]
***************
*** 1361,1365 ****
def Canvas init {mess} {
!     global pd_opendir pd_tearoff OS cmdline canvas history manager window_list
      lappend window_list $self
      set @mapped 0
--- 1361,1365 ----
def Canvas init {mess} {
!     global pd_opendir pd_tearoff OS cmdline history manager window_list
      lappend window_list $self
      set @mapped 0
***************
*** 2251,2255 ****
  # should be only called from the server
  def Canvas wires= {wires2} {
! 	global canvas clipboard
    set wires {}
    foreach x $wires2 {
--- 2251,2255 ----
  # should be only called from the server
  def Canvas wires= {wires2} {
! 	global clipboard
    set wires {}
    foreach x $wires2 {
***************
*** 2406,2410 ****
def Canvas motion {x y f target} {
! 	global font canvas tooltip crosshair
    set c [$self widget]
    $self motion_checkhairtip $target $x $y
--- 2406,2410 ----
def Canvas motion {x y f target} {
! 	global font tooltip crosshair
    set c [$self widget]
    $self motion_checkhairtip $target $x $y
***************
*** 2902,2906 ****
  }
  def FutureWire draw {} {
! 	$self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
  }
--- 2902,2906 ----
  }
  def FutureWire draw {} {
! 	$self item WIRE line [xys $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
  }
***************
*** 3848,3851 ****
--- 3848,3852 ----
  def Wire connects {} {return $@connects}
  proc xys {x1 y1 x2 y2} {
+ 	return [list $x1 $y1 $x2 $y2] ;# just a straight line, no frills
    set r {}
    lappend r $x1 $y1
***************
*** 3875,3879 ****
    set x2 [expr $ix1 + ($iowidth/2)]
    set y2 $iy1
! 	set xys [list $x1 $y1 $x2 $y2]
    set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
    # how to customise the arrow size/shape?
--- 3876,3880 ----
    set x2 [expr $ix1 + ($iowidth/2)]
    set y2 $iy1
! 	set xys [xys $x1 $y1 $x2 $y2]
    set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
    # how to customise the arrow size/shape?
***************
*** 4118,4123 ****
def MessageBox bang {flag} {
! 	[$@canvas widget] itemconfigure ${self}BASE -fill \
! 	    [if {$flag} {list #ffff00} {list [$self look bg]}]
  }
--- 4119,4124 ----
def MessageBox bang {flag} {
! 	if {$flag} {set color #ffff00} {set color [$self look bg]}
! 	[$@canvas widget] itemconfigure ${self}BASE -fill $color
  }