[PD-cvs] pd/src desire.tk,1.1.2.260,1.1.2.261

[Mathieu Bouchard]

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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
added ClientClassTreeDialog


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.260
retrieving revision 1.1.2.261
diff -C2 -d -r1.1.2.260 -r1.1.2.261
*** desire.tk	21 Jun 2006 11:46:45 -0000	1.1.2.260
--- desire.tk	23 Jun 2006 06:33:27 -0000	1.1.2.261
***************
*** 421,424 ****
--- 421,426 ----
  set key(popup_help) ""
  set key(popup_open) ""
+ set key(client_class_tree) "Ctrl+grave"
+ 
  set accels {}
  ################## set up main window #########################
***************
*** 1040,1043 ****
--- 1042,1046 ----
  	{about {} ""}
  	{class_browser {} ""}
+ 	{client_class_tree {} ""}
      }
  }
***************
*** 5227,5233 ****
  def ClientPrefsDialog _delete {} {super}
  
- 
  ############ other stuff #########
  
  #c proc updatesel {_ sel} {
  #c   variable ""
--- 5230,5298 ----
  def ClientPrefsDialog _delete {} {super}
  
  ############ other stuff #########
  
+ def Client client_class_tree {} {ClientClassTreeDialog new}
+ class_new ClientClassTreeDialog {Dialog}
+ def ClientClassTreeDialog cancel {} {destroy .$self}
+ 
+ proc* place_stuff {args} {}
+ 
+ def ClientClassTreeDialog make_row {w tree} {
+ 	pack [frame $w] -fill x
+ 	pack [frame $w.row] -side top -fill x
+ 	pack [button $w.row.butt -image icon_minus] -side left
+ 	pack [label $w.row.label -text [lindex $tree 0]] -side left -fill x
+ 	pack [frame $w.dent -width 32] -side left
+ 	set i 1
+ 	foreach node [lrange $tree 1 end] {
+ 		$self make_row $w.$i $node
+ 		incr i
+ 	}
+ }
+ 
+ def ClientClassTreeDialog init {} {
+ 	super
+ 	pack [frame .$self.1   -width 600 -height 400] -fill y -expand y
+ 	pack [frame .$self.1.1 -width 600 -height 400 -bg "#6688aa"] -side left -fill y -expand y
+ 	# "$w.1.scroll set"
+ 	# i'd like a scrollable frame
+ 	pack [scrollbar .$self.1.scroll \
+ 		-command "ClientClassTreeDialog_scroll $self"] -side left -fill y -expand y
+ 	place [frame .$self.1.1.tree] -x 0 -y 0
+ 	set w .$self.1.1.tree.1
+ 	$self make_row $w [Thing get_hierarchy]
+ 	after 100 "$self update_scrollbar"
+ }
+ 
+ def ClientClassTreeDialog update_scrollbar {} {
+ 	set w .$self.1.1
+ 	set zy [winfo height $w]
+ 	set sy [winfo height $w.tree]
+ 	set y1 [expr   0.0-[winfo y $w.tree]]
+ 	set y2 [expr $y1+$zy]
+ 	puts "sy=$sy y1=$y1 y2=$y2"
+ 	.$self.1.scroll set [expr $y1/$sy] [expr $y2/$sy]
+ 	puts ".$self.1.scroll set [expr $y1/$sy] [expr $y2/$sy]"
+ }
+ 
+ def* ClientClassTreeDialog scroll {args} {
+ 	set w .$self.1.1
+ 	set zy [winfo height $w]
+ 	set sy [winfo height $w.tree]
+ 	set y1 [expr   0.0-[winfo y $w.tree]]
+ 	set y2 [expr $y1+$zy]
+ 	switch [lindex $args 0] {
+ 		moveto {
+ 			set f [lindex $args 1]
+ 			set y [expr (0.0-$f)*$sy]
+ 			place .$self.1.1.tree -x 0 -y $y
+ 			puts $y
+ 		}
+ 		scroll {
+ 
+ 		}
+ 	}
+ }
+ 
  #c proc updatesel {_ sel} {
  #c   variable ""
***************
*** 5245,5248 ****
--- 5310,5319 ----
    foreach sub $@subclasses {$sub post_hierarchy [expr $i+1]}
  }
+ def Class get_hierarchy {} {
+   set l [list $self]
+   foreach sub $@subclasses {lappend l [$sub get_hierarchy]}
+   return $l
+ }
+ 
  Thing post_hierarchy