Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
ClassDescription.st
changeset 11697 d476ab2f240d
parent 11575 77524922d201
child 11698 2fa6304fee2b 
--- a/ClassDescription.st	Wed May 13 19:39:45 2009 +0200
+++ b/ClassDescription.st	Thu May 14 11:39:25 2009 +0200
@@ -1992,21 +1992,22 @@
     "/ this test allows a smalltalk to be built without Projects/ChangeSets
     "/
     Project notNil ifTrue:[
-	fileName := Project currentProjectDirectory asFilename construct:(fileName name).
+        fileName := Project currentProjectDirectory asFilename construct:(fileName name).
     ].
 
     "/
     "/ if the file exists, save original in a .sav file
     "/
     fileName exists ifTrue:[
-	fileName copyTo:(fileName withSuffix:'sav')
+        fileName copyTo:(fileName withSuffix:'sav')
     ].
+
     [
-	aStream := fileName newReadWriteStream.
+        aStream := fileName newReadWriteStream.
     ] on:FileStream openErrorSignal do:[:ex|
-	^ FileOutErrorSignal
-		raiseRequestWith:fileName name
-		errorString:(' - cannot create file:', fileName name)
+        ^ FileOutErrorSignal
+                raiseRequestWith:fileName name
+                errorString:(' - cannot create file:', fileName name)
     ].
 
     self fileOutCategory:aCategory on:aStream.
@@ -2024,79 +2025,73 @@
      If both are nil, all are saved. See version-method handling in
      fileOut for what this is needed."
 
-    |dict source sortedSelectors first privacy interestingMethods cat|
-
-    dict := self methodDictionary.
-    dict notNil ifTrue:[
-	interestingMethods := OrderedCollection new.
-	dict do:[:aMethod |
-	    |wanted|
-
-	    (methodFilter isNil
-	    or:[methodFilter value:aMethod]) ifTrue:[
-		(aCategory = aMethod category) ifTrue:[
-		    skippedMethods notNil ifTrue:[
-			wanted := (skippedMethods includesIdentical:aMethod) not
-		    ] ifFalse:[
-			savedMethods notNil ifTrue:[
-			    wanted := (savedMethods includesIdentical:aMethod).
-			] ifFalse:[
-			    wanted := true
-			]
-		    ].
-		    wanted ifTrue:[interestingMethods add:aMethod].
-		]
-	    ]
-	].
-	interestingMethods notEmpty ifTrue:[
-	    first := true.
-	    privacy := nil.
-
-	    "/
-	    "/ sort by selector
-	    "/
-	    sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
-	    sortedSelectors sortWith:interestingMethods.
-
-	    interestingMethods do:[:aMethod |
-		first ifFalse:[
-		    privacy ~~ aMethod privacy ifTrue:[
-			first := true.
-			aStream space.
-			aStream nextPutChunkSeparator.
-		    ].
-		    aStream cr; cr
-		].
-
-		privacy := aMethod privacy.
-
-		first ifTrue:[
-		    aStream nextPutChunkSeparator.
-		    self printClassNameOn:aStream.
-		    privacy ~~ #public ifTrue:[
-			aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
-		    ] ifFalse:[
-			aStream nextPutAll:' methodsFor:'.
-		    ].
-		    cat := aCategory.
-		    cat isNil ifTrue:[ cat := '' ].
-		    aStream nextPutAll:aCategory asString storeString.
-		    aStream nextPutChunkSeparator; cr; cr.
-		    first := false.
-		].
-		source := aMethod source.
-		source isNil ifTrue:[
-		    FileOutErrorSignal
-			raiseRequestWith:self
-			errorString:' - no source for method: ', (aMethod displayString)
-		] ifFalse:[
-		    aStream nextChunkPut:source.
-		].
-	    ].
-	    aStream space.
-	    aStream nextPutChunkSeparator.
-	    aStream cr
-	]
+    |source sortedSelectors first privacy interestingMethods cat|
+
+    interestingMethods := self methodsInCategory:aCategory forWhich:methodFilter.
+    interestingMethods := interestingMethods 
+            select:[:method |
+                |wanted|
+
+                skippedMethods notNil ifTrue:[
+                    wanted := (skippedMethods includesIdentical:method) not
+                ] ifFalse:[
+                    savedMethods notNil ifTrue:[
+                        wanted := (savedMethods includesIdentical:method).
+                    ] ifFalse:[
+                        wanted := true
+                    ]
+                ].
+                wanted 
+            ].
+
+    interestingMethods notEmpty ifTrue:[
+        first := true.
+        privacy := nil.
+
+        "/
+        "/ sort by selector
+        "/
+        sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
+        sortedSelectors sortWith:interestingMethods.
+
+        interestingMethods do:[:aMethod |
+            first ifFalse:[
+                privacy ~~ aMethod privacy ifTrue:[
+                    first := true.
+                    aStream space.
+                    aStream nextPutChunkSeparator.
+                ].
+                aStream cr; cr
+            ].
+
+            privacy := aMethod privacy.
+
+            first ifTrue:[
+                aStream nextPutChunkSeparator.
+                self printClassNameOn:aStream.
+                privacy ~~ #public ifTrue:[
+                    aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
+                ] ifFalse:[
+                    aStream nextPutAll:' methodsFor:'.
+                ].
+                cat := aCategory.
+                cat isNil ifTrue:[ cat := '' ].
+                aStream nextPutAll:aCategory asString storeString.
+                aStream nextPutChunkSeparator; cr; cr.
+                first := false.
+            ].
+            source := aMethod source.
+            source isNil ifTrue:[
+                FileOutErrorSignal
+                    raiseRequestWith:self
+                    errorString:' - no source for method: ', (aMethod displayString)
+            ] ifFalse:[
+                aStream nextChunkPut:source.
+            ].
+        ].
+        aStream space.
+        aStream nextPutChunkSeparator.
+        aStream cr
     ]
 
     "Modified: 28.8.1995 / 14:30:41 / claus"
