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