author | Claus Gittinger <cg@exept.de> |
Sat, 02 May 2020 19:50:29 +0200 | |
changeset 6244 | 2050c2ab251c |
parent 6182 | ff49f5c3a2e9 |
permissions | -rw-r--r-- |
5879 | 1 |
"{ Encoding: utf8 }" |
2 |
||
696 | 3 |
" |
4 |
COPYRIGHT (c) 1997 by eXept Software AG |
|
5 |
All Rights Reserved |
|
6 |
||
7 |
This software is furnished under a license and may be used |
|
8 |
only in accordance with the terms of that license and with the |
|
9 |
inclusion of the above copyright notice. This software may not |
|
10 |
be provided or otherwise made available to, or used by, any |
|
11 |
other person. No title to or ownership of the software is |
|
12 |
hereby transferred. |
|
13 |
" |
|
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
14 |
"{ Package: 'stx:libwidg2' }" |
1759 | 15 |
|
5153 | 16 |
"{ NameSpace: Smalltalk }" |
17 |
||
696 | 18 |
Model subclass:#TabItem |
3191 | 19 |
instanceVariableNames:'view rawLabel label enabled argument canvas activeHelpText |
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
20 |
translateLabel applicationProvidesLabel shortcutKey majorKey |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
21 |
minorKey miniScrollerVertical miniScrollerHorizontal |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
22 |
hasVerticalScrollBar hasHorizontalScrollBar foregroundColor |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
23 |
createNewBuilder autoHideScrollBars accessCharacterPosition |
4159
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
24 |
activeHelpKey builder nameKey destroyTabButtonAction |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
25 |
destroyTabAction' |
696 | 26 |
classVariableNames:'' |
27 |
poolDictionaries:'' |
|
28 |
category:'Views-Support' |
|
29 |
! |
|
30 |
||
31 |
!TabItem class methodsFor:'documentation'! |
|
32 |
||
33 |
copyright |
|
34 |
" |
|
35 |
COPYRIGHT (c) 1997 by eXept Software AG |
|
36 |
All Rights Reserved |
|
37 |
||
38 |
This software is furnished under a license and may be used |
|
39 |
only in accordance with the terms of that license and with the |
|
40 |
inclusion of the above copyright notice. This software may not |
|
41 |
be provided or otherwise made available to, or used by, any |
|
42 |
other person. No title to or ownership of the software is |
|
43 |
hereby transferred. |
|
44 |
" |
|
45 |
||
46 |
! |
|
47 |
||
48 |
documentation |
|
49 |
" |
|
50 |
describes one tab entry; could be used for tabs instead of a string. Whenever |
|
51 |
a value changed, a change notification is raised |
|
52 |
||
53 |
[see also:] |
|
54 |
TabItemEditor |
|
55 |
TabView |
|
56 |
NoteBookView |
|
57 |
UIPainter |
|
58 |
||
59 |
[author:] |
|
60 |
Claus Atzkern |
|
61 |
" |
|
62 |
||
63 |
||
64 |
! |
|
65 |
||
66 |
examples |
|
67 |
" |
|
68 |
labels derived from item |
|
69 |
[exBegin] |
|
70 |
|top tab| |
|
71 |
||
72 |
top := StandardSystemView new label:'tabs at top'; extent:250@100. |
|
73 |
tab := TabView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top. |
|
74 |
||
75 |
tab direction:#top. |
|
76 |
tab list:(#( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ]). |
|
77 |
tab action:[:aName|Transcript showCR:aName]. |
|
78 |
top open. |
|
79 |
[exEnd] |
|
80 |
||
3516 | 81 |
[exBegin] |
82 |
|top tab list item| |
|
83 |
||
84 |
top := StandardSystemView new label:'tabs at top'; extent:400@400. |
|
85 |
tab := NoteBookView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top. |
|
86 |
||
87 |
tab direction:#top. |
|
88 |
list := #( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ]. |
|
89 |
||
90 |
item := list at:1. |
|
91 |
item majorKey:ClockView. |
|
92 |
||
93 |
item := list at:2. |
|
94 |
item majorKey:CodingExamples_GUI::GUIDemoNoteBook. |
|
95 |
||
96 |
item := list at:3. |
|
97 |
item majorKey:CodingExamples_GUI::GUIDemoMenu. |
|
98 |
||
99 |
tab list:list. |
|
100 |
top open. |
|
101 |
[exEnd] |
|
696 | 102 |
|
103 |
testing tab configuration and change notifications |
|
104 |
[exBegin] |
|
105 |
|top tab list idx label| |
|
106 |
||
107 |
top := StandardSystemView new label:'tabs at top'; extent:250@100. |
|
108 |
tab := TabView origin:0.0 @ 0.0 corner:1.0 @ 0.5 in:top. |
|
109 |
||
110 |
tab direction:#top. |
|
111 |
list := (#( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ]). |
|
112 |
tab list:list. |
|
113 |
tab action:[:aName|Transcript showCR:aName]. |
|
114 |
top openAndWait. |
|
115 |
||
116 |
[ |
|
117 |
idx := 0. |
|
118 |
label := LabelAndIcon icon:(Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm' )) |
|
119 |
string:'Test Tab'. |
|
120 |
||
121 |
[top shown] whileTrue:[ |
|
122 |
|aTab lbl| |
|
123 |
||
124 |
(idx := idx + 1) > list size ifTrue:[idx := 1]. |
|
125 |
||
126 |
aTab := list at:idx. |
|
127 |
lbl := aTab label. |
|
128 |
||
129 |
Delay waitForSeconds:0.5. aTab label:label. |
|
130 |
Delay waitForSeconds:0.5. aTab enabled:false. |
|
131 |
Delay waitForSeconds:0.5. aTab enabled:true. |
|
132 |
Delay waitForSeconds:0.5. aTab foregroundColor:(Color red). |
|
133 |
Delay waitForSeconds:0.5. aTab foregroundColor:nil. |
|
134 |
aTab label:lbl. |
|
135 |
] |
|
136 |
] forkAt:1. |
|
137 |
[exEnd] |
|
138 |
||
139 |
" |
|
140 |
! ! |
|
141 |
||
142 |
!TabItem class methodsFor:'instance creation'! |
|
143 |
||
144 |
label:aLabel |
|
145 |
^ self new label:aLabel |
|
146 |
! ! |
|
147 |
||
148 |
!TabItem methodsFor:'accessing'! |
|
149 |
||
1671 | 150 |
accessCharacterPosition |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
151 |
"get the index of the access character in the label text or string, or 0 if none" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
152 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
153 |
^ accessCharacterPosition ? 0 |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
154 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
155 |
"Modified: / 06-09-2006 / 14:57:08 / cg" |
1671 | 156 |
! |
157 |
||
1759 | 158 |
accessCharacterPosition:anIndex |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
159 |
"set the index of the access character in the label" |
1759 | 160 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
161 |
accessCharacterPosition := anIndex |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
162 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
163 |
"Modified: / 06-09-2006 / 14:57:44 / cg" |
1671 | 164 |
! |
165 |
||
716 | 166 |
argument |
167 |
"returns a user defined argument or nil |
|
168 |
" |
|
169 |
^ argument |
|
170 |
! |
|
171 |
||
172 |
argument:anArgument |
|
173 |
"set a user defined argument |
|
174 |
" |
|
1674 | 175 |
(anArgument isString and:[anArgument isEmpty]) ifTrue:[ |
176 |
argument := nil |
|
177 |
] ifFalse:[ |
|
178 |
argument := anArgument |
|
179 |
]. |
|
716 | 180 |
argument := anArgument |
181 |
! |
|
182 |
||
1759 | 183 |
createNewBuilder |
184 |
"returns true if a new builder is used to create the canvas; |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
185 |
the default is true" |
1759 | 186 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
187 |
^ createNewBuilder ? true |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
188 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
189 |
"Modified: / 06-09-2006 / 14:58:58 / cg" |
1759 | 190 |
! |
191 |
||
192 |
createNewBuilder:aBool |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
193 |
"set/clear the flag which controls if a new ui-builder is used to create the canvas; |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
194 |
the default is true. This affects if the bindings will be shared or not between tabs." |
1759 | 195 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
196 |
createNewBuilder := aBool |
1759 | 197 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
198 |
"Modified: / 06-09-2006 / 15:00:04 / cg" |
1759 | 199 |
! |
200 |
||
4159
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
201 |
destroyTabAction |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
202 |
"if non-nil, this tab has its own private destroyButton. |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
203 |
This can be used for individual tabs; for an overall tab-destroy capability, |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
204 |
change the destroyTab: action of my owning tabView" |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
205 |
|
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
206 |
^ destroyTabAction |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
207 |
! |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
208 |
|
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
209 |
destroyTabAction:aBlock |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
210 |
"if non-nil, this tab has its own private destroyButton. |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
211 |
This can be used for individual tabs; for an overall tab-destroy capability, |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
212 |
change the destroyTab: action of my owning tabView" |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
213 |
|
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
214 |
destroyTabAction := aBlock |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
215 |
! |
a4bd3b389805
allow for individual tabs to have a destroyButton
Claus Gittinger <cg@exept.de>
parents:
3933
diff
changeset
|
216 |
|
696 | 217 |
enabled |
218 |
"get the enabled state of the tab |
|
219 |
" |
|
220 |
^ enabled ? true |
|
221 |
! |
|
222 |
||
5437 | 223 |
enabled:aBoolean |
696 | 224 |
"set the enabled state of the tab |
225 |
" |
|
226 |
|s| |
|
227 |
||
5437 | 228 |
s := aBoolean ? true. |
696 | 229 |
|
230 |
self enabled ~~ s ifTrue:[ |
|
231 |
enabled := s. |
|
232 |
self changed:#enabled |
|
233 |
] |
|
5437 | 234 |
|
235 |
"Modified (format): / 04-02-2017 / 21:34:46 / cg" |
|
696 | 236 |
! |
237 |
||
3296 | 238 |
hasView |
239 |
^ view notNil |
|
240 |
! |
|
241 |
||
696 | 242 |
label |
6182 | 243 |
"get the label or selector to access a label/bitmap. |
244 |
To get the label to be shown use: #rawLabel |
|
696 | 245 |
" |
246 |
^ label |
|
247 |
! |
|
248 |
||
249 |
label:aLabel |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
250 |
"set the label or selector to access the label/bitmap" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
251 |
|
696 | 252 |
label := aLabel. |
253 |
||
1936
ce9aa6069889
in #label: treat label as different, if emphasis is.
Claus Gittinger <cg@exept.de>
parents:
1891
diff
changeset
|
254 |
(aLabel ~= rawLabel |
3346 | 255 |
or:[aLabel class ~~ rawLabel class |
1936
ce9aa6069889
in #label: treat label as different, if emphasis is.
Claus Gittinger <cg@exept.de>
parents:
1891
diff
changeset
|
256 |
or:[aLabel isString |
ce9aa6069889
in #label: treat label as different, if emphasis is.
Claus Gittinger <cg@exept.de>
parents:
1891
diff
changeset
|
257 |
and:[rawLabel isString |
3346 | 258 |
and:[(aLabel sameStringAndEmphasisAs:rawLabel) not]]]]) |
1936
ce9aa6069889
in #label: treat label as different, if emphasis is.
Claus Gittinger <cg@exept.de>
parents:
1891
diff
changeset
|
259 |
|
ce9aa6069889
in #label: treat label as different, if emphasis is.
Claus Gittinger <cg@exept.de>
parents:
1891
diff
changeset
|
260 |
ifTrue:[ |
696 | 261 |
rawLabel := aLabel. |
262 |
self changed |
|
263 |
] |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
264 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
265 |
"Modified: / 06-09-2006 / 15:54:13 / cg" |
696 | 266 |
! |
267 |
||
3933 | 268 |
nameKey |
269 |
"an additional (untranslated) key (do not use the label to identify tabs)" |
|
270 |
||
271 |
^ nameKey |
|
272 |
||
273 |
"Created: / 21-09-2010 / 16:57:54 / cg" |
|
274 |
! |
|
275 |
||
276 |
nameKey:aStringOrSymbol |
|
277 |
"an additional (untranslated) key (do not use the label to identify tabs)" |
|
278 |
||
279 |
nameKey := aStringOrSymbol |
|
280 |
||
281 |
"Created: / 21-09-2010 / 16:58:05 / cg" |
|
282 |
! |
|
283 |
||
6182 | 284 |
printableLabel |
285 |
^ self rawLabel |
|
286 |
! |
|
287 |
||
1671 | 288 |
shortcutKey |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
289 |
"get the key to press to select the tab item from the keyboard; a symbol or nil" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
290 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
291 |
^ shortcutKey |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
292 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
293 |
"Modified: / 06-09-2006 / 15:09:18 / cg" |
1671 | 294 |
! |
295 |
||
296 |
shortcutKey:aKeyOrNil |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
297 |
"set the key to press to select the tab item from the keyboard; a symbol or nil" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
298 |
|
1759 | 299 |
|key| |
300 |
||
301 |
aKeyOrNil size ~~ 0 ifTrue:[ |
|
302 |
key := aKeyOrNil asSymbol |
|
303 |
]. |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
304 |
shortcutKey := key |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
305 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
306 |
"Modified: / 06-09-2006 / 15:09:31 / cg" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
307 |
! |
1759 | 308 |
|
3919 | 309 |
view |
310 |
^ view |
|
311 |
||
312 |
"Created: / 25-07-2010 / 11:58:53 / cg" |
|
313 |
! |
|
314 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
315 |
view:aView |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
316 |
aView isNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
317 |
view := aView. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
318 |
^ self. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
319 |
]. |
1759 | 320 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
321 |
view notNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
322 |
aView ~~ view ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
323 |
self error:'TabItems cannot be reused'. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
324 |
]. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
325 |
]. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
326 |
view := aView. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
327 |
self setAttributesWithBuilder:view application builder. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
328 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
329 |
"Modified: / 06-09-2006 / 17:58:58 / cg" |
1759 | 330 |
! ! |
331 |
||
2404 | 332 |
!TabItem methodsFor:'accessing-canvas'! |
1759 | 333 |
|
334 |
canvas |
|
3437 | 335 |
"returns the application or view. Creates one if not already present" |
3358 | 336 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
337 |
|view cls wsel classNameKey oldBuilder usedBuilder appl| |
1759 | 338 |
|
339 |
canvas notNil ifTrue:[ |
|
340 |
^ canvas |
|
341 |
]. |
|
342 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
343 |
(classNameKey := majorKey) notNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
344 |
oldBuilder := builder. |
1891
ab8801a1c22d
subapps always got a new builder (even if one was already present)
tm
parents:
1777
diff
changeset
|
345 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
346 |
(oldBuilder notNil |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
347 |
and:[(appl := oldBuilder application) notNil]) ifTrue:[ |
2848 | 348 |
canvas := appl subApplicationFor:majorKey. |
349 |
canvas isNil ifTrue:[ |
|
350 |
cls := appl resolveName:classNameKey. |
|
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
351 |
] |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
352 |
] ifFalse:[ |
5565 | 353 |
classNameKey isUppercaseFirst ifTrue:[ |
354 |
"/ cls := Smalltalk resolveName:classNameKey inClass:self class. |
|
355 |
cls := Smalltalk classNamed:classNameKey. |
|
356 |
cls isNil ifTrue:[ |
|
357 |
('TabItem: no canvas (i.e. class) for majorKey: ' , classNameKey) errorPrintCR. |
|
358 |
^ nil |
|
359 |
]. |
|
360 |
]. |
|
1759 | 361 |
]. |
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
362 |
canvas isNil ifTrue:[ |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
363 |
cls isNil ifTrue:[ |
5565 | 364 |
('TabItem: no canvas or class for majorKey: ' , classNameKey) errorPrintCR. |
2491 | 365 |
^ nil |
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
366 |
]. |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
367 |
canvas := cls new. |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
368 |
]. |
1759 | 369 |
|
2723 | 370 |
self isCanvasApplicationModel ifTrue:[ |
2794 | 371 |
view := ApplicationSubView new. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
372 |
wsel := minorKey ? #windowSpec. |
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
373 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
374 |
(usedBuilder := canvas builder) isNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
375 |
(usedBuilder := oldBuilder) isNil ifTrue:[ |
3516 | 376 |
canvas createBuilder. |
377 |
usedBuilder := canvas builder. |
|
1891
ab8801a1c22d
subapps always got a new builder (even if one was already present)
tm
parents:
1777
diff
changeset
|
378 |
] ifFalse:[ |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
379 |
canvas builder:usedBuilder. |
1891
ab8801a1c22d
subapps always got a new builder (even if one was already present)
tm
parents:
1777
diff
changeset
|
380 |
]. |
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
381 |
]. |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
382 |
|
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
383 |
(appl notNil and:[canvas masterApplication isNil]) ifTrue:[ |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
384 |
canvas masterApplication:appl |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
385 |
]. |
1943
c90153998d43
set new application in builder if builder is created
martin
parents:
1936
diff
changeset
|
386 |
self createNewBuilder ifTrue:[ |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
387 |
usedBuilder application:canvas |
1943
c90153998d43
set new application in builder if builder is created
martin
parents:
1936
diff
changeset
|
388 |
]. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
389 |
view client:canvas spec:wsel builder:usedBuilder. |
1759 | 390 |
canvas window:(self setupCanvasView:view). |
391 |
] ifFalse:[ |
|
392 |
canvas := self setupCanvasView:canvas |
|
1943
c90153998d43
set new application in builder if builder is created
martin
parents:
1936
diff
changeset
|
393 |
] |
1759 | 394 |
]. |
395 |
^ canvas |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
396 |
|
5565 | 397 |
"Modified: / 25-07-2017 / 15:28:21 / cg" |
1759 | 398 |
! |
399 |
||
3436 | 400 |
canvasApplication |
401 |
"returns the application the canvas is running" |
|
402 |
||
403 |
|canvas| |
|
404 |
||
405 |
(canvas := self canvas) isNil ifTrue:[^ nil]. |
|
406 |
(canvas isKindOf:ApplicationModel) ifTrue:[ ^ canvas ]. |
|
407 |
^ canvas application |
|
408 |
! |
|
409 |
||
3347 | 410 |
canvasOrNil |
411 |
"returns the application or nil - does NOT create one" |
|
412 |
||
413 |
^ canvas |
|
414 |
! |
|
415 |
||
1759 | 416 |
canvasView |
417 |
"returns the view the canvas is running in or nil if no canvas |
|
418 |
specified or not yet created |
|
419 |
" |
|
420 |
|canvas| |
|
421 |
||
422 |
(canvas := self canvas) notNil ifTrue:[ |
|
423 |
^ canvas perform:#window ifNotUnderstood:[canvas] |
|
424 |
]. |
|
425 |
^ nil |
|
426 |
! |
|
427 |
||
428 |
destroyCanvas |
|
3268 | 429 |
|canvasView| |
1759 | 430 |
|
431 |
canvas notNil ifTrue:[ |
|
2723 | 432 |
self isCanvasApplicationModel ifTrue:[ |
433 |
canvas releaseAsSubCanvas. |
|
434 |
]. |
|
3268 | 435 |
(canvasView := self canvasView) notNil ifTrue:[ |
436 |
canvasView destroy. |
|
437 |
]. |
|
1759 | 438 |
canvas := nil |
439 |
]. |
|
3268 | 440 |
|
441 |
"Modified: / 02-11-2007 / 14:54:47 / cg" |
|
1759 | 442 |
! |
443 |
||
444 |
majorKey |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
445 |
^ majorKey |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
446 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
447 |
"Modified: / 06-09-2006 / 15:01:14 / cg" |
1759 | 448 |
! |
449 |
||
450 |
majorKey:aMajorKey |
|
451 |
|key| |
|
452 |
||
453 |
aMajorKey notNil ifTrue:[ |
|
454 |
aMajorKey isBehavior ifTrue:[ |
|
455 |
key := aMajorKey name asSymbol |
|
456 |
] ifFalse:[ |
|
457 |
aMajorKey size ~~ 0 ifTrue:[ |
|
458 |
key := aMajorKey asSymbol |
|
459 |
] |
|
460 |
] |
|
461 |
]. |
|
462 |
||
463 |
self majorKey ~~ key ifTrue:[ |
|
464 |
self destroyCanvas |
|
465 |
]. |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
466 |
majorKey := key. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
467 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
468 |
"Modified: / 06-09-2006 / 15:01:22 / cg" |
1759 | 469 |
! |
470 |
||
471 |
minorKey |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
472 |
^ minorKey |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
473 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
474 |
"Modified: / 06-09-2006 / 15:01:58 / cg" |
1759 | 475 |
! |
476 |
||
477 |
minorKey:aMinorKey |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
478 |
minorKey := aMinorKey. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
479 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
480 |
"Modified: / 06-09-2006 / 15:02:04 / cg" |
1759 | 481 |
! |
1671 | 482 |
|
1759 | 483 |
setupCanvasView:aView |
3888 | 484 |
|frame isV isH auto viewScroller| |
1759 | 485 |
|
486 |
isH := self hasHorizontalScrollBar. |
|
487 |
isV := self hasVerticalScrollBar. |
|
488 |
||
489 |
(isH or:[isV]) ifFalse:[ |
|
490 |
frame := aView |
|
491 |
] ifTrue:[ |
|
492 |
frame := ScrollableView for:ViewScroller. |
|
3888 | 493 |
viewScroller := frame scrolledView. |
1759 | 494 |
|
495 |
frame horizontalScrollable:isH. |
|
496 |
frame verticalScrollable:isV. |
|
497 |
||
3888 | 498 |
isH ifTrue:[ |
499 |
frame horizontalMini:(self miniScrollerHorizontal) |
|
500 |
] ifFalse:[ |
|
501 |
"/ not horizontal scrollable - always set x to scrolled view x |
|
502 |
viewScroller resizeScrolledViewHorizontal:true. |
|
503 |
]. |
|
504 |
isV ifTrue:[ |
|
505 |
frame verticalMini:(self miniScrollerVertical) |
|
506 |
] ifFalse:[ |
|
507 |
"/ not vertical scrollable - always set y to scrolled view y |
|
508 |
viewScroller resizeScrolledViewVertical:true. |
|
509 |
]. |
|
1759 | 510 |
|
511 |
(auto := self autoHideScrollBars) notNil ifTrue:[ |
|
512 |
frame autoHideScrollBars:auto |
|
513 |
]. |
|
3888 | 514 |
viewScroller scrolledView:aView. |
1759 | 515 |
]. |
516 |
frame objectAttributeAt:#isTabItem put:true. |
|
3436 | 517 |
^ frame |
1759 | 518 |
! ! |
519 |
||
5648 | 520 |
!TabItem methodsFor:'accessing-color & font'! |
521 |
||
522 |
foregroundColor |
|
523 |
"get the label color or nil" |
|
524 |
||
525 |
^ foregroundColor |
|
526 |
||
527 |
"Modified: / 06-09-2006 / 15:14:46 / cg" |
|
528 |
! |
|
529 |
||
530 |
foregroundColor:aColor |
|
531 |
"set the label color or nil" |
|
532 |
||
533 |
foregroundColor ~= aColor ifTrue:[ |
|
534 |
foregroundColor := aColor. |
|
535 |
self changed:#foregroundColor |
|
536 |
]. |
|
537 |
||
538 |
"Modified: / 06-09-2006 / 15:00:31 / cg" |
|
539 |
! |
|
540 |
||
541 |
labelForegroundColor |
|
542 |
"get the label color or nil |
|
543 |
" |
|
544 |
^ self foregroundColor |
|
545 |
! |
|
546 |
||
547 |
labelForegroundColor:aColor |
|
548 |
"set the label color or nil |
|
549 |
" |
|
550 |
self foregroundColor:aColor |
|
551 |
! ! |
|
552 |
||
2404 | 553 |
!TabItem methodsFor:'accessing-scrollbars'! |
1759 | 554 |
|
555 |
autoHideScrollBars |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
556 |
^ autoHideScrollBars |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
557 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
558 |
"Modified: / 06-09-2006 / 14:58:38 / cg" |
1759 | 559 |
! |
560 |
||
561 |
autoHideScrollBars:aBoolOrNil |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
562 |
autoHideScrollBars := aBoolOrNil |
1759 | 563 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
564 |
"Modified: / 06-09-2006 / 14:58:45 / cg" |
1759 | 565 |
! |
566 |
||
567 |
hasHorizontalScrollBar |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
568 |
^ hasHorizontalScrollBar ? false |
1759 | 569 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
570 |
"Modified: / 06-09-2006 / 15:00:39 / cg" |
1759 | 571 |
! |
572 |
||
573 |
hasHorizontalScrollBar:aBool |
|
574 |
|flag| |
|
575 |
||
576 |
aBool == true ifTrue:[flag := true] |
|
577 |
ifFalse:[self miniScrollerHorizontal:false]. |
|
578 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
579 |
hasHorizontalScrollBar := flag |
1759 | 580 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
581 |
"Modified: / 06-09-2006 / 15:00:58 / cg" |
1759 | 582 |
! |
583 |
||
584 |
hasVerticalScrollBar |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
585 |
^ hasVerticalScrollBar ? false |
1759 | 586 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
587 |
"Modified: / 06-09-2006 / 15:01:03 / cg" |
1759 | 588 |
! |
589 |
||
590 |
hasVerticalScrollBar:aBool |
|
591 |
|flag| |
|
592 |
||
593 |
aBool == true ifTrue:[flag := true] |
|
594 |
ifFalse:[self miniScrollerVertical:false]. |
|
595 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
596 |
hasVerticalScrollBar := flag |
1759 | 597 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
598 |
"Modified: / 06-09-2006 / 15:01:10 / cg" |
1759 | 599 |
! |
600 |
||
601 |
miniScrollerHorizontal |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
602 |
^ miniScrollerHorizontal ? false |
1759 | 603 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
604 |
"Modified: / 06-09-2006 / 15:01:29 / cg" |
1759 | 605 |
! |
606 |
||
607 |
miniScrollerHorizontal:aBool |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
608 |
miniScrollerHorizontal := aBool |
1759 | 609 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
610 |
"Modified: / 06-09-2006 / 15:01:40 / cg" |
1759 | 611 |
! |
612 |
||
613 |
miniScrollerVertical |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
614 |
^ miniScrollerVertical ? false |
1759 | 615 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
616 |
"Modified: / 06-09-2006 / 15:01:45 / cg" |
1759 | 617 |
! |
618 |
||
619 |
miniScrollerVertical:aBool |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
620 |
miniScrollerVertical := aBool |
1759 | 621 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
622 |
"Modified: / 06-09-2006 / 15:01:55 / cg" |
696 | 623 |
! ! |
624 |
||
625 |
!TabItem methodsFor:'building'! |
|
626 |
||
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
627 |
applicationProvidesLabel |
5153 | 628 |
"returns true if the label is acquired from the application" |
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
629 |
|
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
630 |
^ applicationProvidesLabel ? false |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
631 |
! |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
632 |
|
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
633 |
applicationProvidesLabel:aBool |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
634 |
"set/clear the flag which controls if the label is provided by the application" |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
635 |
|
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
636 |
applicationProvidesLabel := aBool. |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
637 |
! |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
638 |
|
716 | 639 |
editAgument |
640 |
"used by TabItemEditor to get the argument |
|
641 |
" |
|
642 |
^ argument isSymbol ifTrue:['#', argument] ifFalse:[argument] |
|
643 |
! |
|
644 |
||
645 |
editAgument:anArgument |
|
646 |
"used by TabItemEditor to set the argument |
|
647 |
" |
|
2439 | 648 |
|size| |
716 | 649 |
|
650 |
anArgument size ~~ 0 ifTrue:[ |
|
651 |
argument := anArgument withoutSeparators. |
|
652 |
||
653 |
(size := argument size) == 0 ifTrue:[ |
|
654 |
argument := nil |
|
655 |
] ifFalse:[ |
|
656 |
(argument startsWith:$#) ifTrue:[ |
|
657 |
size > 1 ifTrue:[ |
|
658 |
argument := (argument copyFrom:2) asSymbol |
|
659 |
] ifFalse:[ |
|
660 |
argument := nil |
|
661 |
] |
|
662 |
] |
|
663 |
] |
|
664 |
] ifFalse:[ |
|
665 |
argument := nil |
|
666 |
] |
|
667 |
! |
|
668 |
||
696 | 669 |
rawLabel |
670 |
"returns the label to be shown |
|
671 |
" |
|
672 |
^ rawLabel ? ' ' |
|
673 |
||
674 |
||
675 |
! |
|
676 |
||
702 | 677 |
setAttributesFromClass:aClass |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
678 |
"setup attributes from aClass |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
679 |
Ugly: used only with the tabListEditor." |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
680 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
681 |
|spec cls| |
1761 | 682 |
|
683 |
rawLabel := nil. |
|
684 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
685 |
cls := aClass. |
3887 | 686 |
cls isBehavior ifFalse:[ |
3559 | 687 |
self halt:'please pass a class, not its name as argument'. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
688 |
cls := Smalltalk classNamed:aClass |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
689 |
]. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
690 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
691 |
cls notNil ifTrue:[ |
1761 | 692 |
(self translateLabel and:[label isString]) ifTrue:[ |
693 |
rawLabel := cls perform:(label asSymbol) ifNotUnderstood:nil |
|
702 | 694 |
]. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
695 |
(majorKey isNil and:[minorKey notNil]) ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
696 |
"/ Error handle:[:ex| |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
697 |
"/ ] do:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
698 |
"/ spec := cls perform:(minorKey asSymbol) ifNotUnderstood:nil. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
699 |
"/ spec notNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
700 |
canvas := ApplicationSubView new. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
701 |
canvas client:nil spec:minorKey "spec" builder:(UIBuilder new). |
1761 | 702 |
canvas := self setupCanvasView:canvas. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
703 |
"/ ]. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
704 |
"/ ] |
1761 | 705 |
] |
702 | 706 |
]. |
1761 | 707 |
|
708 |
rawLabel isNil ifTrue:[ |
|
709 |
rawLabel := label isNil ifTrue:[''] ifFalse:[label printString] |
|
710 |
]. |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
711 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
712 |
"Modified: / 06-09-2006 / 17:48:37 / cg" |
702 | 713 |
! |
714 |
||
696 | 715 |
setAttributesWithBuilder:aBuilder |
3919 | 716 |
"setup attributes dependent on the builder" |
717 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
718 |
|appl usedBuilder | |
1759 | 719 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
720 |
usedBuilder := self createNewBuilder ifTrue:[UIBuilder new] ifFalse:[aBuilder]. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
721 |
builder := usedBuilder. |
1759 | 722 |
|
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
723 |
(self applicationProvidesLabel) ifTrue:[ |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
724 |
rawLabel := aBuilder labelFor:label. |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
725 |
] ifFalse:[ |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
726 |
(self translateLabel) ifTrue:[ |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
727 |
rawLabel := aBuilder application resources string:label. |
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
728 |
]. |
1759 | 729 |
]. |
730 |
rawLabel isNil ifTrue:[ |
|
731 |
rawLabel := label printString. |
|
696 | 732 |
]. |
1759 | 733 |
|
3919 | 734 |
(aBuilder notNil and:[aBuilder isEditing not]) ifTrue:[ |
735 |
appl := aBuilder application. |
|
736 |
]. |
|
737 |
appl notNil ifTrue:[ |
|
738 |
"/ now lazy - when actually asked for (to allow for more dynamics) |
|
739 |
"/ activeHelpKey notNil ifTrue:[ |
|
740 |
"/ activeHelpText := appl helpTextForKey:activeHelpKey. |
|
741 |
"/ ]. |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
742 |
usedBuilder application isNil ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
743 |
usedBuilder application:appl |
1777
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
744 |
]. |
1c09f7e0a18a
set masterApplication ... in case of an ApplicationModel
tm
parents:
1761
diff
changeset
|
745 |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
746 |
(majorKey isNil and:[minorKey notNil]) ifTrue:[ |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
747 |
canvas := ApplicationSubView new. |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
748 |
canvas client:appl spec:minorKey builder:usedBuilder. |
1759 | 749 |
canvas := self setupCanvasView:canvas. |
750 |
] |
|
1891
ab8801a1c22d
subapps always got a new builder (even if one was already present)
tm
parents:
1777
diff
changeset
|
751 |
]. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
752 |
|
3919 | 753 |
"Modified: / 25-07-2010 / 11:26:23 / cg" |
696 | 754 |
! |
755 |
||
756 |
translateLabel |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
757 |
"returns true if the label derives from the application" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
758 |
|
4649 | 759 |
^ translateLabel ? true |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
760 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
761 |
"Modified: / 06-09-2006 / 15:09:40 / cg" |
696 | 762 |
! |
763 |
||
764 |
translateLabel:aBool |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
765 |
"set/clear the flag which controls if the label is translated to a national language |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
766 |
via the applications resources" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
767 |
|
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
768 |
translateLabel := aBool. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
769 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
770 |
"Modified: / 06-09-2006 / 15:11:16 / cg" |
696 | 771 |
! ! |
772 |
||
773 |
!TabItem methodsFor:'converting'! |
|
774 |
||
3191 | 775 |
skippedInLiteralEncoding |
5879 | 776 |
"define the inst-slots which are skipped when generating a literalArrayEncoding; |
777 |
(to skip the ones with default values.)" |
|
778 |
||
3191 | 779 |
|skipped| |
696 | 780 |
|
3191 | 781 |
skipped := super skippedInLiteralEncoding asOrderedCollection. |
696 | 782 |
|
3191 | 783 |
skipped add:#view. |
784 |
skipped add:#rawLabel. |
|
785 |
skipped add:#canvas. |
|
716 | 786 |
|
3191 | 787 |
self enabled ifTrue:[ skipped add:#enabled ]. |
788 |
self accessCharacterPosition == 0 ifTrue:[ skipped add:#accessCharacterPosition ]. |
|
789 |
self createNewBuilder ifTrue:[ skipped add:#createNewBuilder ]. |
|
790 |
self miniScrollerVertical ifFalse:[ skipped add:#miniScrollerVertical ]. |
|
791 |
self miniScrollerHorizontal ifFalse:[ skipped add:#miniScrollerHorizontal ]. |
|
4649 | 792 |
"/ self translateLabel ifFalse:[ skipped add:#translateLabel ]. |
3416
84641e5a108c
confusion between applicationProvidesLabel and translateLabel fixed.
Claus Gittinger <cg@exept.de>
parents:
3393
diff
changeset
|
793 |
self applicationProvidesLabel ifFalse:[ skipped add:#applicationProvidesLabel ]. |
1759 | 794 |
|
3191 | 795 |
^ skipped |
5879 | 796 |
|
797 |
"Modified (comment): / 09-08-2018 / 17:17:13 / Claus Gittinger" |
|
696 | 798 |
! ! |
799 |
||
1759 | 800 |
!TabItem methodsFor:'displaying'! |
801 |
||
802 |
displayOn:aGC x:x y:y |
|
803 |
|s| |
|
804 |
||
805 |
(s := rawLabel ? label) isNil ifTrue:[ |
|
806 |
^ self |
|
807 |
]. |
|
808 |
s isNumber ifTrue:[ |
|
809 |
s := s printString |
|
810 |
]. |
|
811 |
s displayOn:aGC x:x y:y |
|
812 |
! |
|
813 |
||
814 |
heightOn:aGC |
|
815 |
|s| |
|
816 |
||
817 |
(s := rawLabel ? label) isNil ifTrue:[ |
|
818 |
^ aGC font height |
|
819 |
]. |
|
820 |
^ s heightOn:aGC |
|
821 |
! |
|
822 |
||
823 |
widthOn:aGC |
|
824 |
|s| |
|
825 |
||
826 |
(s := rawLabel ? label) isNil ifTrue:[ |
|
827 |
^ 4 |
|
828 |
]. |
|
829 |
^ s widthOn:aGC |
|
830 |
! ! |
|
831 |
||
832 |
!TabItem methodsFor:'help'! |
|
833 |
||
834 |
activeHelpKey |
|
6060 | 835 |
"the key used to ask the application for the tooltip text (via helpTextFor:)" |
836 |
||
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
837 |
^ activeHelpKey |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
838 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
839 |
"Modified: / 06-09-2006 / 14:58:11 / cg" |
6060 | 840 |
"Modified (comment): / 30-05-2019 / 09:35:40 / Claus Gittinger" |
1759 | 841 |
! |
842 |
||
6062 | 843 |
activeHelpKey:aSymbolicKey |
844 |
"the key used to ask the application for the tooltip text (via helpTextFor:)" |
|
845 |
||
1759 | 846 |
|key| |
847 |
||
6062 | 848 |
aSymbolicKey size > 0 ifTrue:[key := aSymbolicKey asSymbol]. |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
849 |
activeHelpKey := key |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
850 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
851 |
"Modified: / 06-09-2006 / 14:58:32 / cg" |
6062 | 852 |
"Modified (comment): / 30-05-2019 / 09:41:34 / Claus Gittinger" |
1759 | 853 |
! |
854 |
||
855 |
activeHelpText |
|
3393
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
856 |
|appl| |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
857 |
|
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
858 |
activeHelpText notNil ifTrue:[^ activeHelpText]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
859 |
|
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
860 |
activeHelpKey notNil ifTrue:[ |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
861 |
view notNil ifTrue:[ |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
862 |
appl := view application. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
863 |
]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
864 |
appl isNil ifTrue:[ |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
865 |
builder notNil ifTrue:[ |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
866 |
appl := builder application. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
867 |
]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
868 |
]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
869 |
appl notNil ifTrue:[ |
5682 | 870 |
^ appl helpTextForKey:activeHelpKey. |
3393
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
871 |
]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
872 |
]. |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
873 |
|
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
874 |
^ nil |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
875 |
! |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
876 |
|
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
877 |
activeHelpText:aString |
8b665bfc7be0
active help etxt done dynamically (when being sked for)
Claus Gittinger <cg@exept.de>
parents:
3358
diff
changeset
|
878 |
activeHelpText := aString |
1759 | 879 |
! ! |
880 |
||
881 |
!TabItem methodsFor:'queries'! |
|
696 | 882 |
|
2723 | 883 |
isCanvasApplicationModel |
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
884 |
"returns true if the canvas is an application model" |
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
885 |
|
2723 | 886 |
canvas notNil ifTrue:[ |
887 |
^ canvas isKindOf:ApplicationModel. |
|
888 |
]. |
|
889 |
^ false. |
|
3068
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
890 |
|
ae56b8c3c7a6
that code sucked - it still does, but less so.
Claus Gittinger <cg@exept.de>
parents:
2848
diff
changeset
|
891 |
"Modified: / 06-09-2006 / 15:11:50 / cg" |
2723 | 892 |
! |
893 |
||
696 | 894 |
isEnabled |
895 |
^ self enabled |
|
896 |
! ! |
|
897 |
||
898 |
!TabItem class methodsFor:'documentation'! |
|
899 |
||
900 |
version |
|
5153 | 901 |
^ '$Header$' |
3887 | 902 |
! |
903 |
||
904 |
version_CVS |
|
5153 | 905 |
^ '$Header$' |
696 | 906 |
! ! |
4649 | 907 |