[PD-cvs] pd/src desire.tk,1.1.2.587,1.1.2.588

[chunlee]

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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
various fixes for pasting objects


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.587
retrieving revision 1.1.2.588
diff -C2 -d -r1.1.2.587 -r1.1.2.588
*** desire.tk	23 Nov 2006 23:20:56 -0000	1.1.2.587
--- desire.tk	24 Nov 2006 00:31:48 -0000	1.1.2.588
***************
*** 1072,1076 ****
  	if {![winfo exists $c]} {
  		set canvas [$@canvas get_canvas]
! 		if {$canvas == "none"} {return}
  		set c [[$canvas get_canvas] widget]
  		if {![winfo exists $c]} {return}
--- 1072,1076 ----
  	if {![winfo exists $c]} {
  		set canvas [$@canvas get_canvas]
! 		if {$canvas == "none" || $canvas == ""} {return}
  		set c [[$canvas get_canvas] widget]
  		if {![winfo exists $c]} {return}
***************
*** 2092,2095 ****
--- 2092,2098 ----
  }
  
+ def Canvas wire_id {wire} {
+ 	set idx [lsearch $@wires_pare $wire]
+ }
  def ObjectBox draw_box {} {
  	global font
***************
*** 2165,2169 ****
  def Canvas folder {} {return $@folder}
  def Canvas name=   {name}    {if {!$@mapped} {return}; set @name   $name  ; $self update_title}
! def Canvas folder= {folder}  {if {!$@mapped} {return}; set @folder $folder; $self update_title}
  def Canvas make_title {} {
  	if {!$@mapped} {return}
--- 2168,2176 ----
  def Canvas folder {} {return $@folder}
  def Canvas name=   {name}    {if {!$@mapped} {return}; set @name   $name  ; $self update_title}
! def Canvas folder= {folder}  {
! 	global paste
! 	if {!$@mapped} {return}; set @folder $folder; $self update_title
! 	if {$self == $paste(state)} {$self done_paste}
! }
  def Canvas make_title {} {
  	if {!$@mapped} {return}
***************
*** 2714,2727 ****
  
  def Canvas do_paste {offset} {
  	pd .$self push
  	foreach mess [pd_mess_split [$::clipboard value]] {
! 		if {[lindex $mess 1] == "connect"} {
! 			mset {from outlet to inlet} [lrange $mess 2 end]
! 			set count [llength $@children]
! 			set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet]
! 			pd $mess2
  			
- 		} else {
- 			pd $mess
  		}
  	}
--- 2721,2750 ----
  
  def Canvas do_paste {offset} {
+ 	global paste
+ 	set @obj_count 0; set @wire_count 0
+ 	set in 0
+ 	foreach mess [pd_mess_split [$::clipboard value]] {
+ 		set type [lindex $mess 1]
+ 		switch $type {connect {} restore {} default {if {$type != ""} {incr paste(count)}}}
+ 	}
  	pd .$self push
+ 	set paste(state) $self
  	foreach mess [pd_mess_split [$::clipboard value]] {
! 		set type [lindex $mess 1]
! 		switch $type {
! 			canvas {set in 1; pd $mess}
! 			connect {
! 				mset {from outlet to inlet} [lrange $mess 2 end]
! 				set count [llength $@children]
! 				set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet]
! 				if {$in} {pd $mess} else {pd $mess2; if {$type != ""} {incr @wire_count}}
! 			}
! 			default {
! 				if {$type == "restore"} {set in 0}
! 				mset {x y} [lmap + [lrange $mess 2 3] $offset]
! 				set mess2 [lreplace $mess 2 3 $x $y]
! 				if {$in} {pd $mess} else {pd $mess2; if {$type != ""} {incr @obj_count}}
! 			} 
  			
  		}
  	}
***************
*** 2729,2732 ****
--- 2752,2763 ----
  }
  
+ def Canvas done_paste {} {
+ 	global paste
+ 	$self deselect_all
+ 	$self selection= [lrange $@children [expr [llength $@children] - $@obj_count] end]
+ 	$self selection_wire= [lrange $@wires [expr [llength $@wires] - $@wire_count] end]
+ 	set paste(state) 0
+ }
+ 
  def Canvas do_paste_oldstyle {offset} {
  	global clipboard subpatcherize
***************
*** 4157,4161 ****
--- 4188,4200 ----
  #X array array1 1 float 3;
  #A 0 0;
+ 
+ #state is 0 when not pasting, its the canvas id if it is
+ set paste(state) 0
+ set paste(count) 0
+ set paste(count2) 0
+ 
  proc update_object {self e ninlets noutlets} {
+ 	global paste
+ 	if {$paste(state) != "0"} {pasting_count $self}
  	foreach mess [pd_mess_split $e] {update_object_2 $self $mess}
  	if {[lindex $e 1] == "array"} {
***************
*** 4170,4174 ****
  
  proc update_object_2 {self mess} {
! 	global _ classinfo canvas
  	set isnew [expr ![info exists _($self:_class)]]
  	switch -- [lindex $mess 0] {
--- 4209,4213 ----
  
  proc update_object_2 {self mess} {
! 	global _ classinfo canvas paste
  	set isnew [expr ![info exists _($self:_class)]]
  	switch -- [lindex $mess 0] {
***************
*** 4215,4218 ****
--- 4254,4262 ----
  }
  
+ proc pasting_count {self} {
+ 	global paste _
+ 	if {$paste(count2) != $paste(count)} {incr paste(count2)}
+ }
+ 
  # split at message boundaries.
  # \n is wiped, then that character is reused temporarily to mean a quoted semicolon.