author | Jan Vrany <jan.vrany@labware.com> |
Wed, 08 Mar 2023 16:40:41 +0000 | |
branch | jv |
changeset 19643 | b3148ab32c03 |
parent 18226 | 346376844040 |
permissions | -rw-r--r-- |
2195 | 1 |
" |
2 |
COPYRIGHT (c) 1997 by eXept Software AG |
|
18226 | 3 |
COPYRIGHT (c) 2016-2017 Jan Vrany |
9961 | 4 |
All Rights Reserved |
2195 | 5 |
|
6 |
This software is furnished under a license and may be used |
|
7 |
only in accordance with the terms of that license and with the |
|
8 |
inclusion of the above copyright notice. This software may not |
|
9 |
be provided or otherwise made available to, or used by, any |
|
10 |
other person. No title to or ownership of the software is |
|
11 |
hereby transferred. |
|
12 |
" |
|
2689
602cbcd0feb3
Fix comment on oldSpace compress limit
Stefan Vogel <sv@exept.de>
parents:
2621
diff
changeset
|
13 |
"{ Package: 'stx:libtool' }" |
602cbcd0feb3
Fix comment on oldSpace compress limit
Stefan Vogel <sv@exept.de>
parents:
2621
diff
changeset
|
14 |
|
15236
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
15 |
"{ NameSpace: Smalltalk }" |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
16 |
|
7455 | 17 |
ToolApplicationModel subclass:#AbstractLauncherApplication |
10907 | 18 |
instanceVariableNames:'transcript' |
19 |
classVariableNames:'NotifyingEmergencyHandler OpenLaunchers RegisteredMenuHandlers |
|
13882 | 20 |
OpenSettingsDialog SettingsList UserSettingsList |
21 |
LastSettingsPageName' |
|
10907 | 22 |
poolDictionaries:'' |
23 |
category:'Interface-Smalltalk' |
|
2001 | 24 |
! |
25 |
||
26 |
Object subclass:#LauncherDialogs |
|
10907 | 27 |
instanceVariableNames:'' |
28 |
classVariableNames:'' |
|
29 |
poolDictionaries:'' |
|
30 |
privateIn:AbstractLauncherApplication |
|
2001 | 31 |
! |
32 |
||
16076 | 33 |
ApplicationModel subclass:#PackageLoadDialog |
34 |
instanceVariableNames:'hierarchicalListView packageIdByItem pathByItem packageDirPath |
|
35 |
packageIcon greyPackageIcon folderIcon greyFolderIcon |
|
36 |
alreadyLoadedString applicationIcon greyApplicationIcon root |
|
37 |
itemsByPath getItemByPath myHierarchicalItemWithLabelAndIcon |
|
38 |
filterHolder masterRoot infoTextHolder loadButton |
|
16330 | 39 |
loadAndBrowseButton selectedPackageHolder monticelloRoot |
16969 | 40 |
backgroundPackageFindProcess itemsMatchingFilter' |
16076 | 41 |
classVariableNames:'PreviousPackageDialogItems PreviousPackageDialogExtent' |
42 |
poolDictionaries:'' |
|
43 |
privateIn:AbstractLauncherApplication |
|
44 |
! |
|
45 |
||
16969 | 46 |
HierarchicalItemWithLabelAndIcon subclass:#MyHierarchicalItem |
47 |
instanceVariableNames:'type info' |
|
48 |
classVariableNames:'' |
|
49 |
poolDictionaries:'' |
|
50 |
privateIn:AbstractLauncherApplication::PackageLoadDialog |
|
51 |
! |
|
52 |
||
2195 | 53 |
!AbstractLauncherApplication class methodsFor:'documentation'! |
54 |
||
55 |
copyright |
|
56 |
" |
|
57 |
COPYRIGHT (c) 1997 by eXept Software AG |
|
18226 | 58 |
COPYRIGHT (c) 2016-2017 Jan Vrany |
9961 | 59 |
All Rights Reserved |
2195 | 60 |
|
61 |
This software is furnished under a license and may be used |
|
62 |
only in accordance with the terms of that license and with the |
|
63 |
inclusion of the above copyright notice. This software may not |
|
64 |
be provided or otherwise made available to, or used by, any |
|
65 |
other person. No title to or ownership of the software is |
|
66 |
hereby transferred. |
|
67 |
" |
|
68 |
||
69 |
! |
|
70 |
||
71 |
documentation |
|
72 |
" |
|
73 |
This is an abstract class, providing mechanisms and common functionality |
|
74 |
for launcher-type applications. Subclasses may implement their GUI either |
|
75 |
with or without the UIPainter framework, and still use the common functions |
|
76 |
provided here. |
|
77 |
||
78 |
[author:] |
|
9961 | 79 |
Claus Gittinger, eXept Software AG |
2195 | 80 |
" |
81 |
||
82 |
||
83 |
! ! |
|
2001 | 84 |
|
85 |
!AbstractLauncherApplication class methodsFor:'accessing'! |
|
86 |
||
2761 | 87 |
closeAllLaunchers |
88 |
"close all opened launchers" |
|
89 |
||
90 |
self openLaunchers copy do:[:eachLauncher | |
|
9961 | 91 |
eachLauncher closeRequest |
2761 | 92 |
]. |
93 |
||
94 |
" |
|
95 |
self closeAllLaunchers. |
|
96 |
NewLauncher open |
|
97 |
" |
|
98 |
! |
|
99 |
||
2001 | 100 |
current |
101 |
"return the launcher running on the current screen. |
|
102 |
(for access via addMenu/ removeMenu)" |
|
103 |
||
104 |
|currentScreen| |
|
105 |
||
106 |
OpenLaunchers size > 0 ifTrue:[ |
|
9961 | 107 |
currentScreen := Screen current. |
108 |
^ OpenLaunchers detect:[:eachLauncher | eachLauncher graphicsDevice == currentScreen] ifNone:nil |
|
2001 | 109 |
]. |
110 |
^ nil. |
|
111 |
||
112 |
" |
|
2761 | 113 |
NewLauncher current |
2001 | 114 |
" |
115 |
||
116 |
"Modified: / 9.9.1996 / 22:41:36 / stefan" |
|
117 |
"Modified: / 13.10.1998 / 16:09:50 / cg" |
|
118 |
! |
|
119 |
||
120 |
openLaunchers |
|
121 |
"return all opened launchers" |
|
122 |
||
3079 | 123 |
OpenLaunchers isNil ifTrue:[ |
9961 | 124 |
OpenLaunchers := IdentitySet new |
3079 | 125 |
]. |
126 |
^ OpenLaunchers |
|
2001 | 127 |
! ! |
128 |
||
129 |
!AbstractLauncherApplication class methodsFor:'defaults'! |
|
130 |
||
131 |
notifyingEmergencyHandler |
|
132 |
"return a block (used as an emergency handler |
|
133 |
for exceptions), which does errorNotification before going |
|
134 |
into the debugger." |
|
135 |
||
136 |
"Remember the handlerBlock, to be able to determine if the current |
|
137 |
handler is the notifying one." |
|
138 |
||
139 |
NotifyingEmergencyHandler isNil ifTrue:[ |
|
9961 | 140 |
NotifyingEmergencyHandler := NoHandlerError notifyingEmergencyHandler |
2001 | 141 |
]. |
142 |
^ NotifyingEmergencyHandler |
|
143 |
||
144 |
"Created: 7.1.1997 / 22:18:19 / cg" |
|
145 |
"Modified: 15.1.1997 / 21:15:38 / cg" |
|
146 |
! ! |
|
147 |
||
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
148 |
!AbstractLauncherApplication class methodsFor:'image specs'! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
149 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
150 |
communicationIcon |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
151 |
"This resource specification was automatically generated |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
152 |
by the ImageEditor of ST/X." |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
153 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
154 |
"Do not manually edit this!! If it is corrupted, |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
155 |
the ImageEditor may not be able to read the specification." |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
156 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
157 |
" |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
158 |
self communicationIcon inspect |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
159 |
ImageEditor openOnClass:self andSelector:#communicationIcon |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
160 |
Icon flushCachedIcons |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
161 |
" |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
162 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
163 |
<resource: #image> |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
164 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
165 |
^Icon |
15763
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
166 |
constantNamed:'AbstractLauncherApplication communicationIcon' |
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
167 |
ifAbsentPut:[(Depth4Image width:22 height:22) bits:(ByteArray fromPackedString:' |
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
168 |
@@W%@@@@@@A^T@@@V2/@@@@@CKJ5@@V?!!>T@@@A[=W9PV?!!<R5@@A[=W1KVR<.S@$@@IC28UJ];?IR- @@7"<%>6NW?2/C&Y%)$/><$3A0/J$A@C$IAL*Y3^ |
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
169 |
;B*QF:''F_,J)G*"R(#G;8W(Y*"$S,)J(G4.CN2&*U@.[$(G5_K1)82U!!@K\86O=[*&93!!DD@)KP7G?>+9T-JPP@@DC\H>$+,@P+%@@@@%@6K(''0@3,@@@@AE |
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
170 |
E9H";@3,@@@@@L5Z$"+,3,@@@@@@19"Z)H3,@@@@@@@L%=)F%<@@@@@@@@B.]H@@@@@@@@@@@@18@@@@@@@b') colorMapFromArray:#[0 0 0 148 148 148 224 224 224 52 52 52 128 128 128 180 180 180 32 32 32 84 84 84 160 160 160 64 64 64 212 212 212 116 116 116 192 192 192 20 20 20 96 96 96 244 244 244] mask:((ImageMask width:22 height:22) bits:(ByteArray fromPackedString:'G@C O G0_0O8?8_<?(W<?8_<???<=:^<???<???<???<_??<O??<O??<B?=\@?<8@?=0@?? @??@@_>@@O @@G@@'); yourself); yourself] |
4386 | 171 |
! |
172 |
||
9805 | 173 |
cross2Icon |
174 |
"This resource specification was automatically generated |
|
175 |
by the ImageEditor of ST/X." |
|
176 |
||
177 |
"Do not manually edit this!! If it is corrupted, |
|
178 |
the ImageEditor may not be able to read the specification." |
|
179 |
||
180 |
" |
|
181 |
self cross2Icon inspect |
|
182 |
ImageEditor openOnClass:self andSelector:#cross2Icon |
|
183 |
Icon flushCachedIcons |
|
184 |
" |
|
185 |
||
186 |
<resource: #image> |
|
187 |
||
188 |
^Icon |
|
15763
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
189 |
constantNamed:'AbstractLauncherApplication cross2Icon' |
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
190 |
ifAbsentPut:[(Depth1Image width:32 height:32) bits:(ByteArray fromPackedString:' |
9806 | 191 |
@@@@@@@F0@@@@H@@@@@@@@@@0@@@@H@@@@@@@@@N<@@@LH0@@D@B@@B@8P@@ HD@@P@@ @D 0HIIIHBB[[X@@@@@[[YA@RRRPPLD @D@@H@@ PD@@H\A@@A@ |
15763
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
192 |
@ @@LP0@@@=0@@@@@@@@@P@@@@L@@@@@@@@@@P@@@@M @@@@@@@b') colorMapFromArray:#[0 0 0 255 255 255] mask:((ImageMask width:32 height:32) bits:(ByteArray fromPackedString:' |
9805 | 193 |
@@_@@@@G0@@@@X@@@@G@@@@A0@@@@X@@@@?0@@@??@@@\X8@@LG#@@FA8X@A XF@@0G@0@M!!0LO[[XCC???????????C@[[[00NF0@LC L@A XF@@X^A @CG |
15763
87b7752ddde1
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15700
diff
changeset
|
194 |
0@@\X8@@C?<@@@O<@@@@X@@@@N@@@@C @@@@X@@@@O @@@C8@@b'); yourself); yourself] |
9805 | 195 |
! |
196 |
||
4893 | 197 |
httpServerIcon |
6346 | 198 |
<resource: #programImage> |
199 |
||
200 |
^ AbstractSettingsApplication::HTTPStartServerSettingsApplication defaultIcon |
|
4893 | 201 |
! |
202 |
||
203 |
systemBrowser24x24Icon |
|
6346 | 204 |
<resource: #programImage> |
205 |
||
4893 | 206 |
^ ToolbarIconLibrary systemBrowser24x24Icon |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
207 |
! ! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
208 |
|
2195 | 209 |
!AbstractLauncherApplication class methodsFor:'queries'! |
210 |
||
15946 | 211 |
isAbstract |
212 |
^ self == AbstractLauncherApplication |
|
2195 | 213 |
! ! |
214 |
||
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
215 |
!AbstractLauncherApplication class methodsFor:'settings application list'! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
216 |
|
9303 | 217 |
addSettingsApplicationByClass:aClass withName:aName icon:anIcon |
218 |
||
219 |
| userSetList addItem| |
|
220 |
||
221 |
userSetList := self userSettingsList. |
|
222 |
addItem := Array with:aName with:aClass with:anIcon. |
|
223 |
||
224 |
"Ignore existing entries found in SettingsList for that name" |
|
225 |
(SettingsList ? #()) do:[:entry | |
|
226 |
entry first = aName ifTrue: [ |
|
227 |
('Settings named "%1" already exists in "%2" with settings app class "%3"' |
|
228 |
bindWith:aName |
|
229 |
with:self name printString |
|
230 |
with:entry second |
|
231 |
) infoPrintCR. |
|
232 |
^ self |
|
233 |
]. |
|
234 |
]. |
|
235 |
||
236 |
"/ remove existing entries in UserSettingsList for that name |
|
237 |
userSetList copy do:[:entry | |
|
4704 | 238 |
entry first = aName ifTrue:[ |
9303 | 239 |
userSetList remove:entry. |
4704 | 240 |
] |
241 |
]. |
|
9303 | 242 |
userSetList add:addItem. |
4436 | 243 |
OpenSettingsDialog notNil ifTrue:[ |
4893 | 244 |
OpenSettingsDialog installSettingsEntry:addItem |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
245 |
]. |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
246 |
! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
247 |
|
9303 | 248 |
allSettingsList |
249 |
^ self settingsList, self userSettingsList |
|
250 |
! |
|
251 |
||
5423
884569242087
defaultSettingsList moved from SettingsDialog to Launcher
Claus Gittinger <cg@exept.de>
parents:
5410
diff
changeset
|
252 |
defaultSettingsApplicationList |
8622 | 253 |
"/ cg: moved it to SettingsDialog - everyone is expecting it there and had to search it... |
254 |
"/ left here for backw. compatibility. |
|
9137
d252e24bd64b
window settings splitted; lower window settings added
Claus Gittinger <cg@exept.de>
parents:
9084
diff
changeset
|
255 |
|
8622 | 256 |
^ SettingsDialog defaultSettingsApplicationList |
5423
884569242087
defaultSettingsList moved from SettingsDialog to Launcher
Claus Gittinger <cg@exept.de>
parents:
5410
diff
changeset
|
257 |
! |
884569242087
defaultSettingsList moved from SettingsDialog to Launcher
Claus Gittinger <cg@exept.de>
parents:
5410
diff
changeset
|
258 |
|
15352
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
259 |
expandSettingsList:rawList |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
260 |
"this expands a raw settings list, |
15355
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
261 |
by looking for entries with a block in their class name. |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
262 |
If any such is present, it is evaluated, returning |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
263 |
a collection of actual entries to use. Then, also % entries in |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
264 |
the name and icon are evaluated by sending corresponding messages |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
265 |
to the collected classes. |
15352
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
266 |
This allows for easy dynamic construction of more complicated |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
267 |
lists, for example to adapt to the set of loaded classes dynamically." |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
268 |
|
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
269 |
"I am not sure. if this is is a good idea; although it makes heavy use of |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
270 |
Smalltalk's dynamic features, it is probably better done differently |
15355
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
271 |
(letting the caller do this). |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
272 |
The code here is harder to debug, and understand" |
15352
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
273 |
|
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
274 |
|cookedList settingsList| |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
275 |
|
9860 | 276 |
cookedList := OrderedCollection new. |
277 |
||
278 |
rawList do:[:eachEntry| |
|
15355
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
279 |
|treeName classNameOrBlock newEntry code classList name nameCode nameBlock nameList iconCode iconBlock| |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
280 |
|
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
281 |
classNameOrBlock := eachEntry at:2 ifAbsent:nil. |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
282 |
classNameOrBlock isBlock ifTrue:[ |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
283 |
classList := classNameOrBlock value select:[:clsOrNil | clsOrNil notNil]. |
9860 | 284 |
name := eachEntry at:1. |
285 |
self assert:(name includesString:'['). |
|
286 |
||
287 |
nameCode := name copyFrom:(name indexOf:$[)+1 to:(name indexOf:$])-1. |
|
288 |
nameCode := '^ [:each | ' , (nameCode copyReplaceString:'%' withString:'each') ,']'. |
|
289 |
nameBlock := Parser evaluate:nameCode. |
|
290 |
||
291 |
nameList := classList collect:nameBlock. |
|
292 |
nameList sortWith:classList. |
|
293 |
nameList with:classList do:[:eachName :eachClass | |
|
294 |
|newEntry| |
|
295 |
||
296 |
newEntry := eachEntry copy. |
|
297 |
newEntry at:1 put:(name copyTo:(name indexOf:$[)-1),eachName. |
|
298 |
newEntry at:2 put:eachClass name. |
|
299 |
cookedList add:newEntry. |
|
300 |
]. |
|
301 |
] ifFalse:[ |
|
15355
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
302 |
(classNameOrBlock isNil "a directory entry" |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
303 |
or:[ (Smalltalk at:classNameOrBlock) notNil "a valid entry"]) ifTrue:[ |
9860 | 304 |
cookedList add:eachEntry. |
14475
724159baf6af
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14459
diff
changeset
|
305 |
] ifFalse:[ |
15355
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
306 |
classNameOrBlock notNil ifTrue:[ |
442c5e018df2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15352
diff
changeset
|
307 |
Transcript showCR:'Launcher: missing settings class: ',classNameOrBlock. |
14475
724159baf6af
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14459
diff
changeset
|
308 |
]. |
9860 | 309 |
]. |
310 |
]. |
|
311 |
]. |
|
312 |
||
313 |
settingsList := |
|
314 |
cookedList collect:[:eachEntry | |
|
315 |
|iconCodeOrSelector iconCode iconBlock newEntry| |
|
316 |
||
317 |
iconCodeOrSelector := eachEntry at:3 ifAbsent:nil. |
|
318 |
iconCodeOrSelector isNil ifTrue:[ |
|
319 |
newEntry := eachEntry |
|
320 |
] ifFalse:[ |
|
321 |
newEntry := eachEntry copy. |
|
16107 | 322 |
(iconCodeOrSelector startsWith:$[) ifTrue:[ |
9860 | 323 |
iconCode := iconCodeOrSelector copyFrom:(iconCodeOrSelector indexOf:$[)+1 to:(iconCodeOrSelector indexOf:$])-1. |
324 |
iconCode := '^ [:each | ' , (iconCode copyReplaceString:'%' withString:'each') ,']'. |
|
325 |
iconBlock := Parser evaluate:iconCode. |
|
326 |
newEntry at:3 put:(iconBlock value:(Smalltalk classNamed:(eachEntry at:2))). |
|
327 |
] ifFalse:[ |
|
328 |
newEntry at:3 put:(self perform:iconCodeOrSelector). |
|
329 |
]. |
|
330 |
]. |
|
331 |
newEntry. |
|
332 |
]. |
|
333 |
||
9188
2ee7d25e44cc
do NOT cache the settings list
Claus Gittinger <cg@exept.de>
parents:
9165
diff
changeset
|
334 |
^ settingsList. |
8761 | 335 |
|
336 |
" |
|
9137
d252e24bd64b
window settings splitted; lower window settings added
Claus Gittinger <cg@exept.de>
parents:
9084
diff
changeset
|
337 |
self withAllSubclassesDo:[:cls | cls initializeSettingsList ] |
8761 | 338 |
" |
15352
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
339 |
! |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
340 |
|
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
341 |
initializeSettingsList |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
342 |
SettingsList := self expandSettingsList:(self defaultSettingsApplicationList). |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
343 |
^ SettingsList. |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
344 |
|
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
345 |
" |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
346 |
self withAllSubclassesDo:[:cls | cls initializeSettingsList ] |
f62436b30ab8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15275
diff
changeset
|
347 |
" |
8761 | 348 |
|
349 |
"Modified: / 16-12-2002 / 18:12:50 / penk" |
|
9875
062f2c80dff0
changed: #initializeSettingsList
Claus Gittinger <cg@exept.de>
parents:
9860
diff
changeset
|
350 |
"Modified: / 20-04-2011 / 17:03:33 / cg" |
8761 | 351 |
! |
352 |
||
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
353 |
removeSettingsApplicationByClass:aClass |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
354 |
|
9303 | 355 |
| userSetList remItem| |
356 |
||
357 |
userSetList := self userSettingsList. |
|
358 |
remItem := userSetList detect:[:item| (item at:2) = aClass] ifNone:[nil]. |
|
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
359 |
remItem notNil ifTrue:[ |
9303 | 360 |
userSetList remove:remItem. |
4436 | 361 |
OpenSettingsDialog notNil ifTrue:[ |
362 |
self removeSettingsEntry:remItem forSettingsApp:OpenSettingsDialog. |
|
4386 | 363 |
]. |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
364 |
]. |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
365 |
! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
366 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
367 |
removeSettingsEntry:entry forSettingsApp:aSettingsApp |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
368 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
369 |
|applName applClass| |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
370 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
371 |
applName := entry at:1. |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
372 |
applClass := entry at:2. |
9303 | 373 |
aSettingsApp remApplClassByName:applName. |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
374 |
! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
375 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
376 |
settingsList |
9303 | 377 |
"/ do NOT cache SettingsList |
378 |
"/ use UserSettingsList to add settings from loaded libraries |
|
9860 | 379 |
|
9188
2ee7d25e44cc
do NOT cache the settings list
Claus Gittinger <cg@exept.de>
parents:
9165
diff
changeset
|
380 |
SettingsList := nil. |
2ee7d25e44cc
do NOT cache the settings list
Claus Gittinger <cg@exept.de>
parents:
9165
diff
changeset
|
381 |
SettingsList isNil ifTrue: [ |
2ee7d25e44cc
do NOT cache the settings list
Claus Gittinger <cg@exept.de>
parents:
9165
diff
changeset
|
382 |
SettingsList := self initializeSettingsList |
2ee7d25e44cc
do NOT cache the settings list
Claus Gittinger <cg@exept.de>
parents:
9165
diff
changeset
|
383 |
]. |
9137
d252e24bd64b
window settings splitted; lower window settings added
Claus Gittinger <cg@exept.de>
parents:
9084
diff
changeset
|
384 |
^ SettingsList |
9860 | 385 |
|
386 |
"Modified: / 19-04-2011 / 12:08:17 / cg" |
|
9303 | 387 |
! |
388 |
||
389 |
userSettingsList |
|
390 |
||
391 |
UserSettingsList isNil ifTrue: [ |
|
392 |
UserSettingsList := OrderedCollection new. |
|
393 |
]. |
|
394 |
^ UserSettingsList |
|
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
395 |
! ! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
396 |
|
14752
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
397 |
!AbstractLauncherApplication class methodsFor:'settings dialog'! |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
398 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
399 |
openSettings |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
400 |
^ self openSettingsFor: nil |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
401 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
402 |
"Created: / 08-10-2014 / 23:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
403 |
! |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
404 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
405 |
openSettingsAndSelect: selectedPageName |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
406 |
^ self openSettingsFor: nil andSelect: selectedPageName |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
407 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
408 |
"Created: / 08-10-2014 / 23:43:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
409 |
! |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
410 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
411 |
openSettingsFor: requestor |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
412 |
^ self openSettingsFor: requestor andSelect: LastSettingsPageName |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
413 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
414 |
"Created: / 08-10-2014 / 23:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
415 |
! |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
416 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
417 |
openSettingsFor: requestor andSelect: selectedPageName |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
418 |
|settingsApp wg proc| |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
419 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
420 |
OpenSettingsDialog notNil ifTrue:[ |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
421 |
(wg := OpenSettingsDialog windowGroup) notNil ifTrue:[ |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
422 |
(proc := wg process) notNil ifTrue:[ |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
423 |
proc isDead ifFalse:[ |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
424 |
OpenSettingsDialog window raiseDeiconified. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
425 |
^ self. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
426 |
] |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
427 |
] |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
428 |
]. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
429 |
OpenSettingsDialog := nil. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
430 |
]. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
431 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
432 |
settingsApp := SettingsDialog new. |
16974 | 433 |
settingsApp resources:(AbstractLauncherApplication resources). |
14752
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
434 |
settingsApp requestor:requestor. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
435 |
settingsApp installSettingsEntries:(self allSettingsList). |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
436 |
"/ settingsApp requestor:self. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
437 |
OpenSettingsDialog := settingsApp. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
438 |
settingsApp allButOpen. |
16990 | 439 |
"/ settingsApp showNonDefaultSettingsMenuItemVisibleHolder value:true. |
14752
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
440 |
settingsApp window label:(self classResources string:'ST/X Settings'). |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
441 |
settingsApp openWindow. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
442 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
443 |
selectedPageName notNil ifTrue:[ |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
444 |
settingsApp selectItemWithName:selectedPageName |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
445 |
]. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
446 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
447 |
"Created: / 08-10-2014 / 23:42:52 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
448 |
! ! |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
449 |
|
16076 | 450 |
!AbstractLauncherApplication class methodsFor:'utilities'! |
451 |
||
452 |
openLoadPackageDialog |
|
453 |
"open a dialog showing wellknown packages (listed in the packages directory) |
|
454 |
and offer to load the selected one(s). |
|
455 |
TODO: make this a little app instead of an ad-hoc dialog, |
|
456 |
add remote packages (central goody repository?)" |
|
457 |
||
458 |
PackageLoadDialog open |
|
459 |
! ! |
|
460 |
||
8381 | 461 |
!AbstractLauncherApplication methodsFor:'drag & drop'! |
462 |
||
463 |
canDropObjects:aCollectionOfDropObjects |
|
464 |
"Any object can be dropped into workspace..." |
|
465 |
||
9303 | 466 |
^ aCollectionOfDropObjects |
9961 | 467 |
contains:[:someObject| (someObject isTextObject or:[ someObject isFileObject ])]. |
8381 | 468 |
! |
469 |
||
470 |
dropFileObject:aFilename |
|
471 |
|suffix| |
|
472 |
||
473 |
suffix := aFilename asFilename suffix. |
|
474 |
suffix = 'st' ifTrue:[ |
|
9961 | 475 |
ChangesBrowser openOn:aFilename. |
476 |
^ self. |
|
8381 | 477 |
]. |
478 |
UserPreferences fileBrowserClass openOn:aFilename. |
|
479 |
||
480 |
! |
|
481 |
||
482 |
dropObjects:aCollectionOfObjects |
|
483 |
"Any object can be dropped: |
|
9961 | 484 |
text: open a workspace |
485 |
file: |
|
486 |
.st - open a cange-browser |
|
487 |
other - open a fileBrowser |
|
8381 | 488 |
" |
489 |
||
490 |
aCollectionOfObjects do:[:dropObject| |
|
9961 | 491 |
|theObject| |
492 |
||
493 |
theObject := dropObject theObject. |
|
494 |
dropObject isTextObject ifTrue:[ |
|
495 |
self dropTextObject:theObject |
|
496 |
] ifFalse:[ |
|
497 |
dropObject isFileObject ifTrue:[ |
|
498 |
self dropFileObject:theObject |
|
499 |
] ifFalse:[ |
|
500 |
]. |
|
501 |
]. |
|
8381 | 502 |
]. |
503 |
! |
|
504 |
||
505 |
dropTextObject:aDropContext |
|
506 |
WorkspaceApplication openWith:aDropContext. |
|
507 |
! ! |
|
508 |
||
11870
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
509 |
!AbstractLauncherApplication methodsFor:'menu actions - tools'! |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
510 |
|
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
511 |
clearAllCoverageInfo |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
512 |
"clear all coverage information" |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
513 |
|
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
514 |
self withWaitCursorDo:[ |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
515 |
InstrumentedMethod cleanAllInfoWithChange:false |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
516 |
]. |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
517 |
Smalltalk changed:#coverageInfo. |
11990 | 518 |
! |
519 |
||
520 |
startSUnitTestRunner2 |
|
521 |
"open the SUnit test runner" |
|
522 |
||
523 |
self openApplication:#Tools::TestRunner2 |
|
11870
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
524 |
! ! |
ab752cb32b9a
added: #clearAllCoverageInfo
Claus Gittinger <cg@exept.de>
parents:
11832
diff
changeset
|
525 |
|
7679 | 526 |
!AbstractLauncherApplication methodsFor:'oldStyle-user actions-settings'! |
527 |
||
528 |
communicationsSettings |
|
529 |
"open a dialog on misc other settings" |
|
530 |
||
531 |
self settingsDialog:[:handler | handler communicationsSettings] |
|
532 |
||
533 |
"Modified: / 31.7.1998 / 22:46:56 / cg" |
|
534 |
! |
|
535 |
||
536 |
compilerSettings |
|
537 |
"open a dialog on compiler related settings" |
|
538 |
||
539 |
self settingsDialog:[:handler | handler compilerSettings] |
|
540 |
! |
|
541 |
||
542 |
displaySettings |
|
543 |
"open a dialog on display related settings" |
|
544 |
||
545 |
self settingsDialog:[:handler | handler displaySettings] |
|
546 |
||
547 |
"Modified: / 31.7.1998 / 22:45:38 / cg" |
|
548 |
! |
|
549 |
||
550 |
editSettings |
|
551 |
"open a dialog on edit settings" |
|
552 |
||
553 |
self settingsDialog:[:handler | handler editSettings] |
|
554 |
||
555 |
"Modified: / 31.7.1998 / 22:46:56 / cg" |
|
556 |
"Created: / 6.1.1999 / 14:14:48 / cg" |
|
557 |
! |
|
558 |
||
559 |
fontSettings |
|
560 |
"open a dialog on font related settings" |
|
561 |
||
562 |
self settingsDialog:[:handler | handler fontSettingsFor:self] |
|
563 |
||
564 |
"Modified: / 31.7.1998 / 22:45:44 / cg" |
|
565 |
! |
|
566 |
||
567 |
javaSettings |
|
568 |
"open a dialog on java-subsystem related settings" |
|
569 |
||
570 |
self settingsDialog:[:handler | handler javaSettings] |
|
571 |
||
572 |
"Modified: / 31.7.1998 / 22:46:13 / cg" |
|
573 |
! |
|
574 |
||
9303 | 575 |
keyboardSetting |
7679 | 576 |
"open a dialog on keyboard related settings" |
577 |
||
578 |
self settingsDialog:[:handler | handler keyboardSettings] |
|
579 |
||
580 |
"Modified: / 31.7.1998 / 22:45:56 / cg" |
|
581 |
! |
|
582 |
||
9303 | 583 |
languageSetting |
7679 | 584 |
"open a dialog on language related settings" |
585 |
||
586 |
self settingsDialog:[:handler | handler languageSettingsFor:self] |
|
587 |
||
588 |
"Modified: / 31.7.1998 / 22:46:13 / cg" |
|
589 |
! |
|
590 |
||
591 |
loadSettings |
|
592 |
"restore settings from a settings-file." |
|
593 |
||
594 |
"a temporary kludge - we need a central systemSettings object for this, |
|
595 |
which can be saved/restored with a single store/read." |
|
596 |
||
597 |
|fileName| |
|
598 |
||
9303 | 599 |
fileName := Dialog |
9961 | 600 |
requestFileName:(resources string:'Load Settings From:') |
601 |
default:'settings.stx' |
|
602 |
ok:(resources string:'Load') |
|
603 |
abort:(resources string:'Cancel') |
|
604 |
pattern:'*.stx' |
|
605 |
fromDirectory:nil. |
|
7679 | 606 |
|
607 |
fileName isEmptyOrNil ifTrue:[ |
|
9961 | 608 |
"/ canceled |
609 |
^ self |
|
7679 | 610 |
]. |
611 |
||
612 |
self withWaitCursorDo:[ |
|
9961 | 613 |
Smalltalk fileIn:fileName. |
614 |
self reOpen |
|
7679 | 615 |
]. |
616 |
! |
|
617 |
||
618 |
memorySettings |
|
619 |
"open a dialog on objectMemory related settings" |
|
620 |
||
621 |
self settingsDialog:[:handler | handler memorySettings] |
|
622 |
||
623 |
"Modified: / 31.7.1998 / 22:46:33 / cg" |
|
624 |
! |
|
625 |
||
626 |
messageSettings |
|
627 |
"open a dialog on infoMessage related settings" |
|
628 |
||
629 |
self settingsDialog:[:handler | handler messageSettings] |
|
630 |
||
631 |
"Modified: / 31.7.1998 / 22:46:45 / cg" |
|
632 |
! |
|
633 |
||
634 |
miscSettings |
|
635 |
"open a dialog on misc other settings" |
|
636 |
||
637 |
self settingsDialog:[:handler | handler miscSettings] |
|
638 |
||
639 |
"Modified: / 31.7.1998 / 22:46:56 / cg" |
|
640 |
! |
|
641 |
||
642 |
printerSettings |
|
643 |
"open a dialog on printer related settings" |
|
644 |
||
645 |
self settingsDialog:[:handler | handler printerSettings] |
|
646 |
||
647 |
"Modified: / 31.7.1998 / 22:47:05 / cg" |
|
648 |
! |
|
649 |
||
650 |
saveSettings |
|
651 |
"save settings to a settings-file." |
|
652 |
||
653 |
self settingsDialog:[:handler | handler saveSettings] |
|
654 |
||
655 |
"Modified: / 31.7.1998 / 22:48:38 / cg" |
|
656 |
! |
|
657 |
||
9303 | 658 |
settingsDialog:symbolOrBlock |
7679 | 659 |
|handler| |
660 |
||
661 |
RegisteredMenuHandlers notNil ifTrue:[ |
|
9961 | 662 |
handler := RegisteredMenuHandlers at:symbolOrBlock ifAbsent:nil. |
7679 | 663 |
]. |
664 |
handler isNil ifTrue:[ |
|
9961 | 665 |
handler := LauncherDialogs |
7679 | 666 |
]. |
667 |
symbolOrBlock isBlock ifTrue:[ |
|
9961 | 668 |
symbolOrBlock value:handler |
7679 | 669 |
] ifFalse:[ |
9961 | 670 |
handler perform:symbolOrBlock with:self. |
7679 | 671 |
] |
672 |
||
673 |
"Modified: / 24-02-2007 / 09:40:48 / cg" |
|
674 |
! |
|
675 |
||
676 |
sourceAndDebuggerSettings |
|
677 |
"open a dialog on misc other settings" |
|
678 |
||
679 |
self settingsDialog:[:handler | handler sourceAndDebuggerSettings] |
|
680 |
||
681 |
"Modified: / 31.7.1998 / 22:47:21 / cg" |
|
682 |
! |
|
683 |
||
684 |
toolSettings |
|
685 |
"open a dialog on tool settings" |
|
686 |
||
687 |
self settingsDialog:[:handler | handler toolSettings] |
|
688 |
||
689 |
"Modified: / 31.7.1998 / 22:46:56 / cg" |
|
690 |
"Created: / 13.10.1998 / 15:50:53 / cg" |
|
691 |
! |
|
692 |
||
9303 | 693 |
viewStyleSetting |
7679 | 694 |
"open a dialog on viewStyle related settings" |
695 |
||
696 |
self settingsDialog:[:handler | handler viewStyleSettingsFor:self] |
|
697 |
||
698 |
"Modified: / 31.7.1998 / 22:47:33 / cg" |
|
699 |
! ! |
|
700 |
||
2001 | 701 |
!AbstractLauncherApplication methodsFor:'private'! |
702 |
||
11487 | 703 |
allTopViewsAndLabelsSortedFilteringWindowGroups: windowGroupFilterOrNil |
704 |
"helper returning all windows on all screens sorted by a label to suite" |
|
705 |
||
706 |
|knownTopViewsAndLabels| |
|
707 |
||
708 |
knownTopViewsAndLabels := OrderedCollection new. |
|
709 |
self allTopViewsFilteringWindowGroups: windowGroupFilterOrNil withLabelsDo: [:v :lbl | |
|
710 |
knownTopViewsAndLabels add:(lbl -> v) |
|
711 |
]. |
|
712 |
knownTopViewsAndLabels sort:[:a :b | a key < b key]. |
|
713 |
^ knownTopViewsAndLabels |
|
714 |
||
715 |
"Created: / 27-04-2012 / 13:04:21 / cg" |
|
716 |
! |
|
717 |
||
718 |
allTopViewsFilteringWindowGroups: windowGroupFilterOrNil withLabelsDo: aBlock |
|
719 |
"helper enumerating all windows on all screens with a label to suite" |
|
720 |
||
721 |
|knownTopViews genLabel| |
|
722 |
||
723 |
||
724 |
genLabel := [:v | |
|
12499
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
725 |
|app appName busyOrNot iconifiedOrNot |
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
726 |
sensor pending process| |
11487 | 727 |
|
728 |
app := v application. |
|
729 |
appName := (app isNil |
|
730 |
ifTrue:[''] |
|
731 |
ifFalse:[app class nameWithoutPrefix,': ']). |
|
11490
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
732 |
busyOrNot := ''. |
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
733 |
(sensor := v windowGroup sensor) notNil ifTrue:[ |
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
734 |
(pending := sensor pendingEvent) notNil ifTrue:[ |
14271
297ed164a7fc
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14238
diff
changeset
|
735 |
(Timestamp now secondDeltaFrom: pending timeStamp) > 1 ifTrue:[ |
11817
76227c9e12bc
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11813
diff
changeset
|
736 |
((process := v windowGroup process) notNil and:[ process isDebugged]) ifTrue:[ |
76227c9e12bc
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11813
diff
changeset
|
737 |
busyOrNot := ' [debug]' |
76227c9e12bc
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11813
diff
changeset
|
738 |
] ifFalse:[ |
76227c9e12bc
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11813
diff
changeset
|
739 |
busyOrNot := ' [busy]' |
76227c9e12bc
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11813
diff
changeset
|
740 |
]. |
16410 | 741 |
busyOrNot := busyOrNot allBold withColor:Color red |
11490
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
742 |
] |
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
743 |
] |
62451ecb3d3b
changed: #allTopViewsFilteringWindowGroups:withLabelsDo:
Claus Gittinger <cg@exept.de>
parents:
11487
diff
changeset
|
744 |
]. |
12499
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
745 |
iconifiedOrNot := ''. |
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
746 |
v topView isCollapsed ifTrue:[ |
16410 | 747 |
iconifiedOrNot := ' (iconified)' withColor:Color blue. |
12499
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
748 |
]. |
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
749 |
appName,'"',(v label ? 'aView'),'"',busyOrNot,iconifiedOrNot |
11487 | 750 |
]. |
751 |
||
752 |
knownTopViews := IdentitySet new. |
|
753 |
Screen allScreens do:[:aScreen | |
|
16749 | 754 |
aScreen allViewsDo:[:aView | |
11487 | 755 |
|top showIt wg| |
756 |
||
757 |
aView notNil ifTrue:[ |
|
758 |
top := aView topView. |
|
759 |
(knownTopViews includes:top) ifFalse:[ |
|
17159 | 760 |
(top isDebugView) ifTrue:[ |
11487 | 761 |
"/ although modal, show it. |
762 |
showIt := top realized |
|
763 |
] ifFalse:[ |
|
764 |
(top isKindOf:TopView) ifTrue:[ |
|
765 |
wg := top windowGroup. |
|
766 |
showIt := (wg notNil and:[wg isModal not]). |
|
767 |
showIt ifTrue:[ |
|
768 |
windowGroupFilterOrNil notNil ifTrue:[ |
|
769 |
showIt := windowGroupFilterOrNil includes:wg |
|
770 |
] |
|
771 |
] |
|
772 |
] ifFalse:[ |
|
773 |
showIt := false |
|
774 |
]. |
|
775 |
]. |
|
776 |
showIt ifTrue:[ |
|
777 |
aBlock value: top value:(genLabel value:top). |
|
778 |
knownTopViews add: top. |
|
779 |
] |
|
780 |
] |
|
781 |
] |
|
782 |
] |
|
783 |
]. |
|
784 |
||
785 |
"Created: / 27-04-2012 / 12:56:53 / cg" |
|
786 |
! |
|
787 |
||
2696
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
788 |
findApplicationClass:classOrClassName nameSpace:aNameSpace |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
789 |
"find some application, given the classes name. |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
790 |
Look for it in Smalltalk and the given nameSpace" |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
791 |
|
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
792 |
|findClass cls classNameSymbol| |
2696
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
793 |
|
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
794 |
classOrClassName isBehavior ifTrue:[ |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
795 |
^ classOrClassName. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
796 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
797 |
findClass := |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
798 |
[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
799 |
(classNameSymbol := classOrClassName asSymbolIfInterned) notNil ifTrue:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
800 |
cls := Smalltalk at:classNameSymbol. |
14121
3c8e880471d9
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14104
diff
changeset
|
801 |
cls isNil ifTrue:[ |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
802 |
"/ look if its in the nameSpace |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
803 |
aNameSpace notNil ifTrue:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
804 |
cls := aNameSpace at:classNameSymbol |
14121
3c8e880471d9
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14104
diff
changeset
|
805 |
]. |
11832
a2fee9d12c5d
changed: #findApplicationClass:nameSpace:
Claus Gittinger <cg@exept.de>
parents:
11817
diff
changeset
|
806 |
]. |
a2fee9d12c5d
changed: #findApplicationClass:nameSpace:
Claus Gittinger <cg@exept.de>
parents:
11817
diff
changeset
|
807 |
]. |
9961 | 808 |
]. |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
809 |
findClass value. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
810 |
cls isNil ifTrue:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
811 |
(Dialog confirm:(resources |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
812 |
stringWithCRs:'Sorry, the ''%1''-class is not available.\\Shall I try to autoload it?' |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
813 |
with:classOrClassName allBold)) ifFalse:[ |
14445
93a87572e630
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14381
diff
changeset
|
814 |
^ AbortOperationRequest raise |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
815 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
816 |
self withWaitCursorDo:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
817 |
#( |
14694
31166504525d
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14683
diff
changeset
|
818 |
'stx:doc/coding' |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
819 |
'stx:clients' |
16096 | 820 |
'stx:goodies/demos' |
14381
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
821 |
'stx:libwidg3' |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
822 |
) do:[:pkg | |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
823 |
Processor activeProcess withPriority:(Processor userSchedulingPriority) do:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
824 |
Smalltalk recursiveInstallAutoloadedClassesFrom:(Smalltalk projectDirectoryForPackage:pkg). |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
825 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
826 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
827 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
828 |
findClass value. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
829 |
cls isNil ifTrue:[ |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
830 |
Dialog warn:(resources stringWithCRs:'Autoload failed.\\Sorry, please check the "stx:clients/demos" & "stx:goodies/clients" directories and load manually.'). |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
831 |
^ nil |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
832 |
]. |
94832321caa4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14296
diff
changeset
|
833 |
"/ self halt. |
2696
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
834 |
]. |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
835 |
^ cls |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
836 |
! |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
837 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
838 |
findWindow:title |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
839 |
"a helper for find & destroy and find & raise operations; |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
840 |
let user choose a view and return it; return nil on cancel" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
841 |
|
2766 | 842 |
^ self findWindow:title windowGroupFilter:nil |
843 |
||
844 |
! |
|
845 |
||
846 |
findWindow:title windowGroupFilter:windowGroupFilterOrNil |
|
847 |
"a helper for find & destroy and find & raise operations; |
|
848 |
let user choose a view and return it; return nil on cancel" |
|
849 |
||
11487 | 850 |
|knownTopViewsAndLabels nameList box| |
851 |
||
852 |
knownTopViewsAndLabels := OrderedCollection new. |
|
853 |
self allTopViewsFilteringWindowGroups: windowGroupFilterOrNil withLabelsDo: [:v :lbl | |
|
854 |
knownTopViewsAndLabels add:(lbl -> v) |
|
855 |
]. |
|
856 |
knownTopViewsAndLabels sort:[:a :b | a key < b key]. |
|
857 |
||
858 |
nameList := knownTopViewsAndLabels collect:[:lblAndView | |
|
859 |
|v l isDead wg p| |
|
860 |
||
861 |
l := lblAndView key. |
|
862 |
v := lblAndView value. |
|
9961 | 863 |
v device == Display ifFalse:[ |
864 |
l := l , ' [' , (v device displayName ? '?') , ']' |
|
865 |
]. |
|
866 |
((wg := v windowGroup) notNil |
|
867 |
and:[(p := wg process) notNil |
|
868 |
and:[p state ~~ #dead]]) ifTrue:[ |
|
869 |
l |
|
870 |
] ifFalse:[ |
|
871 |
l , ' (dead ?)' |
|
872 |
] |
|
873 |
]. |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
874 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
875 |
box := ListSelectionBox new. |
2766 | 876 |
box selectionChangeCallback:[:selectionIndex | |v| |
11487 | 877 |
v := (knownTopViewsAndLabels at:box selectionIndex) value. |
9961 | 878 |
v raise. box raise |
879 |
]. |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
880 |
box noEnterField. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
881 |
box list:nameList. |
4412 | 882 |
box label:(resources string:'View Selection'). |
6352 | 883 |
box title:(resources stringWithCRs:title). |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
884 |
box action:[:selection | |
9961 | 885 |
|v| |
886 |
||
16747 | 887 |
box selectionIndex isNil ifTrue:[ |
888 |
^ nil. |
|
889 |
]. |
|
890 |
||
11487 | 891 |
v := (knownTopViewsAndLabels at:box selectionIndex) value. |
9961 | 892 |
box destroy. |
893 |
^ v |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
894 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
895 |
box extent:400@300. |
3293
d7b925f89a7b
dont use explicit showAtPointer
Claus Gittinger <cg@exept.de>
parents:
3288
diff
changeset
|
896 |
box open. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
897 |
^ nil |
11354
cdab1a0846a2
changed: #findWindow:windowGroupFilter:
Claus Gittinger <cg@exept.de>
parents:
11270
diff
changeset
|
898 |
|
11487 | 899 |
"Modified: / 27-04-2012 / 12:59:37 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
900 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
901 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
902 |
openApplication: classOrClassName |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
903 |
"open an application, given by the classe name." |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
904 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
905 |
self openApplication:classOrClassName nameSpace:nil |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
906 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
907 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
908 |
openApplication:classOrClassName nameSpace:aNameSpace |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
909 |
"open some application, given the classes name. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
910 |
Look for it in Smalltalk and the given nameSpace" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
911 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
912 |
self openApplication:classOrClassName nameSpace:aNameSpace with:#open |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
913 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
914 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
915 |
openApplication:classOrClassName nameSpace:aNameSpace with:aSelector |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
916 |
"open some application, given the classes name. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
917 |
Look for it in Smalltalk and the given nameSpace" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
918 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
919 |
|cls| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
920 |
|
2696
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
921 |
cls := self findApplicationClass:classOrClassName nameSpace:aNameSpace. |
bc8ab69f2a56
allow browserClass to be set in preferences
Claus Gittinger <cg@exept.de>
parents:
2689
diff
changeset
|
922 |
cls isNil ifTrue:[ |
14296
59c1a4f442e4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14271
diff
changeset
|
923 |
Dialog information:'Could not find class: ' |
59c1a4f442e4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14271
diff
changeset
|
924 |
,(classOrClassName isBehavior |
59c1a4f442e4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14271
diff
changeset
|
925 |
ifTrue:[classOrClassName name] |
59c1a4f442e4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14271
diff
changeset
|
926 |
ifFalse:[classOrClassName]). |
9961 | 927 |
^ self |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
928 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
929 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
930 |
Autoload autoloadFailedSignal handle:[:ex | |
9961 | 931 |
self warn:(resources string:'Sorry, the %1 class seems to be not available (failed to load).' with:cls name) |
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
932 |
] do:[ |
9961 | 933 |
self withWaitCursorDo:[ |
934 |
cls perform:aSelector |
|
935 |
] |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
936 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
937 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
938 |
|
7882 | 939 |
openFileBrowser |
940 |
"open a fileBrowser" |
|
941 |
||
14183
ec5f8f775000
class: AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
14123
diff
changeset
|
942 |
self openApplication:UserPreferences fileBrowserClass nameSpace:nil |
7882 | 943 |
|
944 |
"Created: / 05-11-2007 / 11:16:17 / cg" |
|
945 |
! |
|
946 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
947 |
pickAView |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
948 |
"let user pick a view and return it" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
949 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
950 |
|v| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
951 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
952 |
(Delay forSeconds:1) wait. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
953 |
v := Screen current viewFromUser. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
954 |
v isNil ifTrue:[ |
9961 | 955 |
self warn:'Sorry, this is not a smalltalk view'. |
956 |
^ nil |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
957 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
958 |
^ v |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
959 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
960 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
961 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
962 |
saveScreenImage:anImage defaultName:defaultName |
17223 | 963 |
"ask user for filename, then save an image into a file" |
964 |
||
965 |
Dialog |
|
966 |
imageSaveDialog:(resources string:'Save hardcopy image in:') |
|
967 |
image:anImage |
|
968 |
default:(defaultName , '.png') |
|
969 |
pattern:'*.png;*.tiff;*.bmp;*.gif' |
|
970 |
||
971 |
"/ |fileName| |
|
972 |
"/ |
|
17222 | 973 |
"/ fileName := Dialog |
974 |
"/ requestFileName:(resources string:'Save hardcopy image in:') |
|
975 |
"/ default:(defaultName , '.png') |
|
976 |
"/ ok:(resources string:'Save') |
|
977 |
"/ abort:(resources string:'Cancel') |
|
978 |
"/ pattern:'*.png;*.tiff;*.bmp' |
|
979 |
"/ fromDirectory:nil |
|
980 |
"/ forSave:true |
|
981 |
"/ whenBoxCreatedEvaluate:[:box | |
|
982 |
"/ |editButton paintButton copyButton| |
|
983 |
"/ "/ UserPreferences current useNewFileDialog ifFalse:[ |
|
984 |
"/ editButton := Button label:(resources string:'Edit'). |
|
985 |
"/ editButton |
|
986 |
"/ action:[ |
|
987 |
"/ box hide; destroy. |
|
988 |
"/ ImageEditor openOnImage:anImage. |
|
989 |
"/ ]. |
|
990 |
"/ box addButton:editButton. |
|
991 |
"/ |
|
992 |
"/ paintButton := Button label:(resources string:'OS Editor'). |
|
993 |
"/ paintButton |
|
994 |
"/ action:[ |
|
995 |
"/ |tempStream| |
|
996 |
"/ |
|
997 |
"/ tempStream := FileStream newTemporaryWithSuffix:'png'. |
|
998 |
"/ box hide; destroy. |
|
999 |
"/ PNGReader save:anImage onStream:tempStream. |
|
1000 |
"/ tempStream close. |
|
1001 |
"/ OperatingSystem |
|
1002 |
"/ openApplicationForDocument:tempStream fileName operation:#edit mimeType:'image/png'. |
|
1003 |
"/ ]. |
|
1004 |
"/ box addButton:paintButton. |
|
1005 |
"/ |
|
1006 |
"/ copyButton := Button label:(resources string:'Copy to Clipboard'). |
|
1007 |
"/ copyButton |
|
1008 |
"/ action:[ |
|
1009 |
"/ self window setClipboardObject:anImage. |
|
1010 |
"/ box hide; destroy. |
|
1011 |
"/ ]. |
|
1012 |
"/ box addButton:copyButton. |
|
1013 |
"/ "/ ] |
|
1014 |
"/ ]. |
|
17223 | 1015 |
"/ |
1016 |
"/ fileName notEmptyOrNil ifTrue:[ |
|
1017 |
"/ anImage saveOn:fileName. |
|
1018 |
"/ ImageEditView lastSaveDirectory:fileName asFilename directory pathName. |
|
1019 |
"/ ]. |
|
9609
f1401442b66b
changed: #saveScreenImage:defaultName:
Claus Gittinger <cg@exept.de>
parents:
9528
diff
changeset
|
1020 |
|
f1401442b66b
changed: #saveScreenImage:defaultName:
Claus Gittinger <cg@exept.de>
parents:
9528
diff
changeset
|
1021 |
"Created: / 29-01-1998 / 23:20:36 / cg" |
9748
a5701b91134a
changed: #saveScreenImage:defaultName:
Claus Gittinger <cg@exept.de>
parents:
9665
diff
changeset
|
1022 |
"Modified: / 08-02-2011 / 21:51:11 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1023 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1024 |
|
2001 | 1025 |
showDocumentation:aRelativeDocFilePath |
1026 |
"open an HTML browser on some document" |
|
1027 |
||
1028 |
" |
|
1029 |
although that one is not yet finished, |
|
1030 |
its better than nothing ... |
|
1031 |
" |
|
1032 |
HTMLDocumentView notNil ifTrue:[ |
|
9961 | 1033 |
self withWaitCursorDo:[ |
1034 |
" |
|
1035 |
temporary kludge; |
|
1036 |
not all machines can autoload binaries; |
|
1037 |
however, on my SGI (which can) we want it |
|
1038 |
to load automatically. |
|
1039 |
" |
|
1040 |
HTMLDocumentView isLoaded ifFalse:[ |
|
1041 |
Error catch:[HTMLDocumentView autoload] |
|
1042 |
]. |
|
1043 |
HTMLDocumentView isLoaded ifTrue:[ |
|
1044 |
HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath. |
|
1045 |
^ self |
|
1046 |
]. |
|
1047 |
] |
|
2001 | 1048 |
]. |
1049 |
||
1050 |
self warn:'Sorry, the ST/X HTML reader is not |
|
1051 |
included in this release. |
|
1052 |
||
7782 | 1053 |
Please use firefox, konqueror, internet explorer or any |
2001 | 1054 |
other HTML viewer to see the documentation. |
1055 |
||
1056 |
The documentation is found in the ''doc/online'' directory.'. |
|
1057 |
||
1058 |
"Modified: / 25.2.1998 / 21:24:20 / cg" |
|
1059 |
! ! |
|
1060 |
||
4859 | 1061 |
!AbstractLauncherApplication methodsFor:'private-settings callBacks'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1062 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1063 |
changeViewStyleTo:newStyle |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1064 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1065 |
newStyle notNil ifTrue:[ |
9961 | 1066 |
self withWaitCursorDo:[ |
1067 |
(transcript ? Transcript) showCR:'change style to ' , newStyle , ' ...'. |
|
1068 |
View defaultStyle:newStyle asSymbol. |
|
1069 |
]. |
|
1070 |
self reopenLauncher. |
|
1071 |
DebugView newDebugger. |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1072 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1073 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1074 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1075 |
fontBoxForEncoding:encodingMatch |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1076 |
"open a fontBox, showing fonts which match some encoding |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1077 |
(used when changing to japanese ...)" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1078 |
|
4062
decb623a8c3d
settings dialogs no longer need a requestor (with few exceptions)
ca
parents:
4052
diff
changeset
|
1079 |
^ LauncherDialogs fontBoxForEncoding:encodingMatch |
2047
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1080 |
|
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1081 |
"/ |box y b |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1082 |
"/ labelDef buttonDef listDef menuDef textDef |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1083 |
"/ models labels allOfThem filter| |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1084 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1085 |
"/ encodingMatch notNil ifTrue:[ |
9303 | 1086 |
"/ filter := [:f | f encoding notNil |
2047
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1087 |
"/ and:[encodingMatch match:f encoding]]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1088 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1089 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1090 |
"/ models := OrderedCollection new. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1091 |
"/ labels := OrderedCollection new. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1092 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1093 |
"/ models add:(allOfThem := nil asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1094 |
"/ models add:(labelDef := Label defaultFont asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1095 |
"/ models add:(buttonDef := Button defaultFont asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1096 |
"/ models add:(listDef := SelectionInListView defaultFont asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1097 |
"/ models add:(menuDef := MenuView defaultFont asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1098 |
"/ models add:(textDef := TextView defaultFont asValue). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1099 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1100 |
"/ box := Dialog new. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1101 |
"/ box label:(resources string:'Font settings'). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1102 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1103 |
"/ models |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1104 |
"/ with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text')) |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1105 |
"/ do:[:model :title | |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1106 |
"/ |y2 lbl f i| |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1107 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1108 |
"/ f := model value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1109 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1110 |
"/ (box addTextLabel:title) adjust:#left. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1111 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1112 |
"/ y := box yPosition. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1113 |
"/ b := box addComponent:(Button label:(resources string:'change ...')) tabable:true. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1114 |
"/ b relativeExtent:nil; extent:(b preferredExtent). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1115 |
"/ y2 := box yPosition. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1116 |
"/ box yPosition:y. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1117 |
"/ i := box leftIndent. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1118 |
"/ box leftIndent:(b widthIncludingBorder + View viewSpacing). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1119 |
"/ (lbl := box addTextLabel:'') |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1120 |
"/ adjust:#left; |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1121 |
"/ font:(model value); |
9303 | 1122 |
"/ labelChannel:(BlockValue |
2047
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1123 |
"/ with:[:v | |f| |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1124 |
"/ f := v value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1125 |
"/ f isNil ifTrue:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1126 |
"/ '' |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1127 |
"/ ] ifFalse:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1128 |
"/ f userFriendlyName |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1129 |
"/ ] |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1130 |
"/ ] |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1131 |
"/ argument:model). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1132 |
"/ labels add:lbl. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1133 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1134 |
"/ box leftIndent:i. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1135 |
"/ box yPosition:(box yPosition max:y2). |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1136 |
"/ box addVerticalSpace. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1137 |
"/ box addHorizontalLine. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1138 |
"/ box addVerticalSpace. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1139 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1140 |
"/ b action:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1141 |
"/ |f| |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1142 |
"/ |
9303 | 1143 |
"/ f := FontPanel |
1144 |
"/ fontFromUserInitial:(model value) |
|
2047
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1145 |
"/ title:(resources string:'font for %1' with:title) |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1146 |
"/ filter:filter. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1147 |
"/ f notNil ifTrue:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1148 |
"/ model == allOfThem ifTrue:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1149 |
"/ models do:[:m | m value:f]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1150 |
"/ labels do:[:l | l font:f] |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1151 |
"/ ] ifFalse:[ |
9303 | 1152 |
"/ model value:f. |
2047
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1153 |
"/ lbl font:f. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1154 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1155 |
"/ ] |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1156 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1157 |
"/ model == allOfThem ifTrue:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1158 |
"/ box addVerticalSpace |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1159 |
"/ ] |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1160 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1161 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1162 |
"/ box addAbortButton; addOkButton. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1163 |
"/ (box addButton:(Button label:(resources string:'defaults')) before:nil) |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1164 |
"/ action:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1165 |
"/ "/ fetch defaults |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1166 |
"/ View readStyleSheetAndUpdateAllStyleCaches. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1167 |
"/ labelDef value: Label defaultFont. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1168 |
"/ buttonDef value: Button defaultFont. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1169 |
"/ listDef value: SelectionInListView defaultFont. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1170 |
"/ menuDef value: MenuView defaultFont. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1171 |
"/ textDef value: TextView defaultFont. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1172 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1173 |
"/ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1174 |
"/ box open. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1175 |
"/ box accepted ifTrue:[ |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1176 |
"/ Label defaultFont:labelDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1177 |
"/ Button defaultFont:buttonDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1178 |
"/ Toggle defaultFont:buttonDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1179 |
"/ SelectionInListView defaultFont:listDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1180 |
"/ MenuView defaultFont:menuDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1181 |
"/ PullDownMenu defaultFont:menuDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1182 |
"/ TextView defaultFont:textDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1183 |
"/ EditTextView defaultFont:textDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1184 |
"/ CodeView defaultFont:textDef value. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1185 |
"/ ]. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1186 |
"/ box destroy. |
bb2070a26bd2
care for styleSheets right-to-left button order.
Claus Gittinger <cg@exept.de>
parents:
2045
diff
changeset
|
1187 |
"/ ^ box accepted |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1188 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1189 |
"Modified: / 15.9.1998 / 22:04:56 / cg" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1190 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1191 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1192 |
reopenLauncher |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1193 |
"reopen a new launcher. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1194 |
for now (since style & language settings currently do |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1195 |
not affect living views ...) |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1196 |
WARNING: bad design: Message known in LauncherDialogs" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1197 |
|
2034
b3537f805381
force reopen at same position (fvwm & mwm)
Claus Gittinger <cg@exept.de>
parents:
2021
diff
changeset
|
1198 |
|oldOrigin contents builder newLauncher| |
b3537f805381
force reopen at same position (fvwm & mwm)
Claus Gittinger <cg@exept.de>
parents:
2021
diff
changeset
|
1199 |
|
b3537f805381
force reopen at same position (fvwm & mwm)
Claus Gittinger <cg@exept.de>
parents:
2021
diff
changeset
|
1200 |
oldOrigin := self window origin. |
2458
3c273283bb84
care for transcript being nil.
Claus Gittinger <cg@exept.de>
parents:
2457
diff
changeset
|
1201 |
transcript notNil ifTrue:[contents := transcript endEntry; list]. |
2034
b3537f805381
force reopen at same position (fvwm & mwm)
Claus Gittinger <cg@exept.de>
parents:
2021
diff
changeset
|
1202 |
builder := self class openAt:oldOrigin. |
3787 | 1203 |
builder window waitUntilVisible; origin:oldOrigin. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1204 |
newLauncher := builder application. |
2458
3c273283bb84
care for transcript being nil.
Claus Gittinger <cg@exept.de>
parents:
2457
diff
changeset
|
1205 |
transcript notNil ifTrue:[ |
9961 | 1206 |
newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor. |
2458
3c273283bb84
care for transcript being nil.
Claus Gittinger <cg@exept.de>
parents:
2457
diff
changeset
|
1207 |
]. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1208 |
^ newLauncher |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1209 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1210 |
"Modified: / 4.8.1998 / 17:08:33 / cg" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1211 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1212 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1213 |
!AbstractLauncherApplication methodsFor:'queries'! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1214 |
|
3410 | 1215 |
bugReporterAvailable |
1216 |
^ BugGUI notNil |
|
8643 | 1217 |
or:[ Expecco::ExpeccoNetAPI notNil ] |
3410 | 1218 |
! |
1219 |
||
3120
564ee1530a8e
startPDALauncher item invisible for the normal user
Claus Gittinger <cg@exept.de>
parents:
3100
diff
changeset
|
1220 |
hasPDALauncher |
564ee1530a8e
startPDALauncher item invisible for the normal user
Claus Gittinger <cg@exept.de>
parents:
3100
diff
changeset
|
1221 |
^ PDALauncher notNil |
564ee1530a8e
startPDALauncher item invisible for the normal user
Claus Gittinger <cg@exept.de>
parents:
3100
diff
changeset
|
1222 |
! |
564ee1530a8e
startPDALauncher item invisible for the normal user
Claus Gittinger <cg@exept.de>
parents:
3100
diff
changeset
|
1223 |
|
10907 | 1224 |
monticelloRepositoryAvailable |
11468 | 1225 |
^ true "MCRepositoryBrowser notNil" "/ - will install, if required. |
10907 | 1226 |
|
1227 |
"Created: / 25-11-2011 / 17:54:37 / cg" |
|
1228 |
! |
|
1229 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1230 |
processName |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1231 |
"for monitors only - my name" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1232 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1233 |
^ 'ST/X Launcher' |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1234 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1235 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1236 |
|
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1237 |
remoteImageBrowserAvailable |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1238 |
^ SmalltalkShareClient notNil and:[RemoteImage notNil] |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1239 |
! |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1240 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1241 |
transcript |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1242 |
"my transcript" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1243 |
|
3079 | 1244 |
transcript isNil ifTrue:[ |
9961 | 1245 |
^ Transcript current |
9303 | 1246 |
]. |
1247 |
^ transcript |
|
9330
378159dded04
refactored for better reusability (menu configuration)
Claus Gittinger <cg@exept.de>
parents:
9303
diff
changeset
|
1248 |
! |
378159dded04
refactored for better reusability (menu configuration)
Claus Gittinger <cg@exept.de>
parents:
9303
diff
changeset
|
1249 |
|
378159dded04
refactored for better reusability (menu configuration)
Claus Gittinger <cg@exept.de>
parents:
9303
diff
changeset
|
1250 |
windowTreeViewAvailable |
378159dded04
refactored for better reusability (menu configuration)
Claus Gittinger <cg@exept.de>
parents:
9303
diff
changeset
|
1251 |
^ false "/ WindowTreeView notNil |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1252 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1253 |
|
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1254 |
!AbstractLauncherApplication methodsFor:'settings dialog'! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1255 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1256 |
openSettings |
14752
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
1257 |
^ self class openSettingsFor: self. |
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
1258 |
|
08eb9a14633a
class: AbstractLauncherApplication
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
14694
diff
changeset
|
1259 |
"Modified: / 08-10-2014 / 23:40:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1260 |
! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1261 |
|
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1262 |
settingsClosed |
13087
82522521c37e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12928
diff
changeset
|
1263 |
LastSettingsPageName := OpenSettingsDialog selectedItemsName. |
9303 | 1264 |
OpenSettingsDialog := nil. |
4379
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1265 |
! ! |
2e224d2ccf50
move SettingsApplication outside because its not a Launcher spezific tool
penk
parents:
4372
diff
changeset
|
1266 |
|
4863 | 1267 |
!AbstractLauncherApplication methodsFor:'startup & release'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1268 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1269 |
addTopViewsToCurrentProject |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1270 |
"ignored here - the launcher is always global (i.e. not project private)." |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1271 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1272 |
^ self |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1273 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1274 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1275 |
|
2314
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1276 |
closeDownViews |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1277 |
OpenLaunchers remove:self ifAbsent:nil. |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1278 |
super closeDownViews |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1279 |
! |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1280 |
|
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1281 |
postBuildWith:aBuilder |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1282 |
super postBuildWith:aBuilder. |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1283 |
|
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1284 |
OpenLaunchers isNil ifTrue:[ |
9961 | 1285 |
OpenLaunchers := IdentitySet new. |
2314
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1286 |
]. |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1287 |
OpenLaunchers add:self |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1288 |
|
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1289 |
! |
7ac730bdb664
OpenLaunchers as IdentitySet methodes modified add and remove
tm
parents:
2311
diff
changeset
|
1290 |
|
5210 | 1291 |
reOpen |
1292 |
"reopen a new launcher. |
|
1293 |
for now (since style & language settings currently do |
|
1294 |
not affect living views ...)" |
|
1295 |
||
1296 |
self reopenLauncher "/ WARNING: bad design: Message known in LauncherDialogs |
|
1297 |
||
1298 |
"Modified: / 31.7.1998 / 22:48:12 / cg" |
|
1299 |
! |
|
1300 |
||
2040 | 1301 |
requestForWindowClose |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1302 |
"close request from windowing system (window close); |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1303 |
confirm and ask if closing of launcher only or |
16940 | 1304 |
a Smalltalk-exit is wanted" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1305 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1306 |
|answer| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1307 |
|
9303 | 1308 |
answer := Dialog |
9961 | 1309 |
confirmWithCancel:(resources string:'Close %1 only or Exit Smalltalk (Close all) ?' with:self class name) |
1310 |
labels:(resources array:#('Cancel' 'Close' 'Exit')) |
|
1311 |
default:3. |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1312 |
answer isNil ifTrue:[ |
9961 | 1313 |
"/ cancel |
1314 |
^ false |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1315 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1316 |
|
5989
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1317 |
answer ifFalse:[ |
9961 | 1318 |
^ true |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1319 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1320 |
|
16940 | 1321 |
self exit. |
1322 |
"/ not reached |
|
1323 |
^ false |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1324 |
|
2160
028c1d5740e5
exit smalltalk is now the default, when closing the launcher.
Claus Gittinger <cg@exept.de>
parents:
2149
diff
changeset
|
1325 |
"Modified: / 20.5.1999 / 17:24:47 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1326 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1327 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1328 |
saveAndTerminateRequest |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1329 |
"some windowManagers can send this, to shutDown an application |
9303 | 1330 |
but let it save its state before, for later restart. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1331 |
Although I have not yet encountered such a windowManager, |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1332 |
we are already prepared for this ;-)" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1333 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1334 |
self snapshot. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1335 |
super saveAndTerminateRequest |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1336 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1337 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1338 |
|
4862 | 1339 |
!AbstractLauncherApplication methodsFor:'user actions-about'! |
2001 | 1340 |
|
1341 |
openLicenseConditions |
|
1342 |
"open an HTML browser on the 'LICENCE' document" |
|
1343 |
||
1344 |
self withWaitCursorDo:[ |
|
15925 | 1345 |
|rel lang doc doc_De doc_En| |
1346 |
||
1347 |
rel := Smalltalk releaseIdentification. |
|
1348 |
((rel = 'ST/X_free_vsn') or:[rel = 'ST/X_demo_free_vsn']) ifTrue:[ |
|
1349 |
doc_En := 'english/LICENCE_FREE_STX.html'. |
|
1350 |
doc_De := 'german/LICENCE_FREE_STX.html'. |
|
9961 | 1351 |
] ifFalse:[ |
15925 | 1352 |
doc_En := 'english/LICENCE_STX.html'. |
1353 |
doc_De := 'german/LICENCE_STX.html'. |
|
1354 |
]. |
|
1355 |
((lang := UserPreferences current language) = 'de' |
|
1356 |
or:[lang = 'german']) ifTrue:[ |
|
1357 |
doc := doc_De |
|
1358 |
] ifFalse:[ |
|
1359 |
doc := doc_En |
|
9961 | 1360 |
]. |
1361 |
doc := resources at:'LICENCEFILE' default:doc. |
|
1362 |
self showDocumentation:('../' , doc) |
|
2001 | 1363 |
] |
1364 |
||
1365 |
"Created: / 5.2.1998 / 21:43:19 / cg" |
|
1366 |
"Modified: / 23.4.1998 / 11:45:53 / cg" |
|
1367 |
! ! |
|
1368 |
||
4862 | 1369 |
!AbstractLauncherApplication methodsFor:'user actions-classes'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1370 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1371 |
browseAllBreakAndTracePoints |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1372 |
"open a browser showing all breakPointed/traced methods |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1373 |
(but, to get rid of them, there is also a menu itme to remove them all)" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1374 |
|
13146
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1375 |
|filter| |
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1376 |
|
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1377 |
"/ only methods which are still anchored in the class are relevant here |
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1378 |
"/ (i.e. allInstances may return too many) |
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1379 |
filter := [:m | m mclass notNil]. |
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1380 |
|
3140 | 1381 |
UserPreferences systemBrowserClass |
13146
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1382 |
browseMethods:(Set new |
14534
7a7c0fbe16f8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14475
diff
changeset
|
1383 |
addAll:(WrappedMethod allWrappedMethods select:filter); |
7a7c0fbe16f8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14475
diff
changeset
|
1384 |
addAll:(MethodWithBreakpoints allBreakpointedMethods select:filter); |
13146
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1385 |
yourself) |
9961 | 1386 |
title:'All breakPointed/traced methods' |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1387 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1388 |
|
16888 | 1389 |
browseContainingString |
1390 |
"open a browser after asking for a string" |
|
1391 |
||
1392 |
|browserClass| |
|
1393 |
||
1394 |
browserClass := UserPreferences systemBrowserClass. |
|
1395 |
self withWaitCursorDo:[ |
|
1396 |
browserClass new browseMenuMethodsWithString |
|
1397 |
]. |
|
1398 |
! |
|
1399 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1400 |
browseImplementors |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1401 |
"open an implementors- browser after asking for a selector" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1402 |
|
11270 | 1403 |
|browserClass selector dialog| |
1404 |
||
1405 |
browserClass := UserPreferences systemBrowserClass. |
|
1406 |
||
1407 |
Tools::SearchDialog notNil ifTrue:[ |
|
1408 |
"/ use a better dialog |
|
1409 |
dialog := Tools::SearchDialog new |
|
1410 |
setupToAskForMethodSearchTitle:(resources string:'Selector to browse implementors of:\(TAB for completion; matchPattern allowed)') |
|
1411 |
forBrowser:nil |
|
1412 |
searchWhat:#selector searchArea:#everywhere |
|
1413 |
withCaseIgnore:true withMatch:true |
|
1414 |
withMethodList:false |
|
1415 |
allowFind:false allowBuffer:false allowBrowser:true |
|
1416 |
withTextEntry:true. |
|
1417 |
||
1418 |
dialog askThenDo:[ |
|
1419 |
|classes methods isMethod selector ignoreCase match| |
|
1420 |
||
1421 |
(classes := dialog classesToSearch) notEmptyOrNil ifTrue:[ |
|
1422 |
(selector := dialog selectorToSearch) notEmptyOrNil ifTrue:[ |
|
1423 |
browserClass |
|
1424 |
browseImplementorsOf:selector |
|
1425 |
in:classes |
|
1426 |
ignoreCase:(dialog searchIgnoringCase) |
|
1427 |
match:(dialog searchWithMatch) |
|
1428 |
title:(SystemBrowser classResources string:'implementors of: %1' with:selector). |
|
1429 |
]. |
|
1430 |
]. |
|
1431 |
]. |
|
1432 |
^ self. |
|
1433 |
]. |
|
1434 |
||
1435 |
"/ the simple dialog |
|
9303 | 1436 |
selector := Dialog |
9961 | 1437 |
requestSelector:(resources string:'Browse implementors of (Tab for completion):') |
1438 |
okLabel:(resources string:'Browse') |
|
1439 |
initialAnswer:''. |
|
3369
ac3ce702451c
senders/implementors: Tab completion
Claus Gittinger <cg@exept.de>
parents:
3362
diff
changeset
|
1440 |
|
11270 | 1441 |
selector notEmptyOrNil ifTrue:[ |
9961 | 1442 |
self withWaitCursorDo:[ |
11270 | 1443 |
browserClass browseImplementorsMatching:selector |
9961 | 1444 |
] |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1445 |
]. |
3442 | 1446 |
|
11270 | 1447 |
"Modified: / 14-02-2012 / 14:17:51 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1448 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1449 |
|
14943
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1450 |
browseReferencesToClass |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1451 |
"open a browser after asking for a class" |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1452 |
|
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1453 |
|browserClass class| |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1454 |
|
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1455 |
browserClass := UserPreferences systemBrowserClass. |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1456 |
|
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1457 |
class := Dialog |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1458 |
requestClassName:(resources string:'Browse References to Class named (Tab for Completion):') |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1459 |
okLabel:(resources string:'Browse') |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1460 |
initialAnswer:''. |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1461 |
class notNil ifTrue:[ |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1462 |
self withWaitCursorDo:[ |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1463 |
browserClass browseReferendsOf:class |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1464 |
] |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1465 |
]. |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1466 |
|
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1467 |
"Modified: / 14-02-2012 / 14:20:56 / cg" |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1468 |
! |
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1469 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1470 |
browseResources |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1471 |
"open a resource- browser after asking for a resource string" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1472 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1473 |
|box resourceHolder valueHolder component rsrc value t anyString| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1474 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1475 |
anyString := resources string:'* any *'. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1476 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1477 |
resourceHolder := ValueHolder newString. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1478 |
valueHolder := '*' asValue. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1479 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1480 |
box := DialogBox new. |
6637 | 1481 |
box label:(resources string:'Resource search:'). |
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1482 |
component := box |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1483 |
addTextLabel:(resources stringWithCRs:'Search for methods which contain a\particular resource specification') |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1484 |
adjust:#left. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1485 |
box addVerticalSpace:10. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1486 |
|
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1487 |
component := box |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1488 |
addTextLabel:(resources stringWithCRs:'Resource symbol (empty for any; no matchPattern allowed):') |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1489 |
adjust:#left. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1490 |
component := box addComboBoxOn:resourceHolder tabable:true. |
3014 | 1491 |
component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' '-' 'obsolete' 'needsFix')). |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1492 |
|
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1493 |
component := box |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1494 |
addTextLabel:(resources stringWithCRs:'Resource value (* for any; matchPattern is allowed):') |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
1495 |
adjust:#left. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1496 |
box addInputFieldOn:valueHolder tabable:true. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1497 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1498 |
box addVerticalSpace:10. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1499 |
box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'. |
2048 | 1500 |
box addAbortAndOkButtons. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1501 |
|
3293
d7b925f89a7b
dont use explicit showAtPointer
Claus Gittinger <cg@exept.de>
parents:
3288
diff
changeset
|
1502 |
box open. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1503 |
box destroy. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1504 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1505 |
box accepted ifTrue:[ |
9961 | 1506 |
rsrc := resourceHolder value. |
1507 |
value := valueHolder value. |
|
1508 |
||
1509 |
(rsrc size == 0 or:[rsrc = '*' or:[rsrc = anyString]]) ifTrue:[ |
|
1510 |
t := 'methods with any resource'. |
|
1511 |
rsrc := nil |
|
1512 |
] ifFalse:[ |
|
1513 |
t := 'methods with #' , rsrc , '-resource'. |
|
1514 |
rsrc := rsrc withoutSeparators asSymbol |
|
1515 |
]. |
|
1516 |
(value size == 0 or:[value = '*']) ifTrue:[ |
|
1517 |
t := t , ' and any value'. |
|
1518 |
value := nil |
|
1519 |
] ifFalse:[ |
|
1520 |
t := t , ' and value ' , value. |
|
1521 |
]. |
|
1522 |
self withWaitCursorDo:[ |
|
1523 |
UserPreferences systemBrowserClass |
|
1524 |
browseForResource:rsrc |
|
1525 |
containing:value |
|
1526 |
in:(Smalltalk allClasses) |
|
1527 |
title:t |
|
1528 |
] |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1529 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1530 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1531 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1532 |
browseSenders |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1533 |
"open a senders- browser after asking for a selector" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1534 |
|
11270 | 1535 |
|browserClass dialog selector| |
1536 |
||
1537 |
browserClass := UserPreferences systemBrowserClass. |
|
1538 |
||
1539 |
Tools::SearchDialog notNil ifTrue:[ |
|
1540 |
"/ use a better dialog |
|
1541 |
dialog := Tools::SearchDialog new |
|
1542 |
setupToAskForMethodSearchTitle:(resources string:'Selector to browse senders of:\(TAB for completion; matchPattern allowed)') |
|
1543 |
forBrowser:nil |
|
1544 |
searchWhat:#selector searchArea:#everywhere |
|
1545 |
withCaseIgnore:true withMatch:true |
|
1546 |
withMethodList:false |
|
1547 |
allowFind:false allowBuffer:false allowBrowser:true |
|
1548 |
withTextEntry:true. |
|
1549 |
||
1550 |
dialog askThenDo:[ |
|
1551 |
|classes methods isMethod selector ignoreCase match| |
|
1552 |
||
1553 |
(classes := dialog classesToSearch) notEmptyOrNil ifTrue:[ |
|
1554 |
(selector := dialog selectorToSearch) notEmptyOrNil ifTrue:[ |
|
1555 |
browserClass |
|
1556 |
browseAllCallsOn:selector |
|
1557 |
in:classes |
|
1558 |
ignoreCase:(dialog searchIgnoringCase) |
|
1559 |
match:(dialog searchWithMatch) |
|
1560 |
title:(SystemBrowser classResources string:'senders of: %1' with:selector). |
|
1561 |
]. |
|
1562 |
]. |
|
1563 |
]. |
|
1564 |
^ self. |
|
1565 |
]. |
|
3369
ac3ce702451c
senders/implementors: Tab completion
Claus Gittinger <cg@exept.de>
parents:
3362
diff
changeset
|
1566 |
|
9303 | 1567 |
selector := Dialog |
9961 | 1568 |
requestSelector:(resources string:'Browse Senders of (Tab for Completion):') |
1569 |
okLabel:(resources string:'Browse') |
|
1570 |
initialAnswer:''. |
|
3369
ac3ce702451c
senders/implementors: Tab completion
Claus Gittinger <cg@exept.de>
parents:
3362
diff
changeset
|
1571 |
selector size > 0 ifTrue:[ |
9961 | 1572 |
self withWaitCursorDo:[ |
14943
bf27145ad88c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14752
diff
changeset
|
1573 |
browserClass browseAllCallsOn:selector |
9961 | 1574 |
] |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1575 |
]. |
3442 | 1576 |
|
11270 | 1577 |
"Modified: / 14-02-2012 / 14:20:56 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1578 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1579 |
|
4199
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1580 |
browseUnboundGlobals |
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1581 |
"open a browser on methods refering to unbound global variables" |
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1582 |
|
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1583 |
self withWaitCursorDo:[ |
9961 | 1584 |
UserPreferences systemBrowserClass |
1585 |
browseReferendsOfUnboundGlobalsWithTitle:(resources string:'References to unbound global variables') |
|
1586 |
warnIfNone:true |
|
4199
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1587 |
] |
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1588 |
! |
f9bc3cbc38f7
added browse refs to unbound globals.
Claus Gittinger <cg@exept.de>
parents:
4155
diff
changeset
|
1589 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1590 |
browseUndeclared |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1591 |
"open a browser on methods refering to undeclared variables" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1592 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1593 |
self withWaitCursorDo:[ |
9961 | 1594 |
UserPreferences systemBrowserClass |
1595 |
browseReferendsOf:(Smalltalk undeclaredPrefix , '*') |
|
1596 |
title:(resources string:'References to undeclared variables') |
|
1597 |
warnIfNone:true |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1598 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1599 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1600 |
|
3778 | 1601 |
clearUndeclaredVariables |
1602 |
"remove all undeclared variables" |
|
1603 |
||
1604 |
Smalltalk clearUndeclaredVariables |
|
1605 |
! |
|
1606 |
||
5597 | 1607 |
newSystemBrowserClass |
1608 |
|newSystemBrowserClass| |
|
1609 |
||
1610 |
newSystemBrowserClass := Tools::NewSystemBrowser ? NewSystemBrowser. |
|
1611 |
newSystemBrowserClass isNil ifTrue:[ |
|
9961 | 1612 |
self warn:'This needs the NewSystemBrowser to be loaded.'. |
1613 |
AbortOperationRequest raise. |
|
5597 | 1614 |
]. |
1615 |
^ newSystemBrowserClass |
|
1616 |
! |
|
1617 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1618 |
removeAllBreakAndTracePoints |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1619 |
"remove all break- and trace points" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1620 |
|
9303 | 1621 |
self |
9961 | 1622 |
withCursor:Cursor execute |
13146
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1623 |
do:[ |
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1624 |
MessageTracer cleanup. |
14534
7a7c0fbe16f8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14475
diff
changeset
|
1625 |
MethodWithBreakpoints allBreakpointedMethods do:[:m | m restoreOriginalMethod] |
13146
a71f344ebbb4
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13143
diff
changeset
|
1626 |
] |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1627 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1628 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1629 |
startClassBrowser |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1630 |
"open a classBrowser; asks for class" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1631 |
|
3140 | 1632 |
UserPreferences systemBrowserClass askThenBrowseClass |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1633 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1634 |
|
3100
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1635 |
startClassBrowserOnChangedClasses |
2854
ac97ea47bb08
browse changed classes added
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
1636 |
"open a classBrowser on the changeSet" |
ac97ea47bb08
browse changed classes added
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
1637 |
|
5597 | 1638 |
self newSystemBrowserClass openOnClassesInChangeSet |
2854
ac97ea47bb08
browse changed classes added
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
1639 |
! |
ac97ea47bb08
browse changed classes added
Claus Gittinger <cg@exept.de>
parents:
2845
diff
changeset
|
1640 |
|
3100
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1641 |
startClassBrowserOnChangedMethods |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1642 |
"open a classBrowser on the changeSet" |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1643 |
|
5597 | 1644 |
self newSystemBrowserClass openOnMethodsInChangeSet |
3100
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1645 |
! |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1646 |
|
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1647 |
startClassBrowserOnChanges |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1648 |
"open a classBrowser on the changeSet" |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1649 |
|
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1650 |
^ self startClassBrowserOnChangedClasses |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1651 |
! |
8867c882329c
added 'browse changed methods' function.
Claus Gittinger <cg@exept.de>
parents:
3079
diff
changeset
|
1652 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1653 |
startClassHierarchyBrowser |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1654 |
"open a classHierarchyBrowser; asks for class" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1655 |
|
3140 | 1656 |
UserPreferences systemBrowserClass askThenBrowseClassHierarchy |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1657 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1658 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1659 |
startFullClassBrowser |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1660 |
"open a fullClass systemBrowser; asks for class" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1661 |
|
3140 | 1662 |
UserPreferences systemBrowserClass askThenBrowseFullClassProtocol |
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1663 |
! |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1664 |
|
10907 | 1665 |
startMonticelloRepositoryBrowser |
1666 |
"open a monticello repository browser. Unfinished & experimental." |
|
1667 |
||
11468 | 1668 |
MCRepositoryBrowser isNil ifTrue:[ |
1669 |
Smalltalk loadPackage:'stx:goodies/monticello' |
|
1670 |
]. |
|
1671 |
||
10907 | 1672 |
MCRepositoryBrowser open. |
1673 |
||
1674 |
"Created: / 25-11-2011 / 17:55:18 / cg" |
|
1675 |
! |
|
1676 |
||
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1677 |
startRemoteImageBrowser |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1678 |
"open a remoteImage browser; asks for hostname. |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1679 |
The remote host must have an st/x running with remote browsing enabled. |
4491 | 1680 |
Sorry, for now, only the old browser supports remote browsing." |
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1681 |
|
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1682 |
|hostName| |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1683 |
|
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1684 |
hostName := Dialog request:'Remote Host:'. |
8428 | 1685 |
hostName isEmptyOrNil ifTrue:[^ self]. |
1686 |
||
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1687 |
SystemBrowser openOnRemoteImageOnHost:hostName port:nil. |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1688 |
! |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1689 |
|
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1690 |
startSnapshotImageBrowser |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1691 |
"open a snapshotImage browser; asks for filename. |
4491 | 1692 |
Sorry, for now, only the old browser supports remote browsing." |
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1693 |
|
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1694 |
|imageFileName| |
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1695 |
|
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1696 |
imageFileName := Dialog requestFileName:'Name of Snapshot Image File:' default:'st.img' pattern:'*.img;*.sav'. |
8428 | 1697 |
imageFileName isEmptyOrNil ifTrue: [^ self ]. |
1698 |
||
3575
c35b9ba0092c
snapshotImage and remoteImage browser
Claus Gittinger <cg@exept.de>
parents:
3572
diff
changeset
|
1699 |
SystemBrowser openOnSnapShotImage:imageFileName |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1700 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1701 |
|
4862 | 1702 |
!AbstractLauncherApplication methodsFor:'user actions-demos'! |
2038 | 1703 |
|
3035 | 1704 |
startPDALauncher |
1705 |
self startRemoteLauncherWithSetup:[:newDisplay | newDisplay bePDA]. |
|
1706 |
! |
|
1707 |
||
2038 | 1708 |
startRemoteLauncher |
3035 | 1709 |
self startRemoteLauncherWithSetup:[:newDisplay | ]. |
1710 |
! |
|
1711 |
||
1712 |
startRemoteLauncherWithSetup:aSetupBlock |
|
2754 | 1713 |
|host remoteDisplay remoteDisplayClass| |
2038 | 1714 |
|
9303 | 1715 |
host := Dialog |
9961 | 1716 |
request:(resources string:'Remote Launcher on which display:') |
1717 |
initialAnswer:'{hostName}:0' |
|
1718 |
initialSelection:(1 to:10). |
|
2038 | 1719 |
host size > 0 ifTrue:[ |
9961 | 1720 |
(host includes:$:) ifFalse:[ |
1721 |
host := (host , ':0') |
|
1722 |
]. |
|
1723 |
||
1724 |
remoteDisplayClass := XWorkstation. |
|
2754 | 1725 |
|
2755
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1726 |
"/ "/ Q: should we allow GL graphics on the remote display |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1727 |
"/ "/ (Problem: the GL library is not threadsafe, when multiple-display connections |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1728 |
"/ "/ are open - leading to mixing output between views ...) |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1729 |
"/ |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1730 |
"/ "/ only simulated GL can be done remote (i.e. not on SGI) |
9303 | 1731 |
"/ (Screen current supportsGLDrawing |
2755
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1732 |
"/ and:[Screen current isTrueGL not]) |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1733 |
"/ ifTrue:[ |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1734 |
"/ remoteDisplayClass := GLXWorkstation. |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1735 |
"/ ]. |
48769b1546d8
use new utility method to start a remote application
Claus Gittinger <cg@exept.de>
parents:
2754
diff
changeset
|
1736 |
|
9961 | 1737 |
[ |
1738 |
remoteDisplay := remoteDisplayClass newDispatchingFor:host. |
|
1739 |
] on:Screen deviceOpenErrorSignal do:[:ex| |
|
1740 |
self warn:'Could not connect to display: ''' , host , '''.'. |
|
1741 |
^ self |
|
1742 |
]. |
|
1743 |
aSetupBlock value:remoteDisplay. |
|
1744 |
Screen currentScreenQuerySignal |
|
1745 |
answer:remoteDisplay |
|
1746 |
do:[ |
|
1747 |
self class open. |
|
1748 |
] |
|
2038 | 1749 |
]. |
1750 |
||
1751 |
"Created: / 10.9.1998 / 11:48:42 / cg" |
|
1752 |
! ! |
|
1753 |
||
4862 | 1754 |
!AbstractLauncherApplication methodsFor:'user actions-file'! |
2001 | 1755 |
|
5989
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1756 |
exit |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1757 |
"saves a snapshot image and exits, after asking for a fileName" |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1758 |
|
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1759 |
|fileName saveAndExit box| |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1760 |
|
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1761 |
box := EnterBox2 title:(resources string:'Save image before exiting?') |
9961 | 1762 |
okText:(resources string:'Exit') |
1763 |
abortText:(resources string:'Cancel') |
|
1764 |
action:[:str | saveAndExit := false]. |
|
5989
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1765 |
box label: (resources string:'Exiting ST/X'). |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1766 |
box initialText: ObjectMemory nameForSnapshot. |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1767 |
box okText2:(resources string:'Save & Exit') action2:[:str|fileName := str. saveAndExit := true]. |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1768 |
box showAtPointer. |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1769 |
|
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1770 |
saveAndExit notNil ifTrue:[ |
9961 | 1771 |
[ |
1772 |
saveAndExit ifTrue:[ |
|
1773 |
self saveImageAs:fileName |
|
1774 |
]. |
|
1775 |
Smalltalk exit. |
|
1776 |
] on:SnapshotError do:[:ex| |
|
1777 |
"do not exit when snapshot writing fails" |
|
1778 |
self warn:ex description. |
|
1779 |
] |
|
16341 | 1780 |
]. |
1781 |
||
1782 |
saveAndExit ~~ true ifTrue:[ |
|
1783 |
"/ not saved - see if settings changed |
|
1784 |
UserPreferences current isModified ifTrue:[ |
|
1785 |
(Dialog confirm:(resources string:'Save changed settings before exiting?')) ifTrue:[ |
|
1786 |
SettingsDialog saveSettingsAsDefaultSettings |
|
1787 |
] |
|
1788 |
] |
|
1789 |
]. |
|
1790 |
||
5989
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1791 |
|
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1792 |
"Modified: / 23.4.1998 / 18:37:46 / cg" |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1793 |
! |
76628a691cdc
Do not move messages to superclass (where they are sent)
Stefan Vogel <sv@exept.de>
parents:
5944
diff
changeset
|
1794 |
|
16076 | 1795 |
fileLoadPackage |
1796 |
"open a dialog showing wellknown packages (listed in the packages directory) |
|
1797 |
and offer to load the selected one(s). |
|
1798 |
TODO: make this a little app instead of an ad-hoc dialog, |
|
1799 |
add remote packages (central goody repository?), |
|
1800 |
add a description text view, showing more info about the package (from where?)" |
|
1801 |
||
1802 |
self class openLoadPackageDialog. |
|
1803 |
! |
|
1804 |
||
2001 | 1805 |
saveImageAs: aFileName |
6233
b2a1e0b092f0
Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents:
6175
diff
changeset
|
1806 |
"save image in aFilename. |
b2a1e0b092f0
Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents:
6175
diff
changeset
|
1807 |
Sender has to handle SnapshotError" |
2001 | 1808 |
|
1809 |
aFileName notNil ifTrue:[ |
|
11684 | 1810 |
self withWriteCursorDo:[ |
9961 | 1811 |
ObjectMemory snapShotOn:aFileName |
1812 |
]. |
|
2001 | 1813 |
]. |
11684 | 1814 |
|
1815 |
"Modified: / 27-07-2012 / 09:46:19 / cg" |
|
2001 | 1816 |
! ! |
1817 |
||
4862 | 1818 |
!AbstractLauncherApplication methodsFor:'user actions-help'! |
2001 | 1819 |
|
1820 |
showBookPrintDocument |
|
1821 |
"open an HTML browser on the 'book'-printing document" |
|
1822 |
||
1823 |
self showDocumentation:'BOOK.html' |
|
1824 |
! |
|
1825 |
||
8314 | 1826 |
showCredits |
13950
05f423b4291a
Fix in AbstractLauncherApplication>>#showCredits
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
13918
diff
changeset
|
1827 |
self showDocumentation:'credits.html' |
05f423b4291a
Fix in AbstractLauncherApplication>>#showCredits
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
13918
diff
changeset
|
1828 |
|
05f423b4291a
Fix in AbstractLauncherApplication>>#showCredits
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
13918
diff
changeset
|
1829 |
"Modified: / 17-02-2014 / 21:20:59 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
8314 | 1830 |
! |
1831 |
||
6175 | 1832 |
showPortInfo |
1833 |
|portNr url| |
|
1834 |
||
1835 |
portNr := Dialog request:'Port Number:'. |
|
1836 |
portNr isEmptyOrNil ifTrue:[^ self]. |
|
1837 |
||
1838 |
url := 'http://www.grc.com/port_' , portNr printString , '.htm'. |
|
1839 |
self withWaitCursorDo:[ |
|
9961 | 1840 |
HTMLDocumentView openFullOnURL:url. |
6175 | 1841 |
] |
1842 |
! |
|
1843 |
||
4448 | 1844 |
showRFC |
1845 |
|rfc url| |
|
1846 |
||
8401 | 1847 |
rfc := Dialog request:'RFC Number ("index" for list):'. |
4448 | 1848 |
rfc isEmptyOrNil ifTrue:[^ self]. |
1849 |
||
8401 | 1850 |
rfc = 'index' ifTrue:[ |
9961 | 1851 |
url := 'http://www.faqs.org/rfcs/'. |
8401 | 1852 |
] ifFalse:[ |
9961 | 1853 |
url := 'http://www.faqs.org/rfcs/rfc' , rfc printString , '.html'. |
8401 | 1854 |
]. |
4448 | 1855 |
self withWaitCursorDo:[ |
9961 | 1856 |
HTMLDocumentView openFullOnURL:url. |
4448 | 1857 |
] |
1858 |
! |
|
1859 |
||
8117 | 1860 |
showTipOfTheDay |
1861 |
"open a tip-of-the-day window" |
|
1862 |
||
1863 |
DidYouKnowTipViewer open |
|
1864 |
! |
|
1865 |
||
2001 | 1866 |
startClassDocumentation |
1867 |
"open an HTML browser on the 'classDoc/TOP' document" |
|
1868 |
||
1869 |
self showDocumentation:'classDoc/TOP.html' |
|
1870 |
||
1871 |
! |
|
1872 |
||
1873 |
startDocumentationIndex |
|
1874 |
"open an HTML browser on the 'index' document" |
|
1875 |
||
1876 |
self showDocumentation:'index.html' |
|
1877 |
! |
|
1878 |
||
1879 |
startDocumentationTool |
|
1880 |
"open an HTML browser on the 'TOP' document" |
|
1881 |
||
1882 |
self showDocumentation:'TOP.html' |
|
1883 |
||
1884 |
! |
|
1885 |
||
15385
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1886 |
startLauncherDocumentation |
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1887 |
"open an HTML browser on the launcher section in the 'tools/TOP' document" |
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1888 |
|
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1889 |
self showDocumentation:'tools/misc/TOP.html#LAUNCHER' |
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1890 |
! |
8d0380a77aba
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15367
diff
changeset
|
1891 |
|
8625
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1892 |
startProgrammersGuide |
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1893 |
"open an HTML browser on the 'programers guide' document" |
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1894 |
|
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1895 |
self showDocumentation:'programming/TOP.html' |
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1896 |
! |
40edf78ff6aa
changed #startProgrammersGuide
Claus Gittinger <cg@exept.de>
parents:
8622
diff
changeset
|
1897 |
|
8769
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1898 |
startSmalltalkTutorial |
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1899 |
"open an HTML browser on 'doc\books\JoyOfST\IntroToST.html' document" |
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1900 |
|
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1901 |
self showDocumentation:'books/JoyOfST/IntroToST.html' |
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1902 |
! |
1698bfb7f08e
added: #startSmalltalkTutorial
Claus Gittinger <cg@exept.de>
parents:
8761
diff
changeset
|
1903 |
|
8401 | 1904 |
startToolsDocumentation |
1905 |
"open an HTML browser on the 'tools/TOP' document" |
|
1906 |
||
1907 |
self showDocumentation:'tools/TOP.html' |
|
1908 |
! |
|
1909 |
||
5071 | 1910 |
startTutorial |
1911 |
"open an HTML browser on the 'getstart/tutorial.html' document" |
|
1912 |
||
1913 |
self showDocumentation:'getstart/tutorial.html' |
|
1914 |
! |
|
1915 |
||
2001 | 1916 |
startWhatsNewDocumentation |
1917 |
"open an HTML browser on the 'whatsNew.html' document" |
|
1918 |
||
1919 |
self showDocumentation:'whatsNew.html' |
|
1920 |
||
2296 | 1921 |
! |
1922 |
||
1923 |
startWhatsNewSTX |
|
1924 |
"open an HTML browser on the 'relNotes.html' document" |
|
1925 |
||
1926 |
self showDocumentation:'newFeatures.html' |
|
1927 |
||
2001 | 1928 |
! ! |
1929 |
||
4862 | 1930 |
!AbstractLauncherApplication methodsFor:'user actions-system'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1931 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1932 |
compressingGarbageCollect |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1933 |
"perform a compressing garbageCollect" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1934 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1935 |
self withWaitCursorDo:[ObjectMemory verboseGarbageCollect] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1936 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1937 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1938 |
|
7899
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1939 |
flushCachedResources |
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1940 |
"flush all cached resources (e.g. translations)." |
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1941 |
|
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1942 |
Smalltalk changed:#Language. "this flushes everything" |
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1943 |
! |
f33a16fa5301
New menu entry to reload the resource files
Stefan Vogel <sv@exept.de>
parents:
7882
diff
changeset
|
1944 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1945 |
garbageCollect |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1946 |
"perform a non-compressing garbageCollect" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1947 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1948 |
self withWaitCursorDo:[ObjectMemory reclaimSymbols] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1949 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1950 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1951 |
|
7929
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1952 |
objectModuleDialog |
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1953 |
"opens a moduleInfo dialog" |
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1954 |
|
7945 | 1955 |
Tools::ObjectModuleInformation notNil ifTrue:[ |
9961 | 1956 |
self openApplication:#'Tools::ObjectModuleInformation'. |
1957 |
^ self. |
|
7945 | 1958 |
]. |
1959 |
||
7929
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1960 |
^ LauncherDialogs objectModuleDialog |
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1961 |
|
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1962 |
"Modified: / 31.7.1998 / 17:33:24 / cg" |
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1963 |
! |
04fe3c979a94
changed #objectModuleDialog - fix method category
Stefan Vogel <sv@exept.de>
parents:
7899
diff
changeset
|
1964 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1965 |
startStopEventTrace |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1966 |
"start/stop event tracing for a particular view" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1967 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1968 |
|v wg| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1969 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1970 |
v := Screen current viewFromUser. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1971 |
v notNil ifTrue:[ |
9961 | 1972 |
v := v topView. |
1973 |
wg := v windowGroup. |
|
1974 |
wg notNil ifTrue:[ |
|
1975 |
"/ |
|
1976 |
"/ toggle eventTrace in its windowGroup |
|
1977 |
"/ |
|
1978 |
wg traceEvents:(wg traceEvents not) |
|
1979 |
] |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1980 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1981 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1982 |
|
4862 | 1983 |
!AbstractLauncherApplication methodsFor:'user actions-tools'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
1984 |
|
2210 | 1985 |
inspectGlobalVariables |
1986 |
"inspect globals" |
|
1987 |
||
9084 | 1988 |
WorkspaceApplication notNil ifTrue:[ |
9961 | 1989 |
"/ looks nicer... |
1990 |
WorkspaceApplication openWithGlobalsInspector. |
|
1991 |
^ self. |
|
9084 | 1992 |
]. |
2210 | 1993 |
Smalltalk inspect |
1994 |
! |
|
1995 |
||
2207
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
1996 |
inspectWorkspaceVariables |
2210 | 1997 |
"inspect workspace variables" |
2207
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
1998 |
|
9084 | 1999 |
WorkspaceApplication notNil ifTrue:[ |
9961 | 2000 |
"/ looks nicer... |
2001 |
WorkspaceApplication openWithWorkspaceVariableInspector. |
|
2002 |
^ self. |
|
9084 | 2003 |
]. |
2004 |
"/ Workspace workspaceVariables inspect |
|
2207
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2005 |
! |
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2006 |
|
9303 | 2007 |
newProject |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2008 |
"creates a new project & opens a projectView for it" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2009 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2010 |
Project notNil ifTrue: [(ProjectView for: Project new) open] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2011 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2012 |
|
8290 | 2013 |
openEvaluationWorkspace |
2014 |
WorkspaceApplication notNil ifTrue:[ |
|
9961 | 2015 |
^ WorkspaceApplication openEvaluationWorkspace |
8290 | 2016 |
]. |
2017 |
^ self openApplication:Workspace |
|
2018 |
! |
|
2019 |
||
8319 | 2020 |
openMyWorkspace |
2021 |
WorkspaceApplication notNil ifTrue:[ |
|
9961 | 2022 |
^ WorkspaceApplication openMyWorkspace |
8319 | 2023 |
]. |
2024 |
^ self openApplication:Workspace |
|
2025 |
! |
|
2026 |
||
15236
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2027 |
openRegularWorkspace |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2028 |
WorkspaceApplication notNil ifTrue:[ |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2029 |
^ WorkspaceApplication openRegularWorkspace |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2030 |
]. |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2031 |
^ self openApplication:Workspace |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2032 |
! |
92e7ef5d694e
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14943
diff
changeset
|
2033 |
|
8290 | 2034 |
openSystemWorkspace |
2035 |
WorkspaceApplication notNil ifTrue:[ |
|
9961 | 2036 |
^ WorkspaceApplication openSystemWorkspace |
8290 | 2037 |
]. |
2038 |
^ self openApplication:Workspace |
|
2039 |
! |
|
2040 |
||
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2041 |
openTerminal |
5298 | 2042 |
TerminalApplication notNil ifTrue:[ |
9961 | 2043 |
^ TerminalApplication open |
9303 | 2044 |
]. |
2045 |
self openApplication:#VT100TerminalView |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2046 |
! |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2047 |
|
15275
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2048 |
openTextDiffTool |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2049 |
Tools::TextDiff2Tool isNil ifTrue:[ |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2050 |
Dialog warn:'Tools::TextDiff2Tool is missing'. |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2051 |
^ self |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2052 |
]. |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2053 |
^Tools::TextDiff2Tool |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2054 |
openOn:'Paste some text here' label:'text1' |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2055 |
and:'Paste the other text text here' label:'text2' |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2056 |
! |
e77c12208abf
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15236
diff
changeset
|
2057 |
|
3158 | 2058 |
openWorkspace |
2059 |
WorkspaceApplication notNil ifTrue:[ |
|
9961 | 2060 |
^ WorkspaceApplication open |
3158 | 2061 |
]. |
2062 |
^ self openApplication:Workspace |
|
2063 |
! |
|
2064 |
||
2207
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2065 |
removeAllWorkspaceVariables |
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2066 |
"remove workspace variables" |
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2067 |
|
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2068 |
Workspace removeAllWorkspaceVariables |
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2069 |
! |
84d23e553268
support for workspace variables
Claus Gittinger <cg@exept.de>
parents:
2206
diff
changeset
|
2070 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2071 |
selectProject |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2072 |
"asks for and switch to another project" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2073 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2074 |
|list box| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2075 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2076 |
Project notNil ifTrue:[ |
9961 | 2077 |
list := Project allInstances. |
2078 |
box := ListSelectionBox new. |
|
2079 |
box list:(list collect:[:p | p name]). |
|
2080 |
box title:(resources string:'Select a project'). |
|
2081 |
box action:[:selection | |
|
2082 |
|project| |
|
2083 |
||
2084 |
project := list detect:[:p | p name = selection] ifNone:[nil]. |
|
2085 |
project isNil ifTrue:[ |
|
2086 |
transcript notNil ifTrue:[ |
|
2087 |
transcript showCR:'No such project.' |
|
2088 |
] |
|
2089 |
] ifFalse:[ |
|
2090 |
project showViews. |
|
2091 |
Project current:project |
|
2092 |
] |
|
2093 |
]. |
|
2094 |
box open. |
|
2095 |
box destroy |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2096 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2097 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2098 |
|
3408 | 2099 |
startBugMessages |
8643 | 2100 |
"open the bug reporter" |
2101 |
||
2102 |
Expecco::ExpeccoNetAPI notNil ifTrue:[ |
|
9961 | 2103 |
Expecco::ExpeccoNetAPI reportCodeReview. |
2104 |
^ self |
|
8643 | 2105 |
]. |
2106 |
||
2107 |
BugGUI notNil ifTrue:[ |
|
9961 | 2108 |
self openApplication:#BugGUI |
8643 | 2109 |
]. |
3408 | 2110 |
|
2111 |
"Modified: / 17.10.1998 / 14:38:18 / cg" |
|
2112 |
! |
|
2113 |
||
3362 | 2114 |
startChangeSetBrowser |
15699
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
2115 |
"open a change Set Browser on the changes in the system" |
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
2116 |
|
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
2117 |
^ UserPreferences current changeSetBrowserClass open |
15506
af054eb73ccf
Fix in AbstractLauncherApplication>>startChangeSetBrowser: use preferred changeset browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
15495
diff
changeset
|
2118 |
|
af054eb73ccf
Fix in AbstractLauncherApplication>>startChangeSetBrowser: use preferred changeset browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
15495
diff
changeset
|
2119 |
"Created: / 05-11-2001 / 18:04:05 / cg" |
af054eb73ccf
Fix in AbstractLauncherApplication>>startChangeSetBrowser: use preferred changeset browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
15495
diff
changeset
|
2120 |
"Modified: / 05-03-2015 / 06:57:59 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
3362 | 2121 |
! |
2122 |
||
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2123 |
startChangesBrowser |
15700
b938df38917c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15699
diff
changeset
|
2124 |
"open a changebrowser on the change file - either new or old GUI, depending on userPrefs" |
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2125 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2126 |
self openApplication:(UserPreferences current changesBrowserClass) |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2127 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2128 |
"Modified: / 17.10.1998 / 14:38:18 / cg" |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2129 |
! |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2130 |
|
8298 | 2131 |
startInternationalLanguageTranslationEditor |
2132 |
"open the language-string editor (english/german/spanish etc.)" |
|
2133 |
||
2134 |
self openApplication:#'Tools::InternationalLanguageTranslationEditor' |
|
2135 |
! |
|
2136 |
||
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2137 |
startNewChangesBrowser |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2138 |
"opens the new changeBrowser" |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2139 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2140 |
self openApplication:#NewChangesBrowser |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2141 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2142 |
"Created: / 6.6.1998 / 19:47:26 / cg" |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2143 |
! |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2144 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2145 |
startNewLauncher |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2146 |
"opens the new launcher" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2147 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2148 |
NewLauncher isNil ifTrue:[ |
9961 | 2149 |
^ self warn:'The NewLauncher is not available in this release.' |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2150 |
]. |
14075
710990d62d23
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13950
diff
changeset
|
2151 |
Display withoutExitingOnLastCloseDo:[ |
710990d62d23
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13950
diff
changeset
|
2152 |
NewLauncher openAt:(self window origin) |
710990d62d23
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13950
diff
changeset
|
2153 |
]. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2154 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2155 |
|
2111
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2156 |
startOldChangesBrowser |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2157 |
"opens the old changeBrowser" |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2158 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2159 |
self openApplication:#ChangesBrowser |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2160 |
|
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2161 |
"Created: / 6.6.1998 / 19:47:26 / cg" |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2162 |
! |
b36bdfb0af38
moved startChangesBrowser from NewLauncher to here.
Claus Gittinger <cg@exept.de>
parents:
2110
diff
changeset
|
2163 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2164 |
startOldLauncher |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2165 |
"opens the old launcher" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2166 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2167 |
Launcher isNil ifTrue:[ |
9961 | 2168 |
^ self warn:'The (Old)Launcher is not available in this release.' |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2169 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2170 |
Launcher openAt:(self window origin) |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2171 |
|
2883 | 2172 |
! |
2173 |
||
2174 |
startSUnitTestRunner |
|
11990 | 2175 |
"open the configured SUnit test runner" |
2176 |
||
2177 |
self openApplication:(UserPreferences current testRunnerClass) |
|
2178 |
||
2179 |
"Modified: / 17.10.1998 / 14:38:18 / cg" |
|
2180 |
! |
|
2181 |
||
2182 |
startSUnitTestRunner1 |
|
2883 | 2183 |
"open the SUnit test runner" |
2184 |
||
3037 | 2185 |
self openApplication:#TestRunner |
2883 | 2186 |
|
2187 |
"Modified: / 17.10.1998 / 14:38:18 / cg" |
|
5016 | 2188 |
! |
2189 |
||
2190 |
startSmaCCParserGenerator |
|
2191 |
"open the SmaCC-ParserGenerator UI" |
|
2192 |
||
2193 |
self openApplication:#'SmaCC::SmaCCParserGenerator' |
|
2194 |
||
2195 |
"Modified: / 17.10.1998 / 14:38:18 / cg" |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2196 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2197 |
|
4862 | 2198 |
!AbstractLauncherApplication methodsFor:'user actions-windows'! |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2199 |
|
12067
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2200 |
allTopViewsDo:aBlock |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2201 |
|setOfViews currentScreen| |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2202 |
|
13882 | 2203 |
setOfViews := Project current views asIdentitySet. |
12067
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2204 |
setOfViews addAll:(Project defaultProject views). |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2205 |
|
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2206 |
currentScreen := Screen current. |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2207 |
setOfViews do:[:eachTopView | |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2208 |
eachTopView device == currentScreen ifTrue:[ |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2209 |
aBlock value:eachTopView |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2210 |
] |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2211 |
] |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2212 |
! |
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2213 |
|
2765 | 2214 |
askForAnotherDisplay |
2215 |
"ask for some other display" |
|
2216 |
||
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2217 |
|displayName| |
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2218 |
|
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2219 |
displayName := Dialog request:'Display:' initialAnswer:(Screen default displayName). |
6264 | 2220 |
displayName isEmptyOrNil ifTrue:[^ nil]. |
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2221 |
|
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2222 |
^ XWorkstation newDispatchingFor:displayName. |
2765 | 2223 |
! |
2224 |
||
13654
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2225 |
bringAllWindowsOntoScreen |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2226 |
self allTopViewsDo:[:eachTopView | self bringWindowOntoScreen:eachTopView] |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2227 |
|
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2228 |
" |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2229 |
Transcript topView application bringAllWindowsOntoScreen |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2230 |
" |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2231 |
! |
e33fa0be5522
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13637
diff
changeset
|
2232 |
|
16114 | 2233 |
bringWindow:aWindow intoBounds:bounds |
2234 |
"shift & resize a view to be completely inside bounds." |
|
2235 |
||
16446 | 2236 |
|topView oldOrg newOrg oldCorner newCorner delta| |
16114 | 2237 |
|
16446 | 2238 |
topView := aWindow topView. |
2239 |
oldOrg := newOrg := topView origin. |
|
2240 |
oldCorner := newCorner := topView corner. |
|
16114 | 2241 |
|
2242 |
(bounds containsPoint:oldOrg) ifFalse:[ |
|
2243 |
newOrg := bounds origin + (10@10). |
|
2244 |
delta := newOrg - oldOrg. |
|
2245 |
newCorner := oldCorner + delta. |
|
2246 |
]. |
|
2247 |
(bounds containsPoint:newCorner) ifFalse:[ |
|
2248 |
newCorner := bounds corner - (10@10). |
|
2249 |
delta := newCorner - oldCorner. |
|
2250 |
newOrg = oldOrg ifTrue:[ |
|
2251 |
newOrg := newOrg + delta. |
|
2252 |
(bounds containsPoint:newOrg) ifFalse:[ |
|
2253 |
newOrg := bounds origin + (10@10). |
|
2254 |
]. |
|
2255 |
]. |
|
2256 |
]. |
|
16446 | 2257 |
topView |
16114 | 2258 |
raiseDeiconified; |
2259 |
origin:newOrg corner:newCorner. |
|
2260 |
! |
|
2261 |
||
16446 | 2262 |
bringWindowOntoScreen:aWindow |
16114 | 2263 |
"shift & resize a view to be visible. |
2264 |
If there are multiple screens,bring them all onto the screen where the launcher is" |
|
16446 | 2265 |
|
2266 |
|allBounds bounds myDevice| |
|
2267 |
||
2268 |
myDevice := self device. |
|
16983 | 2269 |
allBounds := myDevice monitorBounds. "At:aWindow center" |
16446 | 2270 |
allBounds notEmptyOrNil ifTrue:[ |
2271 |
bounds := allBounds |
|
2272 |
detect:[:bounds | bounds containsPoint:self window center ] |
|
2273 |
ifNone:[ nil ]. |
|
16114 | 2274 |
]. |
2275 |
bounds isNil ifTrue:[ |
|
16446 | 2276 |
bounds := 0@0 extent:myDevice usableExtent. |
2277 |
]. |
|
2278 |
self bringWindow:aWindow intoBounds:bounds |
|
12568 | 2279 |
! |
2280 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2281 |
deIconifyAllWindows |
13696
94a519c56f57
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13654
diff
changeset
|
2282 |
self allTopViewsDo:[:eachTopView | eachTopView expand; raise]. |
94a519c56f57
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13654
diff
changeset
|
2283 |
self window raise. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2284 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2285 |
" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2286 |
Transcript topView application deIconifyAllWindows |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2287 |
" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2288 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2289 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2290 |
findAndDestroyWindow |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2291 |
"find a window (by name) and destroy it" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2292 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2293 |
|v| |
4412 | 2294 |
v := self findWindow:'Select window to close:'. |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2295 |
v notNil ifTrue:[v destroy] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2296 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2297 |
|
2759 | 2298 |
findAndMigrateWindow |
2299 |
"find a window (by name) and migrate it to some other display" |
|
2300 |
||
2766 | 2301 |
|possibleGroups v| |
2302 |
||
2303 |
possibleGroups := WindowGroup allInstances select:[:eachGroup | |
|
9961 | 2304 |
eachGroup graphicsDevice == Screen current |
2305 |
and:[eachGroup isModal not |
|
2306 |
and:[eachGroup topViews size > 0]]]. |
|
6264 | 2307 |
possibleGroups isEmpty ifTrue:[ |
9961 | 2308 |
self information:'No windows found which could be migrated to some other display.'. |
2309 |
^ self |
|
2766 | 2310 |
]. |
2311 |
||
4412 | 2312 |
v := self findWindow:'Select window to migrate:' windowGroupFilter:possibleGroups. |
2759 | 2313 |
v notNil ifTrue:[ |
9961 | 2314 |
self migrateWindow:v topView |
2759 | 2315 |
] |
2316 |
! |
|
2317 |
||
2766 | 2318 |
findAndMigrateWindowBack |
2319 |
"find a window (by name) and migrate it back to this display" |
|
2320 |
||
2321 |
|possibleGroups v| |
|
2322 |
||
2323 |
possibleGroups := WindowGroup allInstances select:[:eachGroup | |
|
9961 | 2324 |
eachGroup graphicsDevice ~~ Screen current |
2325 |
and:[eachGroup isModal not |
|
2326 |
and:[eachGroup topViews size > 0]]]. |
|
6264 | 2327 |
possibleGroups isEmpty ifTrue:[ |
9961 | 2328 |
self information:'No windows are open on any other display.'. |
2329 |
^ self |
|
9303 | 2330 |
]. |
2331 |
||
4412 | 2332 |
v := self findWindow:'Select window to migrate back:' windowGroupFilter:possibleGroups. |
2766 | 2333 |
v notNil ifTrue:[ |
9961 | 2334 |
v windowGroup migrateTo:(Screen current) |
2766 | 2335 |
] |
2336 |
! |
|
2337 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2338 |
findAndRaiseWindow |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2339 |
"find a window (by name) and raise it" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2340 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2341 |
|v| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2342 |
|
4412 | 2343 |
v := self findWindow:'Select window to raise deiconified:'. |
11417 | 2344 |
v notNil ifTrue:[v raiseDeiconified; setForegroundWindow] |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2345 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2346 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2347 |
fullScreenHardcopy |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2348 |
"after a second (to allow redraw of views under menu ...), |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2349 |
save the contents of the whole screen." |
16446 | 2350 |
|
2351 |
|mySensor| |
|
2352 |
||
2353 |
mySensor := self window sensor. |
|
2354 |
mySensor ctrlDown ifTrue:[ |
|
9961 | 2355 |
^ self fullScreenHardcopyUngrabbed |
9303 | 2356 |
]. |
16446 | 2357 |
Processor |
2358 |
addTimedBlock:[ self saveScreenImage:(Image fromScreen) defaultName:'screen' ] |
|
2359 |
afterSeconds:(mySensor shiftDown ifTrue:5 ifFalse:1) |
|
3326 | 2360 |
! |
2361 |
||
2362 |
fullScreenHardcopyUngrabbed |
|
2363 |
"after a second (to allow redraw of views under menu ...), |
|
2364 |
save the contents of the whole screen." |
|
2365 |
||
9303 | 2366 |
Processor |
9961 | 2367 |
addTimedBlock:[ |
2368 |
|display image| |
|
2369 |
||
2370 |
display := Screen current. |
|
2371 |
image := Image |
|
2372 |
fromScreen:(0@0 corner:(display extent)) |
|
2373 |
on:display |
|
2374 |
grab:false. |
|
2375 |
||
2376 |
self |
|
2377 |
saveScreenImage:image |
|
2378 |
defaultName:'screen' |
|
2379 |
] |
|
2380 |
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1) |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2381 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2382 |
|
11487 | 2383 |
hardcopyOfView: aView |
2384 |
"after a second (to allow redraw of views under menu ...), |
|
2385 |
save a view's contents as bitmap image." |
|
2386 |
||
12500
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2387 |
|top| |
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2388 |
|
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2389 |
top := aView topView. |
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2390 |
top raiseDeiconified; makeFullyVisible. |
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2391 |
|
11487 | 2392 |
"do a pushEvent, in case its me myself and I have to redraw first..." |
2393 |
self enqueueDelayedAction:[ |
|
2394 |
Delay waitForSeconds:1. "/ give view a chance to redraw itself. |
|
12500
5e05cf44bd94
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12499
diff
changeset
|
2395 |
self saveScreenImage:(Image fromView:top) defaultName:'hardcopy' |
11487 | 2396 |
]. |
2397 |
aView windowGroup processExposeEvents |
|
2398 |
||
2399 |
"Created: / 27-04-2012 / 13:23:40 / cg" |
|
2400 |
! |
|
2401 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2402 |
iconifyAllWindows |
12067
08fea14741d0
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12059
diff
changeset
|
2403 |
self allTopViewsDo:[:eachTopView | eachTopView collapse] |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2404 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2405 |
|
2765 | 2406 |
migrateAllWindows |
2407 |
"migrate all views to some other display" |
|
2408 |
||
2409 |
|anotherDisplay toMigrate| |
|
2410 |
||
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2411 |
[ |
9961 | 2412 |
anotherDisplay := self askForAnotherDisplay. |
2413 |
anotherDisplay isNil ifTrue:[ |
|
2414 |
^ self. |
|
2415 |
]. |
|
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2416 |
] on:Screen deviceOpenErrorSignal do:[:ex| |
9961 | 2417 |
^ self warn:'Cannot open display: ', ex parameter. |
9303 | 2418 |
]. |
2419 |
||
2420 |
toMigrate := WindowGroup allInstances |
|
9961 | 2421 |
select:[:each | each graphicsDevice == Screen current |
2422 |
and:[each topViews size > 0 |
|
2423 |
and:[each isModal not]] |
|
2424 |
]. |
|
2765 | 2425 |
toMigrate do:[:eachGroup | |
9961 | 2426 |
eachGroup migrateTo:anotherDisplay |
2765 | 2427 |
] |
2428 |
! |
|
2429 |
||
2759 | 2430 |
migrateWindow:aWindow |
2431 |
"migrate a view to some other display" |
|
2432 |
||
16747 | 2433 |
aWindow isModal ifTrue:[ |
9961 | 2434 |
self warn:'Sorry - I cannot migrate a modalBox; please migrate the owning View.'. |
2435 |
^ self |
|
2778
1e4bf8bf1d37
block migration of a modalBox
Claus Gittinger <cg@exept.de>
parents:
2775
diff
changeset
|
2436 |
]. |
11487 | 2437 |
self |
2438 |
migrateWindow:aWindow |
|
2439 |
withBackOption:(self confirm:'Show ''Return Back'' Button on the other display ?') |
|
2440 |
||
2441 |
"Modified (format): / 27-04-2012 / 13:15:23 / cg" |
|
2775 | 2442 |
! |
2443 |
||
2444 |
migrateWindow:aWindow withBackOption:withBackOption |
|
2445 |
"migrate a view to some other display" |
|
2446 |
||
2447 |
|anotherDisplay wg here b| |
|
2765 | 2448 |
|
2766 | 2449 |
aWindow isTopView ifFalse:[ |
9961 | 2450 |
self information:'Cannot migrate this window'. |
2451 |
^ self |
|
2766 | 2452 |
]. |
2453 |
||
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2454 |
[ |
9961 | 2455 |
anotherDisplay := self askForAnotherDisplay. |
2456 |
anotherDisplay isNil ifTrue:[ |
|
2457 |
^ self. |
|
2458 |
]. |
|
3664
77fb767b5368
Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents:
3644
diff
changeset
|
2459 |
] on:Screen deviceOpenErrorSignal do:[:ex| |
9961 | 2460 |
^ self warn:'Cannot open display: ', ex parameter. |
2759 | 2461 |
]. |
2462 |
||
2775 | 2463 |
wg := aWindow windowGroup. |
2464 |
wg migrateTo:anotherDisplay. |
|
2465 |
||
2466 |
withBackOption ifTrue:[ |
|
9961 | 2467 |
here := Screen current. |
2468 |
b := Button onDevice:anotherDisplay. |
|
2469 |
b label:'Return window back to ' , here displayName. |
|
2470 |
b action:[ wg migrateTo:here. b destroy. ]. |
|
2471 |
b origin:0@0. |
|
2472 |
b open. |
|
2775 | 2473 |
]. |
2759 | 2474 |
! |
2475 |
||
9364
be7f9957ef94
added: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9330
diff
changeset
|
2476 |
openWindowTreeInspector |
9932
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2477 |
Tools::ViewTreeInspectorApplication isNil ifTrue:[ |
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2478 |
Dialog warn:'Missing class: Tools::ViewTreeInspectorApplication'. |
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2479 |
^ self. |
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2480 |
]. |
14459
8bf63fa9cd85
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14445
diff
changeset
|
2481 |
Tools::ViewTreeInspectorApplication openInPickModeAndRelease |
9932
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2482 |
|
f6d155d70650
changed: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9875
diff
changeset
|
2483 |
"Modified: / 12-05-2011 / 10:15:39 / cg" |
9364
be7f9957ef94
added: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9330
diff
changeset
|
2484 |
! |
be7f9957ef94
added: #openWindowTreeInspector
Claus Gittinger <cg@exept.de>
parents:
9330
diff
changeset
|
2485 |
|
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2486 |
screenHardcopy |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2487 |
"after a second (to allow redraw of views under menu ...), |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2488 |
let user specify a rectangular area on the screen |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2489 |
and save its contents." |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2490 |
|
9303 | 2491 |
Processor |
9961 | 2492 |
addTimedBlock:[ |
2493 |
|area| |
|
2494 |
||
2495 |
[Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05]. |
|
2496 |
||
2497 |
area := Rectangle fromUser. |
|
2498 |
(area width > 0 and:[area height > 0]) ifTrue:[ |
|
2499 |
Delay waitForSeconds:2. |
|
2500 |
self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy' |
|
2501 |
] |
|
2502 |
] |
|
15367
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2503 |
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:0.5) |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2504 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2505 |
"Modified: / 18.8.1998 / 15:00:42 / cg" |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2506 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2507 |
|
6069
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2508 |
screenHardcopyWithDelay |
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2509 |
"after some time (to allow user to pull menu or similar...), |
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2510 |
let user specify a rectangular area on the screen |
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2511 |
and save its contents." |
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2512 |
|
8385
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2513 |
|area| |
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2514 |
|
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2515 |
[Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05]. |
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2516 |
|
15367
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2517 |
Delay waitForSeconds:0.2. "/ to allow redraw under the menu area just uncovered |
8385
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2518 |
area := Rectangle fromUser. |
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2519 |
(area width > 0 and:[area height > 0]) ifTrue:[ |
9961 | 2520 |
[ |
15367
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2521 |
|oldLabel| |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2522 |
|
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2523 |
oldLabel := self window label. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2524 |
10 to:4 by:-1 do:[:secs | |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2525 |
self window label:(resources string:'%1 seconds until making a screenshot...' with:secs). |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2526 |
Screen current beep. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2527 |
Delay waitForSeconds:1. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2528 |
]. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2529 |
3 to:1 by:-1 do:[:secs | |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2530 |
self window label:(resources string:'%1 seconds until making a screenshot...' with:secs). |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2531 |
Screen current beep. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2532 |
Delay waitForSeconds:0.5. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2533 |
Screen current beep. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2534 |
Delay waitForSeconds:0.5. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2535 |
]. |
2391b2f27591
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15355
diff
changeset
|
2536 |
self window label:oldLabel. |
9961 | 2537 |
self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy' |
2538 |
] fork |
|
8385
635607a0dcc4
changed #screenHardcopyWithDelay
Claus Gittinger <cg@exept.de>
parents:
8381
diff
changeset
|
2539 |
] |
6069
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2540 |
! |
6b2903a57572
edit-button in screen-area abzug
Claus Gittinger <cg@exept.de>
parents:
6040
diff
changeset
|
2541 |
|
7977 | 2542 |
showFlyByWindowInformation |
9303 | 2543 |
"show infos about window under the mouse pointer" |
7977 | 2544 |
|
7980
9da97ea4f99d
changed #showFlyByWindowInformation
Claus Gittinger <cg@exept.de>
parents:
7977
diff
changeset
|
2545 |
FlyByWindowInformation notNil ifTrue:[ |
9961 | 2546 |
[ |
2547 |
FlyByWindowInformation shownInformationOfViewUnderMouseUntilButtonIsPressed |
|
2548 |
] fork. |
|
7980
9da97ea4f99d
changed #showFlyByWindowInformation
Claus Gittinger <cg@exept.de>
parents:
7977
diff
changeset
|
2549 |
] |
7977 | 2550 |
! |
2551 |
||
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2552 |
startWindowTreeView |
2371
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2553 |
"open a windowTree (on a picked topView)" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2554 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2555 |
|v| |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2556 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2557 |
WindowTreeView isNil ifTrue:[ |
9961 | 2558 |
^ self warn:'The WindowTreeView is not available in this release.' |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2559 |
]. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2560 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2561 |
v := self pickAView. |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2562 |
v notNil ifTrue:[ |
9961 | 2563 |
WindowTreeView openOn:v topView |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2564 |
] |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2565 |
|
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2566 |
! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2567 |
|
2371
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2568 |
startWindowTreeViewForAll |
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2569 |
"open a windowTree on all views in the system" |
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2570 |
|
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2571 |
WindowTreeView isNil ifTrue:[ |
9961 | 2572 |
^ self warn:'The WindowTreeView is not available in this release.' |
2371
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2573 |
]. |
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2574 |
|
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2575 |
WindowTreeView openOnAll |
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2576 |
! |
7ce8ba08aca1
added windowTree on all views on all screens
Claus Gittinger <cg@exept.de>
parents:
2359
diff
changeset
|
2577 |
|
9961 | 2578 |
viewBrowse |
16446 | 2579 |
"let user pick a view and browse its Application class. |
16940 | 2580 |
Of course, only Smalltalk views are allowed" |
9961 | 2581 |
|
14238
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2582 |
|v app appClass browser| |
9961 | 2583 |
|
2584 |
(v := self pickAView) notNil ifTrue:[ |
|
14238
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2585 |
browser := UserPreferences browserClass. |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2586 |
(app := v application) notNil ifTrue:[ |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2587 |
appClass := app class theMetaclass. |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2588 |
(appClass includesSelector:#windowSpec) ifTrue:[ |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2589 |
browser openInMethod:(appClass compiledMethodAt:#windowSpec) |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2590 |
] |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2591 |
] ifFalse:[ |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2592 |
(app ? v) browse |
fb35cdfdc677
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14183
diff
changeset
|
2593 |
] |
9961 | 2594 |
] |
2595 |
||
2596 |
"Created: / 30-06-2011 / 22:59:03 / cg" |
|
2597 |
! |
|
2598 |
||
4244 | 2599 |
viewDestroy |
2600 |
"let user pick a view and destroy it. |
|
16940 | 2601 |
Even allow destroying non-Smalltalk views |
4244 | 2602 |
(also for views which I forgot due to some error)" |
2603 |
||
9805 | 2604 |
|screen v id i c| |
2605 |
||
2606 |
Delay waitForSeconds:1. |
|
2607 |
||
2608 |
i := self class cross2Icon. |
|
4244 | 2609 |
i isNil ifTrue:[ |
9805 | 2610 |
c := Cursor crossHair |
4244 | 2611 |
] ifFalse:[ |
9805 | 2612 |
c := Cursor fromImage:i |
2613 |
]. |
|
2614 |
||
2615 |
screen := Screen current. |
|
2616 |
id := screen viewIdFromPoint:(screen pointFromUserShowing:c). |
|
2617 |
(v := screen viewFromId:id) notNil ifTrue:[ |
|
2618 |
v topView destroy. |
|
2619 |
^ self |
|
2620 |
]. |
|
2621 |
id = screen rootView id ifTrue:[ |
|
2622 |
^ self |
|
2623 |
]. |
|
16756 | 2624 |
(Dialog confirm:'This may not be a smalltalk view\(or I somehow forgot about it).\Destroy anyway?' withCRs) |
4244 | 2625 |
ifTrue:[ |
9805 | 2626 |
screen destroyView:nil withId:id |
2627 |
]. |
|
4244 | 2628 |
! |
2629 |
||
2630 |
viewHardcopy |
|
2631 |
"after a second (to allow redraw of views under menu ...), |
|
2632 |
let user specify a view and save its contents." |
|
2633 |
||
9303 | 2634 |
Processor |
9961 | 2635 |
addTimedBlock:[ |
2636 |
|v| |
|
2637 |
(v := Screen current viewFromUser) notNil ifTrue:[ |
|
11487 | 2638 |
self hardcopyOfView: v |
9961 | 2639 |
] |
2640 |
] |
|
2641 |
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1) |
|
11487 | 2642 |
|
2643 |
"Modified: / 27-04-2012 / 13:24:23 / cg" |
|
4244 | 2644 |
! |
2645 |
||
2646 |
viewInspect |
|
16446 | 2647 |
"let user pick a view and inspect it. |
16940 | 2648 |
Of course, only Smalltalk views are allowed" |
4244 | 2649 |
|
2650 |
|v| |
|
2651 |
||
2652 |
(v := self pickAView) notNil ifTrue:[ |
|
9961 | 2653 |
v inspect |
4244 | 2654 |
] |
2655 |
! |
|
2656 |
||
2657 |
viewMigrate |
|
16446 | 2658 |
"let user pick a view and migrate it to some other display. |
16940 | 2659 |
Only Smalltalk views are allowed" |
4244 | 2660 |
|
2661 |
|v| |
|
2662 |
||
2663 |
(v := self pickAView) notNil ifTrue:[ |
|
9961 | 2664 |
self migrateWindow:v topView |
4244 | 2665 |
] |
6032
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2666 |
! |
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2667 |
|
14571
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2668 |
viewSelectAndShrink |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2669 |
"let user pick a view and shrink it to a reasonable size |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2670 |
Added for stupid mac, to get windows back onto the screen, |
16446 | 2671 |
which have their resize handle hidden or unreachable." |
14571
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2672 |
|
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2673 |
|v| |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2674 |
|
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2675 |
(v := self pickAView) notNil ifTrue:[ |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2676 |
v topView |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2677 |
origin:50@50 extent:200@200; |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2678 |
raise |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2679 |
] |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2680 |
! |
75b4e99a3384
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14534
diff
changeset
|
2681 |
|
6032
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2682 |
widgetHardcopy |
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2683 |
"after a second (to allow redraw of views under menu ...), |
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2684 |
let user specify a widget and save its contents." |
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2685 |
|
9303 | 2686 |
Processor |
16446 | 2687 |
addTimedBlock: |
2688 |
[ |
|
2689 |
|v| |
|
2690 |
(v := Screen current viewFromUser) notNil ifTrue:[ |
|
2691 |
self saveScreenImage:(Image fromView:v) defaultName:'hardcopy' |
|
2692 |
] |
|
2693 |
] |
|
9961 | 2694 |
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1) |
6032
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2695 |
|
c9ff68a79be2
Move #widgetHardcopy from NewLauncher to AbstractLauncherApplication
Stefan Vogel <sv@exept.de>
parents:
6019
diff
changeset
|
2696 |
"Created: / 21.8.1998 / 20:44:12 / cg" |
2005
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2697 |
! ! |
c227faa4616b
more refactoring (NewLauncher <-> Launcher)
Claus Gittinger <cg@exept.de>
parents:
2001
diff
changeset
|
2698 |
|
2001 | 2699 |
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs'! |
2700 |
||
4244 | 2701 |
communicationsSettings |
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
2702 |
"open a dialog on communications settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
2703 |
Obsoleted by the settings application" |
4244 | 2704 |
|
2705 |
|box check in resources y acceptChannel |
|
2706 |
hasRDoitServer rDoitServerPort |
|
9303 | 2707 |
rDoitsEnabled rDoitLogging rDoitErrorLogging rDoitErrorDebugging |
4244 | 2708 |
org_rDoitsEnabled org_rDoitLogging org_rDoitErrorLogging org_rDoitErrorDebugging org_rDoitServerPort |
2709 |
||
2710 |
hasRemoteBrowsingSupport remoteBrowsingEnabled org_remoteBrowsingEnabled |
|
2711 |
||
2712 |
hasWindowMigrationServer windowMigrationAuthenticate windowMigrationPassword |
|
9303 | 2713 |
windowMigrationEnabled |
4244 | 2714 |
org_windowMigrationEnabled org_windowMigrationAuthenticate org_windowMigrationPassword |
2715 |
||
2716 |
hasHTTPServer httpServerRunning httpServerFileRoot httpServerHomeURL |
|
2717 |
httpServerPort httpServerLogFile hasSwiki swikiEnabled swikiRoot |
|
2718 |
allowEmbedded hasSoap soapEnabled |
|
2719 |
org_httpServerRunning org_httpServerFileRoot org_httpServerHomeURL |
|
2720 |
org_httpServerPort org_swikiRoot org_swikiEnabled org_httpServerLogFile |
|
2721 |
org_allowEmbedded org_soapEnabled |
|
2722 |
||
2723 |
osiACSEPresent osiROSEPresent osiCMISEPresent |
|
2724 |
osiACSEErrorLogging osiACSEConnectionLogging osiACSEDataLogging |
|
2725 |
osiROSEErrorLogging osiROSEResponseLogging osiROSEInvokationLogging |
|
4872 | 2726 |
osiCMISEErrorLogging osiCMISEMessageLogging defaultServer |
4244 | 2727 |
| |
2728 |
||
5048 | 2729 |
self warn:'Please use HTTPServer Settings in the new SettingsDialog'. |
4244 | 2730 |
acceptChannel := false asValue. |
2731 |
||
2732 |
resources := self owningClass classResources. |
|
4872 | 2733 |
defaultServer := HTTPServer defaultServer. |
9303 | 2734 |
"/ |
4244 | 2735 |
"/ extract relevant remoteBrowsing settings ... |
2736 |
"/ |
|
2737 |
remoteBrowsingEnabled := false. |
|
2738 |
(hasRemoteBrowsingSupport := SmalltalkShareServer notNil) ifTrue:[ |
|
9961 | 2739 |
SmalltalkShareServer isLoaded ifTrue:[ |
2740 |
remoteBrowsingEnabled := SmalltalkShareServer serverRunning. |
|
2741 |
]. |
|
4244 | 2742 |
]. |
2743 |
org_remoteBrowsingEnabled := remoteBrowsingEnabled. |
|
2744 |
remoteBrowsingEnabled := remoteBrowsingEnabled asValue. |
|
2745 |
||
9303 | 2746 |
"/ |
4244 | 2747 |
"/ extract relevant windowMigration settings ... |
2748 |
"/ |
|
2749 |
windowMigrationEnabled := windowMigrationAuthenticate := false. |
|
2750 |
(hasWindowMigrationServer := WindowMigrationServer notNil) ifTrue:[ |
|
9961 | 2751 |
WindowMigrationServer isLoaded ifTrue:[ |
2752 |
windowMigrationEnabled := WindowMigrationServer serverRunning. |
|
2753 |
]. |
|
2754 |
windowMigrationPassword := WindowMigrationServer password. |
|
2755 |
windowMigrationAuthenticate := windowMigrationPassword notNil. |
|
4244 | 2756 |
]. |
2757 |
org_windowMigrationEnabled := windowMigrationEnabled. |
|
2758 |
windowMigrationEnabled := windowMigrationEnabled asValue. |
|
2759 |
org_windowMigrationAuthenticate := windowMigrationAuthenticate. |
|
2760 |
windowMigrationAuthenticate := windowMigrationAuthenticate asValue. |
|
2761 |
org_windowMigrationPassword := windowMigrationPassword. |
|
2762 |
windowMigrationPassword := windowMigrationPassword asValue. |
|
2763 |
||
9303 | 2764 |
"/ |
4244 | 2765 |
"/ extract relevant rdoit settings ... |
2766 |
"/ |
|
2767 |
rDoitsEnabled := rDoitLogging := rDoitErrorLogging := false. |
|
2768 |
(hasRDoitServer := RDoItServer notNil) ifTrue:[ |
|
9961 | 2769 |
RDoItServer isLoaded ifTrue:[ |
2770 |
rDoitsEnabled := RDoItServer serverRunning. |
|
2771 |
rDoitLogging := RDoItServer isLogging. |
|
2772 |
rDoitErrorLogging := RDoItServer isErrorLogging. |
|
2773 |
rDoitErrorDebugging := RDoItServer isErrorCatching not. |
|
2774 |
rDoitServerPort := RDoItServer defaultPortNumberOrPath. |
|
2775 |
] |
|
4244 | 2776 |
]. |
2777 |
org_rDoitsEnabled := rDoitsEnabled. |
|
2778 |
org_rDoitLogging := rDoitLogging. |
|
2779 |
org_rDoitErrorLogging := rDoitErrorLogging. |
|
2780 |
org_rDoitErrorDebugging := rDoitErrorDebugging. |
|
2781 |
org_rDoitServerPort := rDoitServerPort. |
|
2782 |
||
2783 |
rDoitServerPort := rDoitServerPort asValue. |
|
2784 |
rDoitsEnabled := rDoitsEnabled asValue. |
|
2785 |
rDoitLogging := rDoitLogging asValue. |
|
2786 |
rDoitErrorLogging := rDoitErrorLogging asValue. |
|
2787 |
rDoitErrorDebugging := rDoitErrorDebugging asValue. |
|
2788 |
||
2789 |
"/ |
|
2790 |
"/ extract http-server settings |
|
2791 |
"/ |
|
2792 |
hasHTTPServer := httpServerRunning := false. |
|
2793 |
(hasHTTPServer := HTTPServer notNil) ifTrue:[ |
|
9961 | 2794 |
HTTPServer isLoaded ifTrue:[ |
2795 |
httpServerRunning := HTTPServer isRunning. |
|
2796 |
"/ httpServerFileRoot := HTTPServer fileRoot. |
|
2797 |
httpServerHomeURL := HTTPServer homeURL. |
|
2798 |
httpServerPort := HTTPServer port. |
|
2799 |
httpServerLogFile := HTTPServer logFile. |
|
2800 |
]. |
|
4244 | 2801 |
]. |
2802 |
org_httpServerRunning := httpServerRunning. |
|
2803 |
httpServerRunning := httpServerRunning asValue. |
|
2804 |
org_httpServerFileRoot := httpServerFileRoot. |
|
2805 |
httpServerFileRoot := httpServerFileRoot asValue. |
|
2806 |
org_httpServerHomeURL := httpServerHomeURL. |
|
2807 |
httpServerHomeURL := httpServerHomeURL asValue. |
|
2808 |
org_httpServerPort := httpServerPort. |
|
2809 |
httpServerPort := httpServerPort asValue. |
|
2810 |
org_httpServerLogFile := httpServerLogFile. |
|
2811 |
httpServerLogFile := httpServerLogFile asValue. |
|
2812 |
||
9303 | 2813 |
httpServerRunning |
9961 | 2814 |
onChangeEvaluate:[ |
2815 |
"/ httpServerFileRoot value:(HTTPServer fileRoot). |
|
2816 |
httpServerHomeURL value:(HTTPServer homeURL). |
|
2817 |
httpServerPort value:(HTTPServer port). |
|
2818 |
httpServerLogFile value:(HTTPServer logFile) |
|
2819 |
]. |
|
4244 | 2820 |
|
2821 |
hasSwiki := false. |
|
2822 |
swikiEnabled := false. |
|
2823 |
soapEnabled := false. |
|
2824 |
||
2825 |
(hasSwiki := PWS::SwikiAction notNil) ifTrue:[ |
|
9961 | 2826 |
PWS::SwikiAction isLoaded ifTrue:[ |
2827 |
(HTTPServer notNil and:[HTTPServer isLoaded]) ifTrue:[ |
|
2828 |
swikiEnabled := (defaultServer notNil and:[defaultServer hasServiceForServiceClass:SwikiAction]). |
|
2829 |
swikiRoot := PWS::SwikiAction serverDirectory. |
|
2830 |
] |
|
2831 |
]. |
|
4244 | 2832 |
]. |
2833 |
(hasSoap := SOAP::SoapHttpModule notNil) ifTrue:[ |
|
9961 | 2834 |
SOAP::SoapHttpModule isLoaded ifTrue:[ |
2835 |
(HTTPServer notNil and:[HTTPServer isLoaded]) ifTrue:[ |
|
2836 |
soapEnabled := HTTPServer soapEnabled. |
|
2837 |
] |
|
2838 |
]. |
|
4244 | 2839 |
]. |
2840 |
||
2841 |
org_swikiRoot := swikiRoot. |
|
2842 |
org_swikiEnabled := swikiEnabled. |
|
2843 |
org_soapEnabled := soapEnabled. |
|
2844 |
swikiRoot := swikiRoot asValue. |
|
2845 |
swikiEnabled := swikiEnabled asValue. |
|
2846 |
soapEnabled := soapEnabled asValue. |
|
2847 |
||
2848 |
swikiEnabled |
|
9961 | 2849 |
onChangeEvaluate:[ |
2850 |
swikiRoot value:(PWS::SwikiAction serverDirectory). |
|
2851 |
]. |
|
4244 | 2852 |
|
4872 | 2853 |
|
5024 | 2854 |
allowEmbedded := defaultServer notNil and:[defaultServer hasServiceForServiceClass:HTTPEmbeddedApplicationService]. |
4244 | 2855 |
org_allowEmbedded := allowEmbedded. |
2856 |
allowEmbedded := allowEmbedded asValue. |
|
2857 |
||
2858 |
"/ |
|
2859 |
"/ osi settings ... |
|
2860 |
"/ |
|
2861 |
osiACSEPresent := OSI::ACSE notNil and:[OSI::ACSE isLoaded]. |
|
2862 |
osiROSEPresent := OSI::ROSE notNil and:[OSI::ROSE isLoaded]. |
|
2863 |
osiCMISEPresent := OSI::CMISE notNil and:[OSI::CMISE isLoaded]. |
|
2864 |
||
2865 |
osiACSEPresent ifTrue:[ |
|
9961 | 2866 |
osiACSEErrorLogging := OSI::ACSE errorLogging asValue. |
2867 |
osiACSEConnectionLogging := OSI::ACSE connectionLogging asValue. |
|
2868 |
osiACSEDataLogging := OSI::ACSE dataLogging asValue. |
|
4244 | 2869 |
]. |
2870 |
osiROSEPresent ifTrue:[ |
|
9961 | 2871 |
osiROSEErrorLogging := OSI::ROSE errorLogging asValue. |
2872 |
osiROSEInvokationLogging := OSI::ROSE invocationLogging asValue. |
|
2873 |
osiROSEResponseLogging := OSI::ROSE responseLogging asValue. |
|
4244 | 2874 |
]. |
2875 |
osiCMISEPresent ifTrue:[ |
|
9961 | 2876 |
osiCMISEErrorLogging := OSI::CMISE errorLogging asValue. |
2877 |
osiCMISEMessageLogging := OSI::CMISE messageLogging asValue. |
|
4244 | 2878 |
]. |
2879 |
||
2880 |
"/ |
|
2881 |
"/ create a box on those values ... |
|
2882 |
"/ |
|
2883 |
box := DialogBox new. |
|
2884 |
box label:(resources string:'Communication settings'). |
|
2885 |
||
2886 |
box addTextLabel:(resources string:'Remote browsing'). |
|
2887 |
||
2888 |
check := box addCheckBox:(resources string:'Remote browsing enabled') on:remoteBrowsingEnabled. |
|
2889 |
hasRemoteBrowsingSupport ifFalse:[ |
|
9961 | 2890 |
check disable |
4244 | 2891 |
]. |
2892 |
box addHorizontalLine. |
|
2893 |
||
2894 |
box addTextLabel:(resources string:'Window migration'). |
|
2895 |
||
2896 |
check := box addCheckBox:(resources string:'Window migration enabled') on:windowMigrationEnabled. |
|
2897 |
hasWindowMigrationServer ifFalse:[ |
|
9961 | 2898 |
check disable |
4244 | 2899 |
]. |
2900 |
check := box addCheckBox:(resources string:'Password check') on:windowMigrationAuthenticate. |
|
2901 |
check enableChannel:windowMigrationEnabled. |
|
2902 |
hasWindowMigrationServer ifFalse:[ |
|
9961 | 2903 |
check disable |
4244 | 2904 |
]. |
2905 |
box leftIndent:20. |
|
9303 | 2906 |
in := box |
9961 | 2907 |
addLabelledInputField:(resources string:'Password:') |
2908 |
adjust:#right |
|
2909 |
on:nil |
|
2910 |
tabable:true |
|
2911 |
separateAtX:0.3. |
|
8074 | 2912 |
in bePassword. |
4244 | 2913 |
in model:windowMigrationPassword. |
2914 |
in acceptChannel:acceptChannel. |
|
2915 |
in enableChannel:windowMigrationAuthenticate. |
|
2916 |
box leftIndent:0. |
|
2917 |
||
2918 |
box addHorizontalLine. |
|
2919 |
||
2920 |
box addTextLabel:'RDoIt Server'. |
|
2921 |
||
2922 |
check := box addCheckBox:(resources string:'Remote doits enabled') on:rDoitsEnabled. |
|
2923 |
hasRDoitServer ifFalse:[ |
|
9961 | 2924 |
check disable |
4244 | 2925 |
]. |
2926 |
box leftIndent:20. |
|
2927 |
rDoitsEnabled onChangeEvaluate:[ rDoitsEnabled value ifTrue:[ |
|
9961 | 2928 |
rDoitServerPort value isNil ifTrue:[ |
2929 |
rDoitServerPort value:(RDoItServer defaultPortNumberOrPath printString). |
|
2930 |
] |
|
2931 |
] |
|
2932 |
]. |
|
9303 | 2933 |
|
2934 |
in := box |
|
9961 | 2935 |
addLabelledInputField:(resources string:'Port:') |
2936 |
adjust:#right |
|
2937 |
on:nil |
|
2938 |
tabable:true |
|
2939 |
separateAtX:0.3. |
|
5033
2b52a33c7eee
allow for rdoitPort to be a string (for ud sockets)
Claus Gittinger <cg@exept.de>
parents:
5032
diff
changeset
|
2940 |
"/ in converter:(PrintConverter new initForNumber). |
4244 | 2941 |
in model:rDoitServerPort. |
2942 |
in acceptChannel:acceptChannel. |
|
2943 |
in enableChannel:rDoitsEnabled. |
|
2944 |
||
2945 |
y := box yPosition. |
|
2946 |
check := box addCheckBox:(resources string:'Log errors') on:rDoitErrorLogging. |
|
2947 |
check width:0.4. |
|
2948 |
check enableChannel:rDoitsEnabled. |
|
2949 |
hasRDoitServer ifFalse:[ |
|
9961 | 2950 |
check disable |
4244 | 2951 |
]. |
2952 |
box yPosition:y. |
|
2953 |
check := box addCheckBox:(resources string:'Log requests') on:rDoitLogging. |
|
2954 |
check left:0.4; width:0.4. |
|
2955 |
check enableChannel:rDoitsEnabled. |
|
2956 |
hasRDoitServer ifFalse:[ |
|
9961 | 2957 |
check disable |
4244 | 2958 |
]. |
2959 |
check := box addCheckBox:(resources string:'Debug errors') on:rDoitErrorDebugging. |
|
2960 |
check width:0.4. |
|
2961 |
check enableChannel:rDoitsEnabled. |
|
2962 |
hasRDoitServer ifFalse:[ |
|
9961 | 2963 |
check disable |
4244 | 2964 |
]. |
2965 |
box leftIndent:0. |
|
2966 |
||
2967 |
box addHorizontalLine. |
|
2968 |
||
2969 |
box addTextLabel:'HTTP Server'. |
|
2970 |
||
2971 |
check := box addCheckBox:(resources string:'Serving HTTP Requests') on:httpServerRunning. |
|
2972 |
hasHTTPServer ifFalse:[ |
|
9961 | 2973 |
check disable |
4244 | 2974 |
]. |
2975 |
box leftIndent:20. |
|
9303 | 2976 |
in := box |
9961 | 2977 |
addLabelledInputField:(resources string:'Port:') |
2978 |
adjust:#right |
|
2979 |
on:nil |
|
2980 |
tabable:true |
|
2981 |
separateAtX:0.3. |
|
4244 | 2982 |
in converter:(PrintConverter new initForNumber). |
2983 |
in model:httpServerPort. |
|
2984 |
in acceptChannel:acceptChannel. |
|
2985 |
in enableChannel:httpServerRunning. |
|
2986 |
||
9303 | 2987 |
in := box |
9961 | 2988 |
addLabelledInputField:(resources string:'Log File:') |
2989 |
adjust:#right |
|
2990 |
on:httpServerLogFile |
|
2991 |
tabable:true |
|
2992 |
separateAtX:0.3. |
|
4244 | 2993 |
in acceptChannel:acceptChannel. |
2994 |
in enableChannel:httpServerRunning. |
|
2995 |
||
9303 | 2996 |
"/ in := box |
5169 | 2997 |
"/ addLabelledInputField:(resources string:'File Root:') |
2998 |
"/ adjust:#right |
|
9303 | 2999 |
"/ on:httpServerFileRoot |
5169 | 3000 |
"/ tabable:true |
3001 |
"/ separateAtX:0.3. |
|
3002 |
"/ in acceptChannel:acceptChannel. |
|
3003 |
"/ in enableChannel:httpServerRunning. |
|
4244 | 3004 |
|
9303 | 3005 |
in := box |
9961 | 3006 |
addLabelledInputField:(resources string:'Home URL:') |
3007 |
adjust:#right |
|
3008 |
on:httpServerHomeURL |
|
3009 |
tabable:true |
|
3010 |
separateAtX:0.3. |
|
4244 | 3011 |
in acceptChannel:acceptChannel. |
3012 |
in enableChannel:httpServerRunning. |
|
3013 |
||
3014 |
check := box addCheckBox:(resources string:'Swiki enabled') on:swikiEnabled. |
|
3015 |
hasHTTPServer ifFalse:[ |
|
9961 | 3016 |
check disable |
4244 | 3017 |
]. |
3018 |
check enableChannel:httpServerRunning. |
|
3019 |
||
3020 |
"/ box leftIndent:40. |
|
3021 |
||
9303 | 3022 |
in := box |
9961 | 3023 |
addLabelledInputField:(resources string:'SwikiRoot:') |
3024 |
adjust:#right |
|
3025 |
on:swikiRoot |
|
3026 |
tabable:true |
|
3027 |
separateAtX:0.3. |
|
4244 | 3028 |
in acceptChannel:acceptChannel. |
3029 |
in enableChannel:(BlockValue forLogical:httpServerRunning and:swikiEnabled). |
|
3030 |
||
3031 |
check := box addCheckBox:(resources string:'Allow embedded ST applications') on:allowEmbedded. |
|
3032 |
hasHTTPServer ifFalse:[ |
|
9961 | 3033 |
check disable |
4244 | 3034 |
]. |
3035 |
check enableChannel:httpServerRunning. |
|
3036 |
||
3037 |
check := box addCheckBox:(resources string:'Soap enabled') on:soapEnabled. |
|
3038 |
hasHTTPServer ifFalse:[ |
|
9961 | 3039 |
check disable |
4244 | 3040 |
]. |
3041 |
check enableChannel:httpServerRunning. |
|
3042 |
||
3043 |
box leftIndent:0. |
|
3044 |
box addHorizontalLine. |
|
3045 |
||
3046 |
box addTextLabel:(resources string:'OSI Protocols (addOn package)'). |
|
3047 |
||
3048 |
y := box yPosition. |
|
3049 |
check := box addCheckBox:(resources string:'Log %1 Errors' with:'ACSE') on:osiACSEErrorLogging. |
|
3050 |
check width:0.33. |
|
3051 |
osiACSEPresent ifFalse:[ |
|
9961 | 3052 |
check disable |
4244 | 3053 |
]. |
3054 |
||
3055 |
box yPosition:y. |
|
3056 |
check := box addCheckBox:(resources string:'Connections') on:osiACSEConnectionLogging. |
|
3057 |
osiACSEPresent ifFalse:[ |
|
9961 | 3058 |
check disable |
4244 | 3059 |
]. |
3060 |
check left:0.33; width:0.33. |
|
3061 |
||
3062 |
box yPosition:y. |
|
3063 |
check := box addCheckBox:(resources string:'Data Xfer') on:osiACSEDataLogging. |
|
3064 |
osiACSEPresent ifFalse:[ |
|
9961 | 3065 |
check disable |
4244 | 3066 |
]. |
3067 |
check left:0.66; width:0.34. |
|
3068 |
||
3069 |
||
3070 |
box addVerticalSpace. |
|
3071 |
||
3072 |
y := box yPosition. |
|
3073 |
check := box addCheckBox:(resources string:'Log %1 Errors' with:'ROSE') on:osiROSEErrorLogging. |
|
3074 |
osiROSEPresent ifFalse:[ |
|
9961 | 3075 |
check disable |
4244 | 3076 |
]. |
3077 |
check width:0.33. |
|
3078 |
||
3079 |
box yPosition:y. |
|
3080 |
check := box addCheckBox:(resources string:'Invoactions') on:osiROSEInvokationLogging. |
|
3081 |
osiROSEPresent ifFalse:[ |
|
9961 | 3082 |
check disable |
4244 | 3083 |
]. |
3084 |
check left:0.33; width:0.33. |
|
3085 |
||
3086 |
box yPosition:y. |
|
3087 |
check := box addCheckBox:(resources string:'Responses') on:osiROSEResponseLogging. |
|
3088 |
osiROSEPresent ifFalse:[ |
|
9961 | 3089 |
check disable |
4244 | 3090 |
]. |
3091 |
check left:0.66; width:0.34. |
|
3092 |
||
3093 |
box addVerticalSpace. |
|
3094 |
||
3095 |
y := box yPosition. |
|
3096 |
check := box addCheckBox:(resources string:'Log %1 Errors' with:'CMISE') on:osiCMISEErrorLogging. |
|
3097 |
osiCMISEPresent ifFalse:[ |
|
9961 | 3098 |
check disable |
4244 | 3099 |
]. |
3100 |
check width:0.33. |
|
3101 |
||
3102 |
box yPosition:y. |
|
3103 |
check := box addCheckBox:(resources string:'Messages') on:osiCMISEMessageLogging. |
|
3104 |
osiCMISEPresent ifFalse:[ |
|
9961 | 3105 |
check disable |
4244 | 3106 |
]. |
3107 |
check left:0.33; width:0.33. |
|
3108 |
||
3109 |
||
3110 |
box addHorizontalLine. |
|
9303 | 3111 |
box |
9961 | 3112 |
addHelpButtonFor:'Launcher/communicationsSettings.html'; |
3113 |
addAbortAndOkButtons. |
|
4244 | 3114 |
|
3115 |
"/ |
|
3116 |
"/ show the box ... |
|
3117 |
"/ |
|
3118 |
box open. |
|
3119 |
||
3120 |
"/ |
|
3121 |
"/ update system settings |
|
3122 |
"/ |
|
3123 |
box accepted ifTrue:[ |
|
9961 | 3124 |
acceptChannel value:false; value:true. |
3125 |
||
3126 |
hasRemoteBrowsingSupport ifTrue:[ |
|
3127 |
remoteBrowsingEnabled := remoteBrowsingEnabled value. |
|
3128 |
(remoteBrowsingEnabled ~~ org_remoteBrowsingEnabled) ifTrue:[ |
|
3129 |
remoteBrowsingEnabled ~~ SmalltalkShareServer serverRunning ifTrue:[ |
|
3130 |
remoteBrowsingEnabled ifFalse:[ |
|
3131 |
SmalltalkShareServer killAll |
|
3132 |
] ifTrue:[ |
|
3133 |
SmalltalkShareServer start. |
|
3134 |
"/ must wait a bit; give it a chance to |
|
3135 |
"/ really start (before checking) |
|
3136 |
Delay waitForSeconds:0.5. |
|
3137 |
SmalltalkShareServer serverRunning ifFalse:[ |
|
3138 |
self warn:'SmalltalkShareServer startup failed (see stderr).' |
|
3139 |
] |
|
3140 |
] |
|
3141 |
]. |
|
3142 |
] |
|
3143 |
]. |
|
3144 |
||
3145 |
hasWindowMigrationServer ifTrue:[ |
|
3146 |
windowMigrationEnabled := windowMigrationEnabled value. |
|
3147 |
windowMigrationAuthenticate := windowMigrationAuthenticate value. |
|
3148 |
windowMigrationPassword := windowMigrationPassword value. |
|
3149 |
(windowMigrationEnabled ~~ org_windowMigrationEnabled |
|
3150 |
or:[windowMigrationAuthenticate ~~ org_windowMigrationAuthenticate |
|
3151 |
or:[windowMigrationPassword ~~ org_windowMigrationPassword]]) ifTrue:[ |
|
3152 |
windowMigrationAuthenticate ~~ org_windowMigrationAuthenticate ifTrue:[ |
|
3153 |
windowMigrationAuthenticate ifFalse:[ |
|
3154 |
WindowMigrationServer password:nil |
|
3155 |
] ifTrue:[ |
|
3156 |
WindowMigrationServer password:windowMigrationPassword |
|
3157 |
]. |
|
3158 |
]. |
|
3159 |
windowMigrationEnabled ~~ WindowMigrationServer serverRunning ifTrue:[ |
|
3160 |
windowMigrationEnabled ifFalse:[ |
|
3161 |
WindowMigrationServer stop |
|
3162 |
] ifTrue:[ |
|
3163 |
WindowMigrationServer start. |
|
3164 |
"/ must wait a bit; give it a chance to |
|
3165 |
"/ really start (before checking) |
|
3166 |
Delay waitForSeconds:0.5. |
|
3167 |
WindowMigrationServer serverRunning ifFalse:[ |
|
3168 |
self warn:'WindowMigrationServer startup failed (see stderr).' |
|
3169 |
] |
|
3170 |
] |
|
3171 |
]. |
|
3172 |
] |
|
3173 |
]. |
|
3174 |
||
3175 |
hasRDoitServer ifTrue:[ |
|
3176 |
(rDoitLogging value ~~ org_rDoitLogging |
|
3177 |
or:[rDoitErrorDebugging value ~~ org_rDoitErrorDebugging |
|
3178 |
or:[rDoitErrorLogging value ~~ org_rDoitErrorLogging |
|
3179 |
or:[rDoitsEnabled value ~~ org_rDoitsEnabled |
|
3180 |
or:[rDoitServerPort value ~~ org_rDoitServerPort]]]]) ifTrue:[ |
|
3181 |
(Integer readFrom:rDoitServerPort value onError:nil) isNil ifTrue:[ |
|
3182 |
RDoItServer defaultPortNumberOrPath:rDoitServerPort value. |
|
3183 |
] ifFalse:[ |
|
3184 |
RDoItServer defaultPortNumberOrPath:(Integer readFrom:rDoitServerPort value onError:nil). |
|
3185 |
]. |
|
3186 |
RDoItServer logging:(rDoitLogging value). |
|
3187 |
RDoItServer errorLogging:(rDoitErrorLogging value). |
|
3188 |
RDoItServer errorCatching:(rDoitErrorDebugging value not). |
|
3189 |
rDoitsEnabled := rDoitsEnabled value. |
|
3190 |
rDoitsEnabled ~~ RDoItServer serverRunning ifTrue:[ |
|
3191 |
rDoitsEnabled ifFalse:[ |
|
3192 |
RDoItServer stop |
|
3193 |
] ifTrue:[ |
|
3194 |
RDoItServer start. |
|
3195 |
"/ must wait a bit; give it a chance to |
|
3196 |
"/ really start (before checking) |
|
3197 |
Delay waitForSeconds:0.5. |
|
3198 |
RDoItServer serverRunning ifFalse:[ |
|
3199 |
self warn:'RDoit startup failed (see stderr).' |
|
3200 |
] |
|
3201 |
] |
|
3202 |
]. |
|
3203 |
]. |
|
3204 |
]. |
|
3205 |
||
3206 |
(hasHTTPServer and:[HTTPServer isLoaded]) ifTrue:[ |
|
3207 |
httpServerPort := httpServerPort value. |
|
3208 |
org_httpServerPort ~= httpServerPort ifTrue:[ |
|
5024 | 3209 |
"/ HTTPServer port:httpServerPort. |
9961 | 3210 |
]. |
3211 |
||
3212 |
httpServerFileRoot := httpServerFileRoot value. |
|
3213 |
httpServerFileRoot size == 0 ifTrue:[ |
|
3214 |
httpServerFileRoot := nil |
|
3215 |
]. |
|
3216 |
org_httpServerFileRoot ~= httpServerFileRoot ifTrue:[ |
|
5024 | 3217 |
"/ HTTPServer fileRoot:httpServerFileRoot. |
9961 | 3218 |
]. |
3219 |
||
3220 |
httpServerLogFile := httpServerLogFile value. |
|
3221 |
httpServerLogFile size == 0 ifTrue:[ |
|
3222 |
httpServerLogFile := nil |
|
3223 |
]. |
|
5024 | 3224 |
"/ org_httpServerLogFile ~= httpServerLogFile ifTrue:[ |
3225 |
"/ HTTPServer logFile:httpServerLogFile. |
|
3226 |
"/ ]. |
|
4244 | 3227 |
|
9961 | 3228 |
httpServerHomeURL := httpServerHomeURL value. |
3229 |
httpServerHomeURL size == 0 ifTrue:[ |
|
3230 |
httpServerHomeURL := nil |
|
3231 |
]. |
|
3232 |
org_httpServerHomeURL ~= httpServerHomeURL ifTrue:[ |
|
5024 | 3233 |
"/ HTTPServer defaultHomeURL:httpServerHomeURL. |
9961 | 3234 |
]. |
3235 |
||
3236 |
httpServerRunning value ~~ org_httpServerRunning ifTrue:[ |
|
3237 |
httpServerRunning value ifTrue:[ |
|
3238 |
HTTPServer startServer |
|
3239 |
] ifFalse:[ |
|
3240 |
HTTPServer stopServer |
|
3241 |
] |
|
3242 |
]. |
|
3243 |
]. |
|
3244 |
||
3245 |
hasSwiki ifTrue:[ |
|
3246 |
swikiRoot := swikiRoot value. |
|
3247 |
swikiRoot size == 0 ifTrue:[ |
|
3248 |
swikiRoot := nil |
|
3249 |
]. |
|
3250 |
org_swikiRoot ~= swikiRoot ifTrue:[ |
|
3251 |
PWS::ServerAction serverDirectory:swikiRoot. |
|
3252 |
]. |
|
3253 |
||
3254 |
swikiEnabled value ~~ org_swikiEnabled ifTrue:[ |
|
3255 |
swikiEnabled value ifTrue:[ |
|
3256 |
HTTPServer setupMySwiki |
|
3257 |
] ifFalse:[ |
|
3258 |
HTTPServer disableMySwiki |
|
3259 |
] |
|
3260 |
]. |
|
3261 |
allowEmbedded value ~~ org_allowEmbedded ifTrue:[ |
|
3262 |
defaultServer notNil ifTrue:[ |
|
3263 |
HTTPEmbeddedApplicationService registerServiceOn:defaultServer. |
|
3264 |
]. |
|
3265 |
]. |
|
3266 |
]. |
|
3267 |
hasSoap ifTrue:[ |
|
3268 |
soapEnabled value ~~ org_soapEnabled ifTrue:[ |
|
3269 |
defaultServer notNil ifTrue:[ |
|
3270 |
soapEnabled value ifTrue:[ |
|
3271 |
defaultServer setupSoap |
|
3272 |
] ifFalse:[ |
|
3273 |
defaultServer disableSoap |
|
3274 |
] |
|
3275 |
] |
|
3276 |
]. |
|
3277 |
]. |
|
3278 |
||
3279 |
osiACSEPresent ifTrue:[ |
|
3280 |
OSI::ACSE errorLogging:osiACSEErrorLogging value. |
|
3281 |
OSI::ACSE connectionLogging:osiACSEConnectionLogging value. |
|
3282 |
OSI::ACSE dataLogging:osiACSEDataLogging value. |
|
3283 |
]. |
|
3284 |
osiROSEPresent ifTrue:[ |
|
3285 |
OSI::ROSE errorLogging:osiROSEErrorLogging value. |
|
3286 |
OSI::ROSE invocationLogging:osiROSEInvokationLogging value. |
|
3287 |
OSI::ROSE responseLogging:osiROSEResponseLogging value. |
|
3288 |
]. |
|
3289 |
osiCMISEPresent ifTrue:[ |
|
3290 |
OSI::CMISE errorLogging:osiCMISEErrorLogging value. |
|
3291 |
OSI::CMISE messageLogging:osiCMISEMessageLogging value. |
|
3292 |
]. |
|
4244 | 3293 |
]. |
3294 |
box destroy |
|
3295 |
||
3296 |
"Modified: / 28.6.1999 / 15:44:35 / stefan" |
|
3297 |
"Modified: / 20.1.2000 / 19:14:18 / cg" |
|
3298 |
! |
|
3299 |
||
3300 |
compilerSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3301 |
"open a dialog on compiler related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3302 |
Obsoleted by the settings application" |
4244 | 3303 |
|
17074 | 3304 |
|box warnings warnSTX warnUnderscore warnDollar warnParagraph warnOldStyle warnUnusedVars |
3305 |
allowDollar allowParagraph allowUnderscore allowSqueakExtensions allowQualifiedNames |
|
9303 | 3306 |
allowDolphinExtensions allowOldStyleAssignment allowReservedWordsAsSelectors |
4244 | 3307 |
immutableArrays |
3308 |
warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox |
|
17074 | 3309 |
warnCompatibility warnCompatibilityBox warnDollarBox warnParagraphBox warnUnusedVarsBox |
9303 | 3310 |
stcCompilation compilationList stcCompilationOptions |
3311 |
historyLines fullHistoryUpdate |
|
3312 |
catchMethodRedefs catchClassRedefs keepSourceOptions keepSource |
|
3313 |
constantFoldingOptions constantFolding justInTimeCompilation |
|
4244 | 3314 |
warnEnabler check component oldIndent supportsJustInTimeCompilation y |
3315 |
y2 fullDebugSupport yMax |
|
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
3316 |
compileLazy loadBinaries canLoadBinaries strings idx |
4244 | 3317 |
resources stcSetupButt| |
3318 |
||
3319 |
resources := self owningClass classResources. |
|
3320 |
||
3321 |
canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
|
3322 |
loadBinaries := Smalltalk loadBinaries asValue. |
|
3323 |
compileLazy := Autoload compileLazy asValue. |
|
3324 |
||
6538 | 3325 |
warnings := ParserFlags warnings asValue. |
3326 |
||
3327 |
warnSTX := ParserFlags warnSTXSpecials asValue. |
|
3328 |
warnUnderscore := ParserFlags warnUnderscoreInIdentifier asValue. |
|
3329 |
warnDollar := ParserFlags warnDollarInIdentifier asValue. |
|
17074 | 3330 |
warnParagraph := ParserFlags warnParagraphInIdentifier asValue. |
6538 | 3331 |
warnOldStyle := ParserFlags warnOldStyleAssignment asValue. |
3332 |
warnCommonMistakes := ParserFlags warnCommonMistakes asValue. |
|
3333 |
warnCompatibility := ParserFlags warnPossibleIncompatibilities asValue. |
|
3334 |
warnUnusedVars := ParserFlags warnUnusedVars asValue. |
|
3335 |
allowUnderscore := ParserFlags allowUnderscoreInIdentifier asValue. |
|
3336 |
allowDollar := ParserFlags allowDollarInIdentifier asValue. |
|
17074 | 3337 |
allowParagraph := ParserFlags allowParagraphInIdentifier asValue. |
6538 | 3338 |
allowSqueakExtensions := ParserFlags allowSqueakExtensions asValue. |
3339 |
allowDolphinExtensions := ParserFlags allowDolphinExtensions asValue. |
|
3340 |
allowQualifiedNames := ParserFlags allowQualifiedNames asValue. |
|
3341 |
allowOldStyleAssignment := ParserFlags allowOldStyleAssignment asValue. |
|
3342 |
allowReservedWordsAsSelectors := ParserFlags allowReservedWordsAsSelectors asValue. |
|
3343 |
immutableArrays := ParserFlags arraysAreImmutable asValue. |
|
4244 | 3344 |
|
3345 |
constantFoldingOptions := #( nil #level1 #level2 #full ). |
|
3346 |
constantFolding := SelectionInList new list:(resources array:#('disabled' 'level1 (always safe)' 'level2 (usually safe)' 'full')). |
|
3347 |
constantFolding selectionIndex:3. |
|
3348 |
||
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
3349 |
stcCompilationOptions := #(default never). |
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
3350 |
strings := #('primitive code only' 'never'). |
6538 | 3351 |
idx := (stcCompilationOptions indexOf:(ParserFlags stcCompilation) ifAbsent:1). |
4244 | 3352 |
|
3353 |
stcCompilation := SelectionInList new list:(resources array:strings). |
|
3354 |
stcCompilation selectionIndex:idx. |
|
3355 |
||
3356 |
(supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) |
|
3357 |
ifTrue:[ |
|
9961 | 3358 |
justInTimeCompilation := ObjectMemory justInTimeCompilation. |
3359 |
fullDebugSupport := ObjectMemory fullSingleStepSupport. |
|
4244 | 3360 |
] ifFalse:[ |
9961 | 3361 |
justInTimeCompilation := false. |
11813
4b506523f3bc
lineNumberInfo moved from parser to parserflags
Claus Gittinger <cg@exept.de>
parents:
11684
diff
changeset
|
3362 |
fullDebugSupport := (ParserFlags fullLineNumberInfo) asValue. |
4244 | 3363 |
]. |
3364 |
justInTimeCompilation := justInTimeCompilation asValue. |
|
3365 |
fullDebugSupport := fullDebugSupport asValue. |
|
3366 |
||
3367 |
catchMethodRedefs := Class catchMethodRedefinitions asValue. |
|
3368 |
catchClassRedefs := Class catchClassRedefinitions asValue. |
|
3369 |
historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]]. |
|
3370 |
historyLines ifFalse:[ |
|
9961 | 3371 |
fullHistoryUpdate := false asValue |
4244 | 3372 |
] ifTrue:[ |
9961 | 3373 |
fullHistoryUpdate := HistoryManager fullHistoryUpdate asValue. |
4244 | 3374 |
]. |
3375 |
historyLines := historyLines asValue. |
|
3376 |
||
3377 |
keepSourceOptions := #( keep reference absReference sourceReference discard ). |
|
9303 | 3378 |
keepSource := SelectionInList new |
9961 | 3379 |
list:(resources array:#('Keep as String' 'Reference to Filename' 'Reference to Full Path' 'Append and Ref in `st.src''' 'Discard' )). |
4244 | 3380 |
keepSource selectionIndex:1. |
3381 |
||
3382 |
warnEnabler := [ |
|
9961 | 3383 |
warnings value ifTrue:[ |
3384 |
warnSTXBox enable. |
|
3385 |
warnOldStyleBox enable. |
|
3386 |
warnCommonMistakesBox enable. |
|
3387 |
warnCompatibilityBox enable. |
|
3388 |
warnUnusedVarsBox enable. |
|
11990 | 3389 |
warnUnderscoreBox enabled:allowUnderscore. |
3390 |
warnDollarBox enabled:allowDollar. |
|
17074 | 3391 |
warnParagraphBox enabled:allowParagraph. |
9961 | 3392 |
] ifFalse:[ |
3393 |
warnSTXBox disable. |
|
3394 |
warnUnderscoreBox disable. |
|
3395 |
warnDollarBox disable. |
|
3396 |
warnOldStyleBox disable. |
|
3397 |
warnCommonMistakesBox disable. |
|
3398 |
warnCompatibilityBox disable. |
|
3399 |
warnUnusedVarsBox disable. |
|
17074 | 3400 |
warnParagraphBox disable. |
9961 | 3401 |
]]. |
4244 | 3402 |
|
3403 |
warnings onChangeEvaluate:warnEnabler. |
|
3404 |
allowUnderscore onChangeEvaluate:warnEnabler. |
|
3405 |
allowDollar onChangeEvaluate:warnEnabler. |
|
17074 | 3406 |
allowParagraph onChangeEvaluate:warnEnabler. |
4244 | 3407 |
"/ allowSqueakExtensions onChangeEvaluate:warnEnabler. |
3408 |
"/ allowQualifiedNames onChangeEvaluate:warnEnabler. |
|
3409 |
||
3410 |
box := DialogBox new. |
|
3411 |
box label:(resources string:'Compiler Settings'). |
|
3412 |
||
3413 |
y := box yPosition. |
|
3414 |
check := box addCheckBox:(resources string:'Catch Method Redefinitions') on:catchMethodRedefs. |
|
3415 |
check width:0.5. |
|
3416 |
||
3417 |
box yPosition:y. |
|
3418 |
check := box addCheckBox:(resources string:'Catch Class Redefinitions') on:catchClassRedefs. |
|
3419 |
check left:0.5; width:0.5. |
|
3420 |
||
3421 |
y := box yPosition. |
|
3422 |
check := box addCheckBox:(resources string:'Keep History Line in Methods') on:historyLines. |
|
3423 |
check width:0.5. |
|
3424 |
HistoryManager isNil ifTrue:[check disable]. |
|
3425 |
box yPosition:y. |
|
3426 |
check := box addCheckBox:(resources string:'Keep Full Class History') on:fullHistoryUpdate. |
|
3427 |
check left:0.5; width:0.5. |
|
3428 |
HistoryManager isNil ifTrue:[check disable] ifFalse:[check enableChannel:historyLines]. |
|
3429 |
||
3430 |
box addPopUpList:(resources string:'FileIn Source Mode:') on:keepSource. |
|
3431 |
keepSource selectionIndex:( keepSourceOptions indexOf:(ClassCategoryReader sourceMode) ifAbsent:1). |
|
3432 |
||
3433 |
box addHorizontalLine. |
|
3434 |
||
3435 |
box addCheckBox:(resources string:'Lazy Compilation when Autoloading') on:compileLazy. |
|
3436 |
check := box addCheckBox:(resources string:'If Present, Load Binary Objects when Autoloading') on:loadBinaries. |
|
3437 |
canLoadBinaries ifFalse:[ |
|
9961 | 3438 |
loadBinaries value:false. |
3439 |
check disable |
|
4244 | 3440 |
]. |
3441 |
supportsJustInTimeCompilation ifTrue:[ |
|
9961 | 3442 |
component := box |
3443 |
addCheckBox:(resources string:'Just in Time Compilation to Machine Code') |
|
3444 |
on:justInTimeCompilation. |
|
4244 | 3445 |
]. |
3446 |
||
3447 |
box addHorizontalLine. |
|
3448 |
||
3449 |
ObjectFileLoader notNil ifTrue:[ |
|
9961 | 3450 |
compilationList := box addPopUpList:(resources string:'Stc Compilation to Machine Code') on:stcCompilation. |
3451 |
stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:1). |
|
3452 |
stcSetupButt := box addComponent:(Button label:(resources string:'Stc Compilation Parameters...') |
|
3453 |
action:[|manager| |
|
3454 |
||
3455 |
self stcCompilerSettings. |
|
3456 |
]). |
|
3457 |
||
3458 |
box addHorizontalLine. |
|
3459 |
||
3460 |
"/ if there is no compiler around, |
|
3461 |
"/ change to compile nothing, and disable the checkBoxes |
|
3462 |
Compiler canCreateMachineCode ifFalse:[ |
|
3463 |
stcCompilation selectionIndex:(3 min:stcCompilationOptions size). |
|
3464 |
compilationList disable. |
|
3465 |
]. |
|
4244 | 3466 |
]. |
3467 |
||
3468 |
y := box yPosition. |
|
3469 |
||
3470 |
component := box addCheckBox:(resources string:'Allow Underscore in Identifiers') on:allowUnderscore. |
|
3471 |
component width:0.4. |
|
3472 |
||
3473 |
component := box addCheckBox:(resources string:'Allow Dollar in Identifiers') on:allowDollar. |
|
3474 |
component width:0.4. |
|
3475 |
||
17074 | 3476 |
component := box addCheckBox:(resources string:'Allow Paragraph in Identifiers') on:allowParagraph. |
3477 |
component width:0.4. |
|
3478 |
||
4244 | 3479 |
component := box addCheckBox:(resources string:'Allow VW3 QualifiedNames') on:allowQualifiedNames. |
3480 |
component width:0.4. |
|
3481 |
||
3482 |
component := box addCheckBox:(resources string:'Allow Squeak Extensions') on:allowSqueakExtensions. |
|
3483 |
component width:0.4. |
|
3484 |
||
3485 |
component := box addCheckBox:(resources string:'Allow Dolphin Extensions') on:allowDolphinExtensions. |
|
3486 |
component width:0.4. |
|
3487 |
||
3488 |
y2 := box yPosition. |
|
3489 |
||
3490 |
box yPosition:y. |
|
3491 |
box leftIndent:0. |
|
3492 |
||
3493 |
component :=box addPopUpList:(resources string:'Constant Folding:') on:constantFolding. |
|
3494 |
component superView left:0.5; width:0.5. |
|
3495 |
constantFolding selectionIndex:( constantFoldingOptions indexOf:(Compiler foldConstants) ifAbsent:1). |
|
3496 |
||
3497 |
component := box addCheckBox:(resources string:'Allow OldStyle Assignment (_)') on:allowOldStyleAssignment. |
|
3498 |
component left:0.5; width:0.4. |
|
3499 |
||
3500 |
component := box addCheckBox:(resources string:'Allow Reserved Words as Selector (self)') on:allowReservedWordsAsSelectors. |
|
3501 |
component left:0.5; width:0.4. |
|
3502 |
||
3503 |
component := box addCheckBox:(resources string:'Full Debug Info') on:fullDebugSupport. |
|
3504 |
component left:0.5; width:0.4. |
|
3505 |
||
3506 |
component := box addCheckBox:(resources string:'Literal Arrays are Immutable') on:immutableArrays. |
|
3507 |
component left:0.5; width:0.4. |
|
3508 |
||
3509 |
box yPosition:(box yPosition max:y2). |
|
3510 |
||
3511 |
||
3512 |
box addHorizontalLine. |
|
3513 |
||
3514 |
box addCheckBox:(resources string:'Warnings') on:warnings. |
|
3515 |
"/ box addVerticalSpace. |
|
3516 |
oldIndent := box leftIndent. |
|
3517 |
box leftIndent:30. |
|
3518 |
||
3519 |
y := box yPosition. |
|
3520 |
||
3521 |
warnSTXBox := box addCheckBox:(resources string:'ST/X Extensions') on:warnSTX. |
|
3522 |
warnSTXBox width:0.4. |
|
3523 |
||
3524 |
warnUnderscoreBox := box addCheckBox:(resources string:'Underscores in Identifiers') on:warnUnderscore. |
|
3525 |
warnUnderscoreBox width:0.4. |
|
3526 |
||
3527 |
warnDollarBox := box addCheckBox:(resources string:'Dollars in Identifiers') on:warnDollar. |
|
3528 |
warnDollarBox width:0.4. |
|
3529 |
||
17074 | 3530 |
warnParagraphBox := box addCheckBox:(resources string:'Paragraphs in Identifiers') on:warnParagraph. |
3531 |
warnParagraphBox width:0.4. |
|
3532 |
||
4244 | 3533 |
warnUnusedVarsBox := box addCheckBox:(resources string:'Unused Method Variables') on:warnUnusedVars. |
3534 |
warnUnusedVarsBox width:0.4. |
|
3535 |
||
3536 |
yMax := box yPosition. |
|
3537 |
||
3538 |
box yPosition:y. |
|
3539 |
box leftIndent:0. |
|
3540 |
warnOldStyleBox := box addCheckBox:(resources string:'OldStyle Assignment') on:warnOldStyle. |
|
3541 |
warnOldStyleBox left:0.5; width:0.4. |
|
3542 |
||
3543 |
warnCommonMistakesBox := box addCheckBox:(resources string:'Common Mistakes') on:warnCommonMistakes. |
|
3544 |
warnCommonMistakesBox left:0.5; width:0.4. |
|
3545 |
||
3546 |
warnCompatibilityBox := box addCheckBox:(resources string:'Possible Incompatibilities') on:warnCompatibility. |
|
3547 |
warnCompatibilityBox left:0.5; width:0.4. |
|
3548 |
||
3549 |
box leftIndent:oldIndent. |
|
3550 |
box yPosition:(yMax max: box yPosition). |
|
3551 |
||
3552 |
box addHorizontalLine. |
|
9303 | 3553 |
box |
9961 | 3554 |
addHelpButtonFor:'Launcher/compilerSettings.html'; |
3555 |
addAbortAndOkButtons. |
|
4244 | 3556 |
|
3557 |
warnEnabler value. |
|
3558 |
box open. |
|
3559 |
||
3560 |
box accepted ifTrue:[ |
|
9961 | 3561 |
HistoryManager notNil ifTrue:[ |
3562 |
HistoryManager fullHistoryUpdate:fullHistoryUpdate value. |
|
3563 |
historyLines value ifTrue:[ |
|
3564 |
HistoryManager activate |
|
3565 |
] ifFalse:[ |
|
3566 |
HistoryManager deactivate |
|
3567 |
]. |
|
3568 |
]. |
|
3569 |
Class catchMethodRedefinitions:catchMethodRedefs value. |
|
3570 |
Class catchClassRedefinitions:catchClassRedefs value. |
|
3571 |
ClassCategoryReader sourceMode:(keepSourceOptions at:keepSource selectionIndex). |
|
3572 |
Compiler warnings:warnings value. |
|
3573 |
Compiler warnSTXSpecials:warnSTX value. |
|
3574 |
Compiler warnOldStyleAssignment:warnOldStyle value. |
|
3575 |
Compiler warnUnderscoreInIdentifier:warnUnderscore value. |
|
3576 |
Compiler warnDollarInIdentifier:warnDollar value. |
|
3577 |
Compiler warnCommonMistakes:warnCommonMistakes value. |
|
3578 |
Compiler warnPossibleIncompatibilities:warnCompatibility value. |
|
3579 |
Compiler warnUnusedVars:warnUnusedVars value. |
|
3580 |
Compiler allowUnderscoreInIdentifier:allowUnderscore value. |
|
3581 |
Compiler allowDollarInIdentifier:allowDollar value. |
|
3582 |
Compiler allowSqueakExtensions:allowSqueakExtensions value. |
|
3583 |
Compiler allowDolphinExtensions:allowDolphinExtensions value. |
|
3584 |
Compiler allowQualifiedNames:allowQualifiedNames value. |
|
3585 |
Compiler allowOldStyleAssignment:allowOldStyleAssignment value. |
|
3586 |
Compiler allowReservedWordsAsSelectors:allowReservedWordsAsSelectors value. |
|
3587 |
||
3588 |
Compiler arraysAreImmutable:immutableArrays value. |
|
11813
4b506523f3bc
lineNumberInfo moved from parser to parserflags
Claus Gittinger <cg@exept.de>
parents:
11684
diff
changeset
|
3589 |
ParserFlags lineNumberInfo:(fullDebugSupport value ifTrue:[#full] ifFalse:[true]). |
9961 | 3590 |
|
3591 |
ParserFlags stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex). |
|
3592 |
Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex). |
|
3593 |
||
3594 |
supportsJustInTimeCompilation ifTrue:[ |
|
3595 |
justInTimeCompilation := justInTimeCompilation value. |
|
3596 |
justInTimeCompilation ifTrue:[ |
|
3597 |
Smalltalk allMethodsDo:[:m | m checked:false]. |
|
3598 |
]. |
|
3599 |
ObjectMemory justInTimeCompilation:justInTimeCompilation. |
|
3600 |
ObjectMemory fullSingleStepSupport:fullDebugSupport value. |
|
3601 |
]. |
|
3602 |
Autoload compileLazy:compileLazy value. |
|
3603 |
Smalltalk loadBinaries:loadBinaries value. |
|
4244 | 3604 |
]. |
3605 |
box destroy |
|
3606 |
||
4386 | 3607 |
" |
3608 |
self compilerSettings |
|
3609 |
" |
|
11813
4b506523f3bc
lineNumberInfo moved from parser to parserflags
Claus Gittinger <cg@exept.de>
parents:
11684
diff
changeset
|
3610 |
|
4b506523f3bc
lineNumberInfo moved from parser to parserflags
Claus Gittinger <cg@exept.de>
parents:
11684
diff
changeset
|
3611 |
"Modified: / 10-09-1995 / 19:19:18 / claus" |
4b506523f3bc
lineNumberInfo moved from parser to parserflags
Claus Gittinger <cg@exept.de>
parents:
11684
diff
changeset
|
3612 |
"Modified: / 09-09-1996 / 22:42:47 / stefan" |
17074 | 3613 |
"Modified: / 16-11-2016 / 22:37:24 / cg" |
4244 | 3614 |
! |
3615 |
||
3616 |
displaySettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3617 |
"open a dialog on display related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3618 |
Obsoleted by the settings application." |
4244 | 3619 |
|
3620 |
|box listOfSizes sizeInfos |
|
3621 |
sizes sizeNames sizeList sizeX sizeY deepIcons |
|
3622 |
isColorMonitor useFixPalette useFixGrayPalette idx ditherStyles ditherSyms ditherList |
|
3623 |
y component screen visual clipEncodings clipEncodingSyms clipEncodingList resources |
|
3624 |
| |
|
3625 |
||
3626 |
resources := self owningClass classResources. |
|
3627 |
||
3628 |
listOfSizes := resources at:'LIST_OF_OFFERED_SCREEN_SIZES' default:#default. |
|
3629 |
listOfSizes == #default ifTrue:[ |
|
9961 | 3630 |
"/ nothing in resource file; offer at least some. |
3631 |
sizeInfos := #( |
|
3632 |
( '11.3'' (235mm x 175mm) LCD' (235 175) ) |
|
3633 |
( '17'' (325mm x 245mm)' (325 245) ) |
|
3634 |
( '19'' (340mm x 270mm)' (340 270) ) |
|
3635 |
( '20'' (350mm x 280mm)' (350 280) ) |
|
3636 |
( '21'' (365mm x 285mm)' (365 285) ) |
|
3637 |
). |
|
4244 | 3638 |
] ifFalse:[ |
9961 | 3639 |
sizeInfos := resources array:listOfSizes. |
4244 | 3640 |
]. |
3641 |
sizeNames := sizeInfos collect:[:entry | entry at:1]. |
|
3642 |
sizes := sizeInfos collect:[:entry | entry at:2]. |
|
3643 |
||
3644 |
screen := Screen current. |
|
3645 |
visual := screen visualType. |
|
3646 |
||
3647 |
isColorMonitor := screen hasColors asValue. |
|
3648 |
deepIcons := screen supportsDeepIcons asValue. |
|
3649 |
useFixPalette := screen fixColors notNil asValue. |
|
3650 |
useFixGrayPalette := screen fixGrayColors notNil asValue. |
|
3651 |
||
3652 |
sizeList := SelectionInList with:sizeNames. |
|
3653 |
sizeX := screen widthInMillimeter asValue. |
|
3654 |
sizeY := screen heightInMillimeter asValue. |
|
3655 |
||
3656 |
clipEncodingSyms := #(nil #iso8859 #jis #jis7 #sjis #euc #big5). |
|
3657 |
clipEncodings := resources array:#('untranslated' 'iso8859' 'jis' 'jis7' 'shift-JIS' 'EUC' 'big5'). |
|
3658 |
clipEncodingList := SelectionInList new. |
|
3659 |
clipEncodingList list:clipEncodings. |
|
6036
826c4d2271b3
Unify naming: clipBoard->clipboard
Stefan Vogel <sv@exept.de>
parents:
6032
diff
changeset
|
3660 |
clipEncodingList selectionIndex:(clipEncodingSyms indexOf:screen clipboardEncoding ifAbsent:1). |
4244 | 3661 |
|
3662 |
ditherList := SelectionInList new. |
|
3663 |
||
3664 |
(visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[ |
|
9961 | 3665 |
ditherStyles := #('threshold' 'ordered dither' 'error diffusion'). |
3666 |
ditherSyms := #(threshold ordered floydSteinberg). |
|
4244 | 3667 |
] ifFalse:[ |
9961 | 3668 |
visual ~~ #TrueColor ifTrue:[ |
3669 |
ditherStyles := #('nearest color' 'error diffusion'). |
|
3670 |
ditherSyms := #(ordered floydSteinberg). |
|
3671 |
] |
|
9303 | 3672 |
]. |
3673 |
ditherSyms notNil ifTrue:[ |
|
9961 | 3674 |
ditherList list:ditherStyles. |
3675 |
ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold). |
|
4244 | 3676 |
]. |
3677 |
||
3678 |
box := DialogBox new. |
|
3679 |
box label:(resources string:'Display Screen Settings'). |
|
3680 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
3681 |
box addTextLabel:(resources string:'Actual Visible Screen Area:') adjust:#left. |
4244 | 3682 |
|
3683 |
(box addPopUpList:(resources string:'Common Sizes:') on:sizeList) |
|
9961 | 3684 |
label:'monitor size'. |
4244 | 3685 |
|
3686 |
idx := sizes findFirst:[:entry | |
|
9961 | 3687 |
((entry at:1) = sizeX value) |
3688 |
and:[((entry at:2) = sizeY value)] |
|
3689 |
]. |
|
4244 | 3690 |
idx ~~ 0 ifTrue:[ |
9961 | 3691 |
sizeList selectionIndex:idx |
4244 | 3692 |
]. |
3693 |
||
3694 |
sizeList onChangeEvaluate:[ |
|
9961 | 3695 |
|idx| |
3696 |
||
3697 |
idx := sizeList selectionIndex. |
|
3698 |
sizeX value:((sizes at:idx) at:1). |
|
3699 |
sizeY value:((sizes at:idx) at:2). |
|
3700 |
]. |
|
4244 | 3701 |
|
3702 |
y := box yPosition. |
|
3703 |
component := box addTextLabel:(resources string:'Screen Size:'). |
|
3704 |
component width:0.3; adjust:#right; borderWidth:0. |
|
3705 |
||
3706 |
box yPosition:y. |
|
3707 |
component := box addInputFieldOn:nil tabable:true. |
|
9303 | 3708 |
component width:0.25; left:0.3; |
9961 | 3709 |
immediateAccept:false; acceptOnLeave:false; |
3710 |
cursorMovementWhenUpdating:#beginOfLine; |
|
3711 |
converter:(PrintConverter new initForInteger); |
|
3712 |
model:sizeX. |
|
4244 | 3713 |
|
3714 |
box yPosition:y. |
|
3715 |
component := box addTextLabel:(' x '). |
|
3716 |
component width:0.1; left:0.55; adjust:#center; borderWidth:0. |
|
3717 |
||
3718 |
box yPosition:y. |
|
3719 |
component := box addInputFieldOn:nil tabable:true. |
|
9303 | 3720 |
component width:0.25; left:0.65; |
9961 | 3721 |
immediateAccept:false; acceptOnLeave:false; |
3722 |
cursorMovementWhenUpdating:#beginOfLine; |
|
3723 |
converter:(PrintConverter new initForInteger); |
|
3724 |
model:sizeY. |
|
4244 | 3725 |
|
3726 |
box yPosition:y. |
|
3727 |
component := box addTextLabel:('(mm)'). |
|
3728 |
component width:0.1; left:0.9; adjust:#center; borderWidth:0. |
|
3729 |
||
3730 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3731 |
||
3732 |
(box addTextLabel:(resources string:'Screen: Depth: %1 Visual: %2 (%3)' |
|
9961 | 3733 |
with:screen depth printString |
3734 |
with:screen visualType |
|
3735 |
with:screen serverVendor)) |
|
3736 |
adjust:#left. |
|
4244 | 3737 |
|
3738 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3739 |
||
3740 |
box addCheckBox:(resources string:'Color Monitor') on:isColorMonitor. |
|
3741 |
||
3742 |
visual == #PseudoColor ifTrue:[ |
|
9961 | 3743 |
box addVerticalSpace. |
3744 |
component := box addCheckBox:(resources string:'Use Fix Color Palette %1' with:'(4x8x4)') on:useFixPalette. |
|
3745 |
||
3746 |
box addVerticalSpace. |
|
3747 |
component := box addCheckBox:(resources string:'Use Fix Gray Color Palette %1' with:'(32)') on:useFixGrayPalette. |
|
4244 | 3748 |
]. |
3749 |
||
3750 |
ditherSyms notNil ifTrue:[ |
|
9961 | 3751 |
box addVerticalSpace. |
3752 |
component := box addPopUpList:(resources string:'Image Display:') on:ditherList. |
|
3753 |
component defaultLabel:'image display'. |
|
3754 |
component superView horizontalLayout:#leftSpace. |
|
4244 | 3755 |
]. |
3756 |
||
3757 |
box addVerticalSpace. |
|
3758 |
box addCheckBox:(resources string:'Allow Colored/Grayscale Icons') on:deepIcons. |
|
3759 |
||
3760 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3761 |
||
3762 |
component := box addPopUpList:(resources string:'ClipBoard Encoding:') on:clipEncodingList. |
|
3763 |
component superView horizontalLayout:#leftSpace. |
|
3764 |
||
3765 |
box addHorizontalLine. |
|
9303 | 3766 |
box |
9961 | 3767 |
addHelpButtonFor:'Launcher/screenSettings.html'; |
3768 |
addAbortAndOkButtons. |
|
4244 | 3769 |
box open. |
3770 |
||
3771 |
box accepted ifTrue:[ |
|
9961 | 3772 |
Image flushDeviceImages. |
3773 |
||
3774 |
screen visualType == #PseudoColor ifTrue:[ |
|
3775 |
useFixPalette value ifTrue:[ |
|
3776 |
Color colorAllocationFailSignal handle:[:ex | |
|
3777 |
self warn:'Could not allocate colors.'. |
|
3778 |
] do:[ |
|
3779 |
Color getColorsRed:4 green:8 blue:4 on:screen |
|
3780 |
] |
|
3781 |
] ifFalse:[ |
|
3782 |
screen releaseFixColors |
|
3783 |
]. |
|
3784 |
||
3785 |
useFixGrayPalette value ifTrue:[ |
|
3786 |
Color colorAllocationFailSignal handle:[:ex | |
|
3787 |
self warn:'Could not allocate colors.'. |
|
3788 |
] do:[ |
|
3789 |
Color getGrayColors:32 on:screen |
|
3790 |
] |
|
3791 |
] ifFalse:[ |
|
3792 |
screen releaseFixGrayColors |
|
3793 |
] |
|
3794 |
]. |
|
3795 |
screen hasColors:isColorMonitor value. |
|
3796 |
screen widthInMillimeter:sizeX value. |
|
3797 |
screen heightInMillimeter:sizeY value. |
|
3798 |
||
3799 |
screen supportsDeepIcons:deepIcons value. |
|
3800 |
ditherSyms notNil ifTrue:[ |
|
3801 |
Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex). |
|
3802 |
]. |
|
3803 |
||
3804 |
WindowGroup activeGroup withWaitCursorDo:[ |
|
3805 |
View defaultStyle:(View defaultStyle). |
|
3806 |
]. |
|
3807 |
||
3808 |
screen clipboardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex). |
|
4244 | 3809 |
]. |
3810 |
box destroy |
|
3811 |
||
3812 |
"Modified: / 9.9.1996 / 22:43:04 / stefan" |
|
3813 |
"Modified: / 20.5.1999 / 18:35:21 / cg" |
|
3814 |
! |
|
3815 |
||
3816 |
editSettings |
|
3817 |
"open a dialog on edit settings" |
|
8421 | 3818 |
"OBSOLETE - this functionality is no longer used - see AbstractSettingsApplication" |
4244 | 3819 |
|
9303 | 3820 |
|box st80EditMode st80SelectMode resources |
14682
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3821 |
tabsIs4 prevTabsIs4 searchDialogIsModal startTextDragWithControl |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3822 |
currentPrefs| |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3823 |
|
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3824 |
currentPrefs := UserPreferences current. |
4244 | 3825 |
resources := self owningClass classResources. |
3826 |
||
9303 | 3827 |
"/ |
4244 | 3828 |
"/ extract relevant system settings ... |
3829 |
"/ |
|
14682
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3830 |
st80EditMode := currentPrefs st80EditMode asValue. |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3831 |
st80SelectMode := currentPrefs st80SelectMode asValue. |
4244 | 3832 |
prevTabsIs4 := (ListView userDefaultTabPositions = ListView tab4Positions). |
3833 |
tabsIs4 := prevTabsIs4 asValue. |
|
14682
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3834 |
searchDialogIsModal := currentPrefs searchDialogIsModal asValue. |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3835 |
startTextDragWithControl := currentPrefs startTextDragWithControl asValue. |
4244 | 3836 |
|
3837 |
"/ |
|
3838 |
"/ create a box on those values ... |
|
3839 |
"/ |
|
3840 |
box := DialogBox new. |
|
3841 |
box label:(resources string:'Edit settings'). |
|
3842 |
||
6806 | 3843 |
box addCheckBox:(resources string:'Cursor has ST80 Line-end Behavior') on:st80EditMode. |
3844 |
box addCheckBox:(resources string:'Double Click Select Behavior as in ST80') on:st80SelectMode. |
|
4244 | 3845 |
box addCheckBox:(resources string:'Tab Stops in Multiples of 4') on:tabsIs4. |
3846 |
box addCheckBox:(resources string:'SearchBox is Modal') on:searchDialogIsModal. |
|
3847 |
box addCheckBox:(resources string:'CTRL-Key to Start TextDrag') on:startTextDragWithControl. |
|
3848 |
||
3849 |
box addHorizontalLine. |
|
3850 |
||
9303 | 3851 |
box |
9961 | 3852 |
addHelpButtonFor:'Launcher/editSettings.html'; |
3853 |
addAbortAndOkButtons. |
|
4244 | 3854 |
|
3855 |
"/ |
|
3856 |
"/ show the box ... |
|
3857 |
"/ |
|
3858 |
box open. |
|
3859 |
||
3860 |
"/ |
|
3861 |
"/ update system settings |
|
3862 |
"/ |
|
3863 |
box accepted ifTrue:[ |
|
14682
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3864 |
currentPrefs st80EditMode:(st80EditMode value). |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3865 |
currentPrefs st80SelectMode:(st80SelectMode value). |
9961 | 3866 |
tabsIs4 value ~~ prevTabsIs4 ifTrue:[ |
3867 |
ListView userDefaultTabPositions:(tabsIs4 value |
|
3868 |
ifTrue:[ListView tab4Positions] |
|
3869 |
ifFalse:[ListView tab8Positions]). |
|
3870 |
ListView allSubInstancesDo:[:eachKindOfListView | |
|
3871 |
tabsIs4 value |
|
3872 |
ifTrue:[eachKindOfListView setTab4] |
|
3873 |
ifFalse:[eachKindOfListView setTab8] |
|
3874 |
]. |
|
3875 |
]. |
|
14682
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3876 |
currentPrefs searchDialogIsModal:searchDialogIsModal value. |
debfdc71c71f
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14571
diff
changeset
|
3877 |
currentPrefs startTextDragWithControl:startTextDragWithControl value. |
4244 | 3878 |
]. |
3879 |
box destroy |
|
3880 |
||
6806 | 3881 |
"Created: / 06-01-1999 / 14:12:09 / cg" |
3882 |
"Modified: / 03-07-2006 / 16:35:03 / cg" |
|
4244 | 3883 |
! |
3884 |
||
3885 |
fontSettingsFor:requestor |
|
3886 |
"open a dialog on font related settings" |
|
3887 |
||
3888 |
(self fontBoxForEncoding:nil) ifTrue:[ |
|
9961 | 3889 |
requestor reopenLauncher. |
3741
a9d08a1b0d7d
Fix save settings dialog when called with Filename arg
Stefan Vogel <sv@exept.de>
parents:
3738
diff
changeset
|
3890 |
] |
4398 | 3891 |
" |
3892 |
self fontSettingsFor:nil |
|
3893 |
" |
|
4244 | 3894 |
"Created: 26.2.1996 / 22:52:51 / cg" |
3895 |
"Modified: 8.1.1997 / 14:52:49 / cg" |
|
3896 |
! |
|
3897 |
||
3898 |
javaSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3899 |
"open a dialog on settings related to the java subsystem. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
3900 |
Obsoleted by the settings application." |
4244 | 3901 |
|
3902 |
|box audio javaHome classPath oldJavaHome oldClassPath resources component |
|
3903 |
extraFileSecurityChecks extraSocketSecurityChecks |
|
9303 | 3904 |
supportsJustInTimeCompilation |
4244 | 3905 |
javaJustInTimeCompilation javaNativeCodeOptimization |
3906 |
showJavaByteCode exceptionDebug nullPointerExceptionDebug pathSep| |
|
3907 |
||
3908 |
resources := self owningClass classResources. |
|
3909 |
||
3910 |
audio := JavaVM audioEnabled asValue. |
|
3911 |
extraFileSecurityChecks := JavaVM fileOpenConfirmation asValue. |
|
3912 |
extraSocketSecurityChecks := JavaVM socketConnectConfirmation asValue. |
|
3913 |
(supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[ |
|
9961 | 3914 |
javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue. |
3915 |
javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue. |
|
4244 | 3916 |
] ifFalse:[ |
9961 | 3917 |
javaJustInTimeCompilation := javaNativeCodeOptimization := false |
4244 | 3918 |
]. |
3919 |
showJavaByteCode := JavaMethod forceByteCodeDisplay asValue. |
|
3920 |
exceptionDebug := JavaVM exceptionDebug asValue. |
|
3921 |
nullPointerExceptionDebug := JavaVM nullPointerExceptionDebug asValue. |
|
3922 |
||
3923 |
classPath := (Java classPath ? ''). |
|
3924 |
OperatingSystem isUNIXlike ifTrue:[ |
|
9961 | 3925 |
pathSep := $;. |
4244 | 3926 |
] ifFalse:[ |
9961 | 3927 |
pathSep := $:. |
4244 | 3928 |
]. |
3929 |
classPath := (classPath asStringWith:pathSep) asValue. |
|
3930 |
oldClassPath := classPath copy. |
|
3931 |
classPath := classPath asValue. |
|
3932 |
||
3933 |
javaHome := (Java javaHome ? ''). |
|
3934 |
oldJavaHome := javaHome copy. |
|
3935 |
javaHome := javaHome asValue. |
|
3936 |
||
3937 |
box := DialogBox new. |
|
3938 |
box label:(resources string:'Java'). |
|
3939 |
||
3940 |
box addCheckBox:(resources string:'Audio Enabled') on:audio. |
|
3941 |
box addCheckBox:(resources string:'Confirm file open for write') on:extraFileSecurityChecks. |
|
3942 |
box addCheckBox:(resources string:'Confirm socket connect') on:extraSocketSecurityChecks. |
|
3943 |
box addCheckBox:(resources string:'Debug Exceptions') on:exceptionDebug. |
|
3944 |
box addCheckBox:(resources string:'Debug Null Pointer Exceptions') on:nullPointerExceptionDebug. |
|
3945 |
box addHorizontalLine. |
|
3946 |
supportsJustInTimeCompilation ifTrue:[ |
|
9961 | 3947 |
box |
3948 |
addCheckBox:(resources string:'java just in time compilation to machine code') |
|
3949 |
on:javaJustInTimeCompilation. |
|
3950 |
box |
|
3951 |
addCheckBox:(resources string:'optimize native code') |
|
3952 |
on:javaNativeCodeOptimization. |
|
4244 | 3953 |
]. |
3954 |
box addHorizontalLine. |
|
3955 |
box addCheckBox:(resources string:'Display java byteCode (i.e. not source)') on:showJavaByteCode. |
|
3956 |
box addHorizontalLine. |
|
9303 | 3957 |
component := box |
9961 | 3958 |
addLabelledInputField:(resources string:'classPath:') |
3959 |
adjust:#right |
|
3960 |
on:classPath |
|
3961 |
tabable:true |
|
3962 |
separateAtX:0.3. |
|
4244 | 3963 |
component acceptOnLeave:false. |
9303 | 3964 |
component := box |
9961 | 3965 |
addLabelledInputField:(resources string:'java home:') |
3966 |
adjust:#right |
|
3967 |
on:javaHome |
|
3968 |
tabable:true |
|
3969 |
separateAtX:0.3. |
|
4244 | 3970 |
component acceptOnLeave:false. |
3971 |
||
3972 |
box addVerticalSpace. |
|
9303 | 3973 |
box addComponent:(Button |
9961 | 3974 |
label:(resources string:'Reinit VM now') |
3975 |
action:[ |
|
3976 |
box windowGroup withWaitCursorDo:[ |
|
4244 | 3977 |
"/ Java classPath size == 0 ifTrue:[ |
3978 |
"/ Java initialize. |
|
3979 |
"/ ]. |
|
3980 |
"/ Java classPath size == 0 ifTrue:[ |
|
3981 |
"/ self warn:'No JDK found'. |
|
3982 |
"/ ] ifFalse:[ |
|
9961 | 3983 |
JavaVM initializeVM |
4244 | 3984 |
"/ ] |
9961 | 3985 |
] |
3986 |
]). |
|
9303 | 3987 |
|
3988 |
box addComponent:(Button |
|
9961 | 3989 |
label:(resources string:'Remove all Java classes now') |
3990 |
action:[ |
|
3991 |
box windowGroup withWaitCursorDo:[ |
|
3992 |
Java flushAllJavaResources |
|
3993 |
] |
|
3994 |
]). |
|
4244 | 3995 |
|
3996 |
"/ box addHorizontalLine. |
|
3997 |
||
3998 |
"/ box addHelpButtonFor:'Launcher/javaSettings.html'. |
|
3999 |
box addAbortAndOkButtons. |
|
4000 |
box open. |
|
4001 |
||
4002 |
box accepted ifTrue:[ |
|
9961 | 4003 |
classPath value ~= oldClassPath ifTrue:[ |
4004 |
OperatingSystem isUNIXlike ifTrue:[ |
|
4005 |
classPath := (classPath value asCollectionOfSubstringsSeparatedBy:$:) |
|
4006 |
] ifFalse:[ |
|
4007 |
classPath := (classPath value asCollectionOfSubstringsSeparatedBy:$;) |
|
4008 |
]. |
|
4009 |
Java classPath:classPath |
|
4010 |
]. |
|
4011 |
Java javaHome:javaHome value. |
|
4012 |
||
4013 |
JavaMethod forceByteCodeDisplay:showJavaByteCode value. |
|
4014 |
JavaVM audioEnabled:audio value. |
|
4015 |
JavaVM exceptionDebug:exceptionDebug value. |
|
4016 |
JavaVM nullPointerExceptionDebug:nullPointerExceptionDebug value. |
|
4017 |
JavaVM fileOpenConfirmation: extraFileSecurityChecks value. |
|
4018 |
JavaVM socketConnectConfirmation: extraSocketSecurityChecks value. |
|
4019 |
||
4020 |
javaJustInTimeCompilation value ~~ ObjectMemory javaJustInTimeCompilation ifTrue:[ |
|
4021 |
ObjectMemory javaJustInTimeCompilation:javaJustInTimeCompilation value. |
|
4022 |
javaJustInTimeCompilation value ifTrue:[ |
|
4023 |
JavaMethod allSubInstancesDo:[:m | m checked:false]. |
|
4024 |
]. |
|
4025 |
]. |
|
4026 |
javaNativeCodeOptimization value ~~ ObjectMemory javaNativeCodeOptimization ifTrue:[ |
|
4027 |
ObjectMemory javaNativeCodeOptimization:javaNativeCodeOptimization value. |
|
4028 |
]. |
|
4244 | 4029 |
]. |
4030 |
box destroy |
|
4398 | 4031 |
" |
4032 |
self javaSettings |
|
4033 |
" |
|
4244 | 4034 |
"Created: / 18.7.1998 / 22:32:58 / cg" |
4035 |
"Modified: / 27.1.1999 / 20:16:03 / cg" |
|
4036 |
! |
|
4037 |
||
9303 | 4038 |
keyboardSettings |
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4039 |
"open a dialog on keyboard related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4040 |
Obsoleted by the settings application" |
4244 | 4041 |
|
4042 |
|mappings listOfRawKeys listOfFunctions |
|
4043 |
box l |
|
9303 | 4044 |
list1 list2 listView1 listView2 |
4244 | 4045 |
frame selectionForwarder macroForwarder macroTextView y resources| |
4046 |
||
4047 |
resources := self owningClass classResources. |
|
4048 |
||
4049 |
mappings := Screen current keyboardMap. |
|
4050 |
||
13882 | 4051 |
listOfRawKeys := (mappings keys collect:[:key | key asString] as:Array) sort. |
4052 |
listOfFunctions := (mappings values asSet collect:[:key | key asString] as:Array) sort. |
|
4244 | 4053 |
|
4054 |
selectionForwarder := Plug new. |
|
4055 |
selectionForwarder respondTo:#showFunction |
|
9961 | 4056 |
with:[ |
4057 |
|raw| |
|
4058 |
raw := list1 selection. |
|
4059 |
list2 retractInterestsFor:selectionForwarder. |
|
4060 |
list2 selection:(mappings at:raw asSymbol) asString. |
|
4061 |
list2 onChangeSend:#showRawKey to:selectionForwarder. |
|
4062 |
]. |
|
4244 | 4063 |
selectionForwarder respondTo:#showRawKey |
9961 | 4064 |
with:[ |
4065 |
|f raw| |
|
4066 |
||
4067 |
f := list2 selection. |
|
4068 |
list1 retractInterestsFor:selectionForwarder. |
|
4069 |
raw := mappings keyAtValue:f asString. |
|
4070 |
raw isNil ifTrue:[ |
|
4071 |
raw := mappings keyAtValue:f first. |
|
4072 |
raw isNil ifTrue:[ |
|
4073 |
raw := mappings keyAtValue:f asSymbol. |
|
4074 |
] |
|
4075 |
]. |
|
4076 |
list1 selection:raw. |
|
4077 |
list1 onChangeSend:#showFunction to:selectionForwarder. |
|
4078 |
]. |
|
4244 | 4079 |
|
4080 |
macroForwarder := [ |
|
9961 | 4081 |
|f macro indent| |
4082 |
f := list2 selection. |
|
4083 |
(f startsWith:'Cmd') ifTrue:[ |
|
4084 |
f := f copyFrom:4 |
|
4085 |
]. |
|
4086 |
macro := UserPreferences current functionKeySequences |
|
4087 |
at:(f asSymbol) ifAbsent:nil. |
|
4088 |
macro notNil ifTrue:[ |
|
4089 |
macro := macro asStringCollection. |
|
4090 |
indent := macro |
|
4091 |
inject:99999 into:[:min :element | |
|
4092 |
|stripped| |
|
4093 |
||
4094 |
stripped := element withoutLeadingSeparators. |
|
4095 |
stripped isEmpty ifTrue:[ |
|
4096 |
min |
|
4097 |
] ifFalse:[ |
|
4098 |
min min:(element size - stripped size) |
|
4099 |
] |
|
4100 |
]. |
|
4101 |
indent ~~ 0 ifTrue:[ |
|
4102 |
macro := macro collect:[:line | |
|
4103 |
line size > indent ifTrue:[ |
|
4104 |
line copyFrom:indent+1 |
|
4105 |
] ifFalse:[ |
|
4106 |
line |
|
4107 |
]. |
|
4108 |
] |
|
4109 |
]. |
|
4110 |
]. |
|
4111 |
macroTextView contents:macro. |
|
4112 |
]. |
|
4244 | 4113 |
|
4114 |
list1 := SelectionInList with:listOfRawKeys. |
|
4115 |
list1 onChangeSend:#showFunction to:selectionForwarder. |
|
4116 |
||
4117 |
list2 := SelectionInList with:listOfFunctions. |
|
4118 |
list2 onChangeSend:#showRawKey to:selectionForwarder. |
|
4119 |
list2 onChangeEvaluate:macroForwarder. |
|
4120 |
||
4121 |
box := Dialog new. |
|
4122 |
box label:(resources string:'Keyboard Mappings'). |
|
4123 |
||
4124 |
l := box addTextLabel:(resources at:'KEY_MSG' default:'keyboard mapping:') withCRs. |
|
4125 |
l adjust:#left; borderWidth:0. |
|
4126 |
||
4127 |
frame := View new. |
|
4128 |
frame extent:300 @ 300. |
|
4129 |
frame borderWidth:0. |
|
4130 |
||
4131 |
listView1 := ScrollableView for:SelectionInListView in:frame. |
|
4132 |
listView1 model:list1. |
|
4133 |
listView1 origin:0.0@0.0 corner:0.5@1.0; inset:2. |
|
4134 |
||
4135 |
listView2 := ScrollableView for:SelectionInListView in:frame. |
|
4136 |
listView2 model:list2. |
|
4137 |
listView2 origin:0.5@0.0 corner:1.0@1.0; inset:2. |
|
4138 |
||
4139 |
frame topInset:box yPosition. |
|
4140 |
box addComponent:frame withExtent:350@200. |
|
9303 | 4141 |
box makeTabable:listView1. |
4142 |
box makeTabable:listView2. |
|
4244 | 4143 |
frame origin:0.0@0.0 corner:1.0@0.6. |
4144 |
||
4145 |
box addVerticalSpace. |
|
4146 |
||
4147 |
l := box addTextLabel:(resources string:'Macro text (if any):') withCRs. |
|
4148 |
l adjust:#left; borderWidth:0. |
|
4149 |
l origin:0.0@0.6 corner:1.0@0.6. |
|
4150 |
l topInset:(View viewSpacing). |
|
8160
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
4151 |
l bottomInset:(l preferredHeight negated - View viewSpacing). |
4244 | 4152 |
|
4153 |
macroTextView := HVScrollableView for:TextView miniScroller:true. |
|
4154 |
box addComponent:macroTextView tabable:true. |
|
4155 |
macroTextView origin:0.0@0.6 corner:1.0@1.0. |
|
4156 |
y := box yPosition. |
|
4157 |
||
4158 |
box |
|
9961 | 4159 |
addHelpButtonFor:'Launcher/keyboardSetting.html'; |
4160 |
"addAbortButton;" |
|
4161 |
addOkButtonLabelled:(resources string:'Close' "'Dismiss'"). |
|
4244 | 4162 |
|
8160
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
4163 |
macroTextView topInset:(l preferredHeight + 5). |
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
4164 |
macroTextView bottomInset:(box preferredHeight - y). |
4244 | 4165 |
|
4166 |
box open. |
|
4167 |
||
4168 |
box accepted ifTrue:[ |
|
9961 | 4169 |
"no action yet ..." |
4244 | 4170 |
]. |
4171 |
box destroy |
|
4172 |
||
4173 |
"Modified: / 9.9.1996 / 22:43:17 / stefan" |
|
4174 |
"Modified: / 4.5.1998 / 12:40:02 / cg" |
|
4175 |
! |
|
4176 |
||
9303 | 4177 |
languageSettings |
4244 | 4178 |
self languageSettingsFor:nil |
4179 |
! |
|
4180 |
||
9303 | 4181 |
languageSettingsFor:requestor |
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4182 |
"open a dialog on language related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4183 |
Obsoleted by the settings application" |
4244 | 4184 |
|
4185 |
|listOfLanguages translatedLanguages switch box languageList flags resources| |
|
4186 |
||
4187 |
resources := self owningClass classResources. |
|
4188 |
||
4189 |
" |
|
4190 |
get list of supported languages from the launchers resources ... |
|
4191 |
" |
|
4192 |
||
4193 |
listOfLanguages := resources at:'LIST_OF_OFFERED_LANGUAGES' default:#('default'). |
|
4194 |
listOfLanguages := listOfLanguages asOrderedCollection. |
|
4195 |
||
4196 |
translatedLanguages := listOfLanguages collect:[:lang | |item| |
|
9961 | 4197 |
item := resources string:lang. |
4198 |
item isString ifTrue:[ |
|
4199 |
item |
|
4200 |
] ifFalse:[ |
|
4201 |
item at:1 |
|
4202 |
] |
|
4203 |
]. |
|
4244 | 4204 |
flags := listOfLanguages collect:[:lang | |item| |
9961 | 4205 |
item := resources string:lang. |
4206 |
item isArray ifTrue:[ |
|
4207 |
item at:2 |
|
4208 |
] ifFalse:[ |
|
4209 |
nil |
|
4210 |
] |
|
4211 |
]. |
|
4244 | 4212 |
flags := flags collect:[:nm | |img d| nm notNil ifTrue:[ |
9961 | 4213 |
img := Image fromFile:nm. |
4214 |
img isNil ifTrue:[ |
|
4215 |
d := Smalltalk getPackageDirectoryForPackage:'stx:goodies'. |
|
4216 |
img := Image fromFile:(d construct:nm). |
|
4217 |
]. |
|
4218 |
] ifFalse:[ |
|
4219 |
nil |
|
4220 |
] |
|
4221 |
]. |
|
4244 | 4222 |
listOfLanguages := listOfLanguages collect:[:nm | nm copyFrom:'LANG_' size + 1]. |
4223 |
languageList := translatedLanguages with:flags collect:[:lang :flag | LabelAndIcon icon:flag string:lang.]. |
|
4224 |
||
4225 |
box := ListSelectionBox title:(resources at:'LANG_MSG' default:'Select a Language') withCRs. |
|
4226 |
box label:(resources string:'Language Selection'). |
|
4227 |
box list:languageList. |
|
15954 | 4228 |
box initialText:(Smalltalk language , '-' , Smalltalk languageTerritory). |
4244 | 4229 |
box action:[:newLanguage | |
9961 | 4230 |
WindowGroup activeGroup withWaitCursorDo:[ |
4231 |
|fontPref idx language oldLanguage territory enc |
|
4232 |
answer matchingFonts l screen| |
|
4233 |
||
4234 |
idx := translatedLanguages indexOf:newLanguage withoutSeparators. |
|
4235 |
idx ~~ 0 ifTrue:[ |
|
4236 |
language := listOfLanguages at:idx |
|
4237 |
] ifFalse:[ |
|
4238 |
language := newLanguage |
|
4239 |
]. |
|
4240 |
(language includes:$-) ifTrue:[ |
|
4241 |
l := language asCollectionOfSubstringsSeparatedBy:$-. |
|
4242 |
language := l at:1. |
|
4243 |
territory := l at:2. |
|
4244 |
]. |
|
4245 |
territory isNil ifTrue:[ |
|
4246 |
territory := language copyTo:2 |
|
4247 |
]. |
|
4248 |
||
4249 |
"/ check if the new language needs a differently encoded font; |
|
4250 |
"/ ask user to switch font and allow cancellation. |
|
4251 |
"/ Otherwise, you are left with unreadable menu & button items ... |
|
4252 |
||
4253 |
oldLanguage := UserPreferences current language. |
|
4254 |
Smalltalk setLanguage:language asSymbol. |
|
4255 |
ResourcePack flushCachedResourcePacks. |
|
4256 |
"/ refetch resources ... |
|
4257 |
resources := self owningClass classResources. |
|
4258 |
fontPref := resources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'. |
|
4259 |
fontPref := fontPref asLowercase. |
|
4260 |
Smalltalk setLanguage:oldLanguage. |
|
4261 |
||
4262 |
switch := true. |
|
4263 |
enc := MenuView defaultFont encoding. |
|
4264 |
(fontPref match:enc asLowercase) ifFalse:[ |
|
4265 |
"/ look if there is one at all. |
|
4266 |
screen := Screen current. |
|
4267 |
matchingFonts := screen listOfAvailableFonts select:[:f | fontPref match:f encoding asLowercase]. |
|
4268 |
matchingFonts isEmpty ifTrue:[ |
|
4269 |
"/ flush and try again - just in case, the font path has changed. |
|
4270 |
screen flushListOfAvailableFonts. |
|
4271 |
matchingFonts := screen listOfAvailableFonts select:[:f | fontPref match:f encoding asLowercase]. |
|
4272 |
]. |
|
4273 |
matchingFonts isEmpty ifTrue:[ |
|
4274 |
(Dialog |
|
4275 |
confirm:(resources |
|
4276 |
string:'Your display does not offer any %1-encoded font.\\Change the language anyway ?\ (texts will probably be unreadable then)' |
|
4277 |
with:fontPref) withCRs) |
|
4278 |
ifFalse:[ |
|
4279 |
switch := false |
|
4280 |
] |
|
4281 |
] ifFalse:[ |
|
4282 |
answer := Dialog |
|
4283 |
confirmWithCancel:(resources |
|
4284 |
string:'menu font is not %1-encoded.\\Change it ?' |
|
4285 |
with:fontPref) withCRs |
|
4286 |
labels:(resources |
|
4287 |
array:#('Cancel' 'No' 'Yes')) |
|
4288 |
default:3. |
|
4289 |
answer isNil ifTrue:[ |
|
4290 |
switch := false |
|
4291 |
] ifFalse:[ |
|
4292 |
answer ifTrue:[ |
|
4293 |
switch := (requestor fontBoxForEncoding:fontPref) |
|
4294 |
] |
|
4295 |
]. |
|
4296 |
]. |
|
4297 |
]. |
|
4298 |
||
4299 |
switch ifTrue:[ |
|
4300 |
Transcript showCR:'change language to ' , newLanguage , ' ...'. |
|
4301 |
Smalltalk language:language asSymbol territory:territory asSymbol. |
|
4302 |
"/ ResourcePack flushCachedResourcePacks - already done by language-change |
|
4303 |
]. |
|
4304 |
]. |
|
4305 |
switch ifTrue:[ |
|
4306 |
requestor reopenLauncher. |
|
4307 |
DebugView newDebugger. |
|
4308 |
] |
|
9303 | 4309 |
]. |
4244 | 4310 |
box |
9961 | 4311 |
addHelpButtonFor:'Launcher/languageSetting.html'. |
4244 | 4312 |
box open. |
4313 |
box destroy |
|
4314 |
||
7431 | 4315 |
"Modified: / 09-09-1996 / 22:43:27 / stefan" |
4316 |
"Modified: / 19-10-2006 / 22:17:01 / cg" |
|
4244 | 4317 |
! |
4318 |
||
4319 |
memorySettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4320 |
"open a dialog on objectMemory related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4321 |
Obsoleted by the settings application" |
4244 | 4322 |
|
4323 |
|box igcLimit igcFreeLimit igcFreeAmount newSpaceSize |
|
4324 |
compressLimit |
|
4325 |
oldIncr component fields codeLimit codeTrigger stackLimit resources |
|
4326 |
fastMoreLimit maxOldSpace models info acceptChannel| |
|
4327 |
||
4328 |
acceptChannel := false asValue. |
|
4329 |
||
4330 |
resources := self owningClass classResources. |
|
4331 |
||
4332 |
"/ |
|
4333 |
"/ extract relevant system settings ... |
|
4334 |
"/ |
|
4335 |
igcLimit := ObjectMemory incrementalGCLimit asValue. |
|
4336 |
igcFreeLimit := ObjectMemory freeSpaceGCLimit asValue. |
|
4337 |
igcFreeAmount := ObjectMemory freeSpaceGCAmount asValue. |
|
4338 |
newSpaceSize := ObjectMemory newSpaceSize asValue. |
|
4339 |
oldIncr := ObjectMemory oldSpaceIncrement asValue. |
|
4340 |
compressLimit := ObjectMemory oldSpaceCompressLimit asValue. |
|
4341 |
codeLimit := ObjectMemory dynamicCodeLimit asValue. |
|
4342 |
codeTrigger := ObjectMemory dynamicCodeGCTrigger asValue. |
|
4343 |
stackLimit := Process defaultMaximumStackSize asValue. |
|
4344 |
fastMoreLimit := (ObjectMemory fastMoreOldSpaceLimit:-1) asValue. |
|
4345 |
maxOldSpace := ObjectMemory maxOldSpace asValue. |
|
4346 |
||
4347 |
models := OrderedCollection new. |
|
4348 |
info := OrderedCollection new. |
|
4349 |
models add:newSpaceSize. info add:#(number 'Size of newSpace where objects are created' 'Size of NewSpace:' ). |
|
4350 |
models add:fastMoreLimit. info add:#(number 'Quickly allocate more memory (suppress GC) up to this limit' 'Quick Allocation Limit:'). |
|
4351 |
models add:maxOldSpace. info add:#(number 'Never allocate more than this amount of memory' 'Maximum Memory Limit:'). |
|
4352 |
models add:igcLimit. info add:#(number 'Start IGC whenever this amount has been allocated' 'Incremental GC Allocation Trigger:'). |
|
4353 |
models add:igcFreeLimit. info add:#(number 'Start IGC whenever freespace drops below this' 'Incremental GC Freespace Trigger:'). |
|
4354 |
models add:igcFreeAmount. info add:#(number 'Try to keep this amount for peak requests' 'Incremental GC Amount:'). |
|
4355 |
models add:oldIncr. info add:#(number 'Increase oldSpace in chunks of this size' 'Oldspace Increment:'). |
|
4356 |
models add:compressLimit. info add:#(number 'Use 2-pass compressing GC if > 0 and more memory is in use' 'Oldspace Compress Limit:'). |
|
4357 |
models add:stackLimit. info add:#(number 'Trigger recursionInterrupt if more stack is used by a process' 'Stack Limit:'). |
|
4358 |
models add:codeLimit. info add:#(numberOrNil 'Flush dynamic compiled code to stay within this limit' 'Dynamic code Limit:'). |
|
4359 |
models add:codeTrigger. info add:#(numberOrNil 'Start incremental GC whenever this amount of code has been allocated' 'Dynamic Code GC Trigger:'). |
|
4360 |
||
4361 |
"/ |
|
4362 |
"/ create a box on those values ... |
|
4363 |
"/ |
|
4364 |
fields := OrderedCollection new. |
|
4365 |
||
4366 |
box := DialogBox new. |
|
4367 |
box label:(resources string:'Memory Manager Settings'). |
|
4368 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
4369 |
box |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
4370 |
addTextLabel:'Warning - invalid settings may result in failures or poor performance |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
4371 |
' , 'You have been warned' allBold , '.' |
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
4372 |
adjust:#left. |
4244 | 4373 |
box addHorizontalLine. |
4374 |
||
4375 |
models with:info do:[:m :i | |
|
9961 | 4376 |
|lbl descr conv| |
4377 |
||
4378 |
conv := i at:1. |
|
4379 |
lbl := i at:3. |
|
4380 |
descr := i at:2. |
|
4381 |
||
4382 |
component := box |
|
4383 |
addLabelledInputField:(resources string:lbl) |
|
4384 |
adjust:#right |
|
4385 |
on:nil "/ newSpaceSize |
|
4386 |
tabable:true |
|
4387 |
separateAtX:0.7. |
|
4388 |
component acceptOnLeave:false. |
|
4244 | 4389 |
"/ component converter:(PrintConverter new perform:conv). |
9961 | 4390 |
component model:((TypeConverter on:m) perform:conv). |
4391 |
component acceptChannel:acceptChannel. |
|
4392 |
fields add:component. |
|
4393 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
4394 |
box addTextLabel:descr adjust:#left. |
9961 | 4395 |
box addHorizontalLine. |
4244 | 4396 |
]. |
4397 |
||
4398 |
ObjectMemory supportsJustInTimeCompilation ifFalse:[ |
|
9961 | 4399 |
(fields at:9) disable. |
4400 |
(fields at:10) disable. |
|
4244 | 4401 |
]. |
4402 |
||
4403 |
box addAbortAndOkButtons. |
|
4404 |
box |
|
9961 | 4405 |
addHelpButtonFor:'Launcher/memorySettings.html'. |
4244 | 4406 |
|
4407 |
"/ |
|
4408 |
"/ show the box ... |
|
4409 |
"/ |
|
4410 |
box open. |
|
4411 |
||
4412 |
"/ |
|
4413 |
"/ update system settings |
|
4414 |
"/ |
|
4415 |
box accepted ifTrue:[ |
|
9961 | 4416 |
acceptChannel value:true. |
4417 |
||
4418 |
igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[ |
|
4419 |
ObjectMemory freeSpaceGCAmount:igcFreeAmount value. |
|
4420 |
]. |
|
4421 |
igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[ |
|
4422 |
ObjectMemory freeSpaceGCLimit:igcFreeLimit value. |
|
4423 |
]. |
|
4424 |
igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[ |
|
4425 |
ObjectMemory incrementalGCLimit:igcLimit value. |
|
4426 |
]. |
|
4427 |
newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[ |
|
4428 |
ObjectMemory newSpaceSize:newSpaceSize value. |
|
4429 |
]. |
|
4430 |
oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[ |
|
4431 |
ObjectMemory oldSpaceIncrement:oldIncr value. |
|
4432 |
]. |
|
4433 |
stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[ |
|
4434 |
Process defaultMaximumStackSize:stackLimit value. |
|
4435 |
]. |
|
4436 |
fastMoreLimit value ~~ (ObjectMemory fastMoreOldSpaceLimit:-1) ifTrue:[ |
|
4437 |
ObjectMemory fastMoreOldSpaceLimit:fastMoreLimit value. |
|
4438 |
]. |
|
4439 |
maxOldSpace value ~~ ObjectMemory maxOldSpace ifTrue:[ |
|
4440 |
ObjectMemory maxOldSpace:maxOldSpace value. |
|
4441 |
]. |
|
4442 |
ObjectMemory oldSpaceCompressLimit:compressLimit value. |
|
4443 |
ObjectMemory dynamicCodeLimit:codeLimit value. |
|
4444 |
ObjectMemory dynamicCodeGCTrigger:codeTrigger value. |
|
4244 | 4445 |
]. |
4446 |
box destroy |
|
4447 |
||
4448 |
"Modified: 27.2.1997 / 16:50:12 / cg" |
|
4449 |
! |
|
4450 |
||
4451 |
messageSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4452 |
"open a dialog on infoMessage related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4453 |
Obsoleted by the settings application" |
4244 | 4454 |
|
4455 |
|box vmInfo vmErrors displayErrors classInfos resources| |
|
4456 |
||
4457 |
resources := self owningClass classResources. |
|
4458 |
||
4459 |
vmInfo := ObjectMemory infoPrinting asValue. |
|
4460 |
vmErrors := ObjectMemory debugPrinting asValue. |
|
4461 |
classInfos := Object infoPrinting asValue. |
|
4462 |
displayErrors := DeviceWorkstation errorPrinting asValue. |
|
4463 |
||
4464 |
box := DialogBox new. |
|
4465 |
box label:(resources string:'Messages'). |
|
4466 |
||
4467 |
box addCheckBox:(resources string:'VM Info Messages') on:vmInfo. |
|
4468 |
box addCheckBox:(resources string:'VM Error Messages') on:vmErrors. |
|
4469 |
box addHorizontalLine. |
|
4470 |
||
4471 |
box addCheckBox:(resources string:'Display Error Messages (Xlib, Xtlib, WinAPI ...)') on:displayErrors. |
|
4472 |
box addCheckBox:(resources string:'Other Info Messages') on:classInfos. |
|
4473 |
box addHorizontalLine. |
|
4474 |
||
4475 |
box addHelpButtonFor:'Launcher/messageSettings.html'. |
|
4476 |
box addAbortAndOkButtons. |
|
4477 |
box open. |
|
4478 |
||
4479 |
box accepted ifTrue:[ |
|
9961 | 4480 |
ObjectMemory infoPrinting:vmInfo value. |
4481 |
ObjectMemory debugPrinting:vmErrors value. |
|
4482 |
Object infoPrinting:classInfos value. |
|
4483 |
DeviceWorkstation errorPrinting:displayErrors value. |
|
4244 | 4484 |
]. |
4485 |
box destroy |
|
4486 |
||
4487 |
"Modified: 27.1.1997 / 17:46:01 / cg" |
|
4488 |
! |
|
4489 |
||
4490 |
miscSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4491 |
"open a dialog on misc other settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4492 |
Obsoleted by the settings application" |
4244 | 4493 |
|
9303 | 4494 |
|box pos pos2 check butt shadows takeFocus focusFollowsMouse returnFocus |
4495 |
hostNameInLabel showAccelerators |
|
4244 | 4496 |
preemptive dynamicPrios hostNameInLabelHolder resources |
4497 |
activateOnClick opaqueVariablePanelResize opaqueTableColumnResize currentUserPrefs |
|
4498 |
beepEnabled newWindowLabelFormat| |
|
4499 |
||
4500 |
resources := self owningClass classResources. |
|
4501 |
currentUserPrefs := UserPreferences current. |
|
4502 |
||
9303 | 4503 |
"/ |
4244 | 4504 |
"/ extract relevant system settings ... |
4505 |
"/ |
|
4506 |
shadows := PopUpView shadows asValue. |
|
4507 |
beepEnabled := currentUserPrefs beepEnabled asValue. |
|
4508 |
||
4509 |
hostNameInLabel := StandardSystemView includeHostNameInLabel. |
|
4510 |
hostNameInLabelHolder := hostNameInLabel asValue. |
|
4511 |
returnFocus := StandardSystemView returnFocusWhenClosingModalBoxes asValue. |
|
4512 |
takeFocus := StandardSystemView takeFocusWhenMapped asValue. |
|
9941
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4513 |
focusFollowsMouse := currentUserPrefs focusFollowsMouse asValue. |
13761
062e30fef79c
Replace references to Diplay with "Screen current" - where appropriate
Stefan Vogel <sv@exept.de>
parents:
13735
diff
changeset
|
4514 |
activateOnClick := (Screen current activateOnClick:nil) asValue. |
4244 | 4515 |
opaqueVariablePanelResize := currentUserPrefs opaqueVariablePanelResizing asValue. |
4516 |
opaqueTableColumnResize := currentUserPrefs opaqueTableColumnResizing asValue. |
|
4517 |
||
4518 |
showAccelerators := MenuView showAcceleratorKeys asValue. |
|
4519 |
preemptive := Processor isTimeSlicing asValue. |
|
4520 |
dynamicPrios := Processor supportDynamicPriorities asValue. |
|
4521 |
||
4522 |
"/ |
|
4523 |
"/ create a box on those values ... |
|
4524 |
"/ |
|
4525 |
box := DialogBox new. |
|
4526 |
box label:(resources string:'Other settings'). |
|
4527 |
||
4528 |
box addCheckBox:(resources string:'Shadows under PopUp Views') on:shadows. |
|
4529 |
box addCheckBox:(resources string:'Beeper enabled') on:beepEnabled. |
|
4530 |
box addCheckBox:(resources string:'Boxes Return Focus to Previously Active View') on:returnFocus. |
|
4531 |
box addCheckBox:(resources string:'Views Catch Focus when Mapped') on:takeFocus. |
|
4532 |
pos := box yPosition. |
|
4533 |
check := box addCheckBox:(resources string:'Hostname in Window Labels') on:hostNameInLabelHolder. |
|
4534 |
check width:0.6. |
|
4535 |
pos2 := box yPosition. |
|
4536 |
box yPosition:pos. |
|
9303 | 4537 |
butt := box addComponent:(Button label:(resources string:'Format...') |
9941
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4538 |
action:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4539 |
|newFormat| |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4540 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4541 |
newFormat := Dialog request: |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4542 |
'Define the Format of Window Labels:\\ %1 - Label\ %2 - Hostname\ %3 - Username\ %4 - ProcessId\' |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4543 |
withCRs initialAnswer:StandardSystemView windowLabelFormat. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4544 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4545 |
newFormat size > 0 ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4546 |
newWindowLabelFormat := newFormat |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4547 |
]. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4548 |
]). |
4244 | 4549 |
box makeTabable:butt. |
4550 |
butt left:0.6; width:0.4. |
|
4551 |
box yPosition:(box yPosition max:pos2). |
|
4552 |
||
4553 |
box addCheckBox:(resources string:'Show Accelerator Keys in Menus') on:showAccelerators. |
|
4554 |
box addCheckBox:(resources string:'Raise & Activate Windows on Click') on:activateOnClick. |
|
4555 |
box addCheckBox:(resources string:'Focus Follows Mouse') on:focusFollowsMouse. |
|
4556 |
box addCheckBox:(resources string:'Opaque Variable Panel Resizing') on:opaqueVariablePanelResize. |
|
4557 |
box addCheckBox:(resources string:'Opaque Table Column Resizing') on:opaqueTableColumnResize. |
|
4558 |
||
4559 |
box addHorizontalLine. |
|
4560 |
||
4561 |
box addCheckBox:(resources string:'Preemptive Scheduling') on:preemptive. |
|
4562 |
box leftIndent:20. |
|
4563 |
check := box addCheckBox:(resources string:'Dynamic Priorities') on:dynamicPrios. |
|
4564 |
check enableChannel:preemptive. |
|
4565 |
box leftIndent:0. |
|
4566 |
||
4567 |
box addHorizontalLine. |
|
9303 | 4568 |
box |
9941
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4569 |
addHelpButtonFor:'Launcher/miscSettings.html'; |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4570 |
addAbortAndOkButtons. |
4244 | 4571 |
|
4572 |
"/ |
|
4573 |
"/ show the box ... |
|
4574 |
"/ |
|
4575 |
box open. |
|
4576 |
||
4577 |
"/ |
|
4578 |
"/ update system settings |
|
4579 |
"/ |
|
4580 |
box accepted ifTrue:[ |
|
9941
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4581 |
PopUpView shadows:shadows value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4582 |
(hostNameInLabelHolder value ~= hostNameInLabel |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4583 |
or:[newWindowLabelFormat ~= StandardSystemView windowLabelFormat]) ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4584 |
StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4585 |
newWindowLabelFormat notNil ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4586 |
StandardSystemView windowLabelFormat:newWindowLabelFormat |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4587 |
]. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4588 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4589 |
Screen allScreens do:[:aDisplay | |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4590 |
aDisplay allViewsDo:[:aView | |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4591 |
|l| |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4592 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4593 |
aView isTopView ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4594 |
l := aView label. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4595 |
l notNil ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4596 |
aView label:(l , ' '); label:l. "/ force a change |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4597 |
] |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4598 |
] |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4599 |
] |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4600 |
] |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4601 |
]. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4602 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4603 |
currentUserPrefs opaqueVariablePanelResizing:opaqueVariablePanelResize value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4604 |
currentUserPrefs opaqueTableColumnResizing:opaqueTableColumnResize value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4605 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4606 |
currentUserPrefs beepEnabled:beepEnabled value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4607 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4608 |
StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4609 |
StandardSystemView takeFocusWhenMapped:takeFocus value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4610 |
currentUserPrefs focusFollowsMouse:focusFollowsMouse value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4611 |
Screen current activateOnClick:(activateOnClick value). |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4612 |
|
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4613 |
MenuView showAcceleratorKeys:showAccelerators value. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4614 |
Processor isTimeSlicing ~~ preemptive value ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4615 |
preemptive value ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4616 |
Processor startTimeSlicing |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4617 |
] ifFalse:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4618 |
Processor stopTimeSlicing |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4619 |
] |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4620 |
]. |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4621 |
Processor supportDynamicPriorities ~~ dynamicPrios value ifTrue:[ |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4622 |
Processor supportDynamicPriorities:dynamicPrios value |
08309b8378fc
fix default for focusFollowsMouse
Stefan Vogel <sv@exept.de>
parents:
9932
diff
changeset
|
4623 |
]. |
4244 | 4624 |
]. |
4625 |
box destroy |
|
4626 |
||
4627 |
"Modified: / 9.9.1996 / 22:43:36 / stefan" |
|
4628 |
"Modified: / 20.5.1999 / 18:33:55 / cg" |
|
4629 |
"Modified: / 3.12.1999 / 17:11:38 / ps" |
|
4630 |
! |
|
4631 |
||
4632 |
printerSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4633 |
"open a dialog on printer related settings; returns true if accepted. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4634 |
Obsoleted by the settings application" |
4244 | 4635 |
|
4636 |
|box accepted |
|
5181 | 4637 |
possiblePrinters possibleTypes printerType printCommand printFile |
4244 | 4638 |
pageFormat landscape updater |
4639 |
formatLabel formatComponent landscapeLabel landscapeComponent |
|
4640 |
topMargin leftMargin rightMargin bottomMargin unitList unit |
|
4641 |
topMarginComponent leftMarginComponent |
|
4642 |
rightMarginComponent |
|
4643 |
bottomMarginComponent supportsColor supportsColorComponent |
|
5181 | 4644 |
y y1 commandListPop printOutField component commandList row resources| |
4244 | 4645 |
|
4646 |
resources := self owningClass classResources. |
|
4647 |
||
4648 |
possiblePrinters := PrinterStream withAllSubclasses asArray. |
|
4649 |
possibleTypes := possiblePrinters collect:[:cls | cls printerTypeName]. |
|
4650 |
||
4651 |
printerType := SelectionInList new list:(resources array:possibleTypes). |
|
4652 |
printerType selectionIndex:(possiblePrinters identityIndexOf:Printer). |
|
4653 |
printCommand := Printer printCommand asValue. |
|
5181 | 4654 |
printFile := (Printer printFilename ? '') asValue. |
4244 | 4655 |
|
4656 |
pageFormat := SelectionInList new list:(Printer defaultPageFormats). |
|
4657 |
pageFormat selection:(Printer pageFormat). |
|
4658 |
landscape := Printer landscape asValue. |
|
4659 |
||
4660 |
topMargin := Printer topMargin asValue. |
|
4661 |
leftMargin := Printer leftMargin asValue. |
|
4662 |
rightMargin := Printer rightMargin asValue. |
|
4663 |
bottomMargin := Printer bottomMargin asValue. |
|
4664 |
supportsColor := Printer supportsColor asValue. |
|
4665 |
||
4666 |
box := DialogBox new. |
|
4667 |
box label:(resources string:'Printer Settings'). |
|
4668 |
||
4669 |
"/ either use a popUpList ... |
|
4670 |
"/ box addPopUpList:(resources string:'printer type:') on:printerType. |
|
4671 |
||
4672 |
"/ or a comboList; |
|
4673 |
"/ which one looks better ? |
|
4674 |
y := box yPosition. |
|
4675 |
component := box addTextLabel:(resources string:'Printer Type:'). |
|
4676 |
component width:0.25; adjust:#right; borderWidth:0. |
|
4677 |
box yPosition:y. |
|
4678 |
component := box addComboListOn:printerType tabable:true. |
|
4679 |
component aspect:#selectionIndex; changeMessage:#selectionIndex:; useIndex:true. |
|
4680 |
component width:0.75; left:0.25. |
|
4681 |
"/ end of question |
|
4682 |
||
4683 |
y := box yPosition. |
|
4684 |
component := box addTextLabel:(resources string:'Print Command:'). |
|
4685 |
component width:0.25; adjust:#right; borderWidth:0. |
|
4686 |
box yPosition:y. |
|
4687 |
commandListPop := box addComboBoxOn:printCommand tabable:true. |
|
4688 |
"/ commandListPop := box addInputFieldOn:printCommand tabable:true. |
|
4689 |
commandListPop width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4690 |
"/ some common print commands ... |
|
4691 |
||
6637 | 4692 |
commandList := resources string:'PRINT_COMMANDS' default:nil. |
4244 | 4693 |
commandList isNil ifTrue:[ |
9961 | 4694 |
commandList := PrinterStream defaultCommands. |
4695 |
commandList isNil ifTrue:[ |
|
4696 |
commandList := #('lpr' |
|
4697 |
'lp' |
|
4698 |
). |
|
4699 |
] |
|
4244 | 4700 |
]. |
4701 |
||
4702 |
commandListPop list:commandList. |
|
4703 |
||
5181 | 4704 |
y := box yPosition. |
4705 |
component := box addTextLabel:(resources string:'Print to File:'). |
|
4706 |
component width:0.25; adjust:#right; borderWidth:0. |
|
4707 |
box yPosition:y. |
|
4708 |
||
4709 |
printOutField := box addInputFieldOn:printFile tabable:true. |
|
4710 |
printOutField width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
9303 | 4711 |
printFile |
9961 | 4712 |
onChangeEvaluate: |
4713 |
[ |
|
4714 |
printFile value size > 0 ifTrue:[ |
|
4715 |
commandListPop disable. |
|
4716 |
] ifFalse:[ |
|
4717 |
commandListPop enable. |
|
4718 |
] |
|
4719 |
]. |
|
5181 | 4720 |
printFile changed. |
4721 |
||
4244 | 4722 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
4723 |
||
4724 |
row := OrderedCollection new. |
|
4725 |
row add:(formatLabel := Label label:(resources string:'Page Format:')). |
|
4726 |
formatLabel borderWidth:0. |
|
4727 |
row add:(formatComponent := PopUpList on:pageFormat). |
|
4728 |
formatComponent label:'unknown'. |
|
4729 |
||
4730 |
row add:(landscapeLabel := Label label:(resources string:'Landscape:')). |
|
4731 |
landscapeLabel borderWidth:0. |
|
4732 |
row add:(landscapeComponent := CheckToggle on:landscape). |
|
4733 |
||
4734 |
y := box yPosition. |
|
4735 |
box |
|
9961 | 4736 |
addRow:(1 to:2) |
4737 |
fromX:0 |
|
4738 |
toX:0.5 |
|
4739 |
collect:[:idx | row at:idx] |
|
4740 |
tabable:false |
|
4741 |
horizontalLayout:#leftSpace |
|
4742 |
verticalLayout:#center. |
|
4244 | 4743 |
y1 := box yPosition. |
4744 |
box yPosition:y. |
|
4745 |
||
4746 |
box |
|
9961 | 4747 |
addRow:(3 to:4) |
4748 |
fromX:0.5 |
|
4749 |
toX:1.0 |
|
4750 |
collect:[:idx | row at:idx] |
|
4751 |
tabable:false |
|
4752 |
horizontalLayout:#leftSpace |
|
4753 |
verticalLayout:#center. |
|
4244 | 4754 |
|
4755 |
box yPosition:(box yPosition max:y1). |
|
4756 |
||
4757 |
box makeTabable:(formatComponent). |
|
4758 |
box makeTabable:(landscapeComponent). |
|
4759 |
||
4760 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
4761 |
||
4762 |
y := box yPosition. |
|
4763 |
||
9303 | 4764 |
topMarginComponent := box |
9961 | 4765 |
addLabelledInputField:(resources string:'Top Margin:') |
4766 |
adjust:#right |
|
4767 |
on:nil "/ topMargin |
|
4768 |
tabable:true |
|
4769 |
from:0.0 to:0.5 |
|
4770 |
separateAtX:0.6. |
|
4244 | 4771 |
topMarginComponent converter:(PrintConverter new initForNumber). |
4772 |
topMarginComponent model:topMargin. |
|
4773 |
y1 := box yPosition. |
|
4774 |
||
4775 |
box yPosition:y. |
|
4776 |
unitList := SelectionInList with:#('inch' 'mm'). |
|
4777 |
unitList selectionIndex:1. |
|
4778 |
||
4779 |
component := box addComponent:(PopUpList on:unitList). |
|
4780 |
component |
|
9961 | 4781 |
left:0.6; |
4782 |
width:0.3. |
|
4244 | 4783 |
|
4784 |
box yPosition:y1. |
|
4785 |
||
9303 | 4786 |
leftMarginComponent := box |
9961 | 4787 |
addLabelledInputField:(resources string:'Left Margin:') |
4788 |
adjust:#right |
|
4789 |
on:nil "/ leftMargin |
|
4790 |
tabable:true |
|
4791 |
from:0.0 to:0.5 |
|
4792 |
separateAtX:0.6. |
|
4244 | 4793 |
leftMarginComponent converter:(PrintConverter new initForNumber). |
4794 |
leftMarginComponent model:leftMargin. |
|
4795 |
||
9303 | 4796 |
rightMarginComponent := box |
9961 | 4797 |
addLabelledInputField:(resources string:'Right Margin:') |
4798 |
adjust:#right |
|
4799 |
on:nil "/ rightMargin |
|
4800 |
tabable:true |
|
4801 |
from:0.0 to:0.5 |
|
4802 |
separateAtX:0.6. |
|
4244 | 4803 |
rightMarginComponent converter:(PrintConverter new initForNumber). |
4804 |
rightMarginComponent model:rightMargin. |
|
4805 |
||
9303 | 4806 |
bottomMarginComponent := box |
9961 | 4807 |
addLabelledInputField:(resources string:'Bottom Margin:') |
4808 |
adjust:#right |
|
4809 |
on:nil "/ bottomMargin |
|
4810 |
tabable:true |
|
4811 |
from:0.0 to:0.5 |
|
4812 |
separateAtX:0.6. |
|
4244 | 4813 |
bottomMarginComponent converter:(PrintConverter new initForNumber). |
4814 |
bottomMarginComponent model:bottomMargin. |
|
4815 |
||
4816 |
box addHorizontalLine. |
|
4817 |
supportsColorComponent := box addCheckBox:(resources string:'Color Printer') on:supportsColor. |
|
4818 |
box addVerticalSpace. |
|
4819 |
||
4820 |
updater := [ |p fg hasPageSize hasMargins| |
|
4821 |
||
9961 | 4822 |
printerType selectionIndex ~~ 0 ifTrue:[ |
4823 |
p := possiblePrinters at:(printerType selectionIndex). |
|
4824 |
hasPageSize := p supportsPageSizes. |
|
4825 |
hasMargins := p supportsMargins. |
|
4826 |
] ifFalse:[ |
|
4827 |
hasPageSize := false. |
|
4828 |
hasMargins := false. |
|
4829 |
]. |
|
4830 |
hasPageSize ifTrue:[ |
|
4831 |
fg := Button new foregroundColor. |
|
4832 |
formatComponent enable. |
|
4833 |
landscapeComponent enable. |
|
4834 |
||
4835 |
formatComponent label:p pageFormat. |
|
4836 |
pageFormat value:(p pageFormat). |
|
4837 |
landscape value:(p landscape). |
|
4838 |
] ifFalse:[ |
|
4839 |
fg := Button new disabledForegroundColor. |
|
4840 |
formatComponent disable. |
|
4841 |
landscapeComponent disable. |
|
4842 |
||
4843 |
formatComponent label:'unknown'. |
|
4844 |
landscape value:nil. |
|
4845 |
]. |
|
4846 |
hasMargins ifTrue:[ |
|
4847 |
unitList selectionIndex == 2 ifTrue:[ |
|
4848 |
unit := #mm |
|
4849 |
] ifFalse:[ |
|
4850 |
unit := #inch |
|
4851 |
]. |
|
4852 |
||
4853 |
topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit). |
|
4854 |
leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit). |
|
4855 |
rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit). |
|
4856 |
bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit). |
|
4857 |
||
4858 |
topMarginComponent enable. |
|
4859 |
leftMarginComponent enable. |
|
4860 |
rightMarginComponent enable. |
|
4861 |
bottomMarginComponent enable. |
|
4862 |
] ifFalse:[ |
|
4863 |
topMarginComponent disable. |
|
4864 |
leftMarginComponent disable. |
|
4865 |
rightMarginComponent disable. |
|
4866 |
bottomMarginComponent disable. |
|
4867 |
]. |
|
4868 |
formatLabel foregroundColor:fg. |
|
4869 |
landscapeLabel foregroundColor:fg. |
|
4870 |
||
4871 |
p notNil ifTrue:[ |
|
4872 |
commandList := p defaultCommands. |
|
4873 |
commandList notNil ifTrue:[ |
|
4874 |
commandListPop list:commandList |
|
4875 |
]. |
|
4876 |
||
4877 |
printCommand value:(p printCommand). |
|
4878 |
]. |
|
4879 |
p supportsPostscript ifFalse:[ |
|
4880 |
supportsColorComponent disable. |
|
4881 |
supportsColor value:false |
|
4882 |
] ifTrue:[ |
|
4883 |
supportsColorComponent enable. |
|
4884 |
supportsColor value:(Printer supportsColor). |
|
4885 |
] |
|
4886 |
]. |
|
4244 | 4887 |
unitList onChangeEvaluate:updater. |
4888 |
printerType onChangeEvaluate:updater. |
|
4889 |
updater value. |
|
4890 |
||
4891 |
box addHorizontalLine. |
|
4892 |
box addVerticalSpace; |
|
9961 | 4893 |
addHelpButtonFor:'Launcher/printerSettings.html'; |
4894 |
addAbortAndOkButtons. |
|
4244 | 4895 |
box open. |
4896 |
||
4897 |
(accepted := box accepted) ifTrue:[ |
|
9961 | 4898 |
Printer := possiblePrinters at:(printerType selectionIndex). |
4899 |
Printer printCommand:printCommand value. |
|
4900 |
Printer printFilename:(printFile value isEmptyOrNil ifTrue:[nil] ifFalse:[printFile value]). |
|
4901 |
||
4902 |
Printer supportsPageSizes ifTrue:[ |
|
4903 |
Printer pageFormat:(pageFormat selection). |
|
4904 |
Printer landscape:(landscape value). |
|
4905 |
]. |
|
4906 |
Printer supportsMargins ifTrue:[ |
|
4907 |
unitList selectionIndex == 2 ifTrue:[ |
|
4908 |
unit := #mm |
|
4909 |
] ifFalse:[ |
|
4910 |
unit := #inch |
|
4911 |
]. |
|
4912 |
Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch). |
|
4913 |
Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch). |
|
4914 |
Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch). |
|
4915 |
Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch). |
|
4916 |
]. |
|
4917 |
Printer supportsPostscript ifTrue:[ |
|
4918 |
Printer supportsColor:supportsColor value. |
|
4919 |
]. |
|
4244 | 4920 |
]. |
4921 |
box destroy. |
|
4922 |
^ accepted |
|
4923 |
||
4924 |
"Modified: 9.9.1996 / 22:43:51 / stefan" |
|
4925 |
"Modified: 28.2.1997 / 14:00:13 / cg" |
|
4926 |
! |
|
4927 |
||
4928 |
saveSettings |
|
5465 | 4929 |
SettingsDialog saveSettingsWithoutAskingForFile. |
4244 | 4930 |
! |
4931 |
||
4932 |
sourceAndDebuggerSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4933 |
"open a dialog on source&debugger other settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
4934 |
Obsoleted by the settings application" |
4244 | 4935 |
|
4936 |
|box check butt setupButt logDoits updChanges changeFileName |
|
4937 |
useManager hasManager cvsIsSetup |
|
9303 | 4938 |
repository repositoryHolder localSourceFirst |
4244 | 4939 |
sourceCacheDir cacheEntry |
4940 |
component localCheck oldIndent nm fn manager |
|
4941 |
showErrorNotifier showVerboseStack |
|
4942 |
syntaxColoring fullSelectorCheck autoFormat |
|
4943 |
resources pos currentUserPrefs checkClassesWhenCheckingIn checkClassesBox| |
|
4944 |
||
4945 |
currentUserPrefs := UserPreferences current. |
|
4946 |
||
4947 |
resources := self owningClass classResources. |
|
4948 |
||
9303 | 4949 |
"/ |
4244 | 4950 |
"/ extract relevant system settings ... |
4951 |
"/ |
|
4952 |
logDoits := Smalltalk logDoits asValue. |
|
4953 |
updChanges := Class updatingChanges asValue. |
|
4954 |
changeFileName := ObjectMemory nameForChanges asValue. |
|
4955 |
||
4840
4f74aeb5e4d2
autoload is understood by all classes (dummy if already loaded)
Claus Gittinger <cg@exept.de>
parents:
4766
diff
changeset
|
4956 |
AbstractSourceCodeManager notNil ifTrue:[ |
9753 | 4957 |
AbstractSourceCodeManager autoload. |
4244 | 4958 |
]. |
4959 |
||
4960 |
hasManager := AbstractSourceCodeManager notNil |
|
9753 | 4961 |
and:[AbstractSourceCodeManager isLoaded]. |
4244 | 4962 |
|
4963 |
repositoryHolder := '' asValue. |
|
4964 |
hasManager ifTrue:[ |
|
9753 | 4965 |
useManager := (manager := Smalltalk at:#SourceCodeManager) notNil asValue. |
4966 |
localSourceFirst := Class tryLocalSourceFirst asValue. |
|
4967 |
manager notNil ifTrue:[ |
|
4968 |
manager forgetDisabledModules. |
|
4969 |
repository := manager repositoryName. |
|
4970 |
repository notNil ifTrue:[ |
|
4971 |
repositoryHolder := repository asValue. |
|
4972 |
] ifFalse:[ |
|
4973 |
repositoryHolder := '' asValue. |
|
4974 |
]. |
|
4975 |
]. |
|
4976 |
cvsIsSetup := true. |
|
4244 | 4977 |
] ifFalse:[ |
9753 | 4978 |
useManager := false. |
4979 |
localSourceFirst := false. |
|
4980 |
cvsIsSetup := false. |
|
4244 | 4981 |
]. |
4982 |
cvsIsSetup := cvsIsSetup asValue. |
|
4566
af369740e2bc
Replace referneces to Exception.
Stefan Vogel <sv@exept.de>
parents:
4552
diff
changeset
|
4983 |
showErrorNotifier := (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) asValue. |
8150 | 4984 |
showVerboseStack := (currentUserPrefs verboseBacktraceInDebugger) asValue. |
4244 | 4985 |
syntaxColoring := currentUserPrefs syntaxColoring asValue. |
4986 |
fullSelectorCheck := currentUserPrefs fullSelectorCheck asValue. |
|
4987 |
autoFormat := currentUserPrefs autoFormatting asValue. |
|
4988 |
||
4989 |
sourceCacheDir := nil asValue. |
|
4990 |
checkClassesWhenCheckingIn := (currentUserPrefs at:#checkClassesWhenCheckingIn ifAbsent:true) asValue. |
|
4991 |
||
4992 |
"/ |
|
4993 |
"/ create a box on those values ... |
|
4994 |
"/ |
|
4995 |
box := DialogBox new. |
|
4996 |
box label:(resources string:'Source & Debugger Settings'). |
|
4997 |
||
4998 |
box addCheckBox:(resources string:'Log compiles in Changefile') on:updChanges. |
|
4999 |
box addCheckBox:(resources string:'Log doIts in Changefile') on:logDoits. |
|
5000 |
||
9303 | 5001 |
component := box |
9753 | 5002 |
addLabelledInputField:(resources string:'Changefile Name:') |
5003 |
adjust:#right |
|
5004 |
on:changeFileName |
|
5005 |
tabable:true |
|
5006 |
separateAtX:0.4. |
|
4244 | 5007 |
component immediateAccept:true; acceptOnLeave:false. |
5008 |
||
5009 |
"/ y := box yPosition. |
|
5010 |
"/ component := box addTextLabel:(resources string:'change file name:'). |
|
5011 |
"/ component width:0.5; adjust:#right; borderWidth:0. |
|
5012 |
"/ box yPosition:y. |
|
5013 |
"/ component := box addInputFieldOn:changeFileName tabable:true. |
|
5014 |
"/ component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false. |
|
5015 |
||
5016 |
box addHorizontalLine. |
|
5017 |
||
5018 |
hasManager ifTrue:[ |
|
9753 | 5019 |
pos := box yPosition. |
5020 |
check := box addCheckBox:(resources string:'Sourcecode Management') on:useManager. |
|
5021 |
check enableChannel:cvsIsSetup. |
|
5022 |
box makeTabable:check. |
|
5023 |
||
5024 |
CVSSourceCodeManager notNil ifTrue:[ |
|
5025 |
check width:0.6. |
|
5026 |
box yPosition:pos. |
|
5027 |
setupButt := box addComponent:(Button label:(resources string:'Setup...') |
|
5028 |
action:[|manager| |
|
5029 |
||
5030 |
self cvsConfigurationDialog. |
|
5031 |
manager := (Smalltalk at:#SourceCodeManager). |
|
5032 |
cvsIsSetup value:manager notNil. |
|
5033 |
manager notNil ifTrue:[ |
|
5034 |
repositoryHolder value: manager repositoryName. |
|
5035 |
sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName). |
|
5036 |
]. |
|
5037 |
]). |
|
5038 |
setupButt enableChannel:useManager. |
|
5039 |
box makeTabable:setupButt. |
|
5040 |
setupButt left:0.6; width:0.4. |
|
5041 |
]. |
|
5042 |
oldIndent := box leftIndent. |
|
5043 |
box leftIndent:30. |
|
5044 |
||
5045 |
box addVerticalSpace:10. |
|
9303 | 5046 |
"/ component := box |
4244 | 5047 |
"/ addLabelledInputField:(resources string:'CVS repository:') |
5048 |
"/ adjust:#right |
|
9303 | 5049 |
"/ on:repositoryHolder |
4244 | 5050 |
"/ tabable:true |
5051 |
"/ separateAtX:0.5. |
|
5052 |
"/ component immediateAccept:true; acceptOnLeave:false. |
|
5053 |
"/ component enableChannel:useManager. |
|
9303 | 5054 |
"/ component readOnly:true. |
4244 | 5055 |
"/ |
9753 | 5056 |
cacheEntry := box |
5057 |
addLabelledInputField:(resources string:'Source Cache Dir:') |
|
5058 |
adjust:#right |
|
5059 |
on:sourceCacheDir |
|
5060 |
tabable:true |
|
5061 |
separateAtX:0.5. |
|
5062 |
cacheEntry immediateAccept:true; acceptOnLeave:false. |
|
5063 |
cacheEntry enableChannel:useManager. |
|
5064 |
||
5065 |
pos := box yPosition. |
|
5066 |
butt := Button label:(resources string:'Flush Cache now'). |
|
5067 |
butt action:[ box withWaitCursorDo:[ AbstractSourceCodeManager flushSourceCache ] ]. |
|
5068 |
box addComponent:butt tabable:true. |
|
5069 |
butt left:0.6; width:0.4; leftInset:0. |
|
5070 |
butt enableChannel:useManager. |
|
5071 |
||
5072 |
butt := Button label:(resources string:'Condense Cache now'). |
|
5073 |
butt action:[ box withWaitCursorDo:[ AbstractSourceCodeManager condenseSourceCache ] ]. |
|
5074 |
box addComponent:butt tabable:true. |
|
5075 |
butt left:0.6; width:0.4; leftInset:0. |
|
5076 |
butt enableChannel:useManager. |
|
5077 |
||
5078 |
localCheck := box addCheckBox:(resources string:'If Present, Use Local Source (Suppress Checkout)') on:localSourceFirst. |
|
5079 |
localCheck enableChannel:useManager. |
|
5080 |
||
5081 |
checkClassesBox := box addCheckBox:(resources string:'Check for halt/error-Sends when Checking in') on:checkClassesWhenCheckingIn. |
|
5082 |
checkClassesBox enableChannel:useManager. |
|
5083 |
||
5084 |
box leftIndent:oldIndent. |
|
5085 |
||
5086 |
(AbstractSourceCodeManager isNil |
|
5087 |
or:[AbstractSourceCodeManager defaultManager isNil]) ifTrue:[ |
|
5088 |
useManager value:false. |
|
5089 |
"/ cacheEntry disable. |
|
5090 |
"/ localCheck enable. |
|
5091 |
] ifFalse:[ |
|
5092 |
sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName). |
|
5093 |
]. |
|
5094 |
box addHorizontalLine. |
|
4244 | 5095 |
]. |
5096 |
||
5097 |
pos := box yPosition. |
|
5098 |
check := box addCheckBox:(resources string:'Syntax Coloring') on:syntaxColoring. |
|
5099 |
check width:0.6. |
|
5100 |
box yPosition:pos. |
|
5101 |
butt := box addComponent:(Button label:(resources string:'Configure...') action:[self syntaxColorConfigurationDialog]). |
|
5102 |
box makeTabable:butt. |
|
5103 |
butt enableChannel:syntaxColoring. |
|
5104 |
butt left:0.6; width:0.4. |
|
5105 |
||
5106 |
check := box addCheckBox:(resources string:'Immediate Selector Check') on:fullSelectorCheck. |
|
5107 |
check enableChannel:syntaxColoring. |
|
5108 |
||
5109 |
pos := box yPosition. |
|
5110 |
check := box addCheckBox:(resources string:'Auto Format') on:autoFormat. |
|
5111 |
check width:0.6. |
|
5112 |
box yPosition:pos. |
|
5113 |
butt := box addComponent:(Button label:(resources string:'Configure...') action:[self formattingConfigurationDialog]). |
|
5114 |
box makeTabable:butt. |
|
5115 |
butt left:0.6; width:0.4. |
|
5116 |
||
5117 |
box addHorizontalLine. |
|
5118 |
||
5119 |
||
5120 |
box addCheckBox:(resources string:'Show Error Notifier before Opening Debugger') on:showErrorNotifier. |
|
5121 |
box addCheckBox:(resources string:'Verbose Backtrace by Default in Debugger') on:showVerboseStack. |
|
5122 |
||
5123 |
box addHorizontalLine. |
|
9303 | 5124 |
box |
9753 | 5125 |
addHelpButtonFor:'Launcher/sourceSettings.html'; |
5126 |
addAbortAndOkButtons. |
|
4244 | 5127 |
|
5128 |
box maxExtent:1000@600. |
|
5129 |
||
5130 |
"/ |
|
5131 |
"/ show the box ... |
|
5132 |
"/ |
|
5133 |
box open. |
|
5134 |
||
5135 |
"/ |
|
5136 |
"/ update system settings |
|
5137 |
"/ |
|
5138 |
box accepted ifTrue:[ |
|
9753 | 5139 |
Smalltalk logDoits:logDoits value. |
5140 |
Class updateChanges:updChanges value. |
|
5141 |
ObjectMemory nameForChanges:(changeFileName value). |
|
5142 |
||
5143 |
(hasManager and:[useManager value]) ifTrue:[ |
|
5144 |
manager isNil ifTrue:[ |
|
5145 |
Smalltalk at:#SourceCodeManager put:(AbstractSourceCodeManager defaultManager). |
|
5146 |
manager := Smalltalk at:#SourceCodeManager. |
|
5147 |
]. |
|
5148 |
Class tryLocalSourceFirst:(localSourceFirst value). |
|
5149 |
||
5150 |
manager notNil ifTrue:[ |
|
4244 | 5151 |
"/ localSourceFirst value ifFalse:[ |
5152 |
||
9753 | 5153 |
nm := sourceCacheDir value. |
5154 |
nm size > 0 ifTrue:[ |
|
5155 |
(fn := nm asFilename) exists ifFalse:[ |
|
5156 |
(self confirm:('CVS cache directory ''' , nm , ''' does not exist\create ?' withCRs)) ifTrue:[ |
|
5157 |
fn makeDirectory; |
|
5158 |
makeReadableForAll; |
|
5159 |
makeWritableForAll; |
|
5160 |
makeExecutableForAll. |
|
5161 |
] |
|
5162 |
]. |
|
13241 | 5163 |
(fn isWritableDirectory and:[fn isReadable]) ifTrue:[ |
9753 | 5164 |
AbstractSourceCodeManager cacheDirectoryName:(sourceCacheDir value). |
5165 |
] ifFalse:[ |
|
5166 |
self warn:'Invalid sourceCache directory.' |
|
5167 |
] |
|
5168 |
] |
|
4244 | 5169 |
"/ ] |
9753 | 5170 |
]. |
5171 |
||
5172 |
repositoryHolder notNil ifTrue:[ |
|
5173 |
repositoryHolder value size > 0 ifTrue:[ |
|
5174 |
manager notNil ifTrue:[ |
|
5175 |
manager initializeForRepository:repositoryHolder value. |
|
5176 |
] |
|
5177 |
]. |
|
5178 |
]. |
|
5179 |
] ifFalse:[ |
|
5180 |
Smalltalk at:#SourceCodeManager put:nil |
|
5181 |
]. |
|
5182 |
||
5183 |
showErrorNotifier value ifFalse:[ |
|
5184 |
NoHandlerError emergencyHandler:nil |
|
5185 |
] ifTrue:[ |
|
5186 |
NoHandlerError emergencyHandler:(AbstractLauncherApplication notifyingEmergencyHandler) |
|
5187 |
]. |
|
5188 |
currentUserPrefs verboseBacktraceInDebugger:(showVerboseStack value). |
|
5189 |
currentUserPrefs syntaxColoring:syntaxColoring value. |
|
5190 |
currentUserPrefs at:#fullSelectorCheck put:fullSelectorCheck value. |
|
5191 |
currentUserPrefs autoFormatting:autoFormat value. |
|
5192 |
||
14683
1fd9d79bd0e7
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14682
diff
changeset
|
5193 |
currentUserPrefs at:#checkClassesWhenCheckingIn put:checkClassesWhenCheckingIn value. |
4244 | 5194 |
]. |
5195 |
box destroy |
|
5196 |
||
9753 | 5197 |
"Modified: / 09-09-1996 / 22:43:36 / stefan" |
5198 |
"Created: / 17-01-1997 / 17:39:33 / cg" |
|
5199 |
"Modified: / 16-04-1998 / 17:18:47 / ca" |
|
5200 |
"Modified: / 09-02-2011 / 20:32:56 / cg" |
|
4244 | 5201 |
! |
5202 |
||
5203 |
stcCompilerSettings |
|
6539 | 5204 |
"open an extra dialog on stc-compiler related settings. |
5205 |
Obsoleted by STCCompilerSettingsApp" |
|
4244 | 5206 |
|
9303 | 5207 |
|box |
4244 | 5208 |
stcIncludes stcDefines stcOptions |
9303 | 5209 |
stcLibraries stcLibraryPath cc stc ccOptions |
4244 | 5210 |
linkCommand linkArgs |
9303 | 5211 |
component |
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5212 |
canLoadBinaries |
4244 | 5213 |
resources| |
5214 |
||
5215 |
resources := self owningClass classResources. |
|
5216 |
||
5217 |
canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
|
5218 |
||
6539 | 5219 |
stcIncludes := ParserFlags stcCompilationIncludes asValue. |
5220 |
stcDefines := ParserFlags stcCompilationDefines asValue. |
|
5221 |
stcOptions := ParserFlags stcCompilationOptions asValue. |
|
5222 |
ccOptions := ParserFlags ccCompilationOptions asValue. |
|
5223 |
||
5224 |
cc := ParserFlags ccPath asValue. |
|
5225 |
stc := ParserFlags stcPath asValue. |
|
5226 |
linkCommand := ParserFlags linkCommand asValue. |
|
5227 |
linkArgs := ParserFlags linkArgs asValue. |
|
4244 | 5228 |
|
5229 |
ObjectFileLoader notNil ifTrue:[ |
|
9961 | 5230 |
| t | |
5231 |
(t := ParserFlags searchedLibraries) notNil ifTrue:[ |
|
5232 |
stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue. |
|
5233 |
]. |
|
5234 |
(t := ParserFlags libPath) notNil ifTrue:[ |
|
5235 |
stcLibraryPath := t asValue. |
|
5236 |
] |
|
4244 | 5237 |
]. |
5238 |
||
5239 |
box := DialogBox new. |
|
5240 |
box label:(resources string:'STC Compilation Settings'). |
|
5241 |
||
5242 |
ObjectFileLoader notNil ifTrue:[ |
|
9961 | 5243 |
component := box |
5244 |
addLabelledInputField:(resources string:'stc Command:') |
|
5245 |
adjust:#right |
|
5246 |
on:stc |
|
5247 |
tabable:true |
|
5248 |
separateAtX:0.3. |
|
5249 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5250 |
component preferredExtent:(100 @ component preferredHeight). |
|
5251 |
canLoadBinaries ifFalse:[component disable]. |
|
5252 |
||
5253 |
component := box |
|
5254 |
addLabelledInputField:(resources string:'stc Options:') |
|
5255 |
adjust:#right |
|
5256 |
on:stcOptions |
|
5257 |
tabable:true |
|
5258 |
separateAtX:0.3. |
|
5259 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5260 |
component preferredExtent:(250 @ component preferredHeight). |
|
5261 |
canLoadBinaries ifFalse:[component disable]. |
|
5262 |
||
5263 |
component := box |
|
5264 |
addLabelledInputField:(resources string:'cc Command:') |
|
5265 |
adjust:#right |
|
5266 |
on:cc |
|
5267 |
tabable:true |
|
5268 |
separateAtX:0.3. |
|
5269 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5270 |
component preferredExtent:(150 @ component preferredHeight). |
|
5271 |
canLoadBinaries ifFalse:[component disable]. |
|
5272 |
||
5273 |
component := box |
|
5274 |
addLabelledInputField:(resources string:'cc Options:') |
|
5275 |
adjust:#right |
|
5276 |
on:ccOptions |
|
5277 |
tabable:true |
|
5278 |
separateAtX:0.3. |
|
5279 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5280 |
component preferredExtent:(250 @ component preferredHeight). |
|
5281 |
canLoadBinaries ifFalse:[component disable]. |
|
5282 |
||
5283 |
component := box |
|
5284 |
addLabelledInputField:(resources string:'Include Directories:') |
|
5285 |
adjust:#right |
|
5286 |
on:stcIncludes |
|
5287 |
tabable:true |
|
5288 |
separateAtX:0.3. |
|
5289 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5290 |
component preferredExtent:(250 @ component preferredHeight). |
|
5291 |
canLoadBinaries ifFalse:[component disable]. |
|
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5292 |
|
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5293 |
"/ box addVerticalSpace. |
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5294 |
|
9961 | 5295 |
component := box |
5296 |
addLabelledInputField:(resources string:'Defines:') |
|
5297 |
adjust:#right |
|
5298 |
on:stcDefines |
|
5299 |
tabable:true |
|
5300 |
separateAtX:0.3. |
|
5301 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5302 |
component preferredExtent:(250 @ component preferredHeight). |
|
5303 |
canLoadBinaries ifFalse:[component disable]. |
|
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5304 |
|
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5305 |
"/ box addVerticalSpace. |
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5306 |
|
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5307 |
"/ box addVerticalSpace. |
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5308 |
|
9961 | 5309 |
component := box |
5310 |
addLabelledInputField:(resources string:'Link Command:') |
|
5311 |
adjust:#right |
|
5312 |
on:linkCommand |
|
5313 |
tabable:true |
|
5314 |
separateAtX:0.3. |
|
5315 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5316 |
component preferredExtent:(250 @ component preferredHeight). |
|
5317 |
canLoadBinaries ifFalse:[component disable]. |
|
5318 |
||
5319 |
component := box |
|
5320 |
addLabelledInputField:(resources string:'Link Args:') |
|
5321 |
adjust:#right |
|
5322 |
on:linkArgs |
|
5323 |
tabable:true |
|
5324 |
separateAtX:0.3. |
|
5325 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5326 |
component preferredExtent:(250 @ component preferredHeight). |
|
5327 |
canLoadBinaries ifFalse:[component disable]. |
|
5328 |
||
5329 |
stcLibraries notNil ifTrue:[ |
|
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5330 |
"/ box addVerticalSpace. |
4244 | 5331 |
|
9961 | 5332 |
component := box |
5333 |
addLabelledInputField:(resources string:'C-libraries:') |
|
5334 |
adjust:#right |
|
5335 |
on:stcLibraries |
|
5336 |
tabable:true |
|
5337 |
separateAtX:0.3. |
|
5338 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5339 |
component preferredExtent:(250 @ component preferredHeight). |
|
5340 |
canLoadBinaries ifFalse:[component disable]. |
|
5341 |
]. |
|
5342 |
||
5343 |
stcLibraryPath notNil ifTrue:[ |
|
5277
d08adb84ea30
fixed compiler settings - removed #always option for stc
Michael Beyl <mb@exept.de>
parents:
5210
diff
changeset
|
5344 |
"/ box addVerticalSpace. |
4244 | 5345 |
|
9961 | 5346 |
component := box |
5347 |
addLabelledInputField:(resources string:'stc LibPath:') |
|
5348 |
adjust:#right |
|
5349 |
on:stcLibraryPath |
|
5350 |
tabable:true |
|
5351 |
separateAtX:0.3. |
|
5352 |
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5353 |
component preferredExtent:(250 @ component preferredHeight). |
|
5354 |
canLoadBinaries ifFalse:[component disable]. |
|
5355 |
]. |
|
9303 | 5356 |
]. |
5357 |
||
5358 |
box |
|
9961 | 5359 |
addHelpButtonFor:'Launcher/compilerSettings.html'; |
5360 |
addAbortAndOkButtons. |
|
4244 | 5361 |
|
5362 |
box open. |
|
5363 |
||
5364 |
box accepted ifTrue:[ |
|
9961 | 5365 |
ParserFlags stcCompilationIncludes:stcIncludes value. |
5366 |
ParserFlags stcCompilationDefines:stcDefines value. |
|
5367 |
ParserFlags stcCompilationOptions:stcOptions value. |
|
5368 |
ParserFlags ccCompilationOptions:ccOptions value. |
|
5369 |
ParserFlags ccPath:cc value. |
|
5370 |
stc value ~= ParserFlags stcPath ifTrue:[ |
|
5371 |
ParserFlags stcPath:stc value |
|
5372 |
]. |
|
5373 |
ParserFlags linkCommand:linkCommand value. |
|
5374 |
ParserFlags linkArgs:linkArgs value. |
|
5375 |
||
5376 |
ObjectFileLoader notNil ifTrue:[ |
|
5377 |
stcLibraries notNil ifTrue:[ |
|
5378 |
ParserFlags searchedLibraries:(stcLibraries value asCollectionOfWords). |
|
5379 |
]. |
|
5380 |
stcLibraryPath notNil ifTrue:[ |
|
5381 |
ParserFlags libPath:(stcLibraryPath value). |
|
5382 |
] |
|
5383 |
]. |
|
4244 | 5384 |
]. |
5385 |
box destroy |
|
4386 | 5386 |
" |
5387 |
self stcCompilerSettings |
|
5388 |
" |
|
4244 | 5389 |
"Modified: / 10.9.1995 / 19:19:18 / claus" |
5390 |
"Modified: / 9.9.1996 / 22:42:47 / stefan" |
|
5391 |
"Created: / 2.10.1998 / 16:27:49 / cg" |
|
5392 |
"Modified: / 21.10.1998 / 19:15:10 / cg" |
|
5393 |
! |
|
5394 |
||
5395 |
toolSettings |
|
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
5396 |
"open a dialog on tool settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
5397 |
Obsoleted by the settings application" |
4244 | 5398 |
|
5399 |
|box resources currentUserPrefs in acceptChannel |
|
5400 |
useNewInspector useNewChangesBrowser useNewSystemBrowser useNewVersionDiffBrowser |
|
9303 | 5401 |
useNewFileBrowser showClockInLauncher showClock launcher |
15495
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5402 |
transcriptBufferSize useNewFileDialog useNewSettingsApplication useProcessMonitorV2 |
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5403 |
currentTranscript| |
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5404 |
|
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5405 |
currentTranscript := Transcript current. |
4244 | 5406 |
currentUserPrefs := UserPreferences current. |
5407 |
||
5408 |
resources := self owningClass classResources. |
|
5409 |
||
9303 | 5410 |
"/ |
4244 | 5411 |
"/ extract relevant system settings ... |
5412 |
"/ |
|
5413 |
useNewInspector := currentUserPrefs useNewInspector asValue. |
|
5414 |
useNewChangesBrowser := currentUserPrefs useNewChangesBrowser asValue. |
|
5415 |
useNewSystemBrowser := currentUserPrefs useNewSystemBrowser asValue. |
|
5416 |
showClockInLauncher := currentUserPrefs showClockInLauncher asValue. |
|
5417 |
useNewVersionDiffBrowser := currentUserPrefs useNewVersionDiffBrowser asValue. |
|
5418 |
useNewFileBrowser := currentUserPrefs useNewFileBrowser asValue. |
|
4385
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5419 |
useNewFileDialog := currentUserPrefs useNewFileDialog asValue. |
4386 | 5420 |
useNewSettingsApplication := currentUserPrefs useNewSettingsApplication asValue. |
4464
997576abcb7f
add ProcessMonitorV2 access from menu dependent on userPreferences
penk
parents:
4456
diff
changeset
|
5421 |
useProcessMonitorV2 := currentUserPrefs useProcessMonitorV2 asValue. |
15495
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5422 |
currentTranscript isExternalStream ifTrue:[ |
9961 | 5423 |
transcriptBufferSize := TextCollector defaultLineLimit |
5629
2cb05ef96502
care for nonPosStream transcript
Claus Gittinger <cg@exept.de>
parents:
5623
diff
changeset
|
5424 |
] ifFalse:[ |
15495
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5425 |
transcriptBufferSize := currentTranscript lineLimit printString asValue. |
5629
2cb05ef96502
care for nonPosStream transcript
Claus Gittinger <cg@exept.de>
parents:
5623
diff
changeset
|
5426 |
]. |
4244 | 5427 |
acceptChannel := false asValue. |
5428 |
||
5429 |
"/ |
|
5430 |
"/ create a box on those values ... |
|
5431 |
"/ |
|
5432 |
box := DialogBox new. |
|
5433 |
box label:(resources string:'Tool Settings'). |
|
5434 |
||
5435 |
||
5436 |
box addCheckBox:(resources string:'Use the New System Browser') on:useNewSystemBrowser. |
|
5437 |
box addHorizontalLine. |
|
5438 |
box addCheckBox:(resources string:'Use the New VersionDiff Browser') on:useNewVersionDiffBrowser. |
|
5439 |
box addHorizontalLine. |
|
5440 |
(Smalltalk at:#FileBrowserV2) isBehavior ifTrue:[ |
|
9961 | 5441 |
box addCheckBox:(resources string:'Use the New File Browser') on:useNewFileBrowser. |
5442 |
box addHorizontalLine. |
|
4244 | 5443 |
]. |
4385
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5444 |
(Smalltalk at:#FileDialog) isBehavior ifTrue:[ |
9961 | 5445 |
box addCheckBox:(resources string:'Use the New File Dialog') on:useNewFileDialog. |
5446 |
box addHorizontalLine. |
|
4385
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5447 |
]. |
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5448 |
(Smalltalk at:#SettingsDialog) isBehavior ifTrue:[ |
9961 | 5449 |
box addCheckBox:(resources string:'Use the New Settings Dialog') on:useNewSettingsApplication. |
5450 |
box addHorizontalLine. |
|
4385
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5451 |
]. |
4464
997576abcb7f
add ProcessMonitorV2 access from menu dependent on userPreferences
penk
parents:
4456
diff
changeset
|
5452 |
(Smalltalk at:#ProcessMonitorV2) isBehavior ifTrue:[ |
9961 | 5453 |
box addCheckBox:(resources string:'Use the New ProcessMonitor') on:useProcessMonitorV2. |
5454 |
box addHorizontalLine. |
|
4464
997576abcb7f
add ProcessMonitorV2 access from menu dependent on userPreferences
penk
parents:
4456
diff
changeset
|
5455 |
]. |
4936 | 5456 |
box addCheckBox:(resources string:'Use the New Changes Browser') on:useNewChangesBrowser. |
5457 |
box addHorizontalLine. |
|
4244 | 5458 |
box addCheckBox:(resources string:'Use Hierarchical Inspector') on:useNewInspector. |
5459 |
box addHorizontalLine. |
|
5460 |
box addCheckBox:(resources string:'Show Clock in Launcher') on:showClockInLauncher. |
|
5461 |
box addHorizontalLine. |
|
9303 | 5462 |
in := box |
9961 | 5463 |
addLabelledInputField:(resources string:'Transcripts Buffer Size:') |
5464 |
adjust:#right |
|
5465 |
on:transcriptBufferSize |
|
5466 |
tabable:true |
|
5467 |
separateAtX:0.6. |
|
4244 | 5468 |
in acceptChannel:acceptChannel. |
5469 |
box addHorizontalLine. |
|
5470 |
||
9303 | 5471 |
box |
9961 | 5472 |
addHelpButtonFor:'Launcher/toolSettings.html'; |
5473 |
addAbortAndOkButtons. |
|
4244 | 5474 |
|
5475 |
"/ |
|
5476 |
"/ show the box ... |
|
5477 |
"/ |
|
5478 |
box open. |
|
5479 |
||
5480 |
"/ |
|
5481 |
"/ update system settings |
|
5482 |
"/ |
|
5483 |
box accepted ifTrue:[ |
|
9961 | 5484 |
acceptChannel value:false; value:true. |
5485 |
||
5486 |
currentUserPrefs useNewInspector:useNewInspector value. |
|
5487 |
currentUserPrefs useNewChangesBrowser:useNewChangesBrowser value. |
|
5488 |
currentUserPrefs useNewSystemBrowser:useNewSystemBrowser value. |
|
5489 |
currentUserPrefs useNewVersionDiffBrowser:useNewVersionDiffBrowser value. |
|
5490 |
currentUserPrefs useNewFileBrowser:useNewFileBrowser value. |
|
5491 |
currentUserPrefs useNewFileDialog:useNewFileDialog value. |
|
5492 |
currentUserPrefs useProcessMonitorV2:useProcessMonitorV2 value. |
|
5493 |
currentUserPrefs useNewSettingsApplication ~= useNewSettingsApplication value ifTrue:[ |
|
5494 |
currentUserPrefs useNewSettingsApplication:useNewSettingsApplication value. |
|
5495 |
NewLauncher open. |
|
5496 |
]. |
|
5497 |
(Smalltalk at:#FileBrowserV2) isBehavior ifTrue:[ |
|
5498 |
useNewFileBrowser value ifTrue:[ |
|
5499 |
FileBrowserV2 installInLauncher. |
|
5500 |
] ifFalse:[ |
|
5501 |
FileBrowserV2 isLoaded ifTrue:[ |
|
5502 |
FileBrowserV2 removeFromLauncher. |
|
5503 |
] |
|
5504 |
]. |
|
5505 |
]. |
|
5506 |
showClock := showClockInLauncher value. |
|
5507 |
currentUserPrefs showClockInLauncher ~= showClock ifTrue:[ |
|
5508 |
currentUserPrefs showClockInLauncher:showClock. |
|
15495
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5509 |
currentTranscript isExternalStream ifFalse:[ |
9961 | 5510 |
launcher := Transcript application. |
5511 |
(launcher isKindOf:ToolApplicationModel) ifTrue:[ |
|
5512 |
showClock ifTrue:[ |
|
5513 |
launcher startClock |
|
5514 |
] ifFalse:[ |
|
5515 |
launcher stopClock |
|
5516 |
] |
|
5517 |
] |
|
5518 |
] |
|
5519 |
]. |
|
5520 |
||
5521 |
Inspector := currentUserPrefs inspectorClassSetting. |
|
5522 |
||
15495
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5523 |
transcriptBufferSize := Integer readFrom:transcriptBufferSize value onError:currentTranscript lineLimit. |
41d4ea9d99d8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15385
diff
changeset
|
5524 |
currentTranscript lineLimit:transcriptBufferSize. |
4244 | 5525 |
|
5526 |
]. |
|
5527 |
box destroy |
|
5528 |
||
4385
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5529 |
" |
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5530 |
self toolSettings |
47c861cdeb58
allow change of settings dialog delction and use new FileDialog
penk
parents:
4382
diff
changeset
|
5531 |
" |
4244 | 5532 |
"Modified: / 9.9.1996 / 22:43:36 / stefan" |
5533 |
"Modified: / 16.4.1998 / 17:18:47 / ca" |
|
5534 |
"Created: / 13.10.1998 / 15:44:36 / cg" |
|
5535 |
"Modified: / 12.11.2001 / 15:48:54 / cg" |
|
5536 |
! |
|
5537 |
||
5538 |
viewStyleSettings |
|
5539 |
self viewStyleSettingsFor:nil |
|
5540 |
! |
|
5541 |
||
9303 | 5542 |
viewStyleSettingsFor:requestor |
13143
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
5543 |
"open a dialog on viewStyle related settings. |
ea1a7e8104c2
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13119
diff
changeset
|
5544 |
Obsoleted by the settings application" |
4244 | 5545 |
|
9303 | 5546 |
|resourceDir dir box |
4244 | 5547 |
list listView scrView infoLabel infoForwarder newStyle |
5548 |
someRsrcFile didApply resources listUpdater showStandardStylesOnly standardStyles| |
|
5549 |
||
5550 |
showStandardStylesOnly := true asValue. |
|
5551 |
standardStyles := #( |
|
9961 | 5552 |
'decWindows' |
5553 |
'iris' |
|
5554 |
'motif' |
|
5555 |
'mswindows95' |
|
12059
9daa2caa5dcd
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
11990
diff
changeset
|
5556 |
'mswindowsXP' |
9daa2caa5dcd
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
11990
diff
changeset
|
5557 |
'mswindowsVista' |
9961 | 5558 |
'next' |
5559 |
'normal' |
|
5560 |
'os2' |
|
5561 |
'st80' |
|
5562 |
). |
|
4244 | 5563 |
|
5564 |
resources := self owningClass classResources. |
|
5565 |
||
5566 |
" |
|
5567 |
search resources directory for a list of .style files ... |
|
5568 |
" |
|
5569 |
someRsrcFile := Smalltalk getSystemFileName:('resources' asFilename constructString:'normal.style'). |
|
5570 |
someRsrcFile isNil ifTrue:[ |
|
9961 | 5571 |
someRsrcFile := Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'. |
5572 |
someRsrcFile isNil ifTrue:[ |
|
5573 |
someRsrcFile := Smalltalk getResourceFileName:'styles/normal.style' forPackage:'stx:libview'. |
|
5574 |
]. |
|
4244 | 5575 |
]. |
5576 |
someRsrcFile notNil ifTrue:[ |
|
9961 | 5577 |
resourceDir := someRsrcFile asFilename directoryName |
4244 | 5578 |
] ifFalse:[ |
9961 | 5579 |
resourceDir := Smalltalk getSystemFileName:'resources'. |
4244 | 5580 |
]. |
5581 |
||
5582 |
resourceDir isNil ifTrue:[ |
|
9961 | 5583 |
self warn:'no styles found (missing ''resources'' directory)'. |
5584 |
^ self |
|
4244 | 5585 |
]. |
5586 |
dir := resourceDir asFilename directoryContents. |
|
5587 |
||
5588 |
list := SelectionInList new. |
|
5589 |
||
5590 |
listUpdater := [ |
|
9961 | 5591 |
|listOfStyles lastSelection| |
5592 |
||
5593 |
lastSelection := list selection. |
|
5594 |
listOfStyles := dir select:[:aFileName | aFileName asFilename hasSuffix:'style']. |
|
5595 |
listOfStyles := listOfStyles collect:[:aFileName | aFileName asFilename nameWithoutSuffix]. |
|
5596 |
Filename isCaseSensitive ifFalse:[ |
|
5597 |
listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase]. |
|
5598 |
]. |
|
5599 |
listOfStyles remove:'generic' ifAbsent:nil; remove:'mswindows3' ifAbsent:nil. |
|
5600 |
showStandardStylesOnly value ifTrue:[ |
|
5601 |
listOfStyles := listOfStyles select:[:aStyleName | standardStyles includes:aStyleName]. |
|
5602 |
]. |
|
5603 |
||
5604 |
listOfStyles sort. |
|
5605 |
list list:listOfStyles. |
|
5606 |
list selection:lastSelection. |
|
4244 | 5607 |
]. |
5608 |
listUpdater value. |
|
5609 |
||
5610 |
showStandardStylesOnly onChangeEvaluate:listUpdater. |
|
5611 |
||
5612 |
infoForwarder := [ |
|
9961 | 5613 |
|nm sheet comment| |
5614 |
||
5615 |
comment := ''. |
|
5616 |
nm := list selection. |
|
5617 |
nm notNil ifTrue:[ |
|
5618 |
sheet := ViewStyle fromFile:(nm , '.style'). |
|
5619 |
comment := (sheet at:#comment ifAbsent:'') withoutSeparators. |
|
5620 |
]. |
|
5621 |
comment := comment withCRs asStringCollection. |
|
5622 |
comment size == 1 ifTrue:[ |
|
5623 |
comment := comment first |
|
5624 |
]. |
|
5625 |
infoLabel label:comment |
|
5626 |
]. |
|
4244 | 5627 |
|
5628 |
list onChangeEvaluate:infoForwarder. |
|
5629 |
||
5630 |
box := Dialog new. |
|
5631 |
box label:(resources string:'Style Selection'). |
|
5632 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
5633 |
box addTextLabel:(resources at:'STYLE_MSG' default:'Select a Style') withCRs adjust:#left. |
4244 | 5634 |
listView := SelectionInListView on:list. |
5635 |
listView doubleClickAction:[:sel | box acceptChannel value:true. box hide]. |
|
5636 |
box addCheckBox:(resources string:'standard styles only') on:showStandardStylesOnly. |
|
5637 |
scrView := box addComponent:(ScrollableView forView:listView) tabable:true. |
|
5638 |
||
5639 |
box addVerticalSpace. |
|
5640 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
5641 |
infoLabel := box addTextLabel:'\\' withCRs adjust:#centerLeft. |
4244 | 5642 |
|
5643 |
box addAbortAndOkButtons. |
|
5644 |
"/ mhmh - the newLauncher does not yet handle apply (without close) correctly |
|
5645 |
"/ b := box addButton:(Button label:(resources string:'apply')). |
|
5646 |
"/ b action:[didApply := true. requestor changeViewStyleTo:(list selection)]. |
|
5647 |
||
5648 |
(standardStyles includes:View defaultStyle) ifFalse:[ |
|
9961 | 5649 |
showStandardStylesOnly value:false |
4244 | 5650 |
]. |
5651 |
list selection:(View defaultStyle). |
|
5652 |
||
5653 |
box stickAtBottomWithVariableHeight:scrView. |
|
5654 |
box stickAtBottomWithFixHeight:infoLabel. |
|
5655 |
didApply := false. |
|
5656 |
box open. |
|
5657 |
||
5658 |
box destroy. |
|
5659 |
box accepted ifTrue:[ |
|
9961 | 5660 |
((newStyle := list selection) ~= View defaultStyle |
5661 |
or:[didApply ~~ true]) ifTrue:[ |
|
5662 |
requestor notNil ifTrue:[requestor changeViewStyleTo:newStyle]. |
|
5663 |
]. |
|
4244 | 5664 |
]. |
5665 |
||
5666 |
" |
|
5667 |
self viewStyleSettingsFor:nil |
|
5668 |
" |
|
5669 |
||
7484 | 5670 |
"Modified: / 07-11-2006 / 13:58:06 / cg" |
2001 | 5671 |
! ! |
5672 |
||
4914 | 5673 |
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-file'! |
2001 | 5674 |
|
4244 | 5675 |
objectModuleDialog |
5676 |
"opens a moduleInfo dialog" |
|
5677 |
||
7313 | 5678 |
self objectModuleDialogReadOnly:false |
5679 |
||
5680 |
"Modified: / 19-09-2006 / 19:14:20 / cg" |
|
5681 |
! |
|
5682 |
||
5683 |
objectModuleDialogReadOnly |
|
5684 |
"opens a moduleInfo dialog" |
|
5685 |
||
5686 |
self objectModuleDialogReadOnly:true |
|
5687 |
||
5688 |
"Created: / 19-09-2006 / 19:14:27 / cg" |
|
5689 |
! |
|
5690 |
||
5691 |
objectModuleDialogReadOnly:readOnly |
|
5692 |
"opens a moduleInfo dialog" |
|
5693 |
||
4244 | 5694 |
|allModules moduleNames |
9303 | 5695 |
allObjects methodObjects methodNames |
4244 | 5696 |
cObjects cObjectNames |
5697 |
otherObjects otherObjectNames |
|
5698 |
box l handles unloadButton unloadAndRemoveButton |
|
5699 |
list1 list2 listView1 listView2 |
|
9303 | 5700 |
y panel |
4244 | 5701 |
showBuiltIn showModules showMethods showCObjects showOthers |
5702 |
moduleListUpdater check canDoIt menu |
|
9374 | 5703 |
resources middleLabel device screenW screenH| |
4244 | 5704 |
|
5705 |
resources := self owningClass classResources. |
|
5706 |
||
9303 | 5707 |
showBuiltIn := true asValue. |
4244 | 5708 |
canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
5709 |
||
9303 | 5710 |
showModules := canDoIt asValue. |
4244 | 5711 |
showMethods := canDoIt asValue. |
5712 |
showCObjects := canDoIt asValue. |
|
5713 |
showOthers := canDoIt asValue. |
|
5714 |
||
5715 |
list1 := SelectionInList new. |
|
5716 |
list2 := SelectionInList new. |
|
5717 |
||
5718 |
moduleListUpdater := [ |
|
9374 | 5719 |
|l| |
5720 |
||
5721 |
list2 list:nil. |
|
5722 |
||
16886 | 5723 |
l := #(). |
5724 |
handles := #(). |
|
9374 | 5725 |
|
5726 |
(showModules value or:[showBuiltIn value]) ifTrue:[ |
|
5727 |
allModules := ObjectMemory binaryModuleInfo asOrderedCollection. |
|
5728 |
(showBuiltIn value and:[showModules value]) ifFalse:[ |
|
5729 |
allModules := allModules select:[:i | |
|
5730 |
|wantToSee| |
|
5731 |
||
5732 |
wantToSee := i dynamic. |
|
5733 |
showBuiltIn value ifTrue:[ |
|
5734 |
wantToSee := wantToSee not |
|
5735 |
]. |
|
5736 |
wantToSee |
|
5737 |
] |
|
5738 |
]. |
|
5739 |
||
5740 |
"/ sorting by reverse id brings newest ones to the top (a side effect) |
|
5741 |
allModules sort:[:a :b | (a id) > (b id)]. |
|
5742 |
moduleNames := allModules collect:[:entry | entry name]. |
|
5743 |
l := l , moduleNames. |
|
5744 |
handles := handles , allModules. |
|
5745 |
]. |
|
5746 |
||
5747 |
showMethods value ifTrue:[ |
|
5748 |
allObjects := ObjectFileLoader loadedObjectHandles. |
|
5749 |
methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray. |
|
5750 |
methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[ |
|
5751 |
'compiled method - removed' " , ' (in ' , mH pathName , ')' " |
|
5752 |
] ifFalse:[ |
|
5753 |
'compiled method ' , mH method whoString " , ' (in ' , mH pathName , ')' " |
|
5754 |
]. |
|
5755 |
]. |
|
5756 |
l := l , methodNames. |
|
5757 |
handles := handles , methodObjects. |
|
5758 |
]. |
|
5759 |
||
5760 |
showCObjects value ifTrue:[ |
|
5761 |
allObjects := ObjectFileLoader loadedObjectHandles. |
|
5762 |
cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray. |
|
5763 |
cObjectNames := cObjects collect:[:entry | entry pathName]. |
|
5764 |
l := l , cObjectNames. |
|
5765 |
handles := handles , cObjects. |
|
5766 |
]. |
|
5767 |
||
5768 |
showOthers value ifTrue:[ |
|
5769 |
allObjects := ObjectFileLoader loadedObjectHandles. |
|
12823
50a3b78ef6e7
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12756
diff
changeset
|
5770 |
otherObjects := (allObjects reject:[:h | (h isFunctionObjectHandle |
9374 | 5771 |
or:[h isMethodHandle |
12823
50a3b78ef6e7
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12756
diff
changeset
|
5772 |
or:[h isClassLibHandle]])]) asArray. |
9374 | 5773 |
otherObjectNames := otherObjects collect:[:entry | entry pathName]. |
5774 |
l := l , otherObjectNames. |
|
5775 |
handles := handles , otherObjects. |
|
5776 |
]. |
|
5777 |
||
5778 |
showBuiltIn value ifTrue:[ |
|
5779 |
l := #('VM') , l. |
|
5780 |
handles := #(VM) , handles. |
|
5781 |
allModules := #(VM) , allModules. |
|
5782 |
]. |
|
5783 |
||
5784 |
list1 list:l. |
|
5785 |
readOnly ifFalse:[ |
|
5786 |
unloadButton disable. |
|
5787 |
unloadAndRemoveButton disable. |
|
5788 |
] |
|
5789 |
]. |
|
4244 | 5790 |
|
5791 |
showBuiltIn onChangeEvaluate:moduleListUpdater. |
|
5792 |
showModules onChangeEvaluate:moduleListUpdater. |
|
5793 |
showMethods onChangeEvaluate:moduleListUpdater. |
|
5794 |
showCObjects onChangeEvaluate:moduleListUpdater. |
|
5795 |
showOthers onChangeEvaluate:moduleListUpdater. |
|
5796 |
||
5797 |
box := Dialog new. |
|
5410 | 5798 |
box label:(resources string:'ST/X & Module Version Information'). |
4244 | 5799 |
|
5800 |
listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true. |
|
5801 |
listView1 model:list1. |
|
5802 |
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2. |
|
5803 |
listView1 action:[:sel | |
|
9374 | 5804 |
|info classNames tabs module| |
5805 |
||
5806 |
listView1 middleButtonMenu:nil. |
|
5807 |
||
5808 |
box withWaitCursorDo:[ |
|
5809 |
|nm fileName addr entry1 entry2 entry3 method l| |
|
5810 |
||
5811 |
tabs := TabulatorSpecification unit:#inch positions:#(0 2.6 3.5). |
|
5812 |
||
5813 |
(showModules value or:[showBuiltIn value]) ifTrue:[ |
|
5814 |
info := allModules at:sel ifAbsent:nil. |
|
5815 |
]. |
|
5816 |
info isNil ifTrue:[ |
|
5817 |
"/ selected a method, cObject or unknown |
|
5818 |
||
5819 |
module := handles at:sel. |
|
5820 |
fileName := module pathName. |
|
5821 |
||
5822 |
module isMethodHandle ifTrue:[ |
|
5823 |
middleLabel label:'contains method:'. |
|
5824 |
||
5825 |
(method := module method) isNil ifTrue:[ |
|
5826 |
nm := '** removed **'. |
|
5827 |
] ifFalse:[ |
|
5828 |
menu := PopUpMenu |
|
5829 |
labels:#('Inspect' 'Browse') |
|
5830 |
selectors:#(inspect browse). |
|
5831 |
menu actionAt:#inspect put:[ method inspect ]. |
|
5832 |
menu actionAt:#browse put:[ |who| |
|
5833 |
who := method who. |
|
5834 |
UserPreferences systemBrowserClass |
|
5835 |
openInClass:(who methodClass) |
|
5836 |
selector:(who methodSelector) |
|
5837 |
]. |
|
5838 |
listView1 middleButtonMenu:menu. |
|
5839 |
||
16410 | 5840 |
nm := (method whoString) withColor:(Color blue). |
9374 | 5841 |
]. |
5842 |
entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5843 |
entry1 colAt:1 put:'compiled method'; colAt:2 put:nm. |
|
5844 |
||
5845 |
entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5846 |
entry2 colAt:1 put:'path'; colAt:2 put:fileName. |
|
5847 |
||
5848 |
entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5849 |
entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)). |
|
5850 |
||
5851 |
list2 list:(Array with:entry1 with:entry2 with:entry3). |
|
5852 |
] ifFalse:[ |
|
5853 |
(module isFunctionObjectHandle |
|
5854 |
and:[module functions notEmpty]) ifTrue:[ |
|
5855 |
middleLabel label:'contains function:'. |
|
5856 |
||
5857 |
menu := PopUpMenu |
|
5858 |
labels:#('Inspect') |
|
5859 |
selectors:#(inspect). |
|
5860 |
menu actionAt:#inspect put:[ module functions inspect ]. |
|
5861 |
listView1 middleButtonMenu:menu. |
|
5862 |
||
5863 |
list2 list:((module functions select:[:f | f notNil]) |
|
5864 |
collect:[:f | |entry| |
|
5865 |
entry := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
16410 | 5866 |
entry colAt:1 put:(f name withColor:Color blue). |
9374 | 5867 |
entry colAt:2 put:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)). |
5868 |
entry |
|
5869 |
]). |
|
5870 |
] ifFalse:[ |
|
5871 |
list2 list:#('nothing known about contents (no functions have been extracted)'). |
|
5872 |
] |
|
5873 |
]. |
|
5874 |
||
5875 |
readOnly ifFalse:[ |
|
5876 |
unloadButton enable. |
|
5877 |
unloadAndRemoveButton disable. |
|
5878 |
] |
|
5879 |
] ifFalse:[ |
|
5880 |
info == #VM ifTrue:[ |
|
5881 |
"/ dummy entry for VM; |
|
5882 |
"/ show file versions in lower view. |
|
5883 |
||
5884 |
middleLabel label:'contains modules:'. |
|
5885 |
l := (ObjectMemory getVMIdentificationStrings). |
|
5886 |
l := l select:[:entry | entry includesString:'$Header']. |
|
5887 |
l := l select:[:entry | entry includesString:',v']. |
|
5888 |
l := l collect:[:entry | |
|
5889 |
|i1 i2 file revision date listEntry| |
|
5890 |
||
5891 |
listEntry := MultiColListEntry new:3 tabulatorSpecification:tabs. |
|
5892 |
||
5893 |
i1 := entry indexOfSubCollection:'librun'. |
|
5894 |
i1 ~~ 0 ifTrue:[ |
|
5895 |
i2 := entry indexOfSubCollection:',v' startingAt:i1. |
|
5896 |
i2 ~~ 0 ifTrue:[ |
|
5897 |
file := entry copyFrom:i1+7 to:(i2-1). |
|
5898 |
listEntry colAt:1 put:file. |
|
5899 |
||
5900 |
i1 := i2+3. |
|
5901 |
i2 := entry indexOfSeparatorStartingAt:i1. |
|
5902 |
revision := entry copyFrom:i1 to:(i2-1). |
|
5903 |
listEntry colAt:2 put:revision. |
|
5904 |
||
5905 |
i1 := i2+1. |
|
5906 |
i2 := entry indexOfSeparatorStartingAt:i1. |
|
5907 |
date := entry copyFrom:i1 to:(i2-1). |
|
5908 |
listEntry colAt:3 put:date. |
|
5909 |
]. |
|
5910 |
]. |
|
5911 |
listEntry. |
|
5912 |
"/ entry |
|
5913 |
]. |
|
5914 |
list2 list:l. |
|
5915 |
||
5916 |
readOnly ifFalse:[ |
|
5917 |
unloadButton disable. |
|
5918 |
unloadAndRemoveButton disable. |
|
5919 |
] |
|
5920 |
] ifFalse:[ |
|
5921 |
"/ selected a package |
|
5922 |
||
5923 |
"/ fill bottom list with class-info |
|
5924 |
||
5925 |
middleLabel label:'contains classes:'. |
|
5926 |
classNames := info classNames asSortedCollection. |
|
5927 |
classNames := classNames select:[:cName | |
|
5928 |
|cls| |
|
5929 |
||
5930 |
cls := Smalltalk classNamed:cName. |
|
5931 |
cls isNil ifTrue:[ |
|
5932 |
true "a removed class" |
|
5933 |
] ifFalse:[ |
|
5934 |
cls isPrivate not |
|
5935 |
]. |
|
5936 |
]. |
|
5937 |
||
5938 |
classNames := classNames collect:[:cName | |
|
5939 |
|cls entry rev listEntry| |
|
5940 |
||
5941 |
listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5942 |
listEntry colAt:1 put:cName. |
|
5943 |
||
5944 |
cls := Smalltalk classNamed:cName. |
|
5945 |
cls isNil ifTrue:[ |
|
5946 |
listEntry colAt:2 put:'(class removed)'. |
|
5947 |
] ifFalse:[ |
|
5948 |
rev := cls binaryRevision. |
|
5949 |
rev notNil ifTrue:[ |
|
5950 |
cls isLoaded ifFalse:[ |
|
5951 |
entry := '(stub for: ' , rev. |
|
5952 |
] ifTrue:[ |
|
5953 |
entry :='(bin: ' , rev. |
|
5954 |
]. |
|
5955 |
cls revision ~= rev ifTrue:[ |
|
5956 |
entry := entry , ' / src: ' , (cls revision printString) |
|
5957 |
]. |
|
5958 |
listEntry colAt:2 put:entry , ')' |
|
5959 |
] ifFalse:[ |
|
5960 |
cls revision notNil ifTrue:[ |
|
5961 |
listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')' |
|
5962 |
] |
|
5963 |
] |
|
5964 |
]. |
|
5965 |
listEntry |
|
5966 |
]. |
|
5967 |
list2 list:classNames. |
|
5968 |
readOnly ifFalse:[ |
|
5969 |
info dynamic ifTrue:[ |
|
5970 |
unloadButton enable. |
|
5971 |
unloadAndRemoveButton enable. |
|
5972 |
] ifFalse:[ |
|
5973 |
unloadButton disable. |
|
5974 |
unloadAndRemoveButton disable. |
|
5975 |
]. |
|
5976 |
]. |
|
5977 |
]. |
|
5978 |
] |
|
5979 |
] |
|
4244 | 5980 |
]. |
5981 |
||
5982 |
||
5983 |
panel := HorizontalPanelView new. |
|
5984 |
||
5410 | 5985 |
panel add:(l := Label label:'Show:'). |
4244 | 5986 |
l adjust:#left; borderWidth:0. |
5410 | 5987 |
panel add:(check := CheckBox label:'Builtin' model:showBuiltIn). |
4244 | 5988 |
box makeTabable:check. |
5410 | 5989 |
panel add:(check := CheckBox label:'ClassLibs' model:showModules). |
4244 | 5990 |
canDoIt ifFalse:[ |
9374 | 5991 |
check disable |
4244 | 5992 |
] ifTrue:[ |
9374 | 5993 |
box makeTabable:check. |
4244 | 5994 |
]. |
5410 | 5995 |
panel add:(check := CheckBox label:'Methods' model:showMethods). |
4244 | 5996 |
canDoIt ifFalse:[ |
9374 | 5997 |
check disable |
4244 | 5998 |
] ifTrue:[ |
9374 | 5999 |
box makeTabable:check. |
4244 | 6000 |
]. |
5410 | 6001 |
panel add:(check := CheckBox label:'C-objects' model:showCObjects). |
4244 | 6002 |
canDoIt ifFalse:[ |
9374 | 6003 |
check disable |
4244 | 6004 |
] ifTrue:[ |
9374 | 6005 |
box makeTabable:check. |
4244 | 6006 |
]. |
5410 | 6007 |
panel add:(check := CheckBox label:'Others' model:showOthers). |
4244 | 6008 |
canDoIt ifFalse:[ |
9374 | 6009 |
check disable |
4244 | 6010 |
] ifTrue:[ |
9374 | 6011 |
box makeTabable:check. |
4244 | 6012 |
]. |
6013 |
||
6014 |
panel horizontalLayout:#fitSpace. |
|
6015 |
"/ panel horizontalLayout:#leftSpace. |
|
6016 |
||
6017 |
box addComponent:panel tabable:false. |
|
6018 |
||
6019 |
box addVerticalSpace. |
|
6020 |
box addComponent:listView1 tabable:true. |
|
8160
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
6021 |
listView1 topInset:(View viewSpacing + panel preferredHeight). |
4244 | 6022 |
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2. |
6023 |
||
5410 | 6024 |
l := box addTextLabel:(resources string:'Contains:'). |
4244 | 6025 |
l adjust:#left; borderWidth:0. |
6026 |
l origin:0.0@0.4 corner:1.0@0.4. |
|
6027 |
l topInset:(View viewSpacing). |
|
8160
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
6028 |
l bottomInset:((l preferredHeight) negated - View viewSpacing). |
4244 | 6029 |
middleLabel := l. |
6030 |
||
6031 |
listView2 := HVScrollableView for:SelectionInListView miniScrollerH:true. |
|
6032 |
listView2 model:list2; printItems:false. |
|
6033 |
box addComponent:listView2 tabable:true. |
|
6034 |
listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2. |
|
6035 |
listView2 disable. |
|
6036 |
||
9303 | 6037 |
menu := PopUpMenu |
9374 | 6038 |
itemList:#( |
6039 |
('Copy List' copyList ) |
|
6040 |
) |
|
6041 |
resources:resources. |
|
9303 | 6042 |
menu |
9374 | 6043 |
actionAt:#copyList |
6044 |
put:[ listView2 setClipboardText:((listView2 list collect:[:l | l string]) asStringCollection asString) ]. |
|
5440 | 6045 |
listView2 middleButtonMenu:menu. |
6046 |
||
7313 | 6047 |
readOnly ifFalse:[ |
9374 | 6048 |
unloadButton := Button label:(resources string:'Unload'). |
6049 |
unloadButton action:[ |
|
6050 |
box withWaitCursorDo:[ |
|
9411
04a4ec0fd112
When unloading an ObjectFileHandle, use ObjectFileHandle instance methods
Stefan Vogel <sv@exept.de>
parents:
9374
diff
changeset
|
6051 |
|handle idx| |
9374 | 6052 |
|
6053 |
idx := list1 selectionIndex. |
|
6054 |
list1 selectionIndex:nil. |
|
6055 |
||
9411
04a4ec0fd112
When unloading an ObjectFileHandle, use ObjectFileHandle instance methods
Stefan Vogel <sv@exept.de>
parents:
9374
diff
changeset
|
6056 |
handle := handles at:idx. |
04a4ec0fd112
When unloading an ObjectFileHandle, use ObjectFileHandle instance methods
Stefan Vogel <sv@exept.de>
parents:
9374
diff
changeset
|
6057 |
handle notNil ifTrue:[ |
04a4ec0fd112
When unloading an ObjectFileHandle, use ObjectFileHandle instance methods
Stefan Vogel <sv@exept.de>
parents:
9374
diff
changeset
|
6058 |
handle unload. |
9374 | 6059 |
]. |
6060 |
moduleListUpdater value. |
|
6061 |
unloadButton disable. |
|
6062 |
] |
|
6063 |
]. |
|
6064 |
||
6065 |
unloadAndRemoveButton := Button label:(resources string:'Remove Classes & Unload'). |
|
6066 |
unloadAndRemoveButton action:[ |
|
6067 |
box withWaitCursorDo:[ |
|
6068 |
|info idx pathName| |
|
6069 |
||
6070 |
idx := list1 selectionIndex. |
|
6071 |
info := allModules at:idx ifAbsent:nil. |
|
6072 |
||
6073 |
list1 selectionIndex:nil. |
|
6074 |
||
6075 |
info isNil ifTrue:[ |
|
6076 |
"/ selected a method |
|
6077 |
"/ idx := idx - allModules size. |
|
6078 |
pathName := (handles at:idx) pathName. |
|
6079 |
||
6080 |
] ifFalse:[ |
|
6081 |
"/ selected a package |
|
6082 |
pathName := info pathName. |
|
6083 |
]. |
|
6084 |
ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName. |
|
6085 |
moduleListUpdater value. |
|
6086 |
unloadAndRemoveButton disable. |
|
6087 |
] |
|
6088 |
]. |
|
4244 | 6089 |
]. |
6090 |
||
6091 |
moduleListUpdater value. |
|
6092 |
||
7313 | 6093 |
readOnly ifFalse:[ |
9374 | 6094 |
box addButton:unloadButton. |
6095 |
box addButton:unloadAndRemoveButton. |
|
7313 | 6096 |
]. |
5410 | 6097 |
box addAbortButtonLabelled:(resources string:'Dismiss'). |
4244 | 6098 |
|
6099 |
y := box yPosition. |
|
8160
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
6100 |
listView2 topInset:(l preferredHeight + 5). |
0dcbd8d60198
added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents:
8150
diff
changeset
|
6101 |
listView2 bottomInset:(box preferredHeight - y). |
4244 | 6102 |
|
9374 | 6103 |
device := box device. |
6104 |
screenW := device width. |
|
6105 |
screenH := device height. |
|
6106 |
box width:(400 min:(screenW * 2 // 3)); |
|
6107 |
height:(450 min:(screenH - 50)). |
|
4244 | 6108 |
|
6109 |
"/ box sizeFixed:true. |
|
9374 | 6110 |
box extent:(600 min:(screenW * 2 // 3)) |
6111 |
@ |
|
6112 |
(500 min:(screenH - 50)) . |
|
5440 | 6113 |
box openModeless. |
6114 |
"/ box destroy. |
|
4398 | 6115 |
" |
6116 |
self objectModuleDialog |
|
6117 |
" |
|
4244 | 6118 |
|
7313 | 6119 |
"Modified: / 17-09-1995 / 16:47:50 / claus" |
6120 |
"Created: / 19-09-2006 / 19:14:06 / cg" |
|
2001 | 6121 |
! ! |
6122 |
||
4914 | 6123 |
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-private'! |
2001 | 6124 |
|
4244 | 6125 |
cvsConfigurationDialog |
9303 | 6126 |
|cvsRootHolder resources defaultsList bindings dialog |
4244 | 6127 |
listOfModules selectedPerModuleRoot rootsPerModule acceptChannel |
7332 | 6128 |
removeEnabled cvsExecutableHolder| |
4244 | 6129 |
|
6130 |
resources := self owningClass classResources. |
|
6131 |
||
9528 | 6132 |
OperatingSystem getDomainName = 'bh.exept.de' ifTrue:[ |
6133 |
defaultsList := #( |
|
6134 |
'cvs.bh.exept.de:/cvs/stx' |
|
6135 |
). |
|
6136 |
defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@cvs.bh.exept.de:/cvs/stx') |
|
6137 |
] ifFalse:[ |
|
6138 |
defaultsList := #( |
|
6139 |
':pserver:user@CVSHOST:/cvs/stx' |
|
6140 |
). |
|
6141 |
defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@CVSHOST:/cvs/stx') |
|
4510 | 6142 |
]. |
6143 |
||
4244 | 6144 |
OperatingSystem isUNIXlike ifTrue:[ |
9528 | 6145 |
defaultsList := defaultsList , #( |
6146 |
'/cvs/stx' |
|
6147 |
). |
|
4244 | 6148 |
] ifFalse:[ |
9528 | 6149 |
OperatingSystem isMSDOSlike ifTrue:[ |
6150 |
defaultsList := defaultsList , #( |
|
6151 |
':local:c:\cvs\stx' |
|
6152 |
). |
|
6153 |
] ifFalse:[ |
|
6154 |
"there might be more here in the future" |
|
6155 |
] |
|
4244 | 6156 |
]. |
6157 |
||
4766 | 6158 |
cvsRootHolder := CVSSourceCodeManager repositoryName ? '/cvs/stx'. |
4244 | 6159 |
cvsRootHolder := cvsRootHolder asValue. |
5944
4fef6e1d18ff
Use #addAll: instead of #declareAllFrom:, since #declareAllFrom:
Stefan Vogel <sv@exept.de>
parents:
5917
diff
changeset
|
6160 |
rootsPerModule := Dictionary new. |
6995 | 6161 |
rootsPerModule addAll:(CVSSourceCodeManager repositoryInfoPerModule). |
7332 | 6162 |
cvsExecutableHolder := CVSSourceCodeManager cvsExecutable asValue. |
4244 | 6163 |
|
6164 |
bindings := IdentityDictionary new. |
|
6165 |
bindings at:#acceptChannel put:(acceptChannel := TriggerValue new). |
|
6166 |
||
6167 |
bindings at:#cvsRootPrototypeList put:defaultsList. |
|
6168 |
bindings at:#cvsRootHolder put:cvsRootHolder. |
|
6169 |
bindings at:#perModuleRootModule put:nil asValue. |
|
6170 |
bindings at:#perModuleRoot put:nil asValue. |
|
6171 |
bindings at:#removeEnabled put:(removeEnabled := false asValue). |
|
6172 |
bindings at:#listOfModules put:(listOfModules := rootsPerModule keys asList). |
|
7332 | 6173 |
bindings at:#cvsExecutableHolder put:cvsExecutableHolder. |
4244 | 6174 |
listOfModules sort. |
6175 |
||
6176 |
bindings at:#selectedPerModuleRoot put:(selectedPerModuleRoot := nil asValue). |
|
9303 | 6177 |
selectedPerModuleRoot |
9528 | 6178 |
onChangeEvaluate:[ |
6179 |
|module cvsRoot| |
|
6180 |
||
6181 |
acceptChannel value:true. |
|
6182 |
module := selectedPerModuleRoot value. |
|
6183 |
removeEnabled value:true. |
|
6184 |
cvsRoot := rootsPerModule at:module ifAbsent:''. |
|
6185 |
(bindings at:#perModuleRootModule) value:module. |
|
6186 |
(bindings at:#perModuleRoot) value:cvsRoot. |
|
6187 |
]. |
|
4244 | 6188 |
|
6189 |
bindings at:#help put:[ |
|
9528 | 6190 |
WindowGroup activeGroup withWaitCursorDo:[ |
6191 |
HTMLDocumentView openFullOnHelpFile:'Launcher/cvsSetup.html' |
|
6192 |
] |
|
6193 |
]. |
|
4244 | 6194 |
|
6195 |
bindings at:#addPerModuleRoot put:[ |
|
9528 | 6196 |
|module cvsRoot| |
6197 |
||
6198 |
acceptChannel value:true. |
|
6199 |
module := (bindings at:#perModuleRootModule) value. |
|
6200 |
cvsRoot := (bindings at:#perModuleRoot) value. |
|
6201 |
(listOfModules includes:module) ifFalse:[ |
|
6202 |
listOfModules add:module. |
|
6203 |
listOfModules sort. |
|
6204 |
]. |
|
6205 |
cvsRoot size > 0 ifTrue:[ |
|
6206 |
rootsPerModule at:module put:cvsRoot. |
|
6207 |
]. |
|
6208 |
]. |
|
4244 | 6209 |
bindings at:#removePerModuleRoot put:[ |
9528 | 6210 |
|module| |
6211 |
||
6212 |
acceptChannel value:true. |
|
6213 |
module := (bindings at:#perModuleRootModule) value. |
|
6214 |
listOfModules remove:module ifAbsent:nil. |
|
6215 |
rootsPerModule removeKey:module ifAbsent:nil. |
|
6216 |
(bindings at:#perModuleRootModule) value:nil. |
|
6217 |
(bindings at:#perModuleRoot) value:nil. |
|
6218 |
]. |
|
4244 | 6219 |
|
6220 |
dialog := SimpleDialog new. |
|
6221 |
dialog resources:resources. |
|
6222 |
(dialog openSpec:(self cvsSetupSpec) withBindings:bindings) ifFalse:[ |
|
9528 | 6223 |
^ self |
9303 | 6224 |
]. |
6225 |
||
6226 |
acceptChannel value. |
|
4244 | 6227 |
|
6228 |
"/ |
|
6229 |
"/ update system settings |
|
6230 |
"/ |
|
7332 | 6231 |
CVSSourceCodeManager cvsExecutable:cvsExecutableHolder value. |
4244 | 6232 |
CVSSourceCodeManager initializeForRepository:cvsRootHolder value. |
6995 | 6233 |
CVSSourceCodeManager repositoryInfoPerModule:rootsPerModule. |
4398 | 6234 |
|
7332 | 6235 |
" |
6236 |
self cvsConfigurationDialog |
|
6237 |
" |
|
6238 |
||
6239 |
"Modified: / 21-09-2006 / 16:54:20 / cg" |
|
4244 | 6240 |
! |
6241 |
||
9303 | 6242 |
fontBoxForEncoding:encodingMatch |
4244 | 6243 |
"open a fontBox, showing fonts which match some encoding |
6244 |
(used when changing to japanese ...)" |
|
6245 |
||
6246 |
|box y b |
|
6247 |
labelDef buttonDef listDef menuDef textDef |
|
6248 |
models labels allOfThem filter resources defaultButton| |
|
6249 |
||
6250 |
resources := self owningClass classResources. |
|
6251 |
||
6252 |
encodingMatch notNil ifTrue:[ |
|
9961 | 6253 |
filter := [:f | f encoding notNil |
6254 |
and:[encodingMatch match:f encoding]]. |
|
4244 | 6255 |
]. |
6256 |
||
6257 |
models := OrderedCollection new. |
|
6258 |
labels := OrderedCollection new. |
|
6259 |
||
6260 |
models add:(allOfThem := nil asValue). |
|
6261 |
models add:(labelDef := Label defaultFont asValue). |
|
6262 |
models add:(buttonDef := Button defaultFont asValue). |
|
6263 |
models add:(listDef := SelectionInListView defaultFont asValue). |
|
6264 |
models add:(menuDef := MenuView defaultFont asValue). |
|
6265 |
models add:(textDef := TextView defaultFont asValue). |
|
6266 |
||
6267 |
box := Dialog new. |
|
6268 |
box label:(resources string:'Font Settings'). |
|
6269 |
||
6270 |
models |
|
6271 |
with:(resources array:#('All' 'Labels' 'Buttons' 'Lists' 'Menus' 'Edited Text')) |
|
6272 |
do:[:model :title | |
|
9961 | 6273 |
|y2 lbl f i| |
6274 |
||
6275 |
f := model value. |
|
6276 |
||
13735
bfac4cb1f1d6
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13696
diff
changeset
|
6277 |
box addTextLabel:title adjust:#left. |
9961 | 6278 |
|
6279 |
y := box yPosition. |
|
6280 |
b := box addComponent:(Button label:(resources string:'Change ...')) tabable:true. |
|
6281 |
b relativeExtent:nil; extent:(b preferredExtent). |
|
6282 |
y2 := box yPosition. |
|
6283 |
box yPosition:y. |
|
6284 |
i := box leftIndent. |
|
6285 |
box leftIndent:(b widthIncludingBorder + View viewSpacing). |
|
6286 |
(lbl := box addTextLabel:'') |
|
6287 |
adjust:#left; |
|
6288 |
font:(model value); |
|
6289 |
labelChannel:(BlockValue |
|
6290 |
with:[:v | |f| |
|
6291 |
f := v. |
|
6292 |
f isNil ifTrue:[ |
|
6293 |
'' |
|
6294 |
] ifFalse:[ |
|
6295 |
f userFriendlyName |
|
6296 |
] |
|
6297 |
] |
|
6298 |
argument:model). |
|
6299 |
labels add:lbl. |
|
6300 |
||
6301 |
box leftIndent:i. |
|
6302 |
box yPosition:(box yPosition max:y2). |
|
6303 |
||
6304 |
box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
6305 |
||
6306 |
b action:[ |
|
6307 |
|f| |
|
6308 |
||
6309 |
f := FontPanel |
|
6310 |
fontFromUserInitial:(model value) |
|
6311 |
title:(resources string:'Font for %1' with:title) |
|
6312 |
filter:filter |
|
6313 |
encoding:encodingMatch. |
|
6314 |
f notNil ifTrue:[ |
|
6315 |
model == allOfThem ifTrue:[ |
|
6316 |
models do:[:m | m value:f]. |
|
6317 |
labels do:[:l | l font:f] |
|
6318 |
] ifFalse:[ |
|
6319 |
model value:f. |
|
6320 |
lbl font:f. |
|
6321 |
]. |
|
6322 |
] |
|
6323 |
]. |
|
6324 |
model == allOfThem ifTrue:[ |
|
6325 |
box addVerticalSpace |
|
6326 |
] |
|
4244 | 6327 |
]. |
6328 |
||
6329 |
box addAbortAndOkButtons. |
|
6330 |
defaultButton := Button label:(resources string:'Defaults'). |
|
6331 |
||
13401
0dbda3c5121c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13241
diff
changeset
|
6332 |
box addButton:defaultButton. |
4244 | 6333 |
defaultButton |
9961 | 6334 |
action:[ |
6335 |
"/ fetch defaults |
|
5449
8947b587b1f7
readStyleSheetAndUpdateAllStyleCaches not for every read settings
penk
parents:
5440
diff
changeset
|
6336 |
"/ View readStyleSheetAndUpdateAllStyleCaches. |
9961 | 6337 |
labelDef value: Label defaultFont. |
6338 |
buttonDef value: Button defaultFont. |
|
6339 |
listDef value: SelectionInListView defaultFont. |
|
6340 |
menuDef value: MenuView defaultFont. |
|
6341 |
textDef value: TextView defaultFont. |
|
6342 |
]. |
|
4244 | 6343 |
|
6344 |
box open. |
|
6345 |
box accepted ifTrue:[ |
|
9961 | 6346 |
Label defaultFont:labelDef value. |
6347 |
Button defaultFont:buttonDef value. |
|
6348 |
Toggle defaultFont:buttonDef value. |
|
6349 |
TextView withAllSubclasses do:[:cls | cls defaultFont:textDef value]. |
|
6350 |
SelectionInListView withAllSubclasses do:[:cls | cls defaultFont:listDef value]. |
|
6351 |
MenuView defaultFont:menuDef value. |
|
6352 |
MenuPanel defaultFont:menuDef value. |
|
6353 |
NoteBookView defaultFont:menuDef value. |
|
6354 |
PullDownMenu defaultFont:menuDef value. |
|
4244 | 6355 |
]. |
6356 |
box destroy. |
|
6357 |
^ box accepted |
|
6358 |
||
7726 | 6359 |
"Created: / 27-02-1996 / 01:44:16 / cg" |
6360 |
"Modified: / 17-06-1996 / 13:38:48 / stefan" |
|
13401
0dbda3c5121c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
13241
diff
changeset
|
6361 |
"Modified: / 29-08-2013 / 12:20:48 / cg" |
4244 | 6362 |
! |
6363 |
||
6364 |
formattingConfigurationDialog |
|
9303 | 6365 |
|dialog |
4244 | 6366 |
resources exampleText formattedText reformatAction |
6367 |
reformatLocked |
|
6368 |
oldUserPreferences |
|
9303 | 6369 |
currentUserPrefs |
6370 |
tabIndent |
|
6371 |
spaceAroundTemporaries emptyLineAfterTemporaries |
|
4244 | 6372 |
spaceAfterReturnToken spaceAfterKeywordSelector cStyleBlocks |
6373 |
blockArgumentsOnNewLine |
|
6374 |
maxLengthForSingleLineBlocks resetValue bindings| |
|
6375 |
||
6376 |
RBFormatter isNil ifTrue:[ |
|
9961 | 6377 |
^ self warn:'Sorry, no RBFormatter class'. |
4244 | 6378 |
]. |
6379 |
||
6380 |
RBFormatter isLoaded ifFalse:[ |
|
9961 | 6381 |
WindowGroup activeGroup withWaitCursorDo:[ |
6382 |
RBFormatter autoload |
|
6383 |
] |
|
4244 | 6384 |
]. |
6385 |
||
6386 |
resources := self owningClass classResources. |
|
6387 |
currentUserPrefs := UserPreferences current. |
|
6388 |
||
9303 | 6389 |
exampleText := |
4244 | 6390 |
'methodSelector:methodArg |
6391 |
"method comment: |
|
6392 |
some stupid code to show the current settings" |
|
6393 |
||
6394 |
|index| |
|
6395 |
||
6396 |
"/ another comment ... |
|
6397 |
self at:index. "/ a message |
|
6398 |
self at:index put:methodArg. "/ a two arg message |
|
6399 |
self from:1 to:index put:methodArg. "/ a three arg message |
|
6400 |
methodArg ifTrue:[ |
|
9961 | 6401 |
Transcript showCR:''hello''. "/ condition |
4244 | 6402 |
]. |
6403 |
methodArg ifTrue:[ |
|
9961 | 6404 |
Transcript showCR:''hello''. "/ condition |
4244 | 6405 |
] ifFalse:[ |
9961 | 6406 |
Transcript showCR:''world''. |
4244 | 6407 |
]. |
6408 |
[methodArg] whileTrue:[ |
|
9961 | 6409 |
Transcript showCR:''hello''. "/ looping |
4244 | 6410 |
]. |
6411 |
[self aVeryLongConditionBlock and:[self toMakeBlockLonger]] whileTrue:[ |
|
9961 | 6412 |
Transcript showCR:''hello''. "/ long blocks |
4244 | 6413 |
]. |
6414 |
methodArg do:[:element | |
|
9961 | 6415 |
Transcript showCR:''hello''. "/ looping |
4244 | 6416 |
]. |
6417 |
1 to:methodArg size do:[:index | |
|
9961 | 6418 |
Transcript showCR:''hello''. "/ looping |
4244 | 6419 |
]. |
6420 |
methodArg keysAndValuesDo:[:index | |
|
9961 | 6421 |
Transcript showCR:''hello''. "/ looping |
9303 | 6422 |
]. |
6423 |
Object errorSignal handle:[:ex | |
|
9961 | 6424 |
ex return |
4244 | 6425 |
] do:[ "/ exception handling |
9961 | 6426 |
self someAction "/ blocks |
4244 | 6427 |
]. |
6428 |
^ self. |
|
6429 |
'. |
|
6430 |
||
6431 |
formattedText := '' asValue. |
|
6432 |
reformatLocked := false. |
|
6433 |
||
6434 |
reformatAction := [ |tree |
|
9961 | 6435 |
s_tabIndent s_spaceAroundTemporaries s_emptyLineAfterTemporaries |
6436 |
s_spaceAfterReturnToken s_spaceAfterKeywordSelector s_cStyleBlocks |
|
6437 |
s_maxLengthForSingleLineBlocks s_blockArgumentsOnNewLine| |
|
6438 |
||
6439 |
reformatLocked ifFalse:[ |
|
6440 |
"/ |
|
6441 |
"/ temporary change the RBFormatters settings ... |
|
6442 |
"/ |
|
6443 |
s_tabIndent := RBFormatter tabIndent. |
|
6444 |
s_spaceAroundTemporaries := RBFormatter spaceAroundTemporaries. |
|
6445 |
s_emptyLineAfterTemporaries := RBFormatter emptyLineAfterTemporaries. |
|
6446 |
s_spaceAfterReturnToken := RBFormatter spaceAfterReturnToken. |
|
6447 |
s_spaceAfterKeywordSelector := RBFormatter spaceAfterKeywordSelector. |
|
6448 |
s_cStyleBlocks := RBFormatter cStyleBlocks. |
|
6449 |
s_blockArgumentsOnNewLine := RBFormatter blockArgumentsOnNewLine. |
|
6450 |
s_maxLengthForSingleLineBlocks := RBFormatter maxLengthForSingleLineBlocks. |
|
6451 |
||
6452 |
RBFormatter |
|
6453 |
tabIndent:tabIndent value; |
|
6454 |
spaceAroundTemporaries:spaceAroundTemporaries value; |
|
6455 |
emptyLineAfterTemporaries:emptyLineAfterTemporaries value; |
|
6456 |
spaceAfterReturnToken:spaceAfterReturnToken value; |
|
6457 |
spaceAfterKeywordSelector:spaceAfterKeywordSelector value; |
|
6458 |
cStyleBlocks:cStyleBlocks value; |
|
6459 |
blockArgumentsOnNewLine:blockArgumentsOnNewLine value; |
|
6460 |
maxLengthForSingleLineBlocks:maxLengthForSingleLineBlocks value. |
|
6461 |
||
6462 |
tree := RBParser |
|
6463 |
parseMethod:exampleText |
|
6464 |
onError: [:aString :position | nil]. |
|
6465 |
tree do:[:node | |
|
6466 |
(node ~~ tree and:[node parent isNil]) ifTrue:[ |
|
6467 |
self error:'No parent for node'. |
|
6468 |
] |
|
6469 |
]. |
|
6470 |
formattedText value:tree printString. |
|
6471 |
||
6472 |
RBFormatter |
|
6473 |
tabIndent:s_tabIndent; |
|
6474 |
spaceAroundTemporaries:s_spaceAroundTemporaries; |
|
6475 |
emptyLineAfterTemporaries:s_emptyLineAfterTemporaries; |
|
6476 |
spaceAfterReturnToken:s_spaceAfterReturnToken; |
|
6477 |
spaceAfterKeywordSelector:s_spaceAfterKeywordSelector; |
|
6478 |
cStyleBlocks:s_cStyleBlocks; |
|
6479 |
blockArgumentsOnNewLine:s_blockArgumentsOnNewLine; |
|
6480 |
maxLengthForSingleLineBlocks:s_maxLengthForSingleLineBlocks. |
|
6481 |
]. |
|
6482 |
]. |
|
4244 | 6483 |
|
6484 |
bindings := IdentityDictionary new. |
|
6485 |
bindings at:#formattedText put:formattedText. |
|
6486 |
||
6487 |
oldUserPreferences := currentUserPrefs copy. |
|
6488 |
||
6489 |
tabIndent := RBFormatter tabIndent asValue. |
|
9303 | 6490 |
tabIndent onChangeEvaluate:reformatAction. |
4244 | 6491 |
bindings at:#tabIndent put:tabIndent. |
6492 |
||
6493 |
spaceAroundTemporaries := RBFormatter spaceAroundTemporaries asValue. |
|
9303 | 6494 |
spaceAroundTemporaries onChangeEvaluate:reformatAction. |
4244 | 6495 |
bindings at:#spaceAroundTemporaries put:spaceAroundTemporaries. |
6496 |
||
6497 |
emptyLineAfterTemporaries := RBFormatter emptyLineAfterTemporaries asValue. |
|
9303 | 6498 |
emptyLineAfterTemporaries onChangeEvaluate:reformatAction. |
4244 | 6499 |
bindings at:#emptyLineAfterTemporaries put:emptyLineAfterTemporaries. |
6500 |
||
6501 |
spaceAfterReturnToken := RBFormatter spaceAfterReturnToken asValue. |
|
9303 | 6502 |
spaceAfterReturnToken onChangeEvaluate:reformatAction. |
4244 | 6503 |
bindings at:#spaceAfterReturnToken put:spaceAfterReturnToken. |
6504 |
||
6505 |
spaceAfterKeywordSelector := RBFormatter spaceAfterKeywordSelector asValue. |
|
9303 | 6506 |
spaceAfterKeywordSelector onChangeEvaluate:reformatAction. |
4244 | 6507 |
bindings at:#spaceAfterKeywordSelector put:spaceAfterKeywordSelector. |
6508 |
||
6509 |
cStyleBlocks := RBFormatter cStyleBlocks asValue. |
|
9303 | 6510 |
cStyleBlocks onChangeEvaluate:reformatAction. |
4244 | 6511 |
bindings at:#cStyleBlocks put:cStyleBlocks. |
6512 |
||
6513 |
blockArgumentsOnNewLine := RBFormatter blockArgumentsOnNewLine asValue. |
|
9303 | 6514 |
blockArgumentsOnNewLine onChangeEvaluate:reformatAction. |
4244 | 6515 |
bindings at:#blockArgumentsOnNewLine put:blockArgumentsOnNewLine. |
6516 |
||
6517 |
maxLengthForSingleLineBlocks := RBFormatter maxLengthForSingleLineBlocks asValue. |
|
9303 | 6518 |
maxLengthForSingleLineBlocks onChangeEvaluate:reformatAction. |
4244 | 6519 |
bindings at:#maxLengthForSingleLineBlocks put:maxLengthForSingleLineBlocks. |
6520 |
||
6521 |
bindings at:#resetList put:#( 'ST/X default' 'RB default' ). |
|
6522 |
bindings at:#resetValue put:(resetValue := nil asValue). |
|
6523 |
resetValue onChangeEvaluate: |
|
9961 | 6524 |
[ |
6525 |
resetValue value == 1 ifTrue:[ |
|
6526 |
"/ ST/X defaults |
|
6527 |
reformatLocked := true. |
|
6528 |
tabIndent value: 4. |
|
6529 |
spaceAfterReturnToken value: true. |
|
6530 |
spaceAfterKeywordSelector value: false. |
|
6531 |
spaceAroundTemporaries value: false. |
|
6532 |
emptyLineAfterTemporaries value: true. |
|
6533 |
cStyleBlocks value: true. |
|
6534 |
blockArgumentsOnNewLine value:false. |
|
6535 |
maxLengthForSingleLineBlocks value: 20. |
|
6536 |
reformatLocked := false. |
|
6537 |
reformatAction value. |
|
6538 |
]. |
|
6539 |
resetValue value == 2 ifTrue:[ |
|
6540 |
"/ RBParser defaults |
|
6541 |
reformatLocked := true. |
|
6542 |
tabIndent value: 8. |
|
6543 |
spaceAfterReturnToken value: false. |
|
6544 |
spaceAfterKeywordSelector value: true. |
|
6545 |
spaceAroundTemporaries value: true. |
|
6546 |
emptyLineAfterTemporaries value: false. |
|
6547 |
cStyleBlocks value: false. |
|
6548 |
blockArgumentsOnNewLine value:false. |
|
6549 |
maxLengthForSingleLineBlocks value: 20. |
|
6550 |
reformatLocked := false. |
|
6551 |
reformatAction value. |
|
6552 |
]. |
|
6553 |
resetValue value:nil. "/ to force default label |
|
6554 |
]. |
|
4244 | 6555 |
|
6556 |
reformatAction value. |
|
6557 |
||
6558 |
"/ |
|
6559 |
"/ create a box on those ... |
|
6560 |
"/ |
|
6561 |
dialog := SimpleDialog new. |
|
6562 |
dialog postBuildBlock:[:builder | |
|
9961 | 6563 |
(builder componentAt:#sampleTextView) |
6564 |
cursorMovementWhenUpdating:nil; |
|
6565 |
scrollWhenUpdating:nil. |
|
6566 |
]. |
|
9303 | 6567 |
(dialog openFor:nil |
9961 | 6568 |
spec:(self formatterDialogSpec) |
6569 |
withBindings:bindings) |
|
4244 | 6570 |
ifTrue:[ |
9961 | 6571 |
currentUserPrefs at:#'formatter.tabIndent' put:tabIndent value. |
6572 |
currentUserPrefs at:#'formatter.spaceAroundTemporaries' put:spaceAroundTemporaries value. |
|
6573 |
currentUserPrefs at:#'formatter.emptyLineAfterTemporaries' put:emptyLineAfterTemporaries value. |
|
6574 |
currentUserPrefs at:#'formatter.spaceAfterReturnToken' put:spaceAfterReturnToken value. |
|
6575 |
currentUserPrefs at:#'formatter.spaceAfterKeywordSelector' put:spaceAfterKeywordSelector value. |
|
6576 |
currentUserPrefs at:#'formatter.cStyleBlocks' put:cStyleBlocks value. |
|
6577 |
currentUserPrefs at:#'formatter.blockArgumentsOnNewLine' put:blockArgumentsOnNewLine value. |
|
6578 |
currentUserPrefs at:#'formatter.maxLengthForSingleLineBlocks' put:maxLengthForSingleLineBlocks value. |
|
6579 |
RBFormatter |
|
6580 |
tabIndent:tabIndent value; |
|
6581 |
spaceAroundTemporaries:spaceAroundTemporaries value; |
|
6582 |
emptyLineAfterTemporaries:emptyLineAfterTemporaries value; |
|
6583 |
spaceAfterReturnToken:spaceAfterReturnToken value; |
|
6584 |
spaceAfterKeywordSelector:spaceAfterKeywordSelector value; |
|
6585 |
cStyleBlocks:cStyleBlocks value; |
|
6586 |
blockArgumentsOnNewLine:blockArgumentsOnNewLine value; |
|
6587 |
maxLengthForSingleLineBlocks:maxLengthForSingleLineBlocks value. |
|
4244 | 6588 |
] ifFalse: [ |
9961 | 6589 |
(UserPreferences reset; current) addAll: oldUserPreferences |
9303 | 6590 |
]. |
4398 | 6591 |
" |
6592 |
self formattingConfigurationDialog |
|
6593 |
" |
|
4244 | 6594 |
! |
6595 |
||
6596 |
syntaxColorConfigurationDialog |
|
6597 |
|box frame exampleView y |
|
6598 |
resources exampleText coloredText recolorAction |
|
6599 |
syntaxColor syntaxColors colorMenu oldUserPreferences |
|
6600 |
syntaxEmphasises syntaxColorSelector syntaxEmphasisSelector syntaxColoringBox |
|
6601 |
syntaxEmphasisesBox syntaxColoringResetButton b resetList |
|
6602 |
resetListBox currentUserPrefs| |
|
6603 |
||
6604 |
resources := self owningClass classResources. |
|
6605 |
currentUserPrefs := UserPreferences current. |
|
6606 |
||
9303 | 6607 |
exampleText := |
4244 | 6608 |
'methodSelector:methodArg |
6609 |
"method comment: |
|
6610 |
some stupid code to show the current settings" |
|
6611 |
||
6612 |
|methodVar| |
|
6613 |
||
6614 |
"/ another comment ... |
|
6615 |
self at:methodArg. "/ a message |
|
6616 |
self fooBarBaz:methodVar. "/ a bad message |
|
6617 |
methodVar := Array new:1. |
|
6618 |
unknonVar := 1. "/ a bad variable |
|
6619 |
UnknonVar := 1. "/ another bad variable |
|
6620 |
"self bar:methodVar. detect commented code easily" |
|
6621 |
1 to:5 do:[:i | self at:i + 1]. |
|
6622 |
Transcript showCR:''some string'' , #someSymbol. |
|
6623 |
^ self. |
|
6624 |
'. |
|
6625 |
||
6626 |
coloredText := '' asValue. |
|
12928 | 6627 |
recolorAction := [ coloredText value:(SyntaxHighlighter formatMethodSource:exampleText in:nil) ]. |
4244 | 6628 |
recolorAction value. |
6629 |
||
6630 |
"/ |
|
6631 |
"/ create a box on those values ... |
|
6632 |
"/ |
|
6633 |
box := DialogBox new. |
|
6634 |
box label:(resources string:'Syntax Colors'). |
|
6635 |
||
6636 |
frame := View new. |
|
6637 |
frame extent:1.0 @ 200. |
|
6638 |
frame borderWidth:0. |
|
6639 |
||
6640 |
exampleView := HVScrollableView for:TextView in:frame. |
|
6641 |
exampleView model:coloredText. |
|
6642 |
exampleView origin:0.0@0.0 corner:1.0@1.0; inset:2. |
|
6643 |
||
6644 |
frame topInset:box yPosition. |
|
6645 |
box addComponent:frame withExtent:1.0@200. |
|
9303 | 6646 |
box makeTabable:exampleView. |
4244 | 6647 |
frame width:1.0. |
6648 |
||
6649 |
box addVerticalSpace. |
|
6650 |
||
6651 |
oldUserPreferences := currentUserPrefs copy. |
|
6652 |
||
6653 |
syntaxColoringBox := box addComboListOn: (syntaxColors := SelectionInList with:UserPreferences syntaxColorNames initialSelection:1). |
|
6654 |
syntaxColorSelector := [(syntaxColors selection replChar:$ withString: '') asLowercaseFirst asSymbol]. |
|
14086
f05ca0ec3ea8
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
14075
diff
changeset
|
6655 |
syntaxEmphasisSelector := [((syntaxColorSelector value upToAll: 'Color'), 'Emphasis') asLowercaseFirst asSymbol]. |
4244 | 6656 |
syntaxColor := (currentUserPrefs perform: syntaxColorSelector value) asValue. |
6657 |
colorMenu := ColorMenu new. |
|
6658 |
colorMenu model: syntaxColor. |
|
9303 | 6659 |
syntaxColor onChangeEvaluate: |
9961 | 6660 |
[currentUserPrefs at: syntaxColorSelector value put: syntaxColor value. |
6661 |
recolorAction value.]. |
|
9303 | 6662 |
syntaxColors onChangeEvaluate: |
9961 | 6663 |
[|eVal| |
6664 |
syntaxColor value: (currentUserPrefs perform:syntaxColorSelector value). |
|
6665 |
eVal := currentUserPrefs perform: syntaxEmphasisSelector value. |
|
6666 |
eVal isArray ifTrue:[ |
|
6667 |
eVal = (Array with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[ |
|
6668 |
eVal := #'red underwave' |
|
6669 |
]. |
|
6670 |
eVal = (Array with:#bold with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[ |
|
6671 |
eVal := #'bold+red underwave' |
|
6672 |
]. |
|
6673 |
eVal = (Array with:#bold with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[ |
|
6674 |
eVal := #'bold+red underline' |
|
6675 |
]. |
|
6676 |
eVal = (Array with:#italic with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[ |
|
6677 |
eVal := #'italic+red underwave' |
|
6678 |
]. |
|
6679 |
eVal = (Array with:#italic with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[ |
|
6680 |
eVal := #'italic+red underline' |
|
6681 |
]. |
|
6682 |
]. |
|
6683 |
syntaxEmphasises selection: eVal. |
|
6684 |
recolorAction value.]. |
|
9303 | 6685 |
|
6686 |
syntaxEmphasises := SelectionInList |
|
9961 | 6687 |
with:#( |
6688 |
normal |
|
6689 |
underline |
|
6690 |
#'red underline' |
|
6691 |
underwave |
|
6692 |
#'red underwave' |
|
6693 |
bold |
|
6694 |
boldUnderline |
|
6695 |
#'bold+red underline' |
|
6696 |
boldUnderwave |
|
6697 |
#'bold+red underwave' |
|
6698 |
italic |
|
6699 |
italicUnderline |
|
6700 |
#'italic+red underline' |
|
6701 |
italicUnderwave |
|
6702 |
#'italic+red underwave' |
|
6703 |
reverse |
|
6704 |
) |
|
6705 |
initialSelection:1. |
|
4244 | 6706 |
syntaxEmphasisesBox := box addComboListOn:syntaxEmphasises. |
9303 | 6707 |
syntaxEmphasises |
9961 | 6708 |
onChangeEvaluate:[ |em| |
6709 |
em := syntaxEmphasises selection. |
|
6710 |
em notNil ifTrue:[ |
|
6711 |
em := em asSymbol. |
|
6712 |
em == #'red underline' ifTrue:[ em := Array with:#underline with:(#underlineColor->Color red)]. |
|
6713 |
em == #'red underwave' ifTrue:[ em := Array with:#underwave with:(#underlineColor->Color red)]. |
|
6714 |
em == #'bold+red underline' ifTrue:[ em := Array with:#bold with:#underline with:(#underlineColor->Color red)]. |
|
6715 |
em == #'bold+red underwave' ifTrue:[ em := Array with:#bold with:#underwave with:(#underlineColor->Color red)]. |
|
6716 |
em == #'italic+red underline' ifTrue:[ em := Array with:#italic with:#underline with:(#underlineColor->Color red)]. |
|
6717 |
em == #'italic+red underwave' ifTrue:[ em := Array with:#italic with:#underwave with:(#underlineColor->Color red)]. |
|
6718 |
||
6719 |
currentUserPrefs at: syntaxEmphasisSelector value put:em. |
|
6720 |
]. |
|
6721 |
recolorAction value |
|
6722 |
]. |
|
4244 | 6723 |
syntaxColors changed:#value. "/ to force initial update of emphasis |
6724 |
box addComponent:colorMenu tabable:true. |
|
6725 |
||
6726 |
y := box yPosition. |
|
6727 |
||
6728 |
b := Button new label: (resources string:'reset to:'). |
|
6729 |
b action:[ |
|
9961 | 6730 |
|resetSelector| |
6731 |
||
6732 |
resetSelector := (currentUserPrefs listOfPredefinedSyntaxColoringSchemes |
|
6733 |
collect:[:eachEntry | eachEntry first]) |
|
6734 |
at:resetList selectionIndex. |
|
6735 |
currentUserPrefs perform:resetSelector. |
|
6736 |
recolorAction value. |
|
4244 | 6737 |
]. |
6738 |
syntaxColoringResetButton := box addComponent:b. |
|
6739 |
box makeTabable:syntaxColoringResetButton. |
|
6740 |
||
6741 |
box yPosition:y. |
|
6742 |
||
9303 | 6743 |
resetList := SelectionInList |
9961 | 6744 |
with:(currentUserPrefs listOfPredefinedSyntaxColoringSchemes |
6745 |
collect:[:eachEntry | eachEntry second]) |
|
6746 |
initialSelection:1. |
|
4244 | 6747 |
resetListBox := box addComboListOn:resetList. |
6748 |
box makeTabable:resetListBox. |
|
6749 |
||
9303 | 6750 |
syntaxColoringBox enable. |
6751 |
colorMenu enable. |
|
6752 |
syntaxEmphasisesBox enable. |
|
6753 |
syntaxColoringResetButton enable. |
|
6754 |
||
6755 |
box |
|
4244 | 6756 |
"/ addHelpButtonFor:'Launcher/sourceSettings.html'; |
9961 | 6757 |
addAbortAndOkButtons. |
4244 | 6758 |
|
6759 |
box stickAtBottomWithVariableHeight:frame. |
|
6760 |
box stickAtBottomWithFixHeight:syntaxColoringBox. |
|
6761 |
box stickAtBottomWithFixHeight:syntaxEmphasisesBox. |
|
6762 |
box stickAtBottomWithFixHeight:colorMenu. |
|
6763 |
box stickAtBottomWithFixHeight:syntaxColoringResetButton left:0.0 right:0.5. |
|
6764 |
box stickAtBottomWithFixHeight:resetListBox left:0.5 right:1.0. |
|
6765 |
||
6766 |
"/ |
|
6767 |
"/ show the box ... |
|
6768 |
"/ |
|
6769 |
box extent:600@400. |
|
6770 |
box openModal. |
|
6771 |
||
6772 |
"/ |
|
6773 |
"/ update system settings |
|
6774 |
"/ |
|
5944
4fef6e1d18ff
Use #addAll: instead of #declareAllFrom:, since #declareAllFrom:
Stefan Vogel <sv@exept.de>
parents:
5917
diff
changeset
|
6775 |
box accepted ifFalse: [ |
9961 | 6776 |
(UserPreferences reset; current) addAll:oldUserPreferences |
4244 | 6777 |
]. |
6778 |
box destroy |
|
6779 |
||
6780 |
"Modified: / 16.4.1998 / 17:18:16 / ca" |
|
6781 |
"Modified: / 7.7.1999 / 00:27:02 / cg" |
|
2001 | 6782 |
! ! |
6783 |
||
2596 | 6784 |
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'interface specs'! |
6785 |
||
4244 | 6786 |
cvsSetupSpec |
6787 |
"This resource specification was automatically generated |
|
6788 |
by the UIPainter of ST/X." |
|
6789 |
||
6790 |
"Do not manually edit this!! If it is corrupted, |
|
6791 |
the UIPainter may not be able to read the specification." |
|
6792 |
||
6793 |
" |
|
6794 |
UIPainter new openOnClass:AbstractLauncherApplication::LauncherDialogs andSelector:#cvsSetupSpec |
|
6795 |
" |
|
6796 |
||
6797 |
<resource: #canvas> |
|
6798 |
||
9303 | 6799 |
^ |
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
6800 |
#(FullSpec |
9961 | 6801 |
name: cvsSetupSpec |
6802 |
window: |
|
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
6803 |
(WindowSpec |
9961 | 6804 |
label: 'CVS Setup' |
6805 |
name: 'CVS Setup' |
|
6806 |
min: (Point 436 316) |
|
6807 |
bounds: (Rectangle 14 46 450 400) |
|
6808 |
) |
|
6809 |
component: |
|
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
6810 |
(SpecCollection |
9961 | 6811 |
collection: ( |
6812 |
(LabelSpec |
|
6813 |
label: 'CVS BinDirectory:' |
|
6814 |
name: 'Label1' |
|
6815 |
layout: (LayoutFrame 0 0.0 36 0 40 0.25 53 0) |
|
6816 |
level: 0 |
|
6817 |
translateLabel: true |
|
6818 |
adjust: right |
|
6819 |
) |
|
6820 |
(InputFieldSpec |
|
6821 |
name: 'BinDirectoryField' |
|
6822 |
layout: (LayoutFrame 44 0.25 34 0 -1 1 56 0) |
|
6823 |
tabable: true |
|
6824 |
model: cvsBinDirectoryHolder |
|
6825 |
acceptChannel: acceptChannel |
|
6826 |
acceptOnPointerLeave: false |
|
6827 |
) |
|
6828 |
(DividerSpec |
|
6829 |
name: 'Separator3' |
|
6830 |
layout: (LayoutFrame 0 0.0 60 0 0 1.0 64 0) |
|
6831 |
) |
|
6832 |
(LabelSpec |
|
6833 |
label: 'CVS SourceCodeManager setup' |
|
6834 |
name: 'label' |
|
6835 |
layout: (LayoutFrame 1 0.0 3 0 -1 1.0 20 0) |
|
6836 |
translateLabel: true |
|
6837 |
adjust: left |
|
6838 |
) |
|
6839 |
(LabelSpec |
|
6840 |
label: 'CVSRoot default:' |
|
6841 |
name: 'defaultCvsRootLabel' |
|
6842 |
layout: (LayoutFrame 0 0.0 71 0 40 0.25 88 0) |
|
6843 |
level: 0 |
|
6844 |
translateLabel: true |
|
6845 |
adjust: right |
|
6846 |
) |
|
6847 |
(ComboBoxSpec |
|
6848 |
name: 'cvsRootComboBox' |
|
6849 |
layout: (LayoutFrame 44 0.25 71 0 -1 1.0 93 0) |
|
6850 |
tabable: true |
|
6851 |
model: cvsRootHolder |
|
6852 |
immediateAccept: true |
|
6853 |
acceptOnLeave: true |
|
6854 |
acceptOnReturn: true |
|
6855 |
acceptOnTab: true |
|
6856 |
acceptOnLostFocus: true |
|
6857 |
acceptChannel: acceptChannel |
|
6858 |
acceptOnPointerLeave: false |
|
6859 |
comboList: cvsRootPrototypeList |
|
6860 |
) |
|
6861 |
(DividerSpec |
|
6862 |
name: 'Separator1' |
|
6863 |
layout: (LayoutFrame 0 0.0 96 0 0 1.0 100 0) |
|
6864 |
) |
|
6865 |
(LabelSpec |
|
6866 |
label: 'CVSRoot per Module:' |
|
6867 |
name: 'knownModulesLabel' |
|
6868 |
layout: (LayoutFrame 0 0.0 109 0 40 0.25 126 0) |
|
6869 |
translateLabel: true |
|
6870 |
adjust: right |
|
6871 |
) |
|
6872 |
(SequenceViewSpec |
|
6873 |
name: 'List1' |
|
6874 |
layout: (LayoutFrame 44 0.25 104 0 -1 1 202 0) |
|
6875 |
tabable: true |
|
6876 |
model: selectedPerModuleRoot |
|
6877 |
hasHorizontalScrollBar: true |
|
6878 |
hasVerticalScrollBar: true |
|
6879 |
miniScrollerHorizontal: true |
|
6880 |
useIndex: false |
|
6881 |
sequenceList: listOfModules |
|
6882 |
) |
|
6883 |
(LabelSpec |
|
6884 |
label: 'Module:' |
|
6885 |
name: 'moduleLabel' |
|
6886 |
layout: (LayoutFrame 0 0.0 209 0 40 0.25 226 0) |
|
6887 |
translateLabel: true |
|
6888 |
adjust: right |
|
6889 |
) |
|
6890 |
(InputFieldSpec |
|
6891 |
name: 'perModuleRootModuleEntryField' |
|
6892 |
layout: (LayoutFrame 44 0.25 205 0 -1 1 227 0) |
|
6893 |
tabable: true |
|
6894 |
model: perModuleRootModule |
|
6895 |
acceptChannel: acceptChannel |
|
6896 |
acceptOnPointerLeave: false |
|
6897 |
) |
|
6898 |
(LabelSpec |
|
6899 |
label: 'CVSRoot:' |
|
6900 |
name: 'cvsRootLabel' |
|
6901 |
layout: (LayoutFrame 0 0.0 236 0 40 0.25 253 0) |
|
6902 |
translateLabel: true |
|
6903 |
adjust: right |
|
6904 |
) |
|
6905 |
(ComboBoxSpec |
|
6906 |
name: 'perModuleRootComboBox' |
|
6907 |
layout: (LayoutFrame 44 0.25 232 0 -1 1.0 254 0) |
|
6908 |
tabable: true |
|
6909 |
model: perModuleRoot |
|
6910 |
immediateAccept: true |
|
6911 |
acceptOnLeave: true |
|
6912 |
acceptOnReturn: true |
|
6913 |
acceptOnTab: true |
|
6914 |
acceptOnLostFocus: true |
|
6915 |
acceptChannel: acceptChannel |
|
6916 |
acceptOnPointerLeave: false |
|
6917 |
comboList: cvsRootPrototypeList |
|
6918 |
) |
|
6919 |
(HorizontalPanelViewSpec |
|
6920 |
name: 'HorizontalPanel1' |
|
6921 |
layout: (LayoutFrame 44 0.25 258 0 -1 1 289 0) |
|
6922 |
horizontalLayout: fitSpace |
|
6923 |
verticalLayout: center |
|
6924 |
horizontalSpace: 3 |
|
6925 |
verticalSpace: 3 |
|
6926 |
component: |
|
6927 |
(SpecCollection |
|
6928 |
collection: ( |
|
6929 |
(ActionButtonSpec |
|
6930 |
label: 'Add/Apply' |
|
6931 |
name: 'addButton' |
|
6932 |
translateLabel: true |
|
6933 |
tabable: true |
|
6934 |
model: addPerModuleRoot |
|
6935 |
extent: (Point 136 22) |
|
6936 |
) |
|
6937 |
(ActionButtonSpec |
|
6938 |
label: 'Remove' |
|
6939 |
name: 'removeButton' |
|
6940 |
translateLabel: true |
|
6941 |
tabable: true |
|
6942 |
model: removePerModuleRoot |
|
6943 |
enableChannel: removeEnabled |
|
6944 |
extent: (Point 137 22) |
|
6945 |
) |
|
6946 |
) |
|
6947 |
||
6948 |
) |
|
6949 |
) |
|
6950 |
(DividerSpec |
|
6951 |
name: 'Separator2' |
|
6952 |
layout: (LayoutFrame 0 0.0 -45 1 0 1.0 -34 1) |
|
6953 |
) |
|
6954 |
(HorizontalPanelViewSpec |
|
6955 |
name: 'buttonPanel' |
|
6956 |
layout: (LayoutFrame 0 0.0 -29 1.0 0 1.0 -3 1.0) |
|
6957 |
horizontalLayout: fitSpace |
|
6958 |
verticalLayout: center |
|
6959 |
horizontalSpace: 3 |
|
6960 |
verticalSpace: 3 |
|
6961 |
ignoreInvisibleComponents: true |
|
6962 |
reverseOrderIfOKAtLeft: true |
|
6963 |
component: |
|
6964 |
(SpecCollection |
|
6965 |
collection: ( |
|
6966 |
(ActionButtonSpec |
|
6967 |
label: 'Cancel' |
|
6968 |
name: 'cancelButton' |
|
6969 |
translateLabel: true |
|
6970 |
tabable: true |
|
6971 |
model: cancel |
|
6972 |
extent: (Point 141 21) |
|
6973 |
) |
|
6974 |
(ActionButtonSpec |
|
6975 |
label: 'Help' |
|
6976 |
name: 'helpButton' |
|
6977 |
translateLabel: true |
|
6978 |
tabable: true |
|
6979 |
model: help |
|
6980 |
extent: (Point 141 21) |
|
6981 |
) |
|
6982 |
(ActionButtonSpec |
|
6983 |
label: 'OK' |
|
6984 |
name: 'okButton' |
|
6985 |
translateLabel: true |
|
6986 |
tabable: true |
|
6987 |
model: accept |
|
6988 |
isDefault: true |
|
6989 |
extent: (Point 142 21) |
|
6990 |
) |
|
6991 |
) |
|
6992 |
||
6993 |
) |
|
6994 |
) |
|
6995 |
) |
|
6996 |
||
6997 |
) |
|
4244 | 6998 |
) |
6999 |
! |
|
7000 |
||
7001 |
formatterDialogSpec |
|
7002 |
"This resource specification was automatically generated |
|
7003 |
by the UIPainter of ST/X." |
|
7004 |
||
7005 |
"Do not manually edit this!! If it is corrupted, |
|
7006 |
the UIPainter may not be able to read the specification." |
|
7007 |
||
7008 |
" |
|
7009 |
UIPainter new openOnClass:AbstractLauncherApplication::LauncherDialogs andSelector:#formatterDialogSpec |
|
7010 |
" |
|
7011 |
||
7012 |
<resource: #canvas> |
|
7013 |
||
9303 | 7014 |
^ |
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
7015 |
#(FullSpec |
9961 | 7016 |
name: formatterDialogSpec |
7017 |
window: |
|
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
7018 |
(WindowSpec |
9961 | 7019 |
label: 'Formatting parameters' |
7020 |
name: 'Formatting parameters' |
|
7021 |
min: (Point 10 10) |
|
7022 |
bounds: (Rectangle 14 46 610 629) |
|
7023 |
) |
|
7024 |
component: |
|
5153
0030b86728bf
Delete #max: (- windowsize) in windowSpecs
Stefan Vogel <sv@exept.de>
parents:
5146
diff
changeset
|
7025 |
(SpecCollection |
9961 | 7026 |
collection: ( |
7027 |
(LabelSpec |
|
7028 |
label: 'Sample output:' |
|
7029 |
name: 'Label2' |
|
7030 |
layout: (LayoutFrame 0 0.0 4 0 0 1.0 26 0) |
|
7031 |
translateLabel: true |
|
7032 |
adjust: left |
|
7033 |
) |
|
7034 |
(TextEditorSpec |
|
7035 |
name: 'sampleTextView' |
|
7036 |
layout: (LayoutFrame 0 0.0 30 0.0 0 1.0 -234 1.0) |
|
7037 |
level: -1 |
|
7038 |
model: formattedText |
|
7039 |
hasHorizontalScrollBar: true |
|
7040 |
hasVerticalScrollBar: true |
|
7041 |
) |
|
7042 |
(FramedBoxSpec |
|
7043 |
label: 'Parameters' |
|
7044 |
name: 'FramedBox1' |
|
7045 |
layout: (LayoutFrame 0 0.0 -225 1 0 1.0 -30 1) |
|
7046 |
labelPosition: topLeft |
|
7047 |
translateLabel: true |
|
7048 |
component: |
|
7049 |
(SpecCollection |
|
7050 |
collection: ( |
|
7051 |
(LabelSpec |
|
7052 |
label: 'Max length for single line blocks:' |
|
7053 |
name: 'Label1' |
|
7054 |
layout: (LayoutFrame 185 0.0 127 0 66 0.7 153 0) |
|
7055 |
level: 0 |
|
7056 |
adjust: right |
|
7057 |
) |
|
7058 |
(CheckBoxSpec |
|
7059 |
label: 'Space around temporaries ' |
|
7060 |
name: 'checkBox' |
|
7061 |
layout: (LayoutFrame 2 0 3 0 260 0 32 0) |
|
7062 |
level: 0 |
|
7063 |
tabable: true |
|
7064 |
model: spaceAroundTemporaries |
|
7065 |
translateLabel: true |
|
7066 |
) |
|
7067 |
(CheckBoxSpec |
|
7068 |
label: 'Blank line after local var declaration' |
|
7069 |
name: 'CheckBox1' |
|
7070 |
layout: (LayoutFrame 267 0 3 0 567 0 32 0) |
|
7071 |
level: 0 |
|
7072 |
tabable: true |
|
7073 |
model: emptyLineAfterTemporaries |
|
7074 |
translateLabel: true |
|
7075 |
) |
|
7076 |
(CheckBoxSpec |
|
7077 |
label: 'Space after ''^''' |
|
7078 |
name: 'CheckBox2' |
|
7079 |
layout: (LayoutFrame 2 0 31 0 260 0 60 0) |
|
7080 |
level: 0 |
|
7081 |
tabable: true |
|
7082 |
model: spaceAfterReturnToken |
|
7083 |
translateLabel: true |
|
7084 |
) |
|
7085 |
(CheckBoxSpec |
|
7086 |
label: 'Space after '':'' in keywords' |
|
7087 |
name: 'CheckBox3' |
|
7088 |
layout: (LayoutFrame 267 0 31 0 567 0 60 0) |
|
7089 |
level: 0 |
|
7090 |
tabable: true |
|
7091 |
model: spaceAfterKeywordSelector |
|
7092 |
translateLabel: true |
|
7093 |
) |
|
7094 |
(CheckBoxSpec |
|
7095 |
label: 'C-Style blocks' |
|
7096 |
name: 'CheckBox4' |
|
7097 |
layout: (LayoutFrame 2 0 59 0 260 0 88 0) |
|
7098 |
level: 0 |
|
7099 |
tabable: true |
|
7100 |
model: cStyleBlocks |
|
7101 |
translateLabel: true |
|
7102 |
) |
|
7103 |
(InputFieldSpec |
|
7104 |
name: 'editField' |
|
7105 |
layout: (LayoutFrame 74 0.7 93 0 -38 1.0 119 0) |
|
7106 |
level: -1 |
|
7107 |
tabable: true |
|
7108 |
model: tabIndent |
|
7109 |
type: number |
|
7110 |
immediateAccept: false |
|
7111 |
acceptOnLeave: true |
|
7112 |
acceptOnReturn: true |
|
7113 |
acceptOnTab: true |
|
7114 |
acceptOnLostFocus: true |
|
7115 |
acceptOnPointerLeave: true |
|
7116 |
) |
|
7117 |
(LabelSpec |
|
7118 |
label: 'Indent:' |
|
7119 |
name: 'label' |
|
7120 |
layout: (LayoutFrame 242 0.0 93 0 66 0.7 119 0) |
|
7121 |
level: 0 |
|
7122 |
adjust: right |
|
7123 |
) |
|
7124 |
(InputFieldSpec |
|
7125 |
name: 'EntryField1' |
|
7126 |
layout: (LayoutFrame 74 0.7 127 0 -38 1.0 153 0) |
|
7127 |
level: -1 |
|
7128 |
tabable: true |
|
7129 |
model: maxLengthForSingleLineBlocks |
|
7130 |
type: number |
|
7131 |
immediateAccept: false |
|
7132 |
acceptOnLeave: true |
|
7133 |
acceptOnReturn: true |
|
7134 |
acceptOnTab: true |
|
7135 |
acceptOnLostFocus: true |
|
7136 |
acceptOnPointerLeave: true |
|
7137 |
) |
|
7138 |
(PopUpListSpec |
|
7139 |
label: 'Reset to...' |
|
7140 |
name: 'PopUpList1' |
|
7141 |
layout: (LayoutFrame 2 0 129 0 127 0 151 0) |
|
7142 |
tabable: true |
|
7143 |
model: resetValue |
|
7144 |
menu: resetList |
|
7145 |
useIndex: true |
|
7146 |
) |
|
7147 |
(CheckBoxSpec |
|
7148 |
label: 'Block args on new line' |
|
7149 |
name: 'CheckBox5' |
|
7150 |
layout: (LayoutFrame 267 0 59 0 567 0 88 0) |
|
7151 |
level: 0 |
|
7152 |
tabable: true |
|
7153 |
model: blockArgumentsOnNewLine |
|
7154 |
translateLabel: true |
|
7155 |
) |
|
7156 |
) |
|
7157 |
||
7158 |
) |
|
7159 |
) |
|
7160 |
(HorizontalPanelViewSpec |
|
7161 |
name: 'horizontalPanelView' |
|
7162 |
layout: (LayoutFrame 0 0.0 -35 1.0 0 1.0 0 1.0) |
|
7163 |
level: 0 |
|
7164 |
horizontalLayout: fitSpace |
|
7165 |
verticalLayout: center |
|
7166 |
horizontalSpace: 4 |
|
7167 |
verticalSpace: 4 |
|
7168 |
ignoreInvisibleComponents: true |
|
7169 |
component: |
|
7170 |
(SpecCollection |
|
7171 |
collection: ( |
|
7172 |
(ActionButtonSpec |
|
7173 |
label: 'Cancel' |
|
7174 |
name: 'button' |
|
7175 |
translateLabel: true |
|
7176 |
tabable: true |
|
7177 |
model: cancel |
|
7178 |
useDefaultExtent: true |
|
7179 |
) |
|
7180 |
(ActionButtonSpec |
|
7181 |
label: 'OK' |
|
7182 |
name: 'Button1' |
|
7183 |
translateLabel: true |
|
7184 |
tabable: true |
|
7185 |
model: accept |
|
7186 |
isDefault: true |
|
7187 |
useDefaultExtent: true |
|
7188 |
) |
|
7189 |
) |
|
7190 |
||
7191 |
) |
|
7192 |
) |
|
7193 |
) |
|
7194 |
||
7195 |
) |
|
4244 | 7196 |
) |
2596 | 7197 |
! ! |
7198 |
||
16076 | 7199 |
!AbstractLauncherApplication::PackageLoadDialog class methodsFor:'documentation'! |
7200 |
||
7201 |
documentation |
|
7202 |
" |
|
7203 |
handwritten q&d dialog to load packages. |
|
7204 |
TODO: |
|
7205 |
rewrite using UI builder |
|
7206 |
" |
|
7207 |
! ! |
|
7208 |
||
7209 |
!AbstractLauncherApplication::PackageLoadDialog class methodsFor:'opening'! |
|
7210 |
||
7211 |
open |
|
7212 |
self new openLoadPackageDialog |
|
16209 | 7213 |
! |
7214 |
||
7215 |
openModal |
|
7216 |
self new openLoadPackageDialogModal:true |
|
16076 | 7217 |
! ! |
7218 |
||
16330 | 7219 |
!AbstractLauncherApplication::PackageLoadDialog methodsFor:'initialize & release'! |
7220 |
||
7221 |
initializeIcons |
|
7222 |
folderIcon := ToolbarIconLibrary directoryOpen18x18Icon. |
|
7223 |
"/ folderHalfGreyIcon := ToolbarIconLibrary directoryOpenHalfGrey18x18Icon. |
|
7224 |
packageIcon := ToolbarIconLibrary packageOpen24x24Icon. |
|
7225 |
applicationIcon := ToolbarIconLibrary makeYellow22x22Icon1. |
|
7226 |
greyFolderIcon := folderIcon asGrayImageDepth:8. |
|
7227 |
greyPackageIcon := packageIcon asGrayImageDepth:8. |
|
7228 |
greyApplicationIcon := applicationIcon asGrayImageDepth:(applicationIcon depth min:8). |
|
7229 |
! |
|
7230 |
||
7231 |
release |
|
7232 |
|p| |
|
7233 |
||
7234 |
(p := backgroundPackageFindProcess) notNil ifTrue:[ |
|
16894 | 7235 |
backgroundPackageFindProcess := nil. |
16330 | 7236 |
p isDead ifFalse:[ |
7237 |
p terminate |
|
7238 |
] |
|
7239 |
]. |
|
7240 |
super release |
|
7241 |
! ! |
|
7242 |
||
17083 | 7243 |
!AbstractLauncherApplication::PackageLoadDialog methodsFor:'menu'! |
7244 |
||
7245 |
itemMenu |
|
7246 |
|item m itemType package defClass| |
|
7247 |
||
7248 |
hierarchicalListView selectionValue notEmptyOrNil ifTrue:[ |
|
7249 |
item := hierarchicalListView selectionValue first. |
|
7250 |
||
7251 |
itemType := item type. |
|
7252 |
( |
|
7253 |
#( #localRoot #monticelloRoot #compiledPackagesRoot ) includes:itemType |
|
7254 |
) ifFalse:[ |
|
7255 |
||
7256 |
package := packageIdByItem at:item ifAbsent:nil. |
|
7257 |
package notNil ifTrue:[ |
|
7258 |
defClass := package asPackageId projectDefinitionClass. |
|
7259 |
]. |
|
7260 |
||
7261 |
m := Menu new. |
|
7262 |
m addItem:(MenuItem |
|
7263 |
label: (resources string:'Load') |
|
7264 |
itemValue: |
|
7265 |
[ |
|
7266 |
package notNil ifTrue:[ |
|
7267 |
self loadPackageAndUpdate:package browse:false subPackages:false item:item. |
|
7268 |
"/ loadPackageAndUpdate value:package value:false value:item. |
|
7269 |
]. |
|
7270 |
] |
|
7271 |
enabled:package notNil). |
|
7272 |
m addItem:(MenuItem |
|
7273 |
label: (resources string:'Load with All Subpackages') |
|
7274 |
itemValue: |
|
7275 |
[ |
|
7276 |
package notNil ifTrue:[ |
|
7277 |
self loadPackageAndUpdate:package browse:false subPackages:true item:item. |
|
7278 |
"/ loadPackageAndUpdate value:package value:false value:item. |
|
7279 |
]. |
|
7280 |
] |
|
7281 |
enabled:package notNil). |
|
7282 |
m addItem:(MenuItem |
|
7283 |
label: (resources string:'Load PackageDefinition Only') |
|
7284 |
itemValue: |
|
7285 |
[ |
|
7286 |
package notNil ifTrue:[ |
|
7287 |
self loadPackageDefinition:package browse:false subPackages:false item:item. |
|
7288 |
]. |
|
7289 |
] |
|
7290 |
enabled:package notNil). |
|
7291 |
m addSeparator. |
|
7292 |
m addItem:(MenuItem |
|
7293 |
label: (resources string:'Open File Browser on Package''s Folder') |
|
7294 |
itemValue: |
|
7295 |
[ |
|
7296 |
|dir| |
|
7297 |
||
7298 |
package notNil ifTrue:[ |
|
7299 |
dir := Smalltalk packageDirectoryForPackageId:package. |
|
7300 |
dir notNil ifTrue:[ |
|
7301 |
FileBrowser default openOn:dir. |
|
7302 |
] ifFalse:[ |
|
17209 | 7303 |
Dialog warn:(resources string:'Project directory of "%1" is not present/readable' with:package) |
17083 | 7304 |
] |
7305 |
]. |
|
7306 |
] |
|
7307 |
enabled:package notNil). |
|
7308 |
m addSeparator. |
|
7309 |
m addItem:(MenuItem |
|
7310 |
label: (resources string:'Browse Package Definition') |
|
7311 |
itemValue: |
|
7312 |
[ |
|
7313 |
defClass notNil ifTrue:[ |
|
7314 |
SystemBrowser default openInClass:defClass class |
|
7315 |
]. |
|
7316 |
] |
|
7317 |
enabled:defClass notNil). |
|
7318 |
m addItem:(MenuItem |
|
7319 |
label: (resources string:'Browse Package') |
|
7320 |
itemValue: |
|
7321 |
[ |
|
7322 |
Tools::NewSystemBrowser openOnPackage:package |
|
7323 |
] |
|
7324 |
enabled:defClass notNil). |
|
7325 |
||
7326 |
item type == #monticelloPackage ifTrue:[ |
|
7327 |
m addItem:(MenuItem |
|
7328 |
label: (resources string:'Browse Monticello Package') |
|
7329 |
itemValue: [ |
|
7330 |
|repos| |
|
7331 |
||
7332 |
repos := item parent info. |
|
7333 |
MCRepositoryBrowser openOnRepository:repos forPackage:item label. |
|
7334 |
]). |
|
7335 |
]. |
|
7336 |
]. |
|
7337 |
]. |
|
7338 |
^ m |
|
7339 |
||
7340 |
"Modified: / 18-11-2016 / 11:11:07 / cg" |
|
7341 |
! ! |
|
7342 |
||
16076 | 7343 |
!AbstractLauncherApplication::PackageLoadDialog methodsFor:'opening'! |
7344 |
||
7345 |
openLoadPackageDialog |
|
7346 |
"open a dialog showing wellknown packages (listed in the packages directory) |
|
7347 |
and offer to load the selected one(s). |
|
7348 |
TODO: make this a little app instead of an ad-hoc dialog, |
|
7349 |
add remote packages (central goody repository?)" |
|
7350 |
||
16209 | 7351 |
self openLoadPackageDialogModal:false. |
7352 |
! |
|
7353 |
||
7354 |
openLoadPackageDialogModal:modal |
|
7355 |
"open a dialog showing wellknown packages (listed in the packages directory) |
|
7356 |
and offer to load the selected one(s). |
|
7357 |
TODO: make this a little app instead of an ad-hoc dialog, |
|
7358 |
add remote packages (central goody repository?)" |
|
7359 |
||
16076 | 7360 |
|list dialog filter v |
7361 |
browse selectionChangeAction |
|
7362 |
selectedPackageLabel infoView monticelloLabel| |
|
7363 |
||
7364 |
alreadyLoadedString := (resources string:' (already loaded)') allItalic. |
|
7365 |
||
7366 |
self initializeIcons. |
|
7367 |
||
7368 |
selectedPackageHolder := ValueHolder with:nil. |
|
7369 |
infoTextHolder := ValueHolder with:nil. |
|
7370 |
filterHolder := ValueHolder with:nil. |
|
7371 |
itemsByPath := Dictionary new. |
|
7372 |
packageIdByItem := IdentityDictionary new. |
|
7373 |
pathByItem := IdentityDictionary new. |
|
7374 |
||
7375 |
list := HierarchicalList new. |
|
7376 |
||
16969 | 7377 |
masterRoot := MyHierarchicalItem new. |
16076 | 7378 |
masterRoot icon:(ToolbarIconLibrary stxHomeIcon). |
7379 |
masterRoot label:(resources string:'local '). |
|
7380 |
masterRoot type:#localRoot. |
|
7381 |
||
16969 | 7382 |
root := MyHierarchicalItem new. |
16076 | 7383 |
root icon:folderIcon. |
16410 | 7384 |
root label:((resources string:'[Compiled Packages]') asText allItalic withColor:Color grey). |
16076 | 7385 |
root type:#compiledPackagesRoot. |
7386 |
masterRoot add:root. |
|
7387 |
||
16969 | 7388 |
monticelloRoot := MyHierarchicalItem new. |
16410 | 7389 |
monticelloLabel := ((resources string:'[Monticello Packages]') asText allItalic withColor:Color grey). |
16076 | 7390 |
monticelloRoot type:#monticelloRoot. |
7391 |
||
7392 |
(MCRepositoryGroup isNil or:[MCRepositoryGroup isLoaded not]) ifTrue:[ |
|
7393 |
monticelloRoot icon:greyFolderIcon. |
|
16506 | 7394 |
monticelloRoot label:monticelloLabel, (' (Monticello Support not Loaded)' withColor:Color grey). |
16076 | 7395 |
] ifFalse:[ |
7396 |
monticelloRoot icon:folderIcon. |
|
7397 |
monticelloRoot label:monticelloLabel. |
|
7398 |
self getMonticelloRepositories. |
|
7399 |
]. |
|
7400 |
masterRoot add:monticelloRoot. |
|
7401 |
||
7402 |
self readPackageTree. |
|
16330 | 7403 |
self readOtherPackageTreesInBackground. |
16076 | 7404 |
masterRoot expand. |
7405 |
root expand. |
|
7406 |
list root:masterRoot. |
|
7407 |
||
7408 |
PreviousPackageDialogItems notNil ifTrue:[ |
|
7409 |
PreviousPackageDialogItems keysAndValuesDo:[:path :prevItem | |
|
7410 |
|newItem| |
|
7411 |
||
7412 |
newItem := itemsByPath at:path ifAbsent:nil. |
|
7413 |
newItem notNil ifTrue:[ |
|
7414 |
prevItem isExpanded ifTrue:[ newItem expand ] |
|
7415 |
]. |
|
7416 |
]. |
|
7417 |
]. |
|
7418 |
||
7419 |
selectionChangeAction := |
|
7420 |
[:selectionIndices | self selectionChangeAction:selectionIndices]. |
|
7421 |
||
7422 |
dialog := Dialog new. |
|
7423 |
dialog label:(resources string:'Load Package'). |
|
7424 |
dialog addButton:(loadButton := Button label:(resources string:'Load') action:[self loadAction:false]) beReturnButton. |
|
7425 |
dialog addButton:(loadAndBrowseButton := Button label:(resources string:'Load & Browse') action:[self loadAction:true]). |
|
7426 |
dialog addAbortButtonLabelled:(resources string:'Close'). |
|
7427 |
||
7428 |
loadButton enabled:false. |
|
7429 |
loadAndBrowseButton enabled:false. |
|
7430 |
||
7431 |
filter := EditField new. |
|
7432 |
filter emptyFieldReplacementText:(resources string:'Filter Pattern'). |
|
7433 |
filter immediateAccept:true. |
|
7434 |
filter model: filterHolder. |
|
7435 |
filterHolder onChangeEvaluate:[self filterChangedAction]. |
|
7436 |
dialog |
|
7437 |
addLabelledField:filter |
|
7438 |
label:(resources string:'Quick Find:') |
|
7439 |
adjust:#left tabable:true from:0.0 to:1.0 separateAtX:150. |
|
7440 |
||
7441 |
"/ dialog addComponent:filter. |
|
7442 |
||
7443 |
v := HVScrollableView for:HierarchicalListView. |
|
7444 |
hierarchicalListView := v scrolledView. |
|
7445 |
hierarchicalListView multipleSelectOk:true. |
|
7446 |
hierarchicalListView preferredExtent:(400 @ 300). |
|
7447 |
hierarchicalListView doubleClickAction:[:index | self loadAction:false. dialog okPressed]. |
|
7448 |
hierarchicalListView list:list. |
|
7449 |
hierarchicalListView action:selectionChangeAction. |
|
7450 |
hierarchicalListView menuHolder:[ self itemMenu]. |
|
7451 |
||
7452 |
dialog addComponent:v. |
|
7453 |
selectedPackageLabel := dialog addTextLabelOn:(selectedPackageHolder) adjust:#left. |
|
7454 |
infoView := dialog addTextBoxOn:infoTextHolder class:TextView withNumberOfLines:5 hScrollable:true vScrollable:true. |
|
7455 |
||
7456 |
dialog stickAtBottomWithVariableHeight:v. |
|
7457 |
dialog stickAtBottomWithFixHeight:selectedPackageLabel. |
|
7458 |
dialog stickAtBottomWithFixHeight:infoView. |
|
7459 |
||
7460 |
PreviousPackageDialogExtent notNil ifTrue:[ |
|
7461 |
dialog extent:PreviousPackageDialogExtent |
|
7462 |
]. |
|
7463 |
||
7464 |
browse := false. |
|
16330 | 7465 |
dialog application:self. |
16209 | 7466 |
modal ifTrue:[ |
7467 |
dialog openModalAtPointer. |
|
7468 |
] ifFalse:[ |
|
7469 |
dialog openModelessAtPointer. |
|
7470 |
]. |
|
16076 | 7471 |
|
7472 |
"/ remember the expand/collapse status |
|
7473 |
PreviousPackageDialogItems := itemsByPath. |
|
7474 |
PreviousPackageDialogExtent := dialog extent. |
|
7475 |
! ! |
|
7476 |
||
7477 |
!AbstractLauncherApplication::PackageLoadDialog methodsFor:'private'! |
|
7478 |
||
16330 | 7479 |
addItemWithPackagePath:path target:target asApplication:isApplication toRoot:aRoot |
7480 |
|item isAlreadyLoaded defClass packageID| |
|
7481 |
||
7482 |
"/ see if already loaded |
|
7483 |
||
7484 |
packageID := (path size > 1) |
|
7485 |
ifTrue:[ path first , ':' , ((path copyFrom:2) asStringWith:$/) ] |
|
7486 |
ifFalse:[ path first ]. |
|
7487 |
||
7488 |
item := self getItemByPath:path packageID:packageID under:aRoot. |
|
7489 |
||
7490 |
isAlreadyLoaded := false. |
|
7491 |
Error handle:[:ex | |
|
16410 | 7492 |
item label:(item label , (' ERROR - please rebuild!!' withColor:Color red)). |
16330 | 7493 |
] do:[ |
7494 |
isAlreadyLoaded := |
|
7495 |
(defClass := ProjectDefinition definitionClassForPackage:packageID) notNil |
|
7496 |
and:[ defClass isLoaded |
|
7497 |
and:[ defClass isFullyLoaded ]]. |
|
7498 |
]. |
|
7499 |
||
7500 |
target notNil ifTrue:[ |
|
7501 |
((target startsWith:'lib ') or:[(target startsWith:'app ')]) ifTrue:[ |
|
7502 |
pathByItem at:item put:(target copyFrom:(target indexOfSeparator + 1)) withoutSeparators. |
|
7503 |
]. |
|
7504 |
]. |
|
7505 |
||
7506 |
"/ do not overwrite an app by a lib with the same name (happens in expecco/application) |
|
7507 |
(isApplication or:[ item icon isNil or:[item icon == folderIcon or:[item icon == greyFolderIcon]]]) ifTrue:[ |
|
7508 |
isAlreadyLoaded ifTrue:[ |
|
7509 |
item icon:(isApplication ifTrue:[greyApplicationIcon] ifFalse:[greyPackageIcon]). |
|
7510 |
item label:(item label , alreadyLoadedString) |
|
7511 |
] ifFalse:[ |
|
7512 |
item icon:(isApplication ifTrue:[applicationIcon] ifFalse:[packageIcon]). |
|
7513 |
]. |
|
7514 |
]. |
|
7515 |
||
7516 |
"/ if it is not already loaded, make all parents non-grey |
|
7517 |
isAlreadyLoaded ifFalse:[ |
|
7518 |
path size-1 to:1 by:-1 do:[:n | |
|
7519 |
|parentPath parentItem| |
|
7520 |
||
7521 |
parentPath := path copyTo:n. |
|
7522 |
parentItem := self getItemByPath:parentPath packageID:packageID under:aRoot. |
|
7523 |
parentItem icon == greyFolderIcon ifTrue:[ |
|
7524 |
parentItem icon:folderIcon. |
|
7525 |
"/ ] ifFalse:[ |
|
7526 |
"/ parentItem icon == greyApplicationIcon ifTrue:[ |
|
7527 |
"/ parentItem icon:applicationIcon. |
|
7528 |
"/ ]. |
|
7529 |
]. |
|
7530 |
] |
|
7531 |
]. |
|
7532 |
! |
|
7533 |
||
16076 | 7534 |
filterChangedAction |
16969 | 7535 |
|newMatchingItems filterPattern isMatch firstMatchingItem| |
16076 | 7536 |
|
7537 |
filterPattern := filterHolder value. |
|
7538 |
filterPattern isEmptyOrNil ifTrue:[ |
|
16969 | 7539 |
itemsMatchingFilter notEmptyOrNil ifTrue:[ |
7540 |
"/ nothing |
|
7541 |
root recursiveDo:[:item | |
|
7542 |
item label:(item label copy asText allNonBold withoutAnyColorEmphasis). |
|
7543 |
]. |
|
7544 |
]. |
|
7545 |
itemsMatchingFilter := #(). |
|
7546 |
^ self. |
|
7547 |
]. |
|
7548 |
||
7549 |
filterPattern := filterPattern asLowercase. |
|
7550 |
isMatch := filterPattern includesMatchCharacters. |
|
7551 |
||
7552 |
newMatchingItems := OrderedCollection new. |
|
7553 |
masterRoot recursiveDo:[:item | |
|
7554 |
|itemLabel itemPackage| |
|
7555 |
||
7556 |
itemLabel := item label. |
|
7557 |
itemPackage := packageIdByItem at:item ifAbsent:''. |
|
7558 |
||
7559 |
((isMatch and:[itemLabel matches:filterPattern caseSensitive:false]) |
|
7560 |
or:[ (isMatch not and:[ itemLabel asLowercase includesString:filterPattern ]) |
|
7561 |
or:[ (isMatch and:[itemPackage matches:filterPattern caseSensitive:false]) |
|
7562 |
or:[ isMatch not and:[ itemPackage asLowercase includesString:filterPattern ]]]]) |
|
7563 |
ifTrue:[ |
|
7564 |
newMatchingItems add:item. |
|
7565 |
] |
|
7566 |
]. |
|
7567 |
(newMatchingItems sameContentsAs:itemsMatchingFilter) ifTrue:[ |
|
7568 |
^ self |
|
7569 |
]. |
|
7570 |
||
7571 |
newMatchingItems isEmpty ifTrue:[ |
|
7572 |
"/ nothing found |
|
16076 | 7573 |
root recursiveDo:[:item | |
7574 |
item label:(item label copy asText allNonBold withoutAnyColorEmphasis). |
|
7575 |
]. |
|
16969 | 7576 |
Screen current beep. |
16076 | 7577 |
] ifFalse:[ |
16969 | 7578 |
"/ collapse all and fully expand all matching items |
16076 | 7579 |
masterRoot recursiveDo:[:item | |
16969 | 7580 |
item collapse. |
7581 |
item label:(item label copy asText allNonBold withColor:Color grey). |
|
16076 | 7582 |
]. |
16969 | 7583 |
firstMatchingItem := nil. |
7584 |
newMatchingItems do:[:item | |
|
7585 |
item label:(item label copy asText allBold withoutAnyColorEmphasis). |
|
7586 |
item makeVisible. |
|
7587 |
firstMatchingItem := firstMatchingItem ? item. |
|
16076 | 7588 |
]. |
16969 | 7589 |
hierarchicalListView makeLineVisible:firstMatchingItem listIndex. |
7590 |
]. |
|
7591 |
itemsMatchingFilter := newMatchingItems. |
|
16076 | 7592 |
! |
7593 |
||
16330 | 7594 |
getItemByPath:path packageID:packageID under:aRoot |
16076 | 7595 |
"/ ensures an item for a path and returns it. |
7596 |
"/ if not already present, the item is created as a folder |
|
7597 |
||
7598 |
|item parent subPackageID| |
|
7599 |
||
7600 |
item := path isEmpty |
|
16330 | 7601 |
ifTrue:[aRoot] |
7602 |
ifFalse:[ itemsByPath at:( {aRoot label},path) ifAbsent:nil ]. |
|
16076 | 7603 |
item isNil ifTrue:[ |
16330 | 7604 |
parent := self getItemByPath:(path copyButLast) packageID:packageID under:aRoot. |
16969 | 7605 |
item := MyHierarchicalItem new |
16076 | 7606 |
children:#(); |
7607 |
icon:greyFolderIcon; |
|
7608 |
label:path last. |
|
7609 |
parent add:item. |
|
16330 | 7610 |
itemsByPath at:( {aRoot label},path) put:item. |
16076 | 7611 |
subPackageID := path size > 1 |
7612 |
ifTrue:[ path first , ':' , ((path copyFrom:2) asStringWith:$/) ] |
|
7613 |
ifFalse:[ path first ]. |
|
7614 |
packageIdByItem at:item put:subPackageID. |
|
7615 |
]. |
|
7616 |
^ item |
|
7617 |
! |
|
7618 |
||
7619 |
getMonticelloRepositories |
|
7620 |
(MCRepositoryGroup default repositories |
|
7621 |
asSortedCollection:[:a :b |a displayString < b displayString]) |
|
7622 |
do:[:each | |
|
7623 |
|reposItem| |
|
7624 |
||
16969 | 7625 |
reposItem := MyHierarchicalItem new. |
16076 | 7626 |
reposItem icon:folderIcon. |
16410 | 7627 |
reposItem label:each displayString , ((resources string:' [MC Repository]') asText allItalic withColor:Color grey). |
16076 | 7628 |
reposItem type:#monticelloRepository. |
7629 |
reposItem info:each. |
|
7630 |
monticelloRoot add:reposItem. |
|
7631 |
||
7632 |
each allPackageNames asSortedCollection do:[:eachPackage | |
|
7633 |
|packageItem| |
|
7634 |
||
16969 | 7635 |
packageItem := MyHierarchicalItem new. |
16076 | 7636 |
packageItem icon:packageIcon. |
7637 |
packageItem label:eachPackage. |
|
7638 |
packageItem type:#monticelloPackage. |
|
7639 |
reposItem add:packageItem. |
|
7640 |
] |
|
7641 |
]. |
|
7642 |
! |
|
7643 |
||
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7644 |
"Modified: / 28-06-2016 / 07:55:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
16076 | 7645 |
loadAction:doBrowse |
7646 |
"the button's load action" |
|
7647 |
||
7648 |
(hierarchicalListView selectionValue) do:[:eachSelectedItem | |
|
7649 |
|package repos| |
|
7650 |
||
7651 |
eachSelectedItem type == #monticelloRepository ifTrue:[ |
|
7652 |
repos := eachSelectedItem info. |
|
7653 |
MCRepositoryBrowser openOnRepository:repos forPackage:nil. |
|
7654 |
] ifFalse:[ |
|
7655 |
eachSelectedItem type == #monticelloPackage ifTrue:[ |
|
7656 |
repos := eachSelectedItem parent info. |
|
7657 |
MCRepositoryBrowser openOnRepository:repos forPackage:eachSelectedItem label. |
|
7658 |
] ifFalse:[ |
|
16894 | 7659 |
package := packageIdByItem at:eachSelectedItem ifAbsent:[nil]. |
16076 | 7660 |
package notNil ifTrue:[ |
7661 |
self loadPackageAndUpdate:package browse:doBrowse subPackages:false item:eachSelectedItem |
|
7662 |
]. |
|
7663 |
]. |
|
7664 |
]. |
|
7665 |
]. |
|
7666 |
! |
|
7667 |
||
7668 |
loadPackageAndUpdate:package browse:doBrowse subPackages:subPackages item:someItem |
|
7669 |
|defClass updateAction| |
|
7670 |
||
7671 |
self withWaitCursorDo:[ |
|
7672 |
updateAction := |
|
7673 |
[:whatChanged :parameter | |
|
7674 |
self updateAction:whatChanged parameter:parameter |
|
7675 |
]. |
|
7676 |
||
7677 |
Smalltalk onChangeSend:#value:value: to:updateAction. |
|
7678 |
[ |
|
16687 | 7679 |
|packageTried| |
7680 |
packageTried := package. |
|
7681 |
((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[ |
|
7682 |
packageTried := package,':' |
|
7683 |
]. |
|
16076 | 7684 |
[ |
16687 | 7685 |
Smalltalk loadPackage:packageTried |
16076 | 7686 |
] on:PackageLoadError do:[:ex | |
7687 |
|path| |
|
7688 |
||
16111 | 7689 |
path := pathByItem at:someItem ifAbsent:nil. |
7690 |
path isNil ifTrue:[ |
|
17213 | 7691 |
Dialog information:('package load failed: %1' bindWith:ex description). |
16111 | 7692 |
] ifFalse:[ |
7693 |
"/ try to load the file as is (i.e. not via package-id |
|
17213 | 7694 |
Dialog information:('package load failed: %1\\Loading file directly...' bindWith:ex description). |
16111 | 7695 |
Smalltalk fileIn:(packageDirPath asFilename / path). |
7696 |
]. |
|
16076 | 7697 |
] |
7698 |
] ensure:[ |
|
7699 |
Smalltalk retractInterestsFor:updateAction. |
|
7700 |
]. |
|
7701 |
]. |
|
7702 |
((defClass := package asPackageId projectDefinitionClass) notNil |
|
7703 |
and:[ defClass isLoaded |
|
7704 |
and:[ defClass isFullyLoaded ]]) |
|
7705 |
ifFalse:[ |
|
7706 |
defClass isNil ifTrue:[ |
|
7707 |
Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package) |
|
7708 |
] ifFalse:[ |
|
7709 |
defClass verbose:true. |
|
7710 |
defClass isLoaded. |
|
7711 |
defClass isFullyLoaded. |
|
7712 |
defClass verbose:false. |
|
7713 |
Dialog warn:(resources string:'Load failed: definition class /%1) not fully loaded after package load.' with:defClass name) |
|
7714 |
] |
|
7715 |
] ifTrue:[ |
|
7716 |
doBrowse ifTrue:[ |
|
7717 |
Tools::NewSystemBrowser openOnPackage:package |
|
7718 |
]. |
|
7719 |
someItem icon == packageIcon ifTrue:[ |
|
7720 |
someItem icon:greyPackageIcon. |
|
7721 |
someItem label:(someItem label , alreadyLoadedString). |
|
7722 |
] ifFalse:[ |
|
7723 |
someItem icon == applicationIcon ifTrue:[ |
|
7724 |
someItem icon:greyApplicationIcon. |
|
7725 |
someItem label:(someItem label , alreadyLoadedString). |
|
7726 |
]. |
|
7727 |
]. |
|
7728 |
]. |
|
7729 |
||
7730 |
subPackages ifTrue:[ |
|
7731 |
someItem children do:[:eachChild | |
|
7732 |
|subPackageID| |
|
7733 |
||
7734 |
subPackageID := packageIdByItem at:eachChild. |
|
7735 |
self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild. |
|
7736 |
]. |
|
7737 |
]. |
|
7738 |
! |
|
7739 |
||
17083 | 7740 |
loadPackageDefinition:package browse:doBrowse subPackages:subPackages item:someItem |
7741 |
|defClass updateAction| |
|
7742 |
||
7743 |
self withWaitCursorDo:[ |
|
7744 |
updateAction := |
|
7745 |
[:whatChanged :parameter | |
|
7746 |
self updateAction:whatChanged parameter:parameter |
|
7747 |
]. |
|
7748 |
||
7749 |
Smalltalk onChangeSend:#value:value: to:updateAction. |
|
17209 | 7750 |
|
17083 | 7751 |
[ |
7752 |
|packageTried dir className fileName| |
|
7753 |
||
7754 |
packageTried := package. |
|
7755 |
((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[ |
|
7756 |
packageTried := package,':' |
|
7757 |
]. |
|
7758 |
||
7759 |
dir := Smalltalk packageDirectoryForPackageId:package. |
|
7760 |
dir notNil ifTrue:[ |
|
7761 |
"/ is there a project definition class's source? |
|
7762 |
className := ProjectDefinition projectDefinitionClassNameForDefinitionOf:package. |
|
7763 |
fileName := dir / ((Smalltalk fileNameForClass:className),'.st'). |
|
7764 |
fileName exists ifTrue:[ |
|
17209 | 7765 |
ParseError handle:[:ex | |
7766 |
Dialog warn:(resources string:'An error happened while loading the project definition:\ %1\\Maybe the project depends on some other package.\Please check this manually.' with:ex description) |
|
7767 |
] do:[ |
|
7768 |
Smalltalk fileIn:fileName. |
|
7769 |
]. |
|
17083 | 7770 |
] ifFalse:[ |
7771 |
Dialog warn:(resources string:'Project definition class file not present: "%1"' with:fileName) |
|
7772 |
] |
|
7773 |
] ifFalse:[ |
|
17209 | 7774 |
Dialog warn:(resources string:'Project directory for "%1" is not present/readable' with:package). |
7775 |
^ self. |
|
17083 | 7776 |
] |
7777 |
] ensure:[ |
|
7778 |
Smalltalk retractInterestsFor:updateAction. |
|
7779 |
]. |
|
7780 |
]. |
|
17209 | 7781 |
((defClass := package asPackageId projectDefinitionClass) notNil and:[ defClass isLoaded ]) |
17083 | 7782 |
ifFalse:[ |
7783 |
defClass isNil ifTrue:[ |
|
7784 |
Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package) |
|
7785 |
] |
|
7786 |
] ifTrue:[ |
|
7787 |
doBrowse ifTrue:[ |
|
7788 |
Tools::NewSystemBrowser openOnPackage:package |
|
7789 |
]. |
|
7790 |
"/ someItem icon == packageIcon ifTrue:[ |
|
7791 |
"/ someItem icon:greyPackageIcon. |
|
7792 |
"/ someItem label:(someItem label , alreadyLoadedString). |
|
7793 |
"/ ] ifFalse:[ |
|
7794 |
"/ someItem icon == applicationIcon ifTrue:[ |
|
7795 |
"/ someItem icon:greyApplicationIcon. |
|
7796 |
"/ someItem label:(someItem label , alreadyLoadedString). |
|
7797 |
"/ ]. |
|
7798 |
"/ ]. |
|
7799 |
]. |
|
7800 |
||
7801 |
subPackages ifTrue:[ |
|
7802 |
someItem children do:[:eachChild | |
|
7803 |
|subPackageID| |
|
7804 |
||
7805 |
subPackageID := packageIdByItem at:eachChild. |
|
7806 |
self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild. |
|
7807 |
]. |
|
7808 |
]. |
|
7809 |
||
7810 |
"Created: / 18-11-2016 / 11:13:03 / cg" |
|
7811 |
! |
|
7812 |
||
16330 | 7813 |
readOtherPackageTrees |
7814 |
|packagePath| |
|
7815 |
||
7816 |
packagePath := Smalltalk packagePath. |
|
7817 |
packagePath do:[:eachDirName | |
|
7818 |
|folderRoot eachDir| |
|
7819 |
||
7820 |
eachDir := eachDirName asFilename. |
|
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7821 |
eachDir isDirectory ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7822 |
selectedPackageHolder value isNil ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7823 |
infoTextHolder value:(resources string:'searching %1...' with:eachDirName). |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7824 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7825 |
eachDir |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7826 |
recursiveDirectoryContentsWithPrefix:'' |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7827 |
filesDo:nil |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7828 |
directoriesDo:[:subDir | |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7829 |
|dfnBasename expectedDfnFilename| |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7830 |
|
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7831 |
(eachDir / subDir / 'abbrev.stc') exists ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7832 |
"/ see if there is a project definition file in this dir |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7833 |
dfnBasename := subDir copyReplaceAll:(Filename separator) with:$_. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7834 |
expectedDfnFilename := (eachDir / subDir / dfnBasename) withSuffix:'st'. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7835 |
expectedDfnFilename exists ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7836 |
|path| |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7837 |
|
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7838 |
path := subDir asFilename components. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7839 |
(itemsByPath at:( {root label},path) ifAbsent:nil) isNil ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7840 |
folderRoot isNil ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7841 |
folderRoot := MyHierarchicalItem new. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7842 |
folderRoot icon:folderIcon. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7843 |
folderRoot label:((resources string:'[%1]' with:eachDirName) asText allItalic withColor:Color grey). |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7844 |
folderRoot type:#compiledPackagesRoot. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7845 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7846 |
self |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7847 |
addItemWithPackagePath:path |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7848 |
target:nil |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7849 |
asApplication:false |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7850 |
toRoot:folderRoot. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7851 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7852 |
] |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7853 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7854 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7855 |
folderRoot notNil ifTrue:[ |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7856 |
masterRoot add:folderRoot. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7857 |
]. |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7858 |
]. |
16330 | 7859 |
selectedPackageHolder value isNil ifTrue:[ |
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7860 |
infoTextHolder value:(resources string:'Done searching other package folders.'). |
16330 | 7861 |
]. |
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7862 |
] |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7863 |
|
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7864 |
"/ packageDirPath isNil ifTrue:[ |
16330 | 7865 |
"/ root label:root label,((resources string:' (no "packages" folder found)') colorizeAllWith:Color red). |
7866 |
"/ ] ifFalse:[ |
|
7867 |
"/ packageDirPath asFilename directoryContentsAsFilenames sort do:[:fn | |
|
7868 |
"/ |item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded |
|
7869 |
"/ defClass target packageID| |
|
7870 |
"/ |
|
7871 |
"/ ((fn suffix = 'mcz') |
|
7872 |
"/ or:[ fn isDirectory |
|
7873 |
"/ or:[ (fn baseName startsWith:'.') |
|
7874 |
"/ or:[ (fn baseName = 'README') ]]]) ifFalse:[ |
|
7875 |
"/ base := fn withoutSuffix baseName. |
|
7876 |
"/ (base startsWith:'lib') ifTrue:[ |
|
7877 |
"/ nm := (base copyFrom:4). |
|
7878 |
"/ fn suffix notEmptyOrNil ifTrue:[ |
|
7879 |
"/ isLibrary := true. |
|
7880 |
"/ isApplication := false. |
|
7881 |
"/ ] ifFalse:[ |
|
7882 |
"/ isLibrary := false. |
|
7883 |
"/ isApplication := true. |
|
7884 |
"/ ] |
|
7885 |
"/ ] ifFalse:[ |
|
7886 |
"/ nm := base. |
|
7887 |
"/ isLibrary := false. |
|
7888 |
"/ isApplication := true. |
|
7889 |
"/ ]. |
|
7890 |
"/ |
|
7891 |
"/ path := nm asCollectionOfSubstringsSeparatedBy:$_. |
|
7892 |
"/ "/ see if already loaded |
|
7893 |
"/ |
|
7894 |
"/ packageID := (path size > 1) |
|
7895 |
"/ ifTrue:[ path first , ':' , ((path copyFrom:2) asStringWith:$/) ] |
|
7896 |
"/ ifFalse:[ path first ]. |
|
7897 |
"/ |
|
7898 |
"/ item := self getItemByPath:path packageID:packageID. |
|
7899 |
"/ |
|
7900 |
"/ isAlreadyLoaded := false. |
|
7901 |
"/ Error handle:[:ex | |
|
7902 |
"/ item label:(item label , (' ERROR - please rebuild!!' colorizeAllWith:Color red)). |
|
7903 |
"/ ] do:[ |
|
7904 |
"/ isAlreadyLoaded := |
|
7905 |
"/ (defClass := ProjectDefinition definitionClassForPackage:packageID) notNil |
|
7906 |
"/ and:[ defClass isLoaded |
|
7907 |
"/ and:[ defClass isFullyLoaded ]]. |
|
7908 |
"/ ]. |
|
7909 |
"/ |
|
7910 |
"/ target := fn contents first. |
|
7911 |
"/ ((target startsWith:'lib ') or:[(target startsWith:'app ')]) ifTrue:[ |
|
7912 |
"/ pathByItem at:item put:(target copyFrom:(target indexOfSeparator + 1)) withoutSeparators. |
|
7913 |
"/ ]. |
|
7914 |
"/ |
|
7915 |
"/ "/ do not overwrite an app by a lib with the same name (happens in expecco/application) |
|
7916 |
"/ (isApplication or:[ item icon isNil or:[item icon == folderIcon or:[item icon == greyFolderIcon]]]) ifTrue:[ |
|
7917 |
"/ isAlreadyLoaded ifTrue:[ |
|
7918 |
"/ item icon:(isApplication ifTrue:[greyApplicationIcon] ifFalse:[greyPackageIcon]). |
|
7919 |
"/ item label:(item label , alreadyLoadedString) |
|
7920 |
"/ ] ifFalse:[ |
|
7921 |
"/ item icon:(isApplication ifTrue:[applicationIcon] ifFalse:[packageIcon]). |
|
7922 |
"/ ]. |
|
7923 |
"/ ]. |
|
7924 |
"/ |
|
7925 |
"/ "/ if it is not already loaded, make all parents non-grey |
|
7926 |
"/ isAlreadyLoaded ifFalse:[ |
|
7927 |
"/ path size-1 to:1 by:-1 do:[:n | |
|
7928 |
"/ |parentPath parentItem| |
|
7929 |
"/ |
|
7930 |
"/ parentPath := path copyTo:n. |
|
7931 |
"/ parentItem := self getItemByPath:parentPath packageID:packageID. |
|
7932 |
"/ parentItem icon == greyFolderIcon ifTrue:[ |
|
7933 |
"/ parentItem icon:folderIcon. |
|
7934 |
"/"/ ] ifFalse:[ |
|
7935 |
"/"/ parentItem icon == greyApplicationIcon ifTrue:[ |
|
7936 |
"/"/ parentItem icon:applicationIcon. |
|
7937 |
"/"/ ]. |
|
7938 |
"/ ]. |
|
7939 |
"/ ] |
|
7940 |
"/ ]. |
|
7941 |
"/ ]. |
|
7942 |
"/ ]. |
|
7943 |
"/ ]. |
|
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7944 |
|
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
7945 |
"Modified: / 05-01-2017 / 21:33:18 / jv" |
16330 | 7946 |
! |
7947 |
||
7948 |
readOtherPackageTreesInBackground |
|
7949 |
backgroundPackageFindProcess := |
|
7950 |
[ |
|
7951 |
[ |
|
7952 |
self readOtherPackageTrees. |
|
7953 |
] ensure:[ |
|
7954 |
backgroundPackageFindProcess := nil. |
|
7955 |
]. |
|
7956 |
] forkAt:(Processor userBackgroundPriority). |
|
7957 |
! |
|
7958 |
||
16076 | 7959 |
readPackageTree |
7960 |
packageDirPath := Smalltalk getSystemFileName:'packages'. |
|
7961 |
packageDirPath isNil ifTrue:[ |
|
16410 | 7962 |
root label:root label,((resources string:' (no "packages" folder found)') withColor:Color red). |
16076 | 7963 |
] ifFalse:[ |
7964 |
packageDirPath asFilename directoryContentsAsFilenames sort do:[:fn | |
|
7965 |
|item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded |
|
7966 |
defClass target packageID| |
|
7967 |
||
7968 |
((fn suffix = 'mcz') |
|
7969 |
or:[ fn isDirectory |
|
7970 |
or:[ (fn baseName startsWith:'.') |
|
7971 |
or:[ (fn baseName = 'README') ]]]) ifFalse:[ |
|
7972 |
base := fn withoutSuffix baseName. |
|
7973 |
(base startsWith:'lib') ifTrue:[ |
|
7974 |
nm := (base copyFrom:4). |
|
7975 |
fn suffix notEmptyOrNil ifTrue:[ |
|
7976 |
isLibrary := true. |
|
7977 |
isApplication := false. |
|
7978 |
] ifFalse:[ |
|
7979 |
isLibrary := false. |
|
7980 |
isApplication := true. |
|
7981 |
] |
|
7982 |
] ifFalse:[ |
|
7983 |
nm := base. |
|
7984 |
isLibrary := false. |
|
7985 |
isApplication := true. |
|
7986 |
]. |
|
7987 |
||
7988 |
path := nm asCollectionOfSubstringsSeparatedBy:$_. |
|
16330 | 7989 |
target := fn contents first. |
7990 |
||
7991 |
self |
|
7992 |
addItemWithPackagePath:path |
|
7993 |
target:target |
|
7994 |
asApplication:isApplication |
|
7995 |
toRoot:root. |
|
7996 |
false ifTrue:[ |
|
16076 | 7997 |
"/ see if already loaded |
7998 |
||
7999 |
packageID := (path size > 1) |
|
8000 |
ifTrue:[ path first , ':' , ((path copyFrom:2) asStringWith:$/) ] |
|
8001 |
ifFalse:[ path first ]. |
|
8002 |
||
8003 |
item := self getItemByPath:path packageID:packageID. |
|
8004 |
||
16225 | 8005 |
isAlreadyLoaded := false. |
8006 |
Error handle:[:ex | |
|
16506 | 8007 |
item label:(item label , (' ERROR - please rebuild!!' withColor:Color red)). |
16225 | 8008 |
] do:[ |
8009 |
isAlreadyLoaded := |
|
8010 |
(defClass := ProjectDefinition definitionClassForPackage:packageID) notNil |
|
8011 |
and:[ defClass isLoaded |
|
8012 |
and:[ defClass isFullyLoaded ]]. |
|
8013 |
]. |
|
8014 |
||
16076 | 8015 |
((target startsWith:'lib ') or:[(target startsWith:'app ')]) ifTrue:[ |
8016 |
pathByItem at:item put:(target copyFrom:(target indexOfSeparator + 1)) withoutSeparators. |
|
8017 |
]. |
|
8018 |
||
8019 |
"/ do not overwrite an app by a lib with the same name (happens in expecco/application) |
|
8020 |
(isApplication or:[ item icon isNil or:[item icon == folderIcon or:[item icon == greyFolderIcon]]]) ifTrue:[ |
|
8021 |
isAlreadyLoaded ifTrue:[ |
|
8022 |
item icon:(isApplication ifTrue:[greyApplicationIcon] ifFalse:[greyPackageIcon]). |
|
8023 |
item label:(item label , alreadyLoadedString) |
|
8024 |
] ifFalse:[ |
|
8025 |
item icon:(isApplication ifTrue:[applicationIcon] ifFalse:[packageIcon]). |
|
8026 |
]. |
|
8027 |
]. |
|
8028 |
||
8029 |
"/ if it is not already loaded, make all parents non-grey |
|
8030 |
isAlreadyLoaded ifFalse:[ |
|
8031 |
path size-1 to:1 by:-1 do:[:n | |
|
8032 |
|parentPath parentItem| |
|
8033 |
||
8034 |
parentPath := path copyTo:n. |
|
8035 |
parentItem := self getItemByPath:parentPath packageID:packageID. |
|
8036 |
parentItem icon == greyFolderIcon ifTrue:[ |
|
8037 |
parentItem icon:folderIcon. |
|
8038 |
"/ ] ifFalse:[ |
|
8039 |
"/ parentItem icon == greyApplicationIcon ifTrue:[ |
|
8040 |
"/ parentItem icon:applicationIcon. |
|
8041 |
"/ ]. |
|
8042 |
]. |
|
8043 |
] |
|
8044 |
]. |
|
16330 | 8045 |
]. |
16076 | 8046 |
]. |
8047 |
]. |
|
8048 |
]. |
|
8049 |
! |
|
8050 |
||
8051 |
selectionChangeAction:selectionIndices |
|
8052 |
|selectedItem p itemType info| |
|
8053 |
||
8054 |
loadButton enabled:(selectionIndices notEmpty). |
|
8055 |
loadAndBrowseButton enabled:(selectionIndices notEmpty). |
|
8056 |
||
8057 |
selectionIndices size == 1 ifTrue:[ |
|
8058 |
selectedItem := hierarchicalListView selectionValue first. |
|
8059 |
itemType := selectedItem type. |
|
8060 |
||
8061 |
itemType == #monticelloRepository ifTrue:[ |
|
8062 |
info := 'Monticello repository. Double click to browse its contents.'. |
|
8063 |
] ifFalse:[ |
|
8064 |
itemType == #monticelloPackage ifTrue:[ |
|
8065 |
info := 'Monticello package. Double click to browse its contents.'. |
|
8066 |
] ifFalse:[ |
|
8067 |
p := packageIdByItem at:selectedItem ifAbsent:nil. |
|
8068 |
p notNil ifTrue:[ |
|
8069 |
selectedPackageHolder value:(resources string:'Selected Package: "%1"' with:p allBold). |
|
8070 |
self showPackageInfoAction:p. |
|
8071 |
] ifFalse:[ |
|
8072 |
selectedItem == masterRoot ifTrue:[ |
|
8073 |
info := 'Packages found on the local machine.' |
|
8074 |
] ifFalse:[ |
|
8075 |
selectedItem == monticelloRoot ifTrue:[ |
|
16379 | 8076 |
info := 'Monticello packages\found on the local machine.' |
16076 | 8077 |
] ifFalse:[ |
8078 |
selectedItem == root ifTrue:[ |
|
16379 | 8079 |
info := 'Class library packages\found in the "packages" folder.' |
8080 |
] ifFalse:[ |
|
8081 |
info := 'Other packages\found along the package-path.' |
|
16076 | 8082 |
]. |
8083 |
]. |
|
8084 |
]. |
|
8085 |
]. |
|
8086 |
]. |
|
16379 | 8087 |
info notNil ifTrue:[ infoTextHolder value:(resources stringWithCRs:info)]. |
16076 | 8088 |
]. |
8089 |
] ifFalse:[ |
|
8090 |
selectedPackageHolder value:(resources string:'Selected %1 packages.' with:selectionIndices size). |
|
8091 |
]. |
|
8092 |
! |
|
8093 |
||
8094 |
showPackageInfoAction:package |
|
17154 | 8095 |
|projectDef comment info projectDir className projectDefinitionFile readMeFile| |
16076 | 8096 |
|
8097 |
info := resources string:'Sorry, could not find any package documentation'. |
|
8098 |
projectDef := package asPackageId projectDefinitionClass. |
|
8099 |
projectDef notNil ifTrue:[ |
|
8100 |
comment := projectDef commentOrDocumentationString. |
|
8101 |
comment isNil ifTrue:[ |
|
8102 |
info := info, |
|
8103 |
(resources stringWithCRs:'\\The project''s definition class (%1)\has no documentation method.' with:projectDef class name). |
|
8104 |
]. |
|
8105 |
] ifFalse:[ |
|
8106 |
"/ try to find the package's source |
|
17163 | 8107 |
projectDir := Smalltalk getPackageDirectoryForPackage:package. |
17154 | 8108 |
projectDir notNil ifTrue:[ |
8109 |
|docChange| |
|
8110 |
||
16076 | 8111 |
"/ is there a project definition class's source? |
8112 |
className := ProjectDefinition projectDefinitionClassNameForDefinitionOf:package. |
|
17154 | 8113 |
projectDefinitionFile := projectDir / ((Smalltalk fileNameForClass:className),'.st'). |
8114 |
projectDefinitionFile exists ifTrue:[ |
|
8115 |
projectDefinitionFile readingFileDo:[:s | |
|
16076 | 8116 |
ChangeSet |
8117 |
fromStream:s |
|
8118 |
while:[:change | |
|
8119 |
(change isMethodCodeChange |
|
8120 |
and:[ change selector == #documentation |
|
8121 |
and:[ change isForMeta ]]) ifTrue:[ |
|
8122 |
docChange := change. |
|
8123 |
false "/ stop reading |
|
8124 |
] ifFalse:[ |
|
8125 |
true |
|
8126 |
]. |
|
8127 |
]. |
|
8128 |
]. |
|
8129 |
docChange notNil ifTrue:[ |
|
8130 |
comment := Parser methodCommentFromSource:docChange source. |
|
8131 |
] ifFalse:[ |
|
8132 |
info := info , |
|
8133 |
(resources stringWithCRs:'\\The project''s definition class (%1) is present,\but has no documentation method.\\In file: %2' |
|
8134 |
with:className |
|
17154 | 8135 |
with:projectDefinitionFile pathName). |
16076 | 8136 |
]. |
8137 |
] ifFalse:[ |
|
8138 |
info := info , |
|
8139 |
(resources stringWithCRs:'\\No definition class was found in the project.\In folder: %1' |
|
17154 | 8140 |
with:projectDir pathName). |
16076 | 8141 |
]. |
8142 |
]. |
|
8143 |
]. |
|
8144 |
comment notEmptyOrNil ifTrue:[ |
|
8145 |
comment := comment asStringCollection. |
|
8146 |
[ comment size > 0 and:[comment first isEmpty]] whileTrue:[ comment removeFirst ]. |
|
8147 |
(comment conform:[:line | line isEmpty or:[line startsWith:' ']]) ifTrue:[ |
|
8148 |
comment := comment collect:[:line | |
|
8149 |
(line startsWith:' ') ifTrue:[ |
|
8150 |
line copyFrom:5 |
|
8151 |
] ifFalse:[ |
|
8152 |
line |
|
8153 |
]]. |
|
8154 |
]. |
|
8155 |
info := comment asString. |
|
8156 |
] ifFalse:[ |
|
16410 | 8157 |
info := info withColor:Color red. |
17154 | 8158 |
(projectDir notNil and:[ (readMeFile := projectDir / 'README') exists]) ifTrue:[ |
8159 |
info := info , '\\The README file there says:\\' withCRs , (readMeFile contents asString). |
|
8160 |
]. |
|
16076 | 8161 |
]. |
8162 |
infoTextHolder value:info. |
|
16717
814e3fa20205
Issue 98: Use #getPackageDirectoryForPackage: instead of #packageDirectoryForPackageId:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
16689
diff
changeset
|
8163 |
|
814e3fa20205
Issue 98: Use #getPackageDirectoryForPackage: instead of #packageDirectoryForPackageId:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
16689
diff
changeset
|
8164 |
"Modified: / 28-06-2016 / 07:55:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
16076 | 8165 |
! |
8166 |
||
8167 |
updateAction:whatChanged parameter:parameter |
|
8168 |
|item isLoaded packageID| |
|
8169 |
||
8170 |
"/ update the corresponding tree item |
|
8171 |
(whatChanged == #postPackageLoad or:[whatChanged == #postLoad]) ifTrue:[ |
|
8172 |
parameter notNil ifTrue:[ |
|
8173 |
packageID := parameter asSymbol. |
|
16330 | 8174 |
item := self getItemByPath:(packageID splitByAny:':/') packageID:packageID under:root. |
16076 | 8175 |
item notNil ifTrue:[ |
8176 |
isLoaded := (ProjectDefinition definitionClassForPackage:packageID) notNil. |
|
8177 |
isLoaded ifTrue:[ |
|
8178 |
(item icon == applicationIcon or:[item icon == packageIcon]) ifTrue:[ |
|
8179 |
item icon:((item icon == applicationIcon) ifTrue:[greyApplicationIcon] ifFalse:[greyPackageIcon]). |
|
8180 |
item label:(item label , alreadyLoadedString) |
|
8181 |
]. |
|
8182 |
]. |
|
8183 |
]. |
|
8184 |
]. |
|
8185 |
]. |
|
8186 |
! ! |
|
8187 |
||
16969 | 8188 |
!AbstractLauncherApplication::PackageLoadDialog::MyHierarchicalItem methodsFor:'accessing'! |
8189 |
||
8190 |
info |
|
8191 |
^ info |
|
8192 |
! |
|
8193 |
||
8194 |
info:something |
|
8195 |
info := something. |
|
8196 |
! |
|
8197 |
||
8198 |
type |
|
8199 |
^ type |
|
8200 |
! |
|
8201 |
||
8202 |
type:something |
|
8203 |
type := something. |
|
8204 |
! ! |
|
8205 |
||
2001 | 8206 |
!AbstractLauncherApplication class methodsFor:'documentation'! |
8207 |
||
8208 |
version |
|
15699
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
8209 |
^ '$Header$' |
10907 | 8210 |
! |
8211 |
||
8212 |
version_CVS |
|
15699
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
8213 |
^ '$Header$' |
9961 | 8214 |
! |
8215 |
||
17274
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
8216 |
version_HG |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
8217 |
|
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
8218 |
^ '$Changeset: <not expanded> $' |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
8219 |
! |
23697d56407f
Fixed PackageLoadDialog>>readOtherPackageTrees
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
17163
diff
changeset
|
8220 |
|
9961 | 8221 |
version_SVN |
15699
292b370e5431
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
15506
diff
changeset
|
8222 |
^ '$Id$' |
2001 | 8223 |
! ! |
12499
3f6769e6733c
class: AbstractLauncherApplication
Claus Gittinger <cg@exept.de>
parents:
12067
diff
changeset
|
8224 |