hg/stx-libtool: comparison NewChangesBrowser.st

equal deleted inserted replaced

-:089039d26fa1
+:4767ba5caf5b
 !
 openOnFile:aFileName
 "opens a Changes Browser with the changes of the aFileName"
 ^self new
 	changeFileName:aFileName;
 	open
 ! !
 "Do not manually edit this!! If it is corrupted,
 the UIHelpTool may not be able to read the specification."
 "
 UIHelpTool openOnClass:NewChangesBrowser
 "
 <resource: #help>
 ^super helpSpec addPairsFrom:#(
 "
 <resource: #canvas>
 ^
 #(#FullSpec
 	  #window:
 	   #(#WindowSpec
 	      #name: 'Changes Browser'
 	      #layout: #(#LayoutFrame 53 0 92 0 687 0 583 0)
 	      #label: 'Changes Browser'
 	      #min: #(#Point 10 10)
 	      #max: #(#Point 1152 900)
 	      #bounds: #(#Rectangle 53 92 688 584)
 	      #menu: #menu
 	      #usePreferredExtent: false
 	  )
 	  #component:
 	   #(#SpecCollection
 	      #collection:
 	       #(
 		 #(#MenuPanelSpec
 		    #name: 'menuToolbarView'
 		    #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 32 0)
 		    #menu: #menuToolbar
 		    #showSeparatingLines: true
 		)
 		 #(#VariableVerticalPanelSpec
 		    #name: 'variableVerticalPanel1'
 		    #layout: #(#LayoutFrame 0 0.0 34 0 0 1.0 -26 1.0)
 		    #component:
 		     #(#SpecCollection
 			#collection:
 			 #(
 			   #(#ViewSpec
 			      #name: 'Box1'
 			      #component:
 			       #(#SpecCollection
 				  #collection:
 				   #(
 				     #(#DataSetSpec
 					#name: 'changesDataSetView'
 					#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -28 1.0)
 					#model: #selectionOfChange
 					#valueChangeSelector: #changeSelected:
 				    )
 				     #(#ViewSpec
 					#name: 'Box2'
 					#layout: #(#LayoutFrame 0 0.0 -28 1 0 1.0 0 1.0)
 					#component:
 					 #(#SpecCollection
 					    #collection:
 					     #(
 					       #(#LabelSpec
 						  #name: 'filterLabel'
 						  #layout: #(#AlignmentOrigin 37 0 13 0.0 1 0.5)
 						  #label: 'Filter:'
 "
 <resource: #menu>
 ^
 #(#Menu
 	   #(
 	     #(#MenuItem
 		#label: 'About'
 		#translateLabel: true
 		#activeHelpKey: #about
 	    )
 	     #(#MenuItem
 		#label: 'File'
 		#translateLabel: true
 		#activeHelpKey: #file
 		#submenu:
 		 #(#Menu
 		     #(
 		       #(#MenuItem
 			  #label: 'Reload'
 			  #translateLabel: true
 			  #value: #doReload
 		)
 	    )
 	     #(#MenuItem
 		#label: 'Apply'
 		#translateLabel: true
 		#submenu:
 		 #(#Menu
 		     #(
 		       #(#MenuItem
 			  #label: 'Change'
 			  #translateLabel: true
 			  #value: #doApply
 	    )
 	     #(#MenuItem
 		#label: 'Delete'
 		#translateLabel: true
 		#activeHelpKey: #edit
 		#submenu:
 		 #(#Menu
 		     #(
 		       #(#MenuItem
 			  #label: 'Change'
 			  #translateLabel: true
 			  #value: #doDelete
 	    )
 	     #(#MenuItem
 		#label: 'Test'
 		#translateLabel: true
 		#activeHelpKey: #test
 		#submenu:
 		 #(#Menu
 		     #(
 		       #(#MenuItem
 			  #label: 'Find last Snapshot'
 			  #translateLabel: true
 			  #value: #doFindSnapshot:
 	    )
 	     #(#MenuItem
 		#label: 'Settings'
 		#translateLabel: true
 		#activeHelpKey: #settings
 		#submenu:
 		 #(#Menu
 		     #(
 		       #(#MenuItem
 			  #label: 'Auto Update'
 			  #translateLabel: true
 			  #activeHelpKey: #settingsAutoUpdate
 		      )
 		       #(#MenuItem
 			  #label: 'Columns'
 			  #translateLabel: true
 			  #activeHelpKey: #settingsColumns
 			  #submenu:
 			   #(#Menu
 			       #(
 				 #(#MenuItem
 				    #label: 'Category'
 				    #activeHelpKey: #settingsColumnsCategory
 				    #indication: #categoryColumn:
 "
 <resource: #menu>
 ^
 #(#Menu
 	   #(
 	     #(#MenuItem
 		#label: 'Apply'
 		#translateLabel: true
 		#value: #doApply
 "
 <resource: #menu>
 ^
 #(#Menu
 	   #(
 	     #(#MenuItem
 		#label: 'Load'
 		#isButton: true
 		#value: #doLoad
 listOfChangeColumns
 "initializes (during the startup) and returns the value holder for the columns"
 |holder|
 (holder := builder bindingAt:#listOfChangeColumns) isNil ifTrue:[
-builder aspectAt:#listOfChangeColumns put:(holder := List new).
+	builder aspectAt:#listOfChangeColumns put:(holder := List new).
-self changeColumn: nil add: true.
+	self changeColumn: nil add: true.
-self changeColumn: #change add: true.
+	self changeColumn: #change add: true.
-self categoryColumn: self categoryColumn.
+	self categoryColumn: self categoryColumn.
-self timeStampColumn: self timeStampColumn.
+	self timeStampColumn: self timeStampColumn.
-self typeColumn: self typeColumn.
+	self typeColumn: self typeColumn.
 "/        self deltaInfoColumn: self deltaInfoColumn.
-self positionsColumn: self positionsColumn.
+	self positionsColumn: self positionsColumn.
 ].
 ^ holder
 "Modified: / 19.5.1998 / 20:30:31 / cg"
 !
 listOfChanges
 "returns the value holder for the changes"
 |holder|
 (holder := builder bindingAt:#listOfChanges) isNil ifTrue:[
 	builder aspectAt:#listOfChanges put:(holder := List new)
 ].
 ^ holder
 !
 selectionOfChange
 "returns the value holder for the selected change"
 |holder|
 (holder := builder bindingAt:#selectionOfChange) isNil ifTrue:[
 	builder aspectAt:#selectionOfChange put:(holder :=  ValueHolder new).
 ].
 ^ holder
 !
 valueOfChangeText
 "returns the value holder for the source code of the selected change"
 sawExcla := aStream peekFor:(aStream class chunkSeparator).
 chunk := aStream nextChunk.
 sawExcla ifTrue:[
 	chunk := aStream nextChunk
 ].
 aStream close.
 self valueOfChangeText value:chunk.
 self updateChannels
 ! !
 update:something with:aParameter from:changedObject
 "evaluates the filterCompletionBlock after returning the filter string"
 super update:something with:aParameter from:changedObject.
 changedObject == self valueOfFilter
 ifTrue:
 [
 	filterCompletionBlock value: changedObject value.
 	self listOfChanges size > 0 ifTrue: [self addToHistory: changedObject value -> #doFilter:]
 ]
 !
 updateChannels
 "updates my channels"
 |change|
 (change := self selectionOfChange value) notNil
 ifTrue:
 [
 	self valueOfHavingSelection value: true.
 	self valueOfHavingChangeSelection value:
 	    ((change type = 'method') or: [(change type = 'class')])
 ]
 ifFalse:
 [
 	self valueOfHavingSelection value: false.
 	    |box|
 	    "
 	     start dialog - make certain cleanup is done
 	    "
 	    action := OptionBox
 			  request:aString
 			  label:'Error'
 			  form:(WarningBox iconBitmap)
 			  buttonLabels:#('cancel' 'skip' 'continue')
 			  values:#(#abort #skip #continue)
 	].
 	action == #skip ifTrue:[
 	    skipSignal raise.
 	    ^ false
 	].
 	^  false
 ].
 ^self changeTextEditor error:aString position:relPos to:relEndPos from:aCompiler
 !
 "initializes the instance variables"
 super initialize.
 changes           := List new.
 self changeFileName: ObjectMemory nameForChanges.
 AutoUpdate        := AutoUpdate ? false.
 PrivateAsSeparate := PrivateAsSeparate ? false.
 ObjectMemory addDependent:self.
 ! !
 !
 autoSelectChange:aChange
 "selects aChange"
 self class autoSelectNext ifTrue:[
 	((self listOfChanges indexOf: aChange) <= self listOfChanges size) ifTrue:[
 	    self selectionOfChange value: aChange.
 	    self changeSelected:(self listOfChanges indexOf: aChange).
 	    self updateChannels.
 	    ^ self
 	]
 ].
 self updateChannels.
 self unselectChange
 !
 "selects aChange or the last"
 |last|
 last := self listOfChanges size.
 aChange notNil ifTrue:[
 	self autoSelectChange:aChange
 ] ifFalse:[
 	self selectionOfChange value: (self listOfChanges at: last ifAbsent: nil).
 	self changeSelected: last
 ].
 |newListOfChangeColumns|
 newListOfChangeColumns := self listOfChangeColumns asOrderedCollection.
 addOrRemove
 ifTrue:
 [
 	newListOfChangeColumns add:
 	    ((self class tableColumnsForChangeAttributes
 		collect: [:i| i decodeAsLiteralArray])
 		    detect: [:column| column id = aColumnId])
 ]
 ifFalse:
 [
 	newListOfChangeColumns remove:
 	    (self listOfChangeColumns detect: [:column| column id = aColumnId] ifNone: nil) ifAbsent: nil
 ].
 self listOfChangeColumns contents: newListOfChangeColumns.
 self autoSelectLast
 checkIfFileHasChanged
 "checks if changes file has changed"
 |f info|
 Processor removeTimedBlock:autoUpdateBlock.
 f := changeFileName asFilename.
 (info := f info) isNil ifTrue:[
-self newLabel:'unaccessable'
+	self newLabel:'unaccessable'
 ] ifFalse:[
-(info modificationTime) > changeFileTimestamp ifTrue:[
+	(info modificationTime) > changeFileTimestamp ifTrue:[
-self newLabel:'outdated'.
+	    self newLabel:'outdated'.
-AutoUpdate ifTrue:[
+	    AutoUpdate ifTrue:[
-self doReload
+		self doReload
-]
+	    ]
-] ifFalse:[
+	] ifFalse:[
-self newLabel:''
+	    self newLabel:''
-]
+	]
 ].
 Processor addTimedBlock:autoUpdateBlock afterSeconds:5.
 !
 classNameOfChange:aChange
 "returns the classname of aChange
 (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
 |name|
 name := self fullClassNameOfChange:aChange.
 		]
 	    ]
 	]
 ] ifTrue:[
 	parseTree := Parser parseExpression:chunk.
 	(parseTree notNil
 	 and:[parseTree ~~ #Error
 	 and:[parseTree isMessage]]) ifTrue:[
 	    (parseTree selector == #methodsFor:) ifTrue:[
 		thisClass := (parseTree receiver evaluate).
 		thisClass isBehavior ifTrue:[
 					showDiff := true.
 					"/
 					"/ check if only historyLine diffs
 					"/
 					(HistoryManager notNil
 					and:[HistoryManager isActive]) ifTrue:[
 					    (HistoryManager withoutHistoryLines:newSource)
 					    =
 					    (HistoryManager withoutHistoryLines:oldSource)
 					    ifTrue:[
 			]
 		    ] ifFalse:[
 			outcome := 'Change unparsable!!'
 		    ].
 		    (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
 			d := DiffTextView
 				openOn:oldSource label:'Current version (in image)'
 				and:newSource label:'Change version'.
 			d label:'method differences'.
 		    ]
 		] ifFalse:[
 	]
 ]
 !
 compressForClass:aClassNameOrNil
 "compresses the list of changes;
 this replaces multiple method-changes by the last (i.e. the most recent) change.
 If the class argument is nil, compress for all classes.
 otherwise, only changes for that class are compressed."
 |aStream searchIndex anyMore deleteSet index
 str snapshotProto snapshotPrefix snapshotNameIndex fileName|
 aStream := FileStream readonlyFileNamed:changeFileName.
 aStream isNil ifTrue:[^ self].
 		"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:[
 		    ]
 		]
 	    ] 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
 	    ].
 	    changeNr := changeNr - 1
 	].
 	aStream close.
