/usr/share/tkcvs/tooltips.tcl is in tkcvs 8.2.3-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | #
# tooltips version 0.1
# Paul Boyer
# Science Applications International Corp.
#
# THINGS I'D LIKE TO DO:
# 1. make a widget called "tooltip_button" which does it all
# and takes name and helptext as arguments in addition to all
# button args
# 2. Keep visibility of tooltip always on top
# 3. Must be a better way to maintain button presses than rebinding?
# Because I don't want to explicitly handle all possible bindings
# such as <Button-2> etc
# 4. Allow for capability for status window at bottom of a frame
# that gets the status of the selected icon
##############################
# set_tooltips gets a button's name and the tooltip string as
# arguments and creates the proper bindings for entering
# and leaving the button
proc set_tooltips { widget name } {
global cvsglb
bind $widget <Enter> "
catch { after 500 { internal_tooltips_PopUp %W $name } } \
cvsglb(tooltip_id)
"
bind $widget <Leave> "internal_tooltips_PopDown"
bind $widget <Button-1> "internal_tooltips_PopDown"
}
##############################
# internal_tooltips_PopUp is used to activate the tooltip window
proc internal_tooltips_PopUp { wid name } {
global cvscfg cvsglb
# get rid of other existing tooltips
catch { destroy .tooltips_wind }
toplevel .tooltips_wind -class ToolTip
set size_changed 0
set bg [option get .tooltips_wind background background]
set fg [option get .tooltips_wind foreground foreground]
# get the cursor position
set X [winfo pointerx $wid]
set Y [winfo pointery $wid]
# add a slight offset to make tooltips fall below cursor
set Y [expr { $Y + 20 }]
# Now pop up the new widgetLabel
wm overrideredirect .tooltips_wind 1
wm geometry .tooltips_wind +$X+$Y
label .tooltips_wind.l \
-text $name \
-border 2 \
-relief raised \
-font $cvscfg(listboxfont) \
-background $bg \
-foreground $fg
pack .tooltips_wind.l
# make invisible
wm withdraw .tooltips_wind
update idletasks
# adjust for bottom of screen
if { ($Y + [winfo reqheight .tooltips_wind]) > [winfo screenheight .] } {
set Y [expr { $Y - [winfo reqheight .tooltips_wind] - 25 }]
set size_changed 1
}
# adjust for right border of screen
if { ($X + [winfo reqwidth .tooltips_wind]) > [winfo screenwidth .] } {
set X [expr { [winfo screenwidth .] - [winfo reqwidth .tooltips_wind] }]
set size_changed 1
}
# reset position
if { $size_changed == 1 } {
wm geometry .tooltips_wind +$X+$Y
}
# make visible
wm deiconify .tooltips_wind
# make tooltip dissappear after 5 sec
set cvsglb(tooltip_id) [after 5000 { internal_tooltips_PopDown }]
}
proc internal_tooltips_PopDown { } {
global cvsglb
after cancel $cvsglb(tooltip_id)
catch { destroy .tooltips_wind }
}
|