|
1 " |
|
2 COPYRIGHT (c) 2006 by eXept Software AG |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 "{ Package: 'stx:libtool' }" |
|
13 |
|
14 "{ NameSpace: Tools }" |
|
15 |
|
16 SimpleDialog subclass:#ProjectLoader |
|
17 instanceVariableNames:'projectList' |
|
18 classVariableNames:'' |
|
19 poolDictionaries:'' |
|
20 category:'Interface-Tools' |
|
21 ! |
|
22 |
|
23 !ProjectLoader class methodsFor:'documentation'! |
|
24 |
|
25 copyright |
|
26 " |
|
27 COPYRIGHT (c) 2006 by eXept Software AG |
|
28 All Rights Reserved |
|
29 |
|
30 This software is furnished under a license and may be used |
|
31 only in accordance with the terms of that license and with the |
|
32 inclusion of the above copyright notice. This software may not |
|
33 be provided or otherwise made available to, or used by, any |
|
34 other person. No title to or ownership of the software is |
|
35 hereby transferred. |
|
36 " |
|
37 ! ! |
|
38 |
|
39 !ProjectLoader class methodsFor:'initialization'! |
|
40 |
|
41 initialize |
|
42 |
|
43 | item | |
|
44 item := (MenuItem label:'Load project') |
|
45 nameKey:'LoadProject'; |
|
46 value:[(Smalltalk at: self fullName asSymbol) open]. |
|
47 |
|
48 NewLauncher |
|
49 addMenuItem: item |
|
50 from: nil |
|
51 in: 'menu' |
|
52 position: #after |
|
53 space: true. |
|
54 |
|
55 " |
|
56 self initialize |
|
57 " |
|
58 |
|
59 "Created: / 22-11-2008 / 09:58:03 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
60 "Modified: / 26-11-2008 / 10:00:39 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
61 ! ! |
|
62 |
|
63 !ProjectLoader class methodsFor:'accessing'! |
|
64 |
|
65 projectSites |
|
66 |
|
67 ^UserPreferences current projectLoaderProjectSites |
|
68 |
|
69 "Created: / 22-11-2008 / 09:13:55 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
70 "Modified: / 26-11-2008 / 10:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
71 ! ! |
|
72 |
|
73 !ProjectLoader class methodsFor:'defaults'! |
|
74 |
|
75 defaultProjectFile |
|
76 ^ (Filename homeDirectory construct:'.smalltalk') construct:'projects.rc' |
|
77 |
|
78 "Created: / 26-11-2008 / 10:15:02 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
79 ! |
|
80 |
|
81 defaultProjects |
|
82 |
|
83 ^#( |
|
84 ( |
|
85 'CellStore' |
|
86 ('cvut:fel/cellstore/core') |
|
87 ) |
|
88 |
|
89 ( |
|
90 'Perseus' |
|
91 ('cvut:fel/perseus/core' |
|
92 'cvut:fel/perseus/core_ui' |
|
93 'cvut:fel/perseus/smallscript' |
|
94 'cvut:fel/perseus/pascal' |
|
95 'stx:goodies/xmlsuite/xquery') |
|
96 ) |
|
97 |
|
98 ( |
|
99 'IZAR' |
|
100 ('cvut:fel/izar') |
|
101 ) |
|
102 ) |
|
103 |
|
104 "Created: / 26-11-2008 / 10:06:14 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
105 ! ! |
|
106 |
|
107 !ProjectLoader class methodsFor:'interface specs'! |
|
108 |
|
109 windowSpec |
|
110 "This resource specification was automatically generated |
|
111 by the UIPainter of ST/X." |
|
112 |
|
113 "Do not manually edit this!! If it is corrupted, |
|
114 the UIPainter may not be able to read the specification." |
|
115 |
|
116 " |
|
117 UIPainter new openOnClass:Tools::ProjectLoadDialog andSelector:#windowSpec |
|
118 Tools::ProjectLoadDialog new openInterface:#windowSpec |
|
119 Tools::ProjectLoadDialog open |
|
120 " |
|
121 |
|
122 <resource: #canvas> |
|
123 |
|
124 ^ |
|
125 #(FullSpec |
|
126 name: windowSpec |
|
127 window: |
|
128 (WindowSpec |
|
129 label: 'Select project' |
|
130 name: 'Select project' |
|
131 min: (Point 10 10) |
|
132 bounds: (Rectangle 0 0 402 301) |
|
133 ) |
|
134 component: |
|
135 (SpecCollection |
|
136 collection: ( |
|
137 (VerticalPanelViewSpec |
|
138 name: 'Main' |
|
139 layout: (LayoutFrame 3 0 3 0 -3 1 -3 1) |
|
140 horizontalLayout: fitSpace |
|
141 verticalLayout: bottomSpaceFit |
|
142 horizontalSpace: 3 |
|
143 verticalSpace: 3 |
|
144 component: |
|
145 (SpecCollection |
|
146 collection: ( |
|
147 (SelectionInListModelViewSpec |
|
148 name: 'ProjectList' |
|
149 model: projectSelectionHolder |
|
150 hasHorizontalScrollBar: true |
|
151 hasVerticalScrollBar: true |
|
152 listModel: projectNamesHolder |
|
153 highlightMode: line |
|
154 doubleClickSelector: doAccept |
|
155 extent: (Point 390 240) |
|
156 ) |
|
157 (ActionButtonSpec |
|
158 label: 'Update list from network' |
|
159 name: 'Update' |
|
160 translateLabel: true |
|
161 model: doUpdateFromNetwork |
|
162 initiallyDisabled: false |
|
163 useDefaultExtent: true |
|
164 ) |
|
165 (HorizontalPanelViewSpec |
|
166 name: 'ButtonPanel' |
|
167 horizontalLayout: fit |
|
168 verticalLayout: fitSpace |
|
169 horizontalSpace: 3 |
|
170 verticalSpace: 3 |
|
171 component: |
|
172 (SpecCollection |
|
173 collection: ( |
|
174 (ActionButtonSpec |
|
175 label: 'Cancel' |
|
176 name: 'CancelButton' |
|
177 translateLabel: true |
|
178 model: doCancel |
|
179 useDefaultExtent: true |
|
180 ) |
|
181 (ActionButtonSpec |
|
182 label: 'Load' |
|
183 name: 'LoadButton' |
|
184 translateLabel: true |
|
185 model: doAccept |
|
186 enableChannel: canDoAcceptHolder |
|
187 useDefaultExtent: true |
|
188 ) |
|
189 ) |
|
190 |
|
191 ) |
|
192 useDefaultExtent: true |
|
193 ) |
|
194 ) |
|
195 |
|
196 ) |
|
197 ) |
|
198 ) |
|
199 |
|
200 ) |
|
201 ) |
|
202 |
|
203 "Modified: / 26-11-2008 / 09:16:59 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
204 ! ! |
|
205 |
|
206 !ProjectLoader class methodsFor:'load & save'! |
|
207 |
|
208 loadProjects |
|
209 |projectFile| |
|
210 |
|
211 projectFile := self defaultProjectFile. |
|
212 projectFile exists ifFalse:[ |
|
213 ^ self defaultProjects |
|
214 ]. |
|
215 ^ Compiler |
|
216 evaluate:projectFile contents asString |
|
217 ifFail:[ self defaultProjects ]. |
|
218 |
|
219 " |
|
220 self projectList" |
|
221 |
|
222 "Created: / 22-11-2008 / 09:41:22 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
223 "Modified: / 26-11-2008 / 10:17:23 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
224 ! |
|
225 |
|
226 saveProjects:projects |
|
227 |projectFile| |
|
228 |
|
229 projectFile := self defaultProjectFile. |
|
230 projectFile writeStream nextPutAll:projects storeString |
|
231 |
|
232 "Created: / 26-11-2008 / 10:07:42 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
233 ! ! |
|
234 |
|
235 !ProjectLoader methodsFor:'actions'! |
|
236 |
|
237 doAccept |
|
238 |
|
239 | packages | |
|
240 self canDoAcceptHolder value ifFalse:[^self]. |
|
241 packages := (projectList at: self projectSelectionHolder value) second. |
|
242 packages do: |
|
243 [:pkg|Smalltalk loadPackage: pkg]. |
|
244 super doAccept. |
|
245 |
|
246 "Created: / 22-11-2008 / 09:55:17 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
247 ! |
|
248 |
|
249 doUpdateFromNetwork |
|
250 <resource: #uiCallback> |
|
251 |
|
252 | projects newProjects | |
|
253 projects := self class loadProjects asOrderedCollection. |
|
254 self class projectSites do: |
|
255 [:site| |
|
256 | siteUrl response | |
|
257 siteUrl := site asURL. |
|
258 response := HTTPInterface get: siteUrl path fromHost: siteUrl host. |
|
259 newProjects := Compiler evaluate: response data ifFail:[#()]. |
|
260 newProjects do: |
|
261 [:newPrj| |
|
262 | oldPrj | |
|
263 oldPrj := projects |
|
264 detect:[:oldPrj|oldPrj first = newPrj first] |
|
265 ifNone:[projects add: newPrj]. |
|
266 oldPrj at:2 put: newPrj second. |
|
267 ] |
|
268 ]. |
|
269 projects := projects asArray. |
|
270 |
|
271 projectList := projects. |
|
272 self class saveProjects: projects. |
|
273 self projectListChanged |
|
274 |
|
275 |
|
276 " |
|
277 Tools::ProjectLoadDialog new doUpdateFromNetwork |
|
278 |
|
279 " |
|
280 |
|
281 "Modified: / 26-11-2008 / 10:28:00 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
282 ! ! |
|
283 |
|
284 !ProjectLoader methodsFor:'aspects'! |
|
285 |
|
286 canDoAcceptHolder |
|
287 <resource: #uiAspect> |
|
288 |
|
289 "automatically generated by UIPainter ..." |
|
290 |
|
291 "*** the code below creates a default model when invoked." |
|
292 "*** (which may not be the one you wanted)" |
|
293 "*** Please change as required and accept it in the browser." |
|
294 "*** (and replace this comment by something more useful ;-)" |
|
295 |
|
296 |holder| |
|
297 |
|
298 (holder := builder bindingAt:#canDoAcceptHolder) isNil ifTrue:[ |
|
299 holder := false asValue. |
|
300 builder aspectAt:#canDoAcceptHolder put:holder. |
|
301 "/ if your app needs to be notified of changes, uncomment one of the lines below: |
|
302 "/ holder addDependent:self. |
|
303 "/ holder onChangeSend:#canDoAcceptHolderChanged to:self. |
|
304 ]. |
|
305 ^ holder. |
|
306 |
|
307 "Created: / 22-11-2008 / 09:51:34 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
308 ! |
|
309 |
|
310 projectNamesHolder |
|
311 <resource: #uiAspect> |
|
312 |
|
313 "automatically generated by UIPainter ..." |
|
314 |
|
315 "*** the code below creates a default model when invoked." |
|
316 "*** (which may not be the one you wanted)" |
|
317 "*** Please change as required and accept it in the browser." |
|
318 "*** (and replace this comment by something more useful ;-)" |
|
319 |
|
320 |holder| |
|
321 |
|
322 (holder := builder bindingAt:#projectNamesHolder) isNil ifTrue:[ |
|
323 holder := #() asValue. |
|
324 builder aspectAt:#projectNamesHolder put:holder. |
|
325 "/ if your app needs to be notified of changes, uncomment one of the lines below: |
|
326 "/ holder addDependent:self. |
|
327 "/ holder onChangeSend:#projectNamesHolderChanged to:self. |
|
328 ]. |
|
329 ^ holder. |
|
330 |
|
331 "Created: / 22-11-2008 / 08:59:43 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
332 ! |
|
333 |
|
334 projectSelectionHolder |
|
335 <resource: #uiAspect> |
|
336 |
|
337 "automatically generated by UIPainter ..." |
|
338 |
|
339 "*** the code below creates a default model when invoked." |
|
340 "*** (which may not be the one you wanted)" |
|
341 "*** Please change as required and accept it in the browser." |
|
342 "*** (and replace this comment by something more useful ;-)" |
|
343 |
|
344 |holder| |
|
345 |
|
346 (holder := builder bindingAt:#projectSelectionHolder) isNil ifTrue:[ |
|
347 holder := ValueHolder new. |
|
348 builder aspectAt:#projectSelectionHolder put:holder. |
|
349 "/ if your app needs to be notified of changes, uncomment one of the lines below: |
|
350 holder addDependent:self. |
|
351 holder onChangeSend:#projectSelectionHolderChanged to:self. |
|
352 ]. |
|
353 ^ holder. |
|
354 |
|
355 "Created: / 22-11-2008 / 08:59:43 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
356 ! ! |
|
357 |
|
358 !ProjectLoader methodsFor:'change & update'! |
|
359 |
|
360 projectListChanged |
|
361 |
|
362 self projectNamesHolder value: |
|
363 (projectList collect:[:prj|prj first]) |
|
364 |
|
365 "Created: / 22-11-2008 / 09:52:47 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
366 ! |
|
367 |
|
368 projectSelectionHolderChanged |
|
369 |
|
370 | selection | |
|
371 selection := self projectSelectionHolder value. |
|
372 |
|
373 self canDoAcceptHolder value: |
|
374 (selection notNil and:[selection ~= 0]) |
|
375 |
|
376 "Created: / 22-11-2008 / 09:52:20 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
377 ! ! |
|
378 |
|
379 !ProjectLoader methodsFor:'hooks'! |
|
380 |
|
381 commonPostOpen |
|
382 |
|
383 projectList := self class loadProjects. |
|
384 self projectListChanged |
|
385 |
|
386 "Created: / 22-11-2008 / 09:43:04 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
387 "Modified: / 26-11-2008 / 10:16:30 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
388 ! ! |
|
389 |
|
390 !ProjectLoader class methodsFor:'documentation'! |
|
391 |
|
392 version_CVS |
|
393 ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectLoader.st,v 1.1 2011-07-01 14:15:32 cg Exp $' |
|
394 ! |
|
395 |
|
396 version_SVN |
|
397 ^ '§Id: Tools__ProjectLoader.st 7486 2009-10-26 22:06:24Z vranyj1 §' |
|
398 ! ! |
|
399 |
|
400 ProjectLoader initialize! |