pd/src desire.tk,1.1.2.600.2.137,1.1.2.600.2.138 - Pd-cvs

26 Dec 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22818
Modified Files:
      Tag: desiredata
    desire.tk 
Log Message:
preparing firefox style find widget
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.137
retrieving revision 1.1.2.600.2.138
diff -C2 -d -r1.1.2.600.2.137 -r1.1.2.600.2.138
*** desire.tk	24 Dec 2006 15:52:30 -0000	1.1.2.600.2.137
--- desire.tk	26 Dec 2006 17:28:02 -0000	1.1.2.600.2.138
***************
*** 1777,1783 ****
  def Canvas find_canvas= {canvas} {set @find_canvas $canvas}; #used for find in nested [pd]
  def Canvas find {} {
    $self find_break= 0
    $self find_canvas= $self
! 	FindDialog new_as find $self
  }
  def Canvas find_again {} {
--- 1777,1792 ----
  def Canvas find_canvas= {canvas} {set @find_canvas $canvas}; #used for find in nested [pd]
  def Canvas find {} {
+ 	set c [$self widget]
    $self find_break= 0
    $self find_canvas= $self
! 	#FindDialog new_as find $self
! 	if {[winfo exists .$self.yscroll]} {set w .$self.yscroll} else {set w .$self.c}
! 	if {[winfo exists .$self.find]} {
! 		focus .$self.find.text
! 	} else {
! 		set @findbar [FindBar new $self]
! 		pack [$@findbar widget] -side bottom -fill x -before $w
! 	}
! 
  }
  def Canvas find_again {} {
***************
*** 2863,2866 ****
--- 2872,2950 ----
  }
+ #-----------------------------------------------------------------------------------#
+ class_new FindBar {Thing} ;# no, using View is wrong here. View is for tk canvas item collections.
+ 
+ def FindBar widget {} {return .$@canvas.find}
+ 
+ def FindBar addw {type label args} {
+ 	set f [$self widget]
+ 	if {$label!=""} {
+ 		eval [concat [list pack [label $f.${type}_l -text $label -font {helvetica -10} -pady 0] -side left]]
+ 	}
+ 	switch $type {
+ 		text {
+ 			text $f.$type -height 1 -width 10 -relief flat -bg white -borderwidth 0 \
+ 			    -highlightthickness 0
+ 			pack $f.$type -side left
+ 			bind $f.$type <Escape> "$self remove"
+ 		}
+ 		checkbutton {
+ 			checkbutton $f.$type
+ 			pack $f.$type -side left
+ 		}
+ 		button {
+ 			button $f.$type -border 1 -command " $self remove" -bitmap gray75 -height 8 -width 8
+ 			pack $f.$type -side left
+ 		}
+ 	}
+ }
+ 
+ def FindBar remove {} {
+ 	set f [$self widget]
+ 	destroy $f
+ 	focus .$@canvas.c
+ }
+ 
+ def FindBar init {canvas} {
+ 	super
+ 	set @canvas $canvas
+ 	set f [$self widget]
+ 	frame $f -border 1 -relief ridge
+ 	$self addw text "Find:" ""
+ 	$self addw checkbutton "Recursive:" ""
+ 	$self addw button "Close" ""
+ 	focus $f.text
+ }
+ 
+ def FindBar draw {x y} {
+     if {$x == "??"} {return}
+     set c [$@canvas widget]
+     set f [$self widget]
+     set zoom [$@canvas zoom]
+     set x [expr [$c canvasx $x]/$zoom]
+     set y [expr [$c canvasy $y]/$zoom]
+     set tags [$c gettags [lindex [$c find overlapping \
+ 	[expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
+     set target [$@canvas identify_target $x $y -1]
+     mset {type id detail} $target
+     set t $target
+     switch -- $type {
+       object {
+ 	if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
+ 	append t " [$class]"
+       }
+     }
+     set action [$@canvas action]
+     if {[regexp ^o $action]} {set action [$action class]}
+     if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
+     $f.px     configure -text [format "%4d" [expr round($x)]]
+     $f.py     configure -text [format "%4d" [expr round($y)]]
+     $f.what   configure -text $t
+     $f.action configure -text $action
+     $f.sel    configure -text [llength [$@canvas selection]]
+     $f.focus  configure -text [$@canvas focus]
+ }
+ 
+ 
  def Canvas index {child} {
    # this could be O(1) if the proper database were maintained.