12 "{ Package: 'stx:libtool' }" |
12 "{ Package: 'stx:libtool' }" |
13 |
13 |
14 "{ NameSpace: Tools }" |
14 "{ NameSpace: Tools }" |
15 |
15 |
16 BrowserList subclass:#VariableList |
16 BrowserList subclass:#VariableList |
17 instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName' |
17 instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName |
|
18 selectedVariableEntries showWarningAboutMissingEntryInXmlSpec' |
18 classVariableNames:'' |
19 classVariableNames:'' |
19 poolDictionaries:'' |
20 poolDictionaries:'' |
20 category:'Interface-Browsers-New' |
21 category:'Interface-Browsers-New' |
|
22 ! |
|
23 |
|
24 Object subclass:#VariableEntry |
|
25 instanceVariableNames:'application class name icon' |
|
26 classVariableNames:'' |
|
27 poolDictionaries:'' |
|
28 privateIn:VariableList |
21 ! |
29 ! |
22 |
30 |
23 !VariableList class methodsFor:'documentation'! |
31 !VariableList class methodsFor:'documentation'! |
24 |
32 |
25 copyright |
33 copyright |
139 ]. |
147 ]. |
140 ! |
148 ! |
141 |
149 |
142 defaultSlaveModeValue |
150 defaultSlaveModeValue |
143 ^ false. |
151 ^ false. |
|
152 ! |
|
153 |
|
154 selectedVariableEntries |
|
155 <resource: #uiAspect> |
|
156 |
|
157 "automatically generated by UIPainter ..." |
|
158 |
|
159 "*** the code below creates a default model when invoked." |
|
160 "*** (which may not be the one you wanted)" |
|
161 "*** Please change as required and accept it in the browser." |
|
162 "*** (and replace this comment by something more useful ;-)" |
|
163 |
|
164 selectedVariableEntries isNil ifTrue:[ |
|
165 selectedVariableEntries := #() asValue. |
|
166 "/ if your app needs to be notified of changes, uncomment one of the lines below: |
|
167 selectedVariableEntries addDependent:self. |
|
168 "/ selectedVariableEntries onChangeSend:#selectedVariableEntriesChanged to:self. |
|
169 ]. |
|
170 ^ selectedVariableEntries. |
|
171 |
|
172 "Modified: / 12-04-2011 / 15:49:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
144 ! |
173 ! |
145 |
174 |
146 selectedVariables |
175 selectedVariables |
147 ^ self selectionHolder |
176 ^ self selectionHolder |
148 |
177 |
326 |
355 |
327 update:something with:aParameter from:changedObject |
356 update:something with:aParameter from:changedObject |
328 "/ ^ self delayedUpdate:something with:aParameter from:changedObject. |
357 "/ ^ self delayedUpdate:something with:aParameter from:changedObject. |
329 |
358 |
330 changedObject == Smalltalk ifTrue:[ |
359 changedObject == Smalltalk ifTrue:[ |
331 something == #methodDictionary ifTrue:[ |
360 something == #methodDictionary ifTrue:[ |
332 ^ self |
361 ^ self |
333 ]. |
362 ]. |
334 something == #methodTrap ifTrue:[ |
363 something == #methodTrap ifTrue:[ |
335 ^ self |
364 ^ self |
336 ]. |
365 ]. |
337 something == #methodInClass ifTrue:[ |
366 something == #methodInClass ifTrue:[ |
338 ^ self |
367 ^ self |
339 ]. |
368 ]. |
340 something == #methodInClassRemoved ifTrue:[ |
369 something == #methodInClassRemoved ifTrue:[ |
341 ^ self |
370 ^ self |
342 ]. |
371 ]. |
343 something == #classComment ifTrue:[ |
372 something == #classComment ifTrue:[ |
344 ^ self. |
373 ^ self. |
345 ]. |
374 ]. |
346 ]. |
375 ]. |
347 "/ self window sensor isNil ifTrue:[ |
376 "/ self window sensor isNil ifTrue:[ |
348 "/ "/ I am not visible ... |
377 "/ "/ I am not visible ... |
349 "/ self invalidateList. |
378 "/ self invalidateList. |
350 "/ ^ self |
379 "/ ^ self |
351 "/ ]. |
380 "/ ]. |
|
381 changedObject == selectedVariableEntries ifTrue:[ |
|
382 self selectedVariables value: |
|
383 ((selectedVariableEntries value ? #()) |
|
384 collect:[:e|e name]). |
|
385 ^self. |
|
386 ]. |
|
387 |
|
388 |
352 super update:something with:aParameter from:changedObject |
389 super update:something with:aParameter from:changedObject |
353 |
390 |
354 "Modified: / 20.11.2001 / 21:55:22 / cg" |
391 "Modified: / 20-11-2001 / 21:55:22 / cg" |
|
392 "Modified: / 12-04-2011 / 15:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
355 ! ! |
393 ! ! |
356 |
394 |
357 !VariableList methodsFor:'generators'! |
395 !VariableList methodsFor:'generators'! |
358 |
396 |
359 makeGenerator |
397 makeGenerator |
407 "/ ]. |
445 "/ ]. |
408 "/ ]. |
446 "/ ]. |
409 "/ ^ classesByInheritance first |
447 "/ ^ classesByInheritance first |
410 ! |
448 ! |
411 |
449 |
|
450 iconInBrowserForVariable: name in: class |
|
451 |
|
452 |
|
453 ^class iconInBrowserForVariableNamed: name |
|
454 |
|
455 "Created: / 12-04-2011 / 19:58:08 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
456 ! |
|
457 |
|
458 listEntryForClass: cls name:name |
|
459 |
|
460 " (showWarningAboutMissingEntryInXmlSpec not |
|
461 and:[Expecco::ExpeccoXMLDecoder notNil |
|
462 and:[cls canUnderstand: #xmlSpecFor:]]) ifTrue: |
|
463 [| hasSpecEntry | |
|
464 hasSpecEntry := false. |
|
465 (Expecco::ExpeccoXMLDecoder xmlSpecForObject:cls basicNew) |
|
466 do:[:spec|spec getter = name ifTrue: |
|
467 [ |
|
468 hasSpecEntry := true]]. |
|
469 showWarningAboutMissingEntryInXmlSpec := hasSpecEntry not]. " |
|
470 |
|
471 ^VariableEntry application: self class: cls name: name |
|
472 |
|
473 "Created: / 12-04-2011 / 15:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
474 "Modified: / 12-04-2011 / 21:36:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
475 ! |
|
476 |
412 listOfVariables |
477 listOfVariables |
413 |nameList numClasses classes class commonSubclass showingClassVars |
478 |nameList numClasses classes class commonSubclass showingClassVars |
414 sortByName| |
479 sortByName| |
415 |
480 |
416 classHolder isNil ifTrue:[ |
481 classHolder isNil ifTrue:[ |
440 nameList := Set new. |
505 nameList := Set new. |
441 classes do:[:class | |
506 classes do:[:class | |
442 showingClassVars ifTrue:[ |
507 showingClassVars ifTrue:[ |
443 self showingInheritedClassVars ifTrue:[ |
508 self showingInheritedClassVars ifTrue:[ |
444 class theNonMetaclass withAllSuperclassesDo:[:cls| |
509 class theNonMetaclass withAllSuperclassesDo:[:cls| |
445 nameList addAll:(cls classVarNames) |
510 nameList addAll: |
|
511 (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm]) |
446 ] |
512 ] |
447 ] ifFalse:[ |
513 ] ifFalse:[ |
448 nameList addAll:(class classVarNames) |
514 nameList addAll: |
|
515 (class classVarNames collect:[:nm|self listEntryForClass: class name: nm]) |
449 ] |
516 ] |
450 ] ifFalse:[ |
517 ] ifFalse:[ |
451 class withAllSuperclassesDo:[:cls| |
518 class withAllSuperclassesDo:[:cls| |
452 nameList addAll:(cls instVarNames) |
519 nameList addAll: |
|
520 (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm]) |
453 ] |
521 ] |
454 ] |
522 ] |
455 ]. |
523 ]. |
456 nameList := nameList asOrderedCollection. |
524 nameList := nameList asOrderedCollection. |
457 ] ifFalse:[ |
525 ] ifFalse:[ |
466 class withAllSuperclassesDo:[:cls| |
534 class withAllSuperclassesDo:[:cls| |
467 |varNames| |
535 |varNames| |
468 |
536 |
469 varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ]. |
537 varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ]. |
470 varNames copy reverse do:[:varName| |
538 varNames copy reverse do:[:varName| |
471 nameList addFirst:varName. |
539 nameList addFirst: (self listEntryForClass: cls name: varName). |
472 ]. |
540 ]. |
473 sortByName ifFalse:[ |
541 sortByName ifFalse:[ |
474 nameList addFirst:'----- ' , cls nameInBrowser , ' -----'. |
542 nameList addFirst:(("'----- ' , "cls nameInBrowser" , ' -----'") asText colorizeAllWith: Color gray). |
475 ] |
543 ] |
476 ]. |
544 ]. |
477 ]. |
545 ]. |
478 ]. |
546 ]. |
479 |
547 |
480 (numClasses > 1 or:[sortByName]) ifTrue:[ |
548 (numClasses > 1 or:[sortByName]) ifTrue:[ |
481 nameList sort. |
549 nameList := nameList asSortedCollection:[:a :b|a name < b name]. |
482 ]. |
550 ]. |
483 ^ nameList |
551 ^ nameList |
484 |
552 |
485 "Created: / 5.2.2000 / 13:42:11 / cg" |
553 "Created: / 05-02-2000 / 13:42:11 / cg" |
486 "Modified: / 26.2.2000 / 01:05:36 / cg" |
554 "Modified: / 26-02-2000 / 01:05:36 / cg" |
|
555 "Modified: / 28-04-2011 / 13:18:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
487 ! |
556 ! |
488 |
557 |
489 postBuildWith:aBuilder |
558 postBuildWith:aBuilder |
490 |listView| |
559 |listView| |
491 |
560 |
502 classHolder removeDependent:self. |
571 classHolder removeDependent:self. |
503 showClassVars removeDependent:self. |
572 showClassVars removeDependent:self. |
504 ! |
573 ! |
505 |
574 |
506 selectionChangeAllowed:index |
575 selectionChangeAllowed:index |
507 ^ ((variableList value at:index) startsWith:'---') not. |
576 |
|
577 | entry | |
|
578 ^((entry := variableList value at:index) isString" and:[entry startsWith:'---']") not. |
|
579 |
|
580 "Modified: / 28-04-2011 / 13:18:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
508 ! |
581 ! |
509 |
582 |
510 updateList |
583 updateList |
511 | prevSelection newSelection newList oldList selectedVariablesHolder| |
584 | prevSelection newSelection newList oldList selectedVariablesHolder| |
512 |
585 |
513 oldList := self variableList value copy. |
586 oldList := self variableList value copy. |
|
587 showWarningAboutMissingEntryInXmlSpec := false. |
514 newList := self listOfVariables. |
588 newList := self listOfVariables. |
515 |
589 |
516 newList ~= variableList value ifTrue:[ |
590 newList ~= variableList value ifTrue:[ |
517 selectedVariablesHolder := self selectedVariables. |
591 selectedVariablesHolder := self selectedVariables. |
518 prevSelection := (selectedVariablesHolder value copy) ? #(). |
592 prevSelection := (selectedVariablesHolder value copy) ? #(). |
519 variableList value:newList. |
593 variableList value:newList. |
520 |
594 |
521 newSelection := prevSelection select:[:item | newList includes:item]. |
595 newSelection := prevSelection select:[:item | newList includes:item]. |
522 |
596 |
523 newSelection size > 0 ifTrue:[ |
597 newSelection size > 0 ifTrue:[ |
524 "/ force change (for dependents) |
598 "/ force change (for dependents) |
525 selectedVariablesHolder value:nil. |
599 selectedVariablesHolder value:nil. |
526 selectedVariablesHolder value:newSelection. |
600 selectedVariablesHolder value:newSelection. |
527 ] ifFalse:[ |
601 ] ifFalse:[ |
528 prevSelection := selectedVariablesHolder value. |
602 prevSelection := selectedVariablesHolder value. |
529 selectedVariablesHolder value:nil. |
603 selectedVariablesHolder value:nil. |
530 ]. |
604 ]. |
531 (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[ |
605 (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[ |
532 self updateOutputGenerator. |
606 self updateOutputGenerator. |
533 ]. |
607 ]. |
534 ]. |
608 ]. |
|
609 (showWarningAboutMissingEntryInXmlSpec and:[self topApplication respondsTo: #showMessage:]) |
|
610 ifTrue: |
|
611 [ |
|
612 self topApplication showMessage: |
|
613 'One or more instance variables are not listed in #xmlSpecFor:'. |
|
614 ]. |
|
615 showWarningAboutMissingEntryInXmlSpec := false. |
535 listValid := true. |
616 listValid := true. |
|
617 |
|
618 "Modified: / 12-04-2011 / 20:16:12 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
619 ! ! |
|
620 |
|
621 !VariableList::VariableEntry class methodsFor:'instance creation'! |
|
622 |
|
623 application: app class: aClass name: aString |
|
624 |
|
625 ^self new application: app; class: aClass; name: aString |
|
626 |
|
627 "Created: / 12-04-2011 / 19:53:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
628 ! |
|
629 |
|
630 class: aClass name: aString |
|
631 |
|
632 ^self new class: aClass; name: aString |
|
633 |
|
634 "Created: / 12-04-2011 / 15:39:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
635 ! ! |
|
636 |
|
637 !VariableList::VariableEntry methodsFor:'accessing'! |
|
638 |
|
639 application: anObject |
|
640 |
|
641 application := anObject |
|
642 |
|
643 "Created: / 12-04-2011 / 19:55:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
644 ! |
|
645 |
|
646 class:aClass |
|
647 class := aClass. |
|
648 ! |
|
649 |
|
650 icon |
|
651 |
|
652 icon ifNil:[icon := application iconInBrowserForVariable: name in: class]. |
|
653 icon ifNil:[icon := #NOICON]. |
|
654 ^icon |
|
655 |
|
656 "Created: / 12-04-2011 / 15:54:50 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
657 "Modified: / 12-04-2011 / 19:58:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
658 ! |
|
659 |
|
660 klass |
|
661 ^ class |
|
662 |
|
663 "Created: / 12-04-2011 / 19:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
664 ! |
|
665 |
|
666 name |
|
667 ^ name |
|
668 ! |
|
669 |
|
670 name:aString |
|
671 name := aString. |
|
672 ! |
|
673 |
|
674 string |
|
675 |
|
676 ^name |
|
677 |
|
678 "Created: / 12-04-2011 / 15:45:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
679 ! ! |
|
680 |
|
681 !VariableList::VariableEntry methodsFor:'displaying'! |
|
682 |
|
683 displayOn:aGC x:x y:y opaque: opaque |
|
684 |
|
685 | icn | |
|
686 icn := self icon. |
|
687 icn ~~ #NOICON ifTrue:[ |
|
688 icn displayOn:aGC x:x + 1 y:y - icn height. |
|
689 ]. |
|
690 ^name displayOn:aGC x:x + 20 y:y opaque: opaque |
|
691 |
|
692 "Created: / 12-04-2011 / 15:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
536 ! ! |
693 ! ! |
537 |
694 |
538 !VariableList class methodsFor:'documentation'! |
695 !VariableList class methodsFor:'documentation'! |
539 |
696 |
540 version |
|
541 ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $' |
|
542 ! |
|
543 |
|
544 version_CVS |
697 version_CVS |
545 ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $' |
698 ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.6 2011-07-07 14:13:39 vrany Exp $' |
546 ! ! |
699 ! ! |