+proc tooltip_starttimer {state x y} {
+ global tooltip_after posted tooltip_inwindow
+ if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
+ catch { after cancel $tooltip_after }
+ set tooltip_after [after 500 tooltip_show $x $y]
+}
+
+proc tooltip_cancel {} {
+ global tooltip_after
+ catch { after cancel $tooltip_after }
+ catch { unset $tooltip_after }
+ wm withdraw .tt
+}
+
+set tooltip_inwindow 0
+
+proc tooltip_enter {state x y} {
+ global tooltip_inwindow
+ set tooltip_inwindow 1
+ tooltip_starttimer $state $x $y
+}
+
+proc tooltip_leave {} {
+ global tooltip_inwindow
+ set tooltip_inwindow 0
+ tooltip_cancel
+}
+
+proc setuptooltip {} {
+ bind .i <Enter> { tooltip_enter %s %X %Y }
+ bind .i <Leave> { tooltip_leave }
+ bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
+ bind .i <Motion> { tooltip_starttimer %s %X %Y }
+ toplevel .tt -background black
+ wm withdraw .tt
+ wm overrideredirect .tt 1
+ label .tt.t -justify left -background {#EEE1B3}
+ pack .tt.t -padx 1 -pady 1
+ settooltip {}
+}
+
+proc settooltip {s} {
+ .tt.t configure -text $s
+}
+
+proc tooltip_show {x y} {
+ incr x 9
+ incr y 9
+ wm geometry .tt +$x+$y
+ wm deiconify .tt
+}
+
+proc setimage {image} {
+ .i configure -image $image
+}
+