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