Mercurial Mercurial > hg > stx-libbasic3 / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
checkin from browser
authorClaus Gittinger <cg@exept.de>
Mon, 16 Feb 1998 15:00:00 +0100
changeset 654 edeb63d98088
parent 653 b873bb41ef10
child 655 94cba977cb39
checkin from browser
Change.st file | annotate | diff | comparison | revisions
ChangeSet.st file | annotate | diff | comparison | revisions
ClassChange.st file | annotate | diff | comparison | revisions
ClassChg.st file | annotate | diff | comparison | revisions
ClassCommentChange.st file | annotate | diff | comparison | revisions
ClsComChg.st file | annotate | diff | comparison | revisions
MethodCategoryChange.st file | annotate | diff | comparison | revisions
MethodChange.st file | annotate | diff | comparison | revisions
MethodChg.st file | annotate | diff | comparison | revisions
MethodPrivacyChange.st file | annotate | diff | comparison | revisions
MthdCatChg.st file | annotate | diff | comparison | revisions
MthdPrivChg.st file | annotate | diff | comparison | revisions 
--- a/Change.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/Change.st	Mon Feb 16 15:00:00 1998 +0100
@@ -75,10 +75,19 @@
     ^ source
 
     "Modified: 15.7.1996 / 09:26:34 / cg"
+!
+
+source:someString
+    "set the source of the change"
+
+    source := someString
+
+    "Modified: / 15.7.1996 / 09:26:34 / cg"
+    "Created: / 16.2.1998 / 13:05:16 / cg"
 ! !
 
 !Change class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.14 1998-02-07 19:01:42 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.15 1998-02-16 13:59:45 cg Exp $'
 ! !
--- a/ChangeSet.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/ChangeSet.st	Mon Feb 16 15:00:00 1998 +0100
@@ -42,6 +42,67 @@
 "
 ! !
 
+!ChangeSet class methodsFor:'instance creation'!
+
+fromStream:aStream
+    "build a changeSet from a stream, containing chunks.
+     (i.e. either a classes sourceFile or a change-file).
+     Return the changeSet."
+
+    |changeSet chunk sawExcla lastTimeStamp tree s change|
+
+    changeSet := self new.
+
+    [aStream atEnd] whileFalse:[
+        aStream skipSeparators.
+        sawExcla := aStream peekFor:$!!.
+        chunk := aStream nextChunk.
+        (chunk notNil and:[chunk notEmpty]) ifTrue:[
+            tree := Parser parseExpression:chunk inNameSpace:Smalltalk.
+            tree == #Error ifTrue:[
+                change := DoItChange new.
+                change source:chunk.
+                changeSet add: change.
+            ] ifFalse:[    
+                (tree notNil and:[tree ~~ #Error]) ifTrue:[
+                    "/
+                    "/ what type of chunk is this ...
+                    "/
+                    tree isConstant ifTrue:[
+                        (s := tree evaluate) isString ifTrue:[
+                            (s startsWith:'---- timestamp ') ifTrue:[
+                                lastTimeStamp := s.
+                            ]
+                        ] ifFalse:[
+                            self halt
+                        ]
+                    ] ifFalse:[
+                        tree isMessage ifTrue:[
+                            (changeSet addFromParseTree:tree andStream:aStream) ifFalse:[
+                                change := DoItChange new.
+                                change source:chunk.
+                                changeSet add: change.
+                            ]
+                        ] ifFalse:[
+                            self halt.
+                        ]
+                    ]
+                ]
+            ]
+        ]
+    ].
+    ^ changeSet
+
+    "
+     ChangeSet fromStream:('changes' asFilename readStream)
+     ChangeSet fromStream:('patches' asFilename readStream)
+     ChangeSet fromStream:(Object source asString readStream)
+    "
+
+    "Created: / 16.2.1998 / 12:19:34 / cg"
+    "Modified: / 16.2.1998 / 14:44:22 / cg"
+! !
+
 !ChangeSet class methodsFor:'ST80 compatibility'!
 
 patches
