--- a/Tools_MethodCategoryList.st Sun Oct 04 17:08:41 2009 +0200
+++ b/Tools_MethodCategoryList.st Sun Oct 04 17:08:55 2009 +0200
@@ -28,7 +28,7 @@
Object subclass:#CachedMethodInfo
instanceVariableNames:'flags'
classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented
- FlagIsDocumentationMethod'
+ FlagIsDocumentationMethod FlagIsLongMethod'
poolDictionaries:''
privateIn:MethodCategoryList
!
@@ -53,6 +53,10 @@
flushMethodInfo
MethodInfoCache := Dictionary new.
+
+ "
+ self flushMethodInfo
+ "
!
initialize
@@ -792,7 +796,8 @@
^ Iterator
on:[:whatToDo |
|protocols
- allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols documentationProtocols
+ allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols
+ documentationProtocols longProtocols
noCat static notStatic classSelectorPairsAlreadyDone
packages remainingClasses remainingCategories classesAlreadyDone noPackage|
@@ -812,6 +817,7 @@
uncommentedProtocols := protocols includes:(self class nameListEntryForUncommented).
obsoleteProtocols := protocols includes:(self class nameListEntryForObsolete).
documentationProtocols := protocols includes:(self class nameListEntryForDocumentation).
+ longProtocols := protocols includes:(self class nameListEntryForLong).
"/ packages := packageFilter value value.
"/ (packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
@@ -871,6 +877,10 @@
documentationProtocols ifTrue:[
info isNil ifTrue:[ info := self methodInfoFor:mthd ].
includeIt := info isDocumentationMethod ]].
+ includeIt ifFalse:[
+ longProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd ].
+ includeIt := info isLongMethod ]].
includeIt ifTrue:[
(methodVisibilityHolder value == #class) ifTrue:[
@@ -995,7 +1005,7 @@
itemsInChangeSet itemsInRemoteChangeSet
packageFilterOnInput packageFilter nameListEntryForALL changeSet
emphasizedPlus emphasisForRef emphasisForMod
- numObsolete numSuper numUncommented numDocumentation|
+ numObsolete numSuper numUncommented numDocumentation numLong|
generator := inGeneratorHolder value.
generator isNil ifTrue:[ ^ #() ].
@@ -1023,7 +1033,7 @@
leafClassesProcessed := IdentitySet new.
variablesToHighlight := variableFilter value.
classVarsToHighLight := filterClassVars value.
- numObsolete := numSuper := numUncommented := numDocumentation := 0.
+ numObsolete := numSuper := numUncommented := numDocumentation := numLong := 0.
generator do:[:clsIn :catIn |
|emptyProtocols clsName doHighLight doHighLightRed suppress|
@@ -1076,6 +1086,7 @@
info sendsSuper ifTrue:[ numSuper := numSuper + 1 ].
info isUncommented ifTrue:[ numUncommented := numUncommented + 1 ].
info isDocumentationMethod ifTrue:[ numDocumentation := numDocumentation + 1 ].
+ info isLongMethod ifTrue:[ numLong := numLong + 1 ].
]
].
].
@@ -1225,6 +1236,10 @@
categoryList add:((self class nameListEntryForUncommented bindWith:numUncommented) asText allItalic).
rawProtocolList add:self class nameListEntryForUncommented.
].
+ numLong > 0 ifTrue:[
+ categoryList add:((self class nameListEntryForLong bindWith:numLong) asText allItalic).
+ rawProtocolList add:self class nameListEntryForLong.
+ ].
numObsolete > 0 ifTrue:[
categoryList add:((self class nameListEntryForObsolete bindWith:numObsolete) asText allItalic).
rawProtocolList add:self class nameListEntryForObsolete.
@@ -1264,6 +1279,7 @@
info sendsSuper:(aMethod superMessages notEmptyOrNil).
info isUncommented:(aMethod comment isEmptyOrNil and:[aMethod isVersionMethod not]).
info isDocumentationMethod:( aMethod isDocumentationMethod).
+ info isLongMethod:( aMethod source asCollectionOfLines size > UserPreferences current numberOfLinesForLongMethod ).
].
info
]
@@ -1435,6 +1451,7 @@
FlagSendsSuper := 2.
FlagIsUncommented := 4.
FlagIsDocumentationMethod := 8.
+ FlagIsLongMethod := 16.
! !
!MethodCategoryList::CachedMethodInfo class methodsFor:'instance creation'!
@@ -1459,6 +1476,16 @@
ifFalse:[ flags bitClear: FlagIsDocumentationMethod]
!
+isLongMethod
+ ^ (flags ? 0) bitTest: FlagIsLongMethod
+!
+
+isLongMethod:aBoolean
+ flags := aBoolean
+ ifTrue:[ flags bitOr: FlagIsLongMethod ]
+ ifFalse:[ flags bitClear: FlagIsLongMethod]
+!
+
isObsolete
^ (flags ? 0) bitTest: FlagObsolete
!
@@ -1492,11 +1519,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.33 2009-10-03 11:00:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.34 2009-10-04 15:08:55 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.33 2009-10-03 11:00:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.34 2009-10-04 15:08:55 cg Exp $'
! !
MethodCategoryList initialize!