WHD: 4/2/2005. Up until now, Notebook App has been using Bwidget's dynamichelp module for toolbar-button tooltips; unfortunately, this causes some unfortunate behavior on OS X with Tcl/Tk Aqua 8.4.9. For some reason whenever a tooltip pops up, it steals the focus from the underlying toplevel window. To give the focus back to the underlying toplevel, you have to click on other window and then back on the toplevel, which is annoying. The bug doesn't appear to be in Bwidgets; it appears to be using a Tcl/Tk Aqua call to create a proper OS X ballon help window. Anyway, since I use Notebook on OS X with Aqua I got tired of it, and decided to see if I could write my own tooltip handler that circumvents the problem.
And here it is. It's not as flexible as the Bwidgets implementation, but it does everything that Notebook needs. Also, it includes a slight memory leak; it never forgets the tooltip text for deleted windows. I haven't decided what to do about that yet.
Using it is easy. To register a tooltip string with a button or other widget, do this:
::gui::tooltip register .button "The Tooltip Text"
That's all there is to it.
Here's the code; note that it's likely to continue to evolve. The most recent version will be included in the Notebook App source starting with Notebook V2.1.1.
package require snit 0.97
namespace eval ::gui:: {}
#-----------------------------------------------------------------------
# Tooltip type
#
# The tooltip command is an instance of TooltipType, so that we can
# have options.
snit::type ::gui::TooltipType {
#-------------------------------------------------------------------
# Options
option -font {Helvetica 12}
option -background "#FFFFC0"
option -topbackground black
option -foreground black
option -delay 600
#-------------------------------------------------------------------
# Variables
# Tool tip text. An array, indexed by window name
variable tiptext
# Tool tip timeout, or {}
variable timeout {}
# Tool tip window, or {}
variable tipwin {}
#-------------------------------------------------------------------
# Constructor
# Implicit
#-------------------------------------------------------------------
# Public methods
method register {window text} {
set tiptext($window) $text
bind $window <Enter> [mymethod Enter $window]
bind $window <Leave> [mymethod Leave $window]
}
method unregister {window} {
unset tiptext($window)
}
#-------------------------------------------------------------------
# Private Methods
# When the mouse pointer enters the window, set the timer.
method Enter {window} {
set timeout [after $options(-delay) [mymethod Popup $window]]
}
# Pop up the tooltip.
method Popup {window} {
# FIRST, the timeout has fired, so we can forget it.
set timeout {}
# NEXT, the tooltip will be a child of the window's toplevel.
set top [winfo toplevel $window]
# NEXT, the tooltip's name depends on which toplevel it is.
set tipwin ".gui_tooltip_window"
if {$top ne "."} {
set tipwin "$top$tipwin"
}
# NEXT, create the tooltip window.
frame $tipwin \
-background $options(-topbackground)
label $tipwin.label \
-text $tiptext($window) \
-foreground $options(-foreground) \
-background $options(-background) \
-font $options(-font)
# Pack the label with a 1 pixel gap, so that there's a box
# around it.
pack $tipwin.label -padx 1 -pady 1
# NEXT, the tipwin will be placed in the toplevel relative to
# the position of the registered window. We'll figure this out
# by getting the position of both relative to the root window.
set tx [winfo rootx $top]
set ty [winfo rooty $top]
set wx [winfo rootx $window]
set wy [winfo rooty $window]
# We want to the tip to appear below and to the right of the
# registered window.
set offset [expr {[winfo width $window]/2}]
# Compute the final position.
set x [expr {($wx - $tx) + $offset}]
set y [expr {($wy - $ty) + [winfo height $window] + 2}]
# Finally, place the tipwin in its position.
place $tipwin -anchor nw -x $x -y $y
# However, if window is to the right of its toplevel, the
# tipwin might be too wide. Slide it to the left, as needed.
# TBD: I don't know of any way to determine the width of the
# tipwin without letting it pop up, which causes an ugly
# jump.
update idletasks
set rightEdge [expr {$x + [winfo width $tipwin]}]
set topWid [winfo width $top]
if {$rightEdge >= $topWid} {
set x [expr {$x - ($rightEdge - $topWid + 2)}]
place $tipwin -anchor nw -x $x -y $y
}
}
# When the mouse pointer leaves the window, cancel the timer or
# popdown the window, as needed.
method Leave {window} {
if {$timeout ne ""} {
after cancel $timeout
set timeout ""
return
}
if {$tipwin ne ""} {
destroy $tipwin
set tipwin ""
}
}
}
#-----------------------------------------------------------------------
# The tooltip command
::gui::TooltipType ::gui::tooltip