@@ -163,6 +224,21 @@
     self add:newChange
 
     "Modified: 15.7.1996 / 09:27:55 / cg"
+!
+
+addRemoveSelectorChange:aSelector in:aClass
+    "add a method-remove change to the receiver"
+
+    |newChange|
+
+    newChange := MethodRemoveChange 
+                        class:aClass
+                        selector:aSelector.
+    self add:newChange
+
+    "Modified: / 27.8.1995 / 22:55:22 / claus"
+    "Modified: / 15.7.1996 / 09:27:28 / cg"
+    "Created: / 16.2.1998 / 12:47:07 / cg"
 ! !
 
 !ChangeSet methodsFor:'misc'!
@@ -173,8 +249,206 @@
     ^ self
 ! !
 
+!ChangeSet methodsFor:'private'!
+
+addFromParseTree:aTree andStream:aStream
+    |sel className categoryName 
+     methodSource methodSelector change parser
+     oldName newName priv|
+
+    sel := aTree selector.
+    (sel == #'methodsFor:'
+    or:[(sel == #'ignoredMethodsFor:')]) ifTrue:[
+        (sel == #'ignoredMethodsFor:') ifTrue:[
+            priv := #ignored.
+        ] ifFalse:[
+            priv := nil
+        ].
+        (aTree receiver isUnaryMessage 
+        and:[aTree receiver selector == #class]) ifTrue:[
+            className := (aTree receiver receiver name) , ' class'.
+        ] ifFalse:[
+            className := (aTree receiver name).
+        ].
+        categoryName := (aTree arguments at:1) evaluate.
+
+        aStream skipSeparators.
+        methodSource := aStream nextChunk.
+        [methodSource notEmpty] whileTrue:[
+            parser := Parser
+                            parseMethod:methodSource 
+                            in:nil 
+                            ignoreErrors:true 
+                            ignoreWarnings:true.
+
+            methodSelector := parser selector.
+
+            change := MethodChange new.
+            change 
+                className:className
+                selector:methodSelector
+                source:methodSource
+                category:categoryName
+                privacy:priv.
+            self add: change.
+
+            aStream skipSeparators.
+            methodSource := aStream nextChunk.
+        ].
+        ^ true
+    ].
+
+    sel == #'removeSelector:' ifTrue:[
+        (aTree receiver isUnaryMessage 
+        and:[aTree receiver selector == #class]) ifTrue:[
+            className := (aTree receiver receiver name) , ' class'.
+        ] ifFalse:[
+            className := (aTree receiver name).
+        ].
+        methodSelector := (aTree arguments at:1) evaluate.
+        change := MethodRemoveChange new.
+        change 
+            className:className
+            selector:methodSelector.
+        self add: change.
+        ^ true
+    ].
+
+    ((sel startsWith:'subclass:')
+    or:[(sel startsWith:'variableSubclass:')
+    or:[(sel startsWith:'variableByteSubclass:')
+    or:[(sel startsWith:'variableWordSubclass:')
+    or:[(sel startsWith:'variableLongSubclass:')
+    or:[(sel startsWith:'variableSignedWordSubclass:')
+    or:[(sel startsWith:'variableSignedLongSubclass:')
+    or:[(sel startsWith:'variableFloatSubclass:')
+    or:[(sel startsWith:'variableDoubleSubclass:')
+    ]]]]]]]]) ifTrue:[
+        className := (aTree arguments at:1) evaluate.
+        change := ClassDefinitionChange new.
+        change 
+            className:className;
+            source:(aTree printString).
+        self add: change.
+        ^ true
+    ].
+
+    sel == #'renameCategory:to:' ifTrue:[
+        (aTree receiver isUnaryMessage 
+        and:[aTree receiver selector == #class]) ifTrue:[
+            className := (aTree receiver receiver name) , ' class'.
+        ] ifFalse:[
+            className := (aTree receiver name).
+        ].
+        change := MethodCategoryRenameChange new.
+        change 
+            className:className;
+            oldCategoryName:(aTree arguments at:1) evaluate
+            newCategoryName:(aTree arguments at:2) evaluate.
+        self add: change.
+        ^ true
+    ].
+
+    (sel == #'category:' 
+    or:[sel == #'privacy:']) ifTrue:[
+        (aTree receiver isMessage
+        and:[aTree receiver selector == #'compiledMethodAt:']) ifTrue:[
+            (aTree receiver receiver isUnaryMessage 
+            and:[aTree receiver receiver selector == #class]) ifTrue:[
+                className := (aTree receiver receiver receiver name) , ' class'.
+            ] ifFalse:[
+                className := (aTree receiver receiver name).
+            ].
+            methodSelector := (aTree receiver arguments at:1) evaluate.
+
+            sel == #'category:' ifTrue:[
+                change := MethodCategoryChange new.
+                change 
+                    className:className
+                    selector:methodSelector
+                    category:(aTree arguments at:1) evaluate.
+            ] ifFalse:[
+                change := MethodPrivacyChange new.
+                change 
+                    className:className
+                    selector:methodSelector
+                    privacy:(aTree arguments at:1) evaluate.
+            ].
+
+            self add: change.
+            ^ true
+        ] ifFalse:[
+            self halt
+        ].
+    ].
+
+    sel == #'comment:' ifTrue:[
+        (aTree receiver isUnaryMessage 
+        and:[aTree receiver selector == #class]) ifTrue:[
+            className := (aTree receiver receiver name) , ' class'.
+        ] ifFalse:[
+            className := (aTree receiver name).
+        ].
+
+        change := ClassCommentChange new.
+        change 
+            className:className
+            comment:(aTree arguments at:1) evaluate.
+        self add: change.
+        ^ true
+    ].
+
+    sel == #'removeClass:' ifTrue:[
+        (aTree receiver isVariable 
+        and:[aTree receiver name == #Smalltalk]) ifTrue:[
+            className := (aTree arguments at:1) name.
+
+            change := ClassRemoveChange new.
+            change className:className.
+            self add: change.
+            ^ true
+        ] ifFalse:[
+            self halt
+        ].
+    ].
+
+    sel == #'renameClass:to:' ifTrue:[
+        (aTree receiver isVariable 
+        and:[aTree receiver name == #Smalltalk]) ifTrue:[
+            oldName := (aTree arguments at:1) name.
+            newName := (aTree arguments at:2) evaluate.
+
+            change := ClassRenameChange new.
+            change oldName:oldName newName:newName.
+            self add: change.
+            ^ true
+        ] ifFalse:[
+            self halt
+        ].
+    ].
+
+    sel == #'name:' ifTrue:[
+        (aTree receiver isVariable 
+        and:[aTree receiver name == #Namespace]) ifTrue:[
+            className := (aTree arguments at:1) evaluate.
+
+            change := NameSpaceCreationChange new.
+            change name:className.
+            self add: change.
+            ^ true
+        ] ifFalse:[
+            self halt
+        ].
+    ].
+
+    ^ false
+
+    "Created: / 16.2.1998 / 13:42:40 / cg"
+    "Modified: / 16.2.1998 / 14:37:40 / cg"
+! !
+
 !ChangeSet class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.19 1997-10-28 19:11:35 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.20 1998-02-16 13:59:37 cg Exp $'
 ! !
--- a/ClassChange.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/ClassChange.st	Mon Feb 16 15:00:00 1998 +0100
@@ -67,6 +67,15 @@
     ^  className
 
     "Modified: 15.7.1996 / 09:28:35 / cg"
+!
+
+className:aString 
+    "set the className of the change"
+
+    className := aString
+
+    "Modified: / 15.7.1996 / 09:28:35 / cg"
+    "Created: / 16.2.1998 / 13:05:36 / cg"
 ! !
 
 !ClassChange methodsFor:'printing'!
@@ -78,5 +87,5 @@
 !ClassChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.15 1997-11-02 19:15:00 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.16 1998-02-16 13:59:41 cg Exp $'
 ! !
--- a/ClassChg.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/ClassChg.st	Mon Feb 16 15:00:00 1998 +0100
@@ -67,6 +67,15 @@
     ^  className
 
     "Modified: 15.7.1996 / 09:28:35 / cg"
+!
+
+className:aString 
+    "set the className of the change"
+
+    className := aString
+
+    "Modified: / 15.7.1996 / 09:28:35 / cg"
+    "Created: / 16.2.1998 / 13:05:36 / cg"
 ! !
 
 !ClassChange methodsFor:'printing'!
@@ -78,5 +87,5 @@
 !ClassChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/ClassChg.st,v 1.15 1997-11-02 19:15:00 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/ClassChg.st,v 1.16 1998-02-16 13:59:41 cg Exp $'
 ! !
--- a/ClassCommentChange.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/ClassCommentChange.st	Mon Feb 16 15:00:00 1998 +0100
@@ -45,6 +45,13 @@
 
 !ClassCommentChange methodsFor:'accessing'!
 
+className:clsName comment:aCommentString
+    className := clsName.
+    comment := aCommentString
+
+    "Created: / 16.2.1998 / 14:16:45 / cg"
+!
+
 comment
     ^ comment
 ! !
@@ -60,5 +67,5 @@
 !ClassCommentChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/ClassCommentChange.st,v 1.12 1996-04-25 17:04:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ClassCommentChange.st,v 1.13 1998-02-16 13:59:49 cg Exp $'
 ! !
--- a/ClsComChg.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/ClsComChg.st	Mon Feb 16 15:00:00 1998 +0100
@@ -45,6 +45,13 @@
 
 !ClassCommentChange methodsFor:'accessing'!
 
+className:clsName comment:aCommentString
+    className := clsName.
+    comment := aCommentString
+
+    "Created: / 16.2.1998 / 14:16:45 / cg"
+!
+
 comment
     ^ comment
 ! !
@@ -60,5 +67,5 @@
 !ClassCommentChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/ClsComChg.st,v 1.12 1996-04-25 17:04:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/ClsComChg.st,v 1.13 1998-02-16 13:59:49 cg Exp $'
 ! !
--- a/MethodCategoryChange.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MethodCategoryChange.st	Mon Feb 16 15:00:00 1998 +0100
@@ -60,6 +60,14 @@
 
 !
 
+className:clsName selector:sel category:cat
+    className := clsName.
+    selector := sel.
+    category := cat
+
+    "Created: / 16.2.1998 / 14:14:16 / cg"
+!
+
 source
     ^ '(' , className , ' compiledMethodAt:#' , selector , ') category:' , category storeString
 
@@ -68,5 +76,5 @@
 !MethodCategoryChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MethodCategoryChange.st,v 1.8 1996-04-25 17:04:22 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MethodCategoryChange.st,v 1.9 1998-02-16 14:00:00 cg Exp $'
 ! !
--- a/MethodChange.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MethodChange.st	Mon Feb 16 15:00:00 1998 +0100
@@ -11,7 +11,7 @@
 "
 
 ClassChange subclass:#MethodChange
-	instanceVariableNames:'selector methodCategory'
+	instanceVariableNames:'selector methodCategory privacy'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Changes'
@@ -58,6 +58,26 @@
     methodCategory := cat
 !
 
+className:clsName selector:sel source:src category:cat
+    className := clsName.
+    selector := sel.
+    source := src.
+    methodCategory := cat
+
+    "Created: / 16.2.1998 / 12:29:49 / cg"
+!
+
+className:clsName selector:sel source:src category:cat privacy:priv
+    className := clsName.
+    selector := sel.
+    source := src.
+    methodCategory := cat.
+    privacy := priv.
+
+    "Created: / 16.2.1998 / 12:29:49 / cg"
+    "Modified: / 16.2.1998 / 14:28:12 / cg"
+!
+
 methodCategory
     ^ methodCategory
 
@@ -89,5 +109,5 @@
 !MethodChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.15 1998-02-07 19:01:54 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.16 1998-02-16 13:59:56 cg Exp $'
 ! !
--- a/MethodChg.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MethodChg.st	Mon Feb 16 15:00:00 1998 +0100
@@ -11,7 +11,7 @@
 "
 
 ClassChange subclass:#MethodChange
-	instanceVariableNames:'selector methodCategory'
+	instanceVariableNames:'selector methodCategory privacy'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Changes'
@@ -58,6 +58,26 @@
     methodCategory := cat
 !
 
+className:clsName selector:sel source:src category:cat
+    className := clsName.
+    selector := sel.
+    source := src.
+    methodCategory := cat
+
+    "Created: / 16.2.1998 / 12:29:49 / cg"
+!
+
+className:clsName selector:sel source:src category:cat privacy:priv
+    className := clsName.
+    selector := sel.
+    source := src.
+    methodCategory := cat.
+    privacy := priv.
+
+    "Created: / 16.2.1998 / 12:29:49 / cg"
+    "Modified: / 16.2.1998 / 14:28:12 / cg"
+!
+
 methodCategory
     ^ methodCategory
 
@@ -89,5 +109,5 @@
 !MethodChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MethodChg.st,v 1.15 1998-02-07 19:01:54 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MethodChg.st,v 1.16 1998-02-16 13:59:56 cg Exp $'
 ! !
--- a/MethodPrivacyChange.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MethodPrivacyChange.st	Mon Feb 16 15:00:00 1998 +0100
@@ -11,7 +11,7 @@
 "
 
 MethodChange subclass:#MethodPrivacyChange
-	instanceVariableNames:'privacy'
+	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Changes'
@@ -61,6 +61,15 @@
     "Modified: 27.8.1995 / 22:56:03 / claus"
 !
 
+className:clsName selector:sel privacy:p
+    className := clsName.
+    privacy := p.
+    selector := sel
+
+    "Modified: / 27.8.1995 / 22:56:03 / claus"
+    "Created: / 16.2.1998 / 14:25:39 / cg"
+!
+
 source
     ^ '(' , className , ' compiledMethodAt:#' , selector , ') privacy:' , privacy storeString
 
@@ -70,5 +79,5 @@
 !MethodPrivacyChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MethodPrivacyChange.st,v 1.6 1996-04-25 17:04:19 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MethodPrivacyChange.st,v 1.7 1998-02-16 13:59:52 cg Exp $'
 ! !
--- a/MthdCatChg.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MthdCatChg.st	Mon Feb 16 15:00:00 1998 +0100
@@ -60,6 +60,14 @@
 
 !
 
+className:clsName selector:sel category:cat
+    className := clsName.
+    selector := sel.
+    category := cat
+
+    "Created: / 16.2.1998 / 14:14:16 / cg"
+!
+
 source
     ^ '(' , className , ' compiledMethodAt:#' , selector , ') category:' , category storeString
 
@@ -68,5 +76,5 @@
 !MethodCategoryChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MthdCatChg.st,v 1.8 1996-04-25 17:04:22 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MthdCatChg.st,v 1.9 1998-02-16 14:00:00 cg Exp $'
 ! !
--- a/MthdPrivChg.st	Mon Feb 16 14:59:29 1998 +0100
+++ b/MthdPrivChg.st	Mon Feb 16 15:00:00 1998 +0100
@@ -11,7 +11,7 @@
 "
 
 MethodChange subclass:#MethodPrivacyChange
-	instanceVariableNames:'privacy'
+	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Changes'
@@ -61,6 +61,15 @@
     "Modified: 27.8.1995 / 22:56:03 / claus"
 !
 
+className:clsName selector:sel privacy:p
+    className := clsName.
+    privacy := p.
+    selector := sel
+
+    "Modified: / 27.8.1995 / 22:56:03 / claus"
+    "Created: / 16.2.1998 / 14:25:39 / cg"
+!
+
 source
     ^ '(' , className , ' compiledMethodAt:#' , selector , ') privacy:' , privacy storeString
 
@@ -70,5 +79,5 @@
 !MethodPrivacyChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MthdPrivChg.st,v 1.6 1996-04-25 17:04:19 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MthdPrivChg.st,v 1.7 1998-02-16 13:59:52 cg Exp $'
 ! !
hg/stx-libbasic3