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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
# $Id: optimenu.tcl,v 2.9 2004/12/03 20:44:06 jfontain Exp $
class optionMenu {}
proc optionMenu::optionMenu {this parentPath args} composite {
[new frame $parentPath -relief $widget::option(button,relief) -borderwidth $widget::option(button,borderwidth)] $args
} {
set path $widget::($this,path)
grid rowconfigure $path 0 -weight 1
grid columnconfigure $path 0 -weight 1
composite::manage $this [new label $path -padx 0 -pady 0] label
grid $composite::($this,label,path) -column 0 -row 0 -sticky nsew
# separate label from stub with border width value so that shell when popped does not hide part of the stub
grid columnconfigure $path 1 -minsize $widget::option(button,borderwidth)
# use a frame instead of a button which does not accept pixel sizes
composite::manage $this [new frame $path\
-background $widget::option(button,background) -relief $widget::option(button,relief)\
-borderwidth $widget::option(button,borderwidth) -width 12 -height 8\
] stub
set stubPath $composite::($this,stub,path)
grid $stubPath -column 2 -row 0
grid columnconfigure $path 3 -minsize 8
# setup bindings for activation highlighting
bind $path <Enter> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,activebackground)}"
bind $path <Leave> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,background)}"
composite::manage $this [new toplevel [winfo toplevel $parentPath] -cursor right_ptr] shell
set shellPath $composite::($this,shell,path)
if {$widget::option(menu,borderwidth)==0} { ;# use a thin black border for popup window, such as in windows menus
$shellPath configure -highlightbackground black -highlightthickness 1
} else { ;# use a border, such as in motif
$shellPath configure -relief raised -borderwidth $widget::option(menu,borderwidth) ;# for Windows and UNIX
}
wm overrideredirect $shellPath 1 ;# no window manager decorations, choices are invisible by default
wm withdraw $shellPath
global embed_args
if {[info exists embed_args]} {
# running in the plug-in environment, menu emulation is not possible since grab command is not yet available
set sequence <ButtonRelease-1>
} else { ;# if not running in the plug-in environment, act as a menu and allow button press in label to pop up the choices
set sequence <ButtonPress-1>
bind $composite::($this,label,path) $sequence "optionMenu::popChoices $this"
}
bind $path $sequence "optionMenu::popChoices $this"
bind $composite::($this,stub,path) $sequence "optionMenu::popChoices $this"
set ($this,selectedLabelIndex) 0
composite::complete $this
}
proc optionMenu::~optionMenu {this} {}
proc optionMenu::options {this} {
return [list\
[list -choices {} {}]\
[list -command {} {}]\
[list -font $widget::option(menu,font) $widget::option(menu,font)]\
[list -popupcommand {} {}]\
[list -takefocus 1]\
[list -text {} {}]\
]
}
proc optionMenu::set-command {this value} {}
proc optionMenu::set-popupcommand {this value} {}
proc optionMenu::set-font {this value} {
$composite::($this,label,path) configure -font $value
set-choices $this $composite::($this,-choices) ;# geometry management must be updated according to new font
}
proc optionMenu::set-text {this value} {
$composite::($this,label,path) configure -text $value
}
proc optionMenu::set-choices {this value} {
set path $composite::($this,shell,path)
eval destroy [winfo children $path] ;# destroy current labels first
set index 0
set width 0
foreach choice $composite::($this,-choices) {
set label [label $path.$index -text $choice -relief flat -font $composite::($this,-font)]
if {[winfo reqwidth $label]>$width} {
set width [winfo reqwidth $label]
}
bind $label <Enter> "optionMenu::select $this $index"
pack $label -fill x
incr index
}
grid columnconfigure $widget::($this,path) 0 -minsize $width ;# find maximum width and apply it to visible label
showTopLevel $path 0x0 ;# make sure sizes will be correct the first time choices are popped
update idletasks
wm withdraw $path
wm geometry $path {}
}
proc optionMenu::set-takefocus {this value} {
set path $widget::($this,path)
switch $value {
0 {
bind $path <space> {}
bind $path <Return> {}
bind $path <KP_Enter> {}
bind $path <Up> {}
bind $path <Down> {}
bind $path <Escape> {}
}
1 {
bind $path <space> "optionMenu::processSpaceKey $this"
bind $path <Return> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
bind $path <KP_Enter> [bind $path <Return>]
bind $path <Up> "optionMenu::selectPrevious $this"
bind $path <Down> "optionMenu::selectNext $this"
bind $path <Escape> "optionMenu::unpopChoices $this"
}
default {
error "bad takefocus value \"$value\": must be 0 or 1"
}
}
$path configure -takefocus $value
}
proc optionMenu::popChoices {this} {
if {\
([llength $composite::($this,-choices)] == 0) ||\
(([string length $composite::($this,-popupcommand)] > 0) && ![uplevel #0 $composite::($this,-popupcommand)])\
} return ;# user code may cancel popping up the choices menu
update idletasks ;# make sure sizes are correct
set shellPath $composite::($this,shell,path)
set selected [lindex [winfo children $composite::($this,shell,path)] $($this,selectedLabelIndex)]
$selected configure -background $widget::option(menu,activebackground) -foreground $widget::option(menu,activeforeground)\
-relief $widget::option(menu,relief)
set labelPath $composite::($this,label,path) ;# position selected label center at the same abscissa of the display label center
set x [expr {[winfo rootx $labelPath]-$widget::option(menu,borderwidth)}]
if {$x<0} {set x 0}
set y [expr {[winfo rooty $labelPath]+(([winfo height $labelPath]-[winfo height $selected])/2)-[winfo y $selected]}]
if {$y<0} {set y 0}
# make sure choices width is identical to label width
showTopLevel $shellPath\
[expr {[winfo width $labelPath]+(2*$widget::option(menu,borderwidth))}]x[winfo reqheight $shellPath]+$x+$y
update idletasks
raise $shellPath
set (previousGrab) [grab current $shellPath]
global embed_args
if {[info exists embed_args]} { ;# running in the plug-in environment, grab does not work yet and is emulated
bind $shellPath <ButtonRelease-1> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
grab $shellPath
} else {
# add a small delay before allowing a button release to unpop the shell so that a rapid press / release sequence leaves the
# shell popped to emulate the Motif behavior
after 300 "bind $shellPath <ButtonRelease-1> {optionMenu::unpopChoices $this; optionMenu::checkSelection $this}"
grab -global $shellPath
}
}
proc optionMenu::unpopChoices {this} {
set path $composite::($this,shell,path)
if {![winfo ismapped $path]} {
return ;# already unpopped
}
wm withdraw $path
if {[string length $(previousGrab)]>0} {
grab $(previousGrab)
unset (previousGrab)
} else {
grab release $path
}
bind $path <ButtonRelease-1> {}
}
proc optionMenu::checkSelection {this} {
set selected [lindex [winfo children $composite::($this,shell,path)] $($this,selectedLabelIndex)]
if {[string length $selected]==0} return
set selection [$selected cget -text]
composite::configure $this -text $selection ;# use composite layer so that cget returns current value
invokeCommand $this $selection
}
proc optionMenu::invokeCommand {this choice} {
if {[string length $composite::($this,-command)]>0} {
uplevel #0 $composite::($this,-command) [list $choice] ;# always invoke command at global level as tk buttons do
}
}
proc optionMenu::configureChoices {this args} {
foreach label [winfo children $composite::($this,shell,path)] {
eval $label configure $option $args
}
}
proc optionMenu::select {this index} {
if {![winfo ismapped $composite::($this,shell,path)]} {
return ;# no selection should be allowed if choices are not posted
}
set labels [winfo children $composite::($this,shell,path)]
if {$index<0} {
set index 0
} elseif {$index>=[llength $labels]} {
set index [expr {[llength $labels]-1}]
}
[lindex $labels $($this,selectedLabelIndex)] configure -background $widget::option(menu,background)\
-foreground $widget::option(menu,foreground) -relief flat
[lindex $labels $index] configure -background $widget::option(menu,activebackground)\
-foreground $widget::option(menu,activeforeground) -relief $widget::option(menu,relief)
set ($this,selectedLabelIndex) $index
}
proc optionMenu::selectPrevious {this} {
select $this [expr {$($this,selectedLabelIndex)-1}]
}
proc optionMenu::selectNext {this} {
select $this [expr {$($this,selectedLabelIndex)+1}]
}
proc optionMenu::processSpaceKey {this} {
if {[winfo ismapped $composite::($this,shell,path)]} {
unpopChoices $this
checkSelection $this
} else {
popChoices $this
}
}
|
