|
1 " |
|
2 COPYRIGHT (c) 2000 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 |
|
13 "{ Package: 'stx:__NoProject__' }" |
|
14 |
|
15 "{ NameSpace: Tools }" |
|
16 |
|
17 BrowserList subclass:#VariableList |
|
18 instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName' |
|
19 classVariableNames:'' |
|
20 poolDictionaries:'' |
|
21 category:'Interface-Browsers-New' |
|
22 ! |
|
23 |
|
24 !VariableList class methodsFor:'documentation'! |
|
25 |
|
26 copyright |
|
27 " |
|
28 COPYRIGHT (c) 2000 by eXept Software AG |
|
29 All Rights Reserved |
|
30 |
|
31 This software is furnished under a license and may be used |
|
32 only in accordance with the terms of that license and with the |
|
33 inclusion of the above copyright notice. This software may not |
|
34 be provided or otherwise made available to, or used by, any |
|
35 other person. No title to or ownership of the software is |
|
36 hereby transferred. |
|
37 " |
|
38 ! ! |
|
39 |
|
40 !VariableList class methodsFor:'interface specs'! |
|
41 |
|
42 windowSpec |
|
43 "This resource specification was automatically generated |
|
44 by the UIPainter of ST/X." |
|
45 |
|
46 "Do not manually edit this!! If it is corrupted, |
|
47 the UIPainter may not be able to read the specification." |
|
48 |
|
49 " |
|
50 UIPainter new openOnClass:VariableList andSelector:#windowSpec |
|
51 VariableList new openInterface:#windowSpec |
|
52 VariableList open |
|
53 " |
|
54 |
|
55 <resource: #canvas> |
|
56 |
|
57 ^ |
|
58 #(#FullSpec |
|
59 #name: #windowSpec |
|
60 #window: |
|
61 #(#WindowSpec |
|
62 #label: 'VariableList' |
|
63 #name: 'VariableList' |
|
64 #min: #(#Point 0 0) |
|
65 #max: #(#Point 1024 721) |
|
66 #bounds: #(#Rectangle 16 46 316 346) |
|
67 ) |
|
68 #component: |
|
69 #(#SpecCollection |
|
70 #collection: #( |
|
71 #(#SequenceViewSpec |
|
72 #name: 'List' |
|
73 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) |
|
74 #tabable: true |
|
75 #model: #selectedVariables |
|
76 #menu: #menuHolder |
|
77 #hasHorizontalScrollBar: true |
|
78 #hasVerticalScrollBar: true |
|
79 #miniScrollerHorizontal: true |
|
80 #isMultiSelect: true |
|
81 #valueChangeSelector: #selectionChangedByClick |
|
82 #useIndex: false |
|
83 #sequenceList: #variableList |
|
84 #doubleClickChannel: #doubleClickChannel |
|
85 ) |
|
86 ) |
|
87 |
|
88 ) |
|
89 ) |
|
90 ! ! |
|
91 |
|
92 !VariableList class methodsFor:'plugIn spec'! |
|
93 |
|
94 aspectSelectors |
|
95 "This resource specification was automatically generated |
|
96 by the UIPainter of ST/X." |
|
97 |
|
98 "Do not manually edit this. If it is corrupted, |
|
99 the UIPainter may not be able to read the specification." |
|
100 |
|
101 "Return a description of exported aspects; |
|
102 these can be connected to aspects of an embedding application |
|
103 (if this app is embedded in a subCanvas)." |
|
104 |
|
105 ^ #( |
|
106 #(#doubleClickChannel #action ) |
|
107 #classHolder |
|
108 #forceGeneratorTrigger |
|
109 #immediateUpdate |
|
110 #inGeneratorHolder |
|
111 #menuHolder |
|
112 #outGeneratorHolder |
|
113 #packageFilter |
|
114 #selectedVariables |
|
115 #selectionChangeCondition |
|
116 #updateTrigger |
|
117 #showClassVarsInVariableList |
|
118 #slaveMode |
|
119 #sortVariablesBy |
|
120 ). |
|
121 ! ! |
|
122 |
|
123 !VariableList methodsFor:'aspects'! |
|
124 |
|
125 classHolder |
|
126 classHolder isNil ifTrue:[ |
|
127 classHolder := #() asValue. |
|
128 classHolder addDependent:self |
|
129 ]. |
|
130 ^ classHolder |
|
131 ! |
|
132 |
|
133 classHolder:aValueHolder |
|
134 classHolder notNil ifTrue:[ |
|
135 classHolder removeDependent:self |
|
136 ]. |
|
137 classHolder := aValueHolder. |
|
138 classHolder notNil ifTrue:[ |
|
139 classHolder isBehavior ifTrue:[self halt:'should not happen']. |
|
140 classHolder addDependent:self |
|
141 ]. |
|
142 ! |
|
143 |
|
144 defaultSlaveModeValue |
|
145 ^ false. |
|
146 ! |
|
147 |
|
148 selectedVariables |
|
149 ^ self selectionHolder |
|
150 |
|
151 ! |
|
152 |
|
153 selectedVariables:aValueHolder |
|
154 ^ self selectionHolder:aValueHolder |
|
155 |
|
156 ! |
|
157 |
|
158 showClassVarsInVariableList |
|
159 showClassVars isNil ifTrue:[ |
|
160 showClassVars := false asValue. |
|
161 showClassVars addDependent:self |
|
162 ]. |
|
163 ^ showClassVars |
|
164 ! |
|
165 |
|
166 showClassVarsInVariableList:aValueHolder |
|
167 showClassVars notNil ifTrue:[ |
|
168 showClassVars removeDependent:self |
|
169 ]. |
|
170 showClassVars := aValueHolder. |
|
171 showClassVars notNil ifTrue:[ |
|
172 showClassVars addDependent:self |
|
173 ]. |
|
174 ! |
|
175 |
|
176 showingInheritedClassVars |
|
177 ^ false |
|
178 "/ ^ true |
|
179 ! |
|
180 |
|
181 sortVariablesByName |
|
182 sortVariablesByName isNil ifTrue:[ |
|
183 sortVariablesByName := false asValue. |
|
184 sortVariablesByName addDependent:self |
|
185 ]. |
|
186 ^ sortVariablesByName |
|
187 ! |
|
188 |
|
189 sortVariablesByName:aValueHolder |
|
190 sortVariablesByName notNil ifTrue:[ |
|
191 sortVariablesByName removeDependent:self |
|
192 ]. |
|
193 sortVariablesByName := aValueHolder. |
|
194 sortVariablesByName notNil ifTrue:[ |
|
195 sortVariablesByName addDependent:self |
|
196 ]. |
|
197 ! |
|
198 |
|
199 variableList |
|
200 variableList isNil ifTrue:[ |
|
201 variableList := ValueHolder new |
|
202 ]. |
|
203 ^ variableList |
|
204 |
|
205 |
|
206 ! ! |
|
207 |
|
208 !VariableList methodsFor:'change & update'! |
|
209 |
|
210 delayedUpdate:something with:aParameter from:changedObject |
|
211 |selectedClasses changedClass anyChange| |
|
212 |
|
213 self inSlaveModeOrInvisible ifTrue:[self invalidateList. ^ self]. |
|
214 "/ slaveMode value == true ifTrue:[^ self]. |
|
215 |
|
216 changedObject == slaveMode ifTrue:[ |
|
217 listValid ~~ true ifTrue:[ |
|
218 self enqueueDelayedUpdateList |
|
219 ]. |
|
220 "/ self invalidateList. |
|
221 ^ self |
|
222 ]. |
|
223 |
|
224 changedObject == classHolder ifTrue:[ |
|
225 self invalidateList. |
|
226 ^ self |
|
227 ]. |
|
228 changedObject == showClassVars ifTrue:[ |
|
229 self invalidateList. |
|
230 ^ self. |
|
231 ]. |
|
232 changedObject == sortVariablesByName ifTrue:[ |
|
233 self invalidateList. |
|
234 ^ self. |
|
235 ]. |
|
236 changedObject == Smalltalk ifTrue:[ |
|
237 (something == #classDefinition |
|
238 or:[something == #classVariables and:[showClassVars value == true]]) |
|
239 ifTrue:[ |
|
240 changedClass := aParameter. |
|
241 selectedClasses := classHolder value. |
|
242 selectedClasses notNil ifTrue:[ |
|
243 selectedClasses isSequenceable ifFalse:[ |
|
244 selectedClasses := selectedClasses asOrderedCollection |
|
245 ]. |
|
246 selectedClasses keysAndValuesDo:[:idx :cls | |nm| |
|
247 cls notNil ifTrue:[ |
|
248 cls isObsolete ifTrue:[ |
|
249 cls isMeta ifTrue:[ |
|
250 nm := cls theNonMetaclass name. |
|
251 selectedClasses at:idx put:(Smalltalk at:nm) class. |
|
252 ] ifFalse:[ |
|
253 nm := cls name. |
|
254 selectedClasses at:idx put:(Smalltalk at:nm). |
|
255 ]. |
|
256 anyChange := true. |
|
257 ] ifFalse:[ |
|
258 (cls == aParameter |
|
259 or:[something == #classVariables |
|
260 and:[showClassVars value == true |
|
261 and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[ |
|
262 anyChange := true. |
|
263 ] |
|
264 ] |
|
265 ] |
|
266 ]. |
|
267 (selectedClasses includes:nil) ifTrue:[ |
|
268 "/ can happen, if a selected class is removed... |
|
269 "/ self halt:'should this happen ?'. |
|
270 "/ fix it ... |
|
271 selectedClasses := selectedClasses select:[:each | each notNil]. |
|
272 classHolder value:selectedClasses. |
|
273 anyChange := true. |
|
274 ]. |
|
275 anyChange == true ifTrue:[ |
|
276 self invalidateList. |
|
277 ^ self |
|
278 ]. |
|
279 ]. |
|
280 ^ self |
|
281 ]. |
|
282 ] ifFalse:[ |
|
283 changedObject isBehavior ifTrue:[ |
|
284 anyChange := false. |
|
285 selectedClasses := classHolder value. |
|
286 selectedClasses notNil ifTrue:[ |
|
287 selectedClasses keysAndValuesDo:[:idx :cls | |nm| |
|
288 cls isObsolete ifTrue:[ |
|
289 nm := cls name. |
|
290 selectedClasses at:idx put:(Smalltalk at:nm). |
|
291 anyChange := true. |
|
292 ] |
|
293 ]. |
|
294 anyChange == true ifTrue:[ |
|
295 self invalidateList. |
|
296 ^ self |
|
297 ]. |
|
298 |
|
299 (selectedClasses includesIdentical:something) ifTrue:[ |
|
300 self invalidateList. |
|
301 ^ self |
|
302 ]. |
|
303 ]. |
|
304 ^ self |
|
305 ]. |
|
306 ]. |
|
307 super delayedUpdate:something with:aParameter from:changedObject |
|
308 ! |
|
309 |
|
310 makeDependent |
|
311 Smalltalk addDependent:self |
|
312 |
|
313 ! |
|
314 |
|
315 makeIndependent |
|
316 Smalltalk removeDependent:self |
|
317 |
|
318 ! |
|
319 |
|
320 selectionChangedByClick |
|
321 "we are not interested in that - get another notification |
|
322 via the changed valueHolder" |
|
323 |
|
324 |
|
325 ! |
|
326 |
|
327 update:something with:aParameter from:changedObject |
|
328 "/ ^ self delayedUpdate:something with:aParameter from:changedObject. |
|
329 |
|
330 changedObject == Smalltalk ifTrue:[ |
|
331 something == #methodDictionary ifTrue:[ |
|
332 ^ self |
|
333 ]. |
|
334 something == #methodTrap ifTrue:[ |
|
335 ^ self |
|
336 ]. |
|
337 something == #methodInClass ifTrue:[ |
|
338 ^ self |
|
339 ]. |
|
340 something == #methodInClassRemoved ifTrue:[ |
|
341 ^ self |
|
342 ]. |
|
343 something == #classComment ifTrue:[ |
|
344 ^ self. |
|
345 ]. |
|
346 ]. |
|
347 "/ self window sensor isNil ifTrue:[ |
|
348 "/ "/ I am not visible ... |
|
349 "/ self invalidateList. |
|
350 "/ ^ self |
|
351 "/ ]. |
|
352 super update:something with:aParameter from:changedObject |
|
353 |
|
354 "Modified: / 20.11.2001 / 21:55:22 / cg" |
|
355 ! ! |
|
356 |
|
357 !VariableList methodsFor:'generators'! |
|
358 |
|
359 makeGenerator |
|
360 |
|
361 |
|
362 |
|
363 ! ! |
|
364 |
|
365 !VariableList methodsFor:'private'! |
|
366 |
|
367 commonPostBuildWith:aBuilder |
|
368 |list| |
|
369 |
|
370 super commonPostBuildWith:aBuilder. |
|
371 |
|
372 list := aBuilder componentAt:#List. |
|
373 list notNil ifTrue:[ |
|
374 list selectConditionBlock:[:item | self selectionChangeAllowed:item]. |
|
375 list ignoreReselect:false. |
|
376 ]. |
|
377 ! |
|
378 |
|
379 commonSubClassIn:classes |
|
380 "return true if there is a common subclass" |
|
381 |
|
382 |theCommonSubClass "classesByInheritance"| |
|
383 |
|
384 theCommonSubClass := nil. |
|
385 classes do:[:eachClass | |
|
386 theCommonSubClass isNil ifTrue:[ |
|
387 theCommonSubClass := eachClass |
|
388 ] ifFalse:[ |
|
389 (eachClass isSubclassOf:theCommonSubClass) ifTrue:[ |
|
390 theCommonSubClass := eachClass |
|
391 ] ifFalse:[ |
|
392 (theCommonSubClass isSubclassOf:eachClass) ifFalse:[ |
|
393 ^ nil |
|
394 ] |
|
395 ] |
|
396 ] |
|
397 ]. |
|
398 ^ theCommonSubClass. |
|
399 |
|
400 "/ classesByInheritance := classes topologicalSort:[:a :b | a isSubclassOf:b]. |
|
401 "/ classesByInheritance keysAndValuesDo:[:index :eachClass | |
|
402 "/ "/ all classes after that one must be superclasses ... |
|
403 "/ classesByInheritance from:index+1 to:classesByInheritance size do:[:otherClass | |
|
404 "/ (eachClass isSubclassOf:otherClass) ifFalse:[ |
|
405 "/ ^ nil. |
|
406 "/ ] |
|
407 "/ ]. |
|
408 "/ ]. |
|
409 "/ ^ classesByInheritance first |
|
410 ! |
|
411 |
|
412 listOfVariables |
|
413 |nameList numClasses classes class commonSubclass showingClassVars |
|
414 sortByName| |
|
415 |
|
416 classHolder isNil ifTrue:[ |
|
417 "/ testing |
|
418 ^ #() |
|
419 ]. |
|
420 |
|
421 showingClassVars := showClassVars value == true. |
|
422 sortByName := sortVariablesByName value. |
|
423 |
|
424 classes := classHolder value. |
|
425 (numClasses := classes size) == 0 ifTrue:[^ #() ]. |
|
426 numClasses > 1 ifTrue:[ |
|
427 "/ multiple classes - see if there is a common subclass ... |
|
428 commonSubclass := self commonSubClassIn:classes. |
|
429 commonSubclass notNil ifTrue:[ |
|
430 "/ yes - treat like a single class |
|
431 classes := Array with:(commonSubclass). |
|
432 numClasses := 1. |
|
433 ]. |
|
434 ]. |
|
435 |
|
436 numClasses > 1 ifTrue:[ |
|
437 "/ multiple classes - sort alphabetically ... |
|
438 "/ unless there is a common subclass ... |
|
439 nameList := Set new. |
|
440 classes do:[:class | |
|
441 showingClassVars ifTrue:[ |
|
442 self showingInheritedClassVars ifTrue:[ |
|
443 class theNonMetaclass withAllSuperclassesDo:[:cls| |
|
444 nameList addAll:(cls classVarNames) |
|
445 ] |
|
446 ] ifFalse:[ |
|
447 nameList addAll:(class classVarNames) |
|
448 ] |
|
449 ] ifFalse:[ |
|
450 class withAllSuperclassesDo:[:cls| |
|
451 nameList addAll:(cls instVarNames) |
|
452 ] |
|
453 ] |
|
454 ]. |
|
455 nameList := nameList asOrderedCollection. |
|
456 ] ifFalse:[ |
|
457 "/ only a single class - sort by inheritance |
|
458 class := classes first. |
|
459 |
|
460 nameList := OrderedCollection new. |
|
461 class notNil ifTrue:[ |
|
462 showingClassVars ifTrue:[ |
|
463 class := class theNonMetaclass |
|
464 ]. |
|
465 class withAllSuperclassesDo:[:cls| |
|
466 |varNames| |
|
467 |
|
468 varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ]. |
|
469 varNames copy reverse do:[:varName| |
|
470 nameList addFirst:varName. |
|
471 ]. |
|
472 sortByName ifFalse:[ |
|
473 nameList addFirst:'----- ' , cls nameInBrowser , ' -----'. |
|
474 ] |
|
475 ]. |
|
476 ]. |
|
477 ]. |
|
478 |
|
479 (numClasses > 1 or:[sortByName]) ifTrue:[ |
|
480 nameList sort. |
|
481 ]. |
|
482 ^ nameList |
|
483 |
|
484 "Created: / 5.2.2000 / 13:42:11 / cg" |
|
485 "Modified: / 26.2.2000 / 01:05:36 / cg" |
|
486 ! |
|
487 |
|
488 postBuildWith:aBuilder |
|
489 |listView| |
|
490 |
|
491 (listView := aBuilder componentAt:#List) notNil ifTrue:[ |
|
492 listView scrollWhenUpdating:#end |
|
493 ]. |
|
494 super postBuildWith:aBuilder |
|
495 |
|
496 ! |
|
497 |
|
498 release |
|
499 super release. |
|
500 |
|
501 classHolder removeDependent:self. |
|
502 showClassVars removeDependent:self. |
|
503 ! |
|
504 |
|
505 selectionChangeAllowed:index |
|
506 ^ ((variableList value at:index) startsWith:'---') not. |
|
507 ! |
|
508 |
|
509 updateList |
|
510 | prevSelection newSelection newList oldList selectedVariablesHolder| |
|
511 |
|
512 oldList := self variableList value copy. |
|
513 newList := self listOfVariables. |
|
514 |
|
515 newList ~= variableList value ifTrue:[ |
|
516 selectedVariablesHolder := self selectedVariables. |
|
517 prevSelection := (selectedVariablesHolder value copy) ? #(). |
|
518 variableList value:newList. |
|
519 |
|
520 newSelection := prevSelection select:[:item | newList includes:item]. |
|
521 |
|
522 newSelection size > 0 ifTrue:[ |
|
523 "/ force change (for dependents) |
|
524 selectedVariablesHolder value:nil. |
|
525 selectedVariablesHolder value:newSelection. |
|
526 ] ifFalse:[ |
|
527 prevSelection := selectedVariablesHolder value. |
|
528 selectedVariablesHolder value:nil. |
|
529 ]. |
|
530 (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[ |
|
531 self updateOutputGenerator. |
|
532 ]. |
|
533 ]. |
|
534 listValid := true. |
|
535 ! ! |
|
536 |
|
537 !VariableList class methodsFor:'documentation'! |
|
538 |
|
539 version |
|
540 ^ '$Header: /cvs/stx/stx/libtool/Attic/Tools_VariableList.st,v 1.1 2004-02-26 18:56:20 cg Exp $' |
|
541 ! ! |