--- a/Tools_ClassCategoryList.st Fri Oct 19 16:59:02 2012 +0200
+++ b/Tools_ClassCategoryList.st Fri Oct 19 17:00:40 2012 +0200
@@ -14,7 +14,8 @@
"{ NameSpace: Tools }"
BrowserList subclass:#ClassCategoryList
- instanceVariableNames:'categoryList classes allSelected showPseudoCategories'
+ instanceVariableNames:'categoryList classes allSelected showPseudoCategories
+ rawCategoryList cookedCategoryList categoryListView'
classVariableNames:'AdditionalEmptyCategories'
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -99,55 +100,53 @@
the UIPainter may not be able to read the specification."
"
- UIPainter new openOnClass:ClassCategoryList andSelector:#windowSpec
- ClassCategoryList new openInterface:#windowSpec
- ClassCategoryList open
+ UIPainter new openOnClass:Tools::ClassCategoryList andSelector:#windowSpec
+ Tools::ClassCategoryList new openInterface:#windowSpec
+ Tools::ClassCategoryList open
"
<resource: #canvas>
^
- #(#FullSpec
- #name: #windowSpec
- #window:
- #(#WindowSpec
- #label: 'ClassCategoryList'
- #name: 'ClassCategoryList'
- #min: #(#Point 0 0)
- #bounds: #(#Rectangle 13 23 313 323)
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'ClassCategoryList'
+ name: 'ClassCategoryList'
+ min: (Point 0 0)
+ bounds: (Rectangle 0 0 300 300)
)
- #component:
- #(#SpecCollection
- #collection: #(
- #(#SequenceViewSpec
- #name: 'List'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #tabable: true
- #model: #selectedCategories
- #menu: #menuHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isMultiSelect: true
- #valueChangeSelector: #selectionChangedByClick
- #useIndex: false
- #sequenceList: #categoryList
- #doubleClickChannel: #doubleClickChannel
- #properties:
- #(#PropertyListDictionary
- #dragArgument: nil
- #dropArgument: nil
- #canDropSelector: #canDropContext:
- #dropSelector: #doDropContext:
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'List'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ tabable: true
+ model: selectedCategories
+ menu: menuHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ isMultiSelect: true
+ valueChangeSelector: selectionChangedByClick
+ useIndex: false
+ sequenceList: categoryList
+ doubleClickChannel: doubleClickChannel
+ properties:
+ (PropertyListDictionary
+ canDropSelector: canDropContext:
+ dragArgument: nil
+ dropArgument: nil
+ dropSelector: doDropContext:
)
+ postBuildCallback: postBuildCategoryListView:
)
)
)
)
-
- "Created: / 5.2.2000 / 13:42:11 / cg"
- "Modified: / 18.8.2000 / 20:11:49 / cg"
! !
!ClassCategoryList class methodsFor:'plugIn spec'!
@@ -164,7 +163,7 @@
(if this app is embedded in a subCanvas)."
^ #(
- #(#doubleClickChannel #action )
+ #(doubleClickChannel action)
#forceGeneratorTrigger
#hideUnloadedClasses
#immediateUpdate
@@ -176,12 +175,11 @@
#packageFilter
#selectedCategories
#selectionChangeCondition
+ #showCoverageInformation
#slaveMode
#updateTrigger
- #showCoverageInformation
).
- "Modified: / 20-07-2011 / 14:29:08 / cg"
! !
!ClassCategoryList class methodsFor:'special'!
@@ -252,11 +250,21 @@
!
selectedCategories
- ^ self selectionHolder
+ ^ self selectionHolder
!
selectedCategories:aValueHolder
^ self selectionHolder:aValueHolder
+!
+
+selectionHolder
+"/ self halt.
+ ^ super selectionHolder
+!
+
+selectionHolder:aValueHolder
+ "/ self halt.
+ super selectionHolder:aValueHolder
! !
!ClassCategoryList methodsFor:'change & update'!
@@ -272,7 +280,7 @@
or:[something == #classDefinition]) ifTrue:[
listValid == true ifTrue:[
categoryOfClass := aParameter category.
- (categoryList value includes:categoryOfClass) ifFalse:[
+ (rawCategoryList includes:categoryOfClass) ifFalse:[
self invalidateList.
].
slaveMode value ~~ true ifTrue:[
@@ -293,7 +301,7 @@
^ self
].
- (categoryList value includes:categoryOfClass) ifFalse:[
+ (rawCategoryList includes:categoryOfClass) ifFalse:[
self invalidateList.
].
@@ -390,7 +398,10 @@
^ self
].
].
-
+ changedObject == categoryList ifTrue:[
+ "/ hack; we use the raw list, but SelectionInListView shall show cookedList (sigh)
+ self halt.
+ ].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 5.2.2000 / 13:42:12 / cg"
@@ -476,9 +487,10 @@
lineNr := categoryListView lineAtY:p y.
lineNr isNil ifTrue:[^ nil].
- cat := categoryList value at:lineNr.
+ cat := rawCategoryList at:lineNr.
cat := cat string.
cat = self class nameListEntryForALL ifTrue:[^ nil].
+
(cat endsWith:(self stringForExtensions)) ifTrue:[
cat := cat copyWithoutLast:(self stringForExtensions size)
].
@@ -521,7 +533,7 @@
(cats includes:allName) ifTrue:[
inGeneratorHolder value isOrderedCollection ifTrue:[
- cats := categoryList value copyWithout:allName.
+ cats := rawCategoryList copyWithout:allName.
]
].
@@ -602,15 +614,15 @@
categoryList := self categoryList value.
idx := categoryList indexOf:category.
idx ~~ 0 ifTrue:[
- ((categoryList at:idx) sameStringAndEmphasisAs:colorizedCategoryItem) ifFalse:[
- categoryList at:idx put:colorizedCategoryItem.
- self categoryList changed.
- ]
+ ((categoryList at:idx) sameStringAndEmphasisAs:colorizedCategoryItem) ifFalse:[
+ categoryList at:idx put:colorizedCategoryItem.
+ self categoryList changed.
+ ]
].
!
listOfCategories
- |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
+ |categories categoriesBag hideUnloadedClasses generator nameSpaceFilter packageFilter allName
categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
classesInChangeSet classesInRemoteChangeSet
numClassesInChangeSet numClasses numUnloaded numUndocumented pseudoEntryColor|
@@ -630,6 +642,7 @@
numClasses := numUndocumented := numUnloaded := numClassesInChangeSet := 0.
categories := Set new.
+ categoriesBag := Bag new.
categoriesWithExtensions := Set new.
categoriesWithChangedCode := Set new.
categoriesWithRemoteChangedCode := Set new.
@@ -667,6 +680,7 @@
cat isString ifFalse:[self halt:'oops - strange category'].
categories add:cat.
classes add:cls.
+ categoriesBag add:cat.
(classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
categoriesWithChangedCode add:cat
@@ -689,59 +703,81 @@
"/ remove those that are present ...
AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
categories addAll:AdditionalEmptyCategories.
+ categoriesBag addAll:AdditionalEmptyCategories withOccurrences:0.
].
] ifFalse:[
+ |setOfCategories|
+
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
+ setOfCategories := Set withAll:generator.
generator do:[:cat | categories add:cat string].
+
+ Smalltalk allClassesDo:[:each |
+ |cat|
+
+ cat := each category string asSymbol.
+ (setOfCategories includes:cat) ifTrue:[
+ categoriesBag add:cat.
+ ].
+ ].
].
+ pseudoEntryColor := self class pseudoEntryForegroundColor.
+
categories := categories asOrderedCollection.
categories sort.
+ rawCategoryList := categories.
+
categories :=
- categories collect:[:cat |
+ categories collect:[:cat |
+ |item|
+
(categoriesWithChangedCode includes:cat) ifTrue:[
- (self colorizeForChangedCode:cat copy asText).
+ item := self colorizeForChangedCode:cat copy asText
] ifFalse:[
(categoriesWithExtensions includes:cat) ifTrue:[
- (self colorizeForDifferentPackage:cat copy asText)
+ item := self colorizeForDifferentPackage:cat copy asText
"/ cannot add a + here - need separate list for presentation and filter
"/ cat , (self colorizeForDifferentPackage:self stringForExtensions)
] ifFalse:[
(categoriesWithRemoteChangedCode includes:cat) ifTrue:[
- (self colorizeForChangedCodeInSmallTeam:cat copy asText).
+ item := self colorizeForChangedCodeInSmallTeam:cat copy asText
] ifFalse:[
- cat
+ item := cat
]
]
- ]
+ ].
+ item := item , ((' (%1)' bindWith:(categoriesBag occurrencesOf:cat))
+ colorizeAllWith:pseudoEntryColor).
+ item
].
- pseudoEntryColor := self class pseudoEntryForegroundColor.
-
numUnloaded > 0 ifTrue:[
- "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
- categories addFirst:((self class nameListEntryForUnloaded "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ rawCategoryList addFirst:self class nameListEntryForUnloaded.
+ categories addFirst:((self class nameListEntryForUnloadedWithCount bindWith:numUnloaded) allItalic colorizeAllWith:pseudoEntryColor).
].
numUndocumented > 0 ifTrue:[
- "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
- categories addFirst:((self class nameListEntryForUndocumented "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ rawCategoryList addFirst:self class nameListEntryForUndocumented.
+ categories addFirst:((self class nameListEntryForUndocumentedWithCount bindWith:numUndocumented) allItalic colorizeAllWith:pseudoEntryColor).
].
numClassesInChangeSet := ChangeSet current changedClasses size.
numClassesInChangeSet > 0 ifTrue:[
- "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
- categories addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ rawCategoryList addFirst:self class nameListEntryForChanged.
+ categories addFirst:((self class nameListEntryForChangedWithCount bindWith:numClassesInChangeSet) allItalic colorizeAllWith:pseudoEntryColor).
].
categories size > 0 ifTrue:[
categories size == 1 ifTrue:[
self classCategoryLabelHolder value:(categories first)
].
- categories addFirst:((self class nameListEntryForALL "WithCount bindWith:numClasses") allItalic colorizeAllWith:pseudoEntryColor).
+ rawCategoryList addFirst:self class nameListEntryForALL.
+ categories addFirst:((self class nameListEntryForALLWithCount bindWith:numClasses) allItalic colorizeAllWith:pseudoEntryColor).
].
- ^ categories
+ cookedCategoryList := categories.
+ ^ rawCategoryList.
"Created: / 05-02-2000 / 13:42:12 / cg"
"Modified: / 10-11-2006 / 17:43:19 / cg"
@@ -770,9 +806,9 @@
idx := categoryList value indexOf:item.
idx ~~ 0 ifTrue:[
- (listView := self listView) notNil ifTrue:[
- listView makeLineVisible:idx.
- ]
+ (listView := self listView) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
]
!
@@ -792,22 +828,21 @@
!
selectedCategoriesStrings
- |selectedCategoriesHolder selectedCategories stringForExtensions|
+ |selectedCategories stringForExtensions|
stringForExtensions := self stringForExtensions.
- selectedCategoriesHolder := self selectedCategories.
- selectedCategories := selectedCategoriesHolder value ? #().
+ selectedCategories := self selectedCategories value ? #().
- selectedCategories := selectedCategories
- collect:[:each |
- |s|
- s := each string.
- (s endsWith:stringForExtensions) ifTrue:[
- s := s copyWithoutLast:(stringForExtensions size).
- ].
- s
- ].
+"/ selectedCategories := selectedCategories
+"/ collect:[:each |
+"/ |s|
+"/ s := each string.
+"/ (s endsWith:stringForExtensions) ifTrue:[
+"/ s := s copyWithoutLast:(stringForExtensions size).
+"/ ].
+"/ s
+"/ ].
^ selectedCategories
"Modified: / 23-08-2006 / 11:38:26 / cg"
@@ -825,13 +860,13 @@
oldSelection := selectedCategoriesHolder value ? #().
prevClasses := classes copy.
- newList := self listOfCategories.
+ newList := self listOfCategories. "/ sigh - sideeffect of setting rawList
oldList := (self categoryList value) ? #().
(newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
ifFalse:[
"/ a real change, or only emphasis ?
(newList sameContentsAs:oldList whenComparedWith:[:a :b | a asString string = b asString string]) ifTrue:[
- "/ a real change
+ "/ only emphasis
oldSelection size > 0 ifTrue:[
selectedCategoriesHolder removeDependent:self.
selectedCategoriesHolder value:#().
@@ -844,7 +879,8 @@
selectedCategoriesHolder value:newSelection.
]
] ifFalse:[
- "/ only emphasis
+ "/ a real change
+
categoryList value:newList.
"/ in case the same categories are present, but classes have changed ...
@@ -874,6 +910,12 @@
listView scrollWhenUpdating:nil
].
super commonPostBuild
+!
+
+postBuildCategoryListView:aView
+ categoryListView := aView.
+ categoryListView visualBlock:[:view :lineNr | cookedCategoryList at:lineNr].
+ categoryListView selectedVisualBlock:[:view :lineNr | (cookedCategoryList at:lineNr) string]
! !
!ClassCategoryList methodsFor:'special'!
@@ -903,9 +945,9 @@
!ClassCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.32 2011-08-18 00:20:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.33 2012-10-19 15:00:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.32 2011-08-18 00:20:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.33 2012-10-19 15:00:40 cg Exp $'
! !