diff -r 94477f9376f3 -r 6c278b8ec6ca ChangesBrowser.st --- a/ChangesBrowser.st Mon Nov 27 23:58:07 1995 +0100 +++ b/ChangesBrowser.st Sun Dec 03 15:31:21 1995 +0100 @@ -15,7 +15,7 @@ changePositions changeClassNames changeHeaderLines anyChanges changeNrShown changeNrProcessed skipSignal compareChanges compareCheckBox changeFileSize changeFileTimestamp checkBlock - changeTimeStamps tabSpec' + changeTimeStamps tabSpec autoUpdate' classVariableNames:'CompressSnapshotInfo' poolDictionaries:'' category:'Interface-Browsers' @@ -207,75 +207,89 @@ changeListMenu |labels selectors m| - labels := #( - 'apply change' - 'apply changes to end' - 'apply changes for this class to end' - 'apply all changes' - '-' - 'delete' - 'delete to end' - 'delete changes for this class to end' - 'delete all changes for this class' - '-' - 'update' - 'compress' - 'compare with current version' - 'browse' - '-' - 'make change a patch' -"/ 'update sourcefile from change' -"/ '-' - 'fileout & delete changes for this class' - '-' - 'save change in file ...' - 'save changes to end in file ...' - 'save changes for this class to end in file ...' - 'save all changes for this class in file ...' - '-' - 'writeback changeFile'). - selectors := #( - doApply - doApplyRest - doApplyClassRest - doApplyAll - nil - doDelete - doDeleteRest - doDeleteClassRest - doDeleteClassAll - nil - doUpdate - doCompress - doCompare - doBrowse - nil - doMakePatch -"/ doMakePermanent -"/ nil - doFileoutAndDeleteClassAll - nil - doSave - doSaveRest - doSaveClassRest - doSaveClassAll - nil - doWriteBack - ). +"/ self sensor ctrlDown ifTrue:[ +"/ labels := #( +"/ '\c auto update' +"/ ). +"/ selectors := #( +"/ autoUpdate: +"/ ). +"/ ] ifFalse:[ + labels := #( + 'apply change' + 'apply changes to end' + 'apply changes for this class to end' + 'apply all changes' + '-' + 'delete' + 'delete to end' + 'delete changes for this class to end' + 'delete all changes for this class' + '-' + 'update' + 'compress' + 'compare with current version' + 'browse' + '-' + 'make change a patch' + "/ 'update sourcefile from change' + "/ '-' + 'fileout & delete changes for this class' + '-' + 'save change in file ...' + 'save changes to end in file ...' + 'save changes for this class to end in file ...' + 'save all changes for this class in file ...' + '-' + 'writeback changeFile'). + + selectors := #( + doApply + doApplyRest + doApplyClassRest + doApplyAll + nil + doDelete + doDeleteRest + doDeleteClassRest + doDeleteClassAll + nil + doUpdate + doCompress + doCompare + doBrowse + nil + doMakePatch + "/ doMakePermanent + "/ nil + doFileoutAndDeleteClassAll + nil + doSave + doSaveRest + doSaveClassRest + doSaveClassAll + nil + doWriteBack + ). +"/ ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors. + labels:(resources array:labels) + selectors:selectors. +"/ autoUpdate ifTrue:[ +"/ m checkToggleAt:#autoUpdate: put:true +"/ ]. changeListView hasSelection ifFalse:[ - m disableAll:#(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest - doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent - doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) + m disableAll:#(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent + doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) ]. ^ m "Modified: 6.9.1995 / 17:14:22 / claus" + "Modified: 3.12.1995 / 14:31:44 / cg" ! compare:aBoolean @@ -303,18 +317,20 @@ ! initialize - |panel v upperFrame buttonPanel| + |panel v upperFrame buttonPanel autoUpdateCheckBox| super initialize. changeFileName := ObjectMemory nameForChanges. "/ 'changes'. compareChanges := false. + autoUpdate := false. + checkBlock := [self checkIfFileHasChanged]. panel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - borderWidth:0 - in:self. + corner:(1.0 @ 1.0) + borderWidth:0 + in:self. upperFrame := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.3) in:panel. @@ -326,13 +342,18 @@ buttonPanel := VerticalPanelView in:upperFrame. buttonPanel origin:(0.8 @ 0.0) corner:(1.0 @ 1.0). - buttonPanel verticalLayout:#topSpace. + buttonPanel verticalLayout:#topSpace; horizontalLayout:#leftSpace. compareCheckBox := CheckBox new. compareCheckBox label:(resources string:'compare'). compareCheckBox action:[:val | self compare:val]. buttonPanel addSubView:compareCheckBox. + autoUpdateCheckBox := CheckBox new. + autoUpdateCheckBox label:(resources string:'auto update'). + autoUpdateCheckBox action:[:val | self autoUpdate:val]. + buttonPanel addSubView:autoUpdateCheckBox. + v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:panel. v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). codeView := v scrolledView. @@ -347,7 +368,7 @@ " +/- cls>>sel type info" tabSpec align: #(#left #left #left #left). - "Modified: 18.11.1995 / 17:30:59 / cg" + "Modified: 3.12.1995 / 14:26:18 / cg" ! realize @@ -512,18 +533,22 @@ Processor removeTimedBlock:checkBlock. f := changeFileName asFilename. (info := f info) isNil ifTrue:[ - self newLabel:'(unaccessable)' + self newLabel:'(unaccessable)' ] ifFalse:[ - (info at:#modified) > changeFileTimestamp ifTrue:[ - self newLabel:'(outdated)' - ] ifFalse:[ - self newLabel:'' - ] + (info at:#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: 3.12.1995 / 14:14:55 / cg" ! classNameOfChange:changeNr @@ -828,23 +853,25 @@ 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 + 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 f| + self newLabel:'updating ...'. + maxLen := 60. f := changeFileName asFilename. @@ -855,288 +882,288 @@ changeFileTimestamp := f info at:#modified. self withCursor:(Cursor read) do:[ - |myProcess myPriority| + |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). - ]. + " + 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| + [ + |excla timeStampInfo| - changeChunks := OrderedCollection new. - changeHeaderLines := OrderedCollection new. - changePositions := OrderedCollection new. - changeTimeStamps := OrderedCollection new. - excla := aStream class chunkSeparator. + changeChunks := OrderedCollection new. + changeHeaderLines := OrderedCollection new. + changePositions := OrderedCollection new. + changeTimeStamps := OrderedCollection new. + excla := aStream class chunkSeparator. - [aStream atEnd] whileFalse:[ - |entry changeDelta changeString changeType - line s l changeClass sawExcla category - chunkText chunkPos| + [aStream atEnd] whileFalse:[ + |entry changeDelta changeString changeType + line s l changeClass sawExcla category + chunkText chunkPos| - " - get a chunk (separated by excla) - " - aStream skipSeparators. - chunkPos := aStream position. + " + get a chunk (separated by excla) + " + aStream skipSeparators. + chunkPos := aStream position. - sawExcla := aStream peekFor:excla. - chunkText := aStream nextChunk. - chunkText notNil ifTrue:[ - |index headerLine| + sawExcla := aStream peekFor:excla. + chunkText := aStream nextChunk. + chunkText notNil ifTrue:[ + |index headerLine| - (chunkText startsWith:'''---- timestamp ') ifTrue:[ - timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces. - ] ifFalse:[ + (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). + " + 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" + "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:[ - chunkText := chunkText , '... %}''' - ]. - (chunkText endsWith:'primitiveVariables:''%{') ifTrue:[ - chunkText := chunkText , '... %}''' - ]. - (chunkText endsWith:'primitiveFunctions:''%{') ifTrue:[ - chunkText := chunkText , '... %}''' - ]. - ]. + (chunkText endsWith:'comment:''') ifTrue:[ + chunkText := chunkText , '...''' + ]. + (chunkText endsWith:'primitiveDefinitions:''%{') ifTrue:[ + chunkText := chunkText , '... %}''' + ]. + (chunkText endsWith:'primitiveVariables:''%{') ifTrue:[ + chunkText := chunkText , '... %}''' + ]. + (chunkText endsWith:'primitiveFunctions:''%{') ifTrue:[ + chunkText := chunkText , '... %}''' + ]. + ]. - changeChunks add:chunkText. - changePositions add:chunkPos. - changeTimeStamps add:timeStampInfo. + changeChunks add:chunkText. + changePositions add:chunkPos. + changeTimeStamps add:timeStampInfo. - headerLine := nil. - changeDelta := ' '. + headerLine := nil. + changeDelta := ' '. - sawExcla ifFalse:[ - (chunkText startsWith:'''---- snap') ifTrue:[ - changeType := ''. - headerLine := chunkText. - changeString := (chunkText contractTo:maxLen). - ] ifFalse:[ + sawExcla ifFalse:[ + (chunkText startsWith:'''---- snap') ifTrue:[ + changeType := ''. + headerLine := chunkText. + changeString := (chunkText contractTo:maxLen). + ] ifFalse:[ - |p sel cls| + |p sel cls| - headerLine := chunkText , ' (doIt)'. + headerLine := chunkText , ' (doIt)'. - " - first, assume doIt - then lets have a more detailed look ... - " - (chunkText startsWith:'''---- file') ifTrue:[ - changeType := ''. - ] ifFalse:[ - changeType := '(doIt)'. - ]. - changeString := (chunkText contractTo:maxLen). + " + first, assume doIt - then lets have a more detailed look ... + " + (chunkText startsWith:'''---- file') ifTrue:[ + changeType := ''. + ] ifFalse:[ + changeType := '(doIt)'. + ]. + changeString := (chunkText contractTo:maxLen). - p := Parser parseExpression:chunkText. - (p notNil - and:[p ~~ #Error - and:[p isMessage]]) ifTrue:[ - sel := p selector. - ]. - (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. + p := Parser parseExpression:chunkText. + (p notNil + and:[p ~~ #Error + and:[p isMessage]]) ifTrue:[ + sel := p selector. + ]. + (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 := '-'. - ] - ] - ]. - changeType := '(remove)'. - changeString := self contractClass:cls selector:sel to:maxLen. - ]. - (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:' - ) includes:sel) ifTrue:[ - changeType := '(class definition)'. - ]. - ] - ] ifTrue:[ "sawExcla" - |done first p sel cls text| + compareChanges ifTrue:[ + (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ + changeDelta := '?' + ] ifFalse:[ + (changeClass implements:sel asSymbol) ifTrue:[ + changeDelta := '-'. + ] + ] + ]. + changeType := '(remove)'. + changeString := self contractClass:cls selector:sel to:maxLen. + ]. + (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:' + ) includes:sel) ifTrue:[ + changeType := '(class definition)'. + ]. + ] + ] ifTrue:[ "sawExcla" + |done first p sel cls text| - " - 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 .... - " - cls := nil. - p := Parser parseExpression:chunkText. + " + 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 .... + " + cls := nil. + p := Parser parseExpression:chunkText. - (p notNil and:[p ~~ #Error]) ifTrue:[ - sel := p selector. - (sel == #methodsFor:) 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 - ]. - category := (p args at:1) evaluate. - ]. - ]. - done := false. - first := true. - [done] whileFalse:[ - text := aStream nextChunk. - text isNil ifTrue:[ - done := true - ] ifFalse:[ - done := text isEmpty - ]. - done ifFalse:[ - first ifFalse:[ - Transcript showCr:'only one method per ''methodsFor:'' handled'. - ] ifTrue:[ - first := false. - " - try to find the selector - " - sel := nil. - cls notNil ifTrue:[ - p := Parser - parseMethodSpecification:text - in:nil - ignoreErrors:true - ignoreWarnings:true. - (p notNil and:[p ~~ #Error]) ifTrue:[ - sel := p selector. - ] - ]. + (p notNil and:[p ~~ #Error]) ifTrue:[ + sel := p selector. + (sel == #methodsFor:) 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 + ]. + category := (p args at:1) evaluate. + ]. + ]. + done := false. + first := true. + [done] whileFalse:[ + text := aStream nextChunk. + text isNil ifTrue:[ + done := true + ] ifFalse:[ + done := text isEmpty + ]. + done ifFalse:[ + first ifFalse:[ + Transcript showCr:'only one method per ''methodsFor:'' handled'. + ] ifTrue:[ + first := false. + " + try to find the selector + " + sel := nil. + cls 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)'. - ] ifFalse:[ - changeString := self contractClass:cls selector:sel to:maxLen. - changeType := '(method in: ''' , category , ''')'. - ]. - sel isNil ifTrue:[ - headerLine := chunkText , ' (change)'. - ] ifFalse:[ - headerLine := cls , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. - ]. + sel isNil ifTrue:[ + changeString := (chunkText contractTo:maxLen). + changeType := '(change)'. + ] ifFalse:[ + changeString := self contractClass:cls selector:sel to:maxLen. + changeType := '(method in: ''' , category , ''')'. + ]. + sel isNil ifTrue:[ + headerLine := chunkText , ' (change)'. + ] ifFalse:[ + headerLine := cls , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. + ]. - compareChanges ifTrue:[ - (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ - changeDelta := '?' - ] ifFalse:[ - (changeClass implements:sel asSymbol) ifFalse:[ - changeDelta := '+'. - ] ifTrue:[ - |m currentText t1 t2| + compareChanges ifTrue:[ + (changeClass isNil or:[changeClass 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 := '=' - ] - ] - ] - ] - ] - ] - ] - ] - ] - ]. - changeString notNil ifTrue:[ - entry := MultiColListEntry new. - entry tabulatorSpecification:tabSpec. - entry colAt:1 put:changeDelta. - entry colAt:2 put:changeString. - entry colAt:3 put:changeType. - entry colAt:4 put:timeStampInfo. - changeHeaderLines add:entry - ] ifFalse:[ - headerLine notNil ifTrue:[ - changeHeaderLines add:headerLine - ] - ] - ] - ] - ]. - changeClassNames := OrderedCollection new grow:(changeChunks size). - aStream close. - anyChanges := false - ] valueNowOrOnUnwindDo:[ - inBackground ifTrue:[myProcess priority:myPriority]. - ]. + 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 := '=' + ] + ] + ] + ] + ] + ] + ] + ] + ] + ]. + changeString notNil ifTrue:[ + entry := MultiColListEntry new. + entry tabulatorSpecification:tabSpec. + entry colAt:1 put:changeDelta. + entry colAt:2 put:changeString. + entry colAt:3 put:changeType. + entry colAt:4 put:timeStampInfo. + changeHeaderLines add:entry + ] ifFalse:[ + headerLine notNil ifTrue:[ + changeHeaderLines add:headerLine + ] + ] + ] + ] + ]. + changeClassNames := OrderedCollection new grow:(changeChunks size). + aStream close. + anyChanges := false + ] valueNowOrOnUnwindDo:[ + inBackground ifTrue:[myProcess priority:myPriority]. + ]. ]. self checkIfFileHasChanged "Modified: 27.8.1995 / 23:06:55 / claus" - "Modified: 24.11.1995 / 14:29:51 / cg" + "Modified: 3.12.1995 / 14:28:33 / cg" ! selectorOfMethodChange:changeNr @@ -1354,6 +1381,13 @@ !ChangesBrowser methodsFor:'user interaction'! +autoUpdate:aBoolean + autoUpdate := aBoolean + + "Created: 3.12.1995 / 14:14:24 / cg" + "Modified: 3.12.1995 / 14:20:45 / cg" +! + changeSelection:lineNr "show a change in the codeView" @@ -1478,137 +1512,142 @@ aStream := FileStream readonlyFileNamed:changeFileName. aStream isNil ifTrue:[^ self]. + self newLabel:'compressing ...'. + 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 withCursor:(Cursor execute) do:[ - |numChanges classes selectors types excla sawExcla - changeNr chunk aParseTree parseTreeChunk - thisClass thisSelector codeChunk codeParser| + |numChanges classes selectors types excla sawExcla + changeNr chunk aParseTree parseTreeChunk + thisClass thisSelector codeChunk codeParser| - numChanges := changePositions size. - classes := Array new:numChanges. - selectors := Array new:numChanges. - types := Array new:numChanges. + numChanges := changePositions size. + 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" + "starting at the end, get the change class and change selector; + collect all in classes / selectors" - changeNr := numChanges. - excla := aStream class chunkSeparator. + 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. + [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" + "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 < changePositions size] whileTrue:[ - thisClass := classes at:changeNr. - 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 - ]. + deleteSet := OrderedCollection new. + changeNr := 1. + [changeNr < changePositions size] whileTrue:[ + thisClass := classes at:changeNr. + 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" + "finally delete what has been found" - (deleteSet size > 0) ifTrue:[ - changeListView deselect. - 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 > changePositions size ifTrue:[ - changeListView makeLineVisible:changePositions size - ]. - self clearCodeView - ] - ] + (deleteSet size > 0) ifTrue:[ + changeListView deselect. + 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 > changePositions size ifTrue:[ + changeListView makeLineVisible:changePositions size + ]. + self clearCodeView + ] + ]. + self newLabel:''. + + "Created: 3.12.1995 / 14:29:54 / cg" ! doDelete @@ -1883,4 +1922,4 @@ !ChangesBrowser class methodsFor:'documentation'! version -^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.53 1995-11-24 22:14:52 cg Exp $'! ! +^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.54 1995-12-03 14:31:21 cg Exp $'! !