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
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: menuhelp.tcl,v 2.15 2005/01/02 00:45:07 jfontain Exp $
bind Menu <<MenuSelect>> {menuContextHelp::menuSelected %W}
class menuContextHelp {
proc menuContextHelp {this path} {
variable identifier
# the popup menus do not seem to send a none selection once an entry is selected and the menu disappears, so use this:
bind $path <Unmap> {catch {menuContextHelp::selected $menuContextHelp::identifier(%W) none}}
::set ($this,active) -1 ;# corresponding to none: no active item
::set ($this,path) $path
::set identifier($path) $this
}
proc ~menuContextHelp {this} {
variable ${this}string
variable identifier
catch {unset ${this}string}
unset identifier($($this,path))
}
proc set {this item string} {
variable ${this}string
::set ${this}string($item) $string
}
proc menuSelected {path} {
variable identifier
::set item [$path index active]
if {[string match {.#*} $path]} {
# menu bar widgets in bindings seem to be coded as the following example shows: .#menu.#menu#edit.#menu#edit#new
regsub -all # [lindex [split $path .] end] . path ;# reconstruct original menu path
} ;# else it seems to be from a popup menu
if {![catch {::set object $identifier($path)}]} {
selected $object $item
}
}
proc selected {this item} {
variable ${this}string
if {[string equal $item none]} { ;# normalize item
::set item -1
}
if {$item == $($this,active)} return ;# no change
lifoLabel::pop $global::messenger
if {$item >= 0} { ;# replace with new item
if {[catch {::set ${this}string($item)} string]} {
lifoLabel::push $global::messenger $item ;# display item number to aid debugging
} else {
lifoLabel::push $global::messenger $string
}
}
::set ($this,active) $item
}
}
|
