Attachment "tooltip.tcl.patch" to
ticket [1547729fff]
added by
mbroeken
2006-08-29 14:04:24.
Index: modules/tooltip/tooltip.tcl
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/tooltip/tooltip.tcl,v
retrieving revision 1.6
diff -r1.6 tooltip.tcl
121,141c121,145
< default {
< set i $w
< if {[llength $args]} {
< set i [uplevel 1 [namespace code "register [list $w] $args"]]
< }
< set b $G(TOPLEVEL)
< if {![winfo exists $b]} {
< toplevel $b -class Tooltip
< if {[tk windowingsystem] eq "aqua"} {
< ::tk::unsupported::MacWindowStyle style $b help none
< } else {
< wm overrideredirect $b 1
< }
< catch {wm attributes $b -topmost 1}
< wm positionfrom $b program
< wm withdraw $b
< label $b.label -highlightthickness 0 -relief solid -bd 1 \
< -background lightyellow -fg black
< pack $b.label -ipadx 1
< }
< if {[info exists tooltip($i)]} { return $tooltip($i) }
---
> default {
> set i $w
> if {[llength $args]} {
> set i [uplevel 1 [namespace code "register [list $w] $args"]]
> }
> set b $G(TOPLEVEL)
> if {![winfo exists $b]} {
> toplevel $b -class Tooltip
> if {[tk windowingsystem] eq "aqua"} {
> ::tk::unsupported::MacWindowStyle style $b help none
> } else {
> wm overrideredirect $b 1
> }
> catch {wm attributes $b -topmost 1}
> wm positionfrom $b program
> wm withdraw $b
> label $b.label -highlightthickness 0 -relief solid -bd 1 -background lightyellow -fg black
> pack $b.label -ipadx 1
> }
> ## If the cursor is on $w the Tooltip should be shown
> if {[llength $args] && ([winfo containing [winfo pointerx .] [winfo pointery .]] eq $w)} {
> event generate $w <Enter>
> }
> if {[info exists tooltip($i)]} { return $tooltip($i) }
> }
143d146
< }
206,215c209,224
< variable tooltip
< foreach w [array names tooltip $pattern] {
< unset tooltip($w)
< if {[winfo exists $w]} {
< set tags [bindtags $w]
< if {[set i [lsearch -exact $tags "Tooltip"]] != -1} {
< bindtags $w [lreplace $tags $i $i]
< }
< ## We don't remove TooltipMenu because there
< ## might be other indices that use it
---
> variable G
> variable tooltip
> foreach w [array names tooltip $pattern] {
> unset tooltip($w)
> if {[winfo exists $w]} {
> set tags [bindtags $w]
> if {[set i [lsearch -exact $tags "Tooltip"]] != -1} {
> bindtags $w [lreplace $tags $i $i]
> }
> ## We don't remove TooltipMenu because there
> ## might be other indices that use it
> }
> ## If the cursor is on $w the Tooltip should be withdrawn
> if {[winfo containing [winfo pointerx .] [winfo pointery .]] eq $w} {
> catch {wm withdraw $G(TOPLEVEL)}
> }
217d225
< }
