Commented rubbish code that ignores change-update notifications when they come too fast. I feel the mask out some changes...
--- a/Tools__ClassCategoryList.st Tue Oct 02 11:36:39 2012 +0100
+++ b/Tools__ClassCategoryList.st Wed Oct 03 23:28:49 2012 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -25,7 +25,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -63,10 +63,10 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
#name: #singleCategoryWindowSpec
- #window:
+ #window:
#(#WindowSpec
#label: 'ClassCategoryList'
#name: 'ClassCategoryList'
@@ -74,7 +74,7 @@
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
- #component:
+ #component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
@@ -86,7 +86,7 @@
#menu: #menuHolder
)
)
-
+
)
)
!
@@ -106,44 +106,44 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #windowSpec
- #window:
+ #name: #windowSpec
+ #window:
#(#WindowSpec
- #label: 'ClassCategoryList'
- #name: 'ClassCategoryList'
- #min: #(#Point 0 0)
- #bounds: #(#Rectangle 13 23 313 323)
- )
- #component:
+ #label: 'ClassCategoryList'
+ #name: 'ClassCategoryList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 13 23 313 323)
+ )
+ #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:
- )
- )
- )
-
- )
+ #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:
+ )
+ )
+ )
+
+ )
)
"Created: / 5.2.2000 / 13:42:11 / cg"
@@ -164,21 +164,21 @@
(if this app is embedded in a subCanvas)."
^ #(
- #(#doubleClickChannel #action )
- #forceGeneratorTrigger
- #hideUnloadedClasses
- #immediateUpdate
- #inGeneratorHolder
- #menuHolder
- #nameSpaceFilter
- #organizerMode
- #outGeneratorHolder
- #packageFilter
- #selectedCategories
- #selectionChangeCondition
- #slaveMode
- #updateTrigger
- #showCoverageInformation
+ #(#doubleClickChannel #action )
+ #forceGeneratorTrigger
+ #hideUnloadedClasses
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #nameSpaceFilter
+ #organizerMode
+ #outGeneratorHolder
+ #packageFilter
+ #selectedCategories
+ #selectionChangeCondition
+ #slaveMode
+ #updateTrigger
+ #showCoverageInformation
).
"Modified: / 20-07-2011 / 14:29:08 / cg"
@@ -191,7 +191,7 @@
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories isNil ifTrue:[
- AdditionalEmptyCategories := Set new.
+ AdditionalEmptyCategories := Set new.
].
AdditionalEmptyCategories add:aCategory.
Smalltalk changed:#organization with:(nil -> aCategory). "/ not really ... to force update
@@ -203,7 +203,7 @@
AdditionalEmptyCategories isNil ifTrue:[^ self].
aListOfCategories do:[:eachCategory |
- AdditionalEmptyCategories remove:eachCategory ifAbsent:nil.
+ AdditionalEmptyCategories remove:eachCategory ifAbsent:nil.
].
Smalltalk changed:#organization "/ not really ... to force update
@@ -262,133 +262,133 @@
!ClassCategoryList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
- |selectedCategories allSelectedBefore
+ |selectedCategories allSelectedBefore
nameListEntryForALL categoryOfClass wg|
selectedCategories := self selectedCategoriesStrings.
changedObject == Smalltalk ifTrue:[
- ((something == #classVariables)
- or:[something == #classDefinition]) ifTrue:[
- listValid == true ifTrue:[
- categoryOfClass := aParameter category.
- (categoryList value includes:categoryOfClass) ifFalse:[
- self invalidateList.
- ].
- slaveMode value ~~ true ifTrue:[
- (selectedCategories includes:categoryOfClass) ifTrue:[
- "/ a selected class has changed
- "/ in order to give others a chance to update their list before,
- "/ this one is always enqueued for delayed update (even if immediateUpdate is true)
- "/ self enqueueDelayedUpdateOutputGenerator
- self enqueueMessage:#updateOutputGenerator for:self arguments:#()
- ].
- ].
- ].
- ^ self
- ].
- something == #newClass ifTrue:[
- categoryOfClass := aParameter category.
- listValid == false ifTrue:[
- ^ self
- ].
+ ((something == #classVariables)
+ or:[something == #classDefinition]) ifTrue:[
+ listValid == true ifTrue:[
+ categoryOfClass := aParameter category.
+ (categoryList value includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ "/ a selected class has changed
+ "/ in order to give others a chance to update their list before,
+ "/ this one is always enqueued for delayed update (even if immediateUpdate is true)
+ "/ self enqueueDelayedUpdateOutputGenerator
+ self enqueueMessage:#updateOutputGenerator for:self arguments:#()
+ ].
+ ].
+ ].
+ ^ self
+ ].
+ something == #newClass ifTrue:[
+ categoryOfClass := aParameter category.
+ listValid == false ifTrue:[
+ ^ self
+ ].
- (categoryList value includes:categoryOfClass) ifFalse:[
- self invalidateList.
- ].
+ (categoryList value includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
- slaveMode value ~~ true ifTrue:[
- (selectedCategories includes:categoryOfClass) ifTrue:[
- self enqueueDelayedUpdateOutputGenerator
- ].
- ].
- ^ self
- ].
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
+ ].
- self invalidateList.
+ self invalidateList.
- (something == #classRemove
- or:[something == #projectOrganization
- or:[something == #organization]]) ifTrue:[
- slaveMode value ~~ true ifTrue:[
- "/ sorry: cannot filter on category (already changed to #removed)
- self enqueueDelayedUpdateOutputGenerator
- ].
- ].
- ^ self
+ (something == #classRemove
+ or:[something == #projectOrganization
+ or:[something == #organization]]) ifTrue:[
+ slaveMode value ~~ true ifTrue:[
+ "/ sorry: cannot filter on category (already changed to #removed)
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
].
changedObject == ChangeSet ifTrue:[
- "/ remove all other change notifications from the eventQueue
- wg := self windowGroup.
- wg isNil ifTrue:[
- "/ oops - should no longer be dependent...
- changedObject removeDependent:self.
- ] ifFalse:[
- wg sensor
- flushEventsFor:self
- where:[:ev | ev isMessageSendEvent
- and:[ev selector == #delayedUpdate:with:from:
- and:[(ev arguments at:3) == ChangeSet]]].
- ].
+ "/ remove all other change notifications from the eventQueue
+ wg := self windowGroup.
+ wg isNil ifTrue:[
+ "/ oops - should no longer be dependent...
+ changedObject removeDependent:self.
+ ] ifFalse:[
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ ].
- something == #addChange: ifTrue:[
- "/ only need to invalidate, if that change changes my emphasis
- "/ (i.e. if its a new methodChange)
- self window topView shown ifFalse:[
- self invalidateList.
- ^ self
- ].
-
+ something == #addChange: ifTrue:[
+ "/ only need to invalidate, if that change changes my emphasis
+ "/ (i.e. if its a new methodChange)
+ self window topView shown ifFalse:[
+ self invalidateList.
+ ^ self
+ ].
+
"/ self invalidateList.
- aParameter isMethodChange ifTrue:[
- aParameter changeClass notNil ifTrue:[
- (ChangeSet current
- count:[:chg | chg notNil and:[chg isMethodChange
- and:[ chg className = aParameter className ]]])
- == 1 ifTrue:[
- "/ that methodChange is the first for this method.
- self colorizeCategoryAsChanged:(aParameter changeClass category).
- ]
- ]
- ].
- ^ self
- ].
+ aParameter isMethodChange ifTrue:[
+ aParameter changeClass notNil ifTrue:[
+ (ChangeSet current
+ count:[:chg | chg notNil and:[chg isMethodChange
+ and:[ chg className = aParameter className ]]])
+ == 1 ifTrue:[
+ "/ that methodChange is the first for this method.
+ self colorizeCategoryAsChanged:(aParameter changeClass category).
+ ]
+ ]
+ ].
+ ^ self
+ ].
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
changedObject == nameSpaceFilter ifTrue:[
- "/ all might be more or less than before ...
- allSelected := false.
+ "/ all might be more or less than before ...
+ allSelected := false.
].
changedObject == packageFilter ifTrue:[
- "/ all might be more or less than before ...
- allSelected := false.
+ "/ all might be more or less than before ...
+ allSelected := false.
].
changedObject == self selectedCategories ifTrue:[
- categoryList isNil ifTrue:[
- "/ oops - hurry up
- self invalidateList.
- ].
+ categoryList isNil ifTrue:[
+ "/ oops - hurry up
+ self invalidateList.
+ ].
- nameListEntryForALL := self class nameListEntryForALL.
+ nameListEntryForALL := self class nameListEntryForALL.
- selectedCategories size > 1 ifTrue:[
- (selectedCategories includes:nameListEntryForALL) ifTrue:[
- self makeSelectionOtherThanAllVisible.
- ]
- ].
+ selectedCategories size > 1 ifTrue:[
+ (selectedCategories includes:nameListEntryForALL) ifTrue:[
+ self makeSelectionOtherThanAllVisible.
+ ]
+ ].
- "/ if all selected before AND allSelected after, no need to update the output generator
- allSelectedBefore := allSelected ? false.
- allSelected := selectedCategories includes:nameListEntryForALL.
- (allSelectedBefore and:[allSelected]) ifTrue:[
- ^ self
- ].
+ "/ if all selected before AND allSelected after, no need to update the output generator
+ allSelectedBefore := allSelected ? false.
+ allSelected := selectedCategories includes:nameListEntryForALL.
+ (allSelectedBefore and:[allSelected]) ifTrue:[
+ ^ self
+ ].
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -414,34 +414,36 @@
|categoryOfClass ts |
changedObject == Smalltalk ifTrue:[
- "JV2012-02-17: Suppress updates if they're comming too fast
- (such as when booting Java or so)"
- ts := OperatingSystem getMillisecondTime.
- (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
- lastUpdateFromSmalltalkTimestamp := ts.
- numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
- numUpdatesFromSmalltalkInLast200Msecs < 15 ifTrue:[ ^ self ].
- ].
- lastUpdateFromSmalltalkTimestamp := ts.
+"/ JV@2012-10-03: Rubbish
+"/
+"/ "JV2012-02-17: Suppress updates if they're comming too fast
+"/ (such as when booting Java or so)"
+"/ ts := OperatingSystem getMillisecondTime.
+"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
+"/ numUpdatesFromSmalltalkInLast200Msecs < 15 ifTrue:[ ^ self ].
+"/ ].
+"/ lastUpdateFromSmalltalkTimestamp := ts.
- (something == #methodInClass
- or:[ something == #classComment
- or:[ something == #methodDictionary
- or:[ something == #methodTrap
- or:[ something == #methodCoverageInfo
- or:[ something == #methodInClassRemoved ]]]]]) ifTrue:[
- ^ self
- ].
+ (something == #methodInClass
+ or:[ something == #classComment
+ or:[ something == #methodDictionary
+ or:[ something == #methodTrap
+ or:[ something == #methodCoverageInfo
+ or:[ something == #methodInClassRemoved ]]]]]) ifTrue:[
+ ^ self
+ ].
- (something == #classVariables
- or:[something == #classDefinition]) ifTrue:[
- categoryOfClass := aParameter category.
- (self selectedCategoriesStrings includes:categoryOfClass) ifTrue:[
+ (something == #classVariables
+ or:[something == #classDefinition]) ifTrue:[
+ categoryOfClass := aParameter category.
+ (self selectedCategoriesStrings includes:categoryOfClass) ifTrue:[
"/ self halt.
- self updateOutputGenerator.
- ].
- ].
+ self updateOutputGenerator.
+ ].
+ ].
].
"/ changedObject == ChangeSet ifTrue:[
@@ -492,7 +494,7 @@
cat := cat string.
cat = self class nameListEntryForALL ifTrue:[^ nil].
(cat endsWith:(self stringForExtensions)) ifTrue:[
- cat := cat copyWithoutLast:(self stringForExtensions size)
+ cat := cat copyWithoutLast:(self stringForExtensions size)
].
^ cat
!
@@ -502,15 +504,15 @@
objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(objects conform:[:something | something isClass]) ifTrue:[
- cat := self categoryAtTargetPointOf:aDropContext.
- cat notNil ifTrue:[
- self masterApplication moveClasses:objects toCategory:cat.
- ].
- ^ self
+ cat := self categoryAtTargetPointOf:aDropContext.
+ cat notNil ifTrue:[
+ self masterApplication moveClasses:objects toCategory:cat.
+ ].
+ ^ self
].
(objects conform:[:something | something isFilename]) ifTrue:[
- self dropClassFiles:objects.
- ^ self
+ self dropClassFiles:objects.
+ ^ self
].
"Modified: / 17-10-2006 / 18:29:25 / cg"
@@ -521,20 +523,20 @@
makeGenerator
"return a generator which enumerates the classes from the selected category."
- |cats hideUnloadedClasses allName nameSpaceFilter packageFilter
+ |cats hideUnloadedClasses allName nameSpaceFilter packageFilter
showChangedClasses showUnloaded showUndocumented inclusionTest changedClasses|
cats := self selectedCategoriesStrings.
cats size == 0 ifTrue:[
- ^ #()
+ ^ #()
].
allName := self class nameListEntryForALL.
(cats includes:allName) ifTrue:[
- inGeneratorHolder value isOrderedCollection ifTrue:[
- cats := categoryList value copyWithout:allName.
- ]
+ inGeneratorHolder value isOrderedCollection ifTrue:[
+ cats := categoryList value copyWithout:allName.
+ ]
].
showChangedClasses := cats includes:(self class nameListEntryForChanged).
@@ -544,61 +546,61 @@
hideUnloadedClasses := self hideUnloadedClasses value ? false.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
- (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
- (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
(cats includes:allName) ifTrue:[
- hideUnloadedClasses ifTrue:[
- inclusionTest := [:cls | cls isLoaded].
- ] ifFalse:[
- inclusionTest := [:cls | true].
- ].
+ hideUnloadedClasses ifTrue:[
+ inclusionTest := [:cls | cls isLoaded].
+ ] ifFalse:[
+ inclusionTest := [:cls | true].
+ ].
] ifFalse:[
- inclusionTest :=
- [:cls |
- |cat isLoaded included|
+ inclusionTest :=
+ [:cls |
+ |cat isLoaded included|
- isLoaded := cls isLoaded.
- included := isLoaded not and:[ showUnloaded ].
- included ifFalse:[
- (hideUnloadedClasses not or:[isLoaded]) ifTrue:[
- cat := cls category ? '* no category *'.
- included := cats includes:cat.
- included ifFalse:[
- included := showChangedClasses
- and:[ (changedClasses includes:cls theNonMetaclass)
- or:[(changedClasses includes:cls theMetaclass)] ].
- included ifFalse:[
- included := showUndocumented and:[ isLoaded and:[ (cls theMetaclass includesSelector:#documentation) not ]].
- ].
- ].
- ].
- ].
- included
- ].
+ isLoaded := cls isLoaded.
+ included := isLoaded not and:[ showUnloaded ].
+ included ifFalse:[
+ (hideUnloadedClasses not or:[isLoaded]) ifTrue:[
+ cat := cls category ? '* no category *'.
+ included := cats includes:cat.
+ included ifFalse:[
+ included := showChangedClasses
+ and:[ (changedClasses includes:cls theNonMetaclass)
+ or:[(changedClasses includes:cls theMetaclass)] ].
+ included ifFalse:[
+ included := showUndocumented and:[ isLoaded and:[ (cls theMetaclass includesSelector:#documentation) not ]].
+ ].
+ ].
+ ].
+ ].
+ included
+ ].
].
^ Iterator on:[:whatToDo |
- showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
- (cls isRealNameSpace) ifFalse:[
- (inclusionTest value:cls) ifTrue:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- whatToDo value:cls
- ]
- ]
- ].
- ].
- ].
- ].
+ Smalltalk allClassesDo:[:cls |
+ (cls isRealNameSpace) ifFalse:[
+ (inclusionTest value:cls) ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
"Created: / 05-02-2000 / 13:42:12 / cg"
"Modified: / 10-11-2006 / 17:13:26 / cg"
@@ -624,7 +626,7 @@
listOfCategories
|categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
- classesInChangeSet classesInRemoteChangeSet
+ classesInChangeSet classesInRemoteChangeSet
numClassesInChangeSet numClasses numUnloaded numUndocumented pseudoEntryColor|
allName := self class nameListEntryForALL.
@@ -632,11 +634,11 @@
hideUnloadedClasses := self hideUnloadedClasses value.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
- (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
- (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
numClasses := numUndocumented := numUnloaded := numClassesInChangeSet := 0.
@@ -654,103 +656,103 @@
classes := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
- Smalltalk allClassesDo:[:cls |
- |cat isLoaded|
+ Smalltalk allClassesDo:[:cls |
+ |cat isLoaded|
- (cls isRealNameSpace) ifFalse:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (cls isRealNameSpace) ifFalse:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- isLoaded := cls isLoaded.
- isLoaded ifTrue:[
- numUnloaded := numUnloaded + 1.
- (cls theMetaclass includesSelector:#documentation) ifFalse:[
- numUndocumented := numUndocumented + 1.
- ].
- ].
+ isLoaded := cls isLoaded.
+ isLoaded ifTrue:[
+ numUnloaded := numUnloaded + 1.
+ (cls theMetaclass includesSelector:#documentation) ifFalse:[
+ numUndocumented := numUndocumented + 1.
+ ].
+ ].
- (hideUnloadedClasses not or:[isLoaded])
- ifTrue:[
- numClasses := numClasses + 1.
+ (hideUnloadedClasses not or:[isLoaded])
+ ifTrue:[
+ numClasses := numClasses + 1.
- cat := cls category ? '* no category *'.
- cat isString ifFalse:[self halt:'oops - strange category'].
- categories add:cat.
- classes add:cls.
+ cat := cls category ? '* no category *'.
+ cat isString ifFalse:[self halt:'oops - strange category'].
+ categories add:cat.
+ classes add:cls.
- (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
- categoriesWithChangedCode add:cat
- ].
- (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
- categoriesWithRemoteChangedCode add:cat
- ].
- cls hasExtensions ifTrue:[
- categoriesWithExtensions add:cat
- ].
- ]
- ]
- ]
- ]
- ].
+ (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithChangedCode add:cat
+ ].
+ (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithRemoteChangedCode add:cat
+ ].
+ cls hasExtensions ifTrue:[
+ categoriesWithExtensions add:cat
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
- "/ those are simulated - in ST/X, empty categories do not
- "/ really exist; however, during browsing, it makes sense.
- AdditionalEmptyCategories size > 0 ifTrue:[
- "/ remove those that are present ...
- AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
- categories addAll:AdditionalEmptyCategories.
- ].
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategories size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
+ categories addAll:AdditionalEmptyCategories.
+ ].
] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
- generator do:[:cat | categories add:cat string].
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:cat | categories add:cat string].
].
categories := categories asOrderedCollection.
categories sort.
- categories :=
- categories collect:[:cat |
- (categoriesWithChangedCode includes:cat) ifTrue:[
- (self colorizeForChangedCode:cat copy asText).
- ] ifFalse:[
- (categoriesWithExtensions includes:cat) ifTrue:[
- (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).
- ] ifFalse:[
- cat
- ]
- ]
- ]
- ].
+ categories :=
+ categories collect:[:cat |
+ (categoriesWithChangedCode includes:cat) ifTrue:[
+ (self colorizeForChangedCode:cat copy asText).
+ ] ifFalse:[
+ (categoriesWithExtensions includes:cat) ifTrue:[
+ (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).
+ ] ifFalse:[
+ cat
+ ]
+ ]
+ ]
+ ].
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).
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForUnloaded "bindWith:numClassesInChangeSet") 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).
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForUndocumented "bindWith:numClassesInChangeSet") 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).
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForChanged "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).
+ categories size == 1 ifTrue:[
+ self classCategoryLabelHolder value:(categories first)
+ ].
+ categories addFirst:((self class nameListEntryForALL "WithCount bindWith:numClasses") allItalic colorizeAllWith:pseudoEntryColor).
].
^ categories
@@ -759,7 +761,7 @@
"Modified: / 10-11-2006 / 17:43:19 / cg"
!
-listView
+listView
^ self componentAt:#List
!
@@ -811,15 +813,15 @@
selectedCategoriesHolder := self selectedCategories.
selectedCategories := selectedCategoriesHolder 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"
@@ -839,36 +841,36 @@
newList := self listOfCategories.
oldList := (self categoryList value) ? #().
- (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
+ (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
- oldSelection size > 0 ifTrue:[
- selectedCategoriesHolder removeDependent:self.
- selectedCategoriesHolder value:#().
- selectedCategoriesHolder addDependent:self.
- ].
- categoryList value:newList.
+ "/ a real change, or only emphasis ?
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a asString string = b asString string]) ifTrue:[
+ "/ a real change
+ oldSelection size > 0 ifTrue:[
+ selectedCategoriesHolder removeDependent:self.
+ selectedCategoriesHolder value:#().
+ selectedCategoriesHolder addDependent:self.
+ ].
+ categoryList value:newList.
- oldSelection size > 0 ifTrue:[
- newSelection := oldSelection select:[:cat | newList includes:cat].
- selectedCategoriesHolder value:newSelection.
- ]
- ] ifFalse:[
- "/ only emphasis
- categoryList value:newList.
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:cat | newList includes:cat].
+ selectedCategoriesHolder value:newSelection.
+ ]
+ ] ifFalse:[
+ "/ only emphasis
+ categoryList value:newList.
- "/ in case the same categories are present, but classes have changed ...
- (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
- self updateOutputGenerator.
- ]
- ]
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
+ ]
] ifTrue:[
- "/ in case the same categories are present, but classes have changed ...
- (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
- self updateOutputGenerator.
- ]
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
].
listValid := true.
@@ -883,7 +885,7 @@
listView := self listView.
listView notNil ifTrue:[
- listView scrollWhenUpdating:nil
+ listView scrollWhenUpdating:nil
].
super commonPostBuild
! !
@@ -915,7 +917,7 @@
!ClassCategoryList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__ClassCategoryList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__ClassCategoryList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
!
version_CVS
@@ -923,6 +925,5 @@
!
version_SVN
- ^ '$Id: Tools__ClassCategoryList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__ClassCategoryList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
! !
-
--- a/Tools__ClassList.st Tue Oct 02 11:36:39 2012 +0100
+++ b/Tools__ClassList.st Wed Oct 03 23:28:49 2012 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -28,7 +28,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -69,10 +69,10 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
#name: #windowSpec
- #window:
+ #window:
#(#WindowSpec
#label: 'ClassList'
#name: 'ClassList'
@@ -80,7 +80,7 @@
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
- #component:
+ #component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
@@ -97,7 +97,7 @@
"/ #minorKey: #metaSpec
"/ )
)
-
+
)
)
!
@@ -117,44 +117,44 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #windowSpec
- #window:
+ #name: #windowSpec
+ #window:
#(#WindowSpec
- #label: 'ClassList'
- #name: 'ClassList'
- #min: #(#Point 0 0)
- #bounds: #(#Rectangle 16 46 316 346)
- )
- #component:
+ #label: 'ClassList'
+ #name: 'ClassList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 16 46 316 346)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#SequenceViewSpec
- #name: 'List'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #tabable: true
- #model: #selectedClassNameIndices
- #menu: #menuHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isMultiSelect: true
- #valueChangeSelector: #selectionChangedByClick
- #useIndex: true
- #sequenceList: #classNameList
- #doubleClickChannel: #doubleClickChannel
- #properties:
- #(#PropertyListDictionary
- #dragArgument: nil
- #dropArgument: nil
- #canDropSelector: #canDropContext:
- #dropSelector: #doDropContext:
- )
- )
- )
-
- )
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectedClassNameIndices
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #classNameList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
)
! !
@@ -172,28 +172,28 @@
(if this app is embedded in a subCanvas)."
^ #(
- #currentNamespace
- #(#doubleClickChannel #action )
- #forceGeneratorTrigger
- #hidePrivateClasses
- #hideUnloadedClasses
- #sortByNameAndInheritance
- #immediateUpdate
- #inGeneratorHolder
- #menuHolder
- #meta
- #organizerMode
- #outGeneratorHolder
- #packageFilter
- #nameSpaceFilter
- #selectedClasses
- #selectionChangeCondition
- #showClassPackages
- #slaveMode
- #updateTrigger
- #markApplicationsHolder
- #showCoverageInformation
- #outGeneratorHolderForMethods
+ #currentNamespace
+ #(#doubleClickChannel #action )
+ #forceGeneratorTrigger
+ #hidePrivateClasses
+ #hideUnloadedClasses
+ #sortByNameAndInheritance
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #meta
+ #organizerMode
+ #outGeneratorHolder
+ #packageFilter
+ #nameSpaceFilter
+ #selectedClasses
+ #selectionChangeCondition
+ #showClassPackages
+ #slaveMode
+ #updateTrigger
+ #markApplicationsHolder
+ #showCoverageInformation
+ #outGeneratorHolderForMethods
).
"Modified: / 04-07-2011 / 18:34:44 / cg"
@@ -385,8 +385,8 @@
sortByNameAndInheritance
sortByNameAndInheritance isNil ifTrue:[
- sortByNameAndInheritance := false asValue.
- sortByNameAndInheritance addDependent:self.
+ sortByNameAndInheritance := false asValue.
+ sortByNameAndInheritance addDependent:self.
].
^ sortByNameAndInheritance.
@@ -395,11 +395,11 @@
sortByNameAndInheritance:aValueHolder
sortByNameAndInheritance notNil ifTrue:[
- sortByNameAndInheritance removeDependent:self
+ sortByNameAndInheritance removeDependent:self
].
sortByNameAndInheritance := aValueHolder.
sortByNameAndInheritance notNil ifTrue:[
- sortByNameAndInheritance addDependent:self
+ sortByNameAndInheritance addDependent:self
].
"Created: / 04-07-2011 / 18:33:43 / cg"
@@ -433,7 +433,7 @@
"/ force update
self selectedClassNameIndices value:(self selectedClassNameIndices value).
- ((self selectedClasses value ? #()) contains:[:cls | cls notNil ifTrue:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name] ifFalse:[false]])
+ ((self selectedClasses value ? #()) contains:[:cls | cls notNil ifTrue:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name] ifFalse:[false]])
ifTrue:[
self updateOutputGenerator
].
@@ -464,8 +464,8 @@
classes := self classList value ? #().
self inSlaveModeOrInvisible ifTrue:[
- self invalidateList.
- ^ self.
+ self invalidateList.
+ ^ self.
].
"/ (self slaveMode value == true) ifTrue:[^ self].
@@ -477,153 +477,153 @@
"/ ].
changedObject == slaveMode ifTrue:[
- listValid ~~ true ifTrue:[
- self enqueueDelayedUpdateList.
- ].
- self enqueueDelayedClassSelectionChanged.
- ^ self
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList.
+ ].
+ self enqueueDelayedClassSelectionChanged.
+ ^ self
].
changedObject == Smalltalk ifTrue:[
- something == #methodInClass ifTrue:[
- ^ self "no interest"
- ].
- something == #methodInClassRemoved ifTrue:[
- "/ must update the list, if the methods package is different from
- "/ the classes package (to undo any has-exension highlighting)
- cls := aParameter first.
- self updateListsFor:cls.
- ^ self
- ].
- something == #organization ifTrue:[^ self "no interest" ].
+ something == #methodInClass ifTrue:[
+ ^ self "no interest"
+ ].
+ something == #methodInClassRemoved ifTrue:[
+ "/ must update the list, if the methods package is different from
+ "/ the classes package (to undo any has-exension highlighting)
+ cls := aParameter first.
+ self updateListsFor:cls.
+ ^ self
+ ].
+ something == #organization ifTrue:[^ self "no interest" ].
- (something == #classDefinition
- or:[something == #classVariables
- or:[something == #newClass]]) ifTrue:[
- "/ update that class in my classList and the selection
- listValid ifTrue:[
- self classDefinitionChanged:aParameter.
- ].
- ^ self.
- ].
- (something == #lastTestRunResult) ifTrue:[
- "/ update that class in my classList and the selection
- listValid ifTrue:[
- self updateListsFor:aParameter.
- "/ self classDefinitionChanged:aParameter.
- ].
- ^ self.
- ].
- something == #classRemove ifTrue:[
- "/ update my classList and the selection
- self classRemoved:aParameter.
- ^ self.
- ].
- something == #classRename ifTrue:[
- "/ update that class in my classList and the selection
- listValid ifTrue:[
- aParameter isArray ifTrue:[
- cls := aParameter at:1.
- self classDefinitionChanged:cls.
- ]
- ].
- ^ self.
- ].
+ (something == #classDefinition
+ or:[something == #classVariables
+ or:[something == #newClass]]) ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ self classDefinitionChanged:aParameter.
+ ].
+ ^ self.
+ ].
+ (something == #lastTestRunResult) ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ self updateListsFor:aParameter.
+ "/ self classDefinitionChanged:aParameter.
+ ].
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ "/ update my classList and the selection
+ self classRemoved:aParameter.
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ aParameter isArray ifTrue:[
+ cls := aParameter at:1.
+ self classDefinitionChanged:cls.
+ ]
+ ].
+ ^ self.
+ ].
- something == #projectOrganization ifTrue:[
- aParameter isNil ifTrue:[
- self invalidateList.
- organizerMode value == #project ifTrue:[
- self enqueueDelayedUpdateOutputGenerator.
- ].
- ^ self
- ].
+ something == #projectOrganization ifTrue:[
+ aParameter isNil ifTrue:[
+ self invalidateList.
+ organizerMode value == #project ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ].
+ ^ self
+ ].
- cls := aParameter at:1.
- cls notNil ifTrue:[ "/ should not happen (but does occasionally)
- ((classes includes:cls theMetaclass)
- or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
- self invalidateList.
- organizerMode value == #project ifTrue:[
- self enqueueDelayedUpdateOutputGenerator.
- ]
- ].
- ].
- ^ self
- ].
- ^ self.
+ cls := aParameter at:1.
+ cls notNil ifTrue:[ "/ should not happen (but does occasionally)
+ ((classes includes:cls theMetaclass)
+ or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
+ self invalidateList.
+ organizerMode value == #project ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ]
+ ].
+ ].
+ ^ self
+ ].
+ ^ self.
].
(something == #lastTestRunResult) ifTrue:[
- ^ self
+ ^ self
].
changedObject == ChangeSet ifTrue:[
- wg := self windowGroup.
- wg isNil ifTrue:[
- changedObject removeDependent:self.
- ] ifFalse:[
- "/ react on changes of the changeSet to recolorize items
- something == #addChange: ifTrue:[
- chgClass := aParameter changeClass.
- chgClass notNil ifTrue:[
- ((classes includes:chgClass theNonMetaclass)
- or:[classes includes:chgClass theMetaclass]) ifTrue:[
- "/ remove all other addChange notifications ...
- wg sensor
- flushEventsFor:self
- where:[:ev | ev isMessageSendEvent
- and:[ev selector == #delayedUpdate:with:from:
- and:[(ev arguments at:3) == ChangeSet]]].
- self reconstructNameList.
- ]
- ]
- ] ifFalse:[
- "/ remove all other ChangeSet notifications ...
- wg sensor
- flushEventsFor:self
- where:[:ev | ev isMessageSendEvent
- and:[ev selector == #delayedUpdate:with:from:
- and:[(ev arguments at:3) == ChangeSet]]].
- self reconstructNameList.
- ].
- ].
- ^ self
+ wg := self windowGroup.
+ wg isNil ifTrue:[
+ changedObject removeDependent:self.
+ ] ifFalse:[
+ "/ react on changes of the changeSet to recolorize items
+ something == #addChange: ifTrue:[
+ chgClass := aParameter changeClass.
+ chgClass notNil ifTrue:[
+ ((classes includes:chgClass theNonMetaclass)
+ or:[classes includes:chgClass theMetaclass]) ifTrue:[
+ "/ remove all other addChange notifications ...
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ self reconstructNameList.
+ ]
+ ]
+ ] ifFalse:[
+ "/ remove all other ChangeSet notifications ...
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ self reconstructNameList.
+ ].
+ ].
+ ^ self
].
changedObject == self selectedClasses ifTrue:[
- slaveMode value ~~ true ifTrue:[
- savedList := self selectedClasses value.
- lastSelectedClasses := nil.
- listValid == true ifFalse:[
- self updateList
- ].
- self selectedClasses setValue:savedList.
- self selectedClassesChanged.
- self updateOutputGenerator.
- ] ifFalse:[
- listValid := false.
- ].
- ^ self
+ slaveMode value ~~ true ifTrue:[
+ savedList := self selectedClasses value.
+ lastSelectedClasses := nil.
+ listValid == true ifFalse:[
+ self updateList
+ ].
+ self selectedClasses setValue:savedList.
+ self selectedClassesChanged.
+ self updateOutputGenerator.
+ ] ifFalse:[
+ listValid := false.
+ ].
+ ^ self
].
- (changedObject == meta
+ (changedObject == meta
or:[changedObject == selectedClassNameIndices]) ifTrue:[
- self selectionChanged.
- ^ self
+ self selectionChanged.
+ ^ self
].
changedObject == showClassPackages ifTrue:[
- self classNameList value:nil.
- self invalidateList.
- ^ self
+ self classNameList value:nil.
+ self invalidateList.
+ ^ self
].
(changedObject == hideUnloadedClasses
or:[changedObject == hidePrivateClasses
or:[changedObject == nameSpaceFilter
or:[changedObject == packageFilter]]]) ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -635,8 +635,8 @@
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
- self selectedClassesChanged.
- ^ self.
+ self selectedClassesChanged.
+ ^ self.
].
self enqueueMessage:#selectedClassesChanged for:self arguments:#()
@@ -681,8 +681,8 @@
classes := classList value.
classes isNil ifTrue:[
- self updateList.
- classes := classList value.
+ self updateList.
+ classes := classList value.
].
isMeta := meta value.
@@ -690,35 +690,35 @@
selectedClassNameIndices := self selectedClassNameIndices value.
selectedClassNameIndices size == classes size ifTrue:[
- selectedClassNameIndices size == 0 ifTrue:[^ #()].
- isMeta ifTrue:[
- ^ classes collect:[:eachClass | eachClass theMetaclass].
- ].
- ^ classes collect:[:eachClass | eachClass theNonMetaclass].
+ selectedClassNameIndices size == 0 ifTrue:[^ #()].
+ isMeta ifTrue:[
+ ^ classes collect:[:eachClass | eachClass theMetaclass].
+ ].
+ ^ classes collect:[:eachClass | eachClass theNonMetaclass].
].
- selected := selectedClassNameIndices
- collect:[:idx |
- |cls|
+ selected := selectedClassNameIndices
+ collect:[:idx |
+ |cls|
- cls := classes at:idx.
- cls == (self class nameListEntryForALL) ifTrue:[
- allEntrySelected := true.
- ] ifFalse:[
- cls notNil ifTrue:[
- isMeta ifTrue:[
- cls := cls theMetaclass
- ] ifFalse:[
- cls := cls theNonMetaclass
- ].
- ] ifFalse:[
- anyLost := true
- ].
- ].
- cls
- ].
+ cls := classes at:idx.
+ cls == (self class nameListEntryForALL) ifTrue:[
+ allEntrySelected := true.
+ ] ifFalse:[
+ cls notNil ifTrue:[
+ isMeta ifTrue:[
+ cls := cls theMetaclass
+ ] ifFalse:[
+ cls := cls theNonMetaclass
+ ].
+ ] ifFalse:[
+ anyLost := true
+ ].
+ ].
+ cls
+ ].
anyLost ifTrue:[
- selected := selected select:[:each | each notNil].
+ selected := selected select:[:each | each notNil].
].
"/ allEntrySelected ifTrue:[
@@ -739,7 +739,7 @@
|indices selectedClassNameIndicesHolder|
self classList value size == 0 ifTrue:[
- "/ this may happen during early startup,
+ "/ this may happen during early startup,
"/ when invoked with a preset classSelection,
"/ and the classGenerator has not yet been setup
"/ to not clobber the selection, defer the update
@@ -748,7 +748,7 @@
].
"/ lastSelectedClasses := self selectedClasses value copy.
- indices := self getSelectedClassIndicesFromClasses.
+ indices := self getSelectedClassIndicesFromClasses.
selectedClassNameIndicesHolder := self selectedClassNameIndices.
selectedClassNameIndicesHolder value ~= indices ifTrue:[
"/ in slaveMode, do not update selectedClasses from indices
@@ -776,7 +776,7 @@
prevSelection := selectedClassesHolder value ? #().
prevSelection ~= selected ifTrue:[
- selectedClassesHolder value:selected.
+ selectedClassesHolder value:selected.
].
!
@@ -790,26 +790,26 @@
"/JV@2012-04-06: Change to also update navigation history"
selected size == 1 ifTrue:[
- masterApplication notNil ifTrue:[
- master := masterApplication.
- masterApplication masterApplication notNil ifTrue:[
- master := masterApplication masterApplication.
- ].
- ].
- (selected = lastSelectedClasses) ifTrue:[
- "/ thats a kludge - we want to turn off the protocol selection,
- "/ when a class is reselected.
- master notNil ifTrue:[
- (master respondsTo:#classReselected) ifTrue:[
- master classReselected.
- ].
- ]
- ] ifFalse:[
- lastSelectedClasses := selected copy.
- ].
- (master notNil and:[master respondsTo:#addToHistory:]) ifTrue:[
- master addToHistory: selected anElement.
- ]
+ masterApplication notNil ifTrue:[
+ master := masterApplication.
+ masterApplication masterApplication notNil ifTrue:[
+ master := masterApplication masterApplication.
+ ].
+ ].
+ (selected = lastSelectedClasses) ifTrue:[
+ "/ thats a kludge - we want to turn off the protocol selection,
+ "/ when a class is reselected.
+ master notNil ifTrue:[
+ (master respondsTo:#classReselected) ifTrue:[
+ master classReselected.
+ ].
+ ]
+ ] ifFalse:[
+ lastSelectedClasses := selected copy.
+ ].
+ (master notNil and:[master respondsTo:#addToHistory:]) ifTrue:[
+ master addToHistory: selected anElement.
+ ]
]
"Modified: / 06-04-2012 / 10:57:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -819,8 +819,8 @@
|cls sel mthd newMethod oldMethod idx classListValue ts |
self slaveMode value == true ifTrue:[
- something == #methodInClass ifTrue:[ ^ self ].
- something == #addChange: ifTrue:[ self invalidateList. ^ self ].
+ something == #methodInClass ifTrue:[ ^ self ].
+ something == #addChange: ifTrue:[ self invalidateList. ^ self ].
].
"/ self window sensor isNil ifTrue:[
"/ "/ not visible ...
@@ -831,124 +831,126 @@
classListValue := classList value.
changedObject == Smalltalk ifTrue:[
- "JV2012-02-17: Suppress updates if they're comming too fast
- (such as when booting Java or so)"
- ts := OperatingSystem getMillisecondTime.
- (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
- lastUpdateFromSmalltalkTimestamp := ts.
- numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
- numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
- ].
- numUpdatesFromSmalltalkInLast200Msecs := 0.
- lastUpdateFromSmalltalkTimestamp := ts.
+"/ JV@2012-10-03: Rubbish
+"/
+"/ "JV2012-02-17: Suppress updates if they're comming too fast
+"/ (such as when booting Java or so)"
+"/ ts := OperatingSystem getMillisecondTime.
+"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
+"/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
+"/ ].
+"/ numUpdatesFromSmalltalkInLast200Msecs := 0.
+"/ lastUpdateFromSmalltalkTimestamp := ts.
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
- something == #coverageInfo ifTrue:[
- listValid == true ifTrue:[
- self enqueueDelayedUpdateList
- ].
- ^ self.
- ].
- something == #methodCoverageInfo ifTrue:[
- listValid == true ifTrue:[
- mthd := aParameter.
- cls := mthd mclass.
- cls notNil ifTrue:[
- classListValue size > 0 ifTrue:[
- ((classListValue includesIdentical:cls theNonMetaclass)
- or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
- self enqueueDelayedUpdateList
- ]
- ]
- ].
- ].
- ^ self
- ].
- something == #lastTestRunResult ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- (cls notNil and:[sel isNil]) ifTrue:[
- classListValue size > 0 ifTrue:[
- ((classListValue includesIdentical:cls theNonMetaclass)
- or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
- self enqueueDelayedUpdateList
- ]
- ]
- ].
- ^ self
- ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #coverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ ^ self.
+ ].
+ something == #methodCoverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ mthd := aParameter.
+ cls := mthd mclass.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ].
+ ^ self
+ ].
+ something == #lastTestRunResult ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ (cls notNil and:[sel isNil]) ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ^ self
+ ].
- something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- cls notNil ifTrue:[
- classListValue size > 0 ifTrue:[
- ((classListValue includesIdentical:cls theNonMetaclass)
- or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
- self enqueueDelayedUpdateList
- ]
- ]
- ].
- ^ self
- ].
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ^ self
+ ].
- something == #methodInClass ifTrue:[
- cls := aParameter at:1.
- cls notNil ifTrue:[
- classListValue size > 0 ifTrue:[
- ((classListValue includesIdentical:cls theNonMetaclass)
- or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
- newMethod := cls compiledMethodAt:(aParameter at:2).
- oldMethod := aParameter at:3.
- ((oldMethod isNil
- and:[newMethod package ~= cls package])
- or:[oldMethod notNil
- and:[newMethod package ~= oldMethod package]])
- ifTrue:[
- "/ must update the list (for the package-info)
- self enqueueDelayedUpdateList
- ]
- ]
- ]
- ].
- ^ self
- ].
+ something == #methodInClass ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ newMethod := cls compiledMethodAt:(aParameter at:2).
+ oldMethod := aParameter at:3.
+ ((oldMethod isNil
+ and:[newMethod package ~= cls package])
+ or:[oldMethod notNil
+ and:[newMethod package ~= oldMethod package]])
+ ifTrue:[
+ "/ must update the list (for the package-info)
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ]
+ ].
+ ^ self
+ ].
- "/ kludge: must be careful if my inGenerator is a constant list.
- "/ in that case, I have to update it
- "/ (sigh - all a consequence of not #becoming the new class)
- ((something == #classDefinition) or:[something == #newClass]) ifTrue:[
- inGeneratorHolder value isOrderedCollection ifTrue:[
- idx := inGeneratorHolder value findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
- idx ~~ 0 ifTrue:[
- inGeneratorHolder value at:idx put:aParameter.
- self updateListsFor:aParameter.
- "/ self enqueueDelayedUpdateList.
- ]
- ] ifFalse:[
- classListValue size > 0 ifTrue:[
- idx := classListValue findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
- idx ~~ 0 ifTrue:[
- listValid ifTrue:[
- self classDefinitionChanged:aParameter.
- ^ self.
- ]
- ]
- ].
- ].
- ].
+ "/ kludge: must be careful if my inGenerator is a constant list.
+ "/ in that case, I have to update it
+ "/ (sigh - all a consequence of not #becoming the new class)
+ ((something == #classDefinition) or:[something == #newClass]) ifTrue:[
+ inGeneratorHolder value isOrderedCollection ifTrue:[
+ idx := inGeneratorHolder value findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
+ idx ~~ 0 ifTrue:[
+ inGeneratorHolder value at:idx put:aParameter.
+ self updateListsFor:aParameter.
+ "/ self enqueueDelayedUpdateList.
+ ]
+ ] ifFalse:[
+ classListValue size > 0 ifTrue:[
+ idx := classListValue findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
+ idx ~~ 0 ifTrue:[
+ listValid ifTrue:[
+ self classDefinitionChanged:aParameter.
+ ^ self.
+ ]
+ ]
+ ].
+ ].
+ ].
].
changedObject == sortByNameAndInheritance ifTrue:[
- self invalidateList.
- ^ self.
+ self invalidateList.
+ ^ self.
].
super update:something with:aParameter from:changedObject
@@ -964,13 +966,13 @@
objects := aDropContext dropObjects collect:[:obj | obj theObject].
(objects conform:[:anObject | anObject isMethod]) ifTrue:[
- |methods cls|
+ |methods cls|
- methods := objects.
- cls := self classAtTargetPointOf:aDropContext.
- cls isNil ifTrue:[^ false].
+ methods := objects.
+ cls := self classAtTargetPointOf:aDropContext.
+ cls isNil ifTrue:[^ false].
- ^ methods contains:[:aMethod | aMethod mclass ~= cls]
+ ^ methods contains:[:aMethod | aMethod mclass ~= cls]
].
(self objectsAreClassFiles:objects) ifTrue:[^ true].
^ false.
@@ -999,29 +1001,29 @@
objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(objects conform:[:something | something isMethod]) ifTrue:[
- |cls methods|
+ |cls methods|
- methods := objects.
- cls := self classAtTargetPointOf:aDropContext.
- methods first mclass isMeta ifTrue:[
- cls := cls theMetaclass
- ].
+ methods := objects.
+ cls := self classAtTargetPointOf:aDropContext.
+ methods first mclass isMeta ifTrue:[
+ cls := cls theMetaclass
+ ].
- cls notNil ifTrue:[
- methods := methods reject:[:mthd | mthd mclass theNonMetaclass == cls theNonMetaclass].
- methods notEmpty ifTrue:[
- aDropContext dragType == DropContext dragTypeCopy ifTrue:[
- browser copyMethods:methods toClass:cls.
- ] ifFalse:[
- browser moveMethods:methods toClass:cls.
- ].
- ]
- ].
- ^ self
+ cls notNil ifTrue:[
+ methods := methods reject:[:mthd | mthd mclass theNonMetaclass == cls theNonMetaclass].
+ methods notEmpty ifTrue:[
+ aDropContext dragType == DropContext dragTypeCopy ifTrue:[
+ browser copyMethods:methods toClass:cls.
+ ] ifFalse:[
+ browser moveMethods:methods toClass:cls.
+ ].
+ ]
+ ].
+ ^ self
].
(objects conform:[:something | something isFilename]) ifTrue:[
- self dropClassFiles:objects.
- ^ self
+ self dropClassFiles:objects.
+ ^ self
].
"Modified: / 21-10-2006 / 20:39:55 / cg"
@@ -1035,111 +1037,111 @@
to make the consumers only depend on one input (i.e. no need for another
classHolder in the methodList)."
- ^ Iterator
- on:[:whatToDo |
- |allEntry classes cls already anyMethod packages classIsInPackage showChanged|
+ ^ Iterator
+ on:[:whatToDo |
+ |allEntry classes cls already anyMethod packages classIsInPackage showChanged|
- allEntry := self class nameListEntryForALL.
+ allEntry := self class nameListEntryForALL.
- classes := self selectedClasses value ? #().
- packages := packageFilter value value.
- (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
- showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
+ classes := self selectedClasses value ? #().
+ packages := packageFilter value value.
+ (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
+ showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
- classes do:[:cls |
- (cls notNil and:[cls ~~ allEntry]) ifTrue:[
- anyMethod := false.
- classIsInPackage := packages isNil
- or:[(packages includes:cls package)
- or:[ showChanged and:[ChangeSet current changedClasses includes:cls]] ].
+ classes do:[:cls |
+ (cls notNil and:[cls ~~ allEntry]) ifTrue:[
+ anyMethod := false.
+ classIsInPackage := packages isNil
+ or:[(packages includes:cls package)
+ or:[ showChanged and:[ChangeSet current changedClasses includes:cls]] ].
- cls theNonMetaclass isJavaClass ifTrue:[
- cls isMeta ifTrue:[
- whatToDo value:cls theNonMetaclass value:(self class nameListEntryForStatic).
- ] ifFalse:[
- whatToDo value:cls value:(self class nameListEntryForNonStatic).
- ]
- ] ifFalse:[
- cls supportsMethodCategories ifTrue:[
- already := Set new.
- cls methodDictionary keysAndValuesDo:[:sel :mthd |
- |cat|
+ cls theNonMetaclass isJavaClass ifTrue:[
+ cls isMeta ifTrue:[
+ whatToDo value:cls theNonMetaclass value:(self class nameListEntryForStatic).
+ ] ifFalse:[
+ whatToDo value:cls value:(self class nameListEntryForNonStatic).
+ ]
+ ] ifFalse:[
+ cls supportsMethodCategories ifTrue:[
+ already := Set new.
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ |cat|
- cat := mthd category.
- (already includes:cat) ifFalse:[
- (classIsInPackage
- or:[packages isNil
- or:[packages includes:mthd package]])
- ifTrue:[
- already add:cat.
- whatToDo value:cls value:cat.
- ]
- ]
- ].
- ] ifFalse:[
- whatToDo value:cls value:(self class nameListEntryForNILCategory).
- ].
- ].
+ cat := mthd category.
+ (already includes:cat) ifFalse:[
+ (classIsInPackage
+ or:[packages isNil
+ or:[packages includes:mthd package]])
+ ifTrue:[
+ already add:cat.
+ whatToDo value:cls value:cat.
+ ]
+ ]
+ ].
+ ] ifFalse:[
+ whatToDo value:cls value:(self class nameListEntryForNILCategory).
+ ].
+ ].
- anyMethod ifFalse:[
- "/ tell the one below, which classes are seen here,
- "/ (even if no method is present)
- "/ to allow him to decide if the className is to be shown in the list
- whatToDo value:cls value:nil.
- ].
- ].
- ].
- ]
+ anyMethod ifFalse:[
+ "/ tell the one below, which classes are seen here,
+ "/ (even if no method is present)
+ "/ to allow him to decide if the className is to be shown in the list
+ whatToDo value:cls value:nil.
+ ].
+ ].
+ ].
+ ]
"Modified: / 24.2.2000 / 23:18:26 / cg"
!
makeGeneratorForMethods
- ^ Iterator
- on:[:whatToDo |
- |allEntry classes cls already packages classIsInPackage showChanged cat |
+ ^ Iterator
+ on:[:whatToDo |
+ |allEntry classes cls already packages classIsInPackage showChanged cat |
- allEntry := self class nameListEntryForALL.
+ allEntry := self class nameListEntryForALL.
- classes := self selectedClasses value ? #().
- packages := packageFilter value value.
- (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
- showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
+ classes := self selectedClasses value ? #().
+ packages := packageFilter value value.
+ (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
+ showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
- classes do:[:cls |
- (cls notNil and:[cls ~~ allEntry]) ifTrue:[
- classIsInPackage := packages isNil
- or:[(packages includes:cls package)
- or:[ showChanged and:[ChangeSet current changedClasses includes:cls]] ].
- cls isMeta ifTrue:[
- cat := self class nameListEntryForStatic.
- ] ifFalse:[
- cat := self class nameListEntryForNonStatic.
- ].
- "Handle Java classes specially, their static methods
- are in inst method dictionary..."
- cls theNonMetaclass isJavaClass ifTrue:[
- cls theNonMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
- (mthd isJavaMethod and:[mthd isStatic == cls isMeta]) ifTrue:[
- whatToDo value:cls value:cat value:sel value:mthd.
- ]
- ].
- "Plus add all possible non-Java methods (proxies, extensions)"
- cls methodDictionary keysAndValuesDo:[:sel :mthd |
- mthd isJavaMethod ifFalse:[
- whatToDo value:cls value:cat value:sel value:mthd.
- ].
- ].
- ] ifFalse:[
- cls methodDictionary keysAndValuesDo:[:sel :mthd |
- whatToDo value:cls value:cat value:sel value:mthd.
- ].
- ].
+ classes do:[:cls |
+ (cls notNil and:[cls ~~ allEntry]) ifTrue:[
+ classIsInPackage := packages isNil
+ or:[(packages includes:cls package)
+ or:[ showChanged and:[ChangeSet current changedClasses includes:cls]] ].
+ cls isMeta ifTrue:[
+ cat := self class nameListEntryForStatic.
+ ] ifFalse:[
+ cat := self class nameListEntryForNonStatic.
+ ].
+ "Handle Java classes specially, their static methods
+ are in inst method dictionary..."
+ cls theNonMetaclass isJavaClass ifTrue:[
+ cls theNonMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
+ (mthd isJavaMethod and:[mthd isStatic == cls isMeta]) ifTrue:[
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ]
+ ].
+ "Plus add all possible non-Java methods (proxies, extensions)"
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ mthd isJavaMethod ifFalse:[
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+ ].
+ ] ifFalse:[
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+ ].
- ].
- ].
- ]
+ ].
+ ].
+ ]
"Modified: / 24-02-2000 / 23:18:26 / cg"
"Created: / 07-08-2011 / 19:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1154,12 +1156,12 @@
!
updateOutputGenerator
- "create a generator which enumerates my elements,
+ "create a generator which enumerates my elements,
and place it into the outputGenerator holder"
self outGeneratorHolder value: self makeGenerator.
outGeneratorHolderForMethods notNil ifTrue:[
- outGeneratorHolderForMethods value: self makeGeneratorForMethods.
+ outGeneratorHolderForMethods value: self makeGeneratorForMethods.
].
"Modified: / 04-02-2000 / 17:16:34 / cg"
@@ -1190,17 +1192,17 @@
privateClassesPerClass nameFilterIncludesMatchCharacters lcNameFilter|
self sortByNameAndInheritance value ifTrue:[
- ^ self listOfClassesByInheritance
+ ^ self listOfClassesByInheritance
].
allName := self class nameListEntryForALL.
(self showAllClassesInNameSpaceOrganisation value) ifFalse:[
- nameSpaceFilter := self nameSpaceFilter value.
- nameSpaceFilter notNil ifTrue:[
- (nameSpaceFilter includes:allName) ifTrue:[
- nameSpaceFilter := nil
- ].
- ].
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[
+ nameSpaceFilter := nil
+ ].
+ ].
].
"/ packageFilter := self packageFilter value.
"/ packageFilter notNil ifTrue:[
@@ -1208,14 +1210,14 @@
"/ ].
inGeneratorHolder isNil ifTrue:[
- "/ for standAlone testing
- generator := Smalltalk allClasses.
- (self hideUnloadedClasses value) ifTrue:[
- generator := generator select:[:cls | cls isLoaded]
- ].
+ "/ for standAlone testing
+ generator := Smalltalk allClasses.
+ (self hideUnloadedClasses value) ifTrue:[
+ generator := generator select:[:cls | cls isLoaded]
+ ].
] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
].
classesAlready := IdentitySet new.
@@ -1226,88 +1228,88 @@
nameFilterIncludesMatchCharacters := nameFilter notNil and:[nameFilter includesMatchCharacters].
nameFilter notNil ifTrue:[ lcNameFilter := nameFilter asLowercase].
- generator do:[:cls |
- |owner bucket|
+ generator do:[:cls |
+ |owner bucket|
- "JV@2011-08-07: FIXME: Ugly code, hard to extend!! And duplicated in listOfClassesByInheritance !!!!!!!!"
- (hidePrivate not or:[cls isPrivate not])
- ifTrue:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- (classesAlready includes:cls) ifFalse:[
- (classFilterBlock isNil
- or:[(classFilterBlock value:cls)]) ifTrue:[
- classesAlready add:cls.
- (nameFilter isNil
- or:[ (nameFilterIncludesMatchCharacters not and:[ cls name asLowercase startsWith:lcNameFilter])
- or:[ (nameFilterIncludesMatchCharacters and:[nameFilter match:cls name ignoreCase:true]) ]]) ifTrue:[
- (owner := cls owningClass) notNil ifTrue:[
- bucket := privateClassesPerClass
- at:owner
- ifAbsentPut:[SortedCollection new
- sortBlock:[:a :b | (a name ? '?') < (b name ? '?')] ].
- bucket add:cls.
- ] ifFalse:[
- "Do not show Java anonymous classes"
- cls isJavaClass ifTrue:[
- cls isAnonymous ifFalse:[
- classesOrdered add:cls.
- ]
- ] ifFalse:[
- classesOrdered add:cls.
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ]
+ "JV@2011-08-07: FIXME: Ugly code, hard to extend!! And duplicated in listOfClassesByInheritance !!!!!!!!"
+ (hidePrivate not or:[cls isPrivate not])
+ ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (classesAlready includes:cls) ifFalse:[
+ (classFilterBlock isNil
+ or:[(classFilterBlock value:cls)]) ifTrue:[
+ classesAlready add:cls.
+ (nameFilter isNil
+ or:[ (nameFilterIncludesMatchCharacters not and:[ cls name asLowercase startsWith:lcNameFilter])
+ or:[ (nameFilterIncludesMatchCharacters and:[nameFilter match:cls name ignoreCase:true]) ]]) ifTrue:[
+ (owner := cls owningClass) notNil ifTrue:[
+ bucket := privateClassesPerClass
+ at:owner
+ ifAbsentPut:[SortedCollection new
+ sortBlock:[:a :b | (a name ? '?') < (b name ? '?')] ].
+ bucket add:cls.
+ ] ifFalse:[
+ "Do not show Java anonymous classes"
+ cls isJavaClass ifTrue:[
+ cls isAnonymous ifFalse:[
+ classesOrdered add:cls.
+ ]
+ ] ifFalse:[
+ classesOrdered add:cls.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
"/ are there any private classes, for which the owner is not in the list ?
privateClassesPerClass keysAndValuesDo:[:eachOwnerClass :privateClasses|
- (classesAlready includes:eachOwnerClass) ifFalse:[
- classesOrdered add:eachOwnerClass.
- classesAlready add:eachOwnerClass.
+ (classesAlready includes:eachOwnerClass) ifFalse:[
+ classesOrdered add:eachOwnerClass.
+ classesAlready add:eachOwnerClass.
"/ privateClasses do:[:privateClass |
"/ (classesOrdered includes:privateClass) ifFalse:[
"/ classesOrdered add:privateClass.
"/ ].
"/ ].
- ].
+ ].
].
classesOrdered size == 1 ifTrue:[
- self classLabelHolder value:(classesOrdered first name)
+ self classLabelHolder value:(classesOrdered first name)
] ifFalse:[
"/ self classLabelHolder value:(classes size printString , ' classes').
- sortBy value ~~ #doNotSort ifTrue:[
- classesOrdered sort:[:a :b | a name < b name].
- ]
+ sortBy value ~~ #doNotSort ifTrue:[
+ classesOrdered sort:[:a :b | a name < b name].
+ ]
].
privateClassesPerClass notEmpty ifTrue:[
- |stream action|
+ |stream action|
- stream := WriteStream on:(Array new).
+ stream := WriteStream on:(Array new).
- action :=
- [:eachClass |
- |bucket|
+ action :=
+ [:eachClass |
+ |bucket|
- stream nextPut:eachClass.
+ stream nextPut:eachClass.
- bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
- bucket notNil ifTrue:[
- bucket do:action.
- ]
- ].
+ bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
+ bucket notNil ifTrue:[
+ bucket do:action.
+ ]
+ ].
- classesOrdered do:action.
- classesOrdered := stream contents.
+ classesOrdered do:action.
+ classesOrdered := stream contents.
].
"/
@@ -1329,22 +1331,22 @@
allName := self class nameListEntryForALL.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
- (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
- (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
inGeneratorHolder isNil ifTrue:[
- "/ for standAlone testing
- generator := Smalltalk allClasses.
- (self hideUnloadedClasses value) ifTrue:[
- generator := generator select:[:cls | cls isLoaded]
- ].
+ "/ for standAlone testing
+ generator := Smalltalk allClasses.
+ (self hideUnloadedClasses value) ifTrue:[
+ generator := generator select:[:cls | cls isLoaded]
+ ].
] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
].
classesAlready := IdentitySet new.
@@ -1356,70 +1358,70 @@
nameFilterIncludesMatchCharacters := nameFilter notNil and:[nameFilter includesMatchCharacters].
nameFilter notNil ifTrue:[ lcNameFilter := nameFilter asLowercase].
- generator do:[:cls |
- |owner bucket|
+ generator do:[:cls |
+ |owner bucket|
- (hidePrivate not or:[cls isPrivate not])
- ifTrue:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- (classesAlready includes:cls) ifFalse:[
- classesAlready add:cls.
- (owner := cls owningClass) notNil ifTrue:[
- bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
- bucket add:cls.
- ] ifFalse:[
- cls isJavaClass ifTrue:[
- cls isAnonymous ifFalse:[
- classes add:cls.
- ]
- ] ifFalse:[
- classes add:cls.
- ]
- ]
- ]
- ]
- ]
- ]
+ (hidePrivate not or:[cls isPrivate not])
+ ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (classesAlready includes:cls) ifFalse:[
+ classesAlready add:cls.
+ (owner := cls owningClass) notNil ifTrue:[
+ bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
+ bucket add:cls.
+ ] ifFalse:[
+ cls isJavaClass ifTrue:[
+ cls isAnonymous ifFalse:[
+ classes add:cls.
+ ]
+ ] ifFalse:[
+ classes add:cls.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
privateClassesPerClass keysAndValuesDo:
- [:owner :privateClasses|
- (owner isPrivate not and:[(classes includes: owner) not])
- ifTrue:[classes addAll: privateClasses]].
+ [:owner :privateClasses|
+ (owner isPrivate not and:[(classes includes: owner) not])
+ ifTrue:[classes addAll: privateClasses]].
classes size == 1 ifTrue:[
- classesOrdered := classes asArray.
- self classLabelHolder value:(classes first name)
+ classesOrdered := classes asArray.
+ self classLabelHolder value:(classes first name)
] ifFalse:[
"/ self classLabelHolder value:(classes size printString , ' classes').
" sortBy value ~~ #doNotSort ifTrue:[
- classesOrdered sort:[:a :b | a name < b name].
- ]"
- classesOrdered := ClassSorter sort: classes.
+ classesOrdered sort:[:a :b | a name < b name].
+ ]"
+ classesOrdered := ClassSorter sort: classes.
].
privateClassesPerClass notEmpty ifTrue:[
- |stream action|
+ |stream action|
- stream := WriteStream on:(Array new).
+ stream := WriteStream on:(Array new).
- action := [:eachClass |
- |bucket|
+ action := [:eachClass |
+ |bucket|
- stream nextPut:eachClass.
+ stream nextPut:eachClass.
- bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
- bucket notNil ifTrue:[
- bucket do:action.
- ]
- ].
+ bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
+ bucket notNil ifTrue:[
+ bucket do:action.
+ ]
+ ].
- classesOrdered do:action.
- classesOrdered := stream contents.
+ classesOrdered do:action.
+ classesOrdered := stream contents.
].
"/
@@ -1454,29 +1456,29 @@
showNamespaces := false.
filteredNameSpaces := nameSpaceFilter value.
- (filteredNameSpaces isNil
+ (filteredNameSpaces isNil
and:[self organizerMode value ~~ OrganizerCanvas organizerModeNamespace]) ifTrue:[
- showNamespaces := true. "/ if no filter, always show the namespace.
+ showNamespaces := true. "/ if no filter, always show the namespace.
] ifFalse:[
- (filteredNameSpaces size > 1
- or:[(filteredNameSpaces size > 0)
- and:[filteredNameSpaces includes:(self class nameListEntryForALL)]]) ifTrue:[
- showNamespaces := true
- ] ifFalse:[
- "/ if there are classes from multiple namespaces,
- "/ show the full name
+ (filteredNameSpaces size > 1
+ or:[(filteredNameSpaces size > 0)
+ and:[filteredNameSpaces includes:(self class nameListEntryForALL)]]) ifTrue:[
+ showNamespaces := true
+ ] ifFalse:[
+ "/ if there are classes from multiple namespaces,
+ "/ show the full name
- namespaces := IdentitySet new.
- fullNameList := OrderedCollection new.
+ namespaces := IdentitySet new.
+ fullNameList := OrderedCollection new.
- aClassList
- do:[:cls | |nm|
- nm := cls nameInBrowser.
- fullNameList add:nm.
- namespaces add:cls topNameSpace.
- ].
- showNamespaces := namespaces size > 1
- ].
+ aClassList
+ do:[:cls | |nm|
+ nm := cls nameInBrowser.
+ fullNameList add:nm.
+ namespaces add:cls topNameSpace.
+ ].
+ showNamespaces := namespaces size > 1
+ ].
].
orgMode := organizerMode value.
@@ -1490,93 +1492,93 @@
classesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass].
classNamesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each name].
- nameList := aClassList
- collect:[:cls |
+ nameList := aClassList
+ collect:[:cls |
- |nm pkg emPkg hasExtensions isInChangeSet isInRemoteChangeSet icon
- clr|
+ |nm pkg emPkg hasExtensions isInChangeSet isInRemoteChangeSet icon
+ clr|
- isInChangeSet := classNamesInChangeSet includes:(cls theNonMetaclass name).
- isInRemoteChangeSet := classNamesInRemoteChangeSet includes:(cls theNonMetaclass name).
+ isInChangeSet := classNamesInChangeSet includes:(cls theNonMetaclass name).
+ isInRemoteChangeSet := classNamesInRemoteChangeSet includes:(cls theNonMetaclass name).
- nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
+ nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
- self showCoverageInformation value ifTrue:[
- clr := self colorForCoverageInformationOfClass:cls.
- clr notNil ifTrue:[
- nm := self colorize:nm with:#color -> clr
- ].
- ] ifFalse:[
- isInChangeSet ifTrue:[
- nm := self emphasizeForChangedCode:nm
- ].
- isInRemoteChangeSet ifTrue:[
- nm := (self colorizeForChangedCodeInSmallTeam:'!! '),nm
- ].
- ].
+ self showCoverageInformation value ifTrue:[
+ clr := self colorForCoverageInformationOfClass:cls.
+ clr notNil ifTrue:[
+ nm := self colorize:nm with:#color -> clr
+ ].
+ ] ifFalse:[
+ isInChangeSet ifTrue:[
+ nm := self emphasizeForChangedCode:nm
+ ].
+ isInRemoteChangeSet ifTrue:[
+ nm := (self colorizeForChangedCodeInSmallTeam:'!! '),nm
+ ].
+ ].
- pkg := cls package ? '-'.
- hasExtensions := cls hasExtensions.
- hasExtensions ifTrue:[
- emPkg := self emphasizeForDifferentPackage:'+'. "/ self emphasizeForDifferentPackage:pkg.
- ].
+ pkg := cls package ? '-'.
+ hasExtensions := cls hasExtensions.
+ hasExtensions ifTrue:[
+ emPkg := self emphasizeForDifferentPackage:'+'. "/ self emphasizeForDifferentPackage:pkg.
+ ].
- orgMode == OrganizerCanvas organizerModeProject ifTrue:[
- (filteredPackages notNil
- and:[(filteredPackages includes:cls package) not]) ifTrue:[
- "/ class is in another packae;
- "/ however, class is listed due to methods
- "/ in the filtered package
- hasExtensions ifTrue:[
- nm := nm , emPkg.
- ] ifFalse:[
- nm := nm , ' [ ' , pkg, ' ]'.
- ].
- ] ifFalse:[
- "/ any methods from other packages in this class ?
- hasExtensions ifTrue:[
- nm := nm , (self emphasizeForDifferentPackage:'+').
- ].
- ].
- ] ifFalse:[
- showClassPackages value == true ifTrue:[
- "/ add the package;
- hasExtensions ifTrue:[
- nm := nm , ' [ ' , pkg, ' ]' , (self emphasizeForDifferentPackage:'+').
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ (filteredPackages notNil
+ and:[(filteredPackages includes:cls package) not]) ifTrue:[
+ "/ class is in another packae;
+ "/ however, class is listed due to methods
+ "/ in the filtered package
+ hasExtensions ifTrue:[
+ nm := nm , emPkg.
+ ] ifFalse:[
+ nm := nm , ' [ ' , pkg, ' ]'.
+ ].
+ ] ifFalse:[
+ "/ any methods from other packages in this class ?
+ hasExtensions ifTrue:[
+ nm := nm , (self emphasizeForDifferentPackage:'+').
+ ].
+ ].
+ ] ifFalse:[
+ showClassPackages value == true ifTrue:[
+ "/ add the package;
+ hasExtensions ifTrue:[
+ nm := nm , ' [ ' , pkg, ' ]' , (self emphasizeForDifferentPackage:'+').
"/ isInChangeSet ifFalse:[
"/ nm := self colorizeForDifferentPackage:nm
"/ ].
- ] ifFalse:[
- nm := nm , (self colorizeGrey:(' [ ' , pkg, ' ]')).
- ].
- ] ifFalse:[
- hasExtensions ifTrue:[
- nm := nm , emPkg.
+ ] ifFalse:[
+ nm := nm , (self colorizeGrey:(' [ ' , pkg, ' ]')).
+ ].
+ ] ifFalse:[
+ hasExtensions ifTrue:[
+ nm := nm , emPkg.
"/ isInChangeSet ifFalse:[
"/ nm := self colorizeForDifferentPackage:nm
"/ ]
- ].
- ]
- ].
+ ].
+ ]
+ ].
- isInChangeSet ifTrue:[
- nm := nm , self class markForBeingInChangeList
- ].
+ isInChangeSet ifTrue:[
+ nm := nm , self class markForBeingInChangeList
+ ].
"/ cls isVisualStartable ifTrue:[
"/ nm := LabelAndIcon icon:((SystemBrowser visualStartableClassIcon)
"/ onDevice:self window device)
"/ string:nm
"/ ].
- markApplicationsHolder value== true ifTrue:[
- icon := self iconForClass:cls theNonMetaclass.
- icon isNil ifTrue:[
- icon := SystemBrowser emptyIcon
- ].
- nm := LabelAndIcon icon:icon string:nm
+ markApplicationsHolder value== true ifTrue:[
+ icon := self iconForClass:cls theNonMetaclass.
+ icon isNil ifTrue:[
+ icon := SystemBrowser emptyIcon
+ ].
+ nm := LabelAndIcon icon:icon string:nm
- ].
- nm
- ].
+ ].
+ nm
+ ].
^ nameList
@@ -1589,24 +1591,24 @@
indent := 0.
indentString := ''.
cls := aClass superclass.
- [self classList value includesIdentical:cls]
- whileTrue:
- [indent := indent + 1.
- cls := cls superclass].
+ [self classList value includesIdentical:cls]
+ whileTrue:
+ [indent := indent + 1.
+ cls := cls superclass].
indent == 0 ifFalse:[
- indent <= 5 ifTrue:[
- indentString := #(
- ''
- ' '
- ' '
- ' '
- ' '
- ' '
- ) at:indent+1.
- ] ifFalse:[
- indentString := String new:indent*2 withAll:Character space.
- ].
+ indent <= 5 ifTrue:[
+ indentString := #(
+ ''
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ ) at:indent+1.
+ ] ifFalse:[
+ indentString := String new:indent*2 withAll:Character space.
+ ].
].
^indentString
@@ -1623,47 +1625,47 @@
|prevMode listView oldNameList newNameList sav|
self classList value isNil ifTrue:[
- self updateList
+ self updateList
].
newNameList := self nameListForClasses:(classList value ? #()).
oldNameList := self classNameList value ? #().
- (newNameList
- sameContentsAs: oldNameList
- whenComparedWith:[:a :b | (a sameStringAndEmphasisAs: b)
- and:[ a hasImage == b hasImage
- and:[ a hasIcon == b hasIcon ]]]
- )
+ (newNameList
+ sameContentsAs: oldNameList
+ whenComparedWith:[:a :b | (a sameStringAndEmphasisAs: b)
+ and:[ a hasImage == b hasImage
+ and:[ a hasIcon == b hasIcon ]]]
+ )
ifTrue:[
- "/ no need to update
+ "/ no need to update
] ifFalse:[
- builder notNil ifTrue:[
- listView := builder componentAt:#List.
- ].
- (listView isNil or:[listView scrolledView isNil]) ifTrue:[
- "/ invoked very early during setup
- self classNameList value:newNameList
- ] ifFalse:[
- "/ avoid flicker and useless redraws
+ builder notNil ifTrue:[
+ listView := builder componentAt:#List.
+ ].
+ (listView isNil or:[listView scrolledView isNil]) ifTrue:[
+ "/ invoked very early during setup
+ self classNameList value:newNameList
+ ] ifFalse:[
+ "/ avoid flicker and useless redraws
- prevMode := listView scrollWhenUpdating.
- listView scrollWhenUpdating:nil.
+ prevMode := listView scrollWhenUpdating.
+ listView scrollWhenUpdating:nil.
- "/ this will lead to a selectionIndex change (done by the selListView);
- "/ however, we dont want this here, since it recurses into
- "/ a selectionChange. Therefore, temporarily disconnect the selectionIndexHolder...
- [
- self selectedClassNameIndices removeDependent:self.
- "/ also, dont want a callback (selectionChangedByClick)
- sav := listView action.
- listView action:nil.
- self classNameList value:newNameList.
- ] ensure:[
- listView action:sav.
- self selectedClassNameIndices addDependent:self.
- listView scrollWhenUpdating:prevMode.
- ].
- ]
+ "/ this will lead to a selectionIndex change (done by the selListView);
+ "/ however, we dont want this here, since it recurses into
+ "/ a selectionChange. Therefore, temporarily disconnect the selectionIndexHolder...
+ [
+ self selectedClassNameIndices removeDependent:self.
+ "/ also, dont want a callback (selectionChangedByClick)
+ sav := listView action.
+ listView action:nil.
+ self classNameList value:newNameList.
+ ] ensure:[
+ listView action:sav.
+ self selectedClassNameIndices addDependent:self.
+ listView scrollWhenUpdating:prevMode.
+ ].
+ ]
].
"Modified: / 31.10.2001 / 11:33:21 / cg"
@@ -1718,7 +1720,7 @@
!
updateList
- |prevSelection oldList newList newSelectionIndices
+ |prevSelection oldList newList newSelectionIndices
forceSelectionChange selectedClassNameIndicesHolder classList
classesAddedToList classesRemovedFromList newSet oldSet|
@@ -1727,87 +1729,87 @@
oldList := classList value ? #().
autoSelect == true ifTrue:[
- classesRemovedFromList := OrderedCollection new.
- newSet := newList asSet.
- oldSet := oldList asSet.
- classesAddedToList := newSet select:[:eachNewClass | (oldSet includes:eachNewClass) not].
- classesRemovedFromList := oldSet select:[:eachOldClass | (newSet includes:eachOldClass) not].
+ classesRemovedFromList := OrderedCollection new.
+ newSet := newList asSet.
+ oldSet := oldList asSet.
+ classesAddedToList := newSet select:[:eachNewClass | (oldSet includes:eachNewClass) not].
+ classesRemovedFromList := oldSet select:[:eachOldClass | (newSet includes:eachOldClass) not].
].
(newList ~= oldList
or:[self classNameList value isNil and:[newList size > 0]]) ifTrue:[
- prevSelection := lastSelectedClasses ? #().
- prevSelection := prevSelection select:[:each | each notNil].
+ prevSelection := lastSelectedClasses ? #().
+ prevSelection := prevSelection select:[:each | each notNil].
- (newList collect:[:each | each name]) = (oldList collect:[:each | each name]) ifTrue:[
- "/ no need to tell anybody
- classList setValue:newList.
- ] ifFalse:[
- classList value:newList.
- ].
- self reconstructNameList.
+ (newList collect:[:each | each name]) = (oldList collect:[:each | each name]) ifTrue:[
+ "/ no need to tell anybody
+ classList setValue:newList.
+ ] ifFalse:[
+ classList value:newList.
+ ].
+ self reconstructNameList.
- (prevSelection size == 0
- and:[self selectedClasses value size ~~ 0]) ifTrue:[
- "/ this happens during early startup time,
- "/ when the selection is already (pre-)set,
- "/ and the classList is generated the first time
- "/ (i.e. when opened with preset selection)
+ (prevSelection size == 0
+ and:[self selectedClasses value size ~~ 0]) ifTrue:[
+ "/ this happens during early startup time,
+ "/ when the selection is already (pre-)set,
+ "/ and the classList is generated the first time
+ "/ (i.e. when opened with preset selection)
- "/ do not clobber the selection in this case.
- prevSelection := self selectedClasses value.
- prevSelection := prevSelection select:[:cls | cls notNil].
- "/ simulate a change, to force selection update in listView
- forceSelectionChange := true.
- ].
+ "/ do not clobber the selection in this case.
+ prevSelection := self selectedClasses value.
+ prevSelection := prevSelection select:[:cls | cls notNil].
+ "/ simulate a change, to force selection update in listView
+ forceSelectionChange := true.
+ ].
- autoSelect == true ifTrue:[
- prevSelection isNil ifTrue:[
- prevSelection := OrderedCollection new
- ].
- prevSelection := prevSelection asOrderedCollection.
+ autoSelect == true ifTrue:[
+ prevSelection isNil ifTrue:[
+ prevSelection := OrderedCollection new
+ ].
+ prevSelection := prevSelection asOrderedCollection.
- classesAddedToList do:[:eachNewClass |
- (prevSelection includes:eachNewClass) ifFalse:[
- prevSelection add:eachNewClass.
- ].
- ].
- classesRemovedFromList do:[:eachOldClass |
- prevSelection remove:eachOldClass ifAbsent:[].
- ].
- ].
+ classesAddedToList do:[:eachNewClass |
+ (prevSelection includes:eachNewClass) ifFalse:[
+ prevSelection add:eachNewClass.
+ ].
+ ].
+ classesRemovedFromList do:[:eachOldClass |
+ prevSelection remove:eachOldClass ifAbsent:[].
+ ].
+ ].
- newSelectionIndices := prevSelection
- collect:[:item | |cls|
- cls := Smalltalk at:item theNonMetaclass name.
- newList identityIndexOf:cls]
- thenSelect:[:index | index ~~ 0].
+ newSelectionIndices := prevSelection
+ collect:[:item | |cls|
+ cls := Smalltalk at:item theNonMetaclass name.
+ newList identityIndexOf:cls]
+ thenSelect:[:index | index ~~ 0].
- selectedClassNameIndicesHolder := self selectedClassNameIndices.
+ selectedClassNameIndicesHolder := self selectedClassNameIndices.
- ((selectedClassNameIndicesHolder value size ~~ self selectedClasses value size)
- or:[newSelectionIndices ~= selectedClassNameIndicesHolder value])
- ifTrue:[
- newSelectionIndices notEmpty ifTrue:[
- "/ force change (for dependents)
- "/ selectedClassNameIndicesHolder value:newSelectionIndices.
- ] ifFalse:[
- prevSelection := self selectedClasses value.
- newSelectionIndices := #().
- ].
- selectedClassNameIndicesHolder value:newSelectionIndices.
+ ((selectedClassNameIndicesHolder value size ~~ self selectedClasses value size)
+ or:[newSelectionIndices ~= selectedClassNameIndicesHolder value])
+ ifTrue:[
+ newSelectionIndices notEmpty ifTrue:[
+ "/ force change (for dependents)
+ "/ selectedClassNameIndicesHolder value:newSelectionIndices.
+ ] ifFalse:[
+ prevSelection := self selectedClasses value.
+ newSelectionIndices := #().
+ ].
+ selectedClassNameIndicesHolder value:newSelectionIndices.
- prevSelection notNil ifTrue:[
- lastSelectedClasses := prevSelection.
- ].
- self updateOutputGenerator.
- ].
+ prevSelection notNil ifTrue:[
+ lastSelectedClasses := prevSelection.
+ ].
+ self updateOutputGenerator.
+ ].
] ifFalse:[
- "/ same classes - but name(s) could be differnet
- newList size > 0 ifTrue:[
- self reconstructNameList
- ]
+ "/ same classes - but name(s) could be differnet
+ newList size > 0 ifTrue:[
+ self reconstructNameList
+ ]
].
listValid := true.
@@ -1822,59 +1824,59 @@
"/ update for a changed class in the classList
(classes := classList value) size > 0 ifTrue:[
- (self updateClassesIn:classes) ifTrue:[
- found := true
- ].
- (classes includes:nil) ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
"/ self halt:'should not happen'.
- classList value:(classes := classes select:[:each | each notNil]).
- ].
+ classList value:(classes := classes select:[:each | each notNil]).
+ ].
].
"/ possibly in the generator
- ((classes := inGeneratorHolder value) isOrderedCollection
+ ((classes := inGeneratorHolder value) isOrderedCollection
and:[classes size > 0]) ifTrue:[
- (self updateClassesIn:classes) ifTrue:[
- found := true
- ].
- (classes includes:nil) ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
"/ self halt:'should not happen'.
- inGeneratorHolder value:(classes select:[:each | each notNil]).
- ]
+ inGeneratorHolder value:(classes select:[:each | each notNil]).
+ ]
].
"/ and in the selection
(classes := self selectedClasses value) size > 0 ifTrue:[
- (self updateClassesIn:classes) ifTrue:[
- found := true.
- foundInSelection := true.
- ].
- (classes includes:nil) ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true.
+ foundInSelection := true.
+ ].
+ (classes includes:nil) ifTrue:[
"/ self halt:'should not happen'.
- self selectedClasses value:(classes select:[:each | each notNil]).
- ]
+ self selectedClasses value:(classes select:[:each | each notNil]).
+ ]
].
"/ and in the last selection
(classes := lastSelectedClasses) size > 0 ifTrue:[
- (self updateClassesIn:classes) ifTrue:[
- found := true
- ].
- (classes includes:nil) ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
"/ self halt:'should not happen'.
- lastSelectedClasses := (classes select:[:each | each notNil]).
- ]
+ lastSelectedClasses := (classes select:[:each | each notNil]).
+ ]
].
found ifFalse:[
- "/ could be a new class (or no-longer autolaoded one).
- listValid ifTrue:[
- self enqueueDelayedUpdateList.
- ].
+ "/ could be a new class (or no-longer autolaoded one).
+ listValid ifTrue:[
+ self enqueueDelayedUpdateList.
+ ].
].
foundInSelection ifTrue:[
- "/ force update of output generator
- self selectedClasses
- removeDependent:self;
- changed;
- addDependent:self.
+ "/ force update of output generator
+ self selectedClasses
+ removeDependent:self;
+ changed;
+ addDependent:self.
].
"Modified: / 05-06-2012 / 23:39:25 / cg"
@@ -1887,21 +1889,21 @@
instrumented := anyPartiallyCovered := anyCalled := anyNotCalled := false.
aClass instAndClassMethodsDo:[:m |
- m category = 'documentation' ifFalse:[
- m isInstrumented ifTrue:[
- instrumented := true.
- m hasBeenCalled ifFalse:[
- anyNotCalled := true.
- ] ifTrue:[
- anyCalled := true.
- m haveAllBlocksBeenExecuted ifFalse:[
- anyPartiallyCovered := true.
- "/ no need to search further...
- ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
- ]
- ].
- ].
- ].
+ m category = 'documentation' ifFalse:[
+ m isInstrumented ifTrue:[
+ instrumented := true.
+ m hasBeenCalled ifFalse:[
+ anyNotCalled := true.
+ ] ifTrue:[
+ anyCalled := true.
+ m haveAllBlocksBeenExecuted ifFalse:[
+ anyPartiallyCovered := true.
+ "/ no need to search further...
+ ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
+ ]
+ ].
+ ].
+ ].
].
instrumented ifFalse:[ ^ nil].
@@ -1930,63 +1932,63 @@
sortByNameAndInheritance := self sortByNameAndInheritance value.
sortByNameAndInheritance ifTrue:[
- nm := (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameInBrowser.
+ nm := (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameInBrowser.
] ifFalse:[
- nm := aClass nameInBrowser.
+ nm := aClass nameInBrowser.
].
aClass isLoaded ifFalse:[
- unloadedClassesColor notNil ifTrue:[
- nm := nm colorizeAllWith:unloadedClassesColor
- ]
+ unloadedClassesColor notNil ifTrue:[
+ nm := nm colorizeAllWith:unloadedClassesColor
+ ]
].
orgMode := organizerMode value.
orgMode == OrganizerCanvas organizerModeHierarchy ifTrue:[
- "/ always show the full name
- ^ nm
+ "/ always show the full name
+ ^ nm
].
orgMode == OrganizerCanvas organizerModeClassHierarchy ifTrue:[
- "/ always show the full name
- ^ nm
+ "/ always show the full name
+ ^ nm
].
aClass isJavaClass ifTrue:[
- "/ only show the last name, unless multiple packages are shown in the list
- javaPackage := aClass package.
- (self classList value contains:[:cls | cls package ~= javaPackage]) ifTrue:[
- ^ nm
- ].
- ^ aClass lastName
+ "/ only show the last name, unless multiple packages are shown in the list
+ javaPackage := aClass package.
+ (self classList value contains:[:cls | cls package ~= javaPackage]) ifTrue:[
+ ^ nm
+ ].
+ ^ aClass lastName
].
useFullName ifFalse:[
- aClass isPrivate ifFalse:[
- sortByNameAndInheritance ifTrue:[
- ^ (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameWithoutNameSpacePrefix
- ].
- ^ aClass nameWithoutNameSpacePrefix
- ]
+ aClass isPrivate ifFalse:[
+ sortByNameAndInheritance ifTrue:[
+ ^ (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameWithoutNameSpacePrefix
+ ].
+ ^ aClass nameWithoutNameSpacePrefix
+ ]
].
"/ full name required if owner is not in the list
owner := aClass owningClass.
(owner isNil
or:[(self classList value includesIdentical:owner) not]) ifTrue:[
- ^ nm
+ ^ nm
].
"/ namespace
indent := (nm count:[:char | char == $:]) // 2.
indent > 0 ifTrue:[
- indent := indent * self indentPerPrivacyLevel.
- indentString := String new:indent withAll:Character space.
- sortByNameAndInheritance ifTrue:[
- nm := (self nameListIndentStringFor:owner withNameSpace:useFullName)
- , indentString , '::' , aClass nameWithoutPrefix.
- ] ifFalse:[
- nm := indentString , '::' , aClass nameWithoutPrefix
- ]
+ indent := indent * self indentPerPrivacyLevel.
+ indentString := String new:indent withAll:Character space.
+ sortByNameAndInheritance ifTrue:[
+ nm := (self nameListIndentStringFor:owner withNameSpace:useFullName)
+ , indentString , '::' , aClass nameWithoutPrefix.
+ ] ifFalse:[
+ nm := indentString , '::' , aClass nameWithoutPrefix
+ ]
].
^ nm
@@ -2006,8 +2008,8 @@
autoSelect:aBoolean
autoSelect ~~ aBoolean ifTrue:[
- autoSelect := aBoolean.
- classList value:nil.
+ autoSelect := aBoolean.
+ classList value:nil.
].
!
@@ -2025,7 +2027,7 @@
classListView := aBuilder componentAt:'List'.
classListView notNil ifTrue:[
classListView allowDrag:true.
- classListView dragObjectConverter:[:obj |
+ classListView dragObjectConverter:[:obj |
|nm class idx|
nm := obj theObject asString.
@@ -2050,5 +2052,5 @@
!
version_SVN
- ^ '$Id: Tools__ClassList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__ClassList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
! !
--- a/Tools__MethodCategoryList.st Tue Oct 02 11:36:39 2012 +0100
+++ b/Tools__MethodCategoryList.st Wed Oct 03 23:28:49 2012 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -47,7 +47,7 @@
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -97,31 +97,31 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #singleProtocolWindowSpec
- #window:
+ #name: #singleProtocolWindowSpec
+ #window:
#(#WindowSpec
- #label: 'ProtocolList'
- #name: 'ProtocolList'
- #min: #(#Point 0 0)
- #max: #(#Point 1024 721)
- #bounds: #(#Rectangle 12 22 312 322)
- )
- #component:
+ #label: 'ProtocolList'
+ #name: 'ProtocolList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#LabelSpec
- #label: 'ProtocolName'
- #name: 'ProtocolLabel'
- #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
- #translateLabel: true
- #labelChannel: #protocolLabelHolder
- #menu: #menuHolder
- )
- )
-
- )
+ #collection: #(
+ #(#LabelSpec
+ #label: 'ProtocolName'
+ #name: 'ProtocolLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #protocolLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
)
!
@@ -140,44 +140,44 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #windowSpec
- #window:
+ #name: #windowSpec
+ #window:
#(#WindowSpec
- #label: 'ProtocolList'
- #name: 'ProtocolList'
- #min: #(#Point 0 0)
- #bounds: #(#Rectangle 16 46 316 346)
- )
- #component:
+ #label: 'ProtocolList'
+ #name: 'ProtocolList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 16 46 316 346)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#SequenceViewSpec
- #name: 'List'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #tabable: true
- #model: #selectedProtocolIndices
- #menu: #menuHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isMultiSelect: true
- #valueChangeSelector: #selectionChangedByClick
- #useIndex: true
- #sequenceList: #protocolList
- #doubleClickChannel: #doubleClickChannel
- #properties:
- #(#PropertyListDictionary
- #dragArgument: nil
- #dropArgument: nil
- #canDropSelector: #canDropContext:
- #dropSelector: #doDropContext:
- )
- )
- )
-
- )
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectedProtocolIndices
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #protocolList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
)
! !
@@ -195,23 +195,23 @@
(if this app is embedded in a subCanvas)."
^ #(
- #(#doubleClickChannel #action )
- #filterClassVars
- #forceGeneratorTrigger
- #immediateUpdate
- #inGeneratorHolder
- #menuHolder
- #noAllItem
- #showPseudoProtocols
- #outGeneratorHolder
- #packageFilter
- #packageFilterOnInput
- #selectedProtocols
- #selectionChangeCondition
- #updateTrigger
- #variableFilter
- #methodVisibilityHolder
- #showCoverageInformation
+ #(#doubleClickChannel #action )
+ #filterClassVars
+ #forceGeneratorTrigger
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #noAllItem
+ #showPseudoProtocols
+ #outGeneratorHolder
+ #packageFilter
+ #packageFilterOnInput
+ #selectedProtocols
+ #selectionChangeCondition
+ #updateTrigger
+ #variableFilter
+ #methodVisibilityHolder
+ #showCoverageInformation
).
"Modified: / 27-04-2010 / 16:40:39 / cg"
@@ -220,7 +220,7 @@
!MethodCategoryList methodsFor:'aspects'!
browserNameList
- ^ self protocolList
+ ^ self protocolList
!
defaultSlaveModeValue
@@ -229,8 +229,8 @@
filterClassVars
filterClassVars isNil ifTrue:[
- filterClassVars := false asValue.
- filterClassVars addDependent:self
+ filterClassVars := false asValue.
+ filterClassVars addDependent:self
].
^ filterClassVars
@@ -240,11 +240,11 @@
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
- filterClassVars removeDependent:self
+ filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
- filterClassVars addDependent:self
+ filterClassVars addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -253,19 +253,19 @@
methodVisibilityHolder
methodVisibilityHolder isNil ifTrue:[
- methodVisibilityHolder := false asValue.
- methodVisibilityHolder addDependent:self
+ methodVisibilityHolder := false asValue.
+ methodVisibilityHolder addDependent:self
].
^ methodVisibilityHolder
!
methodVisibilityHolder:aValueHolder
methodVisibilityHolder notNil ifTrue:[
- methodVisibilityHolder removeDependent:self
+ methodVisibilityHolder removeDependent:self
].
methodVisibilityHolder := aValueHolder.
methodVisibilityHolder notNil ifTrue:[
- methodVisibilityHolder addDependent:self
+ methodVisibilityHolder addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -274,26 +274,26 @@
noAllItem
noAllItem isNil ifTrue:[
- noAllItem := false asValue.
- noAllItem addDependent:self
+ noAllItem := false asValue.
+ noAllItem addDependent:self
].
^ noAllItem
!
noAllItem:aValueHolder
noAllItem notNil ifTrue:[
- noAllItem removeDependent:self
+ noAllItem removeDependent:self
].
noAllItem := aValueHolder.
noAllItem notNil ifTrue:[
- noAllItem addDependent:self
+ noAllItem addDependent:self
].
!
packageFilterOnInput
packageFilterOnInput isNil ifTrue:[
- packageFilterOnInput := nil asValue.
- packageFilterOnInput addDependent:self
+ packageFilterOnInput := nil asValue.
+ packageFilterOnInput addDependent:self
].
^ packageFilterOnInput
!
@@ -303,14 +303,14 @@
prevFilter := packageFilterOnInput value.
packageFilterOnInput notNil ifTrue:[
- packageFilterOnInput removeDependent:self
+ packageFilterOnInput removeDependent:self
].
packageFilterOnInput := aValueHolder.
packageFilterOnInput notNil ifTrue:[
- packageFilterOnInput addDependent:self
+ packageFilterOnInput addDependent:self
].
prevFilter ~= packageFilterOnInput value ifTrue:[
- self enqueueDelayedUpdateList
+ self enqueueDelayedUpdateList
].
!
@@ -320,7 +320,7 @@
protocolList
protocolList isNil ifTrue:[
- protocolList := List new. "/ ValueHolder new
+ protocolList := List new. "/ ValueHolder new
].
^ protocolList
@@ -330,15 +330,15 @@
rawProtocolList
rawProtocolList isNil ifTrue:[
- rawProtocolList := List new.
+ rawProtocolList := List new.
].
^ rawProtocolList
!
selectedProtocolIndices
selectedProtocolIndices isNil ifTrue:[
- selectedProtocolIndices := ValueHolder new.
- selectedProtocolIndices addDependent:self
+ selectedProtocolIndices := ValueHolder new.
+ selectedProtocolIndices addDependent:self
].
^ selectedProtocolIndices.
!
@@ -353,26 +353,26 @@
showPseudoProtocols
showPseudoProtocols isNil ifTrue:[
- showPseudoProtocols := true asValue.
- showPseudoProtocols addDependent:self
+ showPseudoProtocols := true asValue.
+ showPseudoProtocols addDependent:self
].
^ showPseudoProtocols
!
showPseudoProtocols:aValueHolder
showPseudoProtocols notNil ifTrue:[
- showPseudoProtocols removeDependent:self
+ showPseudoProtocols removeDependent:self
].
showPseudoProtocols := aValueHolder.
showPseudoProtocols notNil ifTrue:[
- showPseudoProtocols addDependent:self
+ showPseudoProtocols addDependent:self
].
!
variableFilter
variableFilter isNil ifTrue:[
- variableFilter := false asValue.
- variableFilter addDependent:self
+ variableFilter := false asValue.
+ variableFilter addDependent:self
].
^ variableFilter
@@ -382,11 +382,11 @@
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
- variableFilter removeDependent:self
+ variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
- variableFilter addDependent:self
+ variableFilter addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -399,31 +399,31 @@
|refetch anyChange|
anyChange := false.
- refetch := [:oldClass |
- |nm cls newClass|
+ refetch := [:oldClass |
+ |nm cls newClass|
- nm := oldClass theNonMetaclass name.
- oldClass isMeta ifTrue:[
- newClass := Smalltalk at:nm.
- newClass isNil ifTrue:[
- "/ Transcript showCR:'oops - browser lost class ' , nm.
- newClass := oldClass
- ] ifFalse:[
- newClass := newClass theMetaclass
- ]
- ] ifFalse:[
- newClass := Smalltalk at:nm
- ].
- newClass ~~ oldClass ifTrue:[
- anyChange := true.
- ].
- newClass
- ].
+ nm := oldClass theNonMetaclass name.
+ oldClass isMeta ifTrue:[
+ newClass := Smalltalk at:nm.
+ newClass isNil ifTrue:[
+ "/ Transcript showCR:'oops - browser lost class ' , nm.
+ newClass := oldClass
+ ] ifFalse:[
+ newClass := newClass theMetaclass
+ ]
+ ] ifFalse:[
+ newClass := Smalltalk at:nm
+ ].
+ newClass ~~ oldClass ifTrue:[
+ anyChange := true.
+ ].
+ newClass
+ ].
classes := classes collect:refetch.
leafClasses := leafClasses collect:refetch.
anyChange ifTrue:[
- self updateOutputGenerator
+ self updateOutputGenerator
].
"Modified: / 06-07-2011 / 11:44:13 / cg"
@@ -437,220 +437,220 @@
rawProtocolListHolder := self rawProtocolList.
changedObject == Smalltalk ifTrue:[
- classes notNil ifTrue:[
- something == #methodCategory ifTrue:[
- cls := aParameter at:1.
- (cls notNil and:[classes includesIdentical:cls]) ifTrue:[
- mthd := aParameter at:2.
- newProtocol := mthd category.
- oldProtocol := aParameter at:3.
+ classes notNil ifTrue:[
+ something == #methodCategory ifTrue:[
+ cls := aParameter at:1.
+ (cls notNil and:[classes includesIdentical:cls]) ifTrue:[
+ mthd := aParameter at:2.
+ newProtocol := mthd category.
+ oldProtocol := aParameter at:3.
- listValid == true ifTrue:[ self invalidateList ].
+ listValid == true ifTrue:[ self invalidateList ].
- selectedCategories := selectedProtocolsHolder value.
- selectedCategories size > 0 ifTrue:[
- selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
- selectedCategories := selectedCategories collect:[:each | each string].
+ selectedCategories := selectedProtocolsHolder value.
+ selectedCategories size > 0 ifTrue:[
+ selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
+ selectedCategories := selectedCategories collect:[:each | each string].
- ((selectedCategories includes:oldProtocol)
- or:[ (selectedCategories includes:newProtocol)
- or:[ selectedCategories includes:(self class nameListEntryForALL) ]])
- ifTrue:[
- self enqueueDelayedUpdateOutputGenerator "/ updateOutputGenerator.
- ].
- ].
+ ((selectedCategories includes:oldProtocol)
+ or:[ (selectedCategories includes:newProtocol)
+ or:[ selectedCategories includes:(self class nameListEntryForALL) ]])
+ ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator "/ updateOutputGenerator.
+ ].
+ ].
- ].
- ^ self
- ].
+ ].
+ ^ self
+ ].
- something == #methodInClass ifTrue:[
- "/ a method has been added/removed/changed
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- self flushMethodInfoForClassNamed:cls name selector:sel.
- oldMethod := aParameter at:3.
- newMethod := cls compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- variableFilter value size > 0 ifTrue:[
- "/ sigh - must invalidate
- listValid == true ifTrue:[ self invalidateList ].
- ].
- ^ self.
- ].
- "/ method was added - update the methodList
- "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
- listValid == true ifTrue:[ self invalidateList ].
+ something == #methodInClass ifTrue:[
+ "/ a method has been added/removed/changed
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ self flushMethodInfoForClassNamed:cls name selector:sel.
+ oldMethod := aParameter at:3.
+ newMethod := cls compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ variableFilter value size > 0 ifTrue:[
+ "/ sigh - must invalidate
+ listValid == true ifTrue:[ self invalidateList ].
+ ].
+ ^ self.
+ ].
+ "/ method was added - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ listValid == true ifTrue:[ self invalidateList ].
- "/ if its category is selected, updateOutputGenerator
- selectedCategories := selectedProtocolsHolder value.
- selectedCategories size > 0 ifTrue:[
- selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
- selectedCategories := selectedCategories collect:[:each | each string].
+ "/ if its category is selected, updateOutputGenerator
+ selectedCategories := selectedProtocolsHolder value.
+ selectedCategories size > 0 ifTrue:[
+ selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
+ selectedCategories := selectedCategories collect:[:each | each string].
- ((oldMethod notNil and:[selectedCategories includes:(oldMethod category)])
- or:[ (newMethod notNil and:[selectedCategories includes:(newMethod category)])])
- ifTrue:[
- self enqueueDelayedUpdateOutputGenerator "/ updateOutputGenerator.
- ].
- ].
- ].
- ^ self.
- ].
+ ((oldMethod notNil and:[selectedCategories includes:(oldMethod category)])
+ or:[ (newMethod notNil and:[selectedCategories includes:(newMethod category)])])
+ ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator "/ updateOutputGenerator.
+ ].
+ ].
+ ].
+ ^ self.
+ ].
- something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- self flushMethodInfoForClassNamed:cls name selector:sel.
- "/ method was removed - update the list and output generator
- self invalidateList.
- "/ self updateOutputGenerator.
- self slaveMode value == true ifFalse:[
- self enqueueDelayedUpdateOutputGenerator.
- ]
- ].
- ^ self.
- ].
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ self flushMethodInfoForClassNamed:cls name selector:sel.
+ "/ method was removed - update the list and output generator
+ self invalidateList.
+ "/ self updateOutputGenerator.
+ self slaveMode value == true ifFalse:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ]
+ ].
+ ^ self.
+ ].
- (something == #classOrganization
- or:[ something == #methodCategoryAdded
- or:[ something == #methodCategoryRemoved
- or:[ something == #methodCategoriesRemoved
- or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
- cls := (something == #classOrganization) ifTrue:aParameter ifFalse:[aParameter first].
- (classes includesIdentical:cls) ifTrue:[
- listValid == true ifTrue:[ self invalidateList ].
- ] ifFalse:[
- (classes contains:[:aClass | aClass name = cls name]) ifTrue:[
- listValid == true ifTrue:[ self invalidateList ].
- "/ self error:'obsolete class: should not happen'.
- ]
- ].
- ^ self.
- ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ cls := (something == #classOrganization) ifTrue:aParameter ifFalse:[aParameter first].
+ (classes includesIdentical:cls) ifTrue:[
+ listValid == true ifTrue:[ self invalidateList ].
+ ] ifFalse:[
+ (classes contains:[:aClass | aClass name = cls name]) ifTrue:[
+ listValid == true ifTrue:[ self invalidateList ].
+ "/ self error:'obsolete class: should not happen'.
+ ]
+ ].
+ ^ self.
+ ].
- something == #projectOrganization ifTrue:[
- aParameter notNil ifTrue:[
- cls := aParameter at:1.
- cls notNil ifTrue:[
- ((classes includes:cls theMetaclass)
- or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
- self invalidateList.
- self slaveMode value == true ifFalse:[
- self enqueueDelayedUpdateOutputGenerator.
- ]
- ].
- ].
- ] ifFalse:[
- listValid == true ifTrue:[ self invalidateList ].
- ].
- ^ self
- ].
+ something == #projectOrganization ifTrue:[
+ aParameter notNil ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ ((classes includes:cls theMetaclass)
+ or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
+ self invalidateList.
+ self slaveMode value == true ifFalse:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ listValid == true ifTrue:[ self invalidateList ].
+ ].
+ ^ self
+ ].
- (something == #methodCoverageInformation) ifTrue:[
- "/ already checked if it is one of my classes
- listValid == true ifTrue:[ self invalidateList ].
- ^ self
- ].
+ (something == #methodCoverageInformation) ifTrue:[
+ "/ already checked if it is one of my classes
+ listValid == true ifTrue:[ self invalidateList ].
+ ^ self
+ ].
- (something == #classDefinition or:[something == #classVariables])
- ifTrue:[
- self classDefinitionChanged:aParameter.
- ^ self
- ].
+ (something == #classDefinition or:[something == #classVariables])
+ ifTrue:[
+ self classDefinitionChanged:aParameter.
+ ^ self
+ ].
- "/ everything else is ignored
- "/ self halt.
- ].
- ^ self
+ "/ everything else is ignored
+ "/ self halt.
+ ].
+ ^ self
].
changedObject == self selectedProtocolIndices ifTrue:[
- oldSelectedProtocols := selectedProtocolsHolder value ? #().
- oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
- oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
- newSelectedProtocols := self getSelectedProtocolsFromIndices.
- oldSelectedProtocols ~= newSelectedProtocols ifTrue:[
- selectedProtocolsHolder value:newSelectedProtocols.
- ].
- newSelectedProtocols size > 1 ifTrue:[
- (newSelectedProtocols includes:(self class nameListEntryForALL)) ifTrue:[
- rawProtocolList := rawProtocolListHolder value.
- idx := rawProtocolList indexOf: (newSelectedProtocols copy remove:(self class nameListEntryForALL); yourself) first.
- idx ~~ 0 ifTrue:[
- (listView := self componentAt:#List) notNil ifTrue:[
- listView makeLineVisible:idx.
- ]
- ]
- ]
- ].
+ oldSelectedProtocols := selectedProtocolsHolder value ? #().
+ oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
+ oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
+ newSelectedProtocols := self getSelectedProtocolsFromIndices.
+ oldSelectedProtocols ~= newSelectedProtocols ifTrue:[
+ selectedProtocolsHolder value:newSelectedProtocols.
+ ].
+ newSelectedProtocols size > 1 ifTrue:[
+ (newSelectedProtocols includes:(self class nameListEntryForALL)) ifTrue:[
+ rawProtocolList := rawProtocolListHolder value.
+ idx := rawProtocolList indexOf: (newSelectedProtocols copy remove:(self class nameListEntryForALL); yourself) first.
+ idx ~~ 0 ifTrue:[
+ (listView := self componentAt:#List) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
+ ]
+ ]
+ ].
- ^ self
+ ^ self
].
changedObject == selectedProtocolsHolder ifTrue:[
- rawProtocolList := rawProtocolListHolder value.
- rawProtocolList size == 0 ifTrue:[
- lastGeneratedProtocols := nil.
- self updateList.
- rawProtocolList := rawProtocolListHolder value.
- ].
- rawProtocolList notNil ifTrue:[
- selectedCategories := selectedProtocolsHolder value ? #().
- selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
- newIndices := selectedCategories
- collect:[:each | rawProtocolList findFirst:[:p | p string = each string]].
- newIndices := newIndices select:[:each | each ~~ 0].
- newIndices ~= self selectedProtocolIndices value ifTrue:[
- self selectedProtocolIndices
- setValue:nil; "/ to force update
- value:newIndices.
- ].
- "/ cg: does not work (selecting all with testcase classes)
- "/ don't see why, at the moment, but....
+ rawProtocolList := rawProtocolListHolder value.
+ rawProtocolList size == 0 ifTrue:[
+ lastGeneratedProtocols := nil.
+ self updateList.
+ rawProtocolList := rawProtocolListHolder value.
+ ].
+ rawProtocolList notNil ifTrue:[
+ selectedCategories := selectedProtocolsHolder value ? #().
+ selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
+ newIndices := selectedCategories
+ collect:[:each | rawProtocolList findFirst:[:p | p string = each string]].
+ newIndices := newIndices select:[:each | each ~~ 0].
+ newIndices ~= self selectedProtocolIndices value ifTrue:[
+ self selectedProtocolIndices
+ setValue:nil; "/ to force update
+ value:newIndices.
+ ].
+ "/ cg: does not work (selecting all with testcase classes)
+ "/ don't see why, at the moment, but....
"/ (lastGeneratedProtocols notNil
"/ and:[(lastGeneratedProtocols includes:self class nameListEntryForALL)
"/ and:[(selectedCategories ? #()) includes:self class nameListEntryForALL]])
"/ ifTrue:[
"/ "/ no need to update generator
"/ ] ifFalse:[
- self updateOutputGenerator.
+ self updateOutputGenerator.
"/ ]
- ].
- ^ self
+ ].
+ ^ self
].
(changedObject == variableFilter
or:[changedObject == filterClassVars
or:[changedObject == packageFilterOnInput]]) ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
changedObject == methodVisibilityHolder ifTrue:[
- self invalidateList.
- self updateOutputGenerator.
- ^ self
+ self invalidateList.
+ self updateOutputGenerator.
+ ^ self
].
lastGeneratedProtocols := nil.
changedObject == inGeneratorHolder ifTrue:[
- selectedCategories := selectedProtocolsHolder value.
+ selectedCategories := selectedProtocolsHolder value.
- selectedCategories size > 0 ifTrue:[
- oldSelectedProtocols := selectedCategories ? #().
- oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
- oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
- self updateList.
- rawProtocolList := rawProtocolListHolder value.
- newSelectedProtocols := oldSelectedProtocols select:[:each | rawProtocolList includes:each].
+ selectedCategories size > 0 ifTrue:[
+ oldSelectedProtocols := selectedCategories ? #().
+ oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
+ oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
+ self updateList.
+ rawProtocolList := rawProtocolListHolder value.
+ newSelectedProtocols := oldSelectedProtocols select:[:each | rawProtocolList includes:each].
"/ selectedProtocolsHolder setValue:nil. "/ to force update
- selectedProtocolsHolder value:newSelectedProtocols.
- ^ self
- ].
+ selectedProtocolsHolder value:newSelectedProtocols.
+ ^ self
+ ].
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -679,8 +679,8 @@
and:[newSelectedCategories notNil
and:[(lastSelectedProtocols includes:(allEntry))
and:[newSelectedCategories includes:(allEntry)]]]) ifTrue:[
- "/ no change ...
- ^ self
+ "/ no change ...
+ ^ self
].
super selectionChanged.
@@ -701,86 +701,89 @@
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
- "JV2012-02-17: Suppress updates if they're comming too fast
- (such as when booting Java or so)"
- ts := OperatingSystem getMillisecondTime.
- (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
- lastUpdateFromSmalltalkTimestamp := ts.
- numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
- numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
- ].
- numUpdatesFromSmalltalkInLast200Msecs := 0.
- lastUpdateFromSmalltalkTimestamp := ts.
- something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
- ^ self.
- ].
+"/ JV@2012-10-03: Rubbish
+"/
+"/ "JV2012-02-17: Suppress updates if they're comming too fast
+"/ (such as when booting Java or so)"
+"/ ts := OperatingSystem getMillisecondTime.
+"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
+"/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
+"/ ].
+"/ numUpdatesFromSmalltalkInLast200Msecs := 0.
+"/ lastUpdateFromSmalltalkTimestamp := ts.
- something == #currentChangeSet ifTrue:[
- listValid == true ifTrue:[ self invalidateList ].
- ^ self.
- ].
+ something isNil ifTrue:[
+ "/ self halt "/ huh - Smalltalk changed - so what ?
+ ^ self.
+ ].
+
+ something == #currentChangeSet ifTrue:[
+ listValid == true ifTrue:[ self invalidateList ].
+ ^ self.
+ ].
- something == #methodInClass ifTrue:[
- "/ a method has been added/removed/changed
- cls := aParameter at:1.
- (classes notNil and:[classes includesIdentical:cls]) ifFalse:[^ self].
+ something == #methodInClass ifTrue:[
+ "/ a method has been added/removed/changed
+ cls := aParameter at:1.
+ (classes notNil and:[classes includesIdentical:cls]) ifFalse:[^ self].
- sel := aParameter at:2.
- self flushMethodInfoForClassNamed:cls name selector:sel.
- oldMethod := aParameter at:3.
- newMethod := cls compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- variableFilter value size > 0 ifTrue:[
- "/ sigh - must invalidate
- listValid == true ifTrue:[ self invalidateList ].
- ^ self.
- ].
- oldMethod category ~= newMethod category ifTrue:[
- listValid == true ifTrue:[ self invalidateList ].
- ^ self.
- ].
- "/ mhmh - its now changed (so coloring will change).
- listValid == true ifTrue:[ self invalidateList ].
- ^ self.
- ].
- ].
+ sel := aParameter at:2.
+ self flushMethodInfoForClassNamed:cls name selector:sel.
+ oldMethod := aParameter at:3.
+ newMethod := cls compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ variableFilter value size > 0 ifTrue:[
+ "/ sigh - must invalidate
+ listValid == true ifTrue:[ self invalidateList ].
+ ^ self.
+ ].
+ oldMethod category ~= newMethod category ifTrue:[
+ listValid == true ifTrue:[ self invalidateList ].
+ ^ self.
+ ].
+ "/ mhmh - its now changed (so coloring will change).
+ listValid == true ifTrue:[ self invalidateList ].
+ ^ self.
+ ].
+ ].
"/ something == #classDefinition ifTrue:[
"/ ^ self.
"/ ].
- something == #newClass ifTrue:[
- ^ self.
- ].
- something == #classRemove ifTrue:[
- ^ self.
- ].
- something == #classRename ifTrue:[
- ^ self.
- ].
+ something == #newClass ifTrue:[
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ ^ self.
+ ].
"/ something == #classVariables ifTrue:[
"/ ^ self.
"/ ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #organization ifTrue:[
- ^ self.
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #organization ifTrue:[
+ ^ self.
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
- something == #methodCoverageInfo ifTrue:[
- self showCoverageInformation value ifFalse:[^ self].
- listValid ifFalse:[^ self ].
+ something == #methodCoverageInfo ifTrue:[
+ self showCoverageInformation value ifFalse:[^ self].
+ listValid ifFalse:[^ self ].
- mthd := aParameter.
- (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[^ self].
+ mthd := aParameter.
+ (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[^ self].
- self enqueueDelayedUpdateList.
- ^ self
- ].
+ self enqueueDelayedUpdateList.
+ ^ self
+ ].
].
super update:something with:aParameter from:changedObject.
@@ -833,7 +836,7 @@
cat := self categoryAtTargetPointOf:aDropContext.
cat notNil ifTrue:[
- self masterApplication moveMethods:methods toProtocol:cat.
+ self masterApplication moveMethods:methods toProtocol:cat.
].
"Modified: / 13-09-2006 / 11:43:23 / cg"
@@ -843,196 +846,196 @@
makeGenerator
"return a generator which enumerates the methods from the selected protocol;
- that generator generates 4-element elements (includes the class and protocol),
- in order to make the consumers only depend on one input
+ that generator generates 4-element elements (includes the class and protocol),
+ in order to make the consumers only depend on one input
(i.e. to pass multiple-class and multiple-protocol info
without a need for another classHolder/protocolHolder in the methodList)."
- ^ Iterator
- on:[:whatToDo |
- |protocols
- allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols
- documentationProtocols longProtocols extensionProtocols redefinedProtocols overrideProtocols
- missingRequiredProtocols subclassResponsibilities
- notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
- partiallyCoveredProtocols uncoveredProtocols
- noCat static notStatic classSelectorPairsAlreadyDone
- packages remainingClasses remainingCategories classesAlreadyDone noPackage
- catListed|
+ ^ Iterator
+ on:[:whatToDo |
+ |protocols
+ allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols
+ documentationProtocols longProtocols extensionProtocols redefinedProtocols overrideProtocols
+ missingRequiredProtocols subclassResponsibilities
+ notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
+ partiallyCoveredProtocols uncoveredProtocols
+ noCat static notStatic classSelectorPairsAlreadyDone
+ packages remainingClasses remainingCategories classesAlreadyDone noPackage
+ catListed|
- noPackage := PackageId noProjectID.
- noCat := (self class nameListEntryForNILCategory).
- static := (self class nameListEntryForStatic).
- notStatic := (self class nameListEntryForNonStatic).
+ noPackage := PackageId noProjectID.
+ noCat := (self class nameListEntryForNILCategory).
+ static := (self class nameListEntryForStatic).
+ notStatic := (self class nameListEntryForNonStatic).
- protocols := self selectedProtocols value ? #().
- protocols := protocols collect:[:each | (each ifNil:[noCat]) string].
- lastGeneratedProtocols := protocols.
- protocols := protocols asSet.
+ protocols := self selectedProtocols value ? #().
+ protocols := protocols collect:[:each | (each ifNil:[noCat]) string].
+ lastGeneratedProtocols := protocols.
+ protocols := protocols asSet.
- (leafClasses size > 0 and:[protocols size > 0]) ifTrue:[
- allProtocols := protocols includes:(self class nameListEntryForALL).
- superSendProtocols := protocols includes:(self class nameListEntryForSuperSend).
- uncommentedProtocols := protocols includes:(self class nameListEntryForUncommented).
- obsoleteProtocols := protocols includes:(self class nameListEntryForObsolete).
- documentationProtocols := protocols includes:(self class nameListEntryForDocumentation).
- longProtocols := protocols includes:(self class nameListEntryForLong).
- extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
- redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
- overrideProtocols := protocols includes:(self class nameListEntryForOverride).
- missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
- subclassResponsibilities := protocols includes:(self class nameListEntryForMustBeRedefinedInSubclass).
- annotatedProtocols := protocols includes:(self class nameListEntryForAnnotated).
+ (leafClasses size > 0 and:[protocols size > 0]) ifTrue:[
+ allProtocols := protocols includes:(self class nameListEntryForALL).
+ superSendProtocols := protocols includes:(self class nameListEntryForSuperSend).
+ uncommentedProtocols := protocols includes:(self class nameListEntryForUncommented).
+ obsoleteProtocols := protocols includes:(self class nameListEntryForObsolete).
+ documentationProtocols := protocols includes:(self class nameListEntryForDocumentation).
+ longProtocols := protocols includes:(self class nameListEntryForLong).
+ extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
+ redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
+ overrideProtocols := protocols includes:(self class nameListEntryForOverride).
+ missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
+ subclassResponsibilities := protocols includes:(self class nameListEntryForMustBeRedefinedInSubclass).
+ annotatedProtocols := protocols includes:(self class nameListEntryForAnnotated).
+
+ fullyCoveredProtocols := protocols includes:(self class nameListEntryForFullyCovered).
+ partiallyCoveredProtocols := protocols includes:(self class nameListEntryForPartiallyCovered).
+ uncoveredProtocols := protocols includes:(self class nameListEntryForUncovered).
+ notInstrumentedProtocols := protocols includes:(self class nameListEntryForNotInstrumented).
- fullyCoveredProtocols := protocols includes:(self class nameListEntryForFullyCovered).
- partiallyCoveredProtocols := protocols includes:(self class nameListEntryForPartiallyCovered).
- uncoveredProtocols := protocols includes:(self class nameListEntryForUncovered).
- notInstrumentedProtocols := protocols includes:(self class nameListEntryForNotInstrumented).
-
- packages := packageFilter value value.
- (packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
- packages := nil.
- ].
+ packages := packageFilter value value.
+ (packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
+ packages := nil.
+ ].
- remainingClasses := leafClasses copy asIdentitySet.
- remainingCategories := protocols copy asSet.
+ remainingClasses := leafClasses copy asIdentitySet.
+ remainingCategories := protocols copy asSet.
+
+ classesAlreadyDone := IdentitySet new.
+ classSelectorPairsAlreadyDone := Set new.
- classesAlreadyDone := IdentitySet new.
- classSelectorPairsAlreadyDone := Set new.
+ leafClasses do:[:aLeafClass |
+ (self classesToProcessForClasses:(Array with:aLeafClass)) do:[:aClass |
+ |supportsMethodCategories isJavaClass anyInThisClass requiredProtocolForClass|
- leafClasses do:[:aLeafClass |
- (self classesToProcessForClasses:(Array with:aLeafClass)) do:[:aClass |
- |supportsMethodCategories isJavaClass anyInThisClass requiredProtocolForClass|
+ (classesAlreadyDone includes:aClass) ifFalse:[
+ classesAlreadyDone add:aClass.
- (classesAlreadyDone includes:aClass) ifFalse:[
- classesAlreadyDone add:aClass.
+ supportsMethodCategories := aClass supportsMethodCategories.
+ isJavaClass := aClass isJavaClass.
+ anyInThisClass := false.
- supportsMethodCategories := aClass supportsMethodCategories.
- isJavaClass := aClass isJavaClass.
- anyInThisClass := false.
-
- aClass methodDictionary keysAndValuesDo:[:sel :mthd |
- |cat mPkg includeIt info|
+ aClass methodDictionary keysAndValuesDo:[:sel :mthd |
+ |cat mPkg includeIt info|
"/ sel == #metacelloCleanup ifTrue:[self halt].
- supportsMethodCategories ifTrue:[
- cat := mthd category.
- ] ifFalse:[
- isJavaClass ifTrue:[
- cat := mthd isStatic ifTrue:[static] ifFalse:[notStatic]
- ] ifFalse:[
- cat := noCat.
- ]
- ].
- catListed := cat.
+ supportsMethodCategories ifTrue:[
+ cat := mthd category.
+ ] ifFalse:[
+ isJavaClass ifTrue:[
+ cat := mthd isStatic ifTrue:[static] ifFalse:[notStatic]
+ ] ifFalse:[
+ cat := noCat.
+ ]
+ ].
+ catListed := cat.
- mPkg := mthd package.
- (packages isNil
- or:[ mPkg = noPackage
- or:[ (packages includes:mPkg)
- or:[ (extensionProtocols and:[ mthd isExtension ])
- ]]]
- ) ifTrue:[
- "/ used to be a more readable or, but to reuse info, I've splitted it.
- "/ because we should use the parser only once, we reuse the same methodInfo.
- "/ otherwise, the list update becomes too slow for long classes (NewSystemBrowser)
- includeIt := allProtocols.
- includeIt ifFalse:[ includeIt := protocols includes:cat ].
- includeIt ifFalse:[
- superSendProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info sendsSuper ]].
- includeIt ifFalse:[
- uncommentedProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isUncommented.
- catListed := self class nameListEntryForUncommented ]].
- includeIt ifFalse:[
- obsoleteProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isObsolete ]].
- includeIt ifFalse:[
- documentationProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isDocumentationMethod ]].
- includeIt ifFalse:[
- longProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isLongMethod ]].
- includeIt ifFalse:[
- extensionProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isExtensionMethod.
- catListed := self class nameListEntryForExtensions ]].
- includeIt ifFalse:[
- overrideProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isOverride ]].
- includeIt ifFalse:[
- redefinedProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isRedefine ]].
- includeIt ifFalse:[
- subclassResponsibilities ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isSubclassResponsibility ]].
- includeIt ifFalse:[
- annotatedProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isAnnotated ]].
+ mPkg := mthd package.
+ (packages isNil
+ or:[ mPkg = noPackage
+ or:[ (packages includes:mPkg)
+ or:[ (extensionProtocols and:[ mthd isExtension ])
+ ]]]
+ ) ifTrue:[
+ "/ used to be a more readable or, but to reuse info, I've splitted it.
+ "/ because we should use the parser only once, we reuse the same methodInfo.
+ "/ otherwise, the list update becomes too slow for long classes (NewSystemBrowser)
+ includeIt := allProtocols.
+ includeIt ifFalse:[ includeIt := protocols includes:cat ].
+ includeIt ifFalse:[
+ superSendProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info sendsSuper ]].
+ includeIt ifFalse:[
+ uncommentedProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isUncommented.
+ catListed := self class nameListEntryForUncommented ]].
+ includeIt ifFalse:[
+ obsoleteProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isObsolete ]].
+ includeIt ifFalse:[
+ documentationProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isDocumentationMethod ]].
+ includeIt ifFalse:[
+ longProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isLongMethod ]].
+ includeIt ifFalse:[
+ extensionProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isExtensionMethod.
+ catListed := self class nameListEntryForExtensions ]].
+ includeIt ifFalse:[
+ overrideProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isOverride ]].
+ includeIt ifFalse:[
+ redefinedProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isRedefine ]].
+ includeIt ifFalse:[
+ subclassResponsibilities ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isSubclassResponsibility ]].
+ includeIt ifFalse:[
+ annotatedProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isAnnotated ]].
- includeIt ifFalse:[
- mthd isInstrumented ifTrue:[
- mthd hasBeenCalled ifTrue:[
- mthd haveAllBlocksBeenExecuted ifTrue:[
- includeIt := fullyCoveredProtocols.
- ] ifFalse:[
- includeIt := partiallyCoveredProtocols
- ]
- ] ifFalse:[
- includeIt := uncoveredProtocols
- ].
- ] ifFalse:[
- includeIt := notInstrumentedProtocols
- ].
- ].
+ includeIt ifFalse:[
+ mthd isInstrumented ifTrue:[
+ mthd hasBeenCalled ifTrue:[
+ mthd haveAllBlocksBeenExecuted ifTrue:[
+ includeIt := fullyCoveredProtocols.
+ ] ifFalse:[
+ includeIt := partiallyCoveredProtocols
+ ]
+ ] ifFalse:[
+ includeIt := uncoveredProtocols
+ ].
+ ] ifFalse:[
+ includeIt := notInstrumentedProtocols
+ ].
+ ].
- includeIt ifTrue:[
- (methodVisibilityHolder value == #class) ifTrue:[
- whatToDo value:aClass value:catListed value:sel value:mthd.
- ] ifFalse:[
- (classSelectorPairsAlreadyDone includes:(aLeafClass->sel)) ifFalse:[
- classSelectorPairsAlreadyDone add:(aLeafClass->sel).
- whatToDo value:aClass value:catListed value:sel value:mthd.
- ].
- ].
- anyInThisClass := true.
- remainingCategories remove:catListed ifAbsent:nil.
- ].
- ]
- ].
+ includeIt ifTrue:[
+ (methodVisibilityHolder value == #class) ifTrue:[
+ whatToDo value:aClass value:catListed value:sel value:mthd.
+ ] ifFalse:[
+ (classSelectorPairsAlreadyDone includes:(aLeafClass->sel)) ifFalse:[
+ classSelectorPairsAlreadyDone add:(aLeafClass->sel).
+ whatToDo value:aClass value:catListed value:sel value:mthd.
+ ].
+ ].
+ anyInThisClass := true.
+ remainingCategories remove:catListed ifAbsent:nil.
+ ].
+ ]
+ ].
- missingRequiredProtocols ifTrue:[
- requiredProtocolForClass := SmalltalkCodeGeneratorTool missingRequiredProtocolFor:aClass.
- requiredProtocolForClass do:[:sel |
- |selectorInRed missingMethodPlaceHolder|
+ missingRequiredProtocols ifTrue:[
+ requiredProtocolForClass := SmalltalkCodeGeneratorTool missingRequiredProtocolFor:aClass.
+ requiredProtocolForClass do:[:sel |
+ |selectorInRed missingMethodPlaceHolder|
- selectorInRed := sel colorizeAllWith:Color red.
- missingMethodPlaceHolder := MissingMethod mclass:aClass selector:sel.
- whatToDo value:aClass value:'required' value:selectorInRed value:missingMethodPlaceHolder.
- ].
- ].
- anyInThisClass ifTrue:[ remainingClasses remove:aClass ifAbsent:nil. ].
- ].
- ].
- ].
- remainingClasses do:[:aClass |
- whatToDo value:aClass value:nil value:nil value:nil.
- ].
- remainingCategories do:[:cat |
- whatToDo value:nil value:cat value:nil value:nil.
- ]
- ]
+ selectorInRed := sel colorizeAllWith:Color red.
+ missingMethodPlaceHolder := MissingMethod mclass:aClass selector:sel.
+ whatToDo value:aClass value:'required' value:selectorInRed value:missingMethodPlaceHolder.
+ ].
+ ].
+ anyInThisClass ifTrue:[ remainingClasses remove:aClass ifAbsent:nil. ].
+ ].
+ ].
+ ].
+ remainingClasses do:[:aClass |
+ whatToDo value:aClass value:nil value:nil value:nil.
+ ].
+ remainingCategories do:[:cat |
+ whatToDo value:nil value:cat value:nil value:nil.
+ ]
+ ]
]
"Created: / 05-02-2000 / 13:42:10 / cg"
@@ -1043,11 +1046,11 @@
class:cls protocol:cat includesMethodsInAnyPackage:packageFilter
cls methodDictionary keysAndValuesDo:[:sel :mthd |
- mthd category == cat ifTrue:[
- (packageFilter includes:mthd package) ifTrue:[
- ^ true
- ]
- ]
+ mthd category == cat ifTrue:[
+ (packageFilter includes:mthd package) ifTrue:[
+ ^ true
+ ]
+ ]
].
^ false
!
@@ -1083,41 +1086,41 @@
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
- anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
+ anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
- "/ no need to parse
- ^ false
+ "/ no need to parse
+ ^ false
].
cls selectorsAndMethodsDo:[:sel :mthd |
- |src parser usedVars|
+ |src parser usedVars|
- mthd category = cat ifTrue:[
- src := mthd source.
- src notNil ifTrue:[
- "
- before doing a slow parse, quickly scan the
- methods source for the variables name ...
- "
- (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
- parser := Parser
- parseMethod:src
- in:cls
- ignoreErrors:true
- ignoreWarnings:true.
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- usedVars := parser perform:querySelector.
- (usedVars includesAny:variablesToHighLight)
- ifTrue:[
- ^ true
- ]
- ]
- ]
- ] ifFalse:[
- Transcript showCR:'Oops - cannot access method source'.
- ]
- ]
+ mthd category = cat ifTrue:[
+ src := mthd source.
+ src notNil ifTrue:[
+ "
+ before doing a slow parse, quickly scan the
+ methods source for the variables name ...
+ "
+ (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
+ parser := Parser
+ parseMethod:src
+ in:cls
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ usedVars := parser perform:querySelector.
+ (usedVars includesAny:variablesToHighLight)
+ ifTrue:[
+ ^ true
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ Transcript showCR:'Oops - cannot access method source'.
+ ]
+ ]
].
^ false
@@ -1132,18 +1135,18 @@
super commonPostOpen.
self showPseudoProtocols ifTrue:[
- "/ revalidate my list, because it was only shown lazy
- self invalidateList.
+ "/ revalidate my list, because it was only shown lazy
+ self invalidateList.
].
!
flushMethodInfoForClassNamed:className selector:selector
MethodInfoCacheAccessLock critical:[
- MethodInfoCache notNil ifTrue:[
- MethodInfoCache
- removeKey:(className,'>>',selector)
- ifAbsent:[]
- ].
+ MethodInfoCache notNil ifTrue:[
+ MethodInfoCache
+ removeKey:(className,'>>',selector)
+ ifAbsent:[]
+ ].
]
"Modified: / 08-08-2011 / 19:16:32 / cg"
@@ -1156,11 +1159,11 @@
itemsInChangeSet itemsInRemoteChangeSet
itemsWithInstrumentedMethods itemsWithCalledMethods itemsWithUncalledMethods
itemsWithPartiallyCoveredMethods itemsWithFullyCoveredMethods
- packageFilterOnInput packageFilter nameListEntryForALL changeSet
+ packageFilterOnInput packageFilter nameListEntryForALL changeSet
emphasizedPlus emphasisForRef emphasisForMod
numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
numRedefine numExtension numMissingRequired numSubclassResponsibility
- numAnnotated numFullyCovered numPartiallyCovered numUncovered numNotInstrumented
+ numAnnotated numFullyCovered numPartiallyCovered numUncovered numNotInstrumented
showPseudoProtocols showCoverageInformation
addPseudoEntry addPseudoEntryWithColor countAll pseudoEntryColor userPreferences
startTime lazyPseudoProtocols|
@@ -1173,19 +1176,19 @@
generator := inGeneratorHolder value.
generator isNil ifTrue:[ ^ #() ].
- showPseudoProtocols := self showPseudoProtocols value
- and:[builder window notNil and:[builder window shown]].
+ showPseudoProtocols := self showPseudoProtocols value
+ and:[builder window notNil and:[builder window shown]].
showCoverageInformation := self showCoverageInformation value.
nameListEntryForALL := self class nameListEntryForALL.
packageFilterOnInput := self packageFilterOnInput value.
(packageFilterOnInput notNil and:[packageFilterOnInput includes:nameListEntryForALL]) ifTrue:[
- packageFilterOnInput := nil
+ packageFilterOnInput := nil
].
packageFilter := self packageFilter value.
(packageFilter notNil and:[packageFilter includes:nameListEntryForALL]) ifTrue:[
- packageFilter := nil
+ packageFilter := nil
].
categoryList := Set new.
@@ -1197,8 +1200,8 @@
itemsInRemoteChangeSet := Set new.
itemsWithInstrumentedMethods := Set new.
- itemsWithCalledMethods := Set new.
- itemsWithUncalledMethods := Set new.
+ itemsWithCalledMethods := Set new.
+ itemsWithUncalledMethods := Set new.
itemsWithPartiallyCoveredMethods := Set new.
itemsWithFullyCoveredMethods := Set new.
@@ -1212,162 +1215,162 @@
numNotInstrumented := numFullyCovered := numPartiallyCovered := numUncovered := 0.
numAnnotated := 0.
- generator do:[:clsIn :catIn |
- |emptyProtocols clsName doHighLight doHighLightRed suppress|
+ generator do:[:clsIn :catIn |
+ |emptyProtocols clsName doHighLight doHighLightRed suppress|
- leafClassesProcessed add:clsIn.
- (self classesToProcessForClasses:(Array with:clsIn)) do:[:cls |
- |cats|
+ leafClassesProcessed add:clsIn.
+ (self classesToProcessForClasses:(Array with:clsIn)) do:[:cls |
+ |cats|
- classesProcessed add:cls.
+ classesProcessed add:cls.
- cls ~~ clsIn ifTrue:[
- cats := cls categories
- ] ifFalse:[
- cats := Array with:catIn.
- ].
- cats do:[:cat |
- cat notNil ifTrue:[
- suppress := packageFilterOnInput notNil
- and:[ (self class:cls protocol:cat includesMethodsInAnyPackage:packageFilterOnInput) not ].
+ cls ~~ clsIn ifTrue:[
+ cats := cls categories
+ ] ifFalse:[
+ cats := Array with:catIn.
+ ].
+ cats do:[:cat |
+ cat notNil ifTrue:[
+ suppress := packageFilterOnInput notNil
+ and:[ (self class:cls protocol:cat includesMethodsInAnyPackage:packageFilterOnInput) not ].
- suppress ifFalse:[
- variablesToHighlight notEmptyOrNil ifTrue:[
- (itemsWithVarRefs includes:cat) ifFalse:[
- classVarsToHighLight ifTrue:[
- doHighLight := self class:cls protocol:cat includesRefsToClassVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self class:cls protocol:cat includesModsOfClassVariable:variablesToHighlight.
- ].
- ] ifFalse:[
- doHighLight := self class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighlight.
- ].
- ].
- doHighLight ifTrue:[
- itemsWithVarRefs add:cat.
- doHighLightRed ifTrue:[
- itemsWithVarMods add:cat.
- ].
- ]
- ]
- ].
+ suppress ifFalse:[
+ variablesToHighlight notEmptyOrNil ifTrue:[
+ (itemsWithVarRefs includes:cat) ifFalse:[
+ classVarsToHighLight ifTrue:[
+ doHighLight := self class:cls protocol:cat includesRefsToClassVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self class:cls protocol:cat includesModsOfClassVariable:variablesToHighlight.
+ ].
+ ] ifFalse:[
+ doHighLight := self class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighlight.
+ ].
+ ].
+ doHighLight ifTrue:[
+ itemsWithVarRefs add:cat.
+ doHighLightRed ifTrue:[
+ itemsWithVarMods add:cat.
+ ].
+ ]
+ ]
+ ].
- (showPseudoProtocols value) ifTrue:[
- cls selectorsAndMethodsDo:[:sel :mthd |
- |info|
+ (showPseudoProtocols value) ifTrue:[
+ cls selectorsAndMethodsDo:[:sel :mthd |
+ |info|
- mthd category = cat ifTrue:[
- info := self methodInfoFor:mthd in:cls selector:sel lazy:lazyPseudoProtocols.
- info notNil ifTrue:[
- info isObsolete ifTrue:[ numObsolete := numObsolete + 1 ].
- info sendsSuper ifTrue:[ numSuper := numSuper + 1 ].
- info isUncommented ifTrue:[ numUncommented := numUncommented + 1 ].
- info isDocumentationMethod ifTrue:[ numDocumentation := numDocumentation + 1 ].
- info isLongMethod ifTrue:[ numLong := numLong + 1 ].
- info isExtensionMethod ifTrue:[ numExtension := numExtension + 1 ].
- info isOverride ifTrue:[ numOverride := numOverride + 1 ].
- info isRedefine ifTrue:[ numRedefine := numRedefine + 1 ].
- info isSubclassResponsibility ifTrue:[ numSubclassResponsibility := numSubclassResponsibility + 1].
- info isAnnotated ifTrue:[ numAnnotated := numAnnotated + 1].
- ]
- ].
- (Timestamp now deltaFrom:startTime) > 5 seconds ifTrue:[
- lazyPseudoProtocols := true.
- "/ because we already computed for 10seconds, more and more will be found in
- "/ the cache, and eventually, pseudo protocols will be shown anyway
- masterApplication showInfo:'suppress pseudo protocols - parsing took too long'.
- ].
- ].
- ].
+ mthd category = cat ifTrue:[
+ info := self methodInfoFor:mthd in:cls selector:sel lazy:lazyPseudoProtocols.
+ info notNil ifTrue:[
+ info isObsolete ifTrue:[ numObsolete := numObsolete + 1 ].
+ info sendsSuper ifTrue:[ numSuper := numSuper + 1 ].
+ info isUncommented ifTrue:[ numUncommented := numUncommented + 1 ].
+ info isDocumentationMethod ifTrue:[ numDocumentation := numDocumentation + 1 ].
+ info isLongMethod ifTrue:[ numLong := numLong + 1 ].
+ info isExtensionMethod ifTrue:[ numExtension := numExtension + 1 ].
+ info isOverride ifTrue:[ numOverride := numOverride + 1 ].
+ info isRedefine ifTrue:[ numRedefine := numRedefine + 1 ].
+ info isSubclassResponsibility ifTrue:[ numSubclassResponsibility := numSubclassResponsibility + 1].
+ info isAnnotated ifTrue:[ numAnnotated := numAnnotated + 1].
+ ]
+ ].
+ (Timestamp now deltaFrom:startTime) > 5 seconds ifTrue:[
+ lazyPseudoProtocols := true.
+ "/ because we already computed for 10seconds, more and more will be found in
+ "/ the cache, and eventually, pseudo protocols will be shown anyway
+ masterApplication showInfo:'suppress pseudo protocols - parsing took too long'.
+ ].
+ ].
+ ].
- categoryList add:cat.
+ categoryList add:cat.
- AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
- clsName := cls name.
- emptyProtocols := AdditionalEmptyCategoriesPerClassName at:clsName ifAbsent:nil.
- emptyProtocols size > 0 ifTrue:[
- emptyProtocols remove:cat ifAbsent:nil.
- ].
- emptyProtocols size == 0 ifTrue:[
- AdditionalEmptyCategoriesPerClassName removeKey:clsName ifAbsent:nil
- ].
- ].
- ]
- ]
- ]
- ]
- ].
+ AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
+ clsName := cls name.
+ emptyProtocols := AdditionalEmptyCategoriesPerClassName at:clsName ifAbsent:nil.
+ emptyProtocols size > 0 ifTrue:[
+ emptyProtocols remove:cat ifAbsent:nil.
+ ].
+ emptyProtocols size == 0 ifTrue:[
+ AdditionalEmptyCategoriesPerClassName removeKey:clsName ifAbsent:nil
+ ].
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
numAll := 0.
changeSet := ChangeSet current.
classesProcessed do:[:eachClass |
- |classPackage required|
+ |classPackage required|
- classPackage := eachClass package.
- eachClass methodDictionary keysAndValuesDo:[:mSelector :mthd |
- |mPackage mCategory|
+ classPackage := eachClass package.
+ eachClass methodDictionary keysAndValuesDo:[:mSelector :mthd |
+ |mPackage mCategory|
- mPackage := mthd package.
- mCategory := mthd category.
+ mPackage := mthd package.
+ mCategory := mthd category.
- #fixme.
- mPackage = classPackage ifTrue:[
- mPackage ~~ classPackage ifTrue:[
- mthd setPackage:(mPackage := mPackage string asSymbol).
- ]
- ].
- mPackage ~~ classPackage ifTrue:[
- (mCategory notNil and:[mPackage ~= PackageId noProjectID]) ifTrue:[
- itemsWithExtensions add:mCategory.
+ #fixme.
+ mPackage = classPackage ifTrue:[
+ mPackage ~~ classPackage ifTrue:[
+ mthd setPackage:(mPackage := mPackage string asSymbol).
+ ]
+ ].
+ mPackage ~~ classPackage ifTrue:[
+ (mCategory notNil and:[mPackage ~= PackageId noProjectID]) ifTrue:[
+ itemsWithExtensions add:mCategory.
- (packageFilter notNil
- and:[ (packageFilter includes:mPackage) not])
- ifTrue:[
- itemsWithSuppressedExtensions add:mCategory.
- ].
- ].
- ].
+ (packageFilter notNil
+ and:[ (packageFilter includes:mPackage) not])
+ ifTrue:[
+ itemsWithSuppressedExtensions add:mCategory.
+ ].
+ ].
+ ].
- showCoverageInformation ifTrue:[
- mthd isInstrumented ifTrue:[
- mthd category = 'documentation' ifFalse:[
- itemsWithInstrumentedMethods add:mCategory.
- mthd hasBeenCalled ifTrue:[
- itemsWithCalledMethods add:mCategory.
- mthd haveAllBlocksBeenExecuted ifTrue:[
- itemsWithFullyCoveredMethods add:mCategory.
- numFullyCovered := numFullyCovered + 1.
- ] ifFalse:[
- itemsWithPartiallyCoveredMethods add:mCategory.
- numPartiallyCovered := numPartiallyCovered + 1.
- ].
- ] ifFalse:[
- itemsWithUncalledMethods add:mCategory.
- numUncovered := numUncovered + 1.
- ].
- ].
- ] ifFalse:[
- numNotInstrumented := numNotInstrumented + 1.
- ].
- ] ifFalse:[
- (changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
- itemsInChangeSet add:mCategory.
- ].
- (SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
- itemsInRemoteChangeSet add:mCategory.
- ].
- ].
- ].
- (lazyPseudoProtocols not and:[showPseudoProtocols value]) ifTrue:[
- "/ see if there is a subclassResponsibility in a superclass
- required := SmalltalkCodeGeneratorTool missingRequiredProtocolFor:eachClass.
- numMissingRequired := numMissingRequired + required size.
- ].
- numAll := numAll + (eachClass methodDictionary size)
+ showCoverageInformation ifTrue:[
+ mthd isInstrumented ifTrue:[
+ mthd category = 'documentation' ifFalse:[
+ itemsWithInstrumentedMethods add:mCategory.
+ mthd hasBeenCalled ifTrue:[
+ itemsWithCalledMethods add:mCategory.
+ mthd haveAllBlocksBeenExecuted ifTrue:[
+ itemsWithFullyCoveredMethods add:mCategory.
+ numFullyCovered := numFullyCovered + 1.
+ ] ifFalse:[
+ itemsWithPartiallyCoveredMethods add:mCategory.
+ numPartiallyCovered := numPartiallyCovered + 1.
+ ].
+ ] ifFalse:[
+ itemsWithUncalledMethods add:mCategory.
+ numUncovered := numUncovered + 1.
+ ].
+ ].
+ ] ifFalse:[
+ numNotInstrumented := numNotInstrumented + 1.
+ ].
+ ] ifFalse:[
+ (changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
+ itemsInChangeSet add:mCategory.
+ ].
+ (SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
+ itemsInRemoteChangeSet add:mCategory.
+ ].
+ ].
+ ].
+ (lazyPseudoProtocols not and:[showPseudoProtocols value]) ifTrue:[
+ "/ see if there is a subclassResponsibility in a superclass
+ required := SmalltalkCodeGeneratorTool missingRequiredProtocolFor:eachClass.
+ numMissingRequired := numMissingRequired + required size.
+ ].
+ numAll := numAll + (eachClass methodDictionary size)
].
categoryList := categoryList asOrderedCollection.
@@ -1378,7 +1381,7 @@
emphasisForRef := userPreferences emphasisForReadVariable.
emphasisForMod := userPreferences emphasisForWrittenVariable.
- (itemsInChangeSet notEmpty
+ (itemsInChangeSet notEmpty
or:[itemsInRemoteChangeSet notEmpty
or:[itemsWithExtensions notEmpty
or:[itemsWithVarRefs notEmpty
@@ -1388,72 +1391,72 @@
or:[itemsWithFullyCoveredMethods notEmpty
or:[itemsWithPartiallyCoveredMethods notEmpty
]]]]]]]]) ifTrue:[
- rawProtocolList keysAndValuesDo:[:idx :cat |
- |item inChangeSet inRemoteChangeSet hasExtensions hasVarRef hasVarMod
- clr|
+ rawProtocolList keysAndValuesDo:[:idx :cat |
+ |item inChangeSet inRemoteChangeSet hasExtensions hasVarRef hasVarMod
+ clr|
- item := cat.
+ item := cat.
- inChangeSet := false.
+ inChangeSet := false.
- showCoverageInformation ifTrue:[
- (itemsWithInstrumentedMethods includes:cat) ifTrue:[
- (itemsWithCalledMethods includes:cat) ifTrue:[
- (itemsWithPartiallyCoveredMethods includes:cat) ifTrue:[
- clr := (userPreferences colorForInstrumentedPartiallyCoveredCode).
- ] ifFalse:[
- (itemsWithUncalledMethods includes:cat) ifTrue:[
- clr := (userPreferences colorForInstrumentedPartiallyCoveredCode).
- ] ifFalse:[
- clr := (userPreferences colorForInstrumentedFullyCoveredCode).
- ]
- ]
- ] ifFalse:[
- clr := (userPreferences colorForInstrumentedNeverCalledCode).
- ].
- item := self colorize:cat with:(#color -> clr).
- ]
- ] ifFalse:[
- inChangeSet := itemsInChangeSet includes:cat.
- inChangeSet ifTrue:[
- item := self colorizeForChangedCode:cat.
- ].
+ showCoverageInformation ifTrue:[
+ (itemsWithInstrumentedMethods includes:cat) ifTrue:[
+ (itemsWithCalledMethods includes:cat) ifTrue:[
+ (itemsWithPartiallyCoveredMethods includes:cat) ifTrue:[
+ clr := (userPreferences colorForInstrumentedPartiallyCoveredCode).
+ ] ifFalse:[
+ (itemsWithUncalledMethods includes:cat) ifTrue:[
+ clr := (userPreferences colorForInstrumentedPartiallyCoveredCode).
+ ] ifFalse:[
+ clr := (userPreferences colorForInstrumentedFullyCoveredCode).
+ ]
+ ]
+ ] ifFalse:[
+ clr := (userPreferences colorForInstrumentedNeverCalledCode).
+ ].
+ item := self colorize:cat with:(#color -> clr).
+ ]
+ ] ifFalse:[
+ inChangeSet := itemsInChangeSet includes:cat.
+ inChangeSet ifTrue:[
+ item := self colorizeForChangedCode:cat.
+ ].
- inRemoteChangeSet := itemsInRemoteChangeSet includes:cat.
- inRemoteChangeSet ifTrue:[
- item := (self colorizeForChangedCodeInSmallTeam:'!! '),item.
- ].
- ].
+ inRemoteChangeSet := itemsInRemoteChangeSet includes:cat.
+ inRemoteChangeSet ifTrue:[
+ item := (self colorizeForChangedCodeInSmallTeam:'!! '),item.
+ ].
+ ].
- hasVarRef := itemsWithVarRefs includes:cat.
- hasVarRef ifTrue:[
- hasVarMod := itemsWithVarMods includes:cat.
- item := item asText
- emphasisAllAdd:(hasVarMod ifTrue:[emphasisForMod] ifFalse:[emphasisForRef]).
- ].
+ hasVarRef := itemsWithVarRefs includes:cat.
+ hasVarRef ifTrue:[
+ hasVarMod := itemsWithVarMods includes:cat.
+ item := item asText
+ emphasisAllAdd:(hasVarMod ifTrue:[emphasisForMod] ifFalse:[emphasisForRef]).
+ ].
- hasExtensions := itemsWithExtensions includes:cat.
- hasExtensions ifTrue:[
- item := item , emphasizedPlus.
- ].
- inChangeSet ifTrue:[
- item := item , self class markForBeingInChangeList.
- ].
- categoryList at:idx put:item.
- ]
+ hasExtensions := itemsWithExtensions includes:cat.
+ hasExtensions ifTrue:[
+ item := item , emphasizedPlus.
+ ].
+ inChangeSet ifTrue:[
+ item := item , self class markForBeingInChangeList.
+ ].
+ categoryList at:idx put:item.
+ ]
].
classesProcessed size > 0 ifTrue:[
- "/ those are simulated - in ST/X, empty categories do not
- "/ really exist; however, during browsing, it makes sense.
- AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
- AdditionalEmptyCategoriesPerClassName keysAndValuesDo:[:clsName :protocols |
- (classesProcessed contains:[:cls | cls name = clsName]) ifTrue:[
- categoryList addAll:protocols.
- rawProtocolList addAll:protocols.
- ]
- ]
- ].
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
+ AdditionalEmptyCategoriesPerClassName keysAndValuesDo:[:clsName :protocols |
+ (classesProcessed contains:[:cls | cls name = clsName]) ifTrue:[
+ categoryList addAll:protocols.
+ rawProtocolList addAll:protocols.
+ ]
+ ]
+ ].
].
self makeIndependent.
@@ -1463,63 +1466,63 @@
rawProtocolList sortWith:categoryList.
categoryList size == 1 ifTrue:[
- nm := categoryList first string.
- classes size == 1 ifTrue:[
- nm := classes first name , '-' , nm
- ].
- self protocolLabelHolder value:nm
+ nm := categoryList first string.
+ classes size == 1 ifTrue:[
+ nm := classes first name , '-' , nm
+ ].
+ self protocolLabelHolder value:nm
].
pseudoEntryColor := self class pseudoEntryForegroundColor.
categoryList notEmpty ifTrue:[
- noAllItem value ~~ true ifTrue:[
- |allName|
+ noAllItem value ~~ true ifTrue:[
+ |allName|
- countAll ifTrue:[
- allName := self class nameListEntryForALLWithCount bindWith:numAll.
- ] ifFalse:[
- allName := nameListEntryForALL.
- ].
- categoryList addFirst:(allName allItalic colorizeAllWith:pseudoEntryColor).
- rawProtocolList addFirst:nameListEntryForALL.
- ].
+ countAll ifTrue:[
+ allName := self class nameListEntryForALLWithCount bindWith:numAll.
+ ] ifFalse:[
+ allName := nameListEntryForALL.
+ ].
+ categoryList addFirst:(allName allItalic colorizeAllWith:pseudoEntryColor).
+ rawProtocolList addFirst:nameListEntryForALL.
+ ].
].
(lazyPseudoProtocols not and:[showPseudoProtocols value]) ifTrue:[
- addPseudoEntryWithColor := [:s :n :clr |
- n > 0 ifTrue:[
- categoryList
- add:((s bindWith:n) allItalic colorizeAllWith:clr).
- rawProtocolList add:s.
- ].
- ].
+ addPseudoEntryWithColor := [:s :n :clr |
+ n > 0 ifTrue:[
+ categoryList
+ add:((s bindWith:n) allItalic colorizeAllWith:clr).
+ rawProtocolList add:s.
+ ].
+ ].
- addPseudoEntry := [:s :n | addPseudoEntryWithColor value:s value:n value:pseudoEntryColor].
+ addPseudoEntry := [:s :n | addPseudoEntryWithColor value:s value:n value:pseudoEntryColor].
- addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
- addPseudoEntry value:self class nameListEntryForRedefined value:numRedefine.
- addPseudoEntry value:self class nameListEntryForDocumentation value:numDocumentation.
- addPseudoEntry value:self class nameListEntryForUncommented value:numUncommented.
- addPseudoEntry value:self class nameListEntryForLong value:numLong.
- addPseudoEntry value:self class nameListEntryForObsolete value:numObsolete.
- addPseudoEntry value:self class nameListEntryForExtensions value:numExtension.
- addPseudoEntry value:self class nameListEntryForOverride value:numOverride.
- addPseudoEntry value:self class nameListEntryForMustBeRedefinedInSubclass value:numSubclassResponsibility.
- addPseudoEntry value:self class nameListEntryForAnnotated value:numAnnotated.
- showCoverageInformation ifTrue:[
- addPseudoEntryWithColor value:self class nameListEntryForPartiallyCovered value:numPartiallyCovered value:userPreferences colorForInstrumentedPartiallyCoveredCode.
- addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.
- addPseudoEntryWithColor value:self class nameListEntryForFullyCovered value:numFullyCovered value:userPreferences colorForInstrumentedFullyCoveredCode.
- addPseudoEntry value:self class nameListEntryForNotInstrumented value:numNotInstrumented.
- ].
+ addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
+ addPseudoEntry value:self class nameListEntryForRedefined value:numRedefine.
+ addPseudoEntry value:self class nameListEntryForDocumentation value:numDocumentation.
+ addPseudoEntry value:self class nameListEntryForUncommented value:numUncommented.
+ addPseudoEntry value:self class nameListEntryForLong value:numLong.
+ addPseudoEntry value:self class nameListEntryForObsolete value:numObsolete.
+ addPseudoEntry value:self class nameListEntryForExtensions value:numExtension.
+ addPseudoEntry value:self class nameListEntryForOverride value:numOverride.
+ addPseudoEntry value:self class nameListEntryForMustBeRedefinedInSubclass value:numSubclassResponsibility.
+ addPseudoEntry value:self class nameListEntryForAnnotated value:numAnnotated.
+ showCoverageInformation ifTrue:[
+ addPseudoEntryWithColor value:self class nameListEntryForPartiallyCovered value:numPartiallyCovered value:userPreferences colorForInstrumentedPartiallyCoveredCode.
+ addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.
+ addPseudoEntryWithColor value:self class nameListEntryForFullyCovered value:numFullyCovered value:userPreferences colorForInstrumentedFullyCoveredCode.
+ addPseudoEntry value:self class nameListEntryForNotInstrumented value:numNotInstrumented.
+ ].
- "/ I think red is too much of an alert color (and we get more of them as we think...)
+ "/ I think red is too much of an alert color (and we get more of them as we think...)
"/ numMissingRequired > 0 ifTrue:[
"/ categoryList add:((self class nameListEntryForRequired bindWith:numMissingRequired) allItalic "colorizeAllWith:Color red").
"/ rawProtocolList add:self class nameListEntryForRequired.
"/ ].
- addPseudoEntry value:self class nameListEntryForRequired value:numMissingRequired.
+ addPseudoEntry value:self class nameListEntryForRequired value:numMissingRequired.
].
^ categoryList
@@ -1555,7 +1558,7 @@
|prevClasses prevSelection newSelection newList oldList sameContents selectedProtocolsHolder rawList|
selectedProtocolsHolder := self selectedProtocols.
-
+
prevClasses := classes isNil ifTrue:[ #() ] ifFalse:[ classes copy ].
oldList := self protocolList value copy.
newList := self listOfMethodCategories.
@@ -1566,44 +1569,44 @@
sameContents := self updateListFor:newList.
self selectedProtocolIndices addDependent:self.
sameContents ifFalse:[
- prevSelection := lastSelectedProtocols ? (selectedProtocolsHolder value) ? #().
- "/ prevSelection := selectedProtocolsHolder value ? lastSelectedProtocols ? #().
+ prevSelection := lastSelectedProtocols ? (selectedProtocolsHolder value) ? #().
+ "/ prevSelection := selectedProtocolsHolder value ? lastSelectedProtocols ? #().
- rawList := self rawProtocolList value.
- newSelection := prevSelection select:[:item | rawList includes:item string].
+ rawList := self rawProtocolList value.
+ newSelection := prevSelection select:[:item | rawList includes:item string].
- newSelection size > 0 ifTrue:[
- "/ force change (for dependents)
+ newSelection size > 0 ifTrue:[
+ "/ force change (for dependents)
"/ selectedProtocolsHolder value:nil.
"/ selectedProtocolsHolder value:newSelection.
- selectedProtocolsHolder setValue:newSelection.
- selectedProtocolsHolder removeDependent:self.
- selectedProtocolsHolder changed:#value.
- selectedProtocolsHolder addDependent:self.
- ] ifFalse:[
- prevSelection := selectedProtocolsHolder value.
- selectedProtocolsHolder value:nil.
- ].
- (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
- self enqueueDelayedUpdateOutputGenerator.
- "/ self updateOutputGenerator.
- ].
+ selectedProtocolsHolder setValue:newSelection.
+ selectedProtocolsHolder removeDependent:self.
+ selectedProtocolsHolder changed:#value.
+ selectedProtocolsHolder addDependent:self.
+ ] ifFalse:[
+ prevSelection := selectedProtocolsHolder value.
+ selectedProtocolsHolder value:nil.
+ ].
+ (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ "/ self updateOutputGenerator.
+ ].
"/ prevSelection notNil ifTrue:[
"/ lastSelectedProtocols := prevSelection.
"/ ].
] ifTrue:[
- "/ same list - but classes might have changed
- "/ that is the case, if the class selection has been changed,
- "/ to another class which has the same categories.
- (prevClasses size ~= classes size
- or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
- (newList size > 0 or:[oldList size > 0]) ifTrue:[
- self updateOutputGenerator
- ]
- ] ifFalse:[
+ "/ same list - but classes might have changed
+ "/ that is the case, if the class selection has been changed,
+ "/ to another class which has the same categories.
+ (prevClasses size ~= classes size
+ or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
+ (newList size > 0 or:[oldList size > 0]) ifTrue:[
+ self updateOutputGenerator
+ ]
+ ] ifFalse:[
"/ self protocolList value:newList.
- ]
+ ]
].
listValid := true.
@@ -1626,53 +1629,53 @@
"/ reduce the average blocking time, and to allow for debugging the info generating
"/ code without deadlock
MethodInfoCacheAccessLock critical:[
- info := MethodInfoCache at:(mclass name,'>>',selector) ifAbsent:nil.
+ info := MethodInfoCache at:(mclass name,'>>',selector) ifAbsent:nil.
].
info isNil ifTrue:[
- lazy ifTrue:[
- "/ TODO: start a background thread to compute the stuff below,
- "/ notify me to update the list, when all the lazy info is avail...
- ] ifFalse:[
- true "aMethod mclass language isSmalltalk" ifTrue:[
- methodsPackage := aMethod package.
+ lazy ifTrue:[
+ "/ TODO: start a background thread to compute the stuff below,
+ "/ notify me to update the list, when all the lazy info is avail...
+ ] ifFalse:[
+ true "aMethod mclass language isSmalltalk" ifTrue:[
+ methodsPackage := aMethod package.
- isVersionMethod := aMethod isVersionMethod.
- isDocumentationMethod := isVersionMethod not and:[aMethod isDocumentationMethod].
+ isVersionMethod := aMethod isVersionMethod.
+ isDocumentationMethod := isVersionMethod not and:[aMethod isDocumentationMethod].
- info := CachedMethodInfo new.
- info isObsolete:(aMethod isObsolete). "/ (aMethod isObsolete).
- info sendsSuper:(aMethod superMessages notEmptyOrNil). "/ (aMethod superMessages notEmptyOrNil).
- info isUncommented:(self methodIsMarkedAsUncommented:aMethod). "/ (self methodIsMarkedAsUncommented:aMethod).
- info isDocumentationMethod:isDocumentationMethod.
- info isLongMethod:(self methodIsMarkedAsLong:aMethod). "/ (self methodIsMarkedAsLong:aMethod).
+ info := CachedMethodInfo new.
+ info isObsolete:(aMethod isObsolete). "/ (aMethod isObsolete).
+ info sendsSuper:(aMethod superMessages notEmptyOrNil). "/ (aMethod superMessages notEmptyOrNil).
+ info isUncommented:(self methodIsMarkedAsUncommented:aMethod). "/ (self methodIsMarkedAsUncommented:aMethod).
+ info isDocumentationMethod:isDocumentationMethod.
+ info isLongMethod:(self methodIsMarkedAsLong:aMethod). "/ (self methodIsMarkedAsLong:aMethod).
- methodsPackage ~= mclass package ifTrue:[
- methodsPackage ~= #'__NoProject__' ifTrue:[
- info isExtensionMethod:true.
- info isOverride:(
- ((def := methodsPackage asPackageId projectDefinitionClass) notNil
- and:[ (def methodOverwrittenBy:aMethod ) notNil ])
- )
- ]
- ] ifFalse:[
- info isExtensionMethod:false.
- info isOverride:false.
- ].
- info isRedefine:(
- ( isVersionMethod not
- and:[ isDocumentationMethod not
- and:[ mclass superclass notNil
- and:[ (mclass superclass whichClassIncludesSelector:selector ) notNil ]]])
- ).
+ methodsPackage ~= mclass package ifTrue:[
+ methodsPackage ~= #'__NoProject__' ifTrue:[
+ info isExtensionMethod:true.
+ info isOverride:(
+ ((def := methodsPackage asPackageId projectDefinitionClass) notNil
+ and:[ (def methodOverwrittenBy:aMethod ) notNil ])
+ )
+ ]
+ ] ifFalse:[
+ info isExtensionMethod:false.
+ info isOverride:false.
+ ].
+ info isRedefine:(
+ ( isVersionMethod not
+ and:[ isDocumentationMethod not
+ and:[ mclass superclass notNil
+ and:[ (mclass superclass whichClassIncludesSelector:selector ) notNil ]]])
+ ).
- info isSubclassResponsibility:( aMethod sends:#subclassResponsibility or:#subclassResponsibility: ).
- info isAnnotated:(aMethod hasAnnotation).
+ info isSubclassResponsibility:( aMethod sends:#subclassResponsibility or:#subclassResponsibility: ).
+ info isAnnotated:(aMethod hasAnnotation).
- MethodInfoCacheAccessLock critical:[
- MethodInfoCache at:(mclass name,'>>',selector) put:info
- ].
- ].
- ].
+ MethodInfoCacheAccessLock critical:[
+ MethodInfoCache at:(mclass name,'>>',selector) put:info
+ ].
+ ].
+ ].
].
^ info
@@ -1691,20 +1694,20 @@
"/ but do not blame the user for writing documentation (dont count comments),
"/ or using literal arrays
RBParser notNil ifTrue:[
- ast := RBParser parseMethod:src.
- ast notNil ifTrue:[
- visitor := RBProgramNodeVisitor new.
- visitor pluggableNodeAction:
- [:eachNode |
- |lno|
- lno := eachNode lineNumber.
- lno notNil ifTrue:[ linesWithCode add:lno ].
- ].
+ ast := RBParser parseMethod:src.
+ ast notNil ifTrue:[
+ visitor := RBProgramNodeVisitor new.
+ visitor pluggableNodeAction:
+ [:eachNode |
+ |lno|
+ lno := eachNode lineNumber.
+ lno notNil ifTrue:[ linesWithCode add:lno ].
+ ].
- linesWithCode := Set new.
- ast acceptVisitor:visitor.
- linesWithCode size < UserPreferences current numberOfLinesForLongMethod "~~30" ifTrue:[^ false].
- ].
+ linesWithCode := Set new.
+ ast acceptVisitor:visitor.
+ linesWithCode size < UserPreferences current numberOfLinesForLongMethod "~~30" ifTrue:[^ false].
+ ].
].
^ true.
!
@@ -1712,14 +1715,14 @@
methodIsMarkedAsUncommented:aMethod
"if true, it will be also categorized under the pseudo category 'undocumented'"
- ^ aMethod comment isEmptyOrNil
+ ^ aMethod comment isEmptyOrNil
and:[aMethod isVersionMethod not]
! !
!MethodCategoryList methodsFor:'special'!
addAdditionalProtocol:aProtocol forClass:aClass
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
@@ -1727,12 +1730,12 @@
|categories|
AdditionalEmptyCategoriesPerClassName isNil ifTrue:[
- AdditionalEmptyCategoriesPerClassName := Dictionary new.
+ AdditionalEmptyCategoriesPerClassName := Dictionary new.
].
categories := AdditionalEmptyCategoriesPerClassName at:aClass name ifAbsent:nil.
categories isNil ifTrue:[
- categories := Set new.
- AdditionalEmptyCategoriesPerClassName at:aClass name put:categories.
+ categories := Set new.
+ AdditionalEmptyCategoriesPerClassName at:aClass name put:categories.
].
categories add:aProtocol.
aClass changed:#organization. "/ not really ... to force update
@@ -1742,7 +1745,7 @@
!
additionalProtocolForClass:aClass
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
@@ -1762,7 +1765,7 @@
!
removeAdditionalProtocol:aListOfProtocols forClass:aClass
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
@@ -1775,7 +1778,7 @@
categories isNil ifTrue:[^ self].
categories removeAllFoundIn:aListOfProtocols.
categories isEmpty ifTrue:[
- AdditionalEmptyCategoriesPerClassName removeKey:aClass name.
+ AdditionalEmptyCategoriesPerClassName removeKey:aClass name.
].
aClass changed:#organization. "/ not really ... to force update
@@ -1785,7 +1788,7 @@
!
removeAllAdditionalProtocol
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
@@ -1796,20 +1799,20 @@
!
removeAllAdditionalProtocolForClass:aClass
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
AdditionalEmptyCategoriesPerClassName notNil ifTrue:[
- AdditionalEmptyCategoriesPerClassName removeKey:aClass name ifAbsent:nil
+ AdditionalEmptyCategoriesPerClassName removeKey:aClass name ifAbsent:nil
].
"Modified (comment): / 01-08-2012 / 17:30:10 / cg"
!
renameAdditionalProtocol:oldName to:newName forClass:aClass
- "those are simulated - in ST/X, empty categories do not really exist;
+ "those are simulated - in ST/X, empty categories do not really exist;
(because the category is an attribute of the method)
However, during browsing, it makes sense. Therefore, empty categories are
remembered here"
@@ -1867,8 +1870,8 @@
isAnnotated:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsAnnotated ]
- ifFalse:[ flags bitClear: FlagIsAnnotated]
+ ifTrue:[ flags bitOr: FlagIsAnnotated ]
+ ifFalse:[ flags bitClear: FlagIsAnnotated]
"Created: / 07-09-2011 / 10:04:48 / cg"
!
@@ -1879,8 +1882,8 @@
isDocumentationMethod:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsDocumentationMethod ]
- ifFalse:[ flags bitClear: FlagIsDocumentationMethod]
+ ifTrue:[ flags bitOr: FlagIsDocumentationMethod ]
+ ifFalse:[ flags bitClear: FlagIsDocumentationMethod]
!
isExtensionMethod
@@ -1889,8 +1892,8 @@
isExtensionMethod:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsExtension ]
- ifFalse:[ flags bitClear: FlagIsExtension]
+ ifTrue:[ flags bitOr: FlagIsExtension ]
+ ifFalse:[ flags bitClear: FlagIsExtension]
!
isLongMethod
@@ -1899,8 +1902,8 @@
isLongMethod:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsLongMethod ]
- ifFalse:[ flags bitClear: FlagIsLongMethod]
+ ifTrue:[ flags bitOr: FlagIsLongMethod ]
+ ifFalse:[ flags bitClear: FlagIsLongMethod]
!
isObsolete
@@ -1909,8 +1912,8 @@
isObsolete:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagObsolete ]
- ifFalse:[ flags bitClear: FlagObsolete]
+ ifTrue:[ flags bitOr: FlagObsolete ]
+ ifFalse:[ flags bitClear: FlagObsolete]
!
isOverride
@@ -1919,8 +1922,8 @@
isOverride:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsOverride ]
- ifFalse:[ flags bitClear: FlagIsOverride]
+ ifTrue:[ flags bitOr: FlagIsOverride ]
+ ifFalse:[ flags bitClear: FlagIsOverride]
!
isRedefine
@@ -1929,8 +1932,8 @@
isRedefine:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsRedefine ]
- ifFalse:[ flags bitClear: FlagIsRedefine]
+ ifTrue:[ flags bitOr: FlagIsRedefine ]
+ ifFalse:[ flags bitClear: FlagIsRedefine]
!
isSubclassResponsibility
@@ -1939,8 +1942,8 @@
isSubclassResponsibility:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsSubclassResponsibility ]
- ifFalse:[ flags bitClear: FlagIsSubclassResponsibility]
+ ifTrue:[ flags bitOr: FlagIsSubclassResponsibility ]
+ ifFalse:[ flags bitClear: FlagIsSubclassResponsibility]
!
isTest
@@ -1953,10 +1956,10 @@
^ (flags ? 0) bitTest: FlagIsUncommented
!
-isUncommented:aBoolean
+isUncommented:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagIsUncommented ]
- ifFalse:[ flags bitClear: FlagIsUncommented]
+ ifTrue:[ flags bitOr: FlagIsUncommented ]
+ ifFalse:[ flags bitClear: FlagIsUncommented]
!
sendsSuper
@@ -1965,8 +1968,8 @@
sendsSuper:aBoolean
flags := aBoolean
- ifTrue:[ flags bitOr: FlagSendsSuper ]
- ifFalse:[ flags bitClear: FlagSendsSuper]
+ ifTrue:[ flags bitOr: FlagSendsSuper ]
+ ifFalse:[ flags bitClear: FlagSendsSuper]
! !
!MethodCategoryList::MissingMethod class methodsFor:'instance creation'!
@@ -2000,8 +2003,8 @@
source
^ (SmalltalkCodeGeneratorTool basicNew
- codeFor_shouldImplementFor:selector inClass:mclass)
- colorizeAllWith:Color red
+ codeFor_shouldImplementFor:selector inClass:mclass)
+ colorizeAllWith:Color red
"Modified: / 31-01-2011 / 18:29:17 / cg"
! !
@@ -2023,7 +2026,7 @@
!
version_SVN
- ^ '$Id: Tools__MethodCategoryList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__MethodCategoryList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
! !
MethodCategoryList::CachedMethodInfo initialize!
--- a/Tools__MethodList.st Tue Oct 02 11:36:39 2012 +0100
+++ b/Tools__MethodList.st Wed Oct 03 23:28:49 2012 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -31,7 +31,7 @@
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -58,31 +58,31 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #singleMethodWindowSpec
- #window:
+ #name: #singleMethodWindowSpec
+ #window:
#(#WindowSpec
- #label: 'SingleSelectorList'
- #name: 'SingleSelectorList'
- #min: #(#Point 0 0)
- #max: #(#Point 1024 721)
- #bounds: #(#Rectangle 12 22 312 322)
- )
- #component:
+ #label: 'SingleSelectorList'
+ #name: 'SingleSelectorList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#LabelSpec
- #label: 'MethodName'
- #name: 'MethodLabel'
- #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
- #translateLabel: true
- #labelChannel: #methodLabelHolder
- #menu: #menuHolder
- )
- )
-
- )
+ #collection: #(
+ #(#LabelSpec
+ #label: 'MethodName'
+ #name: 'MethodLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #methodLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
)
"Modified: / 1.3.2000 / 20:50:15 / cg"
@@ -103,44 +103,44 @@
<resource: #canvas>
- ^
+ ^
#(FullSpec
- name: windowSpec
- window:
+ name: windowSpec
+ window:
(WindowSpec
- label: 'SelectorList'
- name: 'SelectorList'
- min: (Point 0 0)
- bounds: (Rectangle 0 0 300 300)
- )
- component:
+ label: 'SelectorList'
+ name: 'SelectorList'
+ 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: selectedMethodNameIndices
- menu: menuHolder
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- miniScrollerHorizontal: true
- isMultiSelect: true
- valueChangeSelector: selectionChangedByClick
- useIndex: true
- sequenceList: browserNameList
- doubleClickChannel: doubleClickChannel
- properties:
- (PropertyListDictionary
- canDropSelector: canDropContext:
- dragArgument: nil
- dropArgument: nil
- dropSelector: doDropContext:
- )
- )
- )
-
- )
+ collection: (
+ (SequenceViewSpec
+ name: 'List'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ tabable: true
+ model: selectedMethodNameIndices
+ menu: menuHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ isMultiSelect: true
+ valueChangeSelector: selectionChangedByClick
+ useIndex: true
+ sequenceList: browserNameList
+ doubleClickChannel: doubleClickChannel
+ properties:
+ (PropertyListDictionary
+ canDropSelector: canDropContext:
+ dragArgument: nil
+ dropArgument: nil
+ dropSelector: doDropContext:
+ )
+ )
+ )
+
+ )
)
! !
@@ -158,25 +158,25 @@
(if this app is embedded in a subCanvas)."
^ #(
- #(doubleClickChannel action)
- #filterClassVars
- #forceGeneratorTrigger
- #immediateUpdate
- #inGeneratorHolder
- #menuHolder
- #methodCategoryHolder
- #packageFilter
- #selectedMethods
- #selectionChangeCondition
- #showCoverageInformation
- #showImageResourceMethodsImages
- #showMethodComplexity
- #showMethodInheritance
- #showMethodTypeIcon
- #sortBy
- #updateTrigger
- #variableFilter
- #showSyntheticMethods
+ #(doubleClickChannel action)
+ #filterClassVars
+ #forceGeneratorTrigger
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #methodCategoryHolder
+ #packageFilter
+ #selectedMethods
+ #selectionChangeCondition
+ #showCoverageInformation
+ #showImageResourceMethodsImages
+ #showMethodComplexity
+ #showMethodInheritance
+ #showMethodTypeIcon
+ #sortBy
+ #updateTrigger
+ #variableFilter
+ #showSyntheticMethods
).
"Modified: / 13-04-2012 / 16:11:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -186,7 +186,7 @@
browserNameList
browserNameList isNil ifTrue:[
- browserNameList := List new.
+ browserNameList := List new.
].
^ browserNameList.
@@ -200,19 +200,19 @@
filterClassVars
filterClassVars isNil ifTrue:[
- filterClassVars := false asValue.
- filterClassVars addDependent:self
+ filterClassVars := false asValue.
+ filterClassVars addDependent:self
].
^ filterClassVars
!
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
- filterClassVars removeDependent:self
+ filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
- filterClassVars addDependent:self
+ filterClassVars addDependent:self
].
!
@@ -228,8 +228,8 @@
selectedMethodNameIndices
selectedMethodNameIndices isNil ifTrue:[
- selectedMethodNameIndices := ValueHolder new.
- selectedMethodNameIndices addDependent:self
+ selectedMethodNameIndices := ValueHolder new.
+ selectedMethodNameIndices addDependent:self
].
^ selectedMethodNameIndices.
@@ -247,80 +247,80 @@
showImageResourceMethodsImages
showImageResourceMethodsImages isNil ifTrue:[
- showImageResourceMethodsImages := false asValue.
- showImageResourceMethodsImages addDependent:self
+ showImageResourceMethodsImages := false asValue.
+ showImageResourceMethodsImages addDependent:self
].
^ showImageResourceMethodsImages
!
showImageResourceMethodsImages:aValueHolder
showImageResourceMethodsImages notNil ifTrue:[
- showImageResourceMethodsImages removeDependent:self
+ showImageResourceMethodsImages removeDependent:self
].
showImageResourceMethodsImages := aValueHolder.
showImageResourceMethodsImages notNil ifTrue:[
- showImageResourceMethodsImages addDependent:self
+ showImageResourceMethodsImages addDependent:self
].
!
showMethodComplexity
showMethodComplexity isNil ifTrue:[
- showMethodComplexity := false asValue.
- showMethodComplexity addDependent:self
+ showMethodComplexity := false asValue.
+ showMethodComplexity addDependent:self
].
^ showMethodComplexity
!
showMethodComplexity:aValueHolder
showMethodComplexity notNil ifTrue:[
- showMethodComplexity removeDependent:self
+ showMethodComplexity removeDependent:self
].
showMethodComplexity := aValueHolder.
showMethodComplexity notNil ifTrue:[
- showMethodComplexity addDependent:self
+ showMethodComplexity addDependent:self
].
!
showMethodInheritance
showMethodInheritance isNil ifTrue:[
- showMethodInheritance := false asValue.
- showMethodInheritance addDependent:self
+ showMethodInheritance := false asValue.
+ showMethodInheritance addDependent:self
].
^ showMethodInheritance
!
showMethodInheritance:aValueHolder
showMethodInheritance notNil ifTrue:[
- showMethodInheritance removeDependent:self
+ showMethodInheritance removeDependent:self
].
showMethodInheritance := aValueHolder.
showMethodInheritance notNil ifTrue:[
- showMethodInheritance addDependent:self
+ showMethodInheritance addDependent:self
].
!
showMethodTypeIcon
showMethodTypeIcon isNil ifTrue:[
- showMethodTypeIcon := true asValue.
- showMethodTypeIcon addDependent:self
+ showMethodTypeIcon := true asValue.
+ showMethodTypeIcon addDependent:self
].
^ showMethodTypeIcon
!
showMethodTypeIcon:aValueHolder
showMethodTypeIcon notNil ifTrue:[
- showMethodTypeIcon removeDependent:self
+ showMethodTypeIcon removeDependent:self
].
showMethodTypeIcon := aValueHolder.
showMethodTypeIcon notNil ifTrue:[
- showMethodTypeIcon addDependent:self
+ showMethodTypeIcon addDependent:self
].
!
showSyntheticMethods
showSyntheticMethods isNil ifTrue:[
- showSyntheticMethods := false asValue.
- showSyntheticMethods addDependent:self
+ showSyntheticMethods := false asValue.
+ showSyntheticMethods addDependent:self
].
^ showSyntheticMethods
@@ -329,11 +329,11 @@
showSyntheticMethods:aValueHolder
showSyntheticMethods notNil ifTrue:[
- showSyntheticMethods removeDependent:self
+ showSyntheticMethods removeDependent:self
].
showSyntheticMethods := aValueHolder.
showSyntheticMethods notNil ifTrue:[
- showSyntheticMethods addDependent:self
+ showSyntheticMethods addDependent:self
].
"Created: / 13-04-2012 / 16:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -341,19 +341,19 @@
variableFilter
variableFilter isNil ifTrue:[
- variableFilter := nil asValue.
- variableFilter addDependent:self
+ variableFilter := nil asValue.
+ variableFilter addDependent:self
].
^ variableFilter
!
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
- variableFilter removeDependent:self
+ variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
- variableFilter addDependent:self
+ variableFilter addDependent:self
].
! !
@@ -367,185 +367,185 @@
selection := selectionHolder value.
changedObject == Smalltalk ifTrue:[
- classes notNil ifTrue:[
- something == #classDefinition ifTrue:[
- cls := aParameter.
- (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
- (Smalltalk at:eachClass theNonMetaclass name) class
- ] ifFalse:[
- Smalltalk at:eachClass name
- ]
- ].
- self invalidateList.
+ classes notNil ifTrue:[
+ something == #classDefinition ifTrue:[
+ cls := aParameter.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
+ (Smalltalk at:eachClass theNonMetaclass name) class
+ ] ifFalse:[
+ Smalltalk at:eachClass name
+ ]
+ ].
+ self invalidateList.
"/ self updateList.
- ^ self.
- ].
+ ^ self.
+ ].
- something == #methodCategory ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
- (something == #classOrganization
- or:[ something == #methodCategoryAdded
- or:[ something == #methodCategoryRemoved
- or:[ something == #methodCategoriesRemoved
- or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
- something == #methodInClass ifTrue:[
- "/ a method has been added/changed
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- oldMethod := aParameter at:3.
- newMethod := cls compiledMethodAt:sel.
- (oldMethod notNil and:[newMethod notNil]) ifTrue:[
- "a method was changed & acccepted;
- No need for a rescan of the methodDictionary;
- however, ensure that the refs to the old method are updated
- "
- methods := selection.
- methods size > 0 ifTrue:[
- (methods includesIdentical:oldMethod) ifTrue:[
- needSelectionChange := true.
- ]
- ].
- methodList replaceAllIdentical:oldMethod with:newMethod.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
- ].
- methods size > 0 ifTrue:[
- methods := methods asOrderedCollection.
- methods replaceAllIdentical:oldMethod with:newMethod.
- ].
+ something == #methodInClass ifTrue:[
+ "/ a method has been added/changed
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ oldMethod := aParameter at:3.
+ newMethod := cls compiledMethodAt:sel.
+ (oldMethod notNil and:[newMethod notNil]) ifTrue:[
+ "a method was changed & acccepted;
+ No need for a rescan of the methodDictionary;
+ however, ensure that the refs to the old method are updated
+ "
+ methods := selection.
+ methods size > 0 ifTrue:[
+ (methods includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ methods size > 0 ifTrue:[
+ methods := methods asOrderedCollection.
+ methods replaceAllIdentical:oldMethod with:newMethod.
+ ].
- needSelectionChange == true ifTrue:[
- selectionHolder setValue:methods.
- "/ self enqueueDelayedMethodsSelectionChanged.
- "/ need this to inform my browser that method was changed
- "/ by someone else.
- selectionHolder changed.
- ].
- "/JV@2011-07-22: Update always - I need to see immediately that
- "/the method has changed. Also, add/remove breakpoint etc.
+ needSelectionChange == true ifTrue:[
+ selectionHolder setValue:methods.
+ "/ self enqueueDelayedMethodsSelectionChanged.
+ "/ need this to inform my browser that method was changed
+ "/ by someone else.
+ selectionHolder changed.
+ ].
+ "/JV@2011-07-22: Update always - I need to see immediately that
+ "/the method has changed. Also, add/remove breakpoint etc.
"/ (variableFilter value size > 0
"/ or:[oldMethod package ~= newMethod package
"/ or:[oldMethod resources ~= newMethod resources
"/ or:[showMethodComplexity value == true]]])
- self autoUpdateOnChange ifTrue:[
- "/ only update that method's entry
- self updateListEntryFor:newMethod.
- "/ sigh - must invalidate
- "/ self invalidateList.
- ].
- ^ self.
- ].
- "/ method was added - update the methodList
- "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
- self invalidateList.
- ].
- ^ self.
- ].
+ self autoUpdateOnChange ifTrue:[
+ "/ only update that method's entry
+ self updateListEntryFor:newMethod.
+ "/ sigh - must invalidate
+ "/ self invalidateList.
+ ].
+ ^ self.
+ ].
+ "/ method was added - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
- something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- "/ method was removed - update the methodList
- "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
- self invalidateList.
- ].
- ^ self.
- ].
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ "/ method was removed - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
- something == #methodCoverageInfo ifTrue:[
- "/ already checked if it is one of my classes
- self updateListEntryFor:aParameter.
+ something == #methodCoverageInfo ifTrue:[
+ "/ already checked if it is one of my classes
+ self updateListEntryFor:aParameter.
"/ self enqueueDelayedUpdateList.
"/ listValid == true ifTrue:[
"/ self invalidateList.
"/ ].
- ^ self.
- ].
+ ^ self.
+ ].
- (something == #methodTrap
- or:[ something == #lastTestRunResult
- or:[ something == #privacyOfMethod ]]) ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- (classes includesIdentical:cls) ifFalse:[ ^ self].
+ (something == #methodTrap
+ or:[ something == #lastTestRunResult
+ or:[ something == #privacyOfMethod ]]) ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ (classes includesIdentical:cls) ifFalse:[ ^ self].
- newMethod := cls compiledMethodAt:sel.
- newMethod isNil ifTrue:[
- self invalidateList.
- ^ self
- ].
+ newMethod := cls compiledMethodAt:sel.
+ newMethod isNil ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
- ((something == #privacyOfMethod) or:[something == #lastTestRunResult]) ifTrue:[
- self updateListEntryFor:newMethod.
- ].
+ ((something == #privacyOfMethod) or:[something == #lastTestRunResult]) ifTrue:[
+ self updateListEntryFor:newMethod.
+ ].
- (something == #methodTrap) ifTrue:[
- newMethod isWrapped ifTrue:[
- oldMethod := newMethod originalMethod
- ] ifFalse:[
- selection size > 0 ifTrue:[
- oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
- ]
- ].
+ (something == #methodTrap) ifTrue:[
+ newMethod isWrapped ifTrue:[
+ oldMethod := newMethod originalMethod
+ ] ifFalse:[
+ selection size > 0 ifTrue:[
+ oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
+ ]
+ ].
- selection size > 0 ifTrue:[
- (selection includesIdentical:oldMethod) ifTrue:[
- needSelectionChange := true.
- ]
- ].
- methodList replaceAllIdentical:oldMethod with:newMethod.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
- ].
- selection size > 0 ifTrue:[
- selection := selection asOrderedCollection.
- selection replaceAllIdentical:oldMethod with:newMethod.
- ].
- needSelectionChange == true ifTrue:[
- selectionHolder changed.
- ].
+ selection size > 0 ifTrue:[
+ (selection includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ selection size > 0 ifTrue:[
+ selection := selection asOrderedCollection.
+ selection replaceAllIdentical:oldMethod with:newMethod.
+ ].
+ needSelectionChange == true ifTrue:[
+ selectionHolder changed.
+ ].
- "/ actually, could just change that single item ...
- "/ ... might be cheaper, if list is huge.
- "/ only update that methods entry
- self updateListEntryFor:newMethod.
- "/ self invalidateList.
- ].
- ^ self
- ].
+ "/ actually, could just change that single item ...
+ "/ ... might be cheaper, if list is huge.
+ "/ only update that methods entry
+ self updateListEntryFor:newMethod.
+ "/ self invalidateList.
+ ].
+ ^ self
+ ].
- (something == #projectOrganization
- or:[something == #lastTestRunResult]) ifTrue:[
- aParameter notNil ifTrue:[
- cls := aParameter at:1.
- cls notNil ifTrue:[
- ((classes includesIdentical:cls theNonMetaclass)
- or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
- self invalidateList.
- ].
- ].
- ] ifFalse:[
- self invalidateList.
- ].
- ^ self
- ].
+ (something == #projectOrganization
+ or:[something == #lastTestRunResult]) ifTrue:[
+ aParameter notNil ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ ((classes includesIdentical:cls theNonMetaclass)
+ or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
+ self invalidateList.
+ ].
+ ].
+ ] ifFalse:[
+ self invalidateList.
+ ].
+ ^ self
+ ].
- "/ everything else is ignored
- "/ self halt.
- ].
- ^ self
+ "/ everything else is ignored
+ "/ self halt.
+ ].
+ ^ self
].
"/ something == #organization ifTrue:[
@@ -616,15 +616,15 @@
"/ ].
changedObject == sortBy ifTrue:[
- listValid ~~ true ifTrue:[ "/ could be nil
- inGeneratorHolder value isNil ifTrue:[
- "/ ok, no need to react on that one
- "/ (will invalidate anyway, once I have more info at hand)
- ^ self
- ].
- ].
- self invalidateList.
- ^ self
+ listValid ~~ true ifTrue:[ "/ could be nil
+ inGeneratorHolder value isNil ifTrue:[
+ "/ ok, no need to react on that one
+ "/ (will invalidate anyway, once I have more info at hand)
+ ^ self
+ ].
+ ].
+ self invalidateList.
+ ^ self
].
(changedObject == variableFilter
@@ -632,34 +632,34 @@
or:[changedObject == showMethodInheritance
or:[changedObject == showMethodComplexity
or:[changedObject == showSyntheticMethods]]]]) ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
changedObject == selectedMethodNameIndices ifTrue:[
- newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
- newSelection ~= selection ifTrue:[
- selectionHolder value:newSelection.
- lastSelectedMethods := newSelection.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods := lastSelectedMethods asOrderedCollection
- ].
- ] ifFalse:[
- "/ a reselect - force update
+ newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
+ newSelection ~= selection ifTrue:[
+ selectionHolder value:newSelection.
+ lastSelectedMethods := newSelection.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ] ifFalse:[
+ "/ a reselect - force update
"/ selection size == 1 ifTrue:[
- selectionHolder setValue:newSelection.
- selectionHolder changed:#value.
+ selectionHolder setValue:newSelection.
+ selectionHolder changed:#value.
"/ ].
- ].
- ^ self
+ ].
+ ^ self
].
changedObject == selectionHolder ifTrue:[
- self selectedMethodsChanged.
- lastSelectedMethods := selectionHolder value.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods := lastSelectedMethods asOrderedCollection
- ].
- ^ self
+ self selectedMethodsChanged.
+ lastSelectedMethods := selectionHolder value.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ^ self
].
"/ something == #methodTrap ifTrue:[
"/self halt:'no longer'.
@@ -710,17 +710,17 @@
"the set of selected methods has changed;
update the selection-index collection (for the selectionInListView)"
- |indices methods reverseMap
+ |indices methods reverseMap
selectedMethodsHolder selectedMethods selectedMethodNameIndicesHolder|
methods := methodList ? #().
methods size == 0 ifTrue:[
- "/ this may happen during early startup,
- "/ when invoked with a preset methodSelection,
- "/ and the methodGenerator has not yet been setup
- "/ to not clobber the selection, defer the update
- "/ until the methodList arrives ...
- ^ self
+ "/ this may happen during early startup,
+ "/ when invoked with a preset methodSelection,
+ "/ and the methodGenerator has not yet been setup
+ "/ to not clobber the selection, defer the update
+ "/ until the methodList arrives ...
+ ^ self
].
selectedMethodsHolder := self selectedMethods.
@@ -729,32 +729,32 @@
"/ check if all is selected (likely)
((selectedMethods size == methodList size)
and:[selectedMethods = methodList]) ifTrue:[
- indices := (1 to:selectedMethods size)
+ indices := (1 to:selectedMethods size)
] ifFalse:[
- selectedMethods size > 100 ifTrue:[
- "/ check if all is selected (likely)
- ((selectedMethods size == methodList size)
- and:[selectedMethods = methodList]) ifTrue:[
- indices := (1 to:selectedMethods size)
- ] ifFalse:[
- "/ for big collections, generate a reverse map
- reverseMap := IdentityDictionary new.
- methods keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
- indices := selectedMethods collect:[:eachSelectedMethod |
- reverseMap at:eachSelectedMethod ifAbsent:0
- ]
- ]
- ] ifFalse:[
- indices := (selectedMethods ? #()) collect:[:eachSelectedMethod |
- methods identityIndexOf:eachSelectedMethod.
- ]
- ].
- indices := indices select:[:idx | idx ~= 0].
+ selectedMethods size > 100 ifTrue:[
+ "/ check if all is selected (likely)
+ ((selectedMethods size == methodList size)
+ and:[selectedMethods = methodList]) ifTrue:[
+ indices := (1 to:selectedMethods size)
+ ] ifFalse:[
+ "/ for big collections, generate a reverse map
+ reverseMap := IdentityDictionary new.
+ methods keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
+ indices := selectedMethods collect:[:eachSelectedMethod |
+ reverseMap at:eachSelectedMethod ifAbsent:0
+ ]
+ ]
+ ] ifFalse:[
+ indices := (selectedMethods ? #()) collect:[:eachSelectedMethod |
+ methods identityIndexOf:eachSelectedMethod.
+ ]
+ ].
+ indices := indices select:[:idx | idx ~= 0].
].
selectedMethodNameIndicesHolder := self selectedMethodNameIndices.
selectedMethodNameIndicesHolder value ~= indices ifTrue:[
- selectedMethodNameIndicesHolder value:indices.
+ selectedMethodNameIndicesHolder value:indices.
]
!
@@ -763,11 +763,11 @@
methods := ((self selectedMethodNameIndices value) ? #()) collect:[:idx | methodList at:idx].
methods notEmpty ifTrue:[
- lastSelectedMethods := methods asOrderedCollection.
+ lastSelectedMethods := methods asOrderedCollection.
].
"/ to allow reselect, change my valueHolder, even if the same collection
"/ self selectedMethods value ~= methods ifTrue:[
- self selectedMethods value:methods
+ self selectedMethods value:methods
"/ ]
"Created: / 5.2.2000 / 13:42:14 / cg"
@@ -785,120 +785,123 @@
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
- "JV2012-02-17: Suppress updates if they're comming too fast
- (such as when booting Java or so)"
- ts := OperatingSystem getMillisecondTime.
- (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
- lastUpdateFromSmalltalkTimestamp := ts.
- numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
- numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
- ].
- numUpdatesFromSmalltalkInLast200Msecs := 0.
- lastUpdateFromSmalltalkTimestamp := ts.
- classes isNil ifTrue:[
- ^ self.
- ].
- something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
- ^ self.
- ].
+"/ JV@2012-10-03: Rubbish
+"/
+"/ "JV2012-02-17: Suppress updates if they're comming too fast
+"/ (such as when booting Java or so)"
+"/ ts := OperatingSystem getMillisecondTime.
+"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
+"/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
+"/ ].
+"/ numUpdatesFromSmalltalkInLast200Msecs := 0.
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+
+ classes isNil ifTrue:[
+ ^ self.
+ ].
+ something isNil ifTrue:[
+ "/ self halt "/ huh - Smalltalk changed - so what ?
+ ^ self.
+ ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #classVariables ifTrue:[
- ^ self.
- ].
- something == #organization ifTrue:[
- ^ self.
- ].
- something == #methodCategory ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
- (something == #classOrganization
- or:[ something == #methodCategoryAdded
- or:[ something == #methodCategoryRemoved
- or:[ something == #methodCategoriesRemoved
- or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #classVariables ifTrue:[
+ ^ self.
+ ].
+ something == #organization ifTrue:[
+ ^ self.
+ ].
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
- something == #methodCoverageInfo ifTrue:[
- self showCoverageInformation value ifFalse:[^ self].
- mthd := aParameter.
- (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- ].
+ something == #methodCoverageInfo ifTrue:[
+ self showCoverageInformation value ifFalse:[^ self].
+ mthd := aParameter.
+ (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ ].
- (something == #methodTrap
- or:[ something == #methodPrivacy
- or:[ something == #lastTestRunResult] ]) ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- self window shown ifFalse:[
- "JV@2011-11-17: Do not break the dependency here,
- because then the window won't get updates once
- deiconified -> leads to confusing behavior (browser
- shows obsolete info)"
- "/changedObject removeDependent:self. "/ ?????
- self invalidateList.
- ^ self
- ].
- ].
+ (something == #methodTrap
+ or:[ something == #methodPrivacy
+ or:[ something == #lastTestRunResult] ]) ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self window shown ifFalse:[
+ "JV@2011-11-17: Do not break the dependency here,
+ because then the window won't get updates once
+ deiconified -> leads to confusing behavior (browser
+ shows obsolete info)"
+ "/changedObject removeDependent:self. "/ ?????
+ self invalidateList.
+ ^ self
+ ].
+ ].
- "/ as the organisation changes, flush my remembered redefinition-cache-info
- classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
- something == #classDefinition ifTrue:[
- cls := aParameter.
- (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
- ^ self "/ I dont care for that class
- ].
+ something == #classDefinition ifTrue:[
+ cls := aParameter.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
"/ classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
-"/ (Smalltalk at:eachClass theNonMetaclass name) class
+"/ (Smalltalk at:eachClass theNonMetaclass name) class
"/ ] ifFalse:[
"/ Smalltalk at:eachClass name
"/ ]
"/ ].
"/ self updateList.
- self enqueueDelayedUpdate:something with:aParameter from:changedObject.
- ^ self.
- ].
- something == #newClass ifTrue:[
- ^ self.
- ].
- something == #classRemove ifTrue:[
- ^ self.
- ].
- something == #classRename ifTrue:[
- ^ self.
- ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+ something == #newClass ifTrue:[
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ ^ self.
+ ].
].
"/ these must lead to immediate update of the selectedMethods collection
"/ (otherwise, that collection might be updated too late, leading to
"/ an obsolete methods code being shown by the codeView.
something == #methodInClass ifTrue:[
- "/ as the organisation changes, flush my remembered redefinition-cache-info
- classAndSelectorsRedefinedBySubclassesOfClass := nil.
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- self enqueueDelayedUpdate:something with:aParameter from:changedObject.
- ^ self
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self
].
something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
].
super update:something with:aParameter from:changedObject
@@ -931,13 +934,13 @@
browser := self masterApplication.
aDropContext dragType == DropContext dragTypeCopy ifTrue:[
- browser
- copyMethods:methods
- toClass:(browser theSingleSelectedClass).
+ browser
+ copyMethods:methods
+ toClass:(browser theSingleSelectedClass).
] ifFalse:[
- browser
- moveMethods:methods
- toClass:(browser theSingleSelectedClass).
+ browser
+ moveMethods:methods
+ toClass:(browser theSingleSelectedClass).
].
"Modified: / 13-09-2006 / 11:43:44 / cg"
@@ -945,7 +948,7 @@
!MethodList methodsFor:'private'!
-isMethodToBeShown:aMethod
+isMethodToBeShown:aMethod
"invoked, when we get a change for aMethod which was previously not
in the list (for example, if I show a filtered list).
Check if that single method is to be shown now.
@@ -955,25 +958,25 @@
generator := inGeneratorHolder value.
generator isNil ifTrue:[
- ^ false
+ ^ false
].
-
+
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
-
- generator do:[:cls :cat :sel :mthd |
- mthd == aMethod ifTrue:[
- (mthd isSynthetic not or:[self showSyntheticMethods value]) ifTrue:[
- sel notNil ifTrue:[
+
+ generator do:[:cls :cat :sel :mthd |
+ mthd == aMethod ifTrue:[
+ (mthd isSynthetic not or:[self showSyntheticMethods value]) ifTrue:[
+ sel notNil ifTrue:[
"/ cg: no longer filter those...
-"/ (packageFilter value isNil
+"/ (packageFilter value isNil
"/ or:[ packageFilter value includes:mthd package ]) ifTrue:[
- ^ true
+ ^ true
"/ ]
- ]
- ].
- ^ false
- ]
+ ]
+ ].
+ ^ false
+ ]
].
^ false
@@ -982,21 +985,21 @@
!
listOfMethodNames
- |methods entries selectorBag newNameList allClasses newClasses
+ |methods entries selectorBag newNameList allClasses newClasses
allCategories "allSelectors"
- generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
+ generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
theMethod sortByClass anyMethodToWatch mclass
packageFilterValue|
generator := inGeneratorHolder value.
generator isNil ifTrue:[
- ^ #()
+ ^ #()
].
allClasses := IdentitySet new.
allCategories := IdentitySet new.
-
+
"/ allSelectors := Set new.
-
+
newClasses := IdentitySet new.
selectorBag := Bag new.
entries := OrderedCollection new.
@@ -1007,197 +1010,197 @@
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
-
+
generator do:[:cls :cat :sel :mthd |
- |categoryIsExtensionsPseudoCategory|
+ |categoryIsExtensionsPseudoCategory|
- categoryIsExtensionsPseudoCategory := (cat = self class nameListEntryForExtensions).
+ categoryIsExtensionsPseudoCategory := (cat = self class nameListEntryForExtensions).
- (cls isNil and:[ cat isNil and:[ sel isNil ] ]) ifTrue:[
- enforceClassAndProtocolInList := true
- ] ifFalse:[
- cls notNil ifTrue:[
- allClasses add:cls.
- ].
- cat notNil ifTrue:[
- allCategories add:cat.
- ].
- "/ JV: Filter method through package filter
- "/ but not, if it is an extension method and we are showing extensions
- (mthd notNil
- and:[ (mthd isSynthetic not or:[
- self showSyntheticMethods value
- ])
- and:[ sel notNil ]]
- ) ifTrue:[
- (packageFilterValue isNil
- or:[ (packageFilterValue includes:mthd package)
- or:[ categoryIsExtensionsPseudoCategory and:[ mthd isExtension ] ]]
- ) ifTrue:[
- entries add:(Array with:cls with:sel with:mthd).
- selectorBag add:sel.
- newClasses add:cls.
-
- "/ allSelectors add:sel.
- ]
- ]
- ].
- (mthd notNil and:[ mthd isWrapped ]) ifTrue:[
- (mthd isTiming or:[ mthd isCounting or:[ mthd isCountingMemoryUsage ] ]) ifTrue:[
- anyMethodToWatch := true
- ]
- ].
+ (cls isNil and:[ cat isNil and:[ sel isNil ] ]) ifTrue:[
+ enforceClassAndProtocolInList := true
+ ] ifFalse:[
+ cls notNil ifTrue:[
+ allClasses add:cls.
+ ].
+ cat notNil ifTrue:[
+ allCategories add:cat.
+ ].
+ "/ JV: Filter method through package filter
+ "/ but not, if it is an extension method and we are showing extensions
+ (mthd notNil
+ and:[ (mthd isSynthetic not or:[
+ self showSyntheticMethods value
+ ])
+ and:[ sel notNil ]]
+ ) ifTrue:[
+ (packageFilterValue isNil
+ or:[ (packageFilterValue includes:mthd package)
+ or:[ categoryIsExtensionsPseudoCategory and:[ mthd isExtension ] ]]
+ ) ifTrue:[
+ entries add:(Array with:cls with:sel with:mthd).
+ selectorBag add:sel.
+ newClasses add:cls.
+
+ "/ allSelectors add:sel.
+ ]
+ ]
+ ].
+ (mthd notNil and:[ mthd isWrapped ]) ifTrue:[
+ (mthd isTiming or:[ mthd isCounting or:[ mthd isCountingMemoryUsage ] ]) ifTrue:[
+ anyMethodToWatch := true
+ ]
+ ].
].
showMethodInheritance value ~~ false ifTrue:[
- "/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
- classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
- classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
- ].
- allClasses do:[:cls |
- |d|
+ "/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
+ classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
+ classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
+ ].
+ allClasses do:[:cls |
+ |d|
- d := classAndSelectorsRedefinedBySubclassesOfClass.
- (d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
- cls isLoaded ifTrue:[
- d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
- ]
- ]
- ].
+ d := classAndSelectorsRedefinedBySubclassesOfClass.
+ (d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
+ cls isLoaded ifTrue:[
+ d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
+ ]
+ ]
+ ].
].
-
+
"/ multiple classes must: add the className for some
-
+
doShowClass := enforceClassAndProtocolInList or:[ allClasses size > 1 ].
-
+
"/ multiple categories: must add the categorie for some
-
- doShowCategory := enforceClassAndProtocolInList
- or:[ allCategories size > 1 ].
+
+ doShowCategory := enforceClassAndProtocolInList
+ or:[ allCategories size > 1 ].
doShowClassFirst := doShowClass.
doShowClassFirst := doShowClass and:[ sortBy value == #class ].
sortBy value == false ifTrue:[
- "/ do not sort
+ "/ do not sort
] ifFalse:[
- (doShowClass not and:[ sortBy value == #class ]) ifTrue:[
- "/ multiple classes must add the className for some
- "/ check, if doShowClass must be enforced
- entries do:[:entry |
- |cls sel mthd s needClass|
+ (doShowClass not and:[ sortBy value == #class ]) ifTrue:[
+ "/ multiple classes must add the className for some
+ "/ check, if doShowClass must be enforced
+ entries do:[:entry |
+ |cls sel mthd s needClass|
- cls := entry at:1.
- sel := entry at:2.
- mthd := entry at:3.
- doShowClass ifFalse:[
- doShowClass := (selectorBag occurrencesOf:sel) > 1
- ].
- ].
- ].
- sortByClass := doShowClass and:[ sortBy value == #class ].
- sortByClass ifTrue:[
- entries
- sort:[:a :b |
- |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ doShowClass ifFalse:[
+ doShowClass := (selectorBag occurrencesOf:sel) > 1
+ ].
+ ].
+ ].
+ sortByClass := doShowClass and:[ sortBy value == #class ].
+ sortByClass ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[ nmA < nmB ]
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ].
- ] ifFalse:[
- sortBy value == #category ifTrue:[
- entries
- sort:[:a :b |
- |nmA nmB catA catB clsNmA clsNmB nsNmA nsNmB|
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ].
+ ] ifFalse:[
+ sortBy value == #category ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB catA catB clsNmA clsNmB nsNmA nsNmB|
- catA := (a at:3) category.
- catB := (b at:3) category.
- catA = catB ifTrue:[
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ] ifFalse:[ nmA < nmB ]
- ] ifFalse:[
- catA < catB
- ]
- ].
- ] ifFalse:[
- entries
- sort:[:a :b |
- |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+ catA := (a at:3) category.
+ catB := (b at:3) category.
+ catA = catB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ catA < catB
+ ]
+ ].
+ ] ifFalse:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ] ifFalse:[ nmA < nmB ]
- ].
- ].
- ].
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ].
+ ].
+ ].
].
methods := OrderedCollection new:(entries size).
-
+
"/ first generate the new methodList, and see if it is different ...
-
- entries do:[:entry |
- |sel mthd|
- mthd := entry at:3.
- methods add:mthd.
+ entries do:[:entry |
+ |sel mthd|
+
+ mthd := entry at:3.
+ methods add:mthd.
].
false "methodList = methods" "does not care for changed icons" ifTrue:[
- "/ same list
- newNameList := self browserNameList.
+ "/ same list
+ newNameList := self browserNameList.
] ifFalse:[
- newNameList := OrderedCollection new:(entries size).
-
- "/ multiple classes must add the className for some
-
- entries do:[:entry |
- |cls sel mthd s needClass|
+ newNameList := OrderedCollection new:(entries size).
+
+ "/ multiple classes must add the className for some
- cls := entry at:1.
- sel := entry at:2.
- mthd := entry at:3.
- needClass := doShowClass.
-
+ entries do:[:entry |
+ |cls sel mthd s needClass|
+
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ needClass := doShowClass.
+
"/ needClass ifFalse:[
"/ needClass := (selectorBag occurrencesOf:sel) > 1
"/ ].
-
- s := self
- listEntryForMethod:mthd
- selector:sel
- class:cls
- showClass:needClass
- showCategory:doShowCategory
- classFirst:doShowClassFirst.
-
+
+ s := self
+ listEntryForMethod:mthd
+ selector:sel
+ class:cls
+ showClass:needClass
+ showCategory:doShowCategory
+ classFirst:doShowClassFirst.
+
"/ s := mthd printStringForBrowserWithSelector:sel inClass:cls.
"/ needClass ifTrue:[
"/ s := s , ' [' , cls name , ']'.
@@ -1205,36 +1208,36 @@
"/ doShowCategory ifTrue:[
"/ s := s , ' {' , mthd category "asText allItalic" , '}'
"/ ].
-
- newNameList add:s.
- ].
+
+ newNameList add:s.
+ ].
].
self makeIndependent.
classes := newClasses.
self makeDependent.
methodList := methods.
methods size == 1 ifTrue:[
- theMethod := methods first.
- mclass := theMethod mclass.
- mclass isNil ifTrue:[
- theMethod isWrapped ifTrue:[
- theMethod := theMethod originalMethod.
- mclass := theMethod mclass.
- ].
- ].
- self methodLabelHolder value:(mclass isNil
- ifTrue:[ ('???' , ' ' , '???') ]
- ifFalse:[ (mclass name , ' ' , theMethod selector) ])
+ theMethod := methods first.
+ mclass := theMethod mclass.
+ mclass isNil ifTrue:[
+ theMethod isWrapped ifTrue:[
+ theMethod := theMethod originalMethod.
+ mclass := theMethod mclass.
+ ].
+ ].
+ self methodLabelHolder value:(mclass isNil
+ ifTrue:[ ('???' , ' ' , '???') ]
+ ifFalse:[ (mclass name , ' ' , theMethod selector) ])
].
anyMethodToWatch ifTrue:[
- self startWatchProcess.
+ self startWatchProcess.
] ifFalse:[
- self stopWatchProcess.
+ self stopWatchProcess.
].
-
+
"/ remember these, in case of an incremental (single method only)
"/ update in the future.
-
+
lastShowClass := doShowClass.
lastShowClassFirst := doShowClassFirst.
lastShowCategory := doShowCategory.
@@ -1281,33 +1284,33 @@
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
- anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
+ anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
- "/ no need to parse
- ^ false
+ "/ no need to parse
+ ^ false
].
src := mthd source.
src notNil ifTrue:[
- "
- before doing a slow parse, quickly scan the
- methods source for the variables name ...
- "
- (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
- parser := Parser
- parseMethod:src
- in:cls
- ignoreErrors:true
- ignoreWarnings:true.
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- usedVars := parser perform:querySelector.
- (usedVars includesAny:variablesToHighLight)
- ifTrue:[
- ^ true
- ]
- ]
- ]
+ "
+ before doing a slow parse, quickly scan the
+ methods source for the variables name ...
+ "
+ (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
+ parser := Parser
+ parseMethod:src
+ in:cls
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ usedVars := parser perform:querySelector.
+ (usedVars includesAny:variablesToHighLight)
+ ifTrue:[
+ ^ true
+ ]
+ ]
+ ]
].
^ false
!
@@ -1317,7 +1320,7 @@
mClass := aMethod mclass.
(mClass notNil and:[mClass superclass notNil]) ifTrue:[
- ^ (mClass superclass whichClassIncludesSelector:aMethod selector) notNil.
+ ^ (mClass superclass whichClassIncludesSelector:aMethod selector) notNil.
].
^ false
!
@@ -1331,18 +1334,18 @@
"/ if possible, make use of info prepared by listOfMethodNames
classAndSelectorsRedefinedBySubclassesOfClass notNil
ifTrue:[
- setOfRedefinedSelectors := classAndSelectorsRedefinedBySubclassesOfClass at:mclass ifAbsent:nil.
- setOfRedefinedSelectors notNil ifTrue:[
- ^ setOfRedefinedSelectors includes:aMethod selector
- ]
+ setOfRedefinedSelectors := classAndSelectorsRedefinedBySubclassesOfClass at:mclass ifAbsent:nil.
+ setOfRedefinedSelectors notNil ifTrue:[
+ ^ setOfRedefinedSelectors includes:aMethod selector
+ ]
].
lastMethodClass == mclass ifTrue:[
- subClasses := lastMethodClassesSubclasses
+ subClasses := lastMethodClassesSubclasses
] ifFalse:[
- subClasses := aMethod mclass allSubclasses.
- lastMethodClassesSubclasses := subClasses.
- lastMethodClass := mclass.
+ subClasses := aMethod mclass allSubclasses.
+ lastMethodClassesSubclasses := subClasses.
+ lastMethodClass := mclass.
].
^ subClasses contains:[:cls | cls includesSelector:aMethod selector].
!
@@ -1354,21 +1357,21 @@
redefined := self methodIsRedefinedBelow:aMethod.
inherited ifTrue:[
- redefined ifTrue:[
- ^ self methodInheritedFromAboveAndRedefinedBelowIcon.
- ].
- ^ self methodInheritedFromAboveIcon.
+ redefined ifTrue:[
+ ^ self methodInheritedFromAboveAndRedefinedBelowIcon.
+ ].
+ ^ self methodInheritedFromAboveIcon.
].
subclassResponsibility := aMethod sends:#subclassResponsibility.
redefined ifTrue:[
- subclassResponsibility ifTrue:[
- ^ self methodIsSubclassResponsibilityAndRedefinedBelowIcon.
- ].
- ^ self methodRedefinedBelowIcon.
+ subclassResponsibility ifTrue:[
+ ^ self methodIsSubclassResponsibilityAndRedefinedBelowIcon.
+ ].
+ ^ self methodRedefinedBelowIcon.
].
subclassResponsibility ifTrue:[
- ^ self methodIsSubclassResponsibilityIcon.
+ ^ self methodIsSubclassResponsibilityIcon.
].
^ self methodEmptyInheritedIcon
@@ -1394,7 +1397,7 @@
set := IdentitySet new.
aClass allSubclassesDo:[:eachSubclass |
- set addAll:(eachSubclass methodDictionary keys).
+ set addAll:(eachSubclass methodDictionary keys).
].
^ set
!
@@ -1410,79 +1413,79 @@
oldListSize := self browserNameList size.
- self topApplication withWaitCursorDo:[
- newList := self listOfMethodNames.
- ].
- newListSize := newList size.
- sameContents := self updateListFor:newList.
+ self topApplication withWaitCursorDo:[
+ newList := self listOfMethodNames.
+ ].
+ newListSize := newList size.
+ sameContents := self updateListFor:newList.
- sameContents ifFalse:[
+ sameContents ifFalse:[
"/ self browserNameList value:newList.
- (prevSelection size == 0
- and:[selectedMethodsHolder value size ~~ 0]) ifTrue:[
- "/ this happens during early startup time,
- "/ when the selection is already (pre-)set,
- "/ and the methodList is generated the first time
- "/ (i.e. when opened with preset selection
+ (prevSelection size == 0
+ and:[selectedMethodsHolder value size ~~ 0]) ifTrue:[
+ "/ this happens during early startup time,
+ "/ when the selection is already (pre-)set,
+ "/ and the methodList is generated the first time
+ "/ (i.e. when opened with preset selection
- "/ do not clobber the selection in this case.
- prevSelection := selectedMethodsHolder value.
- ].
+ "/ do not clobber the selection in this case.
+ prevSelection := selectedMethodsHolder value.
+ ].
- (methodList size == 0 or:[prevSelection size == 0]) ifTrue:[
- newSelection := #()
- ] ifFalse:[
- methodSet := methodList.
+ (methodList size == 0 or:[prevSelection size == 0]) ifTrue:[
+ newSelection := #()
+ ] ifFalse:[
+ methodSet := methodList.
- "/ inclusion test is much faster with sets, if the number of items is large
- methodList size > 30 ifTrue:[
- "/ however, only if its worth building the set ...
- prevSelection size > 5 ifTrue:[
- methodSet := methodSet asIdentitySet.
- ]
- ].
- newSelection := prevSelection select:[:item | methodSet includesIdentical:item].
- ].
- newSelection size > 0 ifTrue:[
- newSelection size > 100 ifTrue:[
- "/ need selection indices - might be expensive if done straight forward...
- reverseMap := IdentityDictionary new.
- methodList keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
- newSelIdx := newSelection collect:[:mthd | reverseMap at:mthd].
- ] ifFalse:[
- newSelIdx := newSelection collect:[:mthd | methodList identityIndexOf:mthd]
- ].
+ "/ inclusion test is much faster with sets, if the number of items is large
+ methodList size > 30 ifTrue:[
+ "/ however, only if its worth building the set ...
+ prevSelection size > 5 ifTrue:[
+ methodSet := methodSet asIdentitySet.
+ ]
+ ].
+ newSelection := prevSelection select:[:item | methodSet includesIdentical:item].
+ ].
+ newSelection size > 0 ifTrue:[
+ newSelection size > 100 ifTrue:[
+ "/ need selection indices - might be expensive if done straight forward...
+ reverseMap := IdentityDictionary new.
+ methodList keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
+ newSelIdx := newSelection collect:[:mthd | reverseMap at:mthd].
+ ] ifFalse:[
+ newSelIdx := newSelection collect:[:mthd | methodList identityIndexOf:mthd]
+ ].
"/ self halt.
- "/ force change (for dependents)
- newSelIdx ~= selectedMethodNameIndices value ifTrue:[
- selectedMethodNameIndices value:newSelIdx.
- ].
- ] ifFalse:[
- lastSelectedMethods := selectedMethodsHolder value.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods := lastSelectedMethods asOrderedCollection
- ].
- selectedMethodNameIndices value size > 0 ifTrue:[
- selectedMethodNameIndices value:#().
- ]
- ].
+ "/ force change (for dependents)
+ newSelIdx ~= selectedMethodNameIndices value ifTrue:[
+ selectedMethodNameIndices value:newSelIdx.
+ ].
+ ] ifFalse:[
+ lastSelectedMethods := selectedMethodsHolder value.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ selectedMethodNameIndices value size > 0 ifTrue:[
+ selectedMethodNameIndices value:#().
+ ]
+ ].
- newSelection ~= prevSelection ifTrue:[
- self selectionChanged.
- ]
- ] ifTrue:[
- "/ same list - but classes might have changed
- "/ that is the case, if the class selection has been changed,
- "/ to another class which has the same categories.
+ newSelection ~= prevSelection ifTrue:[
+ self selectionChanged.
+ ]
+ ] ifTrue:[
+ "/ same list - but classes might have changed
+ "/ that is the case, if the class selection has been changed,
+ "/ to another class which has the same categories.
- (prevClasses size ~= classes size
- or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
- (newListSize > 0 or:[oldListSize > 0]) ifTrue:[
- self selectionChanged.
- ]
- ]
- ]
+ (prevClasses size ~= classes size
+ or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
+ (newListSize > 0 or:[oldListSize > 0]) ifTrue:[
+ self selectionChanged.
+ ]
+ ]
+ ]
"/ ].
"Modified: / 05-03-2007 / 16:07:24 / cg"
@@ -1495,31 +1498,31 @@
|s idx|
- s := self
- listEntryForMethod:aMethod
- selector:aMethod selector
- class:aMethod mclass
- showClass:lastShowClass
- showCategory:lastShowCategory
- classFirst:lastShowClassFirst.
+ s := self
+ listEntryForMethod:aMethod
+ selector:aMethod selector
+ class:aMethod mclass
+ showClass:lastShowClass
+ showCategory:lastShowCategory
+ classFirst:lastShowClassFirst.
idx := methodList identityIndexOf:aMethod.
idx == 0 ifTrue:[
- aMethod isWrapped ifTrue:[
- idx := methodList identityIndexOf:aMethod originalMethod.
- idx == 0 ifTrue:[
- "/ aMethod (wrapped) has changed its status, but is not in the list.
- ^ self.
- ].
- ]
+ aMethod isWrapped ifTrue:[
+ idx := methodList identityIndexOf:aMethod originalMethod.
+ idx == 0 ifTrue:[
+ "/ aMethod (wrapped) has changed its status, but is not in the list.
+ ^ self.
+ ].
+ ]
].
idx == 0 ifTrue:[
- "/ method was not previously shown; try to avoid a full update
- (self isMethodToBeShown:aMethod) ifTrue:[
- self invalidateList
- ].
+ "/ method was not previously shown; try to avoid a full update
+ (self isMethodToBeShown:aMethod) ifTrue:[
+ self invalidateList
+ ].
] ifFalse:[
- self browserNameList at:idx put:s.
+ self browserNameList at:idx put:s.
]
"Modified: / 17-08-2011 / 15:05:02 / cg"
@@ -1532,10 +1535,10 @@
aMethod category = 'documentation' ifTrue:[^ nil].
aMethod hasBeenCalled ifTrue:[
- aMethod haveAllBlocksBeenExecuted ifTrue:[
- ^ UserPreferences current colorForInstrumentedFullyCoveredCode
- ].
- ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
+ aMethod haveAllBlocksBeenExecuted ifTrue:[
+ ^ UserPreferences current colorForInstrumentedFullyCoveredCode
+ ].
+ ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
].
^ UserPreferences current colorForInstrumentedNeverCalledCode
@@ -1543,33 +1546,33 @@
!
listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst
- "answer a method list entry
- gimmics:
- adding a little image to breakPointed methods,
- inheritance indicators,
- highlight accessors of variable"
+ "answer a method list entry
+ gimmics:
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
- |clsName s icn variablesToHighlight classVarsToHighLight
- doHighLight doHighLightRed clr emp cat l redefIcon
+ |clsName s icn variablesToHighlight classVarsToHighLight
+ doHighLight doHighLightRed clr emp cat l redefIcon
metrics complexity complexityString complexityIcon mark|
aMethod isNil ifTrue:[
- "/ a non-existing (pseudo) method (such as required protocol)
- ^ selector colorizeAllWith:Color red.
+ "/ a non-existing (pseudo) method (such as required protocol)
+ ^ selector colorizeAllWith:Color red.
].
aMethod isAssociation ifTrue:[
- self halt:'should not happen'.
+ self halt:'should not happen'.
].
selector isNil ifTrue:[
- s := '???'
+ s := '???'
] ifFalse:[
- s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
+ s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
].
showClassFirst ifTrue:[
- clsName := cls nameInBrowser.
- s := clsName , ' ' , s allBold
+ clsName := cls nameInBrowser.
+ s := clsName , ' ' , s allBold
].
"/
@@ -1577,168 +1580,168 @@
"/ have higher prio ...
"/
(aMethod notNil and:[aMethod isWrapped]) ifTrue:[
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- aMethod isBreakpointed ifTrue:[
- icn := self stopIcon
- ] ifFalse:[
- aMethod isTimed ifTrue:[
- icn := self timeIcon
- ] ifFalse:[
- icn := self traceIcon
- ]
- ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ aMethod isBreakpointed ifTrue:[
+ icn := self stopIcon
+ ] ifFalse:[
+ aMethod isTimed ifTrue:[
+ icn := self timeIcon
+ ] ifFalse:[
+ icn := self traceIcon
+ ]
+ ].
].
icn isNil ifTrue:[
- self showImageResourceMethodsImages value ~~ false ifTrue:[
- (aMethod hasImageResource) ifTrue:[
- aMethod mclass isMeta ifTrue:[
- icn := aMethod valueWithReceiver:nil arguments:nil .
- ].
- ].
- ].
+ self showImageResourceMethodsImages value ~~ false ifTrue:[
+ (aMethod hasImageResource) ifTrue:[
+ aMethod mclass isMeta ifTrue:[
+ icn := aMethod valueWithReceiver:nil arguments:nil .
+ ].
+ ].
+ ].
].
icn isNil ifTrue:[
- showMethodTypeIcon value ~~ false ifTrue:[
- icn := self resourceIconForMethod:aMethod.
- ].
- icn isNil ifTrue:[
- aMethod isProtected ifTrue:[
- icn := self protectedMethodIcon
- ] ifFalse:[
- aMethod isPrivate ifTrue:[
- icn := self privateMethodIcon
- ] ifFalse:[
- (aMethod isIgnored) ifTrue:[
- icn := self ignoredMethodIcon
- ] ifFalse:[
- (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
- icn := self abstractMethodIcon
- ]
- ]
- ]
- ].
- ].
+ showMethodTypeIcon value ~~ false ifTrue:[
+ icn := self resourceIconForMethod:aMethod.
+ ].
+ icn isNil ifTrue:[
+ aMethod isProtected ifTrue:[
+ icn := self protectedMethodIcon
+ ] ifFalse:[
+ aMethod isPrivate ifTrue:[
+ icn := self privateMethodIcon
+ ] ifFalse:[
+ (aMethod isIgnored) ifTrue:[
+ icn := self ignoredMethodIcon
+ ] ifFalse:[
+ (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
+ icn := self abstractMethodIcon
+ ]
+ ]
+ ]
+ ].
+ ].
].
icn isNil ifTrue:[
- cls isTestCaseLike ifTrue:[
- ((cls isTestSelector: selector)
- and:[cls isAbstract not]) ifTrue:[
- "JV@2011-11-17: Show thumbs even if not all test were run"
- "/cls lastTestRunResultOrNil "== false" notNil ifTrue:[
- | realTestCaseCls |
- realTestCaseCls := cls isJavaClass
- ifTrue:[cls asTestCase]
- ifFalse:[cls].
- ((realTestCaseCls testSelectorFailed:selector) or:[(realTestCaseCls testSelectorError:selector)]) ifTrue:[
- icn := SystemBrowser testCaseFailedIcon
- ] ifFalse:[
- (realTestCaseCls testSelectorPassed: selector) ifTrue:
- [icn := SystemBrowser testCasePassedIcon]
- ].
- "/]
- ].
- ]
+ cls isTestCaseLike ifTrue:[
+ ((cls isTestSelector: selector)
+ and:[cls isAbstract not]) ifTrue:[
+ "JV@2011-11-17: Show thumbs even if not all test were run"
+ "/cls lastTestRunResultOrNil "== false" notNil ifTrue:[
+ | realTestCaseCls |
+ realTestCaseCls := cls isJavaClass
+ ifTrue:[cls asTestCase]
+ ifFalse:[cls].
+ ((realTestCaseCls testSelectorFailed:selector) or:[(realTestCaseCls testSelectorError:selector)]) ifTrue:[
+ icn := SystemBrowser testCaseFailedIcon
+ ] ifFalse:[
+ (realTestCaseCls testSelectorPassed: selector) ifTrue:
+ [icn := SystemBrowser testCasePassedIcon]
+ ].
+ "/]
+ ].
+ ]
].
showClass ifTrue:[
- showClassFirst ifFalse:[
- s := s , ' [' , cls name allBold , ']'.
- ]
+ showClassFirst ifFalse:[
+ s := s , ' [' , cls name allBold , ']'.
+ ]
].
showCategory ifTrue:[
- cat := aMethod category.
- cat notNil ifTrue:[
- s := s , ' {' , cat "asText allItalic" , '}'
- ]
+ cat := aMethod category.
+ cat notNil ifTrue:[
+ s := s , ' {' , cat "asText allItalic" , '}'
+ ]
].
self showCoverageInformation value ifTrue:[
- clr := self colorForCoverageInformationOfMethod:aMethod.
- clr notNil ifTrue:[
- s := self colorize:s with:(#color->clr).
- "/ aMethod isInstrumented ifTrue:[
- "/ icn := self instrumentationIcon
- "/ ].
- ].
+ clr := self colorForCoverageInformationOfMethod:aMethod.
+ clr notNil ifTrue:[
+ s := self colorize:s with:(#color->clr).
+ "/ aMethod isInstrumented ifTrue:[
+ "/ icn := self instrumentationIcon
+ "/ ].
+ ].
] ifFalse:[
- (ChangeSet current includesChangeForClass:cls selector:selector) ifTrue:[
- mark := self class markForBeingInChangeList.
- "/ mark := self colorizeForChangedCode:mark.
- s := s , mark.
- "/ cg: I dont know why this was disabled - it is req'd to
- "/ see changed methods in a method list (implementors...)
- s := self colorizeForChangedCode:s.
- ].
+ (ChangeSet current includesChangeForClass:cls selector:selector) ifTrue:[
+ mark := self class markForBeingInChangeList.
+ "/ mark := self colorizeForChangedCode:mark.
+ s := s , mark.
+ "/ cg: I dont know why this was disabled - it is req'd to
+ "/ see changed methods in a method list (implementors...)
+ s := self colorizeForChangedCode:s.
+ ].
- (SmallTeam notNil and:[SmallTeam includesChangeForClass:cls selector:selector]) ifTrue:[
- s := (self colorizeForChangedCodeInSmallTeam:'!! '),s
- ].
+ (SmallTeam notNil and:[SmallTeam includesChangeForClass:cls selector:selector]) ifTrue:[
+ s := (self colorizeForChangedCodeInSmallTeam:'!! '),s
+ ].
].
variablesToHighlight := variableFilter value.
variablesToHighlight size > 0 ifTrue:[
- classVarsToHighLight := filterClassVars value.
- classVarsToHighLight ifTrue:[
- doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
- ].
- ] ifFalse:[
- doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
- ]
- ].
- doHighLight ifTrue:[
- s := s allBold.
- doHighLightRed ifTrue:[
- emp := (UserPreferences current emphasisForWrittenVariable)
- ] ifFalse:[
- emp := (UserPreferences current emphasisForReadVariable)
- ].
- s := s emphasisAllAdd:emp
- ]
+ classVarsToHighLight := filterClassVars value.
+ classVarsToHighLight ifTrue:[
+ doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
+ ].
+ ] ifFalse:[
+ doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
+ ]
+ ].
+ doHighLight ifTrue:[
+ s := s allBold.
+ doHighLightRed ifTrue:[
+ emp := (UserPreferences current emphasisForWrittenVariable)
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForReadVariable)
+ ].
+ s := s emphasisAllAdd:emp
+ ]
].
- (showMethodComplexity value == true
+ (showMethodComplexity value == true
and:[ OOM::MethodMetrics notNil ]) ifTrue:[
- icn isNil ifTrue:[
- metrics := OOM::MethodMetrics forMethod:aMethod.
- complexity := metrics complexity ? 0.
- complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
+ icn isNil ifTrue:[
+ metrics := OOM::MethodMetrics forMethod:aMethod.
+ complexity := metrics complexity ? 0.
+ complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
- ShowComplexityValue == true ifTrue:[
- complexityString := '{' , complexity printString , '}'.
- s := complexityString , ' ' , s.
- ].
- "/ icn := icn ? complexityIcon.
- s := LabelAndIcon icon:complexityIcon string:s.
- ].
+ ShowComplexityValue == true ifTrue:[
+ complexityString := '{' , complexity printString , '}'.
+ s := complexityString , ' ' , s.
+ ].
+ "/ icn := icn ? complexityIcon.
+ s := LabelAndIcon icon:complexityIcon string:s.
+ ].
].
showMethodInheritance value ~~ false ifTrue:[
- redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ redefIcon := self redefinedOrInheritedIconFor:aMethod.
].
"JV@2012-04-13: Show all synthetic methods in gray"
aMethod isSynthetic ifTrue:[
- s := s colorizeAllWith: Color gray.
+ s := s colorizeAllWith: Color gray.
].
(icn notNil or:[redefIcon notNil]) ifTrue:[
- "/eXept version
- "/l := LabelAndIcon icon:redefIcon string:s.
- "/l image:icn.
- "/JV:
- l := LabelAndIcon icon:icn string:s.
- l image:redefIcon.
- icn isNil ifTrue:[l offset: 13].
- l gap:1.
- ^ l
+ "/eXept version
+ "/l := LabelAndIcon icon:redefIcon string:s.
+ "/l image:icn.
+ "/JV:
+ l := LabelAndIcon icon:icn string:s.
+ l image:redefIcon.
+ icn isNil ifTrue:[l offset: 13].
+ l gap:1.
+ ^ l
].
^ s
@@ -1752,22 +1755,22 @@
startWatchProcess
updateProcess notNil ifTrue:[
- ^ self
+ ^ self
].
updateProcess := [
- [true] whileTrue:[
- Delay waitForSeconds:1.
- self enqueueDelayedUpdateList
- ]
- ] fork.
+ [true] whileTrue:[
+ Delay waitForSeconds:1.
+ self enqueueDelayedUpdateList
+ ]
+ ] fork.
!
stopWatchProcess
|p|
(p := updateProcess) notNil ifTrue:[
- updateProcess := nil.
- p terminate
+ updateProcess := nil.
+ p terminate
].
! !
@@ -1780,15 +1783,15 @@
methodListView := aBuilder componentAt:'List'.
methodListView notNil ifTrue:[
- methodListView allowDrag:true.
- methodListView dragObjectConverter:[:obj |
- |nm method idx|
+ methodListView allowDrag:true.
+ methodListView dragObjectConverter:[:obj |
+ |nm method idx|
- nm := obj theObject asString string string.
- idx := browserNameList value findFirst:[:item | item string string = nm].
- method := methodList value at:idx.
- DropObject newMethod:method.
- ].
+ nm := obj theObject asString string string.
+ idx := browserNameList value findFirst:[:item | item string string = nm].
+ method := methodList value at:idx.
+ DropObject newMethod:method.
+ ].
]
! !
@@ -1803,5 +1806,5 @@
!
version_SVN
- ^ '$Id: Tools__MethodList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__MethodList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
! !
--- a/Tools__ProjectList.st Tue Oct 02 11:36:39 2012 +0100
+++ b/Tools__ProjectList.st Wed Oct 03 23:28:49 2012 +0100
@@ -53,10 +53,10 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
#name: #singleProjectWindowSpec
- #window:
+ #window:
#(#WindowSpec
#label: 'ProjectList'
#name: 'ProjectList'
@@ -64,7 +64,7 @@
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
- #component:
+ #component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
@@ -96,44 +96,44 @@
<resource: #canvas>
- ^
+ ^
#(#FullSpec
- #name: #windowSpec
- #window:
+ #name: #windowSpec
+ #window:
#(#WindowSpec
- #label: 'ProjectList'
- #name: 'ProjectList'
- #min: #(#Point 0 0)
- #bounds: #(#Rectangle 13 23 313 323)
- )
- #component:
+ #label: 'ProjectList'
+ #name: 'ProjectList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 13 23 313 323)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#SequenceViewSpec
- #name: 'List'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #tabable: true
- #model: #selectionIndexHolder
- #menu: #menuHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isMultiSelect: true
- #valueChangeSelector: #selectionChangedByClick
- #useIndex: true
- #sequenceList: #projectNameList
- #doubleClickChannel: #doubleClickChannel
- #properties:
- #(#PropertyListDictionary
- #dragArgument: nil
- #dropArgument: nil
- #canDropSelector: #canDropContext:
- #dropSelector: #doDropContext:
- )
- )
- )
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectionIndexHolder
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #projectNameList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
- )
+ )
)
"Created: / 17.2.2000 / 23:45:47 / cg"
@@ -143,13 +143,13 @@
!ProjectList class methodsFor:'queries-plugin'!
aspectSelectors
- ^ #(
+ ^ #(
#(#doubleClickChannel #action )
- immediateUpdate
- selectedProjects
- menuHolder
- outGeneratorHolder
- inGeneratorHolder
+ immediateUpdate
+ selectedProjects
+ menuHolder
+ outGeneratorHolder
+ inGeneratorHolder
selectionChangeCondition
updateTrigger
forceGeneratorTrigger
@@ -184,8 +184,8 @@
projectNameList
projectNameList isNil ifTrue:[
- projectNameList := ValueHolder new.
- "/ projectNameList addDependent:self.
+ projectNameList := ValueHolder new.
+ "/ projectNameList addDependent:self.
].
^ projectNameList
@@ -204,8 +204,8 @@
selectionIndexHolder
selectionIndexHolder isNil ifTrue:[
- selectionIndexHolder := 0 asValue.
- selectionIndexHolder addDependent:self.
+ selectionIndexHolder := 0 asValue.
+ selectionIndexHolder addDependent:self.
].
^ selectionIndexHolder
@@ -217,96 +217,96 @@
delayedUpdate:something with:aParameter from:changedObject
|cls sel pkg mthd newSel allIdx|
- self inSlaveModeOrInvisible
- "/ (self slaveMode value == true)
+ self inSlaveModeOrInvisible
+ "/ (self slaveMode value == true)
ifTrue:[
- (changedObject == Smalltalk
- or:[ something == #projectOrganization ]) ifTrue:[
- listValid := false
- ].
- ^ self
+ (changedObject == Smalltalk
+ or:[ something == #projectOrganization ]) ifTrue:[
+ listValid := false
+ ].
+ ^ self
].
changedObject == self selectionIndexHolder ifTrue:[
- listValid ifFalse:[
- self updateList.
- ].
- newSel := changedObject value collect:[:idx | projectList value at:idx].
- newSel ~= self selectedProjects value ifTrue:[
- self selectedProjects value:newSel.
- ].
- ^ self.
+ listValid ifFalse:[
+ self updateList.
+ ].
+ newSel := changedObject value collect:[:idx | projectList value at:idx].
+ newSel ~= self selectedProjects value ifTrue:[
+ self selectedProjects value:newSel.
+ ].
+ ^ self.
].
changedObject == self selectionHolder ifTrue:[
- listValid == true ifFalse:[
- self updateList.
- ].
- allIdx := projectList value indexOf:(self class nameListEntryForALL).
- newSel := changedObject value
- collect:[:val | |i|
- i := projectList value indexOf:val.
- i == 0 ifTrue:[allIdx] ifFalse:[i]]
- thenSelect:[:idx | idx ~~ 0].
- newSel ~= self selectionIndexHolder value ifTrue:[
- self selectionIndexHolder value:newSel
- ].
+ listValid == true ifFalse:[
+ self updateList.
+ ].
+ allIdx := projectList value indexOf:(self class nameListEntryForALL).
+ newSel := changedObject value
+ collect:[:val | |i|
+ i := projectList value indexOf:val.
+ i == 0 ifTrue:[allIdx] ifFalse:[i]]
+ thenSelect:[:idx | idx ~~ 0].
+ newSel ~= self selectionIndexHolder value ifTrue:[
+ self selectionIndexHolder value:newSel
+ ].
].
changedObject == slaveMode ifTrue:[
- listValid ~~ true ifTrue:[
- self enqueueDelayedUpdateList
- ].
- "/ self invalidateList.
- ^ self
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ ^ self
].
changedObject == self projectList ifTrue:[
- ^ self
+ ^ self
].
changedObject == Smalltalk ifTrue:[
- something == #projectOrganization ifTrue:[
- self invalidateList.
- self enqueueDelayedUpdateOutputGenerator.
- ^ self.
- ].
- something == #methodInClass ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- mthd := cls compiledMethodAt:sel.
- mthd notNil ifTrue:[
- pkg := mthd package.
- (projectList value includes:pkg) ifFalse:[
- self invalidateList.
- ]
- ].
- ].
- ^ self
- ].
+ something == #projectOrganization ifTrue:[
+ self invalidateList.
+ self enqueueDelayedUpdateOutputGenerator.
+ ^ self.
+ ].
+ something == #methodInClass ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ mthd := cls compiledMethodAt:sel.
+ mthd notNil ifTrue:[
+ pkg := mthd package.
+ (projectList value includes:pkg) ifFalse:[
+ self invalidateList.
+ ]
+ ].
+ ].
+ ^ self
+ ].
- (something == #classDefinition
- or:[something == #newClass]) ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter.
- pkg := cls package.
- (projectList value includes:pkg) ifFalse:[
- self invalidateList.
- ] ifTrue:[
- self enqueueDelayedUpdateOutputGenerator
- ].
- ] ifFalse:[
- self invalidateList
- ].
- ^ self
- ].
- (something == #classRemove) ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter.
- pkg := cls package.
- ].
- ].
- ^ self
+ (something == #classDefinition
+ or:[something == #newClass]) ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ (projectList value includes:pkg) ifFalse:[
+ self invalidateList.
+ ] ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ] ifFalse:[
+ self invalidateList
+ ].
+ ^ self
+ ].
+ (something == #classRemove) ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ ].
+ ].
+ ^ self
].
"/ something == #projectOrganization ifTrue:[
@@ -320,14 +320,14 @@
"/ ].
changedObject == ChangeSet ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
(organizerMode notNil
and:[organizerMode value ~~ #project]) ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -347,43 +347,45 @@
(self builder isNil or:[self window topView realized not]) ifTrue:[
- self makeIndependent
+ self makeIndependent
].
changedObject == Smalltalk ifTrue:[
- "JV2012-02-17: Suppress updates if they're comming too fast
- (such as when booting Java or so)"
- ts := OperatingSystem getMillisecondTime.
- (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
- lastUpdateFromSmalltalkTimestamp := ts.
- numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
- numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
-
- ].
- numUpdatesFromSmalltalkInLast200Msecs := 0.
- lastUpdateFromSmalltalkTimestamp := ts.
+"/ JV@2012-10-03: Rubbish
+"/
+"/ "JV2012-02-17: Suppress updates if they're comming too fast
+"/ (such as when booting Java or so)"
+"/ ts := OperatingSystem getMillisecondTime.
+"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
+"/ lastUpdateFromSmalltalkTimestamp := ts.
+"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
+"/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
+"/
+"/ ].
+"/ numUpdatesFromSmalltalkInLast200Msecs := 0.
+"/ lastUpdateFromSmalltalkTimestamp := ts.
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
- something == #methodCoverageInfo ifTrue:[
- ^ self
- ].
- something == #methodInClass ifTrue:[
- ^ self
- ].
- something == #classVariables ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #methodInClassRemoved ifTrue:[
- ^ self.
- ].
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #methodCoverageInfo ifTrue:[
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[
+ ^ self
+ ].
+ something == #classVariables ifTrue:[
+ ^ self
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #methodInClassRemoved ifTrue:[
+ ^ self.
+ ].
].
super update:something with:aParameter from:changedObject
@@ -416,38 +418,38 @@
objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(objects conform:[:something | (something isMethod or:[something isClass])]) ifTrue:[
- methods := objects select:[:something | something isMethod].
- classes := objects select:[:something | something isClass].
+ methods := objects select:[:something | something isMethod].
+ classes := objects select:[:something | something isClass].
- package := self packageAtTargetPointOf:aDropContext.
- package notNil ifTrue:[
- methods notEmpty ifTrue:[
- self masterApplication moveMethods:methods toProject:package.
- ].
- classes notEmpty ifTrue:[
- self masterApplication moveClasses:classes toProject:package.
- ]
- ].
- ^ self
+ package := self packageAtTargetPointOf:aDropContext.
+ package notNil ifTrue:[
+ methods notEmpty ifTrue:[
+ self masterApplication moveMethods:methods toProject:package.
+ ].
+ classes notEmpty ifTrue:[
+ self masterApplication moveClasses:classes toProject:package.
+ ]
+ ].
+ ^ self
].
(objects conform:[:something | something isFilename]) ifTrue:[
- |p|
+ |p|
- p := (self selectedProjects value ? #()) firstIfEmpty:PackageId noProjectID.
+ p := (self selectedProjects value ? #()) firstIfEmpty:PackageId noProjectID.
- Class packageQuerySignal answer:p
- do:[
- self dropClassFiles:objects.
- ].
- ^ self
+ Class packageQuerySignal answer:p
+ do:[
+ self dropClassFiles:objects.
+ ].
+ ^ self
].
"Modified: / 17-10-2006 / 18:34:43 / cg"
!
packageAtTargetPointOf:aDropContext
- |p packageListView lineNr item package dropInfo now
+ |p packageListView lineNr item package dropInfo now
overItem timeOverItem|
p := aDropContext targetPoint.
@@ -464,23 +466,23 @@
item isString ifTrue:[^ item asSymbol].
item canExpand ifTrue:[
- now := Timestamp now.
- overItem := dropInfo at:#overItem ifAbsentPut:item.
- timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now].
+ now := Timestamp now.
+ overItem := dropInfo at:#overItem ifAbsentPut:item.
+ timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now].
- overItem ~~ item ifTrue:[
- dropInfo at:#timeOverItem put:now.
- dropInfo at:#overItem put:item.
- aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
- ] ifFalse:[
- (now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[
- aDropContext saveDraw:[ item expand. packageListView repairDamage ].
- dropInfo removeKey:#timeOverItem.
- dropInfo removeKey:#overItem.
- ] ifFalse:[
- aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
- ]
- ].
+ overItem ~~ item ifTrue:[
+ dropInfo at:#timeOverItem put:now.
+ dropInfo at:#overItem put:item.
+ aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
+ ] ifFalse:[
+ (now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[
+ aDropContext saveDraw:[ item expand. packageListView repairDamage ].
+ dropInfo removeKey:#timeOverItem.
+ dropInfo removeKey:#overItem.
+ ] ifFalse:[
+ aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
+ ]
+ ].
].
package := item package.
@@ -499,7 +501,7 @@
selectedPackages := self selectedProjects value.
selectedPackages size == 0 ifTrue:[
- ^ #()
+ ^ #()
].
selectedPackages := selectedPackages collect:[:p | p string withoutSeparators].
@@ -507,95 +509,95 @@
hideUnloadedClasses := self hideUnloadedClasses value.
(selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[
- hideUnloadedClasses ifTrue:[
- ^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
- cls isLoaded ifTrue:[
- cls isRealNameSpace ifFalse:[
- whatToDo value:cls
- ]
- ]
- ]
- ]
- ].
- ^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
- cls isRealNameSpace ifFalse:[
- whatToDo value:cls
- ]
- ]
- ]
+ hideUnloadedClasses ifTrue:[
+ ^ Iterator on:[:whatToDo |
+ Smalltalk allClassesDo:[:cls |
+ cls isLoaded ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ Iterator on:[:whatToDo |
+ Smalltalk allClassesDo:[:cls |
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
].
selectedPackages size == 1 ifTrue:[
- "/ faster common case
- thePackage := selectedPackages first.
+ "/ faster common case
+ thePackage := selectedPackages first.
- ^ Iterator on:[:whatToDo |
- |changedClasses|
+ ^ Iterator on:[:whatToDo |
+ |changedClasses|
- showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
- |doInclude|
+ Smalltalk allClassesDo:[:cls |
+ |doInclude|
- (hideUnloadedClasses not or:[cls isLoaded])
- ifTrue:[
- cls isRealNameSpace ifFalse:[
- doInclude := (thePackage = cls package).
- doInclude ifFalse:[
- cls isJavaClass ifFalse:[
- doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package])
- or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]].
- ].
- doInclude ifFalse:[
- (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass)
- or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[
- doInclude := true
- ].
- ].
- ].
- doInclude ifTrue:[
- whatToDo value:cls
- ]
- ]
- ]
- ]
- ]
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ doInclude := (thePackage = cls package).
+ doInclude ifFalse:[
+ cls isJavaClass ifFalse:[
+ doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package])
+ or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]].
+ ].
+ doInclude ifFalse:[
+ (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass)
+ or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[
+ doInclude := true
+ ].
+ ].
+ ].
+ doInclude ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ]
].
- ^ Iterator on:[:whatToDo |
- |changedClasses|
+ ^ Iterator on:[:whatToDo |
+ |changedClasses|
- showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
- |doInclude|
+ Smalltalk allClassesDo:[:cls |
+ |doInclude|
- (hideUnloadedClasses not or:[cls isLoaded])
- ifTrue:[
- cls isRealNameSpace ifFalse:[
- doInclude := (selectedPackages includes:cls package).
- doInclude ifFalse:[
- cls isJavaClass ifFalse:[
- doInclude := (cls methodDictionary contains:[:mthd | selectedPackages includes:mthd package])
- or:[ cls class methodDictionary contains:[:mthd | selectedPackages includes:mthd package]].
- doInclude ifFalse:[
- (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass)
- or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[
- doInclude := true
- ].
- ].
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ doInclude := (selectedPackages includes:cls package).
+ doInclude ifFalse:[
+ cls isJavaClass ifFalse:[
+ doInclude := (cls methodDictionary contains:[:mthd | selectedPackages includes:mthd package])
+ or:[ cls class methodDictionary contains:[:mthd | selectedPackages includes:mthd package]].
+ doInclude ifFalse:[
+ (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass)
+ or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[
+ doInclude := true
+ ].
+ ].
- ]
- ].
- doInclude ifTrue:[
- whatToDo value:cls
- ]
- ]
- ]
- ]
- ]
+ ]
+ ].
+ doInclude ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ]
"Created: / 17-02-2000 / 23:49:37 / cg"
"Modified: / 10-11-2006 / 17:15:15 / cg"
@@ -628,78 +630,78 @@
allProjects := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
- hideUnloaded := self hideUnloadedClasses value.
+ hideUnloaded := self hideUnloadedClasses value.
- addWithAllParentPackages :=
- [:package |
- |p parent module|
+ addWithAllParentPackages :=
+ [:package |
+ |p parent module|
- (allProjects includes:package) ifFalse:[
- allProjects add:package.
- (package ~= PackageId noProjectID
- and:[package ~= #private]) ifTrue:[
- p := package asPackageId.
- [(parent := p parentPackage) notNil] whileTrue:[
- allProjects add:parent asSymbol.
- p := parent.
- ].
- hideModules ifFalse:[
- (module := p module) notNil ifTrue:[
- allProjects add:module asSymbol.
- ].
- ].
- ].
- ].
- ].
+ (allProjects includes:package) ifFalse:[
+ allProjects add:package.
+ (package ~= PackageId noProjectID
+ and:[package ~= #private]) ifTrue:[
+ p := package asPackageId.
+ [(parent := p parentPackage) notNil] whileTrue:[
+ allProjects add:parent asSymbol.
+ p := parent.
+ ].
+ hideModules ifFalse:[
+ (module := p module) notNil ifTrue:[
+ allProjects add:module asSymbol.
+ ].
+ ].
+ ].
+ ].
+ ].
- Smalltalk allClassesDo:[:eachClass |
- |cls pkg p classPackage|
+ Smalltalk allClassesDo:[:eachClass |
+ |cls pkg p classPackage|
- eachClass isRealNameSpace ifFalse:[
+ eachClass isRealNameSpace ifFalse:[
- (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[
- cls := eachClass theNonMetaclass.
- cls isPrivate ifTrue:[
- cls := cls topOwningClass
- ].
+ (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[
+ cls := eachClass theNonMetaclass.
+ cls isPrivate ifTrue:[
+ cls := cls topOwningClass
+ ].
- classPackage := cls package ? (PackageId noProjectID).
- classPackage size > 0 ifTrue:[
- addWithAllParentPackages value:classPackage asSymbol.
- ] ifFalse:[
- "/ for now, nameSpaces are not in any package;
- "/ this might change. Then, 0-sized packages are
- "/ illegal, and the following should be enabled.
- "/ self halt
- ].
- cls isJavaClass ifFalse:[
- cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- |mpkg|
+ classPackage := cls package ? (PackageId noProjectID).
+ classPackage size > 0 ifTrue:[
+ addWithAllParentPackages value:classPackage asSymbol.
+ ] ifFalse:[
+ "/ for now, nameSpaces are not in any package;
+ "/ this might change. Then, 0-sized packages are
+ "/ illegal, and the following should be enabled.
+ "/ self halt
+ ].
+ cls isJavaClass ifFalse:[
+ cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ |mpkg|
- mpkg := mthd package asSymbol.
- mpkg ~~ classPackage ifTrue:[
- (allProjects includes:mpkg) ifFalse:[
- addWithAllParentPackages value:mpkg.
- ]
- ].
- ].
- ].
- ].
- ].
- ].
- allProjects := allProjects asOrderedCollection.
+ mpkg := mthd package asSymbol.
+ mpkg ~~ classPackage ifTrue:[
+ (allProjects includes:mpkg) ifFalse:[
+ addWithAllParentPackages value:mpkg.
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ allProjects := allProjects asOrderedCollection.
- "/ those are simulated - in ST/X, empty projects do not
- "/ really exist; however, during browsing, it makes sense.
- AdditionalEmptyProjects size > 0 ifTrue:[
- "/ remove those that are present ...
- AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
- allProjects addAll:AdditionalEmptyProjects.
- ].
+ "/ those are simulated - in ST/X, empty projects do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyProjects size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
+ allProjects addAll:AdditionalEmptyProjects.
+ ].
] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
- generator do:[:prj | allProjects add:prj].
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:prj | allProjects add:prj].
].
^ allProjects asOrderedCollection.
@@ -726,18 +728,18 @@
allProjects sort.
allProjects size == 1 ifTrue:[
- "/ self projectLabelHolder value:(allProjects first , ' [Project]').
- self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
+ "/ self projectLabelHolder value:(allProjects first , ' [Project]').
+ self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
].
numClassesInChangeSet := ChangeSet current changedClasses size.
numClassesInChangeSet > 0 ifTrue:[
- "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
- allProjects addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic).
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ allProjects addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic).
].
allProjects size > 1 ifTrue:[
- allProjects addFirst:(self class nameListEntryForALL allItalic).
+ allProjects addFirst:(self class nameListEntryForALL allItalic).
].
^ allProjects
@@ -762,11 +764,11 @@
(ConfigurableFeatures includesFeature: #SubversionSupportEnabled) ifFalse:[^rawEntry].
package = PackageId noProjectID ifTrue:[^rawEntry].
-"/ workerQueue
+"/ workerQueue
"/ nextPut:[
"/ | repo newEntry branch mark|
"/ "/ use Smalltalk-at to trick the dependency/prerequisite generator
-"/ repo := (Smalltalk at:#SVN::RepositoryManager) current
+"/ repo := (Smalltalk at:#SVN::RepositoryManager) current
"/ repositoryForPackage: package onlyFromCache: false.
"/ repo ifNotNil:[
"/ mark := ' [SVN]'.
@@ -786,21 +788,21 @@
nameListFor:aProjectList
"
self basicNew
- nameListFor:#(
- 'exept:expecco'
- 'exept:expecco/application'
- 'exept:procware'
- 'exept:workflow'
- )
+ nameListFor:#(
+ 'exept:expecco'
+ 'exept:expecco/application'
+ 'exept:procware'
+ 'exept:workflow'
+ )
self basicNew
- nameListFor:#(
- 'exept'
- 'exept:expecco'
- 'exept:expecco/application'
- 'exept:procware'
- 'exept:workflow'
- )
+ nameListFor:#(
+ 'exept'
+ 'exept:expecco'
+ 'exept:expecco/application'
+ 'exept:procware'
+ 'exept:workflow'
+ )
"
|stack projectsWithExtensions projectsWithChangedCode packagesInChangeSet projectNameList|
@@ -814,55 +816,55 @@
projectNameList := OrderedCollection new.
aProjectList do:[:this |
- |thisC entry rawEntry prefix indent|
+ |thisC entry rawEntry prefix indent|
- this = self class nameListEntryForALL ifTrue:[
- entry := this
- ] ifFalse:[
- thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
- thisC isEmpty ifTrue:[
- thisC := Array with:(PackageId noProjectID).
- ].
+ this = self class nameListEntryForALL ifTrue:[
+ entry := this
+ ] ifFalse:[
+ thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
+ thisC isEmpty ifTrue:[
+ thisC := Array with:(PackageId noProjectID).
+ ].
- [
- |stackTop|
+ [
+ |stackTop|
- stack notEmpty
- and:[
- stackTop := stack last.
- (thisC startsWith:stackTop) ifFalse:[
- stack removeLast.
- true
- ] ifTrue:[
- false
- ]]
- ] whileTrue.
- prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ].
- indent := stack size * 4.
- stack addLast:thisC.
- prefix isEmpty ifTrue:[
- rawEntry := thisC first.
- thisC size > 1 ifTrue:[
- rawEntry := rawEntry , ':' , ((thisC copyFrom:2) asStringWith:$/).
- ]
- ] ifFalse:[
- rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/.
- ].
+ stack notEmpty
+ and:[
+ stackTop := stack last.
+ (thisC startsWith:stackTop) ifFalse:[
+ stack removeLast.
+ true
+ ] ifTrue:[
+ false
+ ]]
+ ] whileTrue.
+ prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ].
+ indent := stack size * 4.
+ stack addLast:thisC.
+ prefix isEmpty ifTrue:[
+ rawEntry := thisC first.
+ thisC size > 1 ifTrue:[
+ rawEntry := rawEntry , ':' , ((thisC copyFrom:2) asStringWith:$/).
+ ]
+ ] ifFalse:[
+ rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/.
+ ].
- (packagesInChangeSet includes:this) ifTrue:[
- rawEntry := rawEntry , self class markForBeingInChangeList.
- rawEntry := self colorizeForChangedCode:rawEntry.
- ].
- entry := (String new:indent) , rawEntry.
- ((ConfigurableFeatures includesFeature: #SubversionSupportEnabled) and:[this first ~= $*]) ifTrue:[
- entry := self markEntry: entry at: projectNameList size + 1
- forBeingManagedBySVN: this.
- ].
- ].
- projectNameList add:entry.
+ (packagesInChangeSet includes:this) ifTrue:[
+ rawEntry := rawEntry , self class markForBeingInChangeList.
+ rawEntry := self colorizeForChangedCode:rawEntry.
+ ].
+ entry := (String new:indent) , rawEntry.
+ ((ConfigurableFeatures includesFeature: #SubversionSupportEnabled) and:[this first ~= $*]) ifTrue:[
+ entry := self markEntry: entry at: projectNameList size + 1
+ forBeingManagedBySVN: this.
+ ].
+ ].
+ projectNameList add:entry.
].
- self startWorker.
+ self startWorker.
^ projectNameList.
"Created: / 17-02-2000 / 23:43:05 / cg"
@@ -873,14 +875,14 @@
startWorker
worker ifNil:
- [worker :=
- [[workerQueue notEmpty ] whileTrue:
- [| job |
- job := workerQueue next.
- job value].
- worker := nil.
- ] newProcess.
- worker resume].
+ [worker :=
+ [[workerQueue notEmpty ] whileTrue:
+ [| job |
+ job := workerQueue next.
+ job value].
+ worker := nil.
+ ] newProcess.
+ worker resume].
"Created: / 14-12-2010 / 15:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-12-2010 / 17:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -903,14 +905,14 @@
"/ selectedProjectsHolder addDependent:self.
"/ ].
- self projectList value:newList.
- listValid := true.
- self projectNameList value:newNameList.
+ self projectList value:newList.
+ listValid := true.
+ self projectNameList value:newNameList.
- oldSelection size > 0 ifTrue:[
- newSelection := oldSelection select:[:prj | newList includes:prj].
- selectedProjectsHolder value:newSelection.
- ]
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:prj | newList includes:prj].
+ selectedProjectsHolder value:newSelection.
+ ]
].
listValid := true.
@@ -923,7 +925,7 @@
"JV@2012-03-08: HACK HACK HACK - fixes bug D1863581"
self slaveMode value == true ifTrue:[
- self updateList
+ self updateList
].
super commonPostBuild.
@@ -937,7 +939,7 @@
"/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects isNil ifTrue:[
- AdditionalEmptyProjects := Set new.
+ AdditionalEmptyProjects := Set new.
].
AdditionalEmptyProjects add:aProject.
@@ -966,5 +968,5 @@
!
version_SVN
- ^ '$Id: Tools__ProjectList.st 8059 2012-09-27 20:08:20Z vranyj1 $'
+ ^ '$Id: Tools__ProjectList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
! !