changes to allow browsing Sqeak fileOut format.
--- a/CBrowser.st Thu Jul 15 15:44:16 1999 +0200
+++ b/CBrowser.st Thu Jul 15 16:45:31 1999 +0200
@@ -40,35 +40,39 @@
documentation
"
- this implements a browser for the changes-file.
+ this implements a browser for the changes-file (actually, it can display
+ any sourceFiles contents).
See the extra document 'doc/misc/cbrowser.doc' for how to use this browser.
written jan 90 by claus
[Class variables:]
- CompressSnapshotInfo if true (the default), snapshot entries
- are also compressed in the compress function.
- Some users prefer them to be not compressed.
- Set it to false for this.
+ CompressSnapshotInfo if true (the default), snapshot entries
+ are also compressed in the compress function.
+ Some users prefer them to be not compressed.
+ Set it to false for this.
Notice:
- this needs a total rewrite, to build up a changeSet from the file
- (which did not exist when the ChangesBrowser was originally written)
- and manipulate that changeSet.
-
- This way, we get a browser for any upcoming incore changeSets for
- free. Also, this will put the chunk analyzation code into Change and
- subclasses (where it belongs) and give a better encapsulation and
- overall structure. Do not take this as an example for good style ;-)
+ this needs a total rewrite, to build up a changeSet from the file
+ (which did not exist when the ChangesBrowser was originally written)
+ and manipulate that changeSet.
+
+ This way, we get a browser for any upcoming incore changeSets for
+ free. Also, this will put the chunk analyzation code into Change and
+ subclasses (where it belongs) and give a better encapsulation and
+ overall structure. Do not take this as an example for good style ;-)
+
+ The Change hierarchy is currently been completed, and the changes browser
+ will be adapted soon.
[author:]
- Claus Gittinger
+ Claus Gittinger
[start with:]
- ChangesBrowser open
+ ChangesBrowser open
[see also:]
- ( Using the ChangesBrowser :html: tools/cbrowser/TOP.html )
+ ( Using the ChangesBrowser :html: tools/cbrowser/TOP.html )
"
! !
@@ -142,12 +146,12 @@
wantChangeLog
"sent by the compiler to ask if a changeLog entry should
- be written. Return false here."
+ be written when compiling. Return false here."
^ false
! !
-!ChangesBrowser methodsFor:'error handling'!
+!ChangesBrowser methodsFor:'compiler interface-error handling'!
correctableError:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of an error - this should really not happen since
@@ -544,6 +548,1069 @@
!ChangesBrowser methodsFor:'private'!
+autoSelect:changeNr
+ "select a change"
+
+ self class autoSelectNext ifTrue:[
+ (changeNr <= self numberOfChanges) ifTrue:[
+ changeListView setSelection:changeNr.
+ self changeSelection:changeNr.
+ ^ self
+ ]
+ ].
+ self clearCodeView.
+ changeListView setSelection:nil.
+
+ "Modified: / 18.5.1998 / 14:26:43 / cg"
+!
+
+autoSelectLast
+ "select the last change"
+
+ self autoSelect:(self numberOfChanges)
+!
+
+autoSelectOrEnd:changeNr
+ "select the next change or the last"
+
+ |last|
+
+ last := self numberOfChanges.
+ changeNr < last ifTrue:[
+ self autoSelect:changeNr
+ ] ifFalse:[
+ changeListView setSelection:last .
+ self changeSelection:last.
+ ]
+
+ "Modified: 25.5.1996 / 12:26:17 / cg"
+!
+
+checkClassIsLoaded:aClass
+ |cls|
+
+ aClass isMeta ifTrue:[
+ cls := aClass soleInstance
+ ] ifFalse:[
+ cls := aClass
+ ].
+ cls isLoaded ifFalse:[
+ (self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs)
+ ifTrue:[
+ cls autoload
+ ]
+ ].
+ ^ cls isLoaded
+
+ "Created: 12.12.1995 / 14:04:39 / cg"
+ "Modified: 12.12.1995 / 14:11:05 / cg"
+!
+
+clearCodeView
+ self unselect "changeListView deselect".
+ codeView contents:nil.
+ changeNrShown := nil
+!
+
+contractClass:className selector:selector to:maxLen
+ |s l|
+
+ s := className , ' ', selector.
+ s size > maxLen ifTrue:[
+ l := maxLen - 1 - selector size max:20.
+ s := (className contractTo:l) , ' ' , selector.
+
+ s size > maxLen ifTrue:[
+ l := maxLen - 1 - className size max:20.
+ s := className , ' ', (selector contractTo:l).
+
+ s size > maxLen ifTrue:[
+ s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
+ ]
+ ]
+ ].
+ ^ s
+!
+
+newLabel:how
+ |l|
+
+ (changeFileName ~= 'changes') ifTrue:[
+ l := self class defaultLabel , ': ', changeFileName
+ ] ifFalse:[
+ l := self class defaultLabel
+ ].
+ l := l , ' ' , how.
+ self label:l
+
+ "Created: / 8.9.1995 / 19:32:04 / claus"
+ "Modified: / 8.9.1995 / 19:39:29 / claus"
+ "Modified: / 6.2.1998 / 13:27:01 / cg"
+!
+
+queryCloseText
+ "made this a method for easy redefinition in subclasses"
+
+ ^ 'Quit without updating changeFile ?'
+!
+
+setChangeList
+ "extract type-information from changes and stuff into top selection
+ view"
+
+ changeListView setList:changeHeaderLines expandTabs:false redraw:false.
+ changeListView invalidate.
+
+ "/ changeListView deselect.
+
+ "Modified: / 18.5.1998 / 14:29:10 / cg"
+!
+
+showNotFound
+ |savedCursor|
+
+ savedCursor := cursor.
+ [
+ self cursor:(Cursor cross).
+ self beep.
+ Delay waitForMilliseconds:300.
+ ] valueNowOrOnUnwindDo:[
+ self cursor:savedCursor
+ ]
+
+ "Modified: / 29.4.1999 / 22:36:54 / cg"
+!
+
+unselect
+ "common unselect"
+
+ changeListView setSelection:nil.
+
+ "Modified: 25.5.1996 / 13:02:49 / cg"
+!
+
+withSelectedChangeDo:aBlock
+ "just a helper, check for a selected change and evaluate aBlock
+ with busy cursor"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withExecuteCursorDo:[
+ aBlock value:changeNr
+ ]
+ ]
+
+ "Modified: 14.12.1995 / 20:58:45 / cg"
+! !
+
+!ChangesBrowser methodsFor:'private-change access'!
+
+changeIsFollowupMethodChange:changeNr
+ ^ changeIsFollowupMethodChange at:changeNr
+
+ "Created: / 6.2.1998 / 13:03:39 / cg"
+!
+
+classNameOfChange:changeNr
+ "return the classname of a change
+ (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
+
+ |name|
+
+ name := self fullClassNameOfChange:changeNr.
+ name isNil ifTrue:[^ nil].
+ (name endsWith:' class') ifTrue:[
+ ^ name copyWithoutLast:6
+ ].
+ ^ name
+
+ "Modified: 6.12.1995 / 17:06:31 / cg"
+!
+
+fullClassNameOfChange:changeNr
+ "return the full classname of a change
+ (for classChanges (i.e. xxx class), a string ending in ' class' is returned.
+ - since parsing ascii methods is slow, keep result cached in
+ changeClassNames for the next query"
+
+ |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
+ words changeStream fullParseTree ownerTree ownerName oldDollarSetting|
+
+ changeNr isNil ifTrue:[^ nil].
+
+ "
+ first look, if not already known
+ "
+ name := changeClassNames at:changeNr.
+ name notNil ifTrue:[^ name].
+
+ prevMethodDefNr := changeNr.
+ [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
+ prevMethodDefNr := prevMethodDefNr - 1.
+ ].
+
+ "
+ get the chunk
+ "
+ chunk := changeChunks at:prevMethodDefNr.
+ chunk isNil ifTrue:[^ nil]. "mhmh - empty"
+
+ (chunk startsWith:'''---') ifTrue:[
+ words := chunk asCollectionOfWords.
+ words size > 2 ifTrue:[
+ (words at:2) = 'checkin' ifTrue:[
+ name := words at:3.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ].
+ ].
+
+ "/ fix it - otherwise, it cannot be parsed
+ (chunk endsWith:'primitiveDefinitions:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+ (chunk endsWith:'primitiveFunctions:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+ (chunk endsWith:'primitiveVariables:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+
+ "
+ use parser to construct a parseTree
+ "
+ oldDollarSetting := Parser allowDollarInIdentifier.
+ [
+ Parser allowDollarInIdentifier:true.
+ aParseTree := Parser parseExpression:chunk.
+
+ aParseTree == #Error ifTrue:[
+ (chunk includesString:'comment') ifTrue:[
+ "/ could be a comment ...
+ aParseTree := Parser parseExpression:chunk , ''''.
+ ]
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Parser allowDollarInIdentifier:oldDollarSetting
+ ].
+
+ (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
+ ^ nil "seems strange ... (could be a comment)"
+ ].
+ aParseTree isMessage ifFalse:[
+ ^ nil "very strange ... (whats that ?)"
+ ].
+
+ "
+ ask parser for selector
+ "
+ sel := aParseTree selector.
+ recTree := aParseTree receiver.
+
+ "
+ is it a method-change, methodRemove or comment-change ?
+ "
+
+ (#(#'methodsFor:'
+ #'privateMethodsFor:'
+ #'protectedMethodsFor:'
+ #'ignoredMethodsFor:'
+ #'publicMethodsFor:'
+ #'removeSelector:'
+ #'comment:'
+ #'primitiveDefinitions:'
+ #'primitiveFunctions:'
+ #'primitiveVariables:'
+ #'renameCategory:to:'
+ #'instanceVariableNames:'
+
+ #'methodsFor:stamp:' "/ Squeak support
+ #'commentStamp:prior:' "/ Squeak support
+ #'addClassVarName:' "/ Squeak support
+ ) includes:sel) ifTrue:[
+ "
+ yes, the className is the receiver
+ "
+ (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
+ isMeta := false.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class methodsFor:..."
+ recTree := recTree receiver.
+ isMeta := true.
+ ].
+ recTree isPrimary ifTrue:[
+ name := recTree name.
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ].
+ "more strange things"
+ ^ nil
+ ].
+
+ "
+ is it a change in a class-description ?
+ "
+ (('subclass:*' match:sel)
+ or:[('variable*subclass:*' match:sel)]) ifTrue:[
+ "/ must parse the full changes text, to get
+ "/ privacy information.
+
+ changeStream := self streamForChange:changeNr.
+ changeStream notNil ifTrue:[
+ chunk := changeStream nextChunk.
+ changeStream close.
+ fullParseTree := Parser parseExpression:chunk.
+ (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
+ fullParseTree := nil
+ ].
+ fullParseTree isMessage ifFalse:[
+ fullParseTree := nil
+ ].
+ "/ actually, the nil case cannot happen
+ fullParseTree notNil ifTrue:[
+ aParseTree := fullParseTree.
+ sel := aParseTree selector.
+ ].
+ ].
+
+ arg1Tree := aParseTree arg1.
+ (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
+ name := arg1Tree value asString.
+
+ "/ is it a private-class ?
+ ('*privateIn:' match:sel) ifTrue:[
+ ownerTree := aParseTree args last.
+ ownerName := ownerTree name asString.
+ name := ownerName , '::' , name
+ ].
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ].
+ "very strange"
+ ^ nil
+ ].
+
+ "
+ is it a class remove ?
+ "
+ (sel == #removeClass:) ifTrue:[
+ (recTree notNil
+ and:[recTree ~~ #Error
+ and:[recTree isPrimary
+ and:[recTree name = 'Smalltalk']]]) ifTrue:[
+ arg1Tree := aParseTree arg1.
+ (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[
+ name := arg1Tree name.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ].
+ ]
+ ].
+
+ "
+ is it a method category change ?
+ "
+ ((sel == #category:)
+ or:[sel == #privacy:]) ifTrue:[
+ (recTree notNil
+ and:[recTree ~~ #Error
+ and:[recTree isMessage
+ and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
+ isMeta := false.
+ recTree := recTree receiver.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class "
+ recTree := recTree receiver
+ ].
+ recTree isPrimary ifTrue:[
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ name := recTree name.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ]
+ ].
+ ^ nil
+
+ "Modified: / 3.8.1998 / 19:58:17 / cg"
+!
+
+numberOfChanges
+ ^ changePositions size
+
+ "Created: 3.12.1995 / 18:15:39 / cg"
+!
+
+selectorOfMethodChange:changeNr
+ "return a method-changes selector, or nil if its not a methodChange"
+
+ |source parser sel chunk aParseTree |
+
+ source := self sourceOfMethodChange:changeNr.
+ source isNil ifTrue:[
+ (self classNameOfChange:changeNr) notNil ifTrue:[
+ chunk := changeChunks at:changeNr.
+ chunk isNil ifTrue:[^ nil]. "mhmh - empty"
+ aParseTree := Parser parseExpression:chunk.
+ (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
+ ^ nil "seems strange ... (could be a comment)"
+ ].
+ aParseTree isMessage ifFalse:[
+ ^ nil "very strange ... (whats that ?)"
+ ].
+ sel := aParseTree selector.
+ (#(
+ #'removeSelector:'
+ ) includes:sel) ifTrue:[
+ sel := aParseTree arguments at:1.
+ sel isConstant ifTrue:[
+ sel := sel evaluate.
+ sel isSymbol ifTrue:[
+ ^ sel
+ ]
+ ]
+ ]
+ ].
+ ^ nil
+ ].
+
+
+ parser := Parser
+ parseMethodArgAndVarSpecification:source
+ in:nil
+ ignoreErrors:true
+ ignoreWarnings:true
+ parseBody:false.
+
+"/ parser := Parser
+"/ parseMethod:source
+"/ in:nil
+"/ ignoreErrors:true
+"/ ignoreWarnings:true.
+
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ sel := parser selector.
+ ].
+ ^ sel
+
+ "Created: 24.11.1995 / 14:30:46 / cg"
+ "Modified: 5.9.1996 / 17:12:50 / cg"
+!
+
+sourceOfMethodChange:changeNr
+ "return a method-changes source code, or nil if its not a methodChange."
+
+ |aStream chunk sawExcla parseTree sourceChunk sel|
+
+ aStream := self streamForChange:changeNr.
+ aStream isNil ifTrue:[^ nil].
+
+ (self changeIsFollowupMethodChange:changeNr) ifFalse:[
+ sawExcla := aStream peekFor:(aStream class chunkSeparator).
+ chunk := aStream nextChunk.
+ ] ifTrue:[
+ chunk := (changeChunks at:changeNr).
+ sawExcla := true.
+ ].
+
+ sawExcla ifTrue:[
+ parseTree := Parser parseExpression:chunk.
+ (parseTree notNil and:[parseTree isMessage]) ifTrue:[
+ sel := parseTree selector.
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+
+ #methodsFor:stamp: "/ Squeak support
+ #commentStamp:prior: "/ Squeak support
+ )
+ includes:sel) ifTrue:[
+ sourceChunk := aStream nextChunk.
+ ]
+ ].
+ ].
+ aStream close.
+ ^ sourceChunk
+
+ "Created: / 5.9.1996 / 17:11:32 / cg"
+ "Modified: / 3.8.1998 / 20:00:21 / cg"
+!
+
+streamForChange:changeNr
+ "answer a stream for change"
+
+ |aStream|
+
+ (changeNr between:1 and:changePositions size) ifFalse:[^ nil].
+ aStream := FileStream readonlyFileNamed:changeFileName.
+ aStream isNil ifTrue:[^ nil].
+ aStream position:(changePositions at:changeNr).
+ ^ aStream
+! !
+
+!ChangesBrowser methodsFor:'private-changeFile access'!
+
+changeFileName:aFileName
+ changeFileName := aFileName
+!
+
+checkIfFileHasChanged
+ |f info |
+
+ Processor removeTimedBlock:checkBlock.
+ f := changeFileName asFilename.
+ (info := f info) isNil ifTrue:[
+ self newLabel:'(unaccessable)'
+ ] ifFalse:[
+ (info modified) > changeFileTimestamp ifTrue:[
+ self newLabel:'(outdated)'.
+ autoUpdate ifTrue:[
+ self doUpdate
+ ]
+ ] ifFalse:[
+ self newLabel:''
+ ]
+ ].
+ Processor addTimedBlock:checkBlock afterSeconds:5.
+
+ "Created: 8.9.1995 / 19:30:19 / claus"
+ "Modified: 8.9.1995 / 19:38:18 / claus"
+ "Modified: 1.11.1996 / 20:22:56 / cg"
+!
+
+readChangesFile
+ "read the changes file, create a list of header-lines (changeChunks)
+ and a list of chunk-positions (changePositions)"
+
+ ^ self readChangesFileInBackground:false
+!
+
+readChangesFileInBackground:inBackground
+ "read the changes file, create a list of header-lines (changeChunks)
+ and a list of chunk-positions (changePositions).
+ Starting with 2.10.3, the entries are multi-col entries;
+ the cols are:
+ 1 delta (only if comparing)
+ '+' -> new method (w.r.t. current state)
+ '-' -> removed method (w.r.t. current state)
+ '?' -> class does not exist currently
+ '=' -> change is same as current methods source
+ 2 class/selector
+ 3 type of change
+ doit
+ method
+ category change
+ 4 timestamp
+
+ since comparing slows down startup time, it is now disabled by
+ default and can be enabled via a toggle."
+
+ |aStream maxLen i f chunkText fullChunkText|
+
+ editingClassSource := false.
+
+ maxLen := 60.
+
+ f := changeFileName asFilename.
+ aStream := f readStream.
+ aStream isNil ifTrue:[^ nil].
+
+ self newLabel:'updating ...'.
+
+ i := f info.
+ changeFileSize := i size.
+ changeFileTimestamp := i modified.
+
+ self withReadCursorDo:[
+ |myProcess myPriority|
+
+ "
+ this is a time consuming operation (especially, if reading an
+ NFS-mounted directory; therefore lower my priority ...
+ "
+ inBackground ifTrue:[
+ myProcess := Processor activeProcess.
+ myPriority := myProcess priority.
+ myProcess priority:(Processor userBackgroundPriority).
+ ].
+
+ [
+ |excla timeStampInfo|
+
+ changeChunks := OrderedCollection new.
+ changeHeaderLines := OrderedCollection new.
+ changePositions := OrderedCollection new.
+ changeTimeStamps := OrderedCollection new.
+ changeIsFollowupMethodChange := OrderedCollection new.
+
+ excla := aStream class chunkSeparator.
+
+ [aStream atEnd] whileFalse:[
+ |entry changeDelta changeString changeType
+ line s l changeClass sawExcla category
+ chunkPos sel|
+
+ "
+ get a chunk (separated by excla)
+ "
+ aStream skipSeparators.
+ chunkPos := aStream position.
+
+
+ sawExcla := aStream peekFor:excla.
+ chunkText := fullChunkText := aStream nextChunk.
+ chunkText notNil ifTrue:[
+ |index headerLine cls|
+
+ (chunkText startsWith:'''---- timestamp ') ifTrue:[
+ timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
+ ] ifFalse:[
+
+ "
+ only first line is saved in changeChunks ...
+ "
+ index := chunkText indexOf:(Character cr).
+ (index ~~ 0) ifTrue:[
+ chunkText := chunkText copyTo:(index - 1).
+
+ "take care for comment changes - must still be a
+ valid expression for classNameOfChange: to work"
+
+ (chunkText endsWith:'comment:''') ifTrue:[
+ chunkText := chunkText , '...'''
+ ].
+ (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
+ sel := 'primitiveDefinitions:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ (chunkText endsWith:'primitiveVariables:''') ifTrue:[
+ sel := 'primitiveVariables:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
+ sel := 'primitiveFunctions:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ ].
+
+ changeChunks add:chunkText.
+ changePositions add:chunkPos.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:false.
+
+ headerLine := nil.
+ changeDelta := ' '.
+
+ sawExcla ifFalse:[
+ (chunkText startsWith:'''---- snap') ifTrue:[
+ changeType := ''.
+ headerLine := chunkText.
+ changeString := (chunkText contractTo:maxLen).
+ timeStampInfo := nil.
+ ] ifFalse:[
+
+ |p cls clsName|
+
+ headerLine := chunkText , ' (doIt)'.
+
+ "
+ first, assume doIt - then lets have a more detailed look ...
+ "
+ ((chunkText startsWith:'''---- file')
+ or:[(chunkText startsWith:'''---- check')]) ifTrue:[
+ changeType := ''.
+ timeStampInfo := nil.
+ ] ifFalse:[
+ changeType := '(doIt)'.
+ ].
+ changeString := (chunkText contractTo:maxLen).
+
+ p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ p isMessage ifTrue:[
+ sel := p selector.
+ ]
+ ] ifFalse:[
+ sel := nil.
+ (Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[
+ "/ a comment only
+ changeType := '(comment)'.
+ ] ifFalse:[
+ changeType := '(???)'.
+ ]
+ ].
+ (sel == #removeSelector:) ifTrue:[
+ p receiver isUnaryMessage ifTrue:[
+ cls := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls) class.
+ cls := cls , ' class'.
+ ] ifFalse:[
+ cls := p receiver name.
+ changeClass := (Smalltalk classNamed:cls)
+ ].
+ sel := (p args at:1) evaluate.
+
+ compareChanges ifTrue:[
+ (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass implements:sel asSymbol) ifTrue:[
+ changeDelta := '-'.
+ ] ifFalse:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ changeType := '(remove)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ (p ~~ #Error
+ and:[p isMessage
+ and:[p receiver isMessage
+ and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
+ p receiver receiver isUnaryMessage ifTrue:[
+ cls := p receiver receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls) class.
+ cls := cls , ' class'.
+ ] ifFalse:[
+ cls := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls)
+ ].
+ (sel == #category:) ifTrue:[
+ sel := (p receiver args at:1) evaluate.
+ changeType := '(category change)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ (sel == #privacy:) ifTrue:[
+ sel := (p receiver args at:1) evaluate.
+ changeType := '(privacy change)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ ].
+ (#(#'subclass:'
+ #'variableSubclass:'
+ #'variableByteSubclass:'
+ #'variableWordSubclass:'
+ #'variableLongSubclass:'
+ #'variableFloatSubclass:'
+ #'variableDoubleSubclass:'
+ #'primitiveDefinitions:'
+ #'primitiveFunctions:'
+ #'primitiveVariables:'
+ ) includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ clsName := (p args at:1) evaluate.
+ cls := Smalltalk at:clsName ifAbsent:nil.
+ cls isNil ifTrue:[
+ changeDelta := '+'.
+ ]
+ ].
+ ]
+ ] ifTrue:[ "sawExcla"
+ |done first p className cls text methodPos
+ singleJunkOnly methodChunks singleInfo|
+
+ singleJunkOnly := false.
+ methodChunks := false.
+ singleInfo := false.
+
+ "
+ method definitions actually consist of
+ two (or more) chunks; skip next chunk(s)
+ up to an empty one.
+ The system only writes one chunk,
+ and we cannot handle more in this ChangesBrowser ....
+ "
+ className := nil.
+ p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
+
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ sel := p selector.
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ #'commentStamp:prior:'
+ )
+ includes:sel) ifTrue:[
+ methodChunks := true.
+ p receiver isUnaryMessage ifTrue:[
+ className := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:className) class.
+ className := className , ' class'.
+ ] ifFalse:[
+ className := p receiver name.
+ changeClass := Smalltalk classNamed:className
+ ].
+ category := (p args at:1) evaluate.
+
+ sel == #'methodsFor:stamp:' ifTrue:[
+ "/ Squeak timeStamp
+ timeStampInfo := (p args at:2) evaluate.
+ singleInfo := true
+ ] ifFalse:[
+ sel == #'commentStamp:prior:' ifTrue:[
+ singleJunkOnly := true.
+ methodChunks := false.
+ ].
+ ]
+ ].
+ ].
+
+ done := false.
+ first := true.
+ [done] whileFalse:[
+ changeDelta := ' '.
+ methodPos := aStream position.
+
+ text := aStream nextChunk.
+ text isNil ifTrue:[
+ done := true
+ ] ifFalse:[
+ done := text isEmpty
+ ].
+ done ifFalse:[
+ first ifFalse:[
+ changeChunks add:chunkText.
+ changePositions add:methodPos.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:true.
+ editingClassSource := true.
+ ].
+
+ first := false.
+ "
+ try to find the selector
+ "
+ sel := nil.
+ className notNil ifTrue:[
+ methodChunks ifTrue:[
+ p := Parser
+ parseMethodSpecification:text
+ in:nil
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ sel := p selector.
+ ]
+ ]
+ ].
+
+ sel isNil ifTrue:[
+ changeString := (chunkText contractTo:maxLen).
+ changeType := '(change)'.
+ headerLine := chunkText , ' (change)'.
+ ] ifFalse:[
+ changeString := self contractClass:className selector:sel to:maxLen.
+ changeType := '(method in: ''' , category , ''')'.
+ headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
+ ].
+
+ compareChanges ifTrue:[
+ changeClass isNil ifFalse:[
+ changeClass isMeta ifTrue:[
+ cls := changeClass soleInstance
+ ] ifFalse:[
+ cls := changeClass
+ ].
+ ].
+
+ (changeClass isNil or:[cls isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass implements:sel asSymbol) ifFalse:[
+ changeDelta := '+'.
+ ] ifTrue:[
+ |m currentText t1 t2|
+
+ m := changeClass compiledMethodAt:sel asSymbol.
+ currentText := m source.
+ currentText notNil ifTrue:[
+ text asString = currentText asString ifTrue:[
+ changeDelta := '='
+ ] ifFalse:[
+ t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t1 = t2 ifTrue:[
+ changeDelta := '='
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ entry := MultiColListEntry new.
+ entry tabulatorSpecification:tabSpec.
+ entry colAt:1 put:changeDelta.
+ entry colAt:2 put:changeString.
+ entry colAt:3 put:changeType.
+ timeStampInfo notNil ifTrue:[
+ entry colAt:4 put:timeStampInfo.
+ ].
+ changeHeaderLines add:entry
+ ].
+ changeString := nil.
+ headerLine := nil.
+ singleJunkOnly ifTrue:[done := true]
+ ].
+ singleInfo ifTrue:[
+ timeStampInfo := nil
+ ].
+ ].
+ changeString notNil ifTrue:[
+ entry := MultiColListEntry new.
+ entry tabulatorSpecification:tabSpec.
+ entry colAt:1 put:changeDelta.
+ entry colAt:2 put:changeString.
+ entry colAt:3 put:changeType.
+ timeStampInfo notNil ifTrue:[
+ entry colAt:4 put:timeStampInfo.
+ ].
+ changeHeaderLines add:entry
+ ] ifFalse:[
+ headerLine notNil ifTrue:[
+ changeHeaderLines add:headerLine
+ ]
+ ]
+ ]
+ ]
+ ].
+ changeClassNames := OrderedCollection new grow:(changeChunks size).
+ anyChanges := false
+ ] valueNowOrOnUnwindDo:[
+ aStream close.
+ inBackground ifTrue:[myProcess priority:myPriority].
+ ].
+ ].
+
+ self checkIfFileHasChanged
+
+ "Modified: / 27.8.1995 / 23:06:55 / claus"
+ "Modified: / 17.7.1998 / 11:10:07 / cg"
+!
+
+writeBackChanges
+ "write back the changes file. To avoid problems when the disk is full
+ or a crash occurs while writing (well, or someone kills us),
+ first write the stuff to a new temporary file. If this works ok,
+ rename the old change-file to a .bak file and finally rename the
+ tempfile back to the change-file.
+ That way, if anything happens, either the original file is left unchanged,
+ or we have at least a backup of the previous change file."
+
+ |inStream outStream tempfile stamp f|
+
+ editingClassSource ifTrue:[
+ (self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
+ ifFalse:[
+ ^ false
+ ]
+ ].
+
+ tempfile := Filename newTemporaryIn:nil.
+ tempfile exists ifTrue:[tempfile remove].
+
+ outStream := tempfile writeStream.
+ outStream isNil ifTrue:[
+ self warn:'cannot create temporary file in current directory.'.
+ ^ false
+ ].
+
+ inStream := FileStream readonlyFileNamed:changeFileName.
+ inStream isNil ifTrue:[^ false].
+
+ self withCursor:(Cursor write) do:[
+ |excla sawExcla done first chunk
+ nChanges "{Class:SmallInteger}" |
+
+ Stream writeErrorSignal handle:[:ex |
+ self warn:('could not update the changes file.\\' , ex errorString) withCRs.
+ tempfile exists ifTrue:[tempfile remove].
+ ^ false
+ ] do:[
+
+ excla := inStream class chunkSeparator.
+ nChanges := self numberOfChanges.
+
+ 1 to:nChanges do:[:index |
+ inStream position:(changePositions at:index).
+ sawExcla := inStream peekFor:excla.
+ chunk := inStream nextChunk.
+
+ (chunk notNil
+ and:[(chunk startsWith:'''---- snap') not]) ifTrue:[
+ (stamp := changeTimeStamps at:index) notNil ifTrue:[
+ outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
+ outStream nextPut:excla; cr.
+ ].
+ ].
+
+ sawExcla ifTrue:[
+ outStream nextPut:excla.
+ outStream nextChunkPut:chunk.
+ outStream cr; cr.
+ "
+ a method-definition chunk - output followups
+ "
+ done := false.
+ first := true.
+ [done] whileFalse:[
+ chunk := inStream nextChunk.
+ chunk isNil ifTrue:[
+ outStream cr; cr.
+ done := true
+ ] ifFalse:[
+ chunk isEmpty ifTrue:[
+ outStream space; nextChunkPut:chunk; cr; cr.
+ done := true.
+ ] ifFalse:[
+ first ifFalse:[
+ outStream cr; cr.
+ ].
+ outStream nextChunkPut:chunk.
+ ].
+ ].
+ first := false.
+ ].
+ ] ifFalse:[
+ outStream nextChunkPut:chunk.
+ outStream cr
+ ]
+ ].
+ outStream close.
+ inStream close.
+ ].
+
+ f := changeFileName asFilename.
+ f renameTo:(f withSuffix:'bak').
+ tempfile renameTo:changeFileName.
+ anyChanges := false
+ ].
+ ^ true
+
+ "Modified: / 2.12.1996 / 22:29:15 / stefan"
+ "Modified: / 21.4.1998 / 17:50:11 / cg"
+! !
+
+!ChangesBrowser methodsFor:'private-user interaction ops'!
+
appendChange:changeNr toFile:fileName
"append change to a file. return true if ok."
@@ -661,120 +1728,6 @@
"Modified: / 7.2.1998 / 19:56:34 / cg"
!
-autoSelect:changeNr
- "select a change"
-
- self class autoSelectNext ifTrue:[
- (changeNr <= self numberOfChanges) ifTrue:[
- changeListView setSelection:changeNr.
- self changeSelection:changeNr.
- ^ self
- ]
- ].
- self clearCodeView.
- changeListView setSelection:nil.
-
- "Modified: / 18.5.1998 / 14:26:43 / cg"
-!
-
-autoSelectLast
- "select the last change"
-
- self autoSelect:(self numberOfChanges)
-!
-
-autoSelectOrEnd:changeNr
- "select the next change or the last"
-
- |last|
-
- last := self numberOfChanges.
- changeNr < last ifTrue:[
- self autoSelect:changeNr
- ] ifFalse:[
- changeListView setSelection:last .
- self changeSelection:last.
- ]
-
- "Modified: 25.5.1996 / 12:26:17 / cg"
-!
-
-changeFileName:aFileName
- changeFileName := aFileName
-!
-
-changeIsFollowupMethodChange:changeNr
- ^ changeIsFollowupMethodChange at:changeNr
-
- "Created: / 6.2.1998 / 13:03:39 / cg"
-!
-
-checkClassIsLoaded:aClass
- |cls|
-
- aClass isMeta ifTrue:[
- cls := aClass soleInstance
- ] ifFalse:[
- cls := aClass
- ].
- cls isLoaded ifFalse:[
- (self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs)
- ifTrue:[
- cls autoload
- ]
- ].
- ^ cls isLoaded
-
- "Created: 12.12.1995 / 14:04:39 / cg"
- "Modified: 12.12.1995 / 14:11:05 / cg"
-!
-
-checkIfFileHasChanged
- |f info |
-
- Processor removeTimedBlock:checkBlock.
- f := changeFileName asFilename.
- (info := f info) isNil ifTrue:[
- self newLabel:'(unaccessable)'
- ] ifFalse:[
- (info modified) > changeFileTimestamp ifTrue:[
- self newLabel:'(outdated)'.
- autoUpdate ifTrue:[
- self doUpdate
- ]
- ] ifFalse:[
- self newLabel:''
- ]
- ].
- Processor addTimedBlock:checkBlock afterSeconds:5.
-
- "Created: 8.9.1995 / 19:30:19 / claus"
- "Modified: 8.9.1995 / 19:38:18 / claus"
- "Modified: 1.11.1996 / 20:22:56 / cg"
-!
-
-classNameOfChange:changeNr
- "return the classname of a change
- (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
-
- |name|
-
- name := self fullClassNameOfChange:changeNr.
- name isNil ifTrue:[^ nil].
- (name endsWith:' class') ifTrue:[
- ^ name copyWithoutLast:6
- ].
- ^ name
-
- "Modified: 6.12.1995 / 17:06:31 / cg"
-!
-
-clearCodeView
- self unselect "changeListView deselect".
- codeView contents:nil.
- changeNrShown := nil
-!
-
compareChange:changeNr
"compare a change with current version"
@@ -859,7 +1812,17 @@
(parseTree notNil
and:[parseTree ~~ #Error
and:[parseTree isMessage]]) ifTrue:[
- (parseTree selector == #methodsFor:) ifTrue:[
+ "/ Squeak support (#methodsFor:***)
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+
+ #methodsFor:stamp: "/ Squeak support
+ )
+ includes:parseTree selector) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
@@ -969,160 +1932,168 @@
aStream isNil ifTrue:[^ self].
aClassNameOrNil isNil ifTrue:[
- self newLabel:'compressing ...'.
+ self newLabel:'compressing ...'.
] ifFalse:[
- self newLabel:'compressing for ' , aClassNameOrNil.
+ self newLabel:'compressing for ' , aClassNameOrNil.
].
CompressSnapshotInfo == true ifTrue:[
- "
- get a prototype snapshot record (to be independent of
- the actual format ..
- "
- str := WriteStream on:String new.
- Class addChangeRecordForSnapshot:'foo' to:str.
- snapshotProto := str contents.
- snapshotPrefix := snapshotProto copyTo:10.
- snapshotNameIndex := snapshotProto findString:'foo'.
+ "
+ get a prototype snapshot record (to be independent of
+ the actual format ..
+ "
+ str := WriteStream on:String new.
+ Class addChangeRecordForSnapshot:'foo' to:str.
+ snapshotProto := str contents.
+ snapshotPrefix := snapshotProto copyTo:10.
+ snapshotNameIndex := snapshotProto findString:'foo'.
].
self withExecuteCursorDo:[
- |numChanges classes selectors types excla sawExcla
- changeNr chunk aParseTree parseTreeChunk
- thisClass thisSelector codeChunk codeParser
- compressThis|
-
- numChanges := self numberOfChanges.
- classes := Array new:numChanges.
- selectors := Array new:numChanges.
- types := Array new:numChanges.
-
- "starting at the end, get the change class and change selector;
- collect all in classes / selectors"
-
- changeNr := numChanges.
- excla := aStream class chunkSeparator.
-
- [changeNr >= 1] whileTrue:[
- aStream position:(changePositions at:changeNr).
- sawExcla := aStream peekFor:excla.
- chunk := aStream nextChunk.
- sawExcla ifTrue:[
- "optimize a bit if multiple methods for same category arrive"
- (chunk = parseTreeChunk) ifFalse:[
- aParseTree := Parser parseExpression:chunk.
- parseTreeChunk := chunk
- ].
- (aParseTree notNil
- and:[(aParseTree ~~ #Error)
- and:[aParseTree isMessage]]) ifTrue:[
- (aParseTree selector == #methodsFor:) ifTrue:[
- thisClass := (aParseTree receiver evaluate).
- codeChunk := aStream nextChunk.
- codeParser := Parser
- parseMethodSpecification:codeChunk
- in:thisClass
- ignoreErrors:true
- ignoreWarnings:true.
- (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[
- selectors at:changeNr put:(codeParser selector).
- classes at:changeNr put:thisClass.
- types at:changeNr put:#methodsFor
- ]
- ]
- ]
- ] ifFalse:[
- aParseTree := Parser parseExpression:chunk.
- parseTreeChunk := chunk.
- (aParseTree notNil
- and:[(aParseTree ~~ #Error)
- and:[aParseTree isMessage]]) ifTrue:[
- (aParseTree selector == #removeSelector:) ifTrue:[
- selectors at:changeNr put:(aParseTree arg1 value ).
- classes at:changeNr put:(aParseTree receiver evaluate).
- types at:changeNr put:#removeSelector
- ]
- ] ifFalse:[
- CompressSnapshotInfo == true ifTrue:[
- (chunk startsWith:snapshotPrefix) ifTrue:[
- str := chunk readStream position:snapshotNameIndex.
- fileName := str upTo:(Character space).
- "
- kludge to allow use of match-check below
- "
- selectors at:changeNr put:snapshotPrefix.
- classes at:changeNr put:fileName.
- ]
- ]
- ]
- ].
- changeNr := changeNr - 1
- ].
- aStream close.
-
- "for all changes, look for another class/selector occurence later
- in the list and, if there is one, add change number to the delete set"
-
- deleteSet := OrderedCollection new.
- changeNr := 1.
- [changeNr < self numberOfChanges] whileTrue:[
- thisClass := classes at:changeNr.
-
- compressThis := false.
- aClassNameOrNil isNil ifTrue:[
- compressThis := true
- ] ifFalse:[
- "/ skipping unloaded/unknown classes
- thisClass isBehavior ifTrue:[
- thisClass isMeta ifTrue:[
- compressThis := aClassNameOrNil = thisClass soleInstance name.
- ] ifFalse:[
- compressThis := aClassNameOrNil = thisClass name
- ]
- ]
- ].
-
- compressThis ifTrue:[
- thisSelector := selectors at:changeNr.
- searchIndex := changeNr.
- anyMore := true.
- [anyMore] whileTrue:[
- searchIndex := classes indexOf:thisClass
- startingAt:(searchIndex + 1).
- (searchIndex ~~ 0) ifTrue:[
- ((selectors at:searchIndex) == thisSelector) ifTrue:[
- thisClass notNil ifTrue:[
- deleteSet add:changeNr.
- anyMore := false
- ]
- ]
- ] ifFalse:[
- anyMore := false
- ]
- ].
- ].
-
- changeNr := changeNr + 1
- ].
-
- "finally delete what has been found"
-
- (deleteSet size > 0) ifTrue:[
- changeListView setSelection:nil.
- index := deleteSet size.
- [index > 0] whileTrue:[
- self silentDeleteChange:(deleteSet at:index).
- index := index - 1
- ].
- self setChangeList.
- "
- scroll back a bit, if we are left way behind the list
- "
- changeListView firstLineShown > self numberOfChanges ifTrue:[
- changeListView makeLineVisible:self numberOfChanges
- ].
- self clearCodeView
- ]
+ |numChanges classes selectors types excla sawExcla
+ changeNr chunk aParseTree parseTreeChunk
+ thisClass thisSelector codeChunk codeParser
+ compressThis|
+
+ numChanges := self numberOfChanges.
+ classes := Array new:numChanges.
+ selectors := Array new:numChanges.
+ types := Array new:numChanges.
+
+ "starting at the end, get the change class and change selector;
+ collect all in classes / selectors"
+
+ changeNr := numChanges.
+ excla := aStream class chunkSeparator.
+
+ [changeNr >= 1] whileTrue:[
+ aStream position:(changePositions at:changeNr).
+ sawExcla := aStream peekFor:excla.
+ chunk := aStream nextChunk.
+ sawExcla ifTrue:[
+ "optimize a bit if multiple methods for same category arrive"
+ (chunk = parseTreeChunk) ifFalse:[
+ aParseTree := Parser parseExpression:chunk.
+ parseTreeChunk := chunk
+ ].
+ (aParseTree notNil
+ and:[(aParseTree ~~ #Error)
+ and:[aParseTree isMessage]]) ifTrue:[
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ )
+ includes:aParseTree selector) ifTrue:[
+ thisClass := (aParseTree receiver evaluate).
+ codeChunk := aStream nextChunk.
+ codeParser := Parser
+ parseMethodSpecification:codeChunk
+ in:thisClass
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[
+ selectors at:changeNr put:(codeParser selector).
+ classes at:changeNr put:thisClass.
+ types at:changeNr put:#methodsFor
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ aParseTree := Parser parseExpression:chunk.
+ parseTreeChunk := chunk.
+ (aParseTree notNil
+ and:[(aParseTree ~~ #Error)
+ and:[aParseTree isMessage]]) ifTrue:[
+ (aParseTree selector == #removeSelector:) ifTrue:[
+ selectors at:changeNr put:(aParseTree arg1 value ).
+ classes at:changeNr put:(aParseTree receiver evaluate).
+ types at:changeNr put:#removeSelector
+ ]
+ ] ifFalse:[
+ CompressSnapshotInfo == true ifTrue:[
+ (chunk startsWith:snapshotPrefix) ifTrue:[
+ str := chunk readStream position:snapshotNameIndex.
+ fileName := str upTo:(Character space).
+ "
+ kludge to allow use of match-check below
+ "
+ selectors at:changeNr put:snapshotPrefix.
+ classes at:changeNr put:fileName.
+ ]
+ ]
+ ]
+ ].
+ changeNr := changeNr - 1
+ ].
+ aStream close.
+
+ "for all changes, look for another class/selector occurence later
+ in the list and, if there is one, add change number to the delete set"
+
+ deleteSet := OrderedCollection new.
+ changeNr := 1.
+ [changeNr < self numberOfChanges] whileTrue:[
+ thisClass := classes at:changeNr.
+
+ compressThis := false.
+ aClassNameOrNil isNil ifTrue:[
+ compressThis := true
+ ] ifFalse:[
+ "/ skipping unloaded/unknown classes
+ thisClass isBehavior ifTrue:[
+ thisClass isMeta ifTrue:[
+ compressThis := aClassNameOrNil = thisClass soleInstance name.
+ ] ifFalse:[
+ compressThis := aClassNameOrNil = thisClass name
+ ]
+ ]
+ ].
+
+ compressThis ifTrue:[
+ thisSelector := selectors at:changeNr.
+ searchIndex := changeNr.
+ anyMore := true.
+ [anyMore] whileTrue:[
+ searchIndex := classes indexOf:thisClass
+ startingAt:(searchIndex + 1).
+ (searchIndex ~~ 0) ifTrue:[
+ ((selectors at:searchIndex) == thisSelector) ifTrue:[
+ thisClass notNil ifTrue:[
+ deleteSet add:changeNr.
+ anyMore := false
+ ]
+ ]
+ ] ifFalse:[
+ anyMore := false
+ ]
+ ].
+ ].
+
+ changeNr := changeNr + 1
+ ].
+
+ "finally delete what has been found"
+
+ (deleteSet size > 0) ifTrue:[
+ changeListView setSelection:nil.
+ index := deleteSet size.
+ [index > 0] whileTrue:[
+ self silentDeleteChange:(deleteSet at:index).
+ index := index - 1
+ ].
+ self setChangeList.
+ "
+ scroll back a bit, if we are left way behind the list
+ "
+ changeListView firstLineShown > self numberOfChanges ifTrue:[
+ changeListView makeLineVisible:self numberOfChanges
+ ].
+ self clearCodeView
+ ]
].
self newLabel:''.
@@ -1130,26 +2101,6 @@
"Modified: / 29.10.1997 / 01:26:59 / cg"
!
-contractClass:className selector:selector to:maxLen
- |s l|
-
- s := className , ' ', selector.
- s size > maxLen ifTrue:[
- l := maxLen - 1 - selector size max:20.
- s := (className contractTo:l) , ' ' , selector.
-
- s size > maxLen ifTrue:[
- l := maxLen - 1 - className size max:20.
- s := className , ' ', (selector contractTo:l).
-
- s size > maxLen ifTrue:[
- s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
- ]
- ]
- ].
- ^ s
-!
-
deleteChange:changeNr
"delete a change"
@@ -1173,218 +2124,6 @@
"Modified: / 18.5.1998 / 14:22:27 / cg"
!
-fullClassNameOfChange:changeNr
- "return the full classname of a change
- (for classChanges (i.e. xxx class), a string ending in ' class' is returned.
- - since parsing ascii methods is slow, keep result cached in
- changeClassNames for the next query"
-
- |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
- words changeStream fullParseTree ownerTree ownerName oldDollarSetting|
-
- changeNr isNil ifTrue:[^ nil].
-
- "
- first look, if not already known
- "
- name := changeClassNames at:changeNr.
- name notNil ifTrue:[^ name].
-
- prevMethodDefNr := changeNr.
- [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
- prevMethodDefNr := prevMethodDefNr - 1.
- ].
-
- "
- get the chunk
- "
- chunk := changeChunks at:prevMethodDefNr.
- chunk isNil ifTrue:[^ nil]. "mhmh - empty"
-
- (chunk startsWith:'''---') ifTrue:[
- words := chunk asCollectionOfWords.
- words size > 2 ifTrue:[
- (words at:2) = 'checkin' ifTrue:[
- name := words at:3.
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ].
- ].
-
- "/ fix it - otherwise, it cannot be parsed
- (chunk endsWith:'primitiveDefinitions:') ifTrue:[
- chunk := chunk , ''''''
- ].
- (chunk endsWith:'primitiveFunctions:') ifTrue:[
- chunk := chunk , ''''''
- ].
- (chunk endsWith:'primitiveVariables:') ifTrue:[
- chunk := chunk , ''''''
- ].
-
- "
- use parser to construct a parseTree
- "
- oldDollarSetting := Parser allowDollarInIdentifier.
- [
- Parser allowDollarInIdentifier:true.
- aParseTree := Parser parseExpression:chunk.
-
- aParseTree == #Error ifTrue:[
- (chunk includesString:'comment') ifTrue:[
- "/ could be a comment ...
- aParseTree := Parser parseExpression:chunk , ''''.
- ]
- ].
- ] valueNowOrOnUnwindDo:[
- Parser allowDollarInIdentifier:oldDollarSetting
- ].
-
- (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
- ^ nil "seems strange ... (could be a comment)"
- ].
- aParseTree isMessage ifFalse:[
- ^ nil "very strange ... (whats that ?)"
- ].
-
- "
- ask parser for selector
- "
- sel := aParseTree selector.
- recTree := aParseTree receiver.
-
- "
- is it a method-change, methodRemove or comment-change ?
- "
- (#(#'methodsFor:'
- #'privateMethodsFor:'
- #'protectedMethodsFor:'
- #'ignoredMethodsFor:'
- #'publicMethodsFor:'
- #'removeSelector:'
- #'comment:'
- #'primitiveDefinitions:'
- #'primitiveFunctions:'
- #'primitiveVariables:'
- #'renameCategory:to:'
- #'instanceVariableNames:'
- ) includes:sel) ifTrue:[
- "
- yes, the className is the receiver
- "
- (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
- isMeta := false.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class methodsFor:..."
- recTree := recTree receiver.
- isMeta := true.
- ].
- recTree isPrimary ifTrue:[
- name := recTree name.
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ].
- "more strange things"
- ^ nil
- ].
-
- "
- is it a change in a class-description ?
- "
- (('subclass:*' match:sel)
- or:[('variable*subclass:*' match:sel)]) ifTrue:[
- "/ must parse the full changes text, to get
- "/ privacy information.
-
- changeStream := self streamForChange:changeNr.
- changeStream notNil ifTrue:[
- chunk := changeStream nextChunk.
- changeStream close.
- fullParseTree := Parser parseExpression:chunk.
- (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
- fullParseTree := nil
- ].
- fullParseTree isMessage ifFalse:[
- fullParseTree := nil
- ].
- "/ actually, the nil case cannot happen
- fullParseTree notNil ifTrue:[
- aParseTree := fullParseTree.
- sel := aParseTree selector.
- ].
- ].
-
- arg1Tree := aParseTree arg1.
- (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
- name := arg1Tree value asString.
-
- "/ is it a private-class ?
- ('*privateIn:' match:sel) ifTrue:[
- ownerTree := aParseTree args last.
- ownerName := ownerTree name asString.
- name := ownerName , '::' , name
- ].
- changeClassNames at:changeNr put:name.
- ^ name
- ].
- "very strange"
- ^ nil
- ].
-
- "
- is it a class remove ?
- "
- (sel == #removeClass:) ifTrue:[
- (recTree notNil
- and:[recTree ~~ #Error
- and:[recTree isPrimary
- and:[recTree name = 'Smalltalk']]]) ifTrue:[
- arg1Tree := aParseTree arg1.
- (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[
- name := arg1Tree name.
- changeClassNames at:changeNr put:name.
- ^ name
- ].
- ]
- ].
-
- "
- is it a method category change ?
- "
- ((sel == #category:)
- or:[sel == #privacy:]) ifTrue:[
- (recTree notNil
- and:[recTree ~~ #Error
- and:[recTree isMessage
- and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
- isMeta := false.
- recTree := recTree receiver.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class "
- recTree := recTree receiver
- ].
- recTree isPrimary ifTrue:[
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- name := recTree name.
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ]
- ].
- ^ nil
-
- "Modified: / 3.8.1998 / 19:58:17 / cg"
-!
-
makeChangeAPatch:changeNr
"append change to patchfile"
@@ -1397,494 +2136,6 @@
self notify:'this is not yet implemented'
!
-newLabel:how
- |l|
-
- (changeFileName ~= 'changes') ifTrue:[
- l := self class defaultLabel , ': ', changeFileName
- ] ifFalse:[
- l := self class defaultLabel
- ].
- l := l , ' ' , how.
- self label:l
-
- "Created: / 8.9.1995 / 19:32:04 / claus"
- "Modified: / 8.9.1995 / 19:39:29 / claus"
- "Modified: / 6.2.1998 / 13:27:01 / cg"
-!
-
-numberOfChanges
- ^ changePositions size
-
- "Created: 3.12.1995 / 18:15:39 / cg"
-!
-
-queryCloseText
- "made this a method for easy redefinition in subclasses"
-
- ^ 'Quit without updating changeFile ?'
-!
-
-readChangesFile
- "read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions)"
-
- ^ self readChangesFileInBackground:false
-!
-
-readChangesFileInBackground:inBackground
- "read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions).
- Starting with 2.10.3, the entries are multi-col entries;
- the cols are:
- 1 delta (only if comparing)
- '+' -> new method (w.r.t. current state)
- '-' -> removed method (w.r.t. current state)
- '?' -> class does not exist currently
- '=' -> change is same as current methods source
- 2 class/selector
- 3 type of change
- doit
- method
- category change
- 4 timestamp
-
- since comparing slows down startup time, it is now disabled by
- default and can be enabled via a toggle."
-
- |aStream maxLen i f|
-
- editingClassSource := false.
-
- maxLen := 60.
-
- f := changeFileName asFilename.
- aStream := f readStream.
- aStream isNil ifTrue:[^ nil].
-
- self newLabel:'updating ...'.
-
- i := f info.
- changeFileSize := i size.
- changeFileTimestamp := i modified.
-
- self withReadCursorDo:[
- |myProcess myPriority|
-
- "
- this is a time consuming operation (especially, if reading an
- NFS-mounted directory; therefore lower my priority ...
- "
- inBackground ifTrue:[
- myProcess := Processor activeProcess.
- myPriority := myProcess priority.
- myProcess priority:(Processor userBackgroundPriority).
- ].
-
- [
- |excla timeStampInfo|
-
- changeChunks := OrderedCollection new.
- changeHeaderLines := OrderedCollection new.
- changePositions := OrderedCollection new.
- changeTimeStamps := OrderedCollection new.
- changeIsFollowupMethodChange := OrderedCollection new.
-
- excla := aStream class chunkSeparator.
-
- [aStream atEnd] whileFalse:[
- |entry changeDelta changeString changeType
- line s l changeClass sawExcla category
- chunkText chunkPos sel|
-
- "
- get a chunk (separated by excla)
- "
- aStream skipSeparators.
- chunkPos := aStream position.
-
-
- sawExcla := aStream peekFor:excla.
- chunkText := aStream nextChunk.
- chunkText notNil ifTrue:[
- |index headerLine cls|
-
- (chunkText startsWith:'''---- timestamp ') ifTrue:[
- timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
- ] ifFalse:[
-
- "
- only first line is saved in changeChunks ...
- "
- index := chunkText indexOf:(Character cr).
- (index ~~ 0) ifTrue:[
- chunkText := chunkText copyTo:(index - 1).
-
- "take care for comment changes - must still be a
- valid expression for classNameOfChange: to work"
-
- (chunkText endsWith:'comment:''') ifTrue:[
- chunkText := chunkText , '...'''
- ].
- (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
- sel := 'primitiveDefinitions:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- (chunkText endsWith:'primitiveVariables:''') ifTrue:[
- sel := 'primitiveVariables:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
- sel := 'primitiveFunctions:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- ].
-
- changeChunks add:chunkText.
- changePositions add:chunkPos.
- changeTimeStamps add:timeStampInfo.
- changeIsFollowupMethodChange add:false.
-
- headerLine := nil.
- changeDelta := ' '.
-
- sawExcla ifFalse:[
- (chunkText startsWith:'''---- snap') ifTrue:[
- changeType := ''.
- headerLine := chunkText.
- changeString := (chunkText contractTo:maxLen).
- timeStampInfo := nil.
- ] ifFalse:[
-
- |p cls clsName|
-
- headerLine := chunkText , ' (doIt)'.
-
- "
- first, assume doIt - then lets have a more detailed look ...
- "
- ((chunkText startsWith:'''---- file')
- or:[(chunkText startsWith:'''---- check')]) ifTrue:[
- changeType := ''.
- timeStampInfo := nil.
- ] ifFalse:[
- changeType := '(doIt)'.
- ].
- changeString := (chunkText contractTo:maxLen).
-
- p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
- (p notNil
- and:[p ~~ #Error
- and:[p isMessage]]) ifTrue:[
- sel := p selector.
- ] ifFalse:[
- sel := nil.
- ].
- (sel == #removeSelector:) ifTrue:[
- p receiver isUnaryMessage ifTrue:[
- cls := p receiver receiver name.
- changeClass := (Smalltalk classNamed:cls) class.
- cls := cls , ' class'.
- ] ifFalse:[
- cls := p receiver name.
- changeClass := (Smalltalk classNamed:cls)
- ].
- sel := (p args at:1) evaluate.
-
- compareChanges ifTrue:[
- (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass implements:sel asSymbol) ifTrue:[
- changeDelta := '-'.
- ] ifFalse:[
- changeDelta := '='.
- ]
- ]
- ].
- changeType := '(remove)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- (p ~~ #Error
- and:[p isMessage
- and:[p receiver isMessage
- and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
- p receiver receiver isUnaryMessage ifTrue:[
- cls := p receiver receiver receiver name.
- changeClass := (Smalltalk classNamed:cls) class.
- cls := cls , ' class'.
- ] ifFalse:[
- cls := p receiver receiver name.
- changeClass := (Smalltalk classNamed:cls)
- ].
- (sel == #category:) ifTrue:[
- sel := (p receiver args at:1) evaluate.
- changeType := '(category change)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- (sel == #privacy:) ifTrue:[
- sel := (p receiver args at:1) evaluate.
- changeType := '(privacy change)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- ].
- (#(#'subclass:'
- #'variableSubclass:'
- #'variableByteSubclass:'
- #'variableWordSubclass:'
- #'variableLongSubclass:'
- #'variableFloatSubclass:'
- #'variableDoubleSubclass:'
- #'primitiveDefinitions:'
- #'primitiveFunctions:'
- #'primitiveVariables:'
- ) includes:sel) ifTrue:[
- changeType := '(class definition)'.
- clsName := (p args at:1) evaluate.
- cls := Smalltalk at:clsName ifAbsent:nil.
- cls isNil ifTrue:[
- changeDelta := '+'.
- ]
- ].
- ]
- ] ifTrue:[ "sawExcla"
- |done first p className cls text methodPos|
-
- "
- method definitions actually consist of
- two (or more) chunks; skip next chunk(s)
- up to an empty one.
- The system only writes one chunk,
- and we cannot handle more in this ChangesBrowser ....
- "
- className := nil.
- p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
-
- (p notNil and:[p ~~ #Error]) ifTrue:[
- sel := p selector.
- (sel == #methodsFor:) ifTrue:[
- p receiver isUnaryMessage ifTrue:[
- className := p receiver receiver name.
- changeClass := (Smalltalk classNamed:className) class.
- className := className , ' class'.
- ] ifFalse:[
- className := p receiver name.
- changeClass := Smalltalk classNamed:className
- ].
- category := (p args at:1) evaluate.
- ].
- ].
-
- done := false.
- first := true.
- [done] whileFalse:[
- changeDelta := ' '.
- methodPos := aStream position.
-
- text := aStream nextChunk.
- text isNil ifTrue:[
- done := true
- ] ifFalse:[
- done := text isEmpty
- ].
- done ifFalse:[
- first ifFalse:[
- changeChunks add:chunkText.
- changePositions add:methodPos.
- changeTimeStamps add:timeStampInfo.
- changeIsFollowupMethodChange add:true.
- editingClassSource := true.
- ].
-
- first := false.
- "
- try to find the selector
- "
- sel := nil.
- className notNil ifTrue:[
- p := Parser
- parseMethodSpecification:text
- in:nil
- ignoreErrors:true
- ignoreWarnings:true.
- (p notNil and:[p ~~ #Error]) ifTrue:[
- sel := p selector.
- ]
- ].
-
- sel isNil ifTrue:[
- changeString := (chunkText contractTo:maxLen).
- changeType := '(change)'.
- headerLine := chunkText , ' (change)'.
- ] ifFalse:[
- changeString := self contractClass:className selector:sel to:maxLen.
- changeType := '(method in: ''' , category , ''')'.
- headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
- ].
-
- compareChanges ifTrue:[
- changeClass isNil ifFalse:[
- changeClass isMeta ifTrue:[
- cls := changeClass soleInstance
- ] ifFalse:[
- cls := changeClass
- ].
- ].
-
- (changeClass isNil or:[cls isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass implements:sel asSymbol) ifFalse:[
- changeDelta := '+'.
- ] ifTrue:[
- |m currentText t1 t2|
-
- m := changeClass compiledMethodAt:sel asSymbol.
- currentText := m source.
- currentText notNil ifTrue:[
- text asString = currentText asString ifTrue:[
- changeDelta := '='
- ] ifFalse:[
- t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
- t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
- t1 = t2 ifTrue:[
- changeDelta := '='
- ]
- ]
- ]
- ]
- ]
- ].
- entry := MultiColListEntry new.
- entry tabulatorSpecification:tabSpec.
- entry colAt:1 put:changeDelta.
- entry colAt:2 put:changeString.
- entry colAt:3 put:changeType.
- timeStampInfo notNil ifTrue:[
- entry colAt:4 put:timeStampInfo.
- ].
- changeHeaderLines add:entry
- ].
- changeString := nil.
- headerLine := nil.
-
- ]
- ].
- changeString notNil ifTrue:[
- entry := MultiColListEntry new.
- entry tabulatorSpecification:tabSpec.
- entry colAt:1 put:changeDelta.
- entry colAt:2 put:changeString.
- entry colAt:3 put:changeType.
- timeStampInfo notNil ifTrue:[
- entry colAt:4 put:timeStampInfo.
- ].
- changeHeaderLines add:entry
- ] ifFalse:[
- headerLine notNil ifTrue:[
- changeHeaderLines add:headerLine
- ]
- ]
- ]
- ]
- ].
- changeClassNames := OrderedCollection new grow:(changeChunks size).
- anyChanges := false
- ] valueNowOrOnUnwindDo:[
- aStream close.
- inBackground ifTrue:[myProcess priority:myPriority].
- ].
- ].
-
- self checkIfFileHasChanged
-
- "Modified: / 27.8.1995 / 23:06:55 / claus"
- "Modified: / 17.7.1998 / 11:10:07 / cg"
-!
-
-selectorOfMethodChange:changeNr
- "return a method-changes selector, or nil if its not a methodChange"
-
- |source parser sel chunk aParseTree |
-
- source := self sourceOfMethodChange:changeNr.
- source isNil ifTrue:[
- (self classNameOfChange:changeNr) notNil ifTrue:[
- chunk := changeChunks at:changeNr.
- chunk isNil ifTrue:[^ nil]. "mhmh - empty"
- aParseTree := Parser parseExpression:chunk.
- (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
- ^ nil "seems strange ... (could be a comment)"
- ].
- aParseTree isMessage ifFalse:[
- ^ nil "very strange ... (whats that ?)"
- ].
- sel := aParseTree selector.
- (#(
- #'removeSelector:'
- ) includes:sel) ifTrue:[
- sel := aParseTree arguments at:1.
- sel isConstant ifTrue:[
- sel := sel evaluate.
- sel isSymbol ifTrue:[
- ^ sel
- ]
- ]
- ]
- ].
- ^ nil
- ].
-
-
- parser := Parser
- parseMethodArgAndVarSpecification:source
- in:nil
- ignoreErrors:true
- ignoreWarnings:true
- parseBody:false.
-
-"/ parser := Parser
-"/ parseMethod:source
-"/ in:nil
-"/ ignoreErrors:true
-"/ ignoreWarnings:true.
-
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- sel := parser selector.
- ].
- ^ sel
-
- "Created: 24.11.1995 / 14:30:46 / cg"
- "Modified: 5.9.1996 / 17:12:50 / cg"
-!
-
-setChangeList
- "extract type-information from changes and stuff into top selection
- view"
-
- changeListView setList:changeHeaderLines expandTabs:false redraw:false.
- changeListView invalidate.
-
- "/ changeListView deselect.
-
- "Modified: / 18.5.1998 / 14:29:10 / cg"
-!
-
-showNotFound
- |savedCursor|
-
- savedCursor := cursor.
- [
- self cursor:(Cursor cross).
- self beep.
- Delay waitForMilliseconds:300.
- ] valueNowOrOnUnwindDo:[
- self cursor:savedCursor
- ]
-
- "Modified: / 29.4.1999 / 22:36:54 / cg"
-!
-
silentDeleteChange:changeNr
"delete a change do not update changeListView"
@@ -1930,181 +2181,6 @@
"Created: / 7.3.1997 / 16:28:32 / cg"
"Modified: / 7.2.1998 / 19:59:11 / cg"
"Modified: / 26.2.1998 / 18:20:48 / stefan"
-!
-
-sourceOfMethodChange:changeNr
- "return a method-changes source code, or nil if its not a methodChange."
-
- |aStream chunk sawExcla parseTree sourceChunk|
-
- aStream := self streamForChange:changeNr.
- aStream isNil ifTrue:[^ nil].
-
- (self changeIsFollowupMethodChange:changeNr) ifFalse:[
- sawExcla := aStream peekFor:(aStream class chunkSeparator).
- chunk := aStream nextChunk.
- ] ifTrue:[
- chunk := (changeChunks at:changeNr).
- sawExcla := true.
- ].
-
- sawExcla ifTrue:[
- parseTree := Parser parseExpression:chunk.
- (parseTree notNil and:[parseTree isMessage]) ifTrue:[
- (#(#methodsFor:
- #privateMethodsFor:
- #publicMethodsFor:
- #ignoredMethodsFor:
- #protectedMethodsFor:)
- includes:parseTree selector) ifTrue:[
- sourceChunk := aStream nextChunk.
- ]
- ].
- ].
- aStream close.
- ^ sourceChunk
-
- "Created: / 5.9.1996 / 17:11:32 / cg"
- "Modified: / 3.8.1998 / 20:00:21 / cg"
-!
-
-streamForChange:changeNr
- "answer a stream for change"
-
- |aStream|
-
- (changeNr between:1 and:changePositions size) ifFalse:[^ nil].
- aStream := FileStream readonlyFileNamed:changeFileName.
- aStream isNil ifTrue:[^ nil].
- aStream position:(changePositions at:changeNr).
- ^ aStream
-!
-
-unselect
- "common unselect"
-
- changeListView setSelection:nil.
-
- "Modified: 25.5.1996 / 13:02:49 / cg"
-!
-
-withSelectedChangeDo:aBlock
- "just a helper, check for a selected change and evaluate aBlock
- with busy cursor"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withExecuteCursorDo:[
- aBlock value:changeNr
- ]
- ]
-
- "Modified: 14.12.1995 / 20:58:45 / cg"
-!
-
-writeBackChanges
- "write back the changes file. To avoid problems when the disk is full
- or a crash occurs while writing (well, or someone kills us),
- first write the stuff to a new temporary file. If this works ok,
- rename the old change-file to a .bak file and finally rename the
- tempfile back to the change-file.
- That way, if anything happens, either the original file is left unchanged,
- or we have at least a backup of the previous change file."
-
- |inStream outStream tempfile stamp f|
-
- editingClassSource ifTrue:[
- (self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
- ifFalse:[
- ^ false
- ]
- ].
-
- tempfile := Filename newTemporaryIn:nil.
- tempfile exists ifTrue:[tempfile remove].
-
- outStream := tempfile writeStream.
- outStream isNil ifTrue:[
- self warn:'cannot create temporary file in current directory.'.
- ^ false
- ].
-
- inStream := FileStream readonlyFileNamed:changeFileName.
- inStream isNil ifTrue:[^ false].
-
- self withCursor:(Cursor write) do:[
- |excla sawExcla done first chunk
- nChanges "{Class:SmallInteger}" |
-
- Stream writeErrorSignal handle:[:ex |
- self warn:('could not update the changes file.\\' , ex errorString) withCRs.
- tempfile exists ifTrue:[tempfile remove].
- ^ false
- ] do:[
-
- excla := inStream class chunkSeparator.
- nChanges := self numberOfChanges.
-
- 1 to:nChanges do:[:index |
- inStream position:(changePositions at:index).
- sawExcla := inStream peekFor:excla.
- chunk := inStream nextChunk.
-
- (chunk notNil
- and:[(chunk startsWith:'''---- snap') not]) ifTrue:[
- (stamp := changeTimeStamps at:index) notNil ifTrue:[
- outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
- outStream nextPut:excla; cr.
- ].
- ].
-
- sawExcla ifTrue:[
- outStream nextPut:excla.
- outStream nextChunkPut:chunk.
- outStream cr; cr.
- "
- a method-definition chunk - output followups
- "
- done := false.
- first := true.
- [done] whileFalse:[
- chunk := inStream nextChunk.
- chunk isNil ifTrue:[
- outStream cr; cr.
- done := true
- ] ifFalse:[
- chunk isEmpty ifTrue:[
- outStream space; nextChunkPut:chunk; cr; cr.
- done := true.
- ] ifFalse:[
- first ifFalse:[
- outStream cr; cr.
- ].
- outStream nextChunkPut:chunk.
- ].
- ].
- first := false.
- ].
- ] ifFalse:[
- outStream nextChunkPut:chunk.
- outStream cr
- ]
- ].
- outStream close.
- inStream close.
- ].
-
- f := changeFileName asFilename.
- f renameTo:(f withSuffix:'bak').
- tempfile renameTo:changeFileName.
- anyChanges := false
- ].
- ^ true
-
- "Modified: / 2.12.1996 / 22:29:15 / stefan"
- "Modified: / 21.4.1998 / 17:50:11 / cg"
! !
!ChangesBrowser methodsFor:'termination'!
@@ -2985,5 +3061,5 @@
!ChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.155 1999-06-26 16:30:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.156 1999-07-15 14:45:31 cg Exp $'
! !
--- a/ChangesBrowser.st Thu Jul 15 15:44:16 1999 +0200
+++ b/ChangesBrowser.st Thu Jul 15 16:45:31 1999 +0200
@@ -40,35 +40,39 @@
documentation
"
- this implements a browser for the changes-file.
+ this implements a browser for the changes-file (actually, it can display
+ any sourceFiles contents).
See the extra document 'doc/misc/cbrowser.doc' for how to use this browser.
written jan 90 by claus
[Class variables:]
- CompressSnapshotInfo if true (the default), snapshot entries
- are also compressed in the compress function.
- Some users prefer them to be not compressed.
- Set it to false for this.
+ CompressSnapshotInfo if true (the default), snapshot entries
+ are also compressed in the compress function.
+ Some users prefer them to be not compressed.
+ Set it to false for this.
Notice:
- this needs a total rewrite, to build up a changeSet from the file
- (which did not exist when the ChangesBrowser was originally written)
- and manipulate that changeSet.
-
- This way, we get a browser for any upcoming incore changeSets for
- free. Also, this will put the chunk analyzation code into Change and
- subclasses (where it belongs) and give a better encapsulation and
- overall structure. Do not take this as an example for good style ;-)
+ this needs a total rewrite, to build up a changeSet from the file
+ (which did not exist when the ChangesBrowser was originally written)
+ and manipulate that changeSet.
+
+ This way, we get a browser for any upcoming incore changeSets for
+ free. Also, this will put the chunk analyzation code into Change and
+ subclasses (where it belongs) and give a better encapsulation and
+ overall structure. Do not take this as an example for good style ;-)
+
+ The Change hierarchy is currently been completed, and the changes browser
+ will be adapted soon.
[author:]
- Claus Gittinger
+ Claus Gittinger
[start with:]
- ChangesBrowser open
+ ChangesBrowser open
[see also:]
- ( Using the ChangesBrowser :html: tools/cbrowser/TOP.html )
+ ( Using the ChangesBrowser :html: tools/cbrowser/TOP.html )
"
! !
@@ -142,12 +146,12 @@
wantChangeLog
"sent by the compiler to ask if a changeLog entry should
- be written. Return false here."
+ be written when compiling. Return false here."
^ false
! !
-!ChangesBrowser methodsFor:'error handling'!
+!ChangesBrowser methodsFor:'compiler interface-error handling'!
correctableError:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of an error - this should really not happen since
@@ -544,6 +548,1069 @@
!ChangesBrowser methodsFor:'private'!
+autoSelect:changeNr
+ "select a change"
+
+ self class autoSelectNext ifTrue:[
+ (changeNr <= self numberOfChanges) ifTrue:[
+ changeListView setSelection:changeNr.
+ self changeSelection:changeNr.
+ ^ self
+ ]
+ ].
+ self clearCodeView.
+ changeListView setSelection:nil.
+
+ "Modified: / 18.5.1998 / 14:26:43 / cg"
+!
+
+autoSelectLast
+ "select the last change"
+
+ self autoSelect:(self numberOfChanges)
+!
+
+autoSelectOrEnd:changeNr
+ "select the next change or the last"
+
+ |last|
+
+ last := self numberOfChanges.
+ changeNr < last ifTrue:[
+ self autoSelect:changeNr
+ ] ifFalse:[
+ changeListView setSelection:last .
+ self changeSelection:last.
+ ]
+
+ "Modified: 25.5.1996 / 12:26:17 / cg"
+!
+
+checkClassIsLoaded:aClass
+ |cls|
+
+ aClass isMeta ifTrue:[
+ cls := aClass soleInstance
+ ] ifFalse:[
+ cls := aClass
+ ].
+ cls isLoaded ifFalse:[
+ (self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs)
+ ifTrue:[
+ cls autoload
+ ]
+ ].
+ ^ cls isLoaded
+
+ "Created: 12.12.1995 / 14:04:39 / cg"
+ "Modified: 12.12.1995 / 14:11:05 / cg"
+!
+
+clearCodeView
+ self unselect "changeListView deselect".
+ codeView contents:nil.
+ changeNrShown := nil
+!
+
+contractClass:className selector:selector to:maxLen
+ |s l|
+
+ s := className , ' ', selector.
+ s size > maxLen ifTrue:[
+ l := maxLen - 1 - selector size max:20.
+ s := (className contractTo:l) , ' ' , selector.
+
+ s size > maxLen ifTrue:[
+ l := maxLen - 1 - className size max:20.
+ s := className , ' ', (selector contractTo:l).
+
+ s size > maxLen ifTrue:[
+ s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
+ ]
+ ]
+ ].
+ ^ s
+!
+
+newLabel:how
+ |l|
+
+ (changeFileName ~= 'changes') ifTrue:[
+ l := self class defaultLabel , ': ', changeFileName
+ ] ifFalse:[
+ l := self class defaultLabel
+ ].
+ l := l , ' ' , how.
+ self label:l
+
+ "Created: / 8.9.1995 / 19:32:04 / claus"
+ "Modified: / 8.9.1995 / 19:39:29 / claus"
+ "Modified: / 6.2.1998 / 13:27:01 / cg"
+!
+
+queryCloseText
+ "made this a method for easy redefinition in subclasses"
+
+ ^ 'Quit without updating changeFile ?'
+!
+
+setChangeList
+ "extract type-information from changes and stuff into top selection
+ view"
+
+ changeListView setList:changeHeaderLines expandTabs:false redraw:false.
+ changeListView invalidate.
+
+ "/ changeListView deselect.
+
+ "Modified: / 18.5.1998 / 14:29:10 / cg"
+!
+
+showNotFound
+ |savedCursor|
+
+ savedCursor := cursor.
+ [
+ self cursor:(Cursor cross).
+ self beep.
+ Delay waitForMilliseconds:300.
+ ] valueNowOrOnUnwindDo:[
+ self cursor:savedCursor
+ ]
+
+ "Modified: / 29.4.1999 / 22:36:54 / cg"
+!
+
+unselect
+ "common unselect"
+
+ changeListView setSelection:nil.
+
+ "Modified: 25.5.1996 / 13:02:49 / cg"
+!
+
+withSelectedChangeDo:aBlock
+ "just a helper, check for a selected change and evaluate aBlock
+ with busy cursor"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withExecuteCursorDo:[
+ aBlock value:changeNr
+ ]
+ ]
+
+ "Modified: 14.12.1995 / 20:58:45 / cg"
+! !
+
+!ChangesBrowser methodsFor:'private-change access'!
+
+changeIsFollowupMethodChange:changeNr
+ ^ changeIsFollowupMethodChange at:changeNr
+
+ "Created: / 6.2.1998 / 13:03:39 / cg"
+!
+
+classNameOfChange:changeNr
+ "return the classname of a change
+ (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
+
+ |name|
+
+ name := self fullClassNameOfChange:changeNr.
+ name isNil ifTrue:[^ nil].
+ (name endsWith:' class') ifTrue:[
+ ^ name copyWithoutLast:6
+ ].
+ ^ name
+
+ "Modified: 6.12.1995 / 17:06:31 / cg"
+!
+
+fullClassNameOfChange:changeNr
+ "return the full classname of a change
+ (for classChanges (i.e. xxx class), a string ending in ' class' is returned.
+ - since parsing ascii methods is slow, keep result cached in
+ changeClassNames for the next query"
+
+ |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
+ words changeStream fullParseTree ownerTree ownerName oldDollarSetting|
+
+ changeNr isNil ifTrue:[^ nil].
+
+ "
+ first look, if not already known
+ "
+ name := changeClassNames at:changeNr.
+ name notNil ifTrue:[^ name].
+
+ prevMethodDefNr := changeNr.
+ [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
+ prevMethodDefNr := prevMethodDefNr - 1.
+ ].
+
+ "
+ get the chunk
+ "
+ chunk := changeChunks at:prevMethodDefNr.
+ chunk isNil ifTrue:[^ nil]. "mhmh - empty"
+
+ (chunk startsWith:'''---') ifTrue:[
+ words := chunk asCollectionOfWords.
+ words size > 2 ifTrue:[
+ (words at:2) = 'checkin' ifTrue:[
+ name := words at:3.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ].
+ ].
+
+ "/ fix it - otherwise, it cannot be parsed
+ (chunk endsWith:'primitiveDefinitions:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+ (chunk endsWith:'primitiveFunctions:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+ (chunk endsWith:'primitiveVariables:') ifTrue:[
+ chunk := chunk , ''''''
+ ].
+
+ "
+ use parser to construct a parseTree
+ "
+ oldDollarSetting := Parser allowDollarInIdentifier.
+ [
+ Parser allowDollarInIdentifier:true.
+ aParseTree := Parser parseExpression:chunk.
+
+ aParseTree == #Error ifTrue:[
+ (chunk includesString:'comment') ifTrue:[
+ "/ could be a comment ...
+ aParseTree := Parser parseExpression:chunk , ''''.
+ ]
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Parser allowDollarInIdentifier:oldDollarSetting
+ ].
+
+ (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
+ ^ nil "seems strange ... (could be a comment)"
+ ].
+ aParseTree isMessage ifFalse:[
+ ^ nil "very strange ... (whats that ?)"
+ ].
+
+ "
+ ask parser for selector
+ "
+ sel := aParseTree selector.
+ recTree := aParseTree receiver.
+
+ "
+ is it a method-change, methodRemove or comment-change ?
+ "
+
+ (#(#'methodsFor:'
+ #'privateMethodsFor:'
+ #'protectedMethodsFor:'
+ #'ignoredMethodsFor:'
+ #'publicMethodsFor:'
+ #'removeSelector:'
+ #'comment:'
+ #'primitiveDefinitions:'
+ #'primitiveFunctions:'
+ #'primitiveVariables:'
+ #'renameCategory:to:'
+ #'instanceVariableNames:'
+
+ #'methodsFor:stamp:' "/ Squeak support
+ #'commentStamp:prior:' "/ Squeak support
+ #'addClassVarName:' "/ Squeak support
+ ) includes:sel) ifTrue:[
+ "
+ yes, the className is the receiver
+ "
+ (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
+ isMeta := false.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class methodsFor:..."
+ recTree := recTree receiver.
+ isMeta := true.
+ ].
+ recTree isPrimary ifTrue:[
+ name := recTree name.
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ].
+ "more strange things"
+ ^ nil
+ ].
+
+ "
+ is it a change in a class-description ?
+ "
+ (('subclass:*' match:sel)
+ or:[('variable*subclass:*' match:sel)]) ifTrue:[
+ "/ must parse the full changes text, to get
+ "/ privacy information.
+
+ changeStream := self streamForChange:changeNr.
+ changeStream notNil ifTrue:[
+ chunk := changeStream nextChunk.
+ changeStream close.
+ fullParseTree := Parser parseExpression:chunk.
+ (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
+ fullParseTree := nil
+ ].
+ fullParseTree isMessage ifFalse:[
+ fullParseTree := nil
+ ].
+ "/ actually, the nil case cannot happen
+ fullParseTree notNil ifTrue:[
+ aParseTree := fullParseTree.
+ sel := aParseTree selector.
+ ].
+ ].
+
+ arg1Tree := aParseTree arg1.
+ (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
+ name := arg1Tree value asString.
+
+ "/ is it a private-class ?
+ ('*privateIn:' match:sel) ifTrue:[
+ ownerTree := aParseTree args last.
+ ownerName := ownerTree name asString.
+ name := ownerName , '::' , name
+ ].
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ].
+ "very strange"
+ ^ nil
+ ].
+
+ "
+ is it a class remove ?
+ "
+ (sel == #removeClass:) ifTrue:[
+ (recTree notNil
+ and:[recTree ~~ #Error
+ and:[recTree isPrimary
+ and:[recTree name = 'Smalltalk']]]) ifTrue:[
+ arg1Tree := aParseTree arg1.
+ (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[
+ name := arg1Tree name.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ].
+ ]
+ ].
+
+ "
+ is it a method category change ?
+ "
+ ((sel == #category:)
+ or:[sel == #privacy:]) ifTrue:[
+ (recTree notNil
+ and:[recTree ~~ #Error
+ and:[recTree isMessage
+ and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
+ isMeta := false.
+ recTree := recTree receiver.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class "
+ recTree := recTree receiver
+ ].
+ recTree isPrimary ifTrue:[
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ name := recTree name.
+ changeClassNames at:changeNr put:name.
+ ^ name
+ ]
+ ]
+ ].
+ ^ nil
+
+ "Modified: / 3.8.1998 / 19:58:17 / cg"
+!
+
+numberOfChanges
+ ^ changePositions size
+
+ "Created: 3.12.1995 / 18:15:39 / cg"
+!
+
+selectorOfMethodChange:changeNr
+ "return a method-changes selector, or nil if its not a methodChange"
+
+ |source parser sel chunk aParseTree |
+
+ source := self sourceOfMethodChange:changeNr.
+ source isNil ifTrue:[
+ (self classNameOfChange:changeNr) notNil ifTrue:[
+ chunk := changeChunks at:changeNr.
+ chunk isNil ifTrue:[^ nil]. "mhmh - empty"
+ aParseTree := Parser parseExpression:chunk.
+ (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
+ ^ nil "seems strange ... (could be a comment)"
+ ].
+ aParseTree isMessage ifFalse:[
+ ^ nil "very strange ... (whats that ?)"
+ ].
+ sel := aParseTree selector.
+ (#(
+ #'removeSelector:'
+ ) includes:sel) ifTrue:[
+ sel := aParseTree arguments at:1.
+ sel isConstant ifTrue:[
+ sel := sel evaluate.
+ sel isSymbol ifTrue:[
+ ^ sel
+ ]
+ ]
+ ]
+ ].
+ ^ nil
+ ].
+
+
+ parser := Parser
+ parseMethodArgAndVarSpecification:source
+ in:nil
+ ignoreErrors:true
+ ignoreWarnings:true
+ parseBody:false.
+
+"/ parser := Parser
+"/ parseMethod:source
+"/ in:nil
+"/ ignoreErrors:true
+"/ ignoreWarnings:true.
+
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ sel := parser selector.
+ ].
+ ^ sel
+
+ "Created: 24.11.1995 / 14:30:46 / cg"
+ "Modified: 5.9.1996 / 17:12:50 / cg"
+!
+
+sourceOfMethodChange:changeNr
+ "return a method-changes source code, or nil if its not a methodChange."
+
+ |aStream chunk sawExcla parseTree sourceChunk sel|
+
+ aStream := self streamForChange:changeNr.
+ aStream isNil ifTrue:[^ nil].
+
+ (self changeIsFollowupMethodChange:changeNr) ifFalse:[
+ sawExcla := aStream peekFor:(aStream class chunkSeparator).
+ chunk := aStream nextChunk.
+ ] ifTrue:[
+ chunk := (changeChunks at:changeNr).
+ sawExcla := true.
+ ].
+
+ sawExcla ifTrue:[
+ parseTree := Parser parseExpression:chunk.
+ (parseTree notNil and:[parseTree isMessage]) ifTrue:[
+ sel := parseTree selector.
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+
+ #methodsFor:stamp: "/ Squeak support
+ #commentStamp:prior: "/ Squeak support
+ )
+ includes:sel) ifTrue:[
+ sourceChunk := aStream nextChunk.
+ ]
+ ].
+ ].
+ aStream close.
+ ^ sourceChunk
+
+ "Created: / 5.9.1996 / 17:11:32 / cg"
+ "Modified: / 3.8.1998 / 20:00:21 / cg"
+!
+
+streamForChange:changeNr
+ "answer a stream for change"
+
+ |aStream|
+
+ (changeNr between:1 and:changePositions size) ifFalse:[^ nil].
+ aStream := FileStream readonlyFileNamed:changeFileName.
+ aStream isNil ifTrue:[^ nil].
+ aStream position:(changePositions at:changeNr).
+ ^ aStream
+! !
+
+!ChangesBrowser methodsFor:'private-changeFile access'!
+
+changeFileName:aFileName
+ changeFileName := aFileName
+!
+
+checkIfFileHasChanged
+ |f info |
+
+ Processor removeTimedBlock:checkBlock.
+ f := changeFileName asFilename.
+ (info := f info) isNil ifTrue:[
+ self newLabel:'(unaccessable)'
+ ] ifFalse:[
+ (info modified) > changeFileTimestamp ifTrue:[
+ self newLabel:'(outdated)'.
+ autoUpdate ifTrue:[
+ self doUpdate
+ ]
+ ] ifFalse:[
+ self newLabel:''
+ ]
+ ].
+ Processor addTimedBlock:checkBlock afterSeconds:5.
+
+ "Created: 8.9.1995 / 19:30:19 / claus"
+ "Modified: 8.9.1995 / 19:38:18 / claus"
+ "Modified: 1.11.1996 / 20:22:56 / cg"
+!
+
+readChangesFile
+ "read the changes file, create a list of header-lines (changeChunks)
+ and a list of chunk-positions (changePositions)"
+
+ ^ self readChangesFileInBackground:false
+!
+
+readChangesFileInBackground:inBackground
+ "read the changes file, create a list of header-lines (changeChunks)
+ and a list of chunk-positions (changePositions).
+ Starting with 2.10.3, the entries are multi-col entries;
+ the cols are:
+ 1 delta (only if comparing)
+ '+' -> new method (w.r.t. current state)
+ '-' -> removed method (w.r.t. current state)
+ '?' -> class does not exist currently
+ '=' -> change is same as current methods source
+ 2 class/selector
+ 3 type of change
+ doit
+ method
+ category change
+ 4 timestamp
+
+ since comparing slows down startup time, it is now disabled by
+ default and can be enabled via a toggle."
+
+ |aStream maxLen i f chunkText fullChunkText|
+
+ editingClassSource := false.
+
+ maxLen := 60.
+
+ f := changeFileName asFilename.
+ aStream := f readStream.
+ aStream isNil ifTrue:[^ nil].
+
+ self newLabel:'updating ...'.
+
+ i := f info.
+ changeFileSize := i size.
+ changeFileTimestamp := i modified.
+
+ self withReadCursorDo:[
+ |myProcess myPriority|
+
+ "
+ this is a time consuming operation (especially, if reading an
+ NFS-mounted directory; therefore lower my priority ...
+ "
+ inBackground ifTrue:[
+ myProcess := Processor activeProcess.
+ myPriority := myProcess priority.
+ myProcess priority:(Processor userBackgroundPriority).
+ ].
+
+ [
+ |excla timeStampInfo|
+
+ changeChunks := OrderedCollection new.
+ changeHeaderLines := OrderedCollection new.
+ changePositions := OrderedCollection new.
+ changeTimeStamps := OrderedCollection new.
+ changeIsFollowupMethodChange := OrderedCollection new.
+
+ excla := aStream class chunkSeparator.
+
+ [aStream atEnd] whileFalse:[
+ |entry changeDelta changeString changeType
+ line s l changeClass sawExcla category
+ chunkPos sel|
+
+ "
+ get a chunk (separated by excla)
+ "
+ aStream skipSeparators.
+ chunkPos := aStream position.
+
+
+ sawExcla := aStream peekFor:excla.
+ chunkText := fullChunkText := aStream nextChunk.
+ chunkText notNil ifTrue:[
+ |index headerLine cls|
+
+ (chunkText startsWith:'''---- timestamp ') ifTrue:[
+ timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
+ ] ifFalse:[
+
+ "
+ only first line is saved in changeChunks ...
+ "
+ index := chunkText indexOf:(Character cr).
+ (index ~~ 0) ifTrue:[
+ chunkText := chunkText copyTo:(index - 1).
+
+ "take care for comment changes - must still be a
+ valid expression for classNameOfChange: to work"
+
+ (chunkText endsWith:'comment:''') ifTrue:[
+ chunkText := chunkText , '...'''
+ ].
+ (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
+ sel := 'primitiveDefinitions:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ (chunkText endsWith:'primitiveVariables:''') ifTrue:[
+ sel := 'primitiveVariables:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
+ sel := 'primitiveFunctions:'.
+ chunkText := chunkText copyWithoutLast:1
+ ].
+ ].
+
+ changeChunks add:chunkText.
+ changePositions add:chunkPos.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:false.
+
+ headerLine := nil.
+ changeDelta := ' '.
+
+ sawExcla ifFalse:[
+ (chunkText startsWith:'''---- snap') ifTrue:[
+ changeType := ''.
+ headerLine := chunkText.
+ changeString := (chunkText contractTo:maxLen).
+ timeStampInfo := nil.
+ ] ifFalse:[
+
+ |p cls clsName|
+
+ headerLine := chunkText , ' (doIt)'.
+
+ "
+ first, assume doIt - then lets have a more detailed look ...
+ "
+ ((chunkText startsWith:'''---- file')
+ or:[(chunkText startsWith:'''---- check')]) ifTrue:[
+ changeType := ''.
+ timeStampInfo := nil.
+ ] ifFalse:[
+ changeType := '(doIt)'.
+ ].
+ changeString := (chunkText contractTo:maxLen).
+
+ p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ p isMessage ifTrue:[
+ sel := p selector.
+ ]
+ ] ifFalse:[
+ sel := nil.
+ (Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[
+ "/ a comment only
+ changeType := '(comment)'.
+ ] ifFalse:[
+ changeType := '(???)'.
+ ]
+ ].
+ (sel == #removeSelector:) ifTrue:[
+ p receiver isUnaryMessage ifTrue:[
+ cls := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls) class.
+ cls := cls , ' class'.
+ ] ifFalse:[
+ cls := p receiver name.
+ changeClass := (Smalltalk classNamed:cls)
+ ].
+ sel := (p args at:1) evaluate.
+
+ compareChanges ifTrue:[
+ (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass implements:sel asSymbol) ifTrue:[
+ changeDelta := '-'.
+ ] ifFalse:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ changeType := '(remove)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ (p ~~ #Error
+ and:[p isMessage
+ and:[p receiver isMessage
+ and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
+ p receiver receiver isUnaryMessage ifTrue:[
+ cls := p receiver receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls) class.
+ cls := cls , ' class'.
+ ] ifFalse:[
+ cls := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:cls)
+ ].
+ (sel == #category:) ifTrue:[
+ sel := (p receiver args at:1) evaluate.
+ changeType := '(category change)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ (sel == #privacy:) ifTrue:[
+ sel := (p receiver args at:1) evaluate.
+ changeType := '(privacy change)'.
+ changeString := self contractClass:cls selector:sel to:maxLen.
+ ].
+ ].
+ (#(#'subclass:'
+ #'variableSubclass:'
+ #'variableByteSubclass:'
+ #'variableWordSubclass:'
+ #'variableLongSubclass:'
+ #'variableFloatSubclass:'
+ #'variableDoubleSubclass:'
+ #'primitiveDefinitions:'
+ #'primitiveFunctions:'
+ #'primitiveVariables:'
+ ) includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ clsName := (p args at:1) evaluate.
+ cls := Smalltalk at:clsName ifAbsent:nil.
+ cls isNil ifTrue:[
+ changeDelta := '+'.
+ ]
+ ].
+ ]
+ ] ifTrue:[ "sawExcla"
+ |done first p className cls text methodPos
+ singleJunkOnly methodChunks singleInfo|
+
+ singleJunkOnly := false.
+ methodChunks := false.
+ singleInfo := false.
+
+ "
+ method definitions actually consist of
+ two (or more) chunks; skip next chunk(s)
+ up to an empty one.
+ The system only writes one chunk,
+ and we cannot handle more in this ChangesBrowser ....
+ "
+ className := nil.
+ p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
+
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ sel := p selector.
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ #'commentStamp:prior:'
+ )
+ includes:sel) ifTrue:[
+ methodChunks := true.
+ p receiver isUnaryMessage ifTrue:[
+ className := p receiver receiver name.
+ changeClass := (Smalltalk classNamed:className) class.
+ className := className , ' class'.
+ ] ifFalse:[
+ className := p receiver name.
+ changeClass := Smalltalk classNamed:className
+ ].
+ category := (p args at:1) evaluate.
+
+ sel == #'methodsFor:stamp:' ifTrue:[
+ "/ Squeak timeStamp
+ timeStampInfo := (p args at:2) evaluate.
+ singleInfo := true
+ ] ifFalse:[
+ sel == #'commentStamp:prior:' ifTrue:[
+ singleJunkOnly := true.
+ methodChunks := false.
+ ].
+ ]
+ ].
+ ].
+
+ done := false.
+ first := true.
+ [done] whileFalse:[
+ changeDelta := ' '.
+ methodPos := aStream position.
+
+ text := aStream nextChunk.
+ text isNil ifTrue:[
+ done := true
+ ] ifFalse:[
+ done := text isEmpty
+ ].
+ done ifFalse:[
+ first ifFalse:[
+ changeChunks add:chunkText.
+ changePositions add:methodPos.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:true.
+ editingClassSource := true.
+ ].
+
+ first := false.
+ "
+ try to find the selector
+ "
+ sel := nil.
+ className notNil ifTrue:[
+ methodChunks ifTrue:[
+ p := Parser
+ parseMethodSpecification:text
+ in:nil
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ sel := p selector.
+ ]
+ ]
+ ].
+
+ sel isNil ifTrue:[
+ changeString := (chunkText contractTo:maxLen).
+ changeType := '(change)'.
+ headerLine := chunkText , ' (change)'.
+ ] ifFalse:[
+ changeString := self contractClass:className selector:sel to:maxLen.
+ changeType := '(method in: ''' , category , ''')'.
+ headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
+ ].
+
+ compareChanges ifTrue:[
+ changeClass isNil ifFalse:[
+ changeClass isMeta ifTrue:[
+ cls := changeClass soleInstance
+ ] ifFalse:[
+ cls := changeClass
+ ].
+ ].
+
+ (changeClass isNil or:[cls isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass implements:sel asSymbol) ifFalse:[
+ changeDelta := '+'.
+ ] ifTrue:[
+ |m currentText t1 t2|
+
+ m := changeClass compiledMethodAt:sel asSymbol.
+ currentText := m source.
+ currentText notNil ifTrue:[
+ text asString = currentText asString ifTrue:[
+ changeDelta := '='
+ ] ifFalse:[
+ t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t1 = t2 ifTrue:[
+ changeDelta := '='
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ entry := MultiColListEntry new.
+ entry tabulatorSpecification:tabSpec.
+ entry colAt:1 put:changeDelta.
+ entry colAt:2 put:changeString.
+ entry colAt:3 put:changeType.
+ timeStampInfo notNil ifTrue:[
+ entry colAt:4 put:timeStampInfo.
+ ].
+ changeHeaderLines add:entry
+ ].
+ changeString := nil.
+ headerLine := nil.
+ singleJunkOnly ifTrue:[done := true]
+ ].
+ singleInfo ifTrue:[
+ timeStampInfo := nil
+ ].
+ ].
+ changeString notNil ifTrue:[
+ entry := MultiColListEntry new.
+ entry tabulatorSpecification:tabSpec.
+ entry colAt:1 put:changeDelta.
+ entry colAt:2 put:changeString.
+ entry colAt:3 put:changeType.
+ timeStampInfo notNil ifTrue:[
+ entry colAt:4 put:timeStampInfo.
+ ].
+ changeHeaderLines add:entry
+ ] ifFalse:[
+ headerLine notNil ifTrue:[
+ changeHeaderLines add:headerLine
+ ]
+ ]
+ ]
+ ]
+ ].
+ changeClassNames := OrderedCollection new grow:(changeChunks size).
+ anyChanges := false
+ ] valueNowOrOnUnwindDo:[
+ aStream close.
+ inBackground ifTrue:[myProcess priority:myPriority].
+ ].
+ ].
+
+ self checkIfFileHasChanged
+
+ "Modified: / 27.8.1995 / 23:06:55 / claus"
+ "Modified: / 17.7.1998 / 11:10:07 / cg"
+!
+
+writeBackChanges
+ "write back the changes file. To avoid problems when the disk is full
+ or a crash occurs while writing (well, or someone kills us),
+ first write the stuff to a new temporary file. If this works ok,
+ rename the old change-file to a .bak file and finally rename the
+ tempfile back to the change-file.
+ That way, if anything happens, either the original file is left unchanged,
+ or we have at least a backup of the previous change file."
+
+ |inStream outStream tempfile stamp f|
+
+ editingClassSource ifTrue:[
+ (self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
+ ifFalse:[
+ ^ false
+ ]
+ ].
+
+ tempfile := Filename newTemporaryIn:nil.
+ tempfile exists ifTrue:[tempfile remove].
+
+ outStream := tempfile writeStream.
+ outStream isNil ifTrue:[
+ self warn:'cannot create temporary file in current directory.'.
+ ^ false
+ ].
+
+ inStream := FileStream readonlyFileNamed:changeFileName.
+ inStream isNil ifTrue:[^ false].
+
+ self withCursor:(Cursor write) do:[
+ |excla sawExcla done first chunk
+ nChanges "{Class:SmallInteger}" |
+
+ Stream writeErrorSignal handle:[:ex |
+ self warn:('could not update the changes file.\\' , ex errorString) withCRs.
+ tempfile exists ifTrue:[tempfile remove].
+ ^ false
+ ] do:[
+
+ excla := inStream class chunkSeparator.
+ nChanges := self numberOfChanges.
+
+ 1 to:nChanges do:[:index |
+ inStream position:(changePositions at:index).
+ sawExcla := inStream peekFor:excla.
+ chunk := inStream nextChunk.
+
+ (chunk notNil
+ and:[(chunk startsWith:'''---- snap') not]) ifTrue:[
+ (stamp := changeTimeStamps at:index) notNil ifTrue:[
+ outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
+ outStream nextPut:excla; cr.
+ ].
+ ].
+
+ sawExcla ifTrue:[
+ outStream nextPut:excla.
+ outStream nextChunkPut:chunk.
+ outStream cr; cr.
+ "
+ a method-definition chunk - output followups
+ "
+ done := false.
+ first := true.
+ [done] whileFalse:[
+ chunk := inStream nextChunk.
+ chunk isNil ifTrue:[
+ outStream cr; cr.
+ done := true
+ ] ifFalse:[
+ chunk isEmpty ifTrue:[
+ outStream space; nextChunkPut:chunk; cr; cr.
+ done := true.
+ ] ifFalse:[
+ first ifFalse:[
+ outStream cr; cr.
+ ].
+ outStream nextChunkPut:chunk.
+ ].
+ ].
+ first := false.
+ ].
+ ] ifFalse:[
+ outStream nextChunkPut:chunk.
+ outStream cr
+ ]
+ ].
+ outStream close.
+ inStream close.
+ ].
+
+ f := changeFileName asFilename.
+ f renameTo:(f withSuffix:'bak').
+ tempfile renameTo:changeFileName.
+ anyChanges := false
+ ].
+ ^ true
+
+ "Modified: / 2.12.1996 / 22:29:15 / stefan"
+ "Modified: / 21.4.1998 / 17:50:11 / cg"
+! !
+
+!ChangesBrowser methodsFor:'private-user interaction ops'!
+
appendChange:changeNr toFile:fileName
"append change to a file. return true if ok."
@@ -661,120 +1728,6 @@
"Modified: / 7.2.1998 / 19:56:34 / cg"
!
-autoSelect:changeNr
- "select a change"
-
- self class autoSelectNext ifTrue:[
- (changeNr <= self numberOfChanges) ifTrue:[
- changeListView setSelection:changeNr.
- self changeSelection:changeNr.
- ^ self
- ]
- ].
- self clearCodeView.
- changeListView setSelection:nil.
-
- "Modified: / 18.5.1998 / 14:26:43 / cg"
-!
-
-autoSelectLast
- "select the last change"
-
- self autoSelect:(self numberOfChanges)
-!
-
-autoSelectOrEnd:changeNr
- "select the next change or the last"
-
- |last|
-
- last := self numberOfChanges.
- changeNr < last ifTrue:[
- self autoSelect:changeNr
- ] ifFalse:[
- changeListView setSelection:last .
- self changeSelection:last.
- ]
-
- "Modified: 25.5.1996 / 12:26:17 / cg"
-!
-
-changeFileName:aFileName
- changeFileName := aFileName
-!
-
-changeIsFollowupMethodChange:changeNr
- ^ changeIsFollowupMethodChange at:changeNr
-
- "Created: / 6.2.1998 / 13:03:39 / cg"
-!
-
-checkClassIsLoaded:aClass
- |cls|
-
- aClass isMeta ifTrue:[
- cls := aClass soleInstance
- ] ifFalse:[
- cls := aClass
- ].
- cls isLoaded ifFalse:[
- (self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs)
- ifTrue:[
- cls autoload
- ]
- ].
- ^ cls isLoaded
-
- "Created: 12.12.1995 / 14:04:39 / cg"
- "Modified: 12.12.1995 / 14:11:05 / cg"
-!
-
-checkIfFileHasChanged
- |f info |
-
- Processor removeTimedBlock:checkBlock.
- f := changeFileName asFilename.
- (info := f info) isNil ifTrue:[
- self newLabel:'(unaccessable)'
- ] ifFalse:[
- (info modified) > changeFileTimestamp ifTrue:[
- self newLabel:'(outdated)'.
- autoUpdate ifTrue:[
- self doUpdate
- ]
- ] ifFalse:[
- self newLabel:''
- ]
- ].
- Processor addTimedBlock:checkBlock afterSeconds:5.
-
- "Created: 8.9.1995 / 19:30:19 / claus"
- "Modified: 8.9.1995 / 19:38:18 / claus"
- "Modified: 1.11.1996 / 20:22:56 / cg"
-!
-
-classNameOfChange:changeNr
- "return the classname of a change
- (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
-
- |name|
-
- name := self fullClassNameOfChange:changeNr.
- name isNil ifTrue:[^ nil].
- (name endsWith:' class') ifTrue:[
- ^ name copyWithoutLast:6
- ].
- ^ name
-
- "Modified: 6.12.1995 / 17:06:31 / cg"
-!
-
-clearCodeView
- self unselect "changeListView deselect".
- codeView contents:nil.
- changeNrShown := nil
-!
-
compareChange:changeNr
"compare a change with current version"
@@ -859,7 +1812,17 @@
(parseTree notNil
and:[parseTree ~~ #Error
and:[parseTree isMessage]]) ifTrue:[
- (parseTree selector == #methodsFor:) ifTrue:[
+ "/ Squeak support (#methodsFor:***)
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+
+ #methodsFor:stamp: "/ Squeak support
+ )
+ includes:parseTree selector) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
@@ -969,160 +1932,168 @@
aStream isNil ifTrue:[^ self].
aClassNameOrNil isNil ifTrue:[
- self newLabel:'compressing ...'.
+ self newLabel:'compressing ...'.
] ifFalse:[
- self newLabel:'compressing for ' , aClassNameOrNil.
+ self newLabel:'compressing for ' , aClassNameOrNil.
].
CompressSnapshotInfo == true ifTrue:[
- "
- get a prototype snapshot record (to be independent of
- the actual format ..
- "
- str := WriteStream on:String new.
- Class addChangeRecordForSnapshot:'foo' to:str.
- snapshotProto := str contents.
- snapshotPrefix := snapshotProto copyTo:10.
- snapshotNameIndex := snapshotProto findString:'foo'.
+ "
+ get a prototype snapshot record (to be independent of
+ the actual format ..
+ "
+ str := WriteStream on:String new.
+ Class addChangeRecordForSnapshot:'foo' to:str.
+ snapshotProto := str contents.
+ snapshotPrefix := snapshotProto copyTo:10.
+ snapshotNameIndex := snapshotProto findString:'foo'.
].
self withExecuteCursorDo:[
- |numChanges classes selectors types excla sawExcla
- changeNr chunk aParseTree parseTreeChunk
- thisClass thisSelector codeChunk codeParser
- compressThis|
-
- numChanges := self numberOfChanges.
- classes := Array new:numChanges.
- selectors := Array new:numChanges.
- types := Array new:numChanges.
-
- "starting at the end, get the change class and change selector;
- collect all in classes / selectors"
-
- changeNr := numChanges.
- excla := aStream class chunkSeparator.
-
- [changeNr >= 1] whileTrue:[
- aStream position:(changePositions at:changeNr).
- sawExcla := aStream peekFor:excla.
- chunk := aStream nextChunk.
- sawExcla ifTrue:[
- "optimize a bit if multiple methods for same category arrive"
- (chunk = parseTreeChunk) ifFalse:[
- aParseTree := Parser parseExpression:chunk.
- parseTreeChunk := chunk
- ].
- (aParseTree notNil
- and:[(aParseTree ~~ #Error)
- and:[aParseTree isMessage]]) ifTrue:[
- (aParseTree selector == #methodsFor:) ifTrue:[
- thisClass := (aParseTree receiver evaluate).
- codeChunk := aStream nextChunk.
- codeParser := Parser
- parseMethodSpecification:codeChunk
- in:thisClass
- ignoreErrors:true
- ignoreWarnings:true.
- (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[
- selectors at:changeNr put:(codeParser selector).
- classes at:changeNr put:thisClass.
- types at:changeNr put:#methodsFor
- ]
- ]
- ]
- ] ifFalse:[
- aParseTree := Parser parseExpression:chunk.
- parseTreeChunk := chunk.
- (aParseTree notNil
- and:[(aParseTree ~~ #Error)
- and:[aParseTree isMessage]]) ifTrue:[
- (aParseTree selector == #removeSelector:) ifTrue:[
- selectors at:changeNr put:(aParseTree arg1 value ).
- classes at:changeNr put:(aParseTree receiver evaluate).
- types at:changeNr put:#removeSelector
- ]
- ] ifFalse:[
- CompressSnapshotInfo == true ifTrue:[
- (chunk startsWith:snapshotPrefix) ifTrue:[
- str := chunk readStream position:snapshotNameIndex.
- fileName := str upTo:(Character space).
- "
- kludge to allow use of match-check below
- "
- selectors at:changeNr put:snapshotPrefix.
- classes at:changeNr put:fileName.
- ]
- ]
- ]
- ].
- changeNr := changeNr - 1
- ].
- aStream close.
-
- "for all changes, look for another class/selector occurence later
- in the list and, if there is one, add change number to the delete set"
-
- deleteSet := OrderedCollection new.
- changeNr := 1.
- [changeNr < self numberOfChanges] whileTrue:[
- thisClass := classes at:changeNr.
-
- compressThis := false.
- aClassNameOrNil isNil ifTrue:[
- compressThis := true
- ] ifFalse:[
- "/ skipping unloaded/unknown classes
- thisClass isBehavior ifTrue:[
- thisClass isMeta ifTrue:[
- compressThis := aClassNameOrNil = thisClass soleInstance name.
- ] ifFalse:[
- compressThis := aClassNameOrNil = thisClass name
- ]
- ]
- ].
-
- compressThis ifTrue:[
- thisSelector := selectors at:changeNr.
- searchIndex := changeNr.
- anyMore := true.
- [anyMore] whileTrue:[
- searchIndex := classes indexOf:thisClass
- startingAt:(searchIndex + 1).
- (searchIndex ~~ 0) ifTrue:[
- ((selectors at:searchIndex) == thisSelector) ifTrue:[
- thisClass notNil ifTrue:[
- deleteSet add:changeNr.
- anyMore := false
- ]
- ]
- ] ifFalse:[
- anyMore := false
- ]
- ].
- ].
-
- changeNr := changeNr + 1
- ].
-
- "finally delete what has been found"
-
- (deleteSet size > 0) ifTrue:[
- changeListView setSelection:nil.
- index := deleteSet size.
- [index > 0] whileTrue:[
- self silentDeleteChange:(deleteSet at:index).
- index := index - 1
- ].
- self setChangeList.
- "
- scroll back a bit, if we are left way behind the list
- "
- changeListView firstLineShown > self numberOfChanges ifTrue:[
- changeListView makeLineVisible:self numberOfChanges
- ].
- self clearCodeView
- ]
+ |numChanges classes selectors types excla sawExcla
+ changeNr chunk aParseTree parseTreeChunk
+ thisClass thisSelector codeChunk codeParser
+ compressThis|
+
+ numChanges := self numberOfChanges.
+ classes := Array new:numChanges.
+ selectors := Array new:numChanges.
+ types := Array new:numChanges.
+
+ "starting at the end, get the change class and change selector;
+ collect all in classes / selectors"
+
+ changeNr := numChanges.
+ excla := aStream class chunkSeparator.
+
+ [changeNr >= 1] whileTrue:[
+ aStream position:(changePositions at:changeNr).
+ sawExcla := aStream peekFor:excla.
+ chunk := aStream nextChunk.
+ sawExcla ifTrue:[
+ "optimize a bit if multiple methods for same category arrive"
+ (chunk = parseTreeChunk) ifFalse:[
+ aParseTree := Parser parseExpression:chunk.
+ parseTreeChunk := chunk
+ ].
+ (aParseTree notNil
+ and:[(aParseTree ~~ #Error)
+ and:[aParseTree isMessage]]) ifTrue:[
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ )
+ includes:aParseTree selector) ifTrue:[
+ thisClass := (aParseTree receiver evaluate).
+ codeChunk := aStream nextChunk.
+ codeParser := Parser
+ parseMethodSpecification:codeChunk
+ in:thisClass
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[
+ selectors at:changeNr put:(codeParser selector).
+ classes at:changeNr put:thisClass.
+ types at:changeNr put:#methodsFor
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ aParseTree := Parser parseExpression:chunk.
+ parseTreeChunk := chunk.
+ (aParseTree notNil
+ and:[(aParseTree ~~ #Error)
+ and:[aParseTree isMessage]]) ifTrue:[
+ (aParseTree selector == #removeSelector:) ifTrue:[
+ selectors at:changeNr put:(aParseTree arg1 value ).
+ classes at:changeNr put:(aParseTree receiver evaluate).
+ types at:changeNr put:#removeSelector
+ ]
+ ] ifFalse:[
+ CompressSnapshotInfo == true ifTrue:[
+ (chunk startsWith:snapshotPrefix) ifTrue:[
+ str := chunk readStream position:snapshotNameIndex.
+ fileName := str upTo:(Character space).
+ "
+ kludge to allow use of match-check below
+ "
+ selectors at:changeNr put:snapshotPrefix.
+ classes at:changeNr put:fileName.
+ ]
+ ]
+ ]
+ ].
+ changeNr := changeNr - 1
+ ].
+ aStream close.
+
+ "for all changes, look for another class/selector occurence later
+ in the list and, if there is one, add change number to the delete set"
+
+ deleteSet := OrderedCollection new.
+ changeNr := 1.
+ [changeNr < self numberOfChanges] whileTrue:[
+ thisClass := classes at:changeNr.
+
+ compressThis := false.
+ aClassNameOrNil isNil ifTrue:[
+ compressThis := true
+ ] ifFalse:[
+ "/ skipping unloaded/unknown classes
+ thisClass isBehavior ifTrue:[
+ thisClass isMeta ifTrue:[
+ compressThis := aClassNameOrNil = thisClass soleInstance name.
+ ] ifFalse:[
+ compressThis := aClassNameOrNil = thisClass name
+ ]
+ ]
+ ].
+
+ compressThis ifTrue:[
+ thisSelector := selectors at:changeNr.
+ searchIndex := changeNr.
+ anyMore := true.
+ [anyMore] whileTrue:[
+ searchIndex := classes indexOf:thisClass
+ startingAt:(searchIndex + 1).
+ (searchIndex ~~ 0) ifTrue:[
+ ((selectors at:searchIndex) == thisSelector) ifTrue:[
+ thisClass notNil ifTrue:[
+ deleteSet add:changeNr.
+ anyMore := false
+ ]
+ ]
+ ] ifFalse:[
+ anyMore := false
+ ]
+ ].
+ ].
+
+ changeNr := changeNr + 1
+ ].
+
+ "finally delete what has been found"
+
+ (deleteSet size > 0) ifTrue:[
+ changeListView setSelection:nil.
+ index := deleteSet size.
+ [index > 0] whileTrue:[
+ self silentDeleteChange:(deleteSet at:index).
+ index := index - 1
+ ].
+ self setChangeList.
+ "
+ scroll back a bit, if we are left way behind the list
+ "
+ changeListView firstLineShown > self numberOfChanges ifTrue:[
+ changeListView makeLineVisible:self numberOfChanges
+ ].
+ self clearCodeView
+ ]
].
self newLabel:''.
@@ -1130,26 +2101,6 @@
"Modified: / 29.10.1997 / 01:26:59 / cg"
!
-contractClass:className selector:selector to:maxLen
- |s l|
-
- s := className , ' ', selector.
- s size > maxLen ifTrue:[
- l := maxLen - 1 - selector size max:20.
- s := (className contractTo:l) , ' ' , selector.
-
- s size > maxLen ifTrue:[
- l := maxLen - 1 - className size max:20.
- s := className , ' ', (selector contractTo:l).
-
- s size > maxLen ifTrue:[
- s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
- ]
- ]
- ].
- ^ s
-!
-
deleteChange:changeNr
"delete a change"
@@ -1173,218 +2124,6 @@
"Modified: / 18.5.1998 / 14:22:27 / cg"
!
-fullClassNameOfChange:changeNr
- "return the full classname of a change
- (for classChanges (i.e. xxx class), a string ending in ' class' is returned.
- - since parsing ascii methods is slow, keep result cached in
- changeClassNames for the next query"
-
- |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
- words changeStream fullParseTree ownerTree ownerName oldDollarSetting|
-
- changeNr isNil ifTrue:[^ nil].
-
- "
- first look, if not already known
- "
- name := changeClassNames at:changeNr.
- name notNil ifTrue:[^ name].
-
- prevMethodDefNr := changeNr.
- [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
- prevMethodDefNr := prevMethodDefNr - 1.
- ].
-
- "
- get the chunk
- "
- chunk := changeChunks at:prevMethodDefNr.
- chunk isNil ifTrue:[^ nil]. "mhmh - empty"
-
- (chunk startsWith:'''---') ifTrue:[
- words := chunk asCollectionOfWords.
- words size > 2 ifTrue:[
- (words at:2) = 'checkin' ifTrue:[
- name := words at:3.
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ].
- ].
-
- "/ fix it - otherwise, it cannot be parsed
- (chunk endsWith:'primitiveDefinitions:') ifTrue:[
- chunk := chunk , ''''''
- ].
- (chunk endsWith:'primitiveFunctions:') ifTrue:[
- chunk := chunk , ''''''
- ].
- (chunk endsWith:'primitiveVariables:') ifTrue:[
- chunk := chunk , ''''''
- ].
-
- "
- use parser to construct a parseTree
- "
- oldDollarSetting := Parser allowDollarInIdentifier.
- [
- Parser allowDollarInIdentifier:true.
- aParseTree := Parser parseExpression:chunk.
-
- aParseTree == #Error ifTrue:[
- (chunk includesString:'comment') ifTrue:[
- "/ could be a comment ...
- aParseTree := Parser parseExpression:chunk , ''''.
- ]
- ].
- ] valueNowOrOnUnwindDo:[
- Parser allowDollarInIdentifier:oldDollarSetting
- ].
-
- (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
- ^ nil "seems strange ... (could be a comment)"
- ].
- aParseTree isMessage ifFalse:[
- ^ nil "very strange ... (whats that ?)"
- ].
-
- "
- ask parser for selector
- "
- sel := aParseTree selector.
- recTree := aParseTree receiver.
-
- "
- is it a method-change, methodRemove or comment-change ?
- "
- (#(#'methodsFor:'
- #'privateMethodsFor:'
- #'protectedMethodsFor:'
- #'ignoredMethodsFor:'
- #'publicMethodsFor:'
- #'removeSelector:'
- #'comment:'
- #'primitiveDefinitions:'
- #'primitiveFunctions:'
- #'primitiveVariables:'
- #'renameCategory:to:'
- #'instanceVariableNames:'
- ) includes:sel) ifTrue:[
- "
- yes, the className is the receiver
- "
- (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
- isMeta := false.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class methodsFor:..."
- recTree := recTree receiver.
- isMeta := true.
- ].
- recTree isPrimary ifTrue:[
- name := recTree name.
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ].
- "more strange things"
- ^ nil
- ].
-
- "
- is it a change in a class-description ?
- "
- (('subclass:*' match:sel)
- or:[('variable*subclass:*' match:sel)]) ifTrue:[
- "/ must parse the full changes text, to get
- "/ privacy information.
-
- changeStream := self streamForChange:changeNr.
- changeStream notNil ifTrue:[
- chunk := changeStream nextChunk.
- changeStream close.
- fullParseTree := Parser parseExpression:chunk.
- (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
- fullParseTree := nil
- ].
- fullParseTree isMessage ifFalse:[
- fullParseTree := nil
- ].
- "/ actually, the nil case cannot happen
- fullParseTree notNil ifTrue:[
- aParseTree := fullParseTree.
- sel := aParseTree selector.
- ].
- ].
-
- arg1Tree := aParseTree arg1.
- (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
- name := arg1Tree value asString.
-
- "/ is it a private-class ?
- ('*privateIn:' match:sel) ifTrue:[
- ownerTree := aParseTree args last.
- ownerName := ownerTree name asString.
- name := ownerName , '::' , name
- ].
- changeClassNames at:changeNr put:name.
- ^ name
- ].
- "very strange"
- ^ nil
- ].
-
- "
- is it a class remove ?
- "
- (sel == #removeClass:) ifTrue:[
- (recTree notNil
- and:[recTree ~~ #Error
- and:[recTree isPrimary
- and:[recTree name = 'Smalltalk']]]) ifTrue:[
- arg1Tree := aParseTree arg1.
- (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[
- name := arg1Tree name.
- changeClassNames at:changeNr put:name.
- ^ name
- ].
- ]
- ].
-
- "
- is it a method category change ?
- "
- ((sel == #category:)
- or:[sel == #privacy:]) ifTrue:[
- (recTree notNil
- and:[recTree ~~ #Error
- and:[recTree isMessage
- and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
- isMeta := false.
- recTree := recTree receiver.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class "
- recTree := recTree receiver
- ].
- recTree isPrimary ifTrue:[
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- name := recTree name.
- changeClassNames at:changeNr put:name.
- ^ name
- ]
- ]
- ].
- ^ nil
-
- "Modified: / 3.8.1998 / 19:58:17 / cg"
-!
-
makeChangeAPatch:changeNr
"append change to patchfile"
@@ -1397,494 +2136,6 @@
self notify:'this is not yet implemented'
!
-newLabel:how
- |l|
-
- (changeFileName ~= 'changes') ifTrue:[
- l := self class defaultLabel , ': ', changeFileName
- ] ifFalse:[
- l := self class defaultLabel
- ].
- l := l , ' ' , how.
- self label:l
-
- "Created: / 8.9.1995 / 19:32:04 / claus"
- "Modified: / 8.9.1995 / 19:39:29 / claus"
- "Modified: / 6.2.1998 / 13:27:01 / cg"
-!
-
-numberOfChanges
- ^ changePositions size
-
- "Created: 3.12.1995 / 18:15:39 / cg"
-!
-
-queryCloseText
- "made this a method for easy redefinition in subclasses"
-
- ^ 'Quit without updating changeFile ?'
-!
-
-readChangesFile
- "read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions)"
-
- ^ self readChangesFileInBackground:false
-!
-
-readChangesFileInBackground:inBackground
- "read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions).
- Starting with 2.10.3, the entries are multi-col entries;
- the cols are:
- 1 delta (only if comparing)
- '+' -> new method (w.r.t. current state)
- '-' -> removed method (w.r.t. current state)
- '?' -> class does not exist currently
- '=' -> change is same as current methods source
- 2 class/selector
- 3 type of change
- doit
- method
- category change
- 4 timestamp
-
- since comparing slows down startup time, it is now disabled by
- default and can be enabled via a toggle."
-
- |aStream maxLen i f|
-
- editingClassSource := false.
-
- maxLen := 60.
-
- f := changeFileName asFilename.
- aStream := f readStream.
- aStream isNil ifTrue:[^ nil].
-
- self newLabel:'updating ...'.
-
- i := f info.
- changeFileSize := i size.
- changeFileTimestamp := i modified.
-
- self withReadCursorDo:[
- |myProcess myPriority|
-
- "
- this is a time consuming operation (especially, if reading an
- NFS-mounted directory; therefore lower my priority ...
- "
- inBackground ifTrue:[
- myProcess := Processor activeProcess.
- myPriority := myProcess priority.
- myProcess priority:(Processor userBackgroundPriority).
- ].
-
- [
- |excla timeStampInfo|
-
- changeChunks := OrderedCollection new.
- changeHeaderLines := OrderedCollection new.
- changePositions := OrderedCollection new.
- changeTimeStamps := OrderedCollection new.
- changeIsFollowupMethodChange := OrderedCollection new.
-
- excla := aStream class chunkSeparator.
-
- [aStream atEnd] whileFalse:[
- |entry changeDelta changeString changeType
- line s l changeClass sawExcla category
- chunkText chunkPos sel|
-
- "
- get a chunk (separated by excla)
- "
- aStream skipSeparators.
- chunkPos := aStream position.
-
-
- sawExcla := aStream peekFor:excla.
- chunkText := aStream nextChunk.
- chunkText notNil ifTrue:[
- |index headerLine cls|
-
- (chunkText startsWith:'''---- timestamp ') ifTrue:[
- timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
- ] ifFalse:[
-
- "
- only first line is saved in changeChunks ...
- "
- index := chunkText indexOf:(Character cr).
- (index ~~ 0) ifTrue:[
- chunkText := chunkText copyTo:(index - 1).
-
- "take care for comment changes - must still be a
- valid expression for classNameOfChange: to work"
-
- (chunkText endsWith:'comment:''') ifTrue:[
- chunkText := chunkText , '...'''
- ].
- (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
- sel := 'primitiveDefinitions:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- (chunkText endsWith:'primitiveVariables:''') ifTrue:[
- sel := 'primitiveVariables:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
- sel := 'primitiveFunctions:'.
- chunkText := chunkText copyWithoutLast:1
- ].
- ].
-
- changeChunks add:chunkText.
- changePositions add:chunkPos.
- changeTimeStamps add:timeStampInfo.
- changeIsFollowupMethodChange add:false.
-
- headerLine := nil.
- changeDelta := ' '.
-
- sawExcla ifFalse:[
- (chunkText startsWith:'''---- snap') ifTrue:[
- changeType := ''.
- headerLine := chunkText.
- changeString := (chunkText contractTo:maxLen).
- timeStampInfo := nil.
- ] ifFalse:[
-
- |p cls clsName|
-
- headerLine := chunkText , ' (doIt)'.
-
- "
- first, assume doIt - then lets have a more detailed look ...
- "
- ((chunkText startsWith:'''---- file')
- or:[(chunkText startsWith:'''---- check')]) ifTrue:[
- changeType := ''.
- timeStampInfo := nil.
- ] ifFalse:[
- changeType := '(doIt)'.
- ].
- changeString := (chunkText contractTo:maxLen).
-
- p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
- (p notNil
- and:[p ~~ #Error
- and:[p isMessage]]) ifTrue:[
- sel := p selector.
- ] ifFalse:[
- sel := nil.
- ].
- (sel == #removeSelector:) ifTrue:[
- p receiver isUnaryMessage ifTrue:[
- cls := p receiver receiver name.
- changeClass := (Smalltalk classNamed:cls) class.
- cls := cls , ' class'.
- ] ifFalse:[
- cls := p receiver name.
- changeClass := (Smalltalk classNamed:cls)
- ].
- sel := (p args at:1) evaluate.
-
- compareChanges ifTrue:[
- (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass implements:sel asSymbol) ifTrue:[
- changeDelta := '-'.
- ] ifFalse:[
- changeDelta := '='.
- ]
- ]
- ].
- changeType := '(remove)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- (p ~~ #Error
- and:[p isMessage
- and:[p receiver isMessage
- and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
- p receiver receiver isUnaryMessage ifTrue:[
- cls := p receiver receiver receiver name.
- changeClass := (Smalltalk classNamed:cls) class.
- cls := cls , ' class'.
- ] ifFalse:[
- cls := p receiver receiver name.
- changeClass := (Smalltalk classNamed:cls)
- ].
- (sel == #category:) ifTrue:[
- sel := (p receiver args at:1) evaluate.
- changeType := '(category change)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- (sel == #privacy:) ifTrue:[
- sel := (p receiver args at:1) evaluate.
- changeType := '(privacy change)'.
- changeString := self contractClass:cls selector:sel to:maxLen.
- ].
- ].
- (#(#'subclass:'
- #'variableSubclass:'
- #'variableByteSubclass:'
- #'variableWordSubclass:'
- #'variableLongSubclass:'
- #'variableFloatSubclass:'
- #'variableDoubleSubclass:'
- #'primitiveDefinitions:'
- #'primitiveFunctions:'
- #'primitiveVariables:'
- ) includes:sel) ifTrue:[
- changeType := '(class definition)'.
- clsName := (p args at:1) evaluate.
- cls := Smalltalk at:clsName ifAbsent:nil.
- cls isNil ifTrue:[
- changeDelta := '+'.
- ]
- ].
- ]
- ] ifTrue:[ "sawExcla"
- |done first p className cls text methodPos|
-
- "
- method definitions actually consist of
- two (or more) chunks; skip next chunk(s)
- up to an empty one.
- The system only writes one chunk,
- and we cannot handle more in this ChangesBrowser ....
- "
- className := nil.
- p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
-
- (p notNil and:[p ~~ #Error]) ifTrue:[
- sel := p selector.
- (sel == #methodsFor:) ifTrue:[
- p receiver isUnaryMessage ifTrue:[
- className := p receiver receiver name.
- changeClass := (Smalltalk classNamed:className) class.
- className := className , ' class'.
- ] ifFalse:[
- className := p receiver name.
- changeClass := Smalltalk classNamed:className
- ].
- category := (p args at:1) evaluate.
- ].
- ].
-
- done := false.
- first := true.
- [done] whileFalse:[
- changeDelta := ' '.
- methodPos := aStream position.
-
- text := aStream nextChunk.
- text isNil ifTrue:[
- done := true
- ] ifFalse:[
- done := text isEmpty
- ].
- done ifFalse:[
- first ifFalse:[
- changeChunks add:chunkText.
- changePositions add:methodPos.
- changeTimeStamps add:timeStampInfo.
- changeIsFollowupMethodChange add:true.
- editingClassSource := true.
- ].
-
- first := false.
- "
- try to find the selector
- "
- sel := nil.
- className notNil ifTrue:[
- p := Parser
- parseMethodSpecification:text
- in:nil
- ignoreErrors:true
- ignoreWarnings:true.
- (p notNil and:[p ~~ #Error]) ifTrue:[
- sel := p selector.
- ]
- ].
-
- sel isNil ifTrue:[
- changeString := (chunkText contractTo:maxLen).
- changeType := '(change)'.
- headerLine := chunkText , ' (change)'.
- ] ifFalse:[
- changeString := self contractClass:className selector:sel to:maxLen.
- changeType := '(method in: ''' , category , ''')'.
- headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
- ].
-
- compareChanges ifTrue:[
- changeClass isNil ifFalse:[
- changeClass isMeta ifTrue:[
- cls := changeClass soleInstance
- ] ifFalse:[
- cls := changeClass
- ].
- ].
-
- (changeClass isNil or:[cls isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass implements:sel asSymbol) ifFalse:[
- changeDelta := '+'.
- ] ifTrue:[
- |m currentText t1 t2|
-
- m := changeClass compiledMethodAt:sel asSymbol.
- currentText := m source.
- currentText notNil ifTrue:[
- text asString = currentText asString ifTrue:[
- changeDelta := '='
- ] ifFalse:[
- t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
- t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
- t1 = t2 ifTrue:[
- changeDelta := '='
- ]
- ]
- ]
- ]
- ]
- ].
- entry := MultiColListEntry new.
- entry tabulatorSpecification:tabSpec.
- entry colAt:1 put:changeDelta.
- entry colAt:2 put:changeString.
- entry colAt:3 put:changeType.
- timeStampInfo notNil ifTrue:[
- entry colAt:4 put:timeStampInfo.
- ].
- changeHeaderLines add:entry
- ].
- changeString := nil.
- headerLine := nil.
-
- ]
- ].
- changeString notNil ifTrue:[
- entry := MultiColListEntry new.
- entry tabulatorSpecification:tabSpec.
- entry colAt:1 put:changeDelta.
- entry colAt:2 put:changeString.
- entry colAt:3 put:changeType.
- timeStampInfo notNil ifTrue:[
- entry colAt:4 put:timeStampInfo.
- ].
- changeHeaderLines add:entry
- ] ifFalse:[
- headerLine notNil ifTrue:[
- changeHeaderLines add:headerLine
- ]
- ]
- ]
- ]
- ].
- changeClassNames := OrderedCollection new grow:(changeChunks size).
- anyChanges := false
- ] valueNowOrOnUnwindDo:[
- aStream close.
- inBackground ifTrue:[myProcess priority:myPriority].
- ].
- ].
-
- self checkIfFileHasChanged
-
- "Modified: / 27.8.1995 / 23:06:55 / claus"
- "Modified: / 17.7.1998 / 11:10:07 / cg"
-!
-
-selectorOfMethodChange:changeNr
- "return a method-changes selector, or nil if its not a methodChange"
-
- |source parser sel chunk aParseTree |
-
- source := self sourceOfMethodChange:changeNr.
- source isNil ifTrue:[
- (self classNameOfChange:changeNr) notNil ifTrue:[
- chunk := changeChunks at:changeNr.
- chunk isNil ifTrue:[^ nil]. "mhmh - empty"
- aParseTree := Parser parseExpression:chunk.
- (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
- ^ nil "seems strange ... (could be a comment)"
- ].
- aParseTree isMessage ifFalse:[
- ^ nil "very strange ... (whats that ?)"
- ].
- sel := aParseTree selector.
- (#(
- #'removeSelector:'
- ) includes:sel) ifTrue:[
- sel := aParseTree arguments at:1.
- sel isConstant ifTrue:[
- sel := sel evaluate.
- sel isSymbol ifTrue:[
- ^ sel
- ]
- ]
- ]
- ].
- ^ nil
- ].
-
-
- parser := Parser
- parseMethodArgAndVarSpecification:source
- in:nil
- ignoreErrors:true
- ignoreWarnings:true
- parseBody:false.
-
-"/ parser := Parser
-"/ parseMethod:source
-"/ in:nil
-"/ ignoreErrors:true
-"/ ignoreWarnings:true.
-
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- sel := parser selector.
- ].
- ^ sel
-
- "Created: 24.11.1995 / 14:30:46 / cg"
- "Modified: 5.9.1996 / 17:12:50 / cg"
-!
-
-setChangeList
- "extract type-information from changes and stuff into top selection
- view"
-
- changeListView setList:changeHeaderLines expandTabs:false redraw:false.
- changeListView invalidate.
-
- "/ changeListView deselect.
-
- "Modified: / 18.5.1998 / 14:29:10 / cg"
-!
-
-showNotFound
- |savedCursor|
-
- savedCursor := cursor.
- [
- self cursor:(Cursor cross).
- self beep.
- Delay waitForMilliseconds:300.
- ] valueNowOrOnUnwindDo:[
- self cursor:savedCursor
- ]
-
- "Modified: / 29.4.1999 / 22:36:54 / cg"
-!
-
silentDeleteChange:changeNr
"delete a change do not update changeListView"
@@ -1930,181 +2181,6 @@
"Created: / 7.3.1997 / 16:28:32 / cg"
"Modified: / 7.2.1998 / 19:59:11 / cg"
"Modified: / 26.2.1998 / 18:20:48 / stefan"
-!
-
-sourceOfMethodChange:changeNr
- "return a method-changes source code, or nil if its not a methodChange."
-
- |aStream chunk sawExcla parseTree sourceChunk|
-
- aStream := self streamForChange:changeNr.
- aStream isNil ifTrue:[^ nil].
-
- (self changeIsFollowupMethodChange:changeNr) ifFalse:[
- sawExcla := aStream peekFor:(aStream class chunkSeparator).
- chunk := aStream nextChunk.
- ] ifTrue:[
- chunk := (changeChunks at:changeNr).
- sawExcla := true.
- ].
-
- sawExcla ifTrue:[
- parseTree := Parser parseExpression:chunk.
- (parseTree notNil and:[parseTree isMessage]) ifTrue:[
- (#(#methodsFor:
- #privateMethodsFor:
- #publicMethodsFor:
- #ignoredMethodsFor:
- #protectedMethodsFor:)
- includes:parseTree selector) ifTrue:[
- sourceChunk := aStream nextChunk.
- ]
- ].
- ].
- aStream close.
- ^ sourceChunk
-
- "Created: / 5.9.1996 / 17:11:32 / cg"
- "Modified: / 3.8.1998 / 20:00:21 / cg"
-!
-
-streamForChange:changeNr
- "answer a stream for change"
-
- |aStream|
-
- (changeNr between:1 and:changePositions size) ifFalse:[^ nil].
- aStream := FileStream readonlyFileNamed:changeFileName.
- aStream isNil ifTrue:[^ nil].
- aStream position:(changePositions at:changeNr).
- ^ aStream
-!
-
-unselect
- "common unselect"
-
- changeListView setSelection:nil.
-
- "Modified: 25.5.1996 / 13:02:49 / cg"
-!
-
-withSelectedChangeDo:aBlock
- "just a helper, check for a selected change and evaluate aBlock
- with busy cursor"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withExecuteCursorDo:[
- aBlock value:changeNr
- ]
- ]
-
- "Modified: 14.12.1995 / 20:58:45 / cg"
-!
-
-writeBackChanges
- "write back the changes file. To avoid problems when the disk is full
- or a crash occurs while writing (well, or someone kills us),
- first write the stuff to a new temporary file. If this works ok,
- rename the old change-file to a .bak file and finally rename the
- tempfile back to the change-file.
- That way, if anything happens, either the original file is left unchanged,
- or we have at least a backup of the previous change file."
-
- |inStream outStream tempfile stamp f|
-
- editingClassSource ifTrue:[
- (self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
- ifFalse:[
- ^ false
- ]
- ].
-
- tempfile := Filename newTemporaryIn:nil.
- tempfile exists ifTrue:[tempfile remove].
-
- outStream := tempfile writeStream.
- outStream isNil ifTrue:[
- self warn:'cannot create temporary file in current directory.'.
- ^ false
- ].
-
- inStream := FileStream readonlyFileNamed:changeFileName.
- inStream isNil ifTrue:[^ false].
-
- self withCursor:(Cursor write) do:[
- |excla sawExcla done first chunk
- nChanges "{Class:SmallInteger}" |
-
- Stream writeErrorSignal handle:[:ex |
- self warn:('could not update the changes file.\\' , ex errorString) withCRs.
- tempfile exists ifTrue:[tempfile remove].
- ^ false
- ] do:[
-
- excla := inStream class chunkSeparator.
- nChanges := self numberOfChanges.
-
- 1 to:nChanges do:[:index |
- inStream position:(changePositions at:index).
- sawExcla := inStream peekFor:excla.
- chunk := inStream nextChunk.
-
- (chunk notNil
- and:[(chunk startsWith:'''---- snap') not]) ifTrue:[
- (stamp := changeTimeStamps at:index) notNil ifTrue:[
- outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
- outStream nextPut:excla; cr.
- ].
- ].
-
- sawExcla ifTrue:[
- outStream nextPut:excla.
- outStream nextChunkPut:chunk.
- outStream cr; cr.
- "
- a method-definition chunk - output followups
- "
- done := false.
- first := true.
- [done] whileFalse:[
- chunk := inStream nextChunk.
- chunk isNil ifTrue:[
- outStream cr; cr.
- done := true
- ] ifFalse:[
- chunk isEmpty ifTrue:[
- outStream space; nextChunkPut:chunk; cr; cr.
- done := true.
- ] ifFalse:[
- first ifFalse:[
- outStream cr; cr.
- ].
- outStream nextChunkPut:chunk.
- ].
- ].
- first := false.
- ].
- ] ifFalse:[
- outStream nextChunkPut:chunk.
- outStream cr
- ]
- ].
- outStream close.
- inStream close.
- ].
-
- f := changeFileName asFilename.
- f renameTo:(f withSuffix:'bak').
- tempfile renameTo:changeFileName.
- anyChanges := false
- ].
- ^ true
-
- "Modified: / 2.12.1996 / 22:29:15 / stefan"
- "Modified: / 21.4.1998 / 17:50:11 / cg"
! !
!ChangesBrowser methodsFor:'termination'!
@@ -2985,5 +3061,5 @@
!ChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.155 1999-06-26 16:30:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.156 1999-07-15 14:45:31 cg Exp $'
! !