# HG changeset patch # User Claus Gittinger # Date 932049931 -7200 # Node ID 46fc2bb1b9c1125e867420936ecd419fded3a96b # Parent 75d490e87d95368301e2c505d0fc96f147ee8a87 changes to allow browsing Sqeak fileOut format. diff -r 75d490e87d95 -r 46fc2bb1b9c1 CBrowser.st --- 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 $' ! ! diff -r 75d490e87d95 -r 46fc2bb1b9c1 ChangesBrowser.st --- 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 $' ! !