Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv346
Modified Files: Tag: devel_0_39 desire.tk Log Message: added tooltip for the pdrc editor
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.163 retrieving revision 1.1.2.164 diff -C2 -d -r1.1.2.163 -r1.1.2.164 *** desire.tk 16 Apr 2006 17:08:59 -0000 1.1.2.163 --- desire.tk 19 Apr 2006 00:57:53 -0000 1.1.2.164 *************** *** 3375,3380 **** proc properties_dialog {self w ok struct} { global _ foreach {name label type options} $struct { ! set f $w.$name switch -- $type { side { --- 3375,3385 ---- proc properties_dialog {self w ok struct} { global _ + #set label_width 0 + #foreach {name label type options} $struct { + # set label_w [string length $label] + # if {$label_w > $label_width} {set label_width $label_w} + #} foreach {name label type options} $struct { ! set f $w.$name switch -- $type { side { *************** *** 3429,3433 **** --- 3434,3449 ---- default { frame $f + #label $f.label -text $label -wraplength 200 -justify left + + set length [string length $label] + set break [string first ":" $label 0] + #puts "$label | $length | $break" + #puts "$label | $name" + #set tip [string $label 0 $break] + #set real_label [string $label $break end] + #puts "$tip <> $real_label" + label $f.label -text $label + balloon $f.label $name pack $f.label -side left eval "entry $f.entry -textvariable _($self:$name) $options" *************** *** 3451,3455 **** } pack $f -side top -fill x ! catch {$f.label configure -width 15 -anchor e} } } --- 3467,3471 ---- } pack $f -side top -fill x ! catch {$f.label configure -width 45 -anchor nw} } } *************** *** 3457,3460 **** --- 3473,3500 ---- ############ .pdrc editor
+ # this makes the tooltip + proc balloon {w help} { + bind $w <Any-Enter> "after 1000 [list balloon:show %W [list $help]]" + bind $w <Any-Leave> "destroy %W.balloon" + } + proc balloon:show {w arg} { + if {[eval winfo containing [winfo pointerxy .]]!=$w} {return} + set top $w.balloon + catch {destroy $top} + toplevel $top -bd 1 -bg black + wm overrideredirect $top 1 + if {$::tcl_platform(platform) == "macintosh"} { + unsupported1 style $top floating sideTitlebar + } + pack [message $top.txt -aspect 10000 -bg lightyellow \ + -font fixed -text $arg] + set wmx [winfo rootx $w] + set wmy [expr [winfo rooty $w]+[winfo height $w]] + wm geometry $top \ + [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy + raise $top + } + + # this proc might be obsolete proc cancel_apply_ok {self procprefix} { *************** *** 3472,3476 **** section "" "Audio DSP" integer -r "sample rate" ! devlist -soundindev|-audioindev "audio in devices" devlist -soundoutdev|-audiooutdev "audio out devices" alias -sounddev|-audiodev {list -soundindev %1 -soundoutdev %1} --- 3512,3516 ---- section "" "Audio DSP" integer -r "sample rate" ! devlist -soundindev|-audioindev "audio in devices" devlist -soundoutdev|-audiooutdev "audio out devices" alias -sounddev|-audiodev {list -soundindev %1 -soundoutdev %1} *************** *** 3614,3618 **** section { incr section ! frame .$self.1.main.$section -width 600 button .$self.1.bar.$section -text $desc \ -command [list notebook_select $self.1 $section] --- 3654,3658 ---- section { incr section ! frame .$self.1.main.$section button .$self.1.bar.$section -text $desc \ -command [list notebook_select $self.1 $section] *************** *** 3625,3630 **** } default { properties_dialog $self .$self.1.main.$section pdrc_editor_ok \ ! [list $name "$name: $desc" $type {}] } } --- 3665,3672 ---- } default { + #properties_dialog $self .$self.1.main.$section pdrc_editor_ok \ + # [list $name "$name: $desc" $type {}] properties_dialog $self .$self.1.main.$section pdrc_editor_ok \ ! [list $name $desc $type {}] } }