Tk Library Source Code

Artifact [399e5a824c]
Login

Artifact 399e5a824c19d0b0a5e30ca513c34fb5a8658029ece5f5192c2b9d17a0ef1273:

Attachment "tooltip.diff" to ticket [8c50f12d26] added by emiliano 2022-05-05 11:24:25. (unpublished)
Index: modules/tooltip/pkgIndex.tcl
==================================================================
--- modules/tooltip/pkgIndex.tcl
+++ modules/tooltip/pkgIndex.tcl
@@ -1,4 +1,4 @@
 # -*- tcl -*-
 
-package ifneeded tooltip  1.4.7 [list source [file join $dir tooltip.tcl]]
+package ifneeded tooltip  1.5   [list source [file join $dir tooltip.tcl]]
 package ifneeded tipstack 1.0.1 [list source [file join $dir tipstack.tcl]]

Index: modules/tooltip/tooltip.tcl
==================================================================
--- modules/tooltip/tooltip.tcl
+++ modules/tooltip/tooltip.tcl
@@ -44,12 +44,12 @@
 # <widget> ?-index index? ?-items id? ?-tag tag? ?message?
 #	If -index is specified, then <widget> is assumed to be a menu
 #	and the index represents what index into the menu (either the
 #	numerical index or the label) to associate the tooltip message with.
 #	Tooltips do not appear for disabled menu items.
-#	If -item is specified, then <widget> is assumed to be a listbox
-#	or canvas and the itemId specifies one or more items.
+#	If -item is specified, then <widget> is assumed to be a listbox,
+#	treeview or canvas and the itemId specifies one or more items.
 #	If -tag is specified, then <widget> is assumed to be a text
 #	and the tagId specifies a tag.
 #	If message is {}, then the tooltip for that widget is removed.
 #	The widget must exist prior to calling tooltip.  The current
 #	tooltip message for <widget> is returned, if any.
@@ -192,11 +192,12 @@
 		}
 		set index [lindex $args 1]
 		set args [lreplace $args 0 1]
 	    }
 	    -item - -items {
-                if {[winfo class $w] eq "Listbox"} {
+                if {[winfo class $w] eq "Listbox" ||
+		    [winfo class $w] eq "Treeview"} {
                     set items [lindex $args 1]
                 } else {
                     set namedItem [lindex $args 1]
                     if {[catch {$w find withtag $namedItem} items]} {
                         return -code error "widget \"$w\" is not a canvas, or\
@@ -235,11 +236,12 @@
 	    set tooltip($w,$index) $key
 	    return $w,$index
 	} elseif {[info exists items]} {
 	    foreach item $items {
 		set tooltip($w,$item) $key
-		if {[winfo class $w] eq "Listbox"} {
+		set class [winfo class $w]
+		if { $class eq "Listbox" || $class eq "Treeview"} {
 		    enableListbox $w $item
 		} else {
 		    enableCanvas $w $item
 		}
 	    }
@@ -416,23 +418,36 @@
 proc ::tooltip::listitemTip {w x y} {
     variable tooltip
     variable G
 
     set G(LAST) -1
-    set item [$w index @$x,$y]
+    if {[winfo class $w] eq "Listbox"} {
+	set item [$w index @$x,$y]
+    } else {
+	set item [$w identify item $x $y]
+    }
     if {$G(enabled) && [info exists tooltip($w,$item)]} {
 	set G(AFTERID) [after $G(DELAY) \
 		[namespace code [list show $w $tooltip($w,$item) cursor]]]
     }
 }
 
-# Handle the lack of <Enter>/<Leave> between listbox items using <Motion>
+# Handle the lack of <Enter>/<Leave> between listbox/treeview items
+# using <Motion>
 proc ::tooltip::listitemMotion {w x y} {
     variable tooltip
     variable G
     if {$G(enabled)} {
-        set item [$w index @$x,$y]
+	if {[winfo class $w] eq "Listbox"} {
+	    set item [$w index @$x,$y]
+	} else {
+	    set item {}
+	    set region [$w identify region $x $y]
+	    if {$region  eq "tree" || $region eq "cell"} {
+		set item [$w identify item $x $y]
+	    }
+	}
         if {$item ne $G(LAST)} {
             set G(LAST) $item
             after cancel $G(AFTERID)
             catch {wm withdraw $G(TOPLEVEL)}
             if {[info exists tooltip($w,$item)]} {
@@ -490,6 +505,6 @@
     $w tag bind $tag <Leave> +[namespace code [list hide 1]] ; # fade ok
     $w tag bind $tag <Any-KeyPress> +[namespace code hide]
     $w tag bind $tag <Any-Button> +[namespace code hide]
 }
 
-package provide tooltip 1.4.7
+package provide tooltip 1.5