@@ -2189,41 +2184,37 @@
 !
 
 fileOutMethod:aMethod on:aStream
-    "file out the method, aMethod onto aStream"
-
-    |dict cat source privacy|
-
-    dict := self methodDictionary.
-    dict notNil ifTrue:[
-	aStream nextPutChunkSeparator.
-	self name printOn:aStream.
+    "file out aMethod onto aStream. Used for example to write individual changeChunks"
+
+    |cat source privacy|
+
+    aStream nextPutChunkSeparator.
+    self name printOn:aStream.
 "/        self printClassNameOn:aStream.
 
-	(privacy := aMethod privacy) ~~ #public ifTrue:[
-	    aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
-	] ifFalse:[
-	    aStream nextPutAll:' methodsFor:'.
-	].
-	cat := aMethod category.
-	cat isNil ifTrue:[
-	    cat := ''
-	].
-	aStream nextPutAll:cat asString storeString.
-	aStream nextPutChunkSeparator; cr; cr.
-	source := aMethod source.
-	source isNil ifTrue:[
-	    FileOutErrorSignal
-		raiseRequestWith:self
-		errorString:(' - no source for method: ' ,
-			     self name , '>>' ,
-			     (self selectorAtMethod:aMethod))
-	] ifFalse:[
-	    aStream nextChunkPut:source.
-	].
-	aStream space.
-	aStream nextPutChunkSeparator.
-	aStream cr
-    ]
+    (privacy := aMethod privacy) ~~ #public ifTrue:[
+        aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
+    ] ifFalse:[
+        aStream nextPutAll:' methodsFor:'.
+    ].
+
+    cat := aMethod category ? ''.
+    aStream nextPutAll:cat asString storeString.
+    aStream nextPutChunkSeparator; cr; cr.
+
+    source := aMethod source.
+    source isNil ifTrue:[
+        FileOutErrorSignal
+            raiseRequestWith:self
+            errorString:(' - no source for method: ' ,
+                         self name , '>>' ,
+                         (self selectorAtMethod:aMethod))
+    ] ifFalse:[
+        aStream nextChunkPut:source.
+    ].
+    aStream space.
+    aStream nextPutChunkSeparator.
+    aStream cr
 
     "Modified: 27.8.1995 / 01:23:19 / claus"
     "Modified: 12.6.1996 / 11:44:41 / stefan"
