line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#
|
2
|
|
|
|
|
|
|
# Tk::JBrowseEntry is an enhanced version of the Tk::BrowseEntry widget.
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=head1 NAME
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
Tk::JBrowseEntry - Full-featured "Combo-box" (Text-entry combined with drop-down listbox)
|
7
|
|
|
|
|
|
|
derived from Tk::BrowseEntry with many additional features and options.
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Tk;
|
12
|
|
|
|
|
|
|
use Tk::JBrowseEntry;
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $mw = MainWindow->new;
|
15
|
|
|
|
|
|
|
my $var;
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $widget = $mw->JBrowseEntry(
|
18
|
|
|
|
|
|
|
-label => 'Normal:',
|
19
|
|
|
|
|
|
|
-variable => \$var,
|
20
|
|
|
|
|
|
|
-state => 'normal',
|
21
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats)],
|
22
|
|
|
|
|
|
|
-width => 12
|
23
|
|
|
|
|
|
|
)->pack(
|
24
|
|
|
|
|
|
|
-side => 'top',
|
25
|
|
|
|
|
|
|
-pady => '10',
|
26
|
|
|
|
|
|
|
-anchor => 'w');
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
MainLoop;
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Tk::JBrowseEntry is a derived widget from Tk::BrowseEntry, but adds numerous
|
33
|
|
|
|
|
|
|
features and options. Among them are hash lists (one set of values is displayed
|
34
|
|
|
|
|
|
|
for the user, but another is used as data), ability to disable either the text
|
35
|
|
|
|
|
|
|
entry widget or the listbox, ability to allow user to delete items from the list,
|
36
|
|
|
|
|
|
|
additional keyboard bindings, and much more.
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
JBrowseEntry widgets allow one to specify a full combo-box, a "readonly"
|
39
|
|
|
|
|
|
|
box (text field allows user to type the 1st letter of an item to search for,
|
40
|
|
|
|
|
|
|
but user may only ultimately select one of the items in the list), or a
|
41
|
|
|
|
|
|
|
"textonly" version (drop-down list disabled), or a completely disabled
|
42
|
|
|
|
|
|
|
widget.
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
This widget is similar to other combo-boxes, ie. JComboBox, but has good
|
45
|
|
|
|
|
|
|
keyboard bindings and allows for quick lookup/search within the listbox.
|
46
|
|
|
|
|
|
|
pressing in entry field displays the dropdown box with the
|
47
|
|
|
|
|
|
|
first entry most closly matching whatever's in the entry field highlighted.
|
48
|
|
|
|
|
|
|
Pressing or in the listbox
|
49
|
|
|
|
|
|
|
selects the highlighted entry and copies it to the text field and removes the
|
50
|
|
|
|
|
|
|
listbox. removes the listbox from view.
|
51
|
|
|
|
|
|
|
and arrows work the listbox as well as pressing a key, which will
|
52
|
|
|
|
|
|
|
move the highlight to the next item starting with that letter/number, etc.
|
53
|
|
|
|
|
|
|
and arrows pressed within the entry field circle through the
|
54
|
|
|
|
|
|
|
various list options as well (unless "-state" is set to 'textonly').
|
55
|
|
|
|
|
|
|
Set "-state" to "text" to disable the dropdown list, but allow and
|
56
|
|
|
|
|
|
|
to cycle among the choices. Setting "-state" to 'textonly' completely
|
57
|
|
|
|
|
|
|
hides the choices list from the user - he must type in his choice just like
|
58
|
|
|
|
|
|
|
a normal entry widget.
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
One may also specify whether or not the button which activates the
|
61
|
|
|
|
|
|
|
dropdown list via the mouse can take focus or not (-btntakesfocus) or
|
62
|
|
|
|
|
|
|
whether the widget itself can take focus or is skipped in the focusing
|
63
|
|
|
|
|
|
|
order. The developer can also specify alternate bitmap images for the
|
64
|
|
|
|
|
|
|
button (-arrowimage and -farrowimage). The developer can also specify the
|
65
|
|
|
|
|
|
|
maximum length of the dropdown list such that if more than that number of
|
66
|
|
|
|
|
|
|
items is added, a vertical scrollbar is automatically added (-height).
|
67
|
|
|
|
|
|
|
A fixed width in characters (-width) can be specified, or the widget can be
|
68
|
|
|
|
|
|
|
allowed to resize itself to the width of the longest string in the list. The
|
69
|
|
|
|
|
|
|
listbox and text entry field are automatically kept to the same width.
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
One can optionally specify a label (-label), similar to the "LabEntry" widget.
|
72
|
|
|
|
|
|
|
By default, the label appears packed to the left of the widget. The
|
73
|
|
|
|
|
|
|
positioning can be specified via the "-labelPack" option. For example, to
|
74
|
|
|
|
|
|
|
position the label above the widget, use "-labelPack => [-side => 'top']".
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 EXAMPLES
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
It is easiest to illustrate this widget's capabilities via examples:
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
use Tk;
|
81
|
|
|
|
|
|
|
use Tk::JBrowseEntry;
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$MainWin = MainWindow->new;
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
#SET UP SOME DEFAULT VALUES.
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
$dbname1 = 'cows';
|
88
|
|
|
|
|
|
|
$dbname2 = 'foxes';
|
89
|
|
|
|
|
|
|
$dbname3 = 'goats';
|
90
|
|
|
|
|
|
|
$dbname5 = 'default';
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
#HERE'S A NORMAL COMBO-BOX.
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
$jb1 = $MainWin->JBrowseEntry(
|
95
|
|
|
|
|
|
|
-label => 'Normal:',
|
96
|
|
|
|
|
|
|
-variable => \$dbname1,
|
97
|
|
|
|
|
|
|
-state => 'normal',
|
98
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats)],
|
99
|
|
|
|
|
|
|
-width => 12);
|
100
|
|
|
|
|
|
|
$jb1->pack(
|
101
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
#THIS ONE HAS THE DROPDOWN LIST DISABLED.
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
$jb2 = $MainWin->JBrowseEntry(
|
106
|
|
|
|
|
|
|
-label => 'TextOnly:',
|
107
|
|
|
|
|
|
|
-variable => \$dbname2,
|
108
|
|
|
|
|
|
|
-state => 'text',
|
109
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats)],
|
110
|
|
|
|
|
|
|
-width => 12);
|
111
|
|
|
|
|
|
|
$jb2->pack(
|
112
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
#THIS ONE'S "READONLY" (USER MUST PICK FROM THE LIST, TEXT BOX ALLOWS QUICK
|
115
|
|
|
|
|
|
|
#SEARCH.
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$jb3 = $MainWin->JBrowseEntry(
|
118
|
|
|
|
|
|
|
-label => 'ReadOnly:',
|
119
|
|
|
|
|
|
|
-variable => \$dbname3,
|
120
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats)],
|
121
|
|
|
|
|
|
|
-state => 'readonly',
|
122
|
|
|
|
|
|
|
-width => 12);
|
123
|
|
|
|
|
|
|
$jb3->pack(
|
124
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#THIS ONE'S COMPLETELY DISABLED!
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
$jb4 = $MainWin->JBrowseEntry(
|
129
|
|
|
|
|
|
|
-label => 'Disabled:',
|
130
|
|
|
|
|
|
|
-variable => \$dbname3,
|
131
|
|
|
|
|
|
|
-state => 'disabled',
|
132
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats)],
|
133
|
|
|
|
|
|
|
-width => 12);
|
134
|
|
|
|
|
|
|
$jb4->pack(
|
135
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
#HERE'S ONE WITH A SCROLLBAR (NOTE THE "-height" ATTRIBUTE).
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$jb5 = $MainWin->JBrowseEntry(
|
140
|
|
|
|
|
|
|
-label => 'Scrolled List:',
|
141
|
|
|
|
|
|
|
-width => 12,
|
142
|
|
|
|
|
|
|
-default => $dbname5,
|
143
|
|
|
|
|
|
|
-height => 4,
|
144
|
|
|
|
|
|
|
-variable => \$dbname5,
|
145
|
|
|
|
|
|
|
-browsecmd => sub {print "-browsecmd!\n";},
|
146
|
|
|
|
|
|
|
-listcmd => sub {print "-listcmd!\n";},
|
147
|
|
|
|
|
|
|
-state => 'normal',
|
148
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats horses sheep dogs cats ardvarks default)]);
|
149
|
|
|
|
|
|
|
$jb5->pack(
|
150
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
#HERE'S ONE THAT THE BUTTON TAKES KEYBOARD FOCUS.
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
$jb6 = $MainWin->JBrowseEntry(
|
155
|
|
|
|
|
|
|
-label => 'Button Focus:',
|
156
|
|
|
|
|
|
|
-btntakesfocus => 1,
|
157
|
|
|
|
|
|
|
-arrowimage => $MainWin->Getimage('balArrow'), #SPECIFY A DIFFERENT BUTTON IMAGE.
|
158
|
|
|
|
|
|
|
-farrowimage => $MainWin->Getimage('cbxarrow'), #OPTIONAL 2ND IMAGE FOR BUTTON WHEN FOCUSED.
|
159
|
|
|
|
|
|
|
-width => 12,
|
160
|
|
|
|
|
|
|
-height => 4,
|
161
|
|
|
|
|
|
|
-variable => \$dbname6,
|
162
|
|
|
|
|
|
|
-browsecmd => sub {print "-browsecmd!\n";},
|
163
|
|
|
|
|
|
|
-listcmd => sub {print "-listcmd!\n";},
|
164
|
|
|
|
|
|
|
-state => 'normal',
|
165
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats horses sheep dogs cats ardvarks default)]);
|
166
|
|
|
|
|
|
|
$jb6->pack(
|
167
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
#HERE'S ONE THAT DOWS NOT TAKE KEYBOARD FOCUS.
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
$jb7 = $MainWin->JBrowseEntry(
|
172
|
|
|
|
|
|
|
-label => 'Skip Focus:',
|
173
|
|
|
|
|
|
|
-takefocus => 0,
|
174
|
|
|
|
|
|
|
-width => 12,
|
175
|
|
|
|
|
|
|
-height => 4,
|
176
|
|
|
|
|
|
|
-variable => \$dbname7,
|
177
|
|
|
|
|
|
|
-browsecmd => sub {print "-browsecmd!\n";},
|
178
|
|
|
|
|
|
|
-listcmd => sub {print "-listcmd!\n";},
|
179
|
|
|
|
|
|
|
-state => 'normal',
|
180
|
|
|
|
|
|
|
-choices => [qw(pigs cows foxes goats horses sheep dogs cats ardvarks default)]);
|
181
|
|
|
|
|
|
|
$jb7->pack(
|
182
|
|
|
|
|
|
|
-side => 'top', -pady => '10', -anchor => 'w');
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
$jb7->choices([qw(First Second Fifth Sixth)]); #REPLACE LIST CHOICES!
|
185
|
|
|
|
|
|
|
$jb7->insert(2, 'Third', 'Fourth'); #ADD MORE AFTER 1ST 2.
|
186
|
|
|
|
|
|
|
$jb7->insert('end', [qw(Seventh Oops Eighth)]); #ADD STILL MORE AT END.
|
187
|
|
|
|
|
|
|
$jb7->delete(7); #REMOVE ONE.
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$b = $MainWin->Button(-text => 'Quit', -command => sub {exit(); });
|
190
|
|
|
|
|
|
|
$b->pack(-side => 'top');
|
191
|
|
|
|
|
|
|
$jb1->focus; #PICK ONE TO START WITH KEYBOARD FOCUS.
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
MainLoop;
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 SEE ALSO
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
L L L L
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 WIDGET-SPECIFIC OPTIONS
|
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=over 4
|
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=item B<-state> => I
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Default: B
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
JBrowseEntry supports 5 different states:
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=over 4
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
I: Default operation -- Both text entry field and dropdown list button function normally.
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
I: Dropdown list functions normally. When text entry field has focus, user may type in a letter, and the dropdown list immediately drops down and the first/ next matching item becomes highlighted. The user must ultimately select from the list of valid entries and may not enter anything else.
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
I: Text entry functions normally, but dropdown list button is disabled. User must type in an entry or use the up and down arrows to choose from among the list items.
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
I: Similar to "text": Text entry functions normally, but dropdown list button is disabled. User must type in an entry. The list choices are completely hidden from the user.
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
I: Widget is completely disabled and greyed out. It will not activate or take focus.
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=back
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=item B<-altbinding>
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Allows one to specify alternate binding schema for certain keys. Currently valid values are "Return=Next" (which causes pressing the [Return] key to advance the focus to the next widget in the main window); and "Down=Popup", which causes the [Down-arrow] key to pop up the selection listbox.
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=item B<-btntakesfocus>
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
The dropdown list button is normally activated with the mouse and is skipped in the focusing circuit. If this option is set, then the button will take keyboard focus. Pressing , , or will cause the list to be dropped down, repeating causes the list to be removed again. Normally, the text entry widget receives the keyboard focus. This option can be used in combination with "-takefocus" so that either the text entry widget, the button, or both or neither receive keyboard focus. If both options are set, the entry field first receives focus, then pressing causes the button to be focused.
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item B<-deleteitemsok>
|
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
If set, allows user to delete individual items in the drop-down list by pressing the key to delete the current (active) item.
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item B<-farrowimage>
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Allows one to specify a second alternate bitmap for the image on the button which activates the dropdown list when the button has the keyboard focus. The default is to use the "-arrowimage" image. This option should only be specified if the "-arrowimage" option is also specified. See the "-arrowimage" option under Standard BrowseEntry options for more details.
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=item B<-height>
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Specify the maximum number of items to be displayed in the listbox before a vertical scrollbar is automatically added. Default is infinity (listbox will not be given a scrollbar regardless of the number of items added).
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item B<-labelPack>
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Specify alternate packing options for the label. The default is: "[-side => 'left', -anchor => 'e']". The argument is an arrayref. Note: if no label is specified, none is packed or displayed.
|
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item B<-labelrelief>
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Default B<"flat">
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Allow relief of the label portion of the widget to be specified.
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item B<-listfont>
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Specify an alternate font for the text in the listbox. Use "-font" to change the text of the text entry field. For best results, "-font" and "-listfont" should specify fonts of similar size.
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=item B<-noselecttext>
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Normally, when the widget has the focus, the current value is "selected" (highlighted and in the cut-buffer). Some consider this unattractive in appearance, particularly with the "readonly" state, which appears as a raised button in Unix, similar to an "Optionmenu". Setting this option will cause the text to not be selected.
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=item B<-width>
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
The number of characters (average if proportional font used) wide to make the entry field. The dropdown list will be set the same width as the entry widget plus the width of the button. If not specified, the default is to calculate the width to the width of the longest item in the choices list and if items are later added or removed the width will be recalculated.
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item B<-nobutton>
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Default B<0>
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Prevents dropdown list button from being displayed.
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=back
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head1 INHERITED OPTIONS
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=over 4
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=item B<-arrowimage>
|
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
Specifies the image to be used in the arrow button beside the entry widget. The default is an downward arrow image in the file cbxarrow.xbm
|
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=item B<-browsecmd>
|
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Specifies a function to call when a selection is made in the popped up listbox. It is passed the widget and the text of the entry selected. This function is called after the entry variable has been assigned the value.
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=item B<-choices>
|
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
Specifies the list of choices to pop up. This is a reference to an array of strings specifying the choices.
|
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=item B<-colorstate>
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
Depreciated -- Appears to force the background of the entry widget on the Unix version to "grey95" if state is normal and a "-background" color is not specified.
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=item B<-listcmd>
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
Specifies the function to call when the button next to the entry is pressed to popup the choices in the listbox. This is called before popping up the listbox, so can be used to populate the entries in the listbox.
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=item B<-listrelief>
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
Specifies relief for the dropdown list (default is "sunken").
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item B<-listwidth>
|
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Specifies the width of the popup listbox.
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item B<-maxwidth>
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Specifies the maximum width the entry and listbox widgets can expand to in characters. The default is zero, meaning expand to the width to accomodate the widest string in the list.
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=item B<-state>
|
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
Specifies one of four states for the widget: "normal", "readonly", "textonly", or "disabled". If the widget is "disabled" then the value may not be changed and the arrow button won't activate. If the widget is "readonly", the entry may not be edited, but it may be changed by choosing a value from the popup listbox. "textonly" means the listbox will not activate. "normal" is the default.
|
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=item B<-tabcomplete>
|
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
If set to "1", pressing the "" key will cause the string in the entry field to be "auto-completed" to the next matching item in the list. If there is no match, the typed text is not changed. If it already matches a list item, then the listbox is removed from view and keyboard focus transfers to the next widget. If set to "2" and there is no match in the list, then entry is set to the default value or empty string.
|
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=item B<-variable>
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Specifies the variable in which the entered value is to be stored.
|
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=back
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head1 WIDGET METHODS
|
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=over 4
|
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=item $widget->B(index)
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
activate() invokes the activate() option on the listbox to make the item with the
|
330
|
|
|
|
|
|
|
index specified by the first argument "active". Unless a second argument is
|
331
|
|
|
|
|
|
|
passed containing a false value, the value of the "-textvariable" variable is also
|
332
|
|
|
|
|
|
|
set to this now active value.
|
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=item $widget->B([listref])
|
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Sets the dropdown list listbox to the list of values referenced by I, if
|
337
|
|
|
|
|
|
|
specified. Returns the current list of choices in the listbox if no arguments
|
338
|
|
|
|
|
|
|
provided.
|
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=item $widget->B()
|
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Returns the currently-selected element in the listbox, if any, otherwise, B.
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item $widget->B(first [, last])
|
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Deletes one or more elements of the listbox. First and last are indices specifying
|
347
|
|
|
|
|
|
|
the first and last elements in the range to delete. If last isn't specified it
|
348
|
|
|
|
|
|
|
defaults to first, i.e. a single element is deleted.
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Deletes one or more elements of the listbox. "hashkey" specifies the element to
|
353
|
|
|
|
|
|
|
be deleted by the value visible to the user.
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Returns the actual option key value that corresponds to the choice value displayed
|
358
|
|
|
|
|
|
|
in the listbox. (undef if there is none). (Opposite of dereference() and
|
359
|
|
|
|
|
|
|
dereferenceOnly().
|
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
Returns the value (displayed in the listbox) that corresponds to the choice key
|
364
|
|
|
|
|
|
|
specified by "hashkey". If the key is not one of the valid choices or the choices
|
365
|
|
|
|
|
|
|
are a list instead of a hash, then "hashkey" is returned.
|
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
Returns 1 if the key specified by "hashkey" is one of the valid choices and the list
|
370
|
|
|
|
|
|
|
of choices is a hash, otherwise B is returned.
|
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item $widget->B()
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Returns a reference to the current hash of choices (keyed by the option visable to
|
375
|
|
|
|
|
|
|
the user) if the choice list is a hash (reversed from the hash passed to choices()),
|
376
|
|
|
|
|
|
|
otherwise, B is returned.
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=item $widget->B()
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
Returns a reference to the current hash of choices (keyed by actual option value)
|
381
|
|
|
|
|
|
|
if the choice list is a hash (same as the hash passed to choices()),
|
382
|
|
|
|
|
|
|
otherwise, B is returned.
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=item $widget->B([first [, last])
|
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
get() with no arguments returns the current value of the "-textvariable" variable.
|
387
|
|
|
|
|
|
|
If any arguments are passed, they are passed directly to the listbox->get()
|
388
|
|
|
|
|
|
|
function, ie. "0", "end" to return all values of the listbox.
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Returns the index number in the list (zero-based) that can be used by get() of
|
393
|
|
|
|
|
|
|
the value specified by "hashkey".
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=item $widget->B(hashkey)
|
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Returns the value (displayed in the listbox) that corresponds to the choice key
|
398
|
|
|
|
|
|
|
specified by "hashkey". If the key is not one of the valid choices or the choices
|
399
|
|
|
|
|
|
|
are a list instead of a hash, then B is returned.
|
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=item $widget->B(index)
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Invokes and returns the result of the listbox->index() function.
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item $widget->B(index, [item | list | listref | hashref])
|
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Inserts one or more elements in the list just before the element given by index.
|
408
|
|
|
|
|
|
|
If I is specified as "end" then the new elements are added to the end of the list.
|
409
|
|
|
|
|
|
|
List can be a reference to a list (I). If a hash reference is specified,
|
410
|
|
|
|
|
|
|
then the values are displayed to the user in the dropdown list, but the values
|
411
|
|
|
|
|
|
|
returned by the "-textvariable" variable or the get() function are the corresponding
|
412
|
|
|
|
|
|
|
hash key(s).
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item $widget->B()
|
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Invokes and returns the result of the listbox size() function (the number of items in
|
417
|
|
|
|
|
|
|
the list.
|
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=item $widget->B([normal | readonly | text | textonly | disabled])
|
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
Get or set the state of the widget.
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=back
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=head1 AUTHOR
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Jim Turner, C<< >>
|
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=head1 COPYRIGHT
|
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
Copyright 2001-2011 (c) Jim Turner .
|
433
|
|
|
|
|
|
|
All rights reserved.
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
This program is free software; you can redistribute
|
436
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself.
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
This is a derived work from Tk::BrowseEntry. Tk::BrowseEntry is
|
439
|
|
|
|
|
|
|
copyrighted by Rajappa Iyer
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=cut
|
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
package Tk::JBrowseEntry;
|
444
|
|
|
|
|
|
|
|
445
|
1
|
|
|
1
|
|
2695
|
use vars qw($VERSION);
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
446
|
|
|
|
|
|
|
$VERSION = '4.8';
|
447
|
|
|
|
|
|
|
|
448
|
1
|
|
|
1
|
|
1838
|
use Tk;
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
use Carp;
|
450
|
|
|
|
|
|
|
use strict;
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
require Tk::Frame;
|
453
|
|
|
|
|
|
|
require Tk::LabEntry;
|
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
use base qw(Tk::Frame);
|
456
|
|
|
|
|
|
|
Construct Tk::Widget 'JBrowseEntry';
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
my ($BITMAP, $FOCUSEDBITMAP);
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub ClassInit
|
461
|
|
|
|
|
|
|
{
|
462
|
|
|
|
|
|
|
my($class,$mw) = @_;
|
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
unless(defined($BITMAP))
|
465
|
|
|
|
|
|
|
{
|
466
|
|
|
|
|
|
|
$BITMAP = __PACKAGE__ . "::downarrwow";
|
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
if ($Tk::platform =~ /Win32/)
|
469
|
|
|
|
|
|
|
{
|
470
|
|
|
|
|
|
|
my $bits = pack("b10"x10,
|
471
|
|
|
|
|
|
|
"..........",
|
472
|
|
|
|
|
|
|
"..........",
|
473
|
|
|
|
|
|
|
"..........",
|
474
|
|
|
|
|
|
|
".#########",
|
475
|
|
|
|
|
|
|
"..#######.",
|
476
|
|
|
|
|
|
|
"...#####..",
|
477
|
|
|
|
|
|
|
"....###...",
|
478
|
|
|
|
|
|
|
".....#....",
|
479
|
|
|
|
|
|
|
"..........",
|
480
|
|
|
|
|
|
|
".........."
|
481
|
|
|
|
|
|
|
);
|
482
|
|
|
|
|
|
|
$mw->DefineBitmap($BITMAP => 10,10, $bits);
|
483
|
|
|
|
|
|
|
}
|
484
|
|
|
|
|
|
|
else
|
485
|
|
|
|
|
|
|
{
|
486
|
|
|
|
|
|
|
my $bits = pack("b11"x12,
|
487
|
|
|
|
|
|
|
"....###....",
|
488
|
|
|
|
|
|
|
"....###....",
|
489
|
|
|
|
|
|
|
"....###....",
|
490
|
|
|
|
|
|
|
"....###....",
|
491
|
|
|
|
|
|
|
".#########.",
|
492
|
|
|
|
|
|
|
"..#######..",
|
493
|
|
|
|
|
|
|
"...#####...",
|
494
|
|
|
|
|
|
|
"....###....",
|
495
|
|
|
|
|
|
|
".....#.....",
|
496
|
|
|
|
|
|
|
"...........",
|
497
|
|
|
|
|
|
|
".#########.",
|
498
|
|
|
|
|
|
|
".#########."
|
499
|
|
|
|
|
|
|
);
|
500
|
|
|
|
|
|
|
$mw->DefineBitmap($BITMAP => 11,12, $bits);
|
501
|
|
|
|
|
|
|
}
|
502
|
|
|
|
|
|
|
$FOCUSEDBITMAP = __PACKAGE__ . "::fdownarrow";
|
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
if ($Tk::platform =~ /Win32/)
|
505
|
|
|
|
|
|
|
{
|
506
|
|
|
|
|
|
|
my $bits = pack("b10"x10,
|
507
|
|
|
|
|
|
|
".#.#.#.#.#",
|
508
|
|
|
|
|
|
|
".#.......#",
|
509
|
|
|
|
|
|
|
"..........",
|
510
|
|
|
|
|
|
|
".#########",
|
511
|
|
|
|
|
|
|
"..#######.",
|
512
|
|
|
|
|
|
|
".#.#####.#",
|
513
|
|
|
|
|
|
|
"....###...",
|
514
|
|
|
|
|
|
|
".#...#...#",
|
515
|
|
|
|
|
|
|
"..........",
|
516
|
|
|
|
|
|
|
".##.#.#.##"
|
517
|
|
|
|
|
|
|
);
|
518
|
|
|
|
|
|
|
$mw->DefineBitmap($FOCUSEDBITMAP => 10,10, $bits);
|
519
|
|
|
|
|
|
|
}
|
520
|
|
|
|
|
|
|
}
|
521
|
|
|
|
|
|
|
}
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub Populate
|
524
|
|
|
|
|
|
|
{
|
525
|
|
|
|
|
|
|
my ($w, $args) = @_;
|
526
|
|
|
|
|
|
|
$w->{btntakesfocus} = 0;
|
527
|
|
|
|
|
|
|
$w->{btntakesfocus} = delete ($args->{-btntakesfocus}) if (defined($args->{-btntakesfocus}));
|
528
|
|
|
|
|
|
|
$w->{arrowimage} = $args->{-arrowimage} if (defined($args->{-arrowimage}));
|
529
|
|
|
|
|
|
|
$w->{farrowimage} = delete ($args->{-farrowimage}) if (defined($args->{-farrowimage}));
|
530
|
|
|
|
|
|
|
$w->{arrowimage} ||= $w->{farrowimage} if ($w->{farrowimage});
|
531
|
|
|
|
|
|
|
$w->{mylistcmd} = $args->{-listcmd} if (defined($args->{-listcmd}));
|
532
|
|
|
|
|
|
|
$w->{takefocus} = 1;
|
533
|
|
|
|
|
|
|
$w->{takefocus} = delete ($args->{-takefocus}) if (defined($args->{-takefocus}));
|
534
|
|
|
|
|
|
|
$w->{-listwidth} = $args->{-width} if (defined($args->{-width}));
|
535
|
|
|
|
|
|
|
$w->{-maxwidth} = delete($args->{-maxwidth}) if (defined($args->{-maxwidth}));
|
536
|
|
|
|
|
|
|
$w->{-foreground} = $args->{-foreground} if (defined($args->{-foreground}));
|
537
|
|
|
|
|
|
|
$w->{-background} = $w->parent->cget(-background) || 'gray';
|
538
|
|
|
|
|
|
|
$w->{-background} = $args->{-background} if (defined($args->{-background}));
|
539
|
|
|
|
|
|
|
$w->{-textbackground} = delete($args->{-textbackground}) if (defined($args->{-textbackground}));
|
540
|
|
|
|
|
|
|
$w->{-textforeground} = delete($args->{-textforeground}) if (defined($args->{-textforeground}));
|
541
|
|
|
|
|
|
|
#unless ($^O =~ /Win/i) #FOR SOME REASON, THIS IS NEEDED IN LINUX?
|
542
|
|
|
|
|
|
|
{
|
543
|
|
|
|
|
|
|
$w->{-disabledbackground} = delete($args->{-disabledbackground}) if (defined($args->{-disabledbackground}));
|
544
|
|
|
|
|
|
|
$w->{-disabledforeground} = delete($args->{-disabledforeground}) if (defined($args->{-disabledforeground}));
|
545
|
|
|
|
|
|
|
}
|
546
|
|
|
|
|
|
|
$w->{-foreground} = $w->parent->cget(-foreground);
|
547
|
|
|
|
|
|
|
#$w->{-borderwidth} = 2;
|
548
|
|
|
|
|
|
|
# $w->{-borderwidth} = delete($args->{-borderwidth}) if (defined($args->{-borderwidth})); #CHGD. TO NEXT 20070904 FROM WOLFRAM HUMANN.
|
549
|
|
|
|
|
|
|
$w->{-borderwidth} = defined($args->{-borderwidth}) ? delete($args->{-borderwidth}) : 2;
|
550
|
|
|
|
|
|
|
$w->{-relief} = 'sunken';
|
551
|
|
|
|
|
|
|
$w->{-relief} = delete($args->{-relief}) if (defined($args->{-relief}));
|
552
|
|
|
|
|
|
|
$w->{-listrelief} = 'sunken';
|
553
|
|
|
|
|
|
|
$w->{-listrelief} = delete($args->{-listrelief}) if (defined($args->{-listrelief}));
|
554
|
|
|
|
|
|
|
$w->{-listfont} = delete($args->{-listfont}) if (defined($args->{-listfont}));
|
555
|
|
|
|
|
|
|
$w->{-noselecttext} = delete($args->{-noselecttext}) if (defined($args->{-noselecttext}));
|
556
|
|
|
|
|
|
|
$w->{-browse} = 0;
|
557
|
|
|
|
|
|
|
$w->{-browse} = delete($args->{-browse}) if (defined($args->{-browse}));
|
558
|
|
|
|
|
|
|
$w->{-tabcomplete} = 0;
|
559
|
|
|
|
|
|
|
$w->{-tabcomplete} = delete($args->{-tabcomplete}) if (defined($args->{-tabcomplete}));
|
560
|
|
|
|
|
|
|
$w->{-altbinding} = 0; #NEXT 2 ADDED 20050112 TO SUPPORT ALTERNATE KEY-ACTION MODELS.
|
561
|
|
|
|
|
|
|
$w->{-altbinding} = delete($args->{-altbinding}) if (defined($args->{-altbinding}));
|
562
|
|
|
|
|
|
|
#NEXT LINE ADDED 20060429 TO SUPPORT OPTION FOR USER DELETION OF LISTBOX ITEMS.
|
563
|
|
|
|
|
|
|
$w->{-deleteitemsok} = delete($args->{-deleteitemsok}) if (defined($args->{-deleteitemsok}));
|
564
|
|
|
|
|
|
|
$w->{-framehighlightthickness} = defined($args->{-framehighlightthickness})
|
565
|
|
|
|
|
|
|
? delete($args->{-framehighlightthickness}) : 1;
|
566
|
|
|
|
|
|
|
#NEXT 2 OPTIONS ADDED 20070904 BY JWT:
|
567
|
|
|
|
|
|
|
$w->{-buttonborderwidth} = defined($args->{-buttonborderwidth})
|
568
|
|
|
|
|
|
|
? delete($args->{-buttonborderwidth}) : 1;
|
569
|
|
|
|
|
|
|
$w->{-entryborderwidth} = defined($args->{-entryborderwidth})
|
570
|
|
|
|
|
|
|
? delete($args->{-entryborderwidth}) : 0;
|
571
|
|
|
|
|
|
|
$w->{-nobutton} = defined($args->{-nobutton})
|
572
|
|
|
|
|
|
|
? delete($args->{-nobutton}) : 0;
|
573
|
|
|
|
|
|
|
$w->{-labelrelief} = defined($args->{-labelrelief})
|
574
|
|
|
|
|
|
|
? delete($args->{-labelrelief}) : 'flat';
|
575
|
|
|
|
|
|
|
my $lpack = delete $args->{-labelPack}; #MOVED ABOVE SUPER:POPULATE 20050120.
|
576
|
|
|
|
|
|
|
$w->SUPER::Populate($args);
|
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
# ENTRY WIDGET AND ARROW BUTTON
|
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
unless (defined $lpack)
|
581
|
|
|
|
|
|
|
{
|
582
|
|
|
|
|
|
|
$lpack = [-side => "left", -anchor => "e"];
|
583
|
|
|
|
|
|
|
}
|
584
|
|
|
|
|
|
|
my $labelvalue = $args->{-label};
|
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
my $ll = $w->Label(-relief => $w->{-labelrelief}, -text => delete $args->{-label});
|
587
|
|
|
|
|
|
|
# my $tf = $w->Frame(-borderwidth => ($w->{-borderwidth} || 2), -highlightthickness => 1,
|
588
|
|
|
|
|
|
|
# -relief => ($w->{-relief} || 'sunken')); #CHGD. TO NEXT 2 20070904 FROM WOLFRAM HUMANN.
|
589
|
|
|
|
|
|
|
my $tf = $w->Frame(-borderwidth => $w->{-borderwidth}, -highlightthickness => $w->{-framehighlightthickness},
|
590
|
|
|
|
|
|
|
-relief => $w->{-relief});
|
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# my $e = $tf->LabEntry(-borderwidth => 0, -relief => 'flat');
|
593
|
|
|
|
|
|
|
my $e = $tf->LabEntry(-borderwidth => $w->{-entryborderwidth}, -relief => 'flat');
|
594
|
|
|
|
|
|
|
# FOR SOME REASON, E HAS TO BE A LABENTRY, JUST PLAIN ENTRY WOULDN'T TAKE KEYBOARD EVENTS????
|
595
|
|
|
|
|
|
|
$w->ConfigSpecs(DEFAULT => [$e]);
|
596
|
|
|
|
|
|
|
# my $b = $tf->Button(-borderwidth => 1, -takefocus => $w->{btntakesfocus}, #CHGD. TO NEXT 20070904 - JWT:
|
597
|
|
|
|
|
|
|
my $b = $tf->Button(-borderwidth => $w->{-buttonborderwidth}, -takefocus => $w->{btntakesfocus},
|
598
|
|
|
|
|
|
|
-bitmap => $BITMAP);
|
599
|
|
|
|
|
|
|
if ($labelvalue)
|
600
|
|
|
|
|
|
|
{
|
601
|
|
|
|
|
|
|
$ll->pack(@$lpack);
|
602
|
|
|
|
|
|
|
}
|
603
|
|
|
|
|
|
|
else
|
604
|
|
|
|
|
|
|
{
|
605
|
|
|
|
|
|
|
$ll->packForget(); # REMOVE LABEL, IF NO VALUE SPECIFIED.
|
606
|
|
|
|
|
|
|
}
|
607
|
|
|
|
|
|
|
$w->Advertise("entry" => $e); #TEXT PART.
|
608
|
|
|
|
|
|
|
$w->Advertise("arrow" => $b); #ARROW BUTTON PART.
|
609
|
|
|
|
|
|
|
$w->Advertise("frame" => $tf); #SURROUNDING FRAME PART.
|
610
|
|
|
|
|
|
|
my ($ee) = $w->Subwidget("entry");
|
611
|
|
|
|
|
|
|
$w->Advertise("textpart" => $ee); #TEXT COMPONENT OF LABENTRY WIDGET.
|
612
|
|
|
|
|
|
|
$tf->pack(-side => "right", -padx => 0, -pady => 0, -fill => 'x', -expand => 1);
|
613
|
|
|
|
|
|
|
$b->pack(-side => "right", -padx => 0, -pady => 0, -fill => 'y') unless ($w->{-nobutton} == 1);
|
614
|
|
|
|
|
|
|
$e->pack(-side => "right", -fill => 'x', -padx => 0, -pady => 0, -expand => 1); #, -padx => 1);
|
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# POPUP SHELL FOR LISTBOX WITH VALUES.
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
my $c = $w->Toplevel(-bd => 2, -relief => "raised");
|
619
|
|
|
|
|
|
|
$c->overrideredirect(1);
|
620
|
|
|
|
|
|
|
$c->withdraw;
|
621
|
|
|
|
|
|
|
my $sl = $c->Scrolled( qw/Listbox -selectmode browse -scrollbars oe/ );
|
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
# PROPOGATE FORE & BACKGROUND COLORS TO ALL WIDGETS, IF SPECIFIED.
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
if (defined($w->{-foreground}))
|
626
|
|
|
|
|
|
|
{
|
627
|
|
|
|
|
|
|
$e->configure(-foreground => $w->{-foreground}, -highlightcolor => $w->{-foreground});
|
628
|
|
|
|
|
|
|
$tf->configure(-foreground => $w->{-foreground}, -highlightcolor => $w->{-foreground});
|
629
|
|
|
|
|
|
|
$sl->configure(-foreground => $w->{-foreground}, -highlightcolor => $w->{-foreground});
|
630
|
|
|
|
|
|
|
$b->configure(-foreground => $w->{-foreground}, -highlightcolor => $w->{-foreground});
|
631
|
|
|
|
|
|
|
}
|
632
|
|
|
|
|
|
|
if (defined($w->{-listrelief}))
|
633
|
|
|
|
|
|
|
{
|
634
|
|
|
|
|
|
|
$sl->configure(-relief => ($w->{-listrelief}||'sunken'));
|
635
|
|
|
|
|
|
|
}
|
636
|
|
|
|
|
|
|
if (defined($w->{-background}) || defined($w->{-textbackground}))
|
637
|
|
|
|
|
|
|
{
|
638
|
|
|
|
|
|
|
$e->configure(-background => ($w->{-textbackground}||$w->{-background}), -highlightbackground => $w->{-background});
|
639
|
|
|
|
|
|
|
$tf->configure(-background => $w->{-background}, -highlightbackground => $w->{-background});
|
640
|
|
|
|
|
|
|
$sl->configure(-background => $w->{-background}, -highlightbackground => $w->{-background});
|
641
|
|
|
|
|
|
|
$b->configure(-background => $w->{-background}, -highlightbackground => $w->{-background});
|
642
|
|
|
|
|
|
|
}
|
643
|
|
|
|
|
|
|
elsif ($^O =~ /Win/i) # SET BACKGROUND TO WINDOWS DEFAULTS (IF NOT SPECIFIED)
|
644
|
|
|
|
|
|
|
{
|
645
|
|
|
|
|
|
|
$sl->configure( -background => 'SystemWindow' );
|
646
|
|
|
|
|
|
|
}
|
647
|
|
|
|
|
|
|
if ($^O =~ /Win/i)
|
648
|
|
|
|
|
|
|
{
|
649
|
|
|
|
|
|
|
$sl->configure( -borderwidth => 1);
|
650
|
|
|
|
|
|
|
$c->configure( -borderwidth => ($w->{-borderwidth}||0), -relief => 'ridge' );
|
651
|
|
|
|
|
|
|
}
|
652
|
|
|
|
|
|
|
if (defined($w->{-disabledforeground})) #THIS ERRS ON LINUX SOMETIMES?!
|
653
|
|
|
|
|
|
|
{
|
654
|
|
|
|
|
|
|
eval { $e->Subwidget("entry")->configure(-disabledforeground => $w->{-disabledforeground}); };
|
655
|
|
|
|
|
|
|
}
|
656
|
|
|
|
|
|
|
if (defined($w->{-disabledbackground}))
|
657
|
|
|
|
|
|
|
{
|
658
|
|
|
|
|
|
|
eval { $e->configure(-disabledbackground => $w->{-disabledbackground}); };
|
659
|
|
|
|
|
|
|
}
|
660
|
|
|
|
|
|
|
$sl->configure(-font => $w->{-listfont}) if ($w->{-listfont});
|
661
|
|
|
|
|
|
|
$w->Advertise("choices" => $c); #LISTBOX POPUP MAIN WINDOW PART.
|
662
|
|
|
|
|
|
|
$w->Advertise("slistbox" => $sl); #ACTUAL LISTBOX ITSELF.
|
663
|
|
|
|
|
|
|
$sl->pack(-expand => 1, -fill => "both");
|
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# OTHER INITIALIZATIONS.
|
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
$w->SetBindings;
|
668
|
|
|
|
|
|
|
$w->{"popped"} = 0;
|
669
|
|
|
|
|
|
|
$w->Delegates('insert' => $sl, 'delete' => $sl, get => $sl, DEFAULT => $e);
|
670
|
|
|
|
|
|
|
$w->ConfigSpecs(
|
671
|
|
|
|
|
|
|
-listwidth => [qw/PASSIVE listWidth ListWidth/, undef],
|
672
|
|
|
|
|
|
|
-maxwidth => [qw/PASSIVE maxWidth MaxWidth/, undef],
|
673
|
|
|
|
|
|
|
-height => [qw/PASSIVE height Height/, undef],
|
674
|
|
|
|
|
|
|
-listcmd => [qw/CALLBACK listCmd ListCmd/, undef],
|
675
|
|
|
|
|
|
|
-browsecmd => [qw/CALLBACK browseCmd BrowseCmd/, undef],
|
676
|
|
|
|
|
|
|
-choices => [qw/METHOD choices Choices/, undef],
|
677
|
|
|
|
|
|
|
-state => [qw/METHOD state State normal/],
|
678
|
|
|
|
|
|
|
-arrowimage => [ {-image => $b}, qw/arrowImage ArrowImage/, undef],
|
679
|
|
|
|
|
|
|
-variable => "-textvariable",
|
680
|
|
|
|
|
|
|
-colorstate => [qw/PASSIVE colorState ColorState/, undef],
|
681
|
|
|
|
|
|
|
-default => "-textvariable",
|
682
|
|
|
|
|
|
|
-imgname => '',
|
683
|
|
|
|
|
|
|
-img0 => '',
|
684
|
|
|
|
|
|
|
-img1 => '',
|
685
|
|
|
|
|
|
|
DEFAULT => [$e] );
|
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
#SET UP DUMMY SO IT DISPLAYSS IF NO VARIABLE SPECIFIED.
|
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
unless (defined($var_ref) && ref($var_ref))
|
692
|
|
|
|
|
|
|
{
|
693
|
|
|
|
|
|
|
$var_ref = '';
|
694
|
|
|
|
|
|
|
$w->configure(-textvariable => \$var_ref);
|
695
|
|
|
|
|
|
|
}
|
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
eval { $w->{'default'} = $_[1]->{'-default'} || ${$_[1]->{-variable}}; };
|
698
|
|
|
|
|
|
|
}
|
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub focus
|
701
|
|
|
|
|
|
|
{
|
702
|
|
|
|
|
|
|
my ($w) = shift;
|
703
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
if ($state eq 'disabled') #MOVE FOCUS ON TO NEXT WIDGET (DON'T TAKE FOCUS).
|
706
|
|
|
|
|
|
|
{
|
707
|
|
|
|
|
|
|
eval {$w->focusNext->focus; };
|
708
|
|
|
|
|
|
|
}
|
709
|
|
|
|
|
|
|
else
|
710
|
|
|
|
|
|
|
{
|
711
|
|
|
|
|
|
|
if ($w->{'savefocus'} && Tk::Exists($w->{'savefocus'}))
|
712
|
|
|
|
|
|
|
{
|
713
|
|
|
|
|
|
|
$w->{'savefocus'}->focus;
|
714
|
|
|
|
|
|
|
}
|
715
|
|
|
|
|
|
|
elsif ($state eq 'readonly') #FRAME GETS FOCUS IF READONLY.
|
716
|
|
|
|
|
|
|
{
|
717
|
|
|
|
|
|
|
$w->Subwidget("frame")->focus;
|
718
|
|
|
|
|
|
|
}
|
719
|
|
|
|
|
|
|
else #OTHERWISE, TEXT ENTRY COMPONENT DOES.
|
720
|
|
|
|
|
|
|
{
|
721
|
|
|
|
|
|
|
$w->Subwidget("entry")->focus;
|
722
|
|
|
|
|
|
|
}
|
723
|
|
|
|
|
|
|
delete $w->{'savefocus'};
|
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
#BUTTON GETS FOCUS IF BUTTON TAKES FOCUS, BUT WIDGET ITSELF DOESN'T.
|
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
$w->Subwidget("arrow")->focus if (!$w->{takefocus} && $w->{btntakesfocus});
|
728
|
|
|
|
|
|
|
$w->Subwidget("entry")->icursor('end');
|
729
|
|
|
|
|
|
|
unless ($w->{-noselecttext} || !$w->Subwidget("entry")->index('end'))
|
730
|
|
|
|
|
|
|
{
|
731
|
|
|
|
|
|
|
$w->Subwidget("entry")->selectionRange(0,'end'); # unless ($state eq 'readonly' && $w->{btntakesfocus});
|
732
|
|
|
|
|
|
|
}
|
733
|
|
|
|
|
|
|
}
|
734
|
|
|
|
|
|
|
}
|
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub SetBindings
|
737
|
|
|
|
|
|
|
{
|
738
|
|
|
|
|
|
|
my ($w) = @_;
|
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
my $e = $w->Subwidget("entry");
|
741
|
|
|
|
|
|
|
my $f = $w->Subwidget("frame");
|
742
|
|
|
|
|
|
|
my $b = $w->Subwidget("arrow");
|
743
|
|
|
|
|
|
|
my $sl = $w->Subwidget("slistbox");
|
744
|
|
|
|
|
|
|
my $l = $sl->Subwidget("listbox");
|
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
local *returnFn = sub #HANDLES RETURN-KEY PRESSED IN ENTRY AREA.
|
747
|
|
|
|
|
|
|
{
|
748
|
|
|
|
|
|
|
shift;
|
749
|
|
|
|
|
|
|
my $keyModifier = shift || '';
|
750
|
|
|
|
|
|
|
$keyModifier .= '-' if ($keyModifier =~ /\S/o);
|
751
|
|
|
|
|
|
|
my $altbinding = $w->{-altbinding};
|
752
|
|
|
|
|
|
|
#print "returnFn0: alt=$altbinding= modifier=$keyModifier=\n";
|
753
|
|
|
|
|
|
|
if ($altbinding =~ /Return\=Next/io)
|
754
|
|
|
|
|
|
|
{
|
755
|
|
|
|
|
|
|
#print "returnFn1: popped=".$w->{"popped"}."=\n";
|
756
|
|
|
|
|
|
|
$w->Popdown if ($w->{"popped"}); #UNDISPLAYS LISTBOX.
|
757
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, "entry.${keyModifier}return.browse")
|
758
|
|
|
|
|
|
|
if ($w->{-browse} == 1);
|
759
|
|
|
|
|
|
|
eval { shift->focusNext->focus; };
|
760
|
|
|
|
|
|
|
Tk->break;
|
761
|
|
|
|
|
|
|
}
|
762
|
|
|
|
|
|
|
elsif ($altbinding =~ /Return\=Go/io)
|
763
|
|
|
|
|
|
|
{
|
764
|
|
|
|
|
|
|
$w->Popdown if ($w->{"popped"}); #UNDISPLAYS LISTBOX.
|
765
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, "entry.${keyModifier}return.go");
|
766
|
|
|
|
|
|
|
Tk->break;
|
767
|
|
|
|
|
|
|
}
|
768
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
&LbFindSelection($w);
|
771
|
|
|
|
|
|
|
#print "returnFn2: popped=".$w->{"popped"}."=\n";
|
772
|
|
|
|
|
|
|
unless ($w->{"popped"})
|
773
|
|
|
|
|
|
|
{
|
774
|
|
|
|
|
|
|
$w->BtnDown;
|
775
|
|
|
|
|
|
|
return if ($state =~ /text/o || $state eq 'disabled');
|
776
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
777
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
778
|
|
|
|
|
|
|
}
|
779
|
|
|
|
|
|
|
else
|
780
|
|
|
|
|
|
|
{
|
781
|
|
|
|
|
|
|
$w->LbCopySelection(0,'entry.enter');
|
782
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
783
|
|
|
|
|
|
|
$e->icursor('end');
|
784
|
|
|
|
|
|
|
Tk->break;
|
785
|
|
|
|
|
|
|
}
|
786
|
|
|
|
|
|
|
};
|
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
local *rightFn = sub
|
789
|
|
|
|
|
|
|
{
|
790
|
|
|
|
|
|
|
Tk->break if ($e->index('insert') < $e->index('end')
|
791
|
|
|
|
|
|
|
|| $w->{-altbinding} =~ /Right=NoSearch/io);
|
792
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
793
|
|
|
|
|
|
|
return if ($state eq 'textonly' || $state eq 'disabled');
|
794
|
|
|
|
|
|
|
my $srchPattern = $w->cget( "-textvariable" );
|
795
|
|
|
|
|
|
|
&LbFindSelection($w, $srchPattern);
|
796
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
797
|
|
|
|
|
|
|
my (@listsels) = $l->get('0','end');
|
798
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
799
|
|
|
|
|
|
|
if (&LbFindSelection($w) == 1 && &LbFindSelection($w, $srchPattern))
|
800
|
|
|
|
|
|
|
{
|
801
|
|
|
|
|
|
|
$index += 1;
|
802
|
|
|
|
|
|
|
$index = 0 if ($index > $#listsels);
|
803
|
|
|
|
|
|
|
}
|
804
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
805
|
|
|
|
|
|
|
$$var_ref = $listsels[$index];
|
806
|
|
|
|
|
|
|
$e->icursor('end');
|
807
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
808
|
|
|
|
|
|
|
};
|
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
local *downFn = sub #HANDLES DOWN-ARROW PRESSED IN ENTRY AREA.
|
811
|
|
|
|
|
|
|
{
|
812
|
|
|
|
|
|
|
my $altbinding = $w->{-altbinding};
|
813
|
|
|
|
|
|
|
#print STDERR "-downFn: altbinding=$altbinding/$w->{-altbinding}= w=$w=\n";
|
814
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
815
|
|
|
|
|
|
|
return if ($state eq 'textonly' || $state eq 'disabled');
|
816
|
|
|
|
|
|
|
&LbFindSelection($w);
|
817
|
|
|
|
|
|
|
if ($altbinding =~ /Down\=Popup/io) #MAKE DOWN-ARROW POP UP DD-LIST.
|
818
|
|
|
|
|
|
|
{
|
819
|
|
|
|
|
|
|
unless ($w->{"popped"})
|
820
|
|
|
|
|
|
|
{
|
821
|
|
|
|
|
|
|
$w->BtnDown;
|
822
|
|
|
|
|
|
|
return if ($state =~ /text/o || $state eq 'disabled');
|
823
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
824
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
825
|
|
|
|
|
|
|
}
|
826
|
|
|
|
|
|
|
else
|
827
|
|
|
|
|
|
|
{
|
828
|
|
|
|
|
|
|
$w->LbCopySelection(0,'entry.down');
|
829
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
830
|
|
|
|
|
|
|
$e->icursor('end');
|
831
|
|
|
|
|
|
|
Tk->break;
|
832
|
|
|
|
|
|
|
}
|
833
|
|
|
|
|
|
|
return;
|
834
|
|
|
|
|
|
|
}
|
835
|
|
|
|
|
|
|
if ($w->{"popped"})
|
836
|
|
|
|
|
|
|
{
|
837
|
|
|
|
|
|
|
return if ($state eq 'text');
|
838
|
|
|
|
|
|
|
&LbFindSelection($w);
|
839
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
840
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
841
|
|
|
|
|
|
|
}
|
842
|
|
|
|
|
|
|
else
|
843
|
|
|
|
|
|
|
{
|
844
|
|
|
|
|
|
|
&LbFindSelection($w);
|
845
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
846
|
|
|
|
|
|
|
my (@listsels) = $l->get('0','end');
|
847
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
848
|
|
|
|
|
|
|
if (&LbFindSelection($w) == 1)
|
849
|
|
|
|
|
|
|
{
|
850
|
|
|
|
|
|
|
$index += 1;
|
851
|
|
|
|
|
|
|
$index = 0 if ($index > $#listsels);
|
852
|
|
|
|
|
|
|
}
|
853
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
854
|
|
|
|
|
|
|
$$var_ref = $listsels[$index];
|
855
|
|
|
|
|
|
|
$l->activate($index); #ADDED 20070904 PER PATCH FROM WOLFRAM HUMANN.
|
856
|
|
|
|
|
|
|
$e->icursor('end');
|
857
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
858
|
|
|
|
|
|
|
}
|
859
|
|
|
|
|
|
|
};
|
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
local *upFn = sub #HANDLES UP-ARROW PRESSED IN ENTRY AREA.
|
862
|
|
|
|
|
|
|
{
|
863
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
864
|
|
|
|
|
|
|
return if ($state eq 'textonly' || $state eq 'disabled');
|
865
|
|
|
|
|
|
|
if ($w->{"popped"})
|
866
|
|
|
|
|
|
|
{
|
867
|
|
|
|
|
|
|
return if ($state eq 'text');
|
868
|
|
|
|
|
|
|
&LbFindSelection($w);
|
869
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
870
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
871
|
|
|
|
|
|
|
}
|
872
|
|
|
|
|
|
|
else
|
873
|
|
|
|
|
|
|
{
|
874
|
|
|
|
|
|
|
&LbFindSelection($w);
|
875
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
876
|
|
|
|
|
|
|
my (@listsels) = $l->get('0','end');
|
877
|
|
|
|
|
|
|
my $index = $w->LbIndex - 1;
|
878
|
|
|
|
|
|
|
$index = $#listsels if ($index < 0);
|
879
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
880
|
|
|
|
|
|
|
$$var_ref = $listsels[$index];
|
881
|
|
|
|
|
|
|
$l->activate($index); #ADDED 20070904 PER PATCH FROM WOLFRAM HUMANN.
|
882
|
|
|
|
|
|
|
$e->icursor('end');
|
883
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
884
|
|
|
|
|
|
|
}
|
885
|
|
|
|
|
|
|
};
|
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
local *escapeFn = sub #HANDLES ESCAPE-KEY PRESSED IN ENTRY AREA.
|
888
|
|
|
|
|
|
|
{
|
889
|
|
|
|
|
|
|
if ($w->{"popped"})
|
890
|
|
|
|
|
|
|
{
|
891
|
|
|
|
|
|
|
$w->Popdown;
|
892
|
|
|
|
|
|
|
}
|
893
|
|
|
|
|
|
|
else
|
894
|
|
|
|
|
|
|
{
|
895
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
896
|
|
|
|
|
|
|
#if ($$var_ref eq $w->{'default'} && $w->cget( "-state" ) ne "readonly")
|
897
|
|
|
|
|
|
|
#CHGD. TO NEXT 20030531 PER PATCH BY FRANK HERRMANN.
|
898
|
|
|
|
|
|
|
if (defined $w->{'default'} and $$var_ref eq $w->{'default'}
|
899
|
|
|
|
|
|
|
and $w->cget( "-state" ) ne "readonly")
|
900
|
|
|
|
|
|
|
{
|
901
|
|
|
|
|
|
|
$$var_ref = '';
|
902
|
|
|
|
|
|
|
}
|
903
|
|
|
|
|
|
|
else
|
904
|
|
|
|
|
|
|
{
|
905
|
|
|
|
|
|
|
$$var_ref = $w->{'default'};
|
906
|
|
|
|
|
|
|
}
|
907
|
|
|
|
|
|
|
$e->icursor('end');
|
908
|
|
|
|
|
|
|
}
|
909
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end')); #ADDED 20020716
|
910
|
|
|
|
|
|
|
Tk->break;
|
911
|
|
|
|
|
|
|
};
|
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
local *spacebarFn = sub #HANDLES SPACEBAR PRESSED IN ENTRY AREA.
|
914
|
|
|
|
|
|
|
{
|
915
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
if ($state eq 'readonly')
|
918
|
|
|
|
|
|
|
{
|
919
|
|
|
|
|
|
|
my $res = &LbFindSelection($w);
|
920
|
|
|
|
|
|
|
unless ($w->{"popped"})
|
921
|
|
|
|
|
|
|
{
|
922
|
|
|
|
|
|
|
$w->BtnDown;
|
923
|
|
|
|
|
|
|
unless ($res) #ADDED 20090320 TO CAUSE DROPDOWN LIST TO POP DOWN W/ACTIVE CURSOR IN RIGHT PLACE (INSTEAD OF BOTTOM) IF ENTRY FIELD EMPTY.
|
924
|
|
|
|
|
|
|
{
|
925
|
|
|
|
|
|
|
$l->selectionClear('0','end');
|
926
|
|
|
|
|
|
|
$l->activate(0);
|
927
|
|
|
|
|
|
|
$l->selectionSet(0);
|
928
|
|
|
|
|
|
|
$l->update();
|
929
|
|
|
|
|
|
|
$l->see(0);
|
930
|
|
|
|
|
|
|
}
|
931
|
|
|
|
|
|
|
return if ($state =~ /text/o || $state eq 'disabled');
|
932
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
933
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
934
|
|
|
|
|
|
|
}
|
935
|
|
|
|
|
|
|
else
|
936
|
|
|
|
|
|
|
{
|
937
|
|
|
|
|
|
|
$w->LbCopySelection(0,'entry.space');
|
938
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
939
|
|
|
|
|
|
|
$e->icursor('end');
|
940
|
|
|
|
|
|
|
Tk->break;
|
941
|
|
|
|
|
|
|
}
|
942
|
|
|
|
|
|
|
}
|
943
|
|
|
|
|
|
|
};
|
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# SET BIND TAGS
|
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
$w->bindtags([$w, 'Tk::JBrowseEntry', $w->toplevel, "all"]);
|
948
|
|
|
|
|
|
|
$e->bindtags([$e, $e->toplevel, "all"]);
|
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
# IF USER-SPECIFIED IMAGE(S), CHANGE BUTTON IMAGE WHEN GETTING/LOSING FOCUS.
|
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
$b->bind("", sub
|
953
|
|
|
|
|
|
|
{
|
954
|
|
|
|
|
|
|
$b = shift;
|
955
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
956
|
|
|
|
|
|
|
my $img = $w->{farrowimage} || $b->cget('-image');
|
957
|
|
|
|
|
|
|
if ($img)
|
958
|
|
|
|
|
|
|
{
|
959
|
|
|
|
|
|
|
unless ($w->{img0})
|
960
|
|
|
|
|
|
|
{
|
961
|
|
|
|
|
|
|
$w->{img0} = $img;
|
962
|
|
|
|
|
|
|
}
|
963
|
|
|
|
|
|
|
$b->configure(-image => $w->{img0});
|
964
|
|
|
|
|
|
|
}
|
965
|
|
|
|
|
|
|
elsif ($^O =~ /Win/io)
|
966
|
|
|
|
|
|
|
{
|
967
|
|
|
|
|
|
|
$w->{img0} = $FOCUSEDBITMAP;
|
968
|
|
|
|
|
|
|
$b->configure(-bitmap => $w->{img0});
|
969
|
|
|
|
|
|
|
}
|
970
|
|
|
|
|
|
|
$w->{imgname} = 'cbfarrow';
|
971
|
|
|
|
|
|
|
$w->{savehl} = $f->cget(-highlightcolor);
|
972
|
|
|
|
|
|
|
my $framehlcolor;
|
973
|
|
|
|
|
|
|
if ($^O =~ /Win/io)
|
974
|
|
|
|
|
|
|
{
|
975
|
|
|
|
|
|
|
$framehlcolor = $w->{-background} || 'SystemButtonFace';
|
976
|
|
|
|
|
|
|
}
|
977
|
|
|
|
|
|
|
else
|
978
|
|
|
|
|
|
|
{
|
979
|
|
|
|
|
|
|
$framehlcolor = $w->{-background} || $e->cget( -background );
|
980
|
|
|
|
|
|
|
}
|
981
|
|
|
|
|
|
|
$f->configure(-highlightcolor => $framehlcolor);
|
982
|
|
|
|
|
|
|
}
|
983
|
|
|
|
|
|
|
);
|
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
$b->bind("", sub
|
986
|
|
|
|
|
|
|
{
|
987
|
|
|
|
|
|
|
$b = shift;
|
988
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
989
|
|
|
|
|
|
|
my $img = $w->{arrowimage} || $b->cget('-image');
|
990
|
|
|
|
|
|
|
if ($img)
|
991
|
|
|
|
|
|
|
{
|
992
|
|
|
|
|
|
|
unless ($w->{img1})
|
993
|
|
|
|
|
|
|
{
|
994
|
|
|
|
|
|
|
$w->{img1} = $img;
|
995
|
|
|
|
|
|
|
}
|
996
|
|
|
|
|
|
|
$b->configure(-image => $w->{img1});
|
997
|
|
|
|
|
|
|
}
|
998
|
|
|
|
|
|
|
elsif ($^O =~ /Win/io)
|
999
|
|
|
|
|
|
|
{
|
1000
|
|
|
|
|
|
|
$w->{img1} = $BITMAP;
|
1001
|
|
|
|
|
|
|
$b->configure(-bitmap => $w->{img1});
|
1002
|
|
|
|
|
|
|
}
|
1003
|
|
|
|
|
|
|
$w->{imgname} = 'cbxarrow';
|
1004
|
|
|
|
|
|
|
$f->configure(-highlightcolor => $w->{savehl}) if ($w->{savehl});
|
1005
|
|
|
|
|
|
|
}
|
1006
|
|
|
|
|
|
|
);
|
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
$b->bind('<1>', sub #MOUSE CLICKED ON BUTTON.
|
1009
|
|
|
|
|
|
|
{
|
1010
|
|
|
|
|
|
|
my ($state) = $b->cget( "-state" );
|
1011
|
|
|
|
|
|
|
unless ($state eq 'disabled')
|
1012
|
|
|
|
|
|
|
{
|
1013
|
|
|
|
|
|
|
&LbFindSelection($w) if ($w->{popped});
|
1014
|
|
|
|
|
|
|
$w->BtnDown; #POPS UP LISTBOX!
|
1015
|
|
|
|
|
|
|
if ($w->{popped})
|
1016
|
|
|
|
|
|
|
{
|
1017
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
1018
|
|
|
|
|
|
|
$index = 0 if (!defined($index) || $index < 0);
|
1019
|
|
|
|
|
|
|
$l->focus;
|
1020
|
|
|
|
|
|
|
$l->activate($index); #THIS UNDERLINES IT.
|
1021
|
|
|
|
|
|
|
$l->selectionClear(0,'end'); #THIS HIGHLIGHTS IT (NEEDED 1ST TIME?!)
|
1022
|
|
|
|
|
|
|
$l->selectionSet($index); #THIS HIGHLIGHTS IT (NEEDED 1ST TIME?!)
|
1023
|
|
|
|
|
|
|
}
|
1024
|
|
|
|
|
|
|
$w->LbCopySelection(1,'buttondown.button1');
|
1025
|
|
|
|
|
|
|
}
|
1026
|
|
|
|
|
|
|
Tk->break;
|
1027
|
|
|
|
|
|
|
}
|
1028
|
|
|
|
|
|
|
);
|
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
$b->bind("", sub {
|
1031
|
|
|
|
|
|
|
my ($state) = $b->cget( "-state" );
|
1032
|
|
|
|
|
|
|
if ($state ne 'disabled' && $w->{'popped'}) #LISTBOX IS SHOWING
|
1033
|
|
|
|
|
|
|
{
|
1034
|
|
|
|
|
|
|
$w->LbCopySelection(1,'buttonup.button1');
|
1035
|
|
|
|
|
|
|
}
|
1036
|
|
|
|
|
|
|
Tk->break;
|
1037
|
|
|
|
|
|
|
}
|
1038
|
|
|
|
|
|
|
);
|
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
$b->bind("", sub
|
1041
|
|
|
|
|
|
|
{
|
1042
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1043
|
|
|
|
|
|
|
return if ($state =~ /text/o || $state eq 'disabled');
|
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
&LbFindSelection($w);
|
1046
|
|
|
|
|
|
|
$w->BtnDown;
|
1047
|
|
|
|
|
|
|
$w->{'savefocus'} = $b || $w->focusCurrent;
|
1048
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
1049
|
|
|
|
|
|
|
}
|
1050
|
|
|
|
|
|
|
);
|
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
$b->bind("", sub
|
1053
|
|
|
|
|
|
|
{
|
1054
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1055
|
|
|
|
|
|
|
return if ($state =~ /text/o || $state eq 'disabled');
|
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
&LbFindSelection($w);
|
1058
|
|
|
|
|
|
|
$w->BtnDown;
|
1059
|
|
|
|
|
|
|
$w->{'savefocus'} = $b || $w->focusCurrent;
|
1060
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
1061
|
|
|
|
|
|
|
Tk->break;
|
1062
|
|
|
|
|
|
|
}
|
1063
|
|
|
|
|
|
|
);
|
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
$b->bind("", sub
|
1066
|
|
|
|
|
|
|
{
|
1067
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1068
|
|
|
|
|
|
|
return if ($state =~ /text/ || $state eq 'disabled');
|
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
&LbFindSelection($w);
|
1071
|
|
|
|
|
|
|
$w->BtnDown;
|
1072
|
|
|
|
|
|
|
$w->{'savefocus'} = $b || $w->focusCurrent;
|
1073
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
1074
|
|
|
|
|
|
|
Tk->break;
|
1075
|
|
|
|
|
|
|
}
|
1076
|
|
|
|
|
|
|
);
|
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
$e->bind("", [\&returnFn, 'mod.Shift']);
|
1079
|
|
|
|
|
|
|
$f->bind("", [\&returnFn, 'mod.Shift']);
|
1080
|
|
|
|
|
|
|
$e->bind("", [\&returnFn, 'mod.Control']);
|
1081
|
|
|
|
|
|
|
$f->bind("", [\&returnFn, 'mod.Control']);
|
1082
|
|
|
|
|
|
|
$e->bind("", [\&returnFn, 'mod.Alt']);
|
1083
|
|
|
|
|
|
|
$f->bind("", [\&returnFn, 'mod.Alt']);
|
1084
|
|
|
|
|
|
|
$e->bind("", \&returnFn);
|
1085
|
|
|
|
|
|
|
$f->bind("", \&returnFn);
|
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
$e->bind("", \&downFn);
|
1088
|
|
|
|
|
|
|
$f->bind("", \&downFn);
|
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
$e->bind("", \&spacebarFn);
|
1091
|
|
|
|
|
|
|
$f->bind("", \&spacebarFn);
|
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
$e->bind("", \&upFn);
|
1094
|
|
|
|
|
|
|
$f->bind("", \&upFn);
|
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
$e->bind('' => \&escapeFn);
|
1097
|
|
|
|
|
|
|
$f->bind('' => \&escapeFn);
|
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
$e->bind("", sub {Tk->break;});
|
1100
|
|
|
|
|
|
|
#$e->bind("", sub {Tk->break;});
|
1101
|
|
|
|
|
|
|
$e->bind("", \&rightFn);
|
1102
|
|
|
|
|
|
|
$f->bind("", sub {Tk->break;});
|
1103
|
|
|
|
|
|
|
#$f->bind("", sub {Tk->break;});
|
1104
|
|
|
|
|
|
|
$f->bind("", \&rightFn);
|
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
$e->bind("<>", sub #ADDED 20070904 PER PATCH FROM WOLFRAM HUMANN.
|
1107
|
|
|
|
|
|
|
{
|
1108
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1109
|
|
|
|
|
|
|
$w->Popdown if ($w->{"popped"});
|
1110
|
|
|
|
|
|
|
$w->focusPrev if ($state =~ /only/o);
|
1111
|
|
|
|
|
|
|
$w->focusCurrent->focusPrev;
|
1112
|
|
|
|
|
|
|
$w->focusCurrent->focusPrev unless ($state =~ /only/o);
|
1113
|
|
|
|
|
|
|
Tk->break;
|
1114
|
|
|
|
|
|
|
});
|
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
$e->bind("", sub
|
1117
|
|
|
|
|
|
|
{
|
1118
|
|
|
|
|
|
|
my $same = 1;
|
1119
|
|
|
|
|
|
|
#NEXT LINE ADDED 20030531 PER PATCH BY FRANK HERRMANN.
|
1120
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, 'entry.tab')
|
1121
|
|
|
|
|
|
|
if ($w->{-browse} == 1);
|
1122
|
|
|
|
|
|
|
if ($w->{-tabcomplete})
|
1123
|
|
|
|
|
|
|
{
|
1124
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
1125
|
|
|
|
|
|
|
if (&LbFindSelection($w))
|
1126
|
|
|
|
|
|
|
{
|
1127
|
|
|
|
|
|
|
my @listsels = $l->get('0','end');
|
1128
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
1129
|
|
|
|
|
|
|
unless ($$var_ref eq $listsels[$index])
|
1130
|
|
|
|
|
|
|
{
|
1131
|
|
|
|
|
|
|
$$var_ref = $listsels[$index];
|
1132
|
|
|
|
|
|
|
$e->icursor('end');
|
1133
|
|
|
|
|
|
|
$same = 0;
|
1134
|
|
|
|
|
|
|
}
|
1135
|
|
|
|
|
|
|
}
|
1136
|
|
|
|
|
|
|
elsif ($w->{-tabcomplete} == 2)
|
1137
|
|
|
|
|
|
|
{
|
1138
|
|
|
|
|
|
|
#THIS CODE FORCES TAB TO CHANGE TEXT ENTERED TO A LIST ITEM!
|
1139
|
|
|
|
|
|
|
#THIS SUCKS IF THERE IS NO LIST OR USER WISHES TO OVERRIDE!
|
1140
|
|
|
|
|
|
|
unless ($$var_ref eq ((defined $w->{'default'}) ? $w->{'default'} : ''))
|
1141
|
|
|
|
|
|
|
{
|
1142
|
|
|
|
|
|
|
if (defined $w->{'default'})
|
1143
|
|
|
|
|
|
|
{
|
1144
|
|
|
|
|
|
|
$$var_ref = $w->{'default'};
|
1145
|
|
|
|
|
|
|
}
|
1146
|
|
|
|
|
|
|
else
|
1147
|
|
|
|
|
|
|
{
|
1148
|
|
|
|
|
|
|
$$var_ref = '';
|
1149
|
|
|
|
|
|
|
}
|
1150
|
|
|
|
|
|
|
$e->icursor('end');
|
1151
|
|
|
|
|
|
|
$same = 0;
|
1152
|
|
|
|
|
|
|
}
|
1153
|
|
|
|
|
|
|
}
|
1154
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
1155
|
|
|
|
|
|
|
}
|
1156
|
|
|
|
|
|
|
if ($w->{"popped"}) #UNDISPLAYS LISTBOX.
|
1157
|
|
|
|
|
|
|
{
|
1158
|
|
|
|
|
|
|
$w->Popdown;
|
1159
|
|
|
|
|
|
|
}
|
1160
|
|
|
|
|
|
|
eval { shift->focusNext->focus; } if ($same);
|
1161
|
|
|
|
|
|
|
Tk->break;
|
1162
|
|
|
|
|
|
|
}
|
1163
|
|
|
|
|
|
|
);
|
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
$f->bind("", sub
|
1166
|
|
|
|
|
|
|
{
|
1167
|
|
|
|
|
|
|
#NEXT LINE ADDED 20030531 PER PATCH BY FRANK HERRMANN.
|
1168
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, 'frame.tab')
|
1169
|
|
|
|
|
|
|
if ($w->{-browse} == 1);
|
1170
|
|
|
|
|
|
|
$w->Popdown if ($w->{"popped"});
|
1171
|
|
|
|
|
|
|
eval { shift->focusNext->focus; };
|
1172
|
|
|
|
|
|
|
}
|
1173
|
|
|
|
|
|
|
);
|
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
# KEYBOARD BINDINGS FOR LISTBOX
|
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
$l->configure(-selectmode => 'browse');
|
1178
|
|
|
|
|
|
|
$l->configure(-takefocus => 1);
|
1179
|
|
|
|
|
|
|
$l->bind("", sub
|
1180
|
|
|
|
|
|
|
{
|
1181
|
|
|
|
|
|
|
$w->ButtonHack;
|
1182
|
|
|
|
|
|
|
LbChoose($w, $l->XEvent->x, $l->XEvent->y);
|
1183
|
|
|
|
|
|
|
Tk->break; #ADDED 20050210.
|
1184
|
|
|
|
|
|
|
}
|
1185
|
|
|
|
|
|
|
);
|
1186
|
|
|
|
|
|
|
$l->bind('' => sub
|
1187
|
|
|
|
|
|
|
{
|
1188
|
|
|
|
|
|
|
$w->LbClose;
|
1189
|
|
|
|
|
|
|
Tk->break;
|
1190
|
|
|
|
|
|
|
}
|
1191
|
|
|
|
|
|
|
);
|
1192
|
|
|
|
|
|
|
$l->bind('' => sub
|
1193
|
|
|
|
|
|
|
{
|
1194
|
|
|
|
|
|
|
$w->LbCopySelection(0,'listbox.enter');
|
1195
|
|
|
|
|
|
|
#$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
1196
|
|
|
|
|
|
|
#$e->icursor('end');
|
1197
|
|
|
|
|
|
|
Tk->break;
|
1198
|
|
|
|
|
|
|
}
|
1199
|
|
|
|
|
|
|
);
|
1200
|
|
|
|
|
|
|
$l->bind('' => sub
|
1201
|
|
|
|
|
|
|
{
|
1202
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1203
|
|
|
|
|
|
|
$w->LbCopySelection(0,'listbox.space');
|
1204
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
1205
|
|
|
|
|
|
|
$e->icursor('end');
|
1206
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent; #ADDED 20060621 TO ALLOW JFILEDIALOG TO SET FOCUS TO ANOTHER WIDGET WHEN USER SELECTS VIA SPACEBAR.
|
1207
|
|
|
|
|
|
|
Tk->break;
|
1208
|
|
|
|
|
|
|
}
|
1209
|
|
|
|
|
|
|
);
|
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
$l->bind('' => sub
|
1212
|
|
|
|
|
|
|
{
|
1213
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1214
|
|
|
|
|
|
|
$w->Popdown if ($^O !~ /Win/i && !$w->{takefocus}); #WINDUHS LOWERS LISTBOX BEHIND CALLER (HIDES IT)!
|
1215
|
|
|
|
|
|
|
$w->Popdown if ($^O =~ /Win/i || $state eq 'readonly'); #WINDUHS LOWERS LISTBOX BEHIND CALLER (HIDES IT)!
|
1216
|
|
|
|
|
|
|
$e->focus() unless ($state eq 'readonly'); #SO WE'LL POP IT DOWN FIRST! (RAISE WOULDN'T WORK :-()
|
1217
|
|
|
|
|
|
|
$w->BtnDown if ($^O =~ /Win/i && $state ne 'readonly' && $w->{takefocus});
|
1218
|
|
|
|
|
|
|
if ($w->{-tabcomplete})
|
1219
|
|
|
|
|
|
|
{
|
1220
|
|
|
|
|
|
|
&LbFindSelection($w);
|
1221
|
|
|
|
|
|
|
my @listsels = $l->get('0','end');
|
1222
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
1223
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
1224
|
|
|
|
|
|
|
unless ($$var_ref eq $listsels[$index])
|
1225
|
|
|
|
|
|
|
{
|
1226
|
|
|
|
|
|
|
$$var_ref = $listsels[$index];
|
1227
|
|
|
|
|
|
|
$e->icursor('end');
|
1228
|
|
|
|
|
|
|
}
|
1229
|
|
|
|
|
|
|
$e->selectionRange(0,'end') unless ($w->{-noselecttext} || !$e->index('end'));
|
1230
|
|
|
|
|
|
|
}
|
1231
|
|
|
|
|
|
|
Tk->break;
|
1232
|
|
|
|
|
|
|
}
|
1233
|
|
|
|
|
|
|
);
|
1234
|
|
|
|
|
|
|
$l->bind('' => sub { $w->delete($w->LbIndex) }) #ADDED 20060429 TO SUPPORT OPTION FOR USER DELETION OF LISTBOX ITEMS.
|
1235
|
|
|
|
|
|
|
if ($w->{-deleteitemsok});
|
1236
|
|
|
|
|
|
|
$l->bind('' => [\&keyFn,$w,$e,$l,1]);
|
1237
|
|
|
|
|
|
|
#if $w->cget( "-state" ) eq "readonly";
|
1238
|
|
|
|
|
|
|
$e->bind('' => [\&keyFn,$w,$e,$l]);
|
1239
|
|
|
|
|
|
|
$f->bind('' => [\&keyFn,$w,$e,$l]);
|
1240
|
|
|
|
|
|
|
#unless $w->cget( "-state" ) eq "readonly";
|
1241
|
|
|
|
|
|
|
$e->bind('<1>' => sub {
|
1242
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1243
|
|
|
|
|
|
|
if ($state eq 'readonly')
|
1244
|
|
|
|
|
|
|
{
|
1245
|
|
|
|
|
|
|
my $res = &LbFindSelection($w);
|
1246
|
|
|
|
|
|
|
if ($w->{"popped"})
|
1247
|
|
|
|
|
|
|
{
|
1248
|
|
|
|
|
|
|
$w->Popdown(1);
|
1249
|
|
|
|
|
|
|
}
|
1250
|
|
|
|
|
|
|
else
|
1251
|
|
|
|
|
|
|
{
|
1252
|
|
|
|
|
|
|
unless ($res) #ADDED 20090320 TO CAUSE DROPDOWN LIST TO POP DOWN W/ACTIVE CURSOR IN RIGHT PLACE (INSTEAD OF BOTTOM) IF ENTRY FIELD EMPTY.
|
1253
|
|
|
|
|
|
|
{
|
1254
|
|
|
|
|
|
|
$l->selectionClear('0','end');
|
1255
|
|
|
|
|
|
|
$l->activate(0);
|
1256
|
|
|
|
|
|
|
$l->selectionSet(0);
|
1257
|
|
|
|
|
|
|
$l->update();
|
1258
|
|
|
|
|
|
|
$l->see(0);
|
1259
|
|
|
|
|
|
|
}
|
1260
|
|
|
|
|
|
|
$w->BtnDown;
|
1261
|
|
|
|
|
|
|
}
|
1262
|
|
|
|
|
|
|
$w->{'savefocus'} = $w->focusCurrent;
|
1263
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->focus;
|
1264
|
|
|
|
|
|
|
Tk->break;
|
1265
|
|
|
|
|
|
|
}
|
1266
|
|
|
|
|
|
|
else
|
1267
|
|
|
|
|
|
|
{
|
1268
|
|
|
|
|
|
|
if ($w->{"popped"})
|
1269
|
|
|
|
|
|
|
{
|
1270
|
|
|
|
|
|
|
$w->Popdown(1);
|
1271
|
|
|
|
|
|
|
}
|
1272
|
|
|
|
|
|
|
$e->focus;
|
1273
|
|
|
|
|
|
|
Tk->break;
|
1274
|
|
|
|
|
|
|
}
|
1275
|
|
|
|
|
|
|
});
|
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
#NEXT 3 LINES ADDED 20030531 PER PATCH BY FRANK HERRMANN.
|
1278
|
|
|
|
|
|
|
$e->bind('<2>' => sub {
|
1279
|
|
|
|
|
|
|
$e->focus;
|
1280
|
|
|
|
|
|
|
});
|
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
# ALLOW CLICK OUTSIDE THE POPPED UP LISTBOX TO POP IT DOWN.
|
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
$w->bind("<1>", sub {$w->BtnDown; Tk->break});
|
1285
|
|
|
|
|
|
|
$w->parent->bind("<1>", sub
|
1286
|
|
|
|
|
|
|
{
|
1287
|
|
|
|
|
|
|
if ($w->{"popped"})
|
1288
|
|
|
|
|
|
|
{
|
1289
|
|
|
|
|
|
|
$w->Popdown(1);
|
1290
|
|
|
|
|
|
|
}
|
1291
|
|
|
|
|
|
|
}
|
1292
|
|
|
|
|
|
|
);
|
1293
|
|
|
|
|
|
|
$w->bind("", \&focus);
|
1294
|
|
|
|
|
|
|
$w->bind('', sub {print "-focus=".$w->focusCurrent()."=\n";});
|
1295
|
|
|
|
|
|
|
$w->bind('', sub {print "-focus=".$w->focusCurrent()."=\n";});
|
1296
|
|
|
|
|
|
|
}
|
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
sub keyFn #JWT: TRAP LETTERS PRESSED AND ADJUST SELECTION ACCORDINGLY.
|
1299
|
|
|
|
|
|
|
{
|
1300
|
|
|
|
|
|
|
my ($x,$w,$e,$l,$flag) = @_;
|
1301
|
|
|
|
|
|
|
my $mykey = $x->XEvent->A;
|
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
#NEXT LINE ADDED 20030531 PER PATCH BY FRANK HERRMANN.
|
1304
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, "key.$mykey")
|
1305
|
|
|
|
|
|
|
if ($w->{-browse} == 1);
|
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
if ($w->cget( "-state" ) eq "readonly") #ADDED 20020711 TO ALLOW TYPING 1ST LETTER TO SELECT NEXT VALID ITEM!
|
1308
|
|
|
|
|
|
|
{
|
1309
|
|
|
|
|
|
|
&LbFindSelection($w,$mykey) if ($mykey); #JUMP TO 1ST ITEM STARTING WITH THIS KEY
|
1310
|
|
|
|
|
|
|
# $w->LbCopySelection(1,'key.$mykey'); #CHGD. TO NEXT 20100803 - I THINK THIS IS WRONG - HOPE IT DOESN'T BREAK ANYTHING!
|
1311
|
|
|
|
|
|
|
$w->LbCopySelection(1,"key.$mykey");
|
1312
|
|
|
|
|
|
|
$w->Subwidget("entry")->selectionRange(0,'end') unless ($w->{"popped"}
|
1313
|
|
|
|
|
|
|
|| $w->{-noselecttext} || !$w->Subwidget("entry")->index('end'));
|
1314
|
|
|
|
|
|
|
$e->icursor('end');
|
1315
|
|
|
|
|
|
|
}
|
1316
|
|
|
|
|
|
|
elsif (defined $flag and $flag == 1) #LISTBOX HAS FOCUS.
|
1317
|
|
|
|
|
|
|
{
|
1318
|
|
|
|
|
|
|
&LbFindSelection($w,$mykey) if ($mykey); #JUMP TO 1ST ITEM STARTING WITH THIS KEY
|
1319
|
|
|
|
|
|
|
}
|
1320
|
|
|
|
|
|
|
else #TEXT FIELD HAS FOCUS.
|
1321
|
|
|
|
|
|
|
{
|
1322
|
|
|
|
|
|
|
&LbFindSelection($w) if ($mykey); #JUMP TO 1ST ITEM MATCHING TEXT FIELD.
|
1323
|
|
|
|
|
|
|
}
|
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
}
|
1326
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
sub BtnDown
|
1328
|
|
|
|
|
|
|
{
|
1329
|
|
|
|
|
|
|
my ($w) = @_;
|
1330
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
return if ($state =~ /text/ || $state eq 'disabled');
|
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
#JWT: NEXT 2 LINES PREVENT POPPING EMPTY LIST!
|
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
1337
|
|
|
|
|
|
|
return unless ($l->get('0','end'));
|
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
if ($w->{"popped"})
|
1340
|
|
|
|
|
|
|
{
|
1341
|
|
|
|
|
|
|
$w->Popdown(1);
|
1342
|
|
|
|
|
|
|
$w->{"buttonHack"} = 0;
|
1343
|
|
|
|
|
|
|
}
|
1344
|
|
|
|
|
|
|
else
|
1345
|
|
|
|
|
|
|
{
|
1346
|
|
|
|
|
|
|
$w->PopupChoices;
|
1347
|
|
|
|
|
|
|
$w->{"buttonHack"} = 1;
|
1348
|
|
|
|
|
|
|
}
|
1349
|
|
|
|
|
|
|
}
|
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
sub PopupChoices
|
1352
|
|
|
|
|
|
|
{
|
1353
|
|
|
|
|
|
|
my ($w) = @_;
|
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
# my $first; -- REMOVED 20070904 PER PATCH BY WOLFRAM HUMANN (PROBABLY OBSOLETED BY FRANK HERRMANN PATCHES
|
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
if (!$w->{"popped"})
|
1358
|
|
|
|
|
|
|
{
|
1359
|
|
|
|
|
|
|
my $x = $w->Callback(-listcmd, $w);
|
1360
|
|
|
|
|
|
|
return undef if ($x =~ /nolist/io); #IF -listcmd CALLBACK RETURNS 'nolist',
|
1361
|
|
|
|
|
|
|
my $e = $w->Subwidget("entry"); #THEN DON'T DISPLAY THE DROP-DOWN LIST!
|
1362
|
|
|
|
|
|
|
my $c = $w->Subwidget("choices");
|
1363
|
|
|
|
|
|
|
my $s = $w->Subwidget("slistbox");
|
1364
|
|
|
|
|
|
|
my $a = $w->Subwidget("arrow");
|
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
my $wheight = $w->cget("-height");
|
1367
|
|
|
|
|
|
|
my (@hh);
|
1368
|
|
|
|
|
|
|
$hh[0]=$w->height;
|
1369
|
|
|
|
|
|
|
$hh[1]=$w->reqheight;
|
1370
|
|
|
|
|
|
|
$hh[2]=$e->height;
|
1371
|
|
|
|
|
|
|
$hh[3]=$e->reqheight;
|
1372
|
|
|
|
|
|
|
$hh[4]=$c->height;
|
1373
|
|
|
|
|
|
|
$hh[5]=$c->reqheight;
|
1374
|
|
|
|
|
|
|
$hh[6]=$s->height;
|
1375
|
|
|
|
|
|
|
$hh[7]=$s->reqheight;
|
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
my $sll = $s->Subwidget("listbox");
|
1378
|
|
|
|
|
|
|
my $rw = $c->width;
|
1379
|
|
|
|
|
|
|
# $first = 1 if ($rw <= 1); -- REMOVED 20070904 PER PATCH BY WOLFRAM HUMANN
|
1380
|
|
|
|
|
|
|
my ($itemcnt) = $sll->index('end');
|
1381
|
|
|
|
|
|
|
$wheight = 10 unless ($wheight);
|
1382
|
|
|
|
|
|
|
$wheight = $itemcnt if ($itemcnt < $wheight);
|
1383
|
|
|
|
|
|
|
$wheight = $itemcnt unless ($wheight);
|
1384
|
|
|
|
|
|
|
$wheight = $itemcnt unless ($wheight || $itemcnt > 10);
|
1385
|
|
|
|
|
|
|
if ($wheight)
|
1386
|
|
|
|
|
|
|
{
|
1387
|
|
|
|
|
|
|
$sll->configure(-height => ($wheight * $w->height));
|
1388
|
|
|
|
|
|
|
$w->update;
|
1389
|
|
|
|
|
|
|
}
|
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
my $y1 = $e->rooty + $e->height + 3;
|
1392
|
|
|
|
|
|
|
#my $bd = $c->cget(-bd) + $c->cget(-highlightthickness); #CHGD. TO NEXT 20050120.
|
1393
|
|
|
|
|
|
|
my $bd = $c->cget(-bd);
|
1394
|
|
|
|
|
|
|
my ($unitpixels, $ht, $x1, $ee, $width, $x2);
|
1395
|
|
|
|
|
|
|
if ($^O =~ /Win/i)
|
1396
|
|
|
|
|
|
|
{
|
1397
|
|
|
|
|
|
|
$y1 -= 3 - ($w->{-borderwidth} || 2);
|
1398
|
|
|
|
|
|
|
#$unitpixels = $e->height + 1; #CHGD. TO NEXT 20040827 - WINBLOWS XP SEEMS TO NOT BEVEL THE HIGHLIGHT CURSOR,
|
1399
|
|
|
|
|
|
|
$unitpixels = $e->height - 1; #SO THE WIDTH OF EACH ITEM IS NOW 2 PIXELS SMALLER! (USE OLD LINE, IF BEVELLED)!
|
1400
|
|
|
|
|
|
|
$ht = ($wheight * $unitpixels) + (2 * $bd) + 4;
|
1401
|
|
|
|
|
|
|
$ee = $w->Subwidget("frame");
|
1402
|
|
|
|
|
|
|
$x1 = $ee->rootx;
|
1403
|
|
|
|
|
|
|
$x2 = $a->rootx + $a->width;
|
1404
|
|
|
|
|
|
|
$width = $x2 - $x1;
|
1405
|
|
|
|
|
|
|
#$rw = $width + $w->{-borderwidth};
|
1406
|
|
|
|
|
|
|
#CHGD. TO NEXT 20030531 PER PATCH BY FRANK HERRMANN.
|
1407
|
|
|
|
|
|
|
$rw = ($width || 0) + ($w->{-borderwidth} || 0);
|
1408
|
|
|
|
|
|
|
$x1 += 1; #FUDGE MORE FOR WINDOWS (THINNER BORDER) TO MAKE DROPDOWN LINE UP VERTICALLY W/ENTRY&BUTTON.
|
1409
|
|
|
|
|
|
|
}
|
1410
|
|
|
|
|
|
|
else
|
1411
|
|
|
|
|
|
|
{
|
1412
|
|
|
|
|
|
|
$y1 -= 3 - ($w->{-borderwidth} || 2);
|
1413
|
|
|
|
|
|
|
#$unitpixels = $e->height - 1; #CHGD. TO NEXT 2 20050120.
|
1414
|
|
|
|
|
|
|
$unitpixels = $e->height - (2*$w->cget(-highlightthickness));
|
1415
|
|
|
|
|
|
|
$unitpixels += 1;
|
1416
|
|
|
|
|
|
|
$ht = ($wheight * $unitpixels) + (2 * $bd) + 6;
|
1417
|
|
|
|
|
|
|
$ee = $w->Subwidget("frame");
|
1418
|
|
|
|
|
|
|
$x1 = $ee->rootx;
|
1419
|
|
|
|
|
|
|
$x2 = $a->rootx + $a->width;
|
1420
|
|
|
|
|
|
|
$width = $x2 - $x1;
|
1421
|
|
|
|
|
|
|
# if ($rw < $width) #NEXT 10 LINES REPLACED BY FOLLOWING LINE 20020815.
|
1422
|
|
|
|
|
|
|
# {
|
1423
|
|
|
|
|
|
|
# $rw = $width;
|
1424
|
|
|
|
|
|
|
# }
|
1425
|
|
|
|
|
|
|
# else
|
1426
|
|
|
|
|
|
|
# {
|
1427
|
|
|
|
|
|
|
# $rw = $width * 3 if ($rw > $width * 3);
|
1428
|
|
|
|
|
|
|
# $rw = $w->vrootwidth if ($rw > $w->vrootwidth);
|
1429
|
|
|
|
|
|
|
# }
|
1430
|
|
|
|
|
|
|
# $width = $rw; #REMOVED 20020815 - UNNECESSARY!
|
1431
|
|
|
|
|
|
|
$rw = $width; #ADDED 20020815 TO CAUSE LISTBOX TO ADJUST WIDTH TO SAME AS VARYING ENTRY FIELD!
|
1432
|
|
|
|
|
|
|
# if ($first) -- REMOVED 20070904 PER PATCH BY WOLFRAM HUMANN
|
1433
|
|
|
|
|
|
|
{
|
1434
|
|
|
|
|
|
|
#NEXT LINE ADDED 20030531 PER PATCH BY FRANK HERRMANN.
|
1435
|
|
|
|
|
|
|
$w->{-borderwidth} = 0 unless(defined $w->{-borderwidth}); # XXX
|
1436
|
|
|
|
|
|
|
# $rw += 1 + int($w->{-borderwidth} / 2); -- CHGD. TO NEXT 20070904 - SEEMS TO WORK BETTER!
|
1437
|
|
|
|
|
|
|
$rw += $w->{-borderwidth};
|
1438
|
|
|
|
|
|
|
# $first = 0; -- REMOVED 20070904 PER PATCH BY WOLFRAM HUMANN
|
1439
|
|
|
|
|
|
|
#THANKS, WOLFRAM!
|
1440
|
|
|
|
|
|
|
}
|
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
# IF LISTBOX IS TOO FAR RIGHT, PULL IT BACK TO THE LEFT
|
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
if ($x2 > $w->vrootwidth)
|
1445
|
|
|
|
|
|
|
{
|
1446
|
|
|
|
|
|
|
$x1 = $w->vrootwidth - $width;
|
1447
|
|
|
|
|
|
|
}
|
1448
|
|
|
|
|
|
|
$x1 += 1; #FUDGE MORE FOR WINDOWS (THINNER BORDER) TO MAKE DROPDOWN LINE UP VERTICALLY W/ENTRY&BUTTON.
|
1449
|
|
|
|
|
|
|
}
|
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
# IF LISTBOX IS TOO FAR LEFT, PULL IT BACK TO THE RIGHT
|
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
if ($x1 < 0)
|
1454
|
|
|
|
|
|
|
{
|
1455
|
|
|
|
|
|
|
$x1 = 0;
|
1456
|
|
|
|
|
|
|
}
|
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
# IF LISTBOX IS BELOW BOTTOM OF SCREEN, PULL IT UP.
|
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
my $y2 = $y1 + $ht;
|
1461
|
|
|
|
|
|
|
if ($y2 > $w->vrootheight)
|
1462
|
|
|
|
|
|
|
{
|
1463
|
|
|
|
|
|
|
$y1 = $y1 - $ht - ($e->height - 5);
|
1464
|
|
|
|
|
|
|
}
|
1465
|
|
|
|
|
|
|
$c->geometry(sprintf("%dx%d+%d+%d", $rw, $ht, $x1, $y1));
|
1466
|
|
|
|
|
|
|
$c->deiconify;
|
1467
|
|
|
|
|
|
|
$c->raise;
|
1468
|
|
|
|
|
|
|
$w->focus;
|
1469
|
|
|
|
|
|
|
$w->{"popped"} = 1;
|
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
&LbFindSelection;
|
1472
|
|
|
|
|
|
|
$c->configure(-cursor => "arrow");
|
1473
|
|
|
|
|
|
|
$w->grabGlobal;
|
1474
|
|
|
|
|
|
|
}
|
1475
|
|
|
|
|
|
|
}
|
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
# CHOOSE VALUE FROM LISTBOX IF APPROPRIATE.
|
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
sub LbChoose
|
1480
|
|
|
|
|
|
|
{
|
1481
|
|
|
|
|
|
|
my ($w, $x, $y) = @_;
|
1482
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
1483
|
|
|
|
|
|
|
$l->configure(-selectmode => 'browse');
|
1484
|
|
|
|
|
|
|
if ((($x < 0) || ($x > $l->Width)) ||
|
1485
|
|
|
|
|
|
|
(($y < 0) || ($y > $l->Height)))
|
1486
|
|
|
|
|
|
|
{
|
1487
|
|
|
|
|
|
|
# MOUSE WAS CLICKED OUTSIDE THE LISTBOX... CLOSE THE LISTBOX
|
1488
|
|
|
|
|
|
|
$w->LbClose;
|
1489
|
|
|
|
|
|
|
}
|
1490
|
|
|
|
|
|
|
else
|
1491
|
|
|
|
|
|
|
{
|
1492
|
|
|
|
|
|
|
# SELECT APPROPRIATE ENTRY AND CLOSE THE LISTBOX
|
1493
|
|
|
|
|
|
|
$w->LbCopySelection(0,'listbox.button1');
|
1494
|
|
|
|
|
|
|
}
|
1495
|
|
|
|
|
|
|
}
|
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
# CLOSE THE LISTBOX AFTER CLEARING SELECTION.
|
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
sub LbClose
|
1500
|
|
|
|
|
|
|
{
|
1501
|
|
|
|
|
|
|
my ($w) = @_;
|
1502
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
1503
|
|
|
|
|
|
|
$l->configure(-selectmode => 'browse');
|
1504
|
|
|
|
|
|
|
$l->selection("clear", 0, "end");
|
1505
|
|
|
|
|
|
|
$w->Popdown;
|
1506
|
|
|
|
|
|
|
}
|
1507
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
# COPY THE SELECTION TO THE ENTRY, AND CLOSE LISTBOX (UNLESS JUSTCOPY SET).
|
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
sub LbCopySelection
|
1511
|
|
|
|
|
|
|
{
|
1512
|
|
|
|
|
|
|
my ($w, $justcopy, $action) = @_;
|
1513
|
|
|
|
|
|
|
my $index = $w->LbIndex;
|
1514
|
|
|
|
|
|
|
if (defined $index)
|
1515
|
|
|
|
|
|
|
{
|
1516
|
|
|
|
|
|
|
$w->{"curIndex"} = $index;
|
1517
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
1518
|
|
|
|
|
|
|
$l->configure(-selectmode => 'browse');
|
1519
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
1520
|
|
|
|
|
|
|
$$var_ref = $l->get($index);
|
1521
|
|
|
|
|
|
|
my $e = $w->Subwidget("entry");
|
1522
|
|
|
|
|
|
|
$e->icursor('end');
|
1523
|
|
|
|
|
|
|
}
|
1524
|
|
|
|
|
|
|
#$w->Popdown if ($w->{"popped"} && !$justcopy);
|
1525
|
|
|
|
|
|
|
if ($w->{"popped"} && !$justcopy)
|
1526
|
|
|
|
|
|
|
{
|
1527
|
|
|
|
|
|
|
my $altbinding = $w->{-altbinding};
|
1528
|
|
|
|
|
|
|
$w->Popdown;
|
1529
|
|
|
|
|
|
|
if ($altbinding =~ /NoListbox\=([^\;]+)/io) {
|
1530
|
|
|
|
|
|
|
my @noActions = split(/\,/o, $1);
|
1531
|
|
|
|
|
|
|
foreach my $i (@noActions) {
|
1532
|
|
|
|
|
|
|
return if ($i =~ /^$action$/io);
|
1533
|
|
|
|
|
|
|
}
|
1534
|
|
|
|
|
|
|
}
|
1535
|
|
|
|
|
|
|
$w->Callback(-browsecmd => $w, $w->Subwidget('entry')->get, $action);
|
1536
|
|
|
|
|
|
|
}
|
1537
|
|
|
|
|
|
|
}
|
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
# GRAB TEXT TYPED IN AND FIND NEAREST ENTRY IN LISTBOX AND SELECT IT.
|
1540
|
|
|
|
|
|
|
# LETTERSEARCH SET MEANS SEARCH FOR *NEXT* MATCH OF SPECIFIED LETTER,
|
1541
|
|
|
|
|
|
|
# CLEARED MEANS SEARCH FOR *1ST* ITEM STARTING WITH CURRENT TEXT ENTRY VALUE.
|
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
sub LbFindSelection
|
1544
|
|
|
|
|
|
|
{
|
1545
|
|
|
|
|
|
|
my ($w, $srchval) = @_;
|
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
my $lettersearch = 0;
|
1548
|
|
|
|
|
|
|
if ($srchval)
|
1549
|
|
|
|
|
|
|
{
|
1550
|
|
|
|
|
|
|
$lettersearch = 1;
|
1551
|
|
|
|
|
|
|
}
|
1552
|
|
|
|
|
|
|
else
|
1553
|
|
|
|
|
|
|
{
|
1554
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
1555
|
|
|
|
|
|
|
# $srchval = $$var_ref; #CHGD. TO NEXT 20091019:
|
1556
|
|
|
|
|
|
|
$srchval = (defined($var_ref) && ref($var_ref) && defined($$var_ref))
|
1557
|
|
|
|
|
|
|
? $$var_ref : '';
|
1558
|
|
|
|
|
|
|
}
|
1559
|
|
|
|
|
|
|
my $l = $w->Subwidget("slistbox")->Subwidget("listbox");
|
1560
|
|
|
|
|
|
|
$l->configure(-selectmode => 'browse');
|
1561
|
|
|
|
|
|
|
my (@listsels) = $l->get('0','end');
|
1562
|
|
|
|
|
|
|
unless ($lettersearch || !defined($srchval))
|
1563
|
|
|
|
|
|
|
{
|
1564
|
|
|
|
|
|
|
foreach my $i (0..$#listsels) #SEARCH FOR TRUE EQUALITY.
|
1565
|
|
|
|
|
|
|
{
|
1566
|
|
|
|
|
|
|
if ($listsels[$i] eq $srchval)
|
1567
|
|
|
|
|
|
|
{
|
1568
|
|
|
|
|
|
|
$l->selectionClear('0','end');
|
1569
|
|
|
|
|
|
|
$l->activate($i);
|
1570
|
|
|
|
|
|
|
$l->selectionSet($i);
|
1571
|
|
|
|
|
|
|
$l->update();
|
1572
|
|
|
|
|
|
|
$l->see($i);
|
1573
|
|
|
|
|
|
|
return 1;
|
1574
|
|
|
|
|
|
|
}
|
1575
|
|
|
|
|
|
|
}
|
1576
|
|
|
|
|
|
|
}
|
1577
|
|
|
|
|
|
|
my $index = $w->LbIndex; #ADDED 20020711 TO ALLOW WRAPPING IF SAME LETTER PRESSED AGAIN!
|
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
foreach my $i (0..$#listsels) #SEARCH W/O REGARD TO CASE, START W/CURRENT SELECTION.
|
1580
|
|
|
|
|
|
|
{
|
1581
|
|
|
|
|
|
|
++$index;
|
1582
|
|
|
|
|
|
|
$index = 0 if ($index > $#listsels);
|
1583
|
|
|
|
|
|
|
#if ($listsels[$index] =~ /^$srchval/i)
|
1584
|
|
|
|
|
|
|
#CHGD. TO NEXT 20030531 PER PATCH BY FRANK HERRMANN.
|
1585
|
|
|
|
|
|
|
# if (defined $srchval && $listsels[$index] =~ /^$srchval/i) #CHGD TO NEXT 20060429 TO PREVENT TK-ERROR ON "("!
|
1586
|
|
|
|
|
|
|
if (defined $srchval && $listsels[$index] =~ /^\Q$srchval\E/i)
|
1587
|
|
|
|
|
|
|
{
|
1588
|
|
|
|
|
|
|
$l->selectionClear('0','end');
|
1589
|
|
|
|
|
|
|
$l->activate($index);
|
1590
|
|
|
|
|
|
|
$l->selectionSet($index);
|
1591
|
|
|
|
|
|
|
$l->update();
|
1592
|
|
|
|
|
|
|
$l->see($index);
|
1593
|
|
|
|
|
|
|
return -1;
|
1594
|
|
|
|
|
|
|
}
|
1595
|
|
|
|
|
|
|
}
|
1596
|
|
|
|
|
|
|
return 0;
|
1597
|
|
|
|
|
|
|
}
|
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
sub LbIndex
|
1600
|
|
|
|
|
|
|
{
|
1601
|
|
|
|
|
|
|
my ($w, $flag) = @_;
|
1602
|
|
|
|
|
|
|
my $sel = $w->Subwidget("slistbox")->Subwidget("listbox")->curselection
|
1603
|
|
|
|
|
|
|
|| $w->Subwidget("slistbox")->Subwidget("listbox")->index('active');
|
1604
|
|
|
|
|
|
|
$sel = $w->Subwidget("slistbox")->Subwidget("listbox")->index('active')
|
1605
|
|
|
|
|
|
|
unless ($sel =~ /^\d+$/); #JWT: ADDED 20040819 'CAUSE CURSELECTION SEEMS TO RETURN "ARRAY(XXXX)" NOW?!?!?!
|
1606
|
|
|
|
|
|
|
if (defined $sel)
|
1607
|
|
|
|
|
|
|
{
|
1608
|
|
|
|
|
|
|
return int($sel);
|
1609
|
|
|
|
|
|
|
}
|
1610
|
|
|
|
|
|
|
else
|
1611
|
|
|
|
|
|
|
{
|
1612
|
|
|
|
|
|
|
if (defined $flag && ($flag eq "emptyOK"))
|
1613
|
|
|
|
|
|
|
{
|
1614
|
|
|
|
|
|
|
return undef;
|
1615
|
|
|
|
|
|
|
}
|
1616
|
|
|
|
|
|
|
else
|
1617
|
|
|
|
|
|
|
{
|
1618
|
|
|
|
|
|
|
return 0;
|
1619
|
|
|
|
|
|
|
}
|
1620
|
|
|
|
|
|
|
}
|
1621
|
|
|
|
|
|
|
}
|
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
# POP DOWN THE LISTBOX
|
1624
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
sub Popdown
|
1626
|
|
|
|
|
|
|
{
|
1627
|
|
|
|
|
|
|
my ($w, $flag) = @_;
|
1628
|
|
|
|
|
|
|
my ($state) = $w->cget( "-state" );
|
1629
|
|
|
|
|
|
|
if ($w->{"popped"})
|
1630
|
|
|
|
|
|
|
{
|
1631
|
|
|
|
|
|
|
my $c = $w->Subwidget("choices");
|
1632
|
|
|
|
|
|
|
$c->withdraw;
|
1633
|
|
|
|
|
|
|
$w->grabRelease;
|
1634
|
|
|
|
|
|
|
$w->{"popped"} = 0;
|
1635
|
|
|
|
|
|
|
########$w->Subwidget("entry")->focus; # unless ($flag);
|
1636
|
|
|
|
|
|
|
$w->Subwidget("entry")->selectionRange(0,'end')
|
1637
|
|
|
|
|
|
|
unless ($w->{-noselecttext} || !$w->Subwidget("entry")->index('end'));
|
1638
|
|
|
|
|
|
|
}
|
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
if ($w->{'savefocus'} && Tk::Exists($w->{'savefocus'}))
|
1641
|
|
|
|
|
|
|
{
|
1642
|
|
|
|
|
|
|
$w->{'savefocus'}->focus;
|
1643
|
|
|
|
|
|
|
#delete $w->{'savefocus'};
|
1644
|
|
|
|
|
|
|
}
|
1645
|
|
|
|
|
|
|
else
|
1646
|
|
|
|
|
|
|
{
|
1647
|
|
|
|
|
|
|
$w->Subwidget("entry")->focus; # unless ($flag);
|
1648
|
|
|
|
|
|
|
}
|
1649
|
|
|
|
|
|
|
}
|
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
# THIS HACK IS TO PREVENT THE UGLINESS OF THE ARROW BEING DEPRESSED.
|
1652
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
sub ButtonHack
|
1654
|
|
|
|
|
|
|
{
|
1655
|
|
|
|
|
|
|
my ($w) = @_;
|
1656
|
|
|
|
|
|
|
my $b = $w->Subwidget("arrow");
|
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
#JWT: NEXT 6 LINES ADDED TO UNPOP MENU IF BUTTON PRESSED OUTSIDE OF LISTBOX.
|
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
my $s = $w->Subwidget("slistbox");
|
1661
|
|
|
|
|
|
|
my $e = $s->XEvent;
|
1662
|
|
|
|
|
|
|
unless (defined($e))
|
1663
|
|
|
|
|
|
|
{
|
1664
|
|
|
|
|
|
|
$w->LbClose;
|
1665
|
|
|
|
|
|
|
}
|
1666
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
if ($w->{"buttonHack"})
|
1668
|
|
|
|
|
|
|
{
|
1669
|
|
|
|
|
|
|
$b->butUp;
|
1670
|
|
|
|
|
|
|
}
|
1671
|
|
|
|
|
|
|
}
|
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
sub choices
|
1674
|
|
|
|
|
|
|
{
|
1675
|
|
|
|
|
|
|
my $w = shift;
|
1676
|
|
|
|
|
|
|
unless( @_ ) #NO ARGS, RETURN CURRENT CHOICES.
|
1677
|
|
|
|
|
|
|
{
|
1678
|
|
|
|
|
|
|
return( $w->Subwidget("slistbox")->get( qw/0 end/ ) );
|
1679
|
|
|
|
|
|
|
}
|
1680
|
|
|
|
|
|
|
else #POPULATE DROPDOWN LIST WITH THESE CHOICES.
|
1681
|
|
|
|
|
|
|
{
|
1682
|
|
|
|
|
|
|
my $choices = shift;
|
1683
|
|
|
|
|
|
|
if ($choices)
|
1684
|
|
|
|
|
|
|
{
|
1685
|
|
|
|
|
|
|
$w->delete( qw/0 end/ );
|
1686
|
|
|
|
|
|
|
$w->{hashref} = {} if (defined $w->{hashref}); #ADDED 20050125.
|
1687
|
|
|
|
|
|
|
$w->{hashref_bydesc} = {} if (defined $w->{hashref_bydesc}); #ADDED 20110226.
|
1688
|
|
|
|
|
|
|
$w->insert($choices);
|
1689
|
|
|
|
|
|
|
}
|
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
#NO WIDTH SPECIFIED, CALCULATE TEXT & LIST WIDTH BASED ON LONGEST CHOICE.
|
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
unless ($w->{-listwidth})
|
1694
|
|
|
|
|
|
|
{
|
1695
|
|
|
|
|
|
|
my @l = $w->Subwidget("slistbox")->get(0, 'end');
|
1696
|
|
|
|
|
|
|
my $width = 0;
|
1697
|
|
|
|
|
|
|
for (my $i=0;$i<=$#l;$i++)
|
1698
|
|
|
|
|
|
|
{
|
1699
|
|
|
|
|
|
|
$width = length($l[$i]) if ($width < length($l[$i]));
|
1700
|
|
|
|
|
|
|
}
|
1701
|
|
|
|
|
|
|
$width = $w->{-maxwidth} if ($width > $w->{-maxwidth} && $w->{-maxwidth} > 0);
|
1702
|
|
|
|
|
|
|
$w->Subwidget("entry")->configure(-width => $width);
|
1703
|
|
|
|
|
|
|
$w->Subwidget("choices")->configure(-width => $width);
|
1704
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->configure(-width => $width);
|
1705
|
|
|
|
|
|
|
}
|
1706
|
|
|
|
|
|
|
$w->state($w->cget(-state));
|
1707
|
|
|
|
|
|
|
return( "" );
|
1708
|
|
|
|
|
|
|
}
|
1709
|
|
|
|
|
|
|
}
|
1710
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
# INSERT NEW ITEMS INTO DROPDOWN LIST.
|
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
sub insert
|
1714
|
|
|
|
|
|
|
{
|
1715
|
|
|
|
|
|
|
my $w = shift;
|
1716
|
|
|
|
|
|
|
my ($pos);
|
1717
|
|
|
|
|
|
|
if ($_[1])
|
1718
|
|
|
|
|
|
|
{
|
1719
|
|
|
|
|
|
|
$pos = shift;
|
1720
|
|
|
|
|
|
|
}
|
1721
|
|
|
|
|
|
|
else
|
1722
|
|
|
|
|
|
|
{
|
1723
|
|
|
|
|
|
|
$pos = 'end';
|
1724
|
|
|
|
|
|
|
}
|
1725
|
|
|
|
|
|
|
#my $pos = shift || 'end'; #POSITION IN LIST TO INSERT.
|
1726
|
|
|
|
|
|
|
my $item = shift; #POINTER TO OR LIST OF ITEMS TO INSERT.
|
1727
|
|
|
|
|
|
|
my $res;
|
1728
|
|
|
|
|
|
|
if (ref($item))
|
1729
|
|
|
|
|
|
|
{
|
1730
|
|
|
|
|
|
|
if (ref($item) eq 'HASH')
|
1731
|
|
|
|
|
|
|
{
|
1732
|
|
|
|
|
|
|
my @choiceKeys = ();
|
1733
|
|
|
|
|
|
|
@choiceKeys = sort { $item->{$a} cmp $item->{$b} } keys(%$item);
|
1734
|
|
|
|
|
|
|
my @choiceVals = sort values(%$item);
|
1735
|
|
|
|
|
|
|
$w->Subwidget('slistbox')->insert($pos, @choiceVals);
|
1736
|
|
|
|
|
|
|
my $choiceHashRef = (defined $w->{hashref}) ? $w->{hashref}
|
1737
|
|
|
|
|
|
|
: {}; #ADDED 20050125.
|
1738
|
|
|
|
|
|
|
my $choiceReverseHashRef = (defined $w->{hashref_bydesc}) ? $w->{hashref_bydesc}
|
1739
|
|
|
|
|
|
|
: {}; #ADDED 20110226.
|
1740
|
|
|
|
|
|
|
for (my $i=0;$i<=$#choiceKeys;$i++) #ADDED 20050125.
|
1741
|
|
|
|
|
|
|
{
|
1742
|
|
|
|
|
|
|
$choiceHashRef->{$choiceKeys[$i]} = $choiceVals[$i];
|
1743
|
|
|
|
|
|
|
$choiceReverseHashRef->{$choiceVals[$i]} = $choiceKeys[$i];
|
1744
|
|
|
|
|
|
|
}
|
1745
|
|
|
|
|
|
|
$w->{hashref_bydesc} = $choiceReverseHashRef;
|
1746
|
|
|
|
|
|
|
$w->{hashref} = $choiceHashRef;
|
1747
|
|
|
|
|
|
|
}
|
1748
|
|
|
|
|
|
|
else
|
1749
|
|
|
|
|
|
|
{
|
1750
|
|
|
|
|
|
|
$res = $w->Subwidget("slistbox")->insert($pos, @$item);
|
1751
|
|
|
|
|
|
|
}
|
1752
|
|
|
|
|
|
|
}
|
1753
|
|
|
|
|
|
|
else
|
1754
|
|
|
|
|
|
|
{
|
1755
|
|
|
|
|
|
|
$res = $w->Subwidget("slistbox")->insert($pos, $item, @_);
|
1756
|
|
|
|
|
|
|
}
|
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
#NO WIDTH SPECIFIED, (RE)CALCULATE TEXT & LIST WIDTH BASED ON LONGEST CHOICE.
|
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
unless ($w->{-listwidth})
|
1761
|
|
|
|
|
|
|
{
|
1762
|
|
|
|
|
|
|
my @l = $w->Subwidget("slistbox")->get(0, 'end');
|
1763
|
|
|
|
|
|
|
my $width = 0;
|
1764
|
|
|
|
|
|
|
for (my $i=0;$i<=$#l;$i++)
|
1765
|
|
|
|
|
|
|
{
|
1766
|
|
|
|
|
|
|
$width = length($l[$i]) if ($width < length($l[$i]));
|
1767
|
|
|
|
|
|
|
}
|
1768
|
|
|
|
|
|
|
$width = $w->{-maxwidth} if ($width > $w->{-maxwidth} && $w->{-maxwidth} > 0);
|
1769
|
|
|
|
|
|
|
$w->Subwidget("entry")->configure(-width => $width);
|
1770
|
|
|
|
|
|
|
$w->Subwidget("choices")->configure(-width => $width);
|
1771
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->configure(-width => $width);
|
1772
|
|
|
|
|
|
|
}
|
1773
|
|
|
|
|
|
|
$w->state($w->state());
|
1774
|
|
|
|
|
|
|
return $res;
|
1775
|
|
|
|
|
|
|
}
|
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
sub delete
|
1778
|
|
|
|
|
|
|
{
|
1779
|
|
|
|
|
|
|
my $w = shift;
|
1780
|
|
|
|
|
|
|
if (defined $w->{hashref}) #ADDED 20050125.
|
1781
|
|
|
|
|
|
|
{
|
1782
|
|
|
|
|
|
|
my ($key, $val);
|
1783
|
|
|
|
|
|
|
foreach my $i (@_)
|
1784
|
|
|
|
|
|
|
{
|
1785
|
|
|
|
|
|
|
$val = $w->get($i);
|
1786
|
|
|
|
|
|
|
$key = $w->{hashref_bydesc}->{$val};
|
1787
|
|
|
|
|
|
|
#print "*** DELETE: i=$i= val=$val= key=$key= 1=".$w->{hashref_bydesc}->{$val}."= 2=".$w->{hashref}->{$key}."=\n";
|
1788
|
|
|
|
|
|
|
next unless ($val);
|
1789
|
|
|
|
|
|
|
delete $w->{hashref_bydesc}->{$val} if (defined $w->{hashref_bydesc}->{$val});
|
1790
|
|
|
|
|
|
|
delete $w->{hashref}->{$key} if (defined $w->{hashref}->{$key});
|
1791
|
|
|
|
|
|
|
}
|
1792
|
|
|
|
|
|
|
}
|
1793
|
|
|
|
|
|
|
my $res = $w->Subwidget("slistbox")->delete(@_);
|
1794
|
|
|
|
|
|
|
unless ($w->Subwidget("slistbox")->size > 0 || $w->{mylistcmd})
|
1795
|
|
|
|
|
|
|
{
|
1796
|
|
|
|
|
|
|
my $button = $w->Subwidget( "arrow" );
|
1797
|
|
|
|
|
|
|
$button->configure( -state => "disabled", -takefocus => 0);
|
1798
|
|
|
|
|
|
|
}
|
1799
|
|
|
|
|
|
|
return $res;
|
1800
|
|
|
|
|
|
|
}
|
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
sub delete_byvalue
|
1803
|
|
|
|
|
|
|
{
|
1804
|
|
|
|
|
|
|
my $w = shift;
|
1805
|
|
|
|
|
|
|
return undef unless (@_);
|
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
my @keys = $w->get(0, 'end');
|
1808
|
|
|
|
|
|
|
my $v;
|
1809
|
|
|
|
|
|
|
my $delThisValue;
|
1810
|
|
|
|
|
|
|
my $delCnt = 0;
|
1811
|
|
|
|
|
|
|
while (@_)
|
1812
|
|
|
|
|
|
|
{
|
1813
|
|
|
|
|
|
|
$delThisValue = shift;
|
1814
|
|
|
|
|
|
|
if (defined $w->{hashref}) #ADDED 20050125.
|
1815
|
|
|
|
|
|
|
{
|
1816
|
|
|
|
|
|
|
for (my $k=0;$k<=$#keys;$k++)
|
1817
|
|
|
|
|
|
|
{
|
1818
|
|
|
|
|
|
|
if ($keys[$k] eq $delThisValue)
|
1819
|
|
|
|
|
|
|
{
|
1820
|
|
|
|
|
|
|
$v = $w->{hashref_bydesc}->{$keys[$k]};
|
1821
|
|
|
|
|
|
|
delete $w->{hashref_bydesc}->{$keys[$k]} if (defined $w->{hashref_bydesc}->{$keys[$k]});
|
1822
|
|
|
|
|
|
|
delete $w->{hashref}->{$v} if (defined $w->{hashref}->{$v});
|
1823
|
|
|
|
|
|
|
$w->Subwidget("slistbox")->delete($k);
|
1824
|
|
|
|
|
|
|
#print "-!!!- deleting k=$k= v=$v= keys=$keys[$k]=\n";
|
1825
|
|
|
|
|
|
|
$delCnt++;
|
1826
|
|
|
|
|
|
|
last;
|
1827
|
|
|
|
|
|
|
}
|
1828
|
|
|
|
|
|
|
}
|
1829
|
|
|
|
|
|
|
}
|
1830
|
|
|
|
|
|
|
}
|
1831
|
|
|
|
|
|
|
return $delCnt;
|
1832
|
|
|
|
|
|
|
}
|
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
sub curselection #RETURN CURRENT LISTBOX SELECTION.
|
1835
|
|
|
|
|
|
|
{
|
1836
|
|
|
|
|
|
|
return shift->Subwidget("slistbox")->curselection;
|
1837
|
|
|
|
|
|
|
}
|
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
# CHANGE APPEARANCES BASED ON CHANGES IN "-STATE" OPTION.
|
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
sub _set_edit_state
|
1842
|
|
|
|
|
|
|
{
|
1843
|
|
|
|
|
|
|
my( $w, $state ) = @_;
|
1844
|
|
|
|
|
|
|
$state ||= 'normal'; #JWT: HAD TO ADD THIS IN TK804...
|
1845
|
|
|
|
|
|
|
my $entry = $w->Subwidget( "entry" );
|
1846
|
|
|
|
|
|
|
my $frame = $w->Subwidget( "frame" );
|
1847
|
|
|
|
|
|
|
my $button = $w->Subwidget( "arrow" );
|
1848
|
|
|
|
|
|
|
my ($color, $txtcolor, $framehlcolor, $texthlcolor); # MAKE ENTRY FIELDS LOOK WINDOSEY!
|
1849
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
unless ($w->{-background})
|
1851
|
|
|
|
|
|
|
{
|
1852
|
|
|
|
|
|
|
if ($^O =~ /Win/i) # SET BACKGROUND TO WINDOWS DEFAULTS (IF NOT SPECIFIED)
|
1853
|
|
|
|
|
|
|
{
|
1854
|
|
|
|
|
|
|
#if ($state eq 'disabled' || $state eq 'readonly')
|
1855
|
|
|
|
|
|
|
if ($state eq 'disabled')
|
1856
|
|
|
|
|
|
|
{
|
1857
|
|
|
|
|
|
|
$color = "SystemButtonFace";
|
1858
|
|
|
|
|
|
|
}
|
1859
|
|
|
|
|
|
|
else
|
1860
|
|
|
|
|
|
|
{# Not Editable
|
1861
|
|
|
|
|
|
|
$color = $w->cget( -background );
|
1862
|
|
|
|
|
|
|
$color = 'SystemWindow' if ($color eq 'SystemButtonFace');
|
1863
|
|
|
|
|
|
|
}
|
1864
|
|
|
|
|
|
|
$entry->configure( -background => $color );
|
1865
|
|
|
|
|
|
|
}
|
1866
|
|
|
|
|
|
|
else #UNIX.
|
1867
|
|
|
|
|
|
|
{
|
1868
|
|
|
|
|
|
|
#THIS APPEARS TO FORCE THE TEXT BACKGROUND TO GREY, IF THE PALETTE
|
1869
|
|
|
|
|
|
|
#IS SOMETHING ELSE BUT USER HAS NOT SPECIFIED A BACKGROUND.
|
1870
|
|
|
|
|
|
|
if ($w->cget( "-colorstate" )) #NOT SURE WHAT POINT OF THIS IS.
|
1871
|
|
|
|
|
|
|
{
|
1872
|
|
|
|
|
|
|
if( $state eq "normal" || $state =~ /text/ )
|
1873
|
|
|
|
|
|
|
{# Editable
|
1874
|
|
|
|
|
|
|
$color = "gray95";
|
1875
|
|
|
|
|
|
|
}
|
1876
|
|
|
|
|
|
|
else
|
1877
|
|
|
|
|
|
|
{# Not Editable
|
1878
|
|
|
|
|
|
|
$color = $w->cget( -background ) || "lightgray";
|
1879
|
|
|
|
|
|
|
}
|
1880
|
|
|
|
|
|
|
$entry->configure( -background => $color);
|
1881
|
|
|
|
|
|
|
}
|
1882
|
|
|
|
|
|
|
}
|
1883
|
|
|
|
|
|
|
}
|
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
$txtcolor = $w->{-foreground} || $w->cget( -foreground ) unless ($state eq "disabled");
|
1886
|
|
|
|
|
|
|
$texthlcolor = $w->{-background} || $entry->cget( -background );
|
1887
|
|
|
|
|
|
|
$framehlcolor = $w->{-foreground} || $entry->cget( -foreground );
|
1888
|
|
|
|
|
|
|
if( $state eq "readonly" )
|
1889
|
|
|
|
|
|
|
{
|
1890
|
|
|
|
|
|
|
$framehlcolor = $w->{-foreground} || $entry->cget( -foreground );
|
1891
|
|
|
|
|
|
|
$entry->configure( -state => "disabled", -takefocus => 0,
|
1892
|
|
|
|
|
|
|
-foreground => $txtcolor, -highlightcolor => $texthlcolor);
|
1893
|
|
|
|
|
|
|
if ($^O =~ /Win/i)
|
1894
|
|
|
|
|
|
|
{
|
1895
|
|
|
|
|
|
|
$button->configure( -state => "normal", -takefocus => $w->{btntakesfocus}, -relief => 'raised');
|
1896
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'groove'),
|
1897
|
|
|
|
|
|
|
-takefocus => (1 & $w->{takefocus}), -highlightcolor => $framehlcolor);
|
1898
|
|
|
|
|
|
|
}
|
1899
|
|
|
|
|
|
|
else
|
1900
|
|
|
|
|
|
|
{
|
1901
|
|
|
|
|
|
|
$button->configure( -state => "normal", -takefocus => $w->{btntakesfocus}, -relief => 'raised');
|
1902
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'raised'),
|
1903
|
|
|
|
|
|
|
-takefocus => (1 & $w->{takefocus}), -highlightcolor => $framehlcolor);
|
1904
|
|
|
|
|
|
|
}
|
1905
|
|
|
|
|
|
|
}
|
1906
|
|
|
|
|
|
|
elsif ($state =~ /text/ )
|
1907
|
|
|
|
|
|
|
{
|
1908
|
|
|
|
|
|
|
$framehlcolor = $w->{-background} || 'SystemButtonFace'
|
1909
|
|
|
|
|
|
|
if ($^O =~ /Win/i);
|
1910
|
|
|
|
|
|
|
$button->configure( -state => "disabled", -takefocus => 0,
|
1911
|
|
|
|
|
|
|
-relief => 'flat');
|
1912
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'sunken'),
|
1913
|
|
|
|
|
|
|
-takefocus => 0, -highlightcolor => $framehlcolor);
|
1914
|
|
|
|
|
|
|
$entry->configure( -state => 'normal',
|
1915
|
|
|
|
|
|
|
-takefocus => (1 & ($w->{takefocus} || $w->{btntakesfocus})),
|
1916
|
|
|
|
|
|
|
-foreground => $txtcolor, -highlightcolor => $texthlcolor);
|
1917
|
|
|
|
|
|
|
}
|
1918
|
|
|
|
|
|
|
elsif ($state eq "disabled" )
|
1919
|
|
|
|
|
|
|
{
|
1920
|
|
|
|
|
|
|
$entry->configure( -state => "disabled", -takefocus => 0,
|
1921
|
|
|
|
|
|
|
-foreground => ($button->cget('-disabledforeground')||'gray30'), -highlightcolor => $texthlcolor);
|
1922
|
|
|
|
|
|
|
#-foreground => 'gray30', -highlightcolor => $texthlcolor);
|
1923
|
|
|
|
|
|
|
if ($^O =~ /Win/i)
|
1924
|
|
|
|
|
|
|
{
|
1925
|
|
|
|
|
|
|
$framehlcolor = $w->{-background} || 'SystemButtonFace';
|
1926
|
|
|
|
|
|
|
$button->configure(-state => "disabled", -takefocus => 0,
|
1927
|
|
|
|
|
|
|
-relief => 'flat');
|
1928
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'sunken'),
|
1929
|
|
|
|
|
|
|
-takefocus => 0, -highlightcolor => $framehlcolor);
|
1930
|
|
|
|
|
|
|
}
|
1931
|
|
|
|
|
|
|
else
|
1932
|
|
|
|
|
|
|
{
|
1933
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'groove'),
|
1934
|
|
|
|
|
|
|
-takefocus => 0, -highlightcolor => $framehlcolor);
|
1935
|
|
|
|
|
|
|
}
|
1936
|
|
|
|
|
|
|
$button->configure(-state => "disabled", -takefocus => 0,
|
1937
|
|
|
|
|
|
|
-relief => 'raised');
|
1938
|
|
|
|
|
|
|
}
|
1939
|
|
|
|
|
|
|
else #NORMAL.
|
1940
|
|
|
|
|
|
|
{
|
1941
|
|
|
|
|
|
|
$framehlcolor = $w->{-background} || 'SystemButtonFace'
|
1942
|
|
|
|
|
|
|
if ($^O =~ /Win/i);
|
1943
|
|
|
|
|
|
|
#$entry->configure( -state => $state, -takefocus => (1 & $w->{takefocus}),
|
1944
|
|
|
|
|
|
|
$entry->configure( -state => $state, -takefocus => 0,
|
1945
|
|
|
|
|
|
|
-foreground => $txtcolor, -highlightcolor => $texthlcolor);
|
1946
|
|
|
|
|
|
|
$button->configure( -state => $state, -relief => 'raised',
|
1947
|
|
|
|
|
|
|
-takefocus => $w->{btntakesfocus});
|
1948
|
|
|
|
|
|
|
$frame->configure(-relief => ($w->{-relief} || 'sunken'),
|
1949
|
|
|
|
|
|
|
-takefocus => (1 & $w->{takefocus}),
|
1950
|
|
|
|
|
|
|
-highlightcolor => $framehlcolor);
|
1951
|
|
|
|
|
|
|
}
|
1952
|
|
|
|
|
|
|
$entry->configure( -background => $w->{-textbackground}) if ($w->{-textbackground});
|
1953
|
|
|
|
|
|
|
$entry->configure( -foreground => $w->{-textforeground}) if ($w->{-textforeground});
|
1954
|
|
|
|
|
|
|
#print "-???- listcmd=".$w->{mylistcmd}."=\n";
|
1955
|
|
|
|
|
|
|
unless ($w->Subwidget("slistbox")->size > 0 || $w->{mylistcmd})
|
1956
|
|
|
|
|
|
|
{
|
1957
|
|
|
|
|
|
|
$button->configure( -state => "disabled", -takefocus => 0);
|
1958
|
|
|
|
|
|
|
}
|
1959
|
|
|
|
|
|
|
}
|
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
sub state
|
1962
|
|
|
|
|
|
|
{
|
1963
|
|
|
|
|
|
|
my $w = shift;
|
1964
|
|
|
|
|
|
|
unless( @_ )
|
1965
|
|
|
|
|
|
|
{
|
1966
|
|
|
|
|
|
|
return( $w->{Configure}{-state} );
|
1967
|
|
|
|
|
|
|
}
|
1968
|
|
|
|
|
|
|
else
|
1969
|
|
|
|
|
|
|
{
|
1970
|
|
|
|
|
|
|
my $state = shift;
|
1971
|
|
|
|
|
|
|
$w->{Configure}{-state} = $state;
|
1972
|
|
|
|
|
|
|
$w->_set_edit_state( $state );
|
1973
|
|
|
|
|
|
|
}
|
1974
|
|
|
|
|
|
|
}
|
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
sub _max
|
1977
|
|
|
|
|
|
|
{
|
1978
|
|
|
|
|
|
|
my $max = shift;
|
1979
|
|
|
|
|
|
|
foreach my $val (@_)
|
1980
|
|
|
|
|
|
|
{
|
1981
|
|
|
|
|
|
|
$max = $val if $max < $val;
|
1982
|
|
|
|
|
|
|
}
|
1983
|
|
|
|
|
|
|
return( $max );
|
1984
|
|
|
|
|
|
|
}
|
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
sub dereference #USER-CALLABLE FUNCTION, ADDED 20050125.
|
1987
|
|
|
|
|
|
|
{
|
1988
|
|
|
|
|
|
|
my $w = shift;
|
1989
|
|
|
|
|
|
|
return undef unless (defined $_[0]);
|
1990
|
|
|
|
|
|
|
my $userValue = shift;
|
1991
|
|
|
|
|
|
|
return (defined($w->{hashref_bydesc}) && defined($w->{hashref_bydesc}->{$userValue}))
|
1992
|
|
|
|
|
|
|
? $w->{hashref_bydesc}->{$userValue} : $userValue;
|
1993
|
|
|
|
|
|
|
}
|
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
sub dereferenceOnly #USER-CALLABLE FUNCTION, ADDED 20050125.
|
1996
|
|
|
|
|
|
|
{
|
1997
|
|
|
|
|
|
|
my $w = shift;
|
1998
|
|
|
|
|
|
|
return undef unless (defined $_[0]);
|
1999
|
|
|
|
|
|
|
my $userValue = shift;
|
2000
|
|
|
|
|
|
|
return (defined($w->{hashref_bydesc}) && defined($w->{hashref_bydesc}->{$userValue}))
|
2001
|
|
|
|
|
|
|
? $w->{hashref_bydesc}->{$userValue} : undef;
|
2002
|
|
|
|
|
|
|
}
|
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
sub reference #USER-CALLABLE FUNCTION, ADDED 20110227, v. 4.8:
|
2005
|
|
|
|
|
|
|
{
|
2006
|
|
|
|
|
|
|
my $w = shift;
|
2007
|
|
|
|
|
|
|
return undef unless (defined $_[0]);
|
2008
|
|
|
|
|
|
|
my $userValue = shift;
|
2009
|
|
|
|
|
|
|
return (defined($w->{hashref}) && defined($w->{hashref}->{$userValue}))
|
2010
|
|
|
|
|
|
|
? $w->{hashref}->{$userValue} : '';
|
2011
|
|
|
|
|
|
|
}
|
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
sub hasreference #USER-CALLABLE FUNCTION, ADDED 20050125.
|
2014
|
|
|
|
|
|
|
{
|
2015
|
|
|
|
|
|
|
my $w = shift;
|
2016
|
|
|
|
|
|
|
return undef unless (defined $_[0]);
|
2017
|
|
|
|
|
|
|
my $userValue = shift;
|
2018
|
|
|
|
|
|
|
return (defined($w->{hashref_bydesc}) && defined($w->{hashref_bydesc}->{$userValue}))
|
2019
|
|
|
|
|
|
|
? 1 : undef;
|
2020
|
|
|
|
|
|
|
}
|
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
sub get_hashref_byname #USER-CALLABLE FUNCTION, ADDED 20110227, v. 4.8:
|
2023
|
|
|
|
|
|
|
{
|
2024
|
|
|
|
|
|
|
my $w = shift;
|
2025
|
|
|
|
|
|
|
return (defined $w->{hashref_bydesc}) ? $w->{hashref_bydesc} : undef;
|
2026
|
|
|
|
|
|
|
}
|
2027
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
sub fetchhash #DEPRECIATED, RENAMED get_hashref_byname():
|
2029
|
|
|
|
|
|
|
{
|
2030
|
|
|
|
|
|
|
my $w = shift;
|
2031
|
|
|
|
|
|
|
return $w->get_hashref_byname;
|
2032
|
|
|
|
|
|
|
}
|
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
sub get_hashref_byvalue #USER-CALLABLE FUNCTION, ADDED 20110227, v. 4.8:
|
2035
|
|
|
|
|
|
|
{
|
2036
|
|
|
|
|
|
|
my $w = shift;
|
2037
|
|
|
|
|
|
|
return (defined $w->{hashref}) ? $w->{hashref} : undef;
|
2038
|
|
|
|
|
|
|
}
|
2039
|
|
|
|
|
|
|
|
2040
|
|
|
|
|
|
|
sub get #USER-CALLABLE FUNCTION, ADDED 20090210 v4.72
|
2041
|
|
|
|
|
|
|
{
|
2042
|
|
|
|
|
|
|
my $w = shift;
|
2043
|
|
|
|
|
|
|
if ( @_ ) #NO ARGS, RETURN CURRENT CHOICES.
|
2044
|
|
|
|
|
|
|
{
|
2045
|
|
|
|
|
|
|
return $w->Subwidget("slistbox")->get( @_ );
|
2046
|
|
|
|
|
|
|
}
|
2047
|
|
|
|
|
|
|
else #RETURN CHOICES:
|
2048
|
|
|
|
|
|
|
{
|
2049
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
2050
|
|
|
|
|
|
|
return $$var_ref;
|
2051
|
|
|
|
|
|
|
}
|
2052
|
|
|
|
|
|
|
}
|
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
sub get_index #USER-CALLABLE FUNCTION, ADDED 20110227, v. 4.8:
|
2055
|
|
|
|
|
|
|
{
|
2056
|
|
|
|
|
|
|
my $w = shift;
|
2057
|
|
|
|
|
|
|
return undef unless (@_);
|
2058
|
|
|
|
|
|
|
my $val = shift;
|
2059
|
|
|
|
|
|
|
my @keys = $w->get(0, 'end');
|
2060
|
|
|
|
|
|
|
for (my $k=0;$k<=$#keys;$k++)
|
2061
|
|
|
|
|
|
|
{
|
2062
|
|
|
|
|
|
|
return $k if ($keys[$k] eq $val);
|
2063
|
|
|
|
|
|
|
}
|
2064
|
|
|
|
|
|
|
return undef;
|
2065
|
|
|
|
|
|
|
}
|
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
sub activate #USER-CALLABLE FUNCTION, ADDED 20090210 v4.72
|
2068
|
|
|
|
|
|
|
{
|
2069
|
|
|
|
|
|
|
my $w = shift;
|
2070
|
|
|
|
|
|
|
my $indx = shift;
|
2071
|
|
|
|
|
|
|
my $initx = shift || 1;
|
2072
|
|
|
|
|
|
|
my $res = $w->Subwidget("slistbox")->Subwidget("listbox")->activate($indx);
|
2073
|
|
|
|
|
|
|
if ($initx)
|
2074
|
|
|
|
|
|
|
{
|
2075
|
|
|
|
|
|
|
my $var_ref = $w->cget( "-textvariable" );
|
2076
|
|
|
|
|
|
|
$$var_ref = $w->Subwidget("slistbox")->Subwidget("listbox")->get($indx);
|
2077
|
|
|
|
|
|
|
}
|
2078
|
|
|
|
|
|
|
return $res;
|
2079
|
|
|
|
|
|
|
}
|
2080
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
sub index
|
2082
|
|
|
|
|
|
|
{
|
2083
|
|
|
|
|
|
|
my $w = shift;
|
2084
|
|
|
|
|
|
|
return $w->Subwidget("slistbox")->Subwidget("listbox")->index(@_);
|
2085
|
|
|
|
|
|
|
}
|
2086
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
sub size
|
2088
|
|
|
|
|
|
|
{
|
2089
|
|
|
|
|
|
|
my $w = shift;
|
2090
|
|
|
|
|
|
|
return $w->Subwidget("slistbox")->Subwidget("listbox")->size(@_);
|
2091
|
|
|
|
|
|
|
}
|
2092
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
1
|
2094
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
__END__
|