line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Tk::TabFrame; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
3174
|
use Tk; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use Tk::ChildNotification; |
5
|
|
|
|
|
|
|
use Tk::Frame; |
6
|
|
|
|
|
|
|
use Tk::Label; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use base qw (Tk::Derived Tk::Frame); |
9
|
|
|
|
|
|
|
use vars qw ($VERSION); |
10
|
|
|
|
|
|
|
use strict; |
11
|
|
|
|
|
|
|
use Carp; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
$VERSION = '0.01'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Tk::Widget->Construct ('TabFrame'); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub Populate |
18
|
|
|
|
|
|
|
{ |
19
|
|
|
|
|
|
|
my $this = shift; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $l_ButtonFrame = $this->{m_ButtonFrame} = $this->Component |
22
|
|
|
|
|
|
|
( |
23
|
|
|
|
|
|
|
'Frame' => 'ButtonFrame', |
24
|
|
|
|
|
|
|
'-borderwidth' => 0, |
25
|
|
|
|
|
|
|
'-relief' => 'flat', |
26
|
|
|
|
|
|
|
'-height' => 40, |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $l_ClientFrame = $this->{m_ClientFrame} = $this->Component |
30
|
|
|
|
|
|
|
( |
31
|
|
|
|
|
|
|
'TabChildFrame' => 'TabChildFrame', |
32
|
|
|
|
|
|
|
'-relief' => 'flat', |
33
|
|
|
|
|
|
|
'-borderwidth' => 0, |
34
|
|
|
|
|
|
|
'-height' => 60, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $l_MagicFrame = $this->Component |
38
|
|
|
|
|
|
|
( |
39
|
|
|
|
|
|
|
'Frame' => 'MagicFrame', |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$l_ButtonFrame->pack |
43
|
|
|
|
|
|
|
( |
44
|
|
|
|
|
|
|
'-anchor' => 'nw', |
45
|
|
|
|
|
|
|
'-side' => 'top', |
46
|
|
|
|
|
|
|
'-fill' => 'x', |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
$l_ClientFrame->pack |
50
|
|
|
|
|
|
|
( |
51
|
|
|
|
|
|
|
'-side' => 'top', |
52
|
|
|
|
|
|
|
'-expand' => 'true', |
53
|
|
|
|
|
|
|
'-fill' => 'both', |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
$this->ConfigSpecs |
57
|
|
|
|
|
|
|
( |
58
|
|
|
|
|
|
|
'-borderwidth' => [['SELF', 'PASSIVE'], 'borderwidth', 'BorderWidth', '1'], |
59
|
|
|
|
|
|
|
'-tabcurve' => [['SELF', 'PASSIVE'], 'tabcurve', 'TabCurve', 2], |
60
|
|
|
|
|
|
|
'-padx' => [['SELF', 'PASSIVE'], 'padx', 'padx', 5], |
61
|
|
|
|
|
|
|
'-pady' => [['SELF', 'PASSIVE'], 'pady', 'pady', 5], |
62
|
|
|
|
|
|
|
'-font' => ['METHOD', 'font', 'Font', undef], |
63
|
|
|
|
|
|
|
'-current' => ['METHOD'], |
64
|
|
|
|
|
|
|
'-raised' => ['METHOD'], |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# These are historical. Their use is deprecated |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
'-trimcolor' => ['PASSIVE', 'trimcolor','trimcolor', undef], |
69
|
|
|
|
|
|
|
'-bottomedge' => ['PASSIVE', 'bottomedge', 'BottomEdge', undef], |
70
|
|
|
|
|
|
|
'-sideedge' => ['PASSIVE', 'sideedge', 'SideEdge', undef], |
71
|
|
|
|
|
|
|
'-tabstart' => ['PASSIVE', 'tabstart', 'TabStart', undef], |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$l_ClientFrame->bind (' |
75
|
|
|
|
|
|
|
$this->Delegates ('Construct' => $l_ClientFrame); |
76
|
|
|
|
|
|
|
$this->SUPER::Populate (@_); |
77
|
|
|
|
|
|
|
return $this; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub TabCreate |
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
my ($this, $p_Widget, $p_Caption, $p_Color) = (shift, @_); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
my $l_Previous = |
85
|
|
|
|
|
|
|
( |
86
|
|
|
|
|
|
|
defined (${$this->{m_ClientList}}[-1]) ? |
87
|
|
|
|
|
|
|
$this->{m_ButtonFrame}->Subwidget ('Button_'.${$this->{m_ClientList}}[-1])->Subwidget ('Button') : |
88
|
|
|
|
|
|
|
undef |
89
|
|
|
|
|
|
|
); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my $l_TabFrame = $this->{m_ButtonFrame}->Component |
92
|
|
|
|
|
|
|
( |
93
|
|
|
|
|
|
|
'Frame' => 'Button_'.$p_Widget, |
94
|
|
|
|
|
|
|
'-foreground' => $this->cget ('-foreground'), |
95
|
|
|
|
|
|
|
'-relief' => 'flat', |
96
|
|
|
|
|
|
|
'-borderwidth' => 0, |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $l_Button = $l_TabFrame->Component |
100
|
|
|
|
|
|
|
( |
101
|
|
|
|
|
|
|
'Button' => 'Button', |
102
|
|
|
|
|
|
|
'-command' => sub {$this->configure ('-current' => $p_Widget);}, |
103
|
|
|
|
|
|
|
(defined ($p_Color) ? ('-bg' => $p_Color) : ()), |
104
|
|
|
|
|
|
|
'-text' => $p_Caption || $p_Widget->name(), |
105
|
|
|
|
|
|
|
'-font' => $this->cget (-font), |
106
|
|
|
|
|
|
|
'-relief' => 'flat', |
107
|
|
|
|
|
|
|
'-borderwidth' => 0, |
108
|
|
|
|
|
|
|
'-takefocus' => 1, |
109
|
|
|
|
|
|
|
'-padx' => 2, |
110
|
|
|
|
|
|
|
'-pady' => 2, |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
$l_TabFrame->bind ('' => sub {$l_Button->invoke();}); |
114
|
|
|
|
|
|
|
$l_Button->bind ('', sub {$l_Button->configure ('-highlightthickness' => 0);}); |
115
|
|
|
|
|
|
|
$l_Button->bind ('', sub {$l_Button->configure ('-highlightthickness' => 1);}); |
116
|
|
|
|
|
|
|
$l_Button->bind ('', sub {($this->children())[0]->focus();}); |
117
|
|
|
|
|
|
|
$l_Button->bind ('' => sub {$l_Button->invoke();}); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
if (defined ($l_Previous)) |
120
|
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
|
$l_Button->bind ('', sub {$l_Previous->focus();}); |
122
|
|
|
|
|
|
|
$l_Button->bind ('', sub {$l_Previous->invoke();}); |
123
|
|
|
|
|
|
|
$l_Previous->bind ('', sub {$l_Button->focus();}); |
124
|
|
|
|
|
|
|
$l_Previous->bind ('', sub {$l_Button->invoke();}); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
$this->TabBorder ($l_TabFrame); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
$this->{m_ClientFrame}->configure |
130
|
|
|
|
|
|
|
( |
131
|
|
|
|
|
|
|
'-borderwidth' => $this->cget ('-borderwidth'), |
132
|
|
|
|
|
|
|
'-relief' => 'raised', |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
$l_Button->configure |
136
|
|
|
|
|
|
|
( |
137
|
|
|
|
|
|
|
'-highlightcolor' => $l_Button->Darken ($l_Button->cget (-background), 50), |
138
|
|
|
|
|
|
|
'-activebackground' => $l_Button->cget (-background), |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
$l_Button->pack |
142
|
|
|
|
|
|
|
( |
143
|
|
|
|
|
|
|
'-expand' => 'true', |
144
|
|
|
|
|
|
|
'-fill' => 'both', |
145
|
|
|
|
|
|
|
'-ipadx' => 0, |
146
|
|
|
|
|
|
|
'-ipady' => 0, |
147
|
|
|
|
|
|
|
'-padx' => 3, |
148
|
|
|
|
|
|
|
'-pady' => 3, |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$l_TabFrame->place |
152
|
|
|
|
|
|
|
( |
153
|
|
|
|
|
|
|
'-width' => ($l_Button->reqwidth() || 20) + 5, |
154
|
|
|
|
|
|
|
'-x' => $this->GetButtonRowWidth(), |
155
|
|
|
|
|
|
|
'-relheight' => 1.0, |
156
|
|
|
|
|
|
|
'-anchor' => 'nw', |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
$this->{m_ButtonFrame}->GeometryRequest |
160
|
|
|
|
|
|
|
( |
161
|
|
|
|
|
|
|
$this->{m_ButtonFrame}->width(), |
162
|
|
|
|
|
|
|
$this->GetButtonRowHeight() + 5, |
163
|
|
|
|
|
|
|
); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
push (@{$this->{m_ClientList}}, $p_Widget); |
166
|
|
|
|
|
|
|
return $this->TabCurrent ($p_Widget); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub TabRaise |
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
my ($this, $p_Widget) = (shift, @_); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
my $l_ButtonFrame = $this->{m_ButtonFrame}; |
174
|
|
|
|
|
|
|
my $l_TabFrame = $l_ButtonFrame->Subwidget ('Button_'.$p_Widget); |
175
|
|
|
|
|
|
|
my $l_MagicFrame = $this->Subwidget ('MagicFrame'); |
176
|
|
|
|
|
|
|
my %l_Hash = $l_TabFrame->placeInfo(); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
foreach my $l_Client (@{$this->{m_ClientList}}) |
179
|
|
|
|
|
|
|
{ |
180
|
|
|
|
|
|
|
if ($l_Client ne $p_Widget) |
181
|
|
|
|
|
|
|
{ |
182
|
|
|
|
|
|
|
my $l_TabButton = $l_ButtonFrame->Subwidget ('Button_'.$l_Client); |
183
|
|
|
|
|
|
|
$l_TabButton->place ('-height' => - 5, '-y' => 5); |
184
|
|
|
|
|
|
|
$l_TabButton->lower ($l_TabFrame); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$l_MagicFrame->place |
189
|
|
|
|
|
|
|
( |
190
|
|
|
|
|
|
|
'-x' => $l_Hash {'-x'}, |
191
|
|
|
|
|
|
|
'-y' => $this->{m_ClientFrame}->rooty() - $this->rooty() - 1, |
192
|
|
|
|
|
|
|
'-height' => $this->{m_ClientFrame}->cget ('-borderwidth'), |
193
|
|
|
|
|
|
|
'-width' => $l_Hash {'-width'}, |
194
|
|
|
|
|
|
|
'-anchor' => 'nw', |
195
|
|
|
|
|
|
|
); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
$l_MagicFrame->configure ('-bg' => $l_TabFrame->cget ('-background')); |
198
|
|
|
|
|
|
|
$l_TabFrame->place ('-height' => - 1, '-y' => 1); |
199
|
|
|
|
|
|
|
$l_TabFrame->Subwidget ('Button')->focus(); |
200
|
|
|
|
|
|
|
$l_TabFrame->Subwidget ('Button')->raise(); |
201
|
|
|
|
|
|
|
$l_MagicFrame->raise (); |
202
|
|
|
|
|
|
|
$l_TabFrame->raise(); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
foreach my $l_Sibling ($p_Widget->parent()->children()) |
205
|
|
|
|
|
|
|
{ |
206
|
|
|
|
|
|
|
$l_Sibling->lower ($p_Widget) if ($l_Sibling ne $p_Widget); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$p_Widget->raise(); |
210
|
|
|
|
|
|
|
return $p_Widget; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub TabBorder |
214
|
|
|
|
|
|
|
{ |
215
|
|
|
|
|
|
|
my ($this, $p_TabFrame) = (shift, @_); |
216
|
|
|
|
|
|
|
my $l_LineWidth = $this->cget ('-borderwidth'); |
217
|
|
|
|
|
|
|
my $l_Background = $this->cget ('-background'); |
218
|
|
|
|
|
|
|
my $l_InnerBackground = $p_TabFrame->Darken ($l_Background, 120), |
219
|
|
|
|
|
|
|
my $l_Curve = $this->cget ('-tabcurve'); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my $l_LeftOuterBorder = $p_TabFrame->Frame |
222
|
|
|
|
|
|
|
( |
223
|
|
|
|
|
|
|
'-background' => 'white', |
224
|
|
|
|
|
|
|
'-borderwidth' => 0, |
225
|
|
|
|
|
|
|
); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
my $l_LeftInnerBorder = $p_TabFrame->Frame |
228
|
|
|
|
|
|
|
( |
229
|
|
|
|
|
|
|
'-background' => $l_InnerBackground, |
230
|
|
|
|
|
|
|
'-borderwidth' => 0, |
231
|
|
|
|
|
|
|
); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
my $l_TopOuterBorder = $p_TabFrame->Frame |
234
|
|
|
|
|
|
|
( |
235
|
|
|
|
|
|
|
'-background' => 'white', |
236
|
|
|
|
|
|
|
'-borderwidth' => 0, |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
my $l_TopInnerBorder = $p_TabFrame->Frame |
240
|
|
|
|
|
|
|
( |
241
|
|
|
|
|
|
|
'-background' => $l_InnerBackground, |
242
|
|
|
|
|
|
|
'-borderwidth' => 0, |
243
|
|
|
|
|
|
|
); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
my $l_RightOuterBorder = $p_TabFrame->Frame |
246
|
|
|
|
|
|
|
( |
247
|
|
|
|
|
|
|
'-background' => 'black', |
248
|
|
|
|
|
|
|
'-borderwidth' => 0, |
249
|
|
|
|
|
|
|
); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
my $l_RightInnerBorder = $p_TabFrame->Frame |
252
|
|
|
|
|
|
|
( |
253
|
|
|
|
|
|
|
'-background' => $p_TabFrame->Darken ($l_Background, 80), |
254
|
|
|
|
|
|
|
'-borderwidth' => 0, |
255
|
|
|
|
|
|
|
); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
$l_LeftOuterBorder->place |
258
|
|
|
|
|
|
|
( |
259
|
|
|
|
|
|
|
'-x' => 0, |
260
|
|
|
|
|
|
|
'-y' => $l_Curve - 1, |
261
|
|
|
|
|
|
|
'-width' => $l_LineWidth, |
262
|
|
|
|
|
|
|
'-relheight' => 1.0, |
263
|
|
|
|
|
|
|
); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
$l_LeftInnerBorder->place |
266
|
|
|
|
|
|
|
( |
267
|
|
|
|
|
|
|
'-x' => $l_LineWidth, |
268
|
|
|
|
|
|
|
'-y' => $l_Curve - 1, |
269
|
|
|
|
|
|
|
'-width' => $l_LineWidth, |
270
|
|
|
|
|
|
|
'-relheight' => 1.0, |
271
|
|
|
|
|
|
|
); |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
$l_TopInnerBorder->place |
274
|
|
|
|
|
|
|
( |
275
|
|
|
|
|
|
|
'-x' => $l_Curve - 1, |
276
|
|
|
|
|
|
|
'-y' => $l_LineWidth, |
277
|
|
|
|
|
|
|
'-relwidth' => 1.0, |
278
|
|
|
|
|
|
|
'-height' => $l_LineWidth, |
279
|
|
|
|
|
|
|
'-width' => - ($l_Curve * 2), |
280
|
|
|
|
|
|
|
); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
$l_TopOuterBorder->place |
283
|
|
|
|
|
|
|
( |
284
|
|
|
|
|
|
|
'-x' => $l_Curve - 1, |
285
|
|
|
|
|
|
|
'-y' => 0, |
286
|
|
|
|
|
|
|
'-relwidth' => 1.0, |
287
|
|
|
|
|
|
|
'-height' => $l_LineWidth, |
288
|
|
|
|
|
|
|
'-width' => - ($l_Curve * 2), |
289
|
|
|
|
|
|
|
); |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
$l_RightOuterBorder->place |
292
|
|
|
|
|
|
|
( |
293
|
|
|
|
|
|
|
'-x' => - ($l_LineWidth), |
294
|
|
|
|
|
|
|
'-relx' => 1.0, |
295
|
|
|
|
|
|
|
'-width' => $l_LineWidth, |
296
|
|
|
|
|
|
|
'-relheight' => 1.0, |
297
|
|
|
|
|
|
|
'-y' => $l_Curve, |
298
|
|
|
|
|
|
|
); |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
$l_RightInnerBorder->place |
301
|
|
|
|
|
|
|
( |
302
|
|
|
|
|
|
|
'-x' => - ($l_LineWidth * 2), |
303
|
|
|
|
|
|
|
'-width' => $l_LineWidth, |
304
|
|
|
|
|
|
|
'-relheight' => 1.0, |
305
|
|
|
|
|
|
|
'-y' => $l_Curve / 2, |
306
|
|
|
|
|
|
|
'-relx' => 1.0, |
307
|
|
|
|
|
|
|
); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub TabCurrent |
311
|
|
|
|
|
|
|
{ |
312
|
|
|
|
|
|
|
return |
313
|
|
|
|
|
|
|
( |
314
|
|
|
|
|
|
|
defined ($_[1]) ? |
315
|
|
|
|
|
|
|
$_[0]->TabRaise ($_[0]->{m_Raised} = $_[1]) : |
316
|
|
|
|
|
|
|
$_[0]->{m_Raised} |
317
|
|
|
|
|
|
|
); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub GetButtonRowWidth |
321
|
|
|
|
|
|
|
{ |
322
|
|
|
|
|
|
|
my ($l_Width, $this) = (0, shift, @_); |
323
|
|
|
|
|
|
|
my $l_ButtonFrame = $this->{m_ButtonFrame}; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
foreach my $l_Client (@{$this->{m_ClientList}}) |
326
|
|
|
|
|
|
|
{ |
327
|
|
|
|
|
|
|
$l_Width += $l_ButtonFrame->Subwidget ('Button_'.$l_Client)->Subwidget ('Button')->reqwidth(); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
return $l_Width ? $l_Width - 10 : $l_Width; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub GetButtonRowHeight |
334
|
|
|
|
|
|
|
{ |
335
|
|
|
|
|
|
|
my ($l_Height, $this) = (0, shift, @_); |
336
|
|
|
|
|
|
|
my $l_ButtonFrame = $this->{m_ButtonFrame}; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
foreach my $l_Client (@{$this->{m_ClientList}}) |
339
|
|
|
|
|
|
|
{ |
340
|
|
|
|
|
|
|
my $l_NewHeight = $l_ButtonFrame->Subwidget ('Button_'.$l_Client)->Subwidget ('Button')->reqheight(); |
341
|
|
|
|
|
|
|
$l_Height = $l_NewHeight if ($l_NewHeight > $l_Height); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
return $l_Height; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub Font |
348
|
|
|
|
|
|
|
{ |
349
|
|
|
|
|
|
|
my ($this, $p_Font) = (shift, @_); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
return ($this->{m_Font}) unless (defined ($p_Font)); |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
my $l_ButtonFrame = $this->{m_ButtonFrame}; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
foreach my $l_Client (@{$this->{m_ClientList}}) |
356
|
|
|
|
|
|
|
{ |
357
|
|
|
|
|
|
|
$l_ButtonFrame->Subwidget ('Button_'.$l_Client)->Subwidget ('Button')->configure |
358
|
|
|
|
|
|
|
( |
359
|
|
|
|
|
|
|
'-font' => $p_Font, |
360
|
|
|
|
|
|
|
); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
return ($this->{m_Font} = $p_Font); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub current |
367
|
|
|
|
|
|
|
{ |
368
|
|
|
|
|
|
|
shift->TabCurrent (@_); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub raised |
372
|
|
|
|
|
|
|
{ |
373
|
|
|
|
|
|
|
shift->TabCurrent (@_); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub font |
377
|
|
|
|
|
|
|
{ |
378
|
|
|
|
|
|
|
shift->Font (@_); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
1; |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
package Tk::TabChildFrame; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
use Tk::ChildNotification; |
386
|
|
|
|
|
|
|
use Tk; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
use vars qw ($VERSION @ISA); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
use strict; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
$VERSION = '1.01'; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
@ISA = qw (Tk::Widget Tk::Frame); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Tk::Widget->Construct ('TabChildFrame'); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub Populate |
399
|
|
|
|
|
|
|
{ |
400
|
|
|
|
|
|
|
my ($this, $p_Parameters) = (shift, @_); |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
$this->SUPER::Populate (@_); |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
return $this; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub QueueLayout |
408
|
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
|
$_[0]->DoWhenIdle (['ExecuteLayout', $_[0]]) unless ($_[0]->{'LayoutPending'}++); |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub SlaveGeometryRequest |
413
|
|
|
|
|
|
|
{ |
414
|
|
|
|
|
|
|
shift->QueueLayout(); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub LostSlave |
418
|
|
|
|
|
|
|
{ |
419
|
|
|
|
|
|
|
shift->QueueLayout(); |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub ExecuteLayout |
423
|
|
|
|
|
|
|
{ |
424
|
|
|
|
|
|
|
my $this = shift; |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
$this->{'LayoutPending'} = 0; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
my $l_PadX = $this->parent()->cget ('-padx'); |
429
|
|
|
|
|
|
|
my $l_PadY = $this->parent()->cget ('-pady'); |
430
|
|
|
|
|
|
|
my $l_Height = 0; |
431
|
|
|
|
|
|
|
my $l_Width = 0; |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
foreach my $l_Child ($this->children()) |
434
|
|
|
|
|
|
|
{ |
435
|
|
|
|
|
|
|
next unless Exists ($l_Child); |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
my @l_Dimensions = |
438
|
|
|
|
|
|
|
( |
439
|
|
|
|
|
|
|
$l_Child->reqwidth(), |
440
|
|
|
|
|
|
|
$l_Child->reqheight(), |
441
|
|
|
|
|
|
|
); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
$l_Height = $l_Dimensions [1] if ($l_Dimensions [1] > $l_Height); |
444
|
|
|
|
|
|
|
$l_Width = $l_Dimensions [0] if ($l_Dimensions [0] > $l_Width); |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
foreach my $l_Child ($this->children()) |
448
|
|
|
|
|
|
|
{ |
449
|
|
|
|
|
|
|
next unless Exists ($l_Child); |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
$l_Child->MoveResizeWindow |
452
|
|
|
|
|
|
|
( |
453
|
|
|
|
|
|
|
$l_PadX, |
454
|
|
|
|
|
|
|
$l_PadY, |
455
|
|
|
|
|
|
|
$l_Width, |
456
|
|
|
|
|
|
|
$l_Height, |
457
|
|
|
|
|
|
|
); |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
$l_Child->MapWindow(); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
$this->GeometryRequest |
463
|
|
|
|
|
|
|
( |
464
|
|
|
|
|
|
|
$l_Width + ($l_PadX * 2), |
465
|
|
|
|
|
|
|
$l_Height + ($l_PadY * 2), |
466
|
|
|
|
|
|
|
); |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub ChildNotification |
470
|
|
|
|
|
|
|
{ |
471
|
|
|
|
|
|
|
my ($this, $p_Child, $p_Arguments) = (shift, @_); |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
$p_Child->packForget(); |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
$this->ManageGeometry ($p_Child); |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
$this->parent()->TabCreate |
478
|
|
|
|
|
|
|
( |
479
|
|
|
|
|
|
|
$p_Child, |
480
|
|
|
|
|
|
|
delete $p_Arguments->{'-caption'}, |
481
|
|
|
|
|
|
|
delete $p_Arguments->{'-tabcolor'}, |
482
|
|
|
|
|
|
|
); |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
1; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
__END__ |