Tools_MethodCategoryList.st
changeset 8867 c926be235b4b
parent 8860 d8ce6a00a43f
child 8931 8c8ce24dadb2
--- 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!