@@ -2245,71 +2236,60 @@
 fileOutXMLCategory:aCategory methodFilter:methodFilter on:aStream
     "file out all methods belonging to aCategory, aString in xml format onto aStream."
 
-    |dict source sortedSelectors first privacy interestingMethods cat|
-
-    dict := self methodDictionary.
-    dict notNil ifTrue:[
-	interestingMethods := OrderedCollection new.
-	dict do:[:aMethod |
-	    (methodFilter isNil
-	    or:[methodFilter value:aMethod]) ifTrue:[
-		(aCategory = aMethod category) ifTrue:[
-		    interestingMethods add:aMethod.
-		]
-	    ]
-	].
-	interestingMethods notEmpty ifTrue:[
-	    first := true.
-	    privacy := nil.
-
-	    "/
-	    "/ sort by selector
-	    "/
-	    sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
-	    sortedSelectors sortWith:interestingMethods.
-
-	    interestingMethods do:[:aMethod |
-		first ifFalse:[
-		    privacy ~~ aMethod privacy ifTrue:[
-			first := true.
-			aStream nextPutLine:'</methods>'.
-		    ].
-		].
-
-		privacy := aMethod privacy.
-
-		first ifTrue:[
-		    cat := aCategory.
-		    cat isNil ifTrue:[ cat := '' ].
-
-		    aStream nextPutLine:'<methods>'.
-		    aStream nextPutAll:'  <class-id>'.
-		    aStream nextPutAll:self name.
-		    aStream nextPutLine:'</class-id>'.
-		    aStream nextPutAll:'  <category>'.
-		    aStream nextPutAll:cat.
-		    aStream nextPutLine:'</category>'.
-
-		    privacy ~~ #public ifTrue:[
-			aStream nextPutAll:'  <privacy>'.
-			aStream nextPutAll:privacy.
-			aStream nextPutLine:'</privacy>'.
-		    ].
-		    first := false.
-		].
-		source := aMethod source.
-		source isNil ifTrue:[
-		    FileOutErrorSignal
-			raiseRequestWith:self
-			errorString:' - no source for method: ', (aMethod displayString)
-		] ifFalse:[
-		    aStream nextPutAll:'  <body>'.
-		    self fileOutXMLString:source on:aStream.
-		    aStream nextPutLine:'</body>'.
-		].
-	    ].
-	    aStream nextPutLine:'</methods>'.
-	]
+    |source sortedSelectors first privacy interestingMethods cat|
+
+    interestingMethods := self methodsInCategory:aCategory forWhich:methodFilter.
+    interestingMethods notEmpty ifTrue:[
+        first := true.
+        privacy := nil.
+
+        "/
+        "/ sort by selector
+        "/
+        sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
+        sortedSelectors sortWith:interestingMethods.
+
+        interestingMethods do:[:aMethod |
+            first ifFalse:[
+                privacy ~~ aMethod privacy ifTrue:[
+                    first := true.
+                    aStream nextPutLine:'</methods>'.
+                ].
+            ].
+
+            privacy := aMethod privacy.
+
+            first ifTrue:[
+                cat := aCategory.
+                cat isNil ifTrue:[ cat := '' ].
+
+                aStream nextPutLine:'<methods>'.
+                aStream nextPutAll:'  <class-id>'.
+                aStream nextPutAll:self name.
+                aStream nextPutLine:'</class-id>'.
+                aStream nextPutAll:'  <category>'.
+                aStream nextPutAll:cat.
+                aStream nextPutLine:'</category>'.
+
+                privacy ~~ #public ifTrue:[
+                    aStream nextPutAll:'  <privacy>'.
+                    aStream nextPutAll:privacy.
+                    aStream nextPutLine:'</privacy>'.
+                ].
+                first := false.
+            ].
+            source := aMethod source.
+            source isNil ifTrue:[
+                FileOutErrorSignal
+                    raiseRequestWith:self
+                    errorString:' - no source for method: ', (aMethod displayString)
+            ] ifFalse:[
+                aStream nextPutAll:'  <body>'.
+                self fileOutXMLString:source on:aStream.
+                aStream nextPutLine:'</body>'.
+            ].
+        ].
+        aStream nextPutLine:'</methods>'.
     ]
 !
 
@@ -2351,6 +2331,23 @@
     "append an xml-escaped string to aStream."
 
     XMLCoder putQuotedString:someString on:aStream
+!
+
+methodsInCategory:aCategory forWhich:methodFilter
+    "helper for fileOut"
+
+    |interestingMethods|
+
+    interestingMethods := OrderedCollection new.
+    self methodsDo:[:aMethod |
+        (methodFilter isNil
+        or:[methodFilter value:aMethod]) ifTrue:[
+            (aCategory = aMethod category) ifTrue:[
+                interestingMethods add:aMethod.
+            ]
+        ]
+    ].
+    ^ interestingMethods
 ! !
 
 !ClassDescription methodsFor:'printOut'!
@@ -2604,31 +2601,21 @@
 !
 
 printOutCategory:aCategory on:aPrintStream
-    "print out all methods in aCategory on aPrintStream should be a PrintStream"
-
-    |dict any|
-
-    dict := self methodDictionary.
-    dict notNil ifTrue:[
-	any := false.
-	dict do:[:aMethod |
-	    (aCategory = aMethod category) ifTrue:[
-		any := true
-	    ]
-	].
-	any ifTrue:[
-	     aPrintStream italic.
-	     aPrintStream nextPutAll:aCategory.
-	     aPrintStream normal.
-	     aPrintStream cr; cr.
-	     dict do:[:aMethod |
-		 (aCategory = aMethod category) ifTrue:[
-		     self printOutSource:(aMethod source) on:aPrintStream.
-		     aPrintStream cr; cr
-		 ]
-	     ].
-	     aPrintStream cr
-	 ]
+    "print out all methods in aCategory on aPrintStream, which should be understanf emphasis"
+
+    |interestingMethods|
+
+    interestingMethods := self methodsInCategory:aCategory forWhich:[:m | true].
+    interestingMethods notEmptyOrNil ifTrue:[
+        aPrintStream italic.
+        aPrintStream nextPutAll:aCategory.
+        aPrintStream normal.
+        aPrintStream cr; cr.
+        interestingMethods do:[:aMethod |
+            self printOutSource:(aMethod source) on:aPrintStream.
+            aPrintStream cr; cr
+        ].
+        aPrintStream cr
     ]
 
     "Modified: / 12.6.1996 / 11:47:36 / stefan"
@@ -2959,29 +2946,19 @@
 printOutCategoryProtocol:aCategory on:aPrintStream
     "{ Pragma: +optSpace }"
 
-    |dict any|
-
-    dict := self methodDictionary.
-    dict notNil ifTrue:[
-	any := false.
-	dict do:[:aMethod |
-	    (aCategory = aMethod category) ifTrue:[
-		any := true
-	    ]
-	].
-	any ifTrue:[
-	    aPrintStream italic.
-	    aPrintStream nextPutAll:aCategory.
-	    aPrintStream normal.
-	    aPrintStream cr; cr.
-	    dict do:[:aMethod |
-		(aCategory = aMethod category) ifTrue:[
-		    self printOutMethodProtocol:aMethod on:aPrintStream.
-		    aPrintStream cr; cr
-		]
-	    ].
-	    aPrintStream cr
-	]
+    |interestingMethods|
+
+    interestingMethods := self methodsInCategory:aCategory forWhich:[:m | true].
+    interestingMethods notEmptyOrNil ifTrue:[
+        aPrintStream italic.
+        aPrintStream nextPutAll:aCategory.
+        aPrintStream normal.
+        aPrintStream cr; cr.
+        interestingMethods do:[:aMethod |
+            self printOutMethodProtocol:aMethod on:aPrintStream.
+            aPrintStream cr; cr
+        ].
+        aPrintStream cr
     ]
 
     "Modified: 20.4.1996 / 18:20:26 / cg"
@@ -4063,7 +4040,7 @@
 !ClassDescription class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.199 2009-02-17 08:50:39 ca Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.200 2009-05-14 09:39:25 cg Exp $'
 ! !
 
 ClassDescription initialize!
hg/stx-libbasic