|
1 " |
|
2 COPYRIGHT (c) 2004 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 BrowserList subclass:#ClassGeneratorList |
|
17 instanceVariableNames:'organizerList categoryList namespaceList namespaceNameList |
|
18 projectList selectedCategories selectedNamespaces |
|
19 selectedProjects selectedClasses' |
|
20 classVariableNames:'AdditionalEmptyCategories AdditionalEmptyProjects' |
|
21 poolDictionaries:'' |
|
22 category:'Interface-Browsers-New' |
|
23 ! |
|
24 |
|
25 !ClassGeneratorList class methodsFor:'documentation'! |
|
26 |
|
27 copyright |
|
28 " |
|
29 COPYRIGHT (c) 2004 by eXept Software AG |
|
30 All Rights Reserved |
|
31 |
|
32 This software is furnished under a license and may be used |
|
33 only in accordance with the terms of that license and with the |
|
34 inclusion of the above copyright notice. This software may not |
|
35 be provided or otherwise made available to, or used by, any |
|
36 other person. No title to or ownership of the software is |
|
37 hereby transferred. |
|
38 " |
|
39 ! |
|
40 |
|
41 documentation |
|
42 " |
|
43 embeddable application displaying the class-categories. |
|
44 Provides an outputGenerator, which enumerates the classes in |
|
45 the selected categories. |
|
46 |
|
47 [author:] |
|
48 Claus Gittinger (cg@exept.de) |
|
49 " |
|
50 ! ! |
|
51 |
|
52 !ClassGeneratorList class methodsFor:'interface specs'! |
|
53 |
|
54 windowSpec |
|
55 "This resource specification was automatically generated |
|
56 by the UIPainter of ST/X." |
|
57 |
|
58 "Do not manually edit this!! If it is corrupted, |
|
59 the UIPainter may not be able to read the specification." |
|
60 |
|
61 " |
|
62 UIPainter new openOnClass:ClassGeneratorList andSelector:#windowSpec |
|
63 ClassGeneratorList new openInterface:#windowSpec |
|
64 ClassGeneratorList open |
|
65 " |
|
66 |
|
67 <resource: #canvas> |
|
68 |
|
69 ^ |
|
70 #(#FullSpec |
|
71 #name: #windowSpec |
|
72 #window: |
|
73 #(#WindowSpec |
|
74 #label: 'OrganizerList' |
|
75 #name: 'OrganizerList' |
|
76 #min: #(#Point 0 0) |
|
77 #bounds: #(#Rectangle 12 22 312 322) |
|
78 ) |
|
79 #component: |
|
80 #(#SpecCollection |
|
81 #collection: #( |
|
82 #(#SequenceViewSpec |
|
83 #name: 'List' |
|
84 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) |
|
85 #tabable: true |
|
86 #model: #organizerSelection |
|
87 #menu: #menuHolder |
|
88 #hasHorizontalScrollBar: true |
|
89 #hasVerticalScrollBar: true |
|
90 #miniScrollerHorizontal: true |
|
91 #isMultiSelect: true |
|
92 #valueChangeSelector: #selectionChangedByClick |
|
93 #useIndex: true |
|
94 #sequenceList: #organizerList |
|
95 #doubleClickChannel: #doubleClickChannel |
|
96 ) |
|
97 ) |
|
98 |
|
99 ) |
|
100 ) |
|
101 |
|
102 "Modified: / 18.8.2000 / 20:12:20 / cg" |
|
103 ! ! |
|
104 |
|
105 !ClassGeneratorList methodsFor:'aspects'! |
|
106 |
|
107 categoryList |
|
108 categoryList isNil ifTrue:[ |
|
109 categoryList := ValueHolder new. |
|
110 ]. |
|
111 ^ categoryList |
|
112 |
|
113 |
|
114 ! |
|
115 |
|
116 nameSpaceList |
|
117 namespaceList isNil ifTrue:[ |
|
118 namespaceList := ValueHolder new |
|
119 ]. |
|
120 ^ namespaceList |
|
121 |
|
122 "Created: / 18.2.2000 / 00:59:01 / cg" |
|
123 ! |
|
124 |
|
125 projectList |
|
126 projectList isNil ifTrue:[ |
|
127 projectList := ValueHolder new |
|
128 ]. |
|
129 ^ projectList |
|
130 |
|
131 "Created: / 17.2.2000 / 23:39:32 / cg" |
|
132 |
|
133 ! |
|
134 |
|
135 selectedCategories |
|
136 selectedCategories isNil ifTrue:[ |
|
137 selectedCategories := ValueHolder new. |
|
138 selectedCategories addDependent:self |
|
139 ]. |
|
140 ^ selectedCategories. |
|
141 |
|
142 ! |
|
143 |
|
144 selectedCategories:aValueHolder |
|
145 |prevSelection| |
|
146 |
|
147 prevSelection := selectedCategories value ? #(). |
|
148 |
|
149 selectedCategories notNil ifTrue:[ |
|
150 selectedCategories removeDependent:self |
|
151 ]. |
|
152 selectedCategories := aValueHolder. |
|
153 selectedCategories notNil ifTrue:[ |
|
154 selectedCategories addDependent:self |
|
155 ]. |
|
156 (selectedCategories value ? #()) ~= prevSelection ifTrue:[ |
|
157 "/ update |
|
158 self update:#value with:nil from:selectedCategories |
|
159 ]. |
|
160 |
|
161 |
|
162 |
|
163 ! |
|
164 |
|
165 selectedClasses |
|
166 "bad name- it's a holder, baby" |
|
167 |
|
168 selectedClasses isNil ifTrue:[ |
|
169 selectedClasses := ValueHolder new. |
|
170 ]. |
|
171 ^ selectedClasses. |
|
172 ! |
|
173 |
|
174 selectedClasses:aValueHolder |
|
175 "/ selectedClasses notNil ifTrue:[ |
|
176 "/ selectedClasses removeDependent:self |
|
177 "/ ]. |
|
178 selectedClasses := aValueHolder. |
|
179 "/ selectedClasses notNil ifTrue:[ |
|
180 "/ selectedClasses addDependent:self |
|
181 "/ ]. |
|
182 ! |
|
183 |
|
184 selectedNamespaces |
|
185 selectedNamespaces isNil ifTrue:[ |
|
186 selectedNamespaces := ValueHolder new. |
|
187 selectedNamespaces addDependent:self |
|
188 ]. |
|
189 ^ selectedNamespaces. |
|
190 |
|
191 ! |
|
192 |
|
193 selectedNamespaces:aValueHolder |
|
194 |prevSelection| |
|
195 |
|
196 prevSelection := selectedNamespaces value ? #(). |
|
197 |
|
198 selectedNamespaces notNil ifTrue:[ |
|
199 selectedNamespaces removeDependent:self |
|
200 ]. |
|
201 selectedNamespaces := aValueHolder. |
|
202 selectedNamespaces notNil ifTrue:[ |
|
203 selectedNamespaces addDependent:self |
|
204 ]. |
|
205 (selectedNamespaces value ? #()) ~= prevSelection ifTrue:[ |
|
206 "/ update |
|
207 self update:#value with:nil from:selectedNamespaces |
|
208 ]. |
|
209 |
|
210 |
|
211 |
|
212 ! |
|
213 |
|
214 selectedProjects |
|
215 selectedProjects isNil ifTrue:[ |
|
216 selectedProjects := ValueHolder new. |
|
217 selectedProjects addDependent:self |
|
218 ]. |
|
219 ^ selectedProjects. |
|
220 |
|
221 ! |
|
222 |
|
223 selectedProjects:aValueHolder |
|
224 |prevSelection| |
|
225 |
|
226 prevSelection := selectedProjects value ? #(). |
|
227 |
|
228 selectedProjects notNil ifTrue:[ |
|
229 selectedProjects removeDependent:self |
|
230 ]. |
|
231 selectedProjects := aValueHolder. |
|
232 selectedProjects notNil ifTrue:[ |
|
233 selectedProjects addDependent:self |
|
234 ]. |
|
235 (selectedProjects value ? #()) ~= prevSelection ifTrue:[ |
|
236 "/ update |
|
237 self update:#value with:nil from:selectedProjects |
|
238 ]. |
|
239 |
|
240 |
|
241 |
|
242 ! ! |
|
243 |
|
244 !ClassGeneratorList methodsFor:'aspects-private'! |
|
245 |
|
246 organizerList |
|
247 organizerList isNil ifTrue:[ |
|
248 organizerList := ValueHolder new. |
|
249 ]. |
|
250 ^ organizerList |
|
251 |
|
252 |
|
253 ! ! |
|
254 |
|
255 !ClassGeneratorList methodsFor:'change & update'! |
|
256 |
|
257 delayedUpdate:something with:aParameter from:changedObject |
|
258 |cls sel pkg mthd orgMode| |
|
259 |
|
260 changedObject == environment ifTrue:[ |
|
261 orgMode := organizerMode value. |
|
262 |
|
263 orgMode == OrganizerCanvas organizerModeCategory ifTrue:[ |
|
264 (something == #organization |
|
265 or:[something == #newClass]) ifTrue:[ |
|
266 self updateList. |
|
267 ^ self |
|
268 ]. |
|
269 something == #methodInClass ifTrue:[ ^ self ]. |
|
270 "/ self halt:'debug halt'. |
|
271 ^ self. |
|
272 ]. |
|
273 orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[ |
|
274 (something == #newClass |
|
275 or:[something == #classRemove]) ifTrue:[ |
|
276 aParameter isNameSpace ifTrue:[ |
|
277 self updateList |
|
278 ]. |
|
279 ^ self |
|
280 ]. |
|
281 "/ self halt:'debug halt'. |
|
282 ^ self |
|
283 ]. |
|
284 orgMode == OrganizerCanvas organizerModeProject ifTrue:[ |
|
285 something == #projectOrganization ifTrue:[ |
|
286 self updateList. |
|
287 ^ self |
|
288 ]. |
|
289 something == #methodInClass ifTrue:[ |
|
290 cls := aParameter at:1. |
|
291 sel := aParameter at:2. |
|
292 mthd := cls compiledMethodAt:sel. |
|
293 pkg := mthd package. |
|
294 (projectList value includes:pkg) ifFalse:[ |
|
295 self halt:'debug-halt. remove when known to work'. |
|
296 self updateList. |
|
297 ^ self |
|
298 ]. |
|
299 ^ self |
|
300 ]. |
|
301 (something == #classDefinition |
|
302 or:[something == #newClass]) ifTrue:[ |
|
303 cls := aParameter. |
|
304 pkg := cls package. |
|
305 (projectList value includes:pkg) ifFalse:[ |
|
306 self halt:'debug-halt. remove when known to work'. |
|
307 self updateList. |
|
308 ^ self |
|
309 ]. |
|
310 ^ self |
|
311 ]. |
|
312 "/ self halt. |
|
313 ^ self |
|
314 ]. |
|
315 ^ self |
|
316 ]. |
|
317 super delayedUpdate:something with:aParameter from:changedObject |
|
318 |
|
319 "Created: / 25.2.2000 / 21:32:03 / cg" |
|
320 "Modified: / 25.2.2000 / 21:35:23 / cg" |
|
321 ! ! |
|
322 |
|
323 !ClassGeneratorList methodsFor:'private'! |
|
324 |
|
325 listFromInGenerator |
|
326 |generator theList| |
|
327 |
|
328 theList := Set new. |
|
329 generator := inGeneratorHolder value. |
|
330 generator isNil ifTrue:[^ #() ]. |
|
331 generator do:[:prj | theList add:prj]. |
|
332 theList := theList asOrderedCollection sort. |
|
333 theList addFirst:(self class nameListEntryForALL allItalic). |
|
334 ^ theList |
|
335 |
|
336 "Created: / 25.2.2000 / 21:24:26 / cg" |
|
337 ! |
|
338 |
|
339 listOfCategories |
|
340 |categories hideUnloadedClasses| |
|
341 |
|
342 inGeneratorHolder notNil ifTrue:[ |
|
343 ^ self listFromInGenerator |
|
344 ]. |
|
345 |
|
346 hideUnloadedClasses := self hideUnloadedClasses value. |
|
347 |
|
348 categories := Set new. |
|
349 environment allClassesDo:[:cls | |
|
350 (hideUnloadedClasses not or:[cls isLoaded]) |
|
351 ifTrue:[ |
|
352 categories add:cls category. |
|
353 ] |
|
354 ]. |
|
355 |
|
356 "/ those are simulated - in ST/X, empty categories do not |
|
357 "/ really exist; however, during browsing, it makes sense. |
|
358 AdditionalEmptyCategories size > 0 ifTrue:[ |
|
359 "/ remove those that are present ... |
|
360 AdditionalEmptyCategories := AdditionalEmptyCategories reject:[:cat | (categories includes:cat)]. |
|
361 categories addAll:AdditionalEmptyCategories. |
|
362 ]. |
|
363 categories := categories asOrderedCollection. |
|
364 categories sort. |
|
365 categories addFirst:(self class nameListEntryForALL allItalic). |
|
366 ^ categories |
|
367 |
|
368 "Created: / 5.2.2000 / 13:42:12 / cg" |
|
369 "Modified: / 25.2.2000 / 21:26:04 / cg" |
|
370 ! |
|
371 |
|
372 listOfNamespaces |
|
373 |allNamespaces showAllNamespaces| |
|
374 |
|
375 inGeneratorHolder notNil ifTrue:[ |
|
376 ^ self listFromInGenerator |
|
377 ]. |
|
378 |
|
379 showAllNamespaces := true. |
|
380 |
|
381 allNamespaces := IdentitySet new. |
|
382 |
|
383 (self hideUnloadedClasses value) ifTrue:[ |
|
384 environment allClassesDo:[:eachClass | |
|
385 eachClass isLoaded ifTrue:[ |
|
386 allNamespaces add:(eachClass theNonMetaclass topNameSpace) |
|
387 ]. |
|
388 ] |
|
389 ] ifFalse:[ |
|
390 allNamespaces := NameSpace allNameSpaces. |
|
391 ]. |
|
392 |
|
393 showAllNamespaces ifFalse:[ |
|
394 "/ only topLevel namespaces are shown |
|
395 "/ i.e. ignore subspaces |
|
396 |
|
397 allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace]. |
|
398 ]. |
|
399 allNamespaces := allNamespaces collect:[:ns | ns name]. |
|
400 allNamespaces := allNamespaces asOrderedCollection. |
|
401 allNamespaces sort. |
|
402 allNamespaces addFirst:(self class nameListEntryForALL allItalic). |
|
403 ^ allNamespaces |
|
404 |
|
405 "Created: / 25.2.2000 / 21:21:14 / cg" |
|
406 "Modified: / 25.2.2000 / 21:26:41 / cg" |
|
407 ! |
|
408 |
|
409 listOfProjects |
|
410 |allProjects| |
|
411 |
|
412 inGeneratorHolder notNil ifTrue:[ |
|
413 ^ self listFromInGenerator |
|
414 ]. |
|
415 |
|
416 allProjects := IdentitySet new. |
|
417 |
|
418 (self hideUnloadedClasses value) ifTrue:[ |
|
419 allProjects := environment allLoadedPackageIDs. |
|
420 ] ifFalse:[ |
|
421 allProjects := environment allPackageIDs. |
|
422 ]. |
|
423 |
|
424 "/ those are simulated - in ST/X, empty projects do not |
|
425 "/ really exist; however, during browsing, it makes sense. |
|
426 AdditionalEmptyProjects size > 0 ifTrue:[ |
|
427 "/ remove those that are present ... |
|
428 AdditionalEmptyProjects := AdditionalEmptyProjects reject:[:pkg | (allProjects includes:pkg)]. |
|
429 allProjects addAll:AdditionalEmptyProjects. |
|
430 ]. |
|
431 allProjects sort. |
|
432 allProjects addFirst:(self class nameListEntryForALL allItalic). |
|
433 ^ allProjects |
|
434 |
|
435 "Created: / 25.2.2000 / 21:22:06 / cg" |
|
436 "Modified: / 25.2.2000 / 21:27:27 / cg" |
|
437 ! |
|
438 |
|
439 makeDependent |
|
440 environment addDependent:self |
|
441 |
|
442 ! |
|
443 |
|
444 makeIndependent |
|
445 environment removeDependent:self. |
|
446 |
|
447 ! |
|
448 |
|
449 release |
|
450 super release. |
|
451 |
|
452 selectedCategories removeDependent:self. |
|
453 selectedNamespaces removeDependent:self. |
|
454 selectedProjects removeDependent:self. |
|
455 ! |
|
456 |
|
457 updateCategoryList |
|
458 |newList| |
|
459 |
|
460 newList := self listOfCategories. |
|
461 newList ~= self categoryList value ifTrue:[ |
|
462 categoryList value:newList. |
|
463 self organizerList value:newList. |
|
464 ]. |
|
465 |
|
466 "Created: / 25.2.2000 / 21:12:32 / cg" |
|
467 ! |
|
468 |
|
469 updateList |
|
470 |orgMode| |
|
471 |
|
472 orgMode := self organizerMode value. |
|
473 orgMode == OrganizerCanvas organizerModeCategory ifTrue:[ |
|
474 self updateCategoryList. |
|
475 ^ self |
|
476 ]. |
|
477 orgMode == OrganizerCanvas organizerModeProject ifTrue:[ |
|
478 self updateProjectList. |
|
479 ^ self |
|
480 ]. |
|
481 orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[ |
|
482 self updateNamespaceList. |
|
483 ^ self |
|
484 ]. |
|
485 self halt:'unexpected value'. |
|
486 |
|
487 "Created: / 5.2.2000 / 13:42:13 / cg" |
|
488 "Modified: / 25.2.2000 / 21:14:19 / cg" |
|
489 ! |
|
490 |
|
491 updateNamespaceList |
|
492 |newList| |
|
493 |
|
494 newList := self listOfNamespaces. |
|
495 newList ~= self nameSpaceList value ifTrue:[ |
|
496 namespaceList value:newList. |
|
497 self organizerList value:newList. |
|
498 ]. |
|
499 |
|
500 "Created: / 25.2.2000 / 21:13:16 / cg" |
|
501 ! |
|
502 |
|
503 updateProjectList |
|
504 |newList| |
|
505 |
|
506 newList := self listOfProjects. |
|
507 newList ~= self projectList value ifTrue:[ |
|
508 projectList value:newList. |
|
509 self organizerList value:newList. |
|
510 ]. |
|
511 |
|
512 "Created: / 25.2.2000 / 21:12:57 / cg" |
|
513 ! ! |
|
514 |
|
515 !ClassGeneratorList class methodsFor:'documentation'! |
|
516 |
|
517 version |
|
518 ^ '$Header$' |
|
519 ! |
|
520 |
|
521 version_CVS |
|
522 ^ '$Header$' |
|
523 ! ! |
|
524 |