[PD-cvs] pd/src desire.tk,1.1.2.600.2.143,1.1.2.600.2.144

chunlee chunlee at users.sourceforge.net
Thu Dec 28 08:51:58 CET 2006


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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
more on FindModel FindView


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.143
retrieving revision 1.1.2.600.2.144
diff -C2 -d -r1.1.2.600.2.143 -r1.1.2.600.2.144
*** desire.tk	28 Dec 2006 02:51:00 -0000	1.1.2.600.2.143
--- desire.tk	28 Dec 2006 07:51:54 -0000	1.1.2.600.2.144
***************
*** 1754,1761 ****
  		FindModel new_as findmodel $self
  		FindView new $self
  	}
  }
  def Canvas find_again {} {
! 	if {[info exists ::_(findmodel:_class)]} {findmodel search}
  }
  
--- 1754,1762 ----
  		FindModel new_as findmodel $self
  		FindView new $self
+ 		focus .$self.find.find
  	}
  }
  def Canvas find_again {} {
! 	if {[info exists ::_(findmodel:_class)]} {findmodel search_recursive}
  }
  
***************
*** 2852,2866 ****
  	set @orig_canvas $canvas
  	set @find_string ""
! 	set @find_break 0
! 	set @lastcanvas ""
  	set @result ""
! 	set @resultcanvas ""
  	set @views {}
  }
! def FindModel delete {} {
! 	foreach view $@views {destroy [$view widget]}
! 	super
  }
  
  def FindModel find_string= {s} {set @find_string $s}
  def FindModel find_string {} {return $@find_string}
--- 2853,2873 ----
  	set @orig_canvas $canvas
  	set @find_string ""
! 	set @next_canvases $canvas
! 	set @last_canvas 0
  	set @result ""
! 	set @results {}
  	set @views {}
+ 	set @recursive 1
  }
! 
! def FindModel reinit {} {
! 	set @next_canvases $@orig_canvas
! 	set @last_canvas 0
! 	set @result ""
! 	set @results {}
  }
  
+ def FindModel delete {} {foreach view $@views {destroy [$view widget]}; super}
+ 
  def FindModel find_string= {s} {set @find_string $s}
  def FindModel find_string {} {return $@find_string}
***************
*** 2873,2908 ****
  def FindModel views+ {view} {lappend @views $view} 
  def FindModel views {} {return $@views}
  
! def FindModel search {} {
! 	$self search_current
! 
  }
  
! def FindModel search_current {} {
! 	set children [$@orig_canvas children]
! 	if {$@result == ""} {set i 0} else {set i [expr [lsearch $children $@result]+1]}
! 	for {} {$i < [llength $children]} {incr i} {
! 		set child [lindex $children $i]
! 		if {[[$child class] <= TextBox]} {
! 			if {[string first $@find_string [$child text] 0] >= 0} {
! 				$self result= $child
! 				return 1
! 			}
  		}
  	}
! 	$self result= ""
! 	return 0
! 	
  }
  
- def FindModel search_recursive {} {
- 	set children [$@orig_canvas children]
- 	set canvas [$@orig_canvas get_nextchildcanvas $@lastcanvas]
- 	if {$canvas == ""} {set @lastcanvas ""} else {set @lastcanvas $canvas}
- }
  class_new FindView {FindModel} ;# no, using View is wrong here. View is for tk canvas item collections.
- 
  def FindView widget {} {return .$@canvas.find}
- 
  def FindView init {canvas} {
  	findmodel views+ $self
--- 2880,2924 ----
  def FindModel views+ {view} {lappend @views $view} 
  def FindModel views {} {return $@views}
+ def FindModel end? {} {return $@end}
+ def FindModel end= {v} {set @end 0}
  
! def FindModel search_recursive {} {
! 	if {![llength $@next_canvases]} {$self reinit; $self search_recursive; return}
! 	if {[llength $@results]} {$self result= [lindex $@results 0]; set @results [lreplace $@results 0 0];return}
! 	while {$@last_canvas < [llength $@next_canvases]} {
! 		set canvas [lindex $@next_canvases $@last_canvas]
! 		if {[$self cache_results $canvas]} {
! 			if {![winfo exists [$canvas widget]]} {$canvas popup_open} else {focus [$canvas widget]}
! 			$self result= [lindex $@results 0]
! 			set @results [lreplace $@results 0 0]
! 			incr @last_canvas
! 			return
! 		} else {
! 			incr @last_canvas
! 			$self search_recursive
! 			return
! 		}
! 	}
! 	set old_canvases $@next_canvases
! 	set @next_canvases {}
! 	foreach canvas $old_canvases {
! 		foreach x [$canvas get_childcanvas] {lappend @next_canvases $x}
! 	}
! 	set @last_canvas 0
! 	$self search_recursive
  }
  
! def FindModel cache_results {canvas} {
! 	set @results {}
! 	foreach child [$canvas children] {
! 		if {[string first $@find_string [$child text] 0] >= 0} {
! 			lappend @results $child
  		}
  	}
! 	if {[llength $@results]} {return 1} else {return 0}
  }
  
  class_new FindView {FindModel} ;# no, using View is wrong here. View is for tk canvas item collections.
  def FindView widget {} {return .$@canvas.find}
  def FindView init {canvas} {
  	findmodel views+ $self
***************
*** 2918,2922 ****
  	set string [findmodel find_string]
  	if {$string != ""} {$f.find insert 0 $string}
- 	focus $f.find
  }
  
--- 2934,2937 ----
***************
*** 2935,2938 ****
--- 2950,2954 ----
  		checkbutton {
  			checkbutton $f.$name
+ 			if {$name == "recursive"} {$f.$name configure -variable _(findmodel:recursive)}
  		}
  		button {
***************
*** 2948,2952 ****
  	set f [$self widget]
  	findmodel find_string= [$f.find get]
! 	findmodel search
  	focus .$@canvas.c
  }
--- 2964,2968 ----
  	set f [$self widget]
  	findmodel find_string= [$f.find get]
! 	findmodel search_recursive
  	focus .$@canvas.c
  }
***************
*** 2959,2974 ****
  
  def Canvas check_findbar {} {
! 	if {[info exists ::_(findmodel:_class)]} {FindView new $self}
  }
! #returns the next child that is a Canvas
! def Canvas get_nextchildcanvas {child} {
! 	if {$child != ""} {
! 		set i [expr [lsearch $@children $child]+1]
! 	} else {set i 0}
! 	for {} {$i < [llength $@children]} {incr i} {
! 		set child [lindex $@children $i]
! 		if {[$child class] == "Canvas"} {return $child; break}
! 	}
! 	
  }
  
--- 2975,2985 ----
  
  def Canvas check_findbar {} {
! 	if {[info exists ::_(findmodel:_class)] && ![winfo exists .$self.find.find]} {FindView new $self}
  }
! 
! def Canvas get_childcanvas {} {
! 	set canvases {}
! 	foreach child $@children {if {[$child class] == "Canvas"} {lappend canvases $child}}
! 	return $canvases
  }
  





More information about the Pd-cvs mailing list