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
98
99
100
101
102
103
104
105
|
# Copyright (C) 1987-2015 by Jeffery P. Hansen
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
# Last edit by hansen on Mon Feb 28 22:42:44 2005
#
set ho_ReqWin ""
set ho_ReqTag ""
set ho_PostWin ""
set ho_delay 500
set ho_color "bisque"
proc post_help {win tag} {
global ho_ReqWin ho_ReqTag ho_PostWin ho_color tkg_helpBalloons
global helpon_msg
set msg ""
catch { set msg $helpon_msg($tag) }
if { $tkg_helpBalloons == 0 } { return }
if { $win != $ho_ReqWin } { return }
if { $tag != $ho_ReqTag } { return }
if { $win == $ho_PostWin } { return }
catch { destroy .helpon }
scan [winfo pointerxy .] "%d %d" X Y
catch {
bind $win <Destroy> { catch { destroy .helpon } }
toplevel .helpon
wm geometry .helpon +[expr $X + 5]+[expr $Y + 5]
wm transient .helpon .
wm overrideredirect .helpon 1
label .helpon.msg -text $msg -justify left -bg $ho_color
pack .helpon.msg
bind .helpon <Visibility> { raise .helpon }
set ho_PostWin $win
}
}
proc req_help {win tag} {
global ho_ReqWin ho_ReqTag ho_delay
set ho_ReqWin $win
set ho_ReqTag $tag
after $ho_delay "post_help $win $tag"
}
proc cancel_help {} {
global ho_ReqWin ho_ReqTag ho_PostWin
catch { destroy .helpon }
set ho_ReqWin ""
set ho_ReqTag ""
set ho_PostWin ""
}
proc helpon {win msg} {
global helpon_msg
set helpon_msg($win) $msg
if {$msg == ""} {
bind $win <Enter> ""
bind $win <Leave> ""
} else {
bind $win <Enter> "+req_help $win $win"
bind $win <Leave> "+cancel_help"
}
}
proc helponitemcancel {win item} {
global helpon_msg
catch {
unset helpon_msg(${win}:$item)
}
}
proc helponitem {win item msg} {
global helpon_msg
set helpon_msg(${win}:$item) $msg
if {$msg == ""} {
$win bind $item <Enter> ""
$win bind $item <Leave> ""
} else {
$win bind $item <Enter> "+req_help $win ${win}:$item"
$win bind $item <Leave> "+cancel_help"
}
}
|