-	"for all changes, look for another class/selector occurence later
+	"for all changes, look for another class/selector occurrence later
 	 in the list and, if there is one, add change number to the delete set"
 	deleteSet := OrderedCollection new.
 	changeNr := 1.
 	[changeNr < changes size] whileTrue:[
 		compressThis := true
 	    ] ifFalse:[
 		"/ skipping unloaded/unknown classes
 		thisClass isBehavior ifTrue:[
 		    thisClass isMeta ifTrue:[
 			compressThis := aClassNameOrNil = thisClass soleInstance name.
 		    ] ifFalse:[
 			compressThis := aClassNameOrNil = thisClass name.
 			(PrivateAsSeparate not and: [thisClass isPrivate])
 			    ifTrue:[compressThis := aClassNameOrNil = thisClass owningClass name]
 		    ]
 				deleteSet add:changeNr.
 				anyMore := false
 			    ]
 			]
 		    ] ifFalse:[
 			anyMore := false
 		    ]
 		].
 	    ].
 	    changeNr := changeNr + 1
 !
 deleteChangesFrom:start to:stop
 "deletes a range of changes"
 self unselectChange.
 stop to:start by:-1 do:[:changeNr|
 	self silentDeleteChange:(self listOfChanges at: changeNr)
 ].
 self setChangeList
 !
 fullClassNameOfChange:aChange
 "returns the full classname of aChange
 (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|
 recTree := aParseTree receiver.
 "
 is it a method-change, methodRemove or comment-change ?
 "
 (#(#'methodsFor:'
 #'privateMethodsFor:'
 #'protectedMethodsFor:'
 #'publicMethodsFor:'
 #'removeSelector:'
 #'comment:'
 #'primitiveDefinitions:'
 #'primitiveFunctions:'
 #'primitiveVariables:'
 #'renameCategory:to:'
 ].
 "
 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:aChange.
 "
 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:[
 "
 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.
 readChangesFileInBackground:inBackground
 "reads the changes file, creates 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)
+	1   delta (only if comparing)
-'+' -> new method (w.r.t. current state)
+		'+' -> new method (w.r.t. current state)
-'-' -> removed method (w.r.t. current state)
+		'-' -> removed method (w.r.t. current state)
-'?' -> class does not exist currently
+		'?' -> class does not exist currently
-'=' -> change is same as current methods source
+		'=' -> change is same as current methods source
-2   class/selector
+	2   class/selector
-3   type of change
+	3   type of change
-doit
+		doit
-method
+		method
-category change
+		category change
-4   timestamp
+	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 v|
 v notNil ifTrue:[v raise].
 v := self filterLabel.
 v notNil ifTrue:[v label: 'Read:'; redraw].
 self withReadCursorDo:[
-|myProcess myPriority|
+	|myProcess myPriority|
-"
+	"
-this is a time consuming operation (especially, if reading an
+	 this is a time consuming operation (especially, if reading an
-NFS-mounted directory; therefore lower my priority...
+	 NFS-mounted directory; therefore lower my priority...
-"
+	"
-inBackground ifTrue:[
+	inBackground ifTrue:[
-myProcess := Processor activeProcess.
+	    myProcess := Processor activeProcess.
-myPriority := myProcess priority.
+	    myPriority := myProcess priority.
-myProcess priority:(Processor userBackgroundPriority).
+	    myProcess priority:(Processor userBackgroundPriority).
-].
+	].
-[
+	[
-|excla timeStampInfo lastChange|
+	    |excla timeStampInfo lastChange|
-excla := aStream class chunkSeparator.
+	    excla := aStream class chunkSeparator.
-[aStream atEnd] whileFalse:[
+	    [aStream atEnd] whileFalse:[
-|change changeDelta changeString changeType changeCategory
+		|change changeDelta changeString changeType changeCategory
-line s l changeClass sawExcla category
+		 line s l changeClass sawExcla category
-chunkText chunkPos sel oldValue|
+		 chunkText chunkPos sel oldValue|
-change := Change new.
+		change := Change new.
-"
+		"
-get a chunk (separated by excla)
+		 get a chunk (separated by excla)
-"
+		"
-oldValue := self valueOfReadProgress value.
+		oldValue := self valueOfReadProgress value.
-self valueOfReadProgress value: (((aStream position/aStream size) * 100) rounded).
+		self valueOfReadProgress value: (((aStream position/aStream size) * 100) rounded).
 "/                oldValue ~~ self valueOfReadProgress value
 "/                    ifTrue: [self readProgressIndicator redrawEdges;redraw].
-aStream skipSeparators.
+		aStream skipSeparators.
-chunkPos := aStream position.
+		chunkPos := aStream position.
-sawExcla := aStream peekFor:excla.
+		sawExcla := aStream peekFor:excla.
-chunkText := aStream nextChunk.
+		chunkText := aStream nextChunk.
-chunkText notNil ifTrue:[
+		chunkText notNil ifTrue:[
-|index headerLine cls|
+		    |index headerLine cls|
-(chunkText startsWith:'''---- timestamp ') ifTrue:[
+		    (chunkText startsWith:'''---- timestamp ') ifTrue:[
-timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
+			timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
-] ifFalse:[
+		    ] ifFalse:[
-"
+			"
-only first line is saved in changeChunks...
+			 only first line is saved in changeChunks...
-"
+			"
-index := chunkText indexOf:(Character cr).
+			index := chunkText indexOf:(Character cr).
-(index ~~ 0) ifTrue:[
+			(index ~~ 0) ifTrue:[
-chunkText := chunkText copyTo:(index - 1).
+			    chunkText := chunkText copyTo:(index - 1).
-"take care for comment changes - must still be a
+			    "take care for comment changes - must still be a
-valid expression for classNameOfChange: to work"
+			     valid expression for classNameOfChange: to work"
-(chunkText endsWith:'comment:''') ifTrue:[
+			    (chunkText endsWith:'comment:''') ifTrue:[
-chunkText := chunkText , '...'''
+				chunkText := chunkText , '...'''
-].
+			    ].
-(chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
+			    (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
-sel := 'primitiveDefinitions:'.
+				sel := 'primitiveDefinitions:'.
-chunkText := chunkText copyWithoutLast:1
+				chunkText := chunkText copyWithoutLast:1
-].
+			    ].
-(chunkText endsWith:'primitiveVariables:''') ifTrue:[
+			    (chunkText endsWith:'primitiveVariables:''') ifTrue:[
-sel := 'primitiveVariables:'.
+				sel := 'primitiveVariables:'.
-chunkText := chunkText copyWithoutLast:1
+				chunkText := chunkText copyWithoutLast:1
-].
+			    ].
-(chunkText endsWith:'primitiveFunctions:''') ifTrue:[
+			    (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
-sel := 'primitiveFunctions:'.
+				sel := 'primitiveFunctions:'.
-chunkText := chunkText copyWithoutLast:1
+				chunkText := chunkText copyWithoutLast:1
-].
+			    ].
-].
+			].
-change chunk: chunkText.
+			change chunk: chunkText.
-change position: chunkPos.
+			change position: chunkPos.
-lastChange notNil ifTrue: [lastChange lastPosition: chunkPos - 1].
+			lastChange notNil ifTrue: [lastChange lastPosition: chunkPos - 1].
-lastChange := change.
+			lastChange := change.
-change timeStamp: timeStampInfo.
+			change timeStamp: timeStampInfo.
-change followUp: false.
+			change followUp: false.
-headerLine := nil.
+			headerLine := nil.
-changeDelta := ' '.
+			changeDelta := ' '.
-sawExcla ifFalse:[
+			sawExcla ifFalse:[
-(chunkText startsWith:'''---- snap') ifTrue:[
+			    (chunkText startsWith:'''---- snap') ifTrue:[
-changeType := ''.
+				changeType := ''.
-headerLine := chunkText.
+				headerLine := chunkText.
-changeString := (chunkText contractTo:maxLen).
+				changeString := (chunkText contractTo:maxLen).
-timeStampInfo := nil.
+				timeStampInfo := nil.
-] ifFalse:[
+			    ] ifFalse:[
-|p cls|
+				|p cls|
-headerLine := chunkText , ' (doIt)'.
+				headerLine := chunkText , ' (doIt)'.
-"
+				"
-first, assume doIt - then lets have a more detailed look...
+				 first, assume doIt - then lets have a more detailed look...
-"
+				"
-((chunkText startsWith:'''---- file')
+				((chunkText startsWith:'''---- file')
-or:[(chunkText startsWith:'''---- check')]) ifTrue:[
+				or:[(chunkText startsWith:'''---- check')]) ifTrue:[
-changeType := ''.
+				    changeType := ''.
-timeStampInfo := nil.
+				    timeStampInfo := nil.
-] ifFalse:[
+				] ifFalse:[
-changeType := 'doIt'.
+				    changeType := 'doIt'.
-].
+				].
-changeString := (chunkText contractTo:maxLen).
+				changeString := (chunkText contractTo:maxLen).
-p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
+				p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
-(p notNil
+				(p notNil
-and:[p ~~ #Error
+				 and:[p ~~ #Error
-and:[p isMessage]]) ifTrue:[
+				 and:[p isMessage]]) ifTrue:[
-sel := p selector.
+				    sel := p selector.
-].
+				].
-(sel == #removeSelector:) ifTrue:[
+				(sel == #removeSelector:) ifTrue:[
-p receiver isUnaryMessage ifTrue:[
+				    p receiver isUnaryMessage ifTrue:[
-cls := p receiver receiver name.
+					cls := p receiver receiver name.
-changeClass := (Smalltalk classNamed:cls) class.
+					changeClass := (Smalltalk classNamed:cls) class.
-cls := cls , ' class'.
+					cls := cls , ' class'.
-] ifFalse:[
+				    ] ifFalse:[
-cls := p receiver name.
+					cls := p receiver name.
-changeClass := (Smalltalk classNamed:cls)
+					changeClass := (Smalltalk classNamed:cls)
-].
+				    ].
-sel := (p args at:1) evaluate.
+				    sel := (p args at:1) evaluate.
-DeltaInfoColumn ifTrue:[
+				    DeltaInfoColumn ifTrue:[
-(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
+					(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
-changeDelta := '?'
+					    changeDelta := '?'
-] ifFalse:[
+					] ifFalse:[
-(changeClass implements:sel asSymbol) ifTrue:[
+					    (changeClass implements:sel asSymbol) ifTrue:[
-changeDelta := '-'.
+						changeDelta := '-'.
-]
+					    ]
-]
+					]
-].
+				    ].
-changeType := 'remove'.
+				    changeType := 'remove'.
-changeString := self contractClass:cls selector:sel to:maxLen.
+				    changeString := self contractClass:cls selector:sel to:maxLen.
-].
+				].
-(p ~~ #Error
+				(p ~~ #Error
-and:[p isMessage
+				and:[p isMessage
-and:[p receiver isMessage
+				and:[p receiver isMessage
-and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
+				and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[
-p receiver receiver isUnaryMessage ifTrue:[
+				    p receiver receiver isUnaryMessage ifTrue:[
-cls := p receiver receiver receiver name.
+					cls := p receiver receiver receiver name.
-changeClass := (Smalltalk classNamed:cls) class.
+					changeClass := (Smalltalk classNamed:cls) class.
-cls := cls , ' class'.
+					cls := cls , ' class'.
-] ifFalse:[
+				    ] ifFalse:[
-cls := p receiver receiver name.
+					cls := p receiver receiver name.
-changeClass := (Smalltalk classNamed:cls)
+					changeClass := (Smalltalk classNamed:cls)
-].
+				    ].
-(sel == #category:) ifTrue:[
+				    (sel == #category:) ifTrue:[
-sel := (p receiver args at:1) evaluate.
+					sel := (p receiver args at:1) evaluate.
-changeType := '(category change)'.
+					changeType := '(category change)'.
-changeString := self contractClass:cls selector:sel to:maxLen.
+					changeString := self contractClass:cls selector:sel to:maxLen.
-].
+				    ].
-(sel == #privacy:) ifTrue:[
+				    (sel == #privacy:) ifTrue:[
-sel := (p receiver args at:1) evaluate.
+					sel := (p receiver args at:1) evaluate.
-changeType := 'privacy change'.
+					changeType := 'privacy change'.
-changeString := self contractClass:cls selector:sel to:maxLen.
+					changeString := self contractClass:cls selector:sel to:maxLen.
-].
+				    ].
-].
+				].
-(#(#'subclass:'
+				(#(#'subclass:'
-#'variableSubclass:'
+				  #'variableSubclass:'
-#'variableByteSubclass:'
+				  #'variableByteSubclass:'
-#'variableWordSubclass:'
+				  #'variableWordSubclass:'
-#'variableLongSubclass:'
+				  #'variableLongSubclass:'
-#'variableFloatSubclass:'
+				  #'variableFloatSubclass:'
-#'variableDoubleSubclass:'
+				  #'variableDoubleSubclass:'
-#'primitiveDefinitions:'
+				  #'primitiveDefinitions:'
-#'primitiveFunctions:'
+				  #'primitiveFunctions:'
-#'primitiveVariables:'
+				  #'primitiveVariables:'
-) includes:sel) ifTrue:[
+				 ) includes:sel) ifTrue:[
-changeType := 'class definition'.
+				    changeType := 'class definition'.
-].
+				].
-]
+			    ]
-] ifTrue:[
+			] ifTrue:[
-|done first p className cls text methodPos|
+			    |done first p className cls text methodPos|
-"
+			    "
-method definitions actually consist of
+			     method definitions actually consist of
-two (or more) chunks; skip next chunk(s)
+			     two (or more) chunks; skip next chunk(s)
-up to an empty one.
+			     up to an empty one.
-The system only writes one chunk,
+			     The system only writes one chunk,
-and we cannot handle more in this ChangesBrowser....
+			     and we cannot handle more in this ChangesBrowser....
-"
+			    "
-className := nil.
+			    className := nil.
-p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
+			    p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
-(p notNil and:[p ~~ #Error]) ifTrue:[
+			    (p notNil and:[p ~~ #Error]) ifTrue:[
-sel := p selector.
+				sel := p selector.
-(sel == #methodsFor:) ifTrue:[
+				(sel == #methodsFor:) ifTrue:[
-p receiver isUnaryMessage ifTrue:[
+				    p receiver isUnaryMessage ifTrue:[
-className := p receiver receiver name.
+					className := p receiver receiver name.
-changeClass := (Smalltalk classNamed:className) class.
+					changeClass := (Smalltalk classNamed:className) class.
-className := className , ' class'.
+					className := className , ' class'.
-] ifFalse:[
+				    ] ifFalse:[
-className := p receiver name.
+					className := p receiver name.
-changeClass := Smalltalk classNamed:className
+					changeClass := Smalltalk classNamed:className
-].
+				    ].
-category := (p args at:1) evaluate.
+				    category := (p args at:1) evaluate.
-].
+				].
-].
+			    ].
-done := false.
+			    done := false.
-first := true.
+			    first := true.
-[done] whileFalse:[
+			    [done] whileFalse:[
-changeDelta := ' '.
+				changeDelta := ' '.
-methodPos := aStream position.
+				methodPos := aStream position.
-text := aStream nextChunk.
+				text := aStream nextChunk.
-text isNil ifTrue:[
+				text isNil ifTrue:[
-done := true
+				    done := true
-] ifFalse:[
+				] ifFalse:[
-done := text isEmpty
+				    done := text isEmpty
-].
+				].
-done ifFalse:[
+				done ifFalse:[
-first ifFalse:[
+				    first ifFalse:[
-change := Change new.
+					change := Change new.
-change chunk: chunkText.
+					change chunk: chunkText.
-change string:changeString.
+					change string:changeString.
-change position: methodPos.
+					change position: methodPos.
-change className: className.
+					change className: className.
-lastChange notNil ifTrue: [lastChange lastPosition: methodPos - 1].
+					lastChange notNil ifTrue: [lastChange lastPosition: methodPos - 1].
-lastChange := change.
+					lastChange := change.
-change timeStamp: timeStampInfo.
+					change timeStamp: timeStampInfo.
-change followUp: true.
+					change followUp: true.
-editingClassSource := true.
+					editingClassSource := true.
-].
+				    ].
-first := false.
+				    first := false.
-"
+				    "
-try to find the selector
+				     try to find the selector
-"
+				    "
-sel := nil.
+				    sel := nil.
-className notNil ifTrue:[
+				    className notNil ifTrue:[
-p := Parser
+					p := Parser
-parseMethodSpecification:text
+						 parseMethodSpecification:text
-in:nil
+						 in:nil
-ignoreErrors:true
+						 ignoreErrors:true
-ignoreWarnings:true.
+						 ignoreWarnings:true.
-(p notNil and:[p ~~ #Error]) ifTrue:[
+					(p notNil and:[p ~~ #Error]) ifTrue:[
-sel := p selector.
+					    sel := p selector.
-]
+					]
-].
+				    ].
-sel isNil ifTrue:[
+				    sel isNil ifTrue:[
-changeString := (chunkText contractTo:maxLen).
+					changeString := (chunkText contractTo:maxLen).
-changeType := 'change'.
+					changeType := 'change'.
-headerLine := chunkText , ' (change)'.
+					headerLine := chunkText , ' (change)'.
-] ifFalse:[
+				    ] ifFalse:[
-changeString :=  self contractClass:className selector:sel to:maxLen.
+					changeString :=  self contractClass:className selector:sel to:maxLen.
-changeType := 'method definition'.
+					changeType := 'method definition'.
-changeCategory := category.
+					changeCategory := category.
-headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
+					headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
-].
+				    ].
-DeltaInfoColumn ifTrue:[
+				    DeltaInfoColumn ifTrue:[
-changeClass isNil ifFalse:[
+					changeClass isNil ifFalse:[
-changeClass isMeta ifTrue:[
+					    changeClass isMeta ifTrue:[
-cls := changeClass soleInstance
+						cls := changeClass soleInstance
-] ifFalse:[
+					    ] ifFalse:[
-cls := changeClass
+						cls := changeClass
-].
+					    ].
-].
+					].
-(changeClass isNil or:[cls isLoaded not]) ifTrue:[
+					(changeClass isNil or:[cls isLoaded not]) ifTrue:[
-changeDelta := '?'
+					    changeDelta := '?'
-] ifFalse:[
+					] ifFalse:[
-(changeClass implements:sel asSymbol) ifFalse:[
+					    (changeClass implements:sel asSymbol) ifFalse:[
-changeDelta := '+'.
+						changeDelta := '+'.
-] ifTrue:[
+					    ] ifTrue:[
-|m currentText t1 t2|
+						|m currentText t1 t2|
-m := changeClass compiledMethodAt:sel asSymbol.
+						m := changeClass compiledMethodAt:sel asSymbol.
-currentText := m source.
+						currentText := m source.
-currentText notNil ifTrue:[
+						currentText notNil ifTrue:[
-text asString = currentText asString ifTrue:[
+						    text asString = currentText asString ifTrue:[
-changeDelta := '='
+							changeDelta := '='
-] ifFalse:[
+						    ] ifFalse:[
-t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
+							t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
-t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
+							t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
-t1 = t2 ifTrue:[
+							t1 = t2 ifTrue:[
-changeDelta := '='
+							    changeDelta := '='
-]
+							]
-]
+						    ]
-]
+						]
-]
+					    ]
-]
+					]
-].
+				    ].
-change delta:changeDelta.
+				    change delta:changeDelta.
-change string:changeString.
+				    change string:changeString.
-change type:changeType.
+				    change type:changeType.
-change category: changeCategory.
+				    change category: changeCategory.
-change timeStamp:timeStampInfo.
+				    change timeStamp:timeStampInfo.
-changes add:change.
+				    changes add:change.
-].
+				].
-changeString := nil.
+				changeString := nil.
-headerLine := nil.
+				headerLine := nil.
-]
+			    ]
-].
+			].
-changeString notNil ifTrue:[
+			changeString notNil ifTrue:[
-change delta:changeDelta.
+			    change delta:changeDelta.
-change string:changeString.
+			    change string:changeString.
-change type:changeType.
+			    change type:changeType.
-change timeStamp:timeStampInfo.
+			    change timeStamp:timeStampInfo.
-changes add:change.
+			    changes add:change.
-] ifFalse:[
+			] ifFalse:[
-headerLine notNil ifTrue:[
+			    headerLine notNil ifTrue:[
-changes add: change.
+				changes add: change.
-]
+			    ]
-]
+			]
-]
+		    ]
-].
+		].
-change lastPosition: aStream position.
+		change lastPosition: aStream position.
-].
+	    ].
-modified := false.
+	    modified := false.
-] valueNowOrOnUnwindDo:[
+	] valueNowOrOnUnwindDo:[
-aStream close.
+	    aStream close.
-inBackground ifTrue:[myProcess priority:myPriority].
+	    inBackground ifTrue:[myProcess priority:myPriority].
-].
+	].
 ].
 self setChangeList.
 self valueOfNotReading value: true.
 self filterField raise.
 self filterLabel label: 'Filter:'.
 |source parser sel|
 source := self sourceOfMethodChange:aChange.
 source isNil ifTrue:[^ nil].
 parser := Parser
 		parseMethod:source
 		in:nil
 		ignoreErrors:true
 		ignoreWarnings:true.
 (parser notNil and:[parser ~~ #Error]) ifTrue:[
 	sel := parser selector.
 ].
 !
 silentDeleteChange:aChange
 "delete aChange do not update changeListView"
 modified := true.
 changes remove:aChange
 !
 silentDeleteChangesFor:aClassName from:start to:stop
 and returns the number of the deleted changes"
 |index numDeleted clsName|
 numDeleted := 0.
 index := stop.
 [index >= start] whileTrue:
 [
 	((clsName := self classNameOfChange:(self listOfChanges at: index)) notNil and:
 	[(clsName = aClassName or: [PrivateAsSeparate not and: [(clsName upTo: $:) = aClassName]])])
 	ifTrue:
 	[
 	    self silentDeleteChange:(self listOfChanges at: index).
 	    numDeleted := numDeleted + 1.
 	].
 	index := index - 1
 ].
 sourceOfMethodChange:aChange
 "returns the source code of the method change, or nil if it is not a method change."
 |aStream chunk sawExcla parseTree sourceChunk|
 aStream := self streamForChange:aChange.
 aStream isNil ifTrue:[^ nil].
 aChange followUp ifFalse:[
 	sawExcla := aStream peekFor:(aStream class chunkSeparator).
 	chunk := aStream nextChunk.
 "just a helper, check for a selected change and evaluate aBlock
 with busy cursor"
 |change|
 (change := self selectionOfChange value) notNil
 ifTrue:[
 	self withExecuteCursorDo:[aBlock value:change]
 ]
 ! !
 "asks for saving before closing"
 self valueOfNotSaving value ifFalse: [^ self].
 modified ifTrue:[
-(OptionBox
+	(OptionBox
-request:(resources string:'Change list was modified. Exit anyway?') withCRs
+	      request:(resources string:'Change list was modified. Exit anyway?') withCRs
-label:'Changes Browser'
+	      label:'Changes Browser'
-form:(WarningBox iconBitmap)
+	      form:(WarningBox iconBitmap)
-buttonLabels:(resources array:#('Cancel' 'Discard Modifications and Exit'))
+	      buttonLabels:(resources array:#('Cancel' 'Discard Modifications and Exit'))
-values:#(abort ignore)
+	      values:#(abort ignore)
-default:#save
+	      default:#save
-) == #abort ifTrue:[^ self].
+	) == #abort ifTrue:[^ self].
 ].
 super closeRequest
 "Modified: / 20.5.1998 / 03:53:47 / cg"
 !
 "starts reading the changes from the file and
 builds entryCompletionBlock for the filterField before opening"
 super postOpenWith:aBuilder.
 builder namedComponents do:
 [:aView|
 	aView allSubViewsDo:
 	[:v|
 	    v redraw
 	]
 ].
 autoUpdateBlock := [self checkIfFileHasChanged].
 Processor addTimedBlock:autoUpdateBlock afterSeconds:5.
 self updateInfoLabel.
 self filterField entryCompletionBlock:
 (filterCompletionBlock := [:value|
 	|filter filters i changesCopy|
 	self unselectChange.
 	filter := self filterField contents.
 	(filters := filter asArrayOfSubstrings) size > 0 ifTrue:
 	[
 	    i := 0.
 	    changesCopy := changes copy.
 	    filters do:
 	    [:filter|
 		i := i + 1.
 		changesCopy contents:
 		    (changesCopy select: [:row|
 			filter match: (row string asArrayOfSubstrings at: i ifAbsent: [''''])])
 	    ].
 	    self listOfChanges contents: changesCopy
 	]
 	ifFalse:
 	[
 	    self listOfChanges contents: changes
 	].
 	self autoSelectLast.
 ]).
 doApplyForClassToEndFrom: start
 "applies changes with same class like the selected one from start to end"
 self withSelectedChangeDo:[:change|
 	|classNameToApply thisClassName lastChange change2|
 	(classNameToApply := self classNameOfChange:change) notNil
 	ifTrue:
 	[
 	    self unselectChange.
 	    skipSignal isNil ifTrue:[skipSignal := Signal new].
 	    start to:self listOfChanges size do:
 	    [:changeNr|
 		change2 := self listOfChanges at: changeNr.
 		((thisClassName := self classNameOfChange:change2) notNil and:
 		[thisClassName = classNameToApply or:
 		[PrivateAsSeparate not and: [(thisClassName upTo: $:) = classNameToApply]]])
 		ifTrue:
 		[
 		    self selectionOfChange value: change2.
 		    self applyChange:change2.
 		    lastChange := change2
 		]
 	    ].
 |className cls isMeta|
 className := self fullClassNameOfChange:self selectionOfChange value.
 className notNil ifTrue:[
-isMeta := false.
+	isMeta := false.
-(className endsWith:' class') ifTrue:[
+	(className endsWith:' class') ifTrue:[
-className := className copyWithoutLast:6.
+	    className := className copyWithoutLast:6.
-isMeta := true.
+	    isMeta := true.
-].
+	].
-(cls := Smalltalk classNamed:className) notNil ifTrue:[
+	(cls := Smalltalk classNamed:className) notNil ifTrue:[
-isMeta ifTrue:[cls := cls class].
+	    isMeta ifTrue:[cls := cls class].
-cls browserClass
+	    cls browserClass
-openInClass:cls
+		openInClass:cls
-selector:(self selectorOfMethodChange:self selectionOfChange value)
+		selector:(self selectorOfMethodChange:self selectionOfChange value)
-]
+	]
 ]
 "Modified: / 26.9.2001 / 17:35:50 / cg"
 !
 |changesSizeBefore|
 (changesSizeBefore := changes size) == 0 ifTrue: [^self warn: 'Nothing to compress!!'].
 self setChangeList.
 self unselectChange.
 self compressForClass:nil.
 self setChangeList.
 self updateInfoLabel.
 self information:
 	'Compression Rate:   ', (((changesSizeBefore - changes size)/changesSizeBefore) * 100) rounded printString, '%\' withCRs,
 	'Obsolete Changes: ', (changesSizeBefore - changes size) printString, ' from ', changesSizeBefore printString
 self withSelectedChangeDo:[:change|
 	|classNameToDelete|
 	(classNameToDelete := self classNameOfChange:change) notNil ifTrue:[
 	    self unselectChange.
 	    self silentDeleteChangesFor:classNameToDelete
 				   from:start
 				     to:self listOfChanges size.
 	    self setChangeList.
 	    self autoSelectOrEnd: nil
 	]
 self listOfChanges detect: [:change| change type = 'image'] ifNone: [^self warn: 'No snapshot found!!'].
 self withSelectedChangeDo:[:change|
 	snapshotNr := self listOfChanges indexOf: change.
 	snapshotFound := false.
 	[snapshotNr > 0 and: [snapshotFound not]]
 	whileTrue:
 	[
 	    what = 'last'
 	    ifTrue:
 	    [
 		snapshotNr := snapshotNr - 1.
 		snapshotNr == 0 ifTrue: [snapshotNr := self listOfChanges size].
 	    ]
 	    ifFalse:
 	    [
 		snapshotNr := snapshotNr + 1.
 		snapshotNr > self listOfChanges size ifTrue: [snapshotNr := 1].
 	    ].
 	    (self listOfChanges at: snapshotNr ifAbsent: [^self autoSelectChange: (what = 'last' ifTrue: [self listOfChanges last] ifFalse: [self listOfChanges first])]) type = 'image'
 	    ifTrue:
 	    [
 		snapshotFound := true.
 		self autoSelectChange:(self listOfChanges at: snapshotNr)
 	    ]
 	]
 !
 doSave
 "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|
 self valueOfNotReading value ifFalse: [^nil].
 editingClassSource ifTrue:[
 	(self confirm:'You are editing a classes sourceFile (not a changeFile) !!\Are you certain, you want to overwrite it ?' withCRs)
 	    self valueOfNotSaving value: false.
 	    excla := inStream class chunkSeparator.
 	    nChanges := changes size.
 	    1 to:nChanges do:[:index |
 		inStream position: (changes at: index) position.
 		sawExcla := inStream peekFor:excla.
 		chunk := inStream nextChunk.
 		(chunk notNil
 			outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
 			outStream nextPut:excla; cr.
 		    ].
 		].
 		sawExcla ifTrue:[
 		    outStream nextPut:excla.
 		    outStream nextChunkPut:chunk.
 		    outStream cr; cr.
 		    "
 		     a method-definition chunk - skip followups
 lastPosition := aValue
 !
 listColor
 (string at: 3) ~~ $- ifTrue:
 [
 	(self type = 'class') ifTrue: [^Color gray].
 	^Color white
 ].
 ! !
 !NewChangesBrowser class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/NewChangesBrowser.st,v 1.28 2003-12-04 11:54:00 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libtool/NewChangesBrowser.st,v 1.29 2005-04-28 17:30:04 cg Exp $'
 ! !

changeset 6288	4767ba5caf5b
parent 5396	d924769c9cc4
child 7957	55841733ff69