[PD-cvs] pd/src desire.c, 1.1.2.104, 1.1.2.105 desire.tk, 1.1.2.359, 1.1.2.360

Mathieu Bouchard matju at users.sourceforge.net
Fri Aug 18 01:14:40 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.c desire.tk 
Log Message:
some fixes.


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.359
retrieving revision 1.1.2.360
diff -C2 -d -r1.1.2.359 -r1.1.2.360
*** desire.tk	17 Aug 2006 03:22:05 -0000	1.1.2.359
--- desire.tk	17 Aug 2006 23:14:38 -0000	1.1.2.360
***************
*** 38,41 ****
--- 38,50 ----
  package require objective
  
+ catch {
+ 	set cmds [info commands]
+ 	puts "Tclx version [package require Tclx]"
+ 	set cmds [lsort [lwithout [info commands] $cmds]]
+ 	puts "Tclx has got $cmds"
+ }
+ 
+ #catch {source profdd.tcl}
+ 
  proc which {file} {
  	global env
***************
*** 172,176 ****
  	#if {[llength $@q]} {post "client queue %d" [llength $@q]}
  	foreach o $@q {
! 		post %s "$o: $poolset($o)"
  		unset poolset($o)
  		$o draw
--- 181,185 ----
  	#if {[llength $@q]} {post "client queue %d" [llength $@q]}
  	foreach o $@q {
! 		#post %s "Manager: $o: $poolset($o)"
  		unset poolset($o)
  		$o draw
***************
*** 676,679 ****
--- 685,689 ----
  		set sock_lobby {}
  	}
+ 	flush $sock
  	after 50 poll_sock
  }
***************
*** 988,992 ****
  	set s [join $args " "]
  	puts $sock "$s;"
! 	flush $sock
  	puts "<- $s;"
  }
--- 998,1002 ----
  	set s [join $args " "]
  	puts $sock "$s;"
! 	#flush $sock
  	puts "<- $s;"
  }
***************
*** 1014,1018 ****
  	set @duplicate 0
  	set @ioselect {}
- 	super
  }
  
--- 1024,1027 ----
***************
*** 1320,1323 ****
--- 1329,1334 ----
  	foreach w $window_list {if {$w != $self} {lappend wl $w}}
  	set window_list $wl
+ 	super
+ 	destroy .$self
  }
  
***************
*** 1555,1559 ****
  	super
  	set @edit 0
- 	set @valid 0
  }
  
--- 1566,1569 ----
***************
*** 1652,1656 ****
  def ObjectBox init {args} {
  	super
! 	set @valid 0
  	set @ninlets 0
  	set @noutlets 0
--- 1662,1666 ----
  def ObjectBox init {args} {
  	super
! 	set @valid 0 ;# only ObjectBox needs a @valid. (removed all others)
  	set @ninlets 0
  	set @noutlets 0
***************
*** 1781,1785 ****
  	  set find [lsearch $@wires_pair $x]
  	  if {$find == -1} {# new wire!!!
! 	    if {[info exists _($obj1:valid)] & [info exists _($obj2:valid)]} {
  	      lappend @wires_pair [list $outobj $outport $inobj $inport]
  	      set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
--- 1791,1795 ----
  	  set find [lsearch $@wires_pair $x]
  	  if {$find == -1} {# new wire!!!
! 	    if {[info exists _($obj1:_class)] && [info exists _($obj2:_class)]} {
  	      lappend @wires_pair [list $outobj $outport $inobj $inport]
  	      set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
***************
*** 3015,3021 ****
  	  set _class ObjectBox
  	  # this is not the same @isnew as $isnew !
! 	  # in the future, both @isnew and @valid should go elsewhere or disappear
  	  set _($self:isnew) [expr [llength $mess] == 4]
- 	  set _($self:valid) 0
  	}
  	if {$isnew} {$_class new_as $self}
--- 3025,3030 ----
  	  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}
***************
*** 3055,3074 ****
  	global canvas _
  	set c $canvas(current)
! 	set unborn_child [lsearch $_($c:unborn) $self]
! 	if {$unborn_child > -1} {
! 		$self canvas= $c
! 		$self subscribe $c
! 		$self changed
! 		if {$unborn_child == [expr [llength $_($c:unborn)] - 1]} {
! 			# when it reachs the last unborn child, its time to draw the wires
! 			# the end of duplication
! 			#puts "### at $self, [llength $_($c:unborn)] unborn children: $_($c:unborn)"
! 			set _($c:unborn) ""
! 			if {[info exists _($c:unborn_wire)]} {
! 				#puts "time to draw wires ----- $_($c:unborn_wire)"
! 				$c wires= $_($c:unborn_wire)
! 				#set _($c:unborn_wire) ""
! 				unset _($c:unborn_wire)
! 			}
  		}
  	}
--- 3064,3078 ----
  	global canvas _
  	set c $canvas(current)
! 	set unborn_children [lsearch $_($c:unborn) $self]
! 	if {$unborn_children<0} {return}
! 	$self canvas= $c
! 	$self subscribe $c
! 	$self changed
! 	if {$unborn_children == [expr [llength $_($c:unborn)] - 1]} {
! 		# when it reaches the last unborn child, its time to draw the wires
! 		set _($c:unborn) ""
! 		if {[info exists _($c:unborn_wire)]} {
! 			$c wires= $_($c:unborn_wire)
! 			unset _($c:unborn_wire)
  		}
  	}
***************
*** 3081,3085 ****
  def MessageBox init {args} {
  	super
- 	set @valid 0
  	set @w 15
  	set @xs $@w
--- 3085,3088 ----
***************
*** 3441,3445 ****
  	set @val 0
  	set @old_val 0
- 	set @valid 0
  	set @clickpos {}
  	set @key_input 0
--- 3444,3447 ----
***************
*** 3581,3585 ****
  	set @buf ""
  	set @text 0
- 	set @valid 0
  	set @key_input 0
  }
--- 3583,3586 ----
***************
*** 3736,3743 ****
  
  class_new Radio {BlueBox}
- def Radio init {} {
- 	super
- 	set @valid 0
- }
  
  def Radio orient {} {
--- 3737,3740 ----
***************
*** 3800,3804 ****
  def Slider init {args} {
  	super
- 	set @valid 0
  	set @clicking 0
  	set @value 0
--- 3797,3800 ----
***************
*** 3914,3918 ****
  def Bang init {args} {
  	super
- 	set @valid 0
  	set @w 15
  	set @flash 0
--- 3910,3913 ----
***************
*** 3958,3962 ****
  def Toggle init {args} {
  	super
- 	set @valid 0
  	set @on 0
  	set @w 15
--- 3953,3956 ----
***************
*** 4177,4186 ****
  proc post {args} {
  	global cmdline
  	if {$cmdline(console)} {
! 		post_to_gui [eval [linsert $args 0 format]]
! 		post_to_gui "\n"
  	} else {
! 		puts stderr [eval [linsert $args 0 format]]
! 		puts stderr "\n"
  	}
  }
--- 4171,4180 ----
  proc post {args} {
  	global cmdline
+ 	set s "[eval [linsert $args 0 format]]\n"
+ #	set s "[info level -1]: $s"
  	if {$cmdline(console)} {
! 		post_to_gui $s
  	} else {
! 		puts stderr $s
  	}
  }

Index: desire.c
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.c,v
retrieving revision 1.1.2.104
retrieving revision 1.1.2.105
diff -C2 -d -r1.1.2.104 -r1.1.2.105
*** desire.c	16 Aug 2006 23:09:18 -0000	1.1.2.104
--- desire.c	17 Aug 2006 23:14:37 -0000	1.1.2.105
***************
*** 307,317 ****
  static void canvas_takeofflist(t_canvas *x)
  {
-         /* take it off the window list */
      if (x == canvas_list) canvas_list = x->gl_next;
!     else
!     {
          t_canvas *z;
!         for (z = canvas_list; z->gl_next != x; z = z->gl_next)
!             ;
          z->gl_next = x->gl_next;
      }
--- 307,314 ----
  static void canvas_takeofflist(t_canvas *x)
  {
      if (x == canvas_list) canvas_list = x->gl_next;
!     else {
          t_canvas *z;
!         for (z = canvas_list; z->gl_next != x; z = z->gl_next) {}
          z->gl_next = x->gl_next;
      }
***************
*** 943,946 ****
--- 940,944 ----
      while ((y = x->gl_list)) glist_delete(x, y);
      canvas_vis(x, 0);
+     sys_mgui(x,"_delete","");
  
      if (strcmp(x->gl_name->s_name, "Pd"))





More information about the Pd-cvs mailing list