"

 COPYRIGHT (c) 1990 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

'From Smalltalk/X, Version:2.10.4 on 26-feb-1995 at 5:18:24 am'!

StandardSystemView subclass:#ChangesBrowser

	 instanceVariableNames:'changeListView codeView changeFileName changeChunks

		changePositions changeClassNames changeHeaderLines anyChanges

		changeNrShown changeNrProcessed skipSignal compareChanges compareCheckBox'

	 classVariableNames:'CompressSnapshotInfo'

	 poolDictionaries:''

	 category:'Interface-Browsers'

!

ChangesBrowser comment:'

COPYRIGHT (c) 1990 by Claus Gittinger

	    All Rights Reserved

'!

!ChangesBrowser class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1990 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    this implements a browser for the changes-file.

    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.

    Notice:

	this needs a total rewrite, to build up a changeSet from the file

	(which did not exist when the ChangesBrowser was 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 ;-)

"

! !

!ChangesBrowser class methodsFor:'instance creation'!

new

    "create a new changes browser"

    ^ super label:'Changes Browser'

	     icon:(Form fromFile:'CBrowser.xbm' resolution:100)

!

openOn:aFileName

    "create c changes browser on a change file"

    ^ ((self new label:'Changes Browser: ', aFileName) changeFileName:aFileName) open

! !

!ChangesBrowser class methodsFor:'behavior'!

autoSelectNext

    "returning true here, makes a Delete operation automatically

     select the next change"

    ^ true

! !

!ChangesBrowser class methodsFor:'defaults'!

defaultLabel

    ^ 'Changes Browser'

! !

!ChangesBrowser methodsFor:'private'!

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

!

autoSelect:changeNr

    "select a change"

    self class autoSelectNext ifTrue:[

	(changeNr <= changePositions size) ifTrue:[

	    changeListView selection:changeNr.

	    self changeSelection:changeNr.

	    ^ self

	]

    ].

    self clearCodeView.

    changeListView selection:nil.

!

clearCodeView

    self unselect "changeListView deselect".

    codeView contents:nil.

    changeNrShown := nil

!

applyChange:changeNr

    "fileIn a change"

    |aStream upd nm|

    aStream := self streamForChange:changeNr.

    aStream isNil ifTrue:[^ self].

    nm := self classNameOfChange:changeNr.

    nm notNil ifTrue:[

	|cls|

	cls := Smalltalk at:(nm asSymbol) ifAbsent:[].

	cls notNil ifTrue:[

	    cls isLoaded ifFalse:[

		cls autoload

	    ]

	]

    ].

    changeNrProcessed := changeNr.

    upd := Class updateChanges:false.

    [

	|sig|

	(skipSignal notNil) ifTrue:[

	    sig := skipSignal

	] ifFalse:[

	    sig := Object abortSignal

	].

	sig catch:[

	    aStream fileInNextChunkNotifying:self

	].

	changeNrProcessed := nil.

    ] valueNowOrOnUnwindDo:[

	Class updateChanges:upd.

	aStream close

    ].

!

unselect

    "common unselect"

    changeListView deselect.

!

setChangeList

    "extract type-information from changes and stuff into top selection

     view"

    changeListView setList:changeHeaderLines expandTabs:false.

    "/ changeListView deselect.

! !

!ChangesBrowser methodsFor:'private'!

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   class/selector

	2   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

	3   type of change

		doit

		method

		category change

     since comparing slows down startup time, it is now disabled by

     default and can be enabled via a toggle.

     "

    |aStream maxLen|

    maxLen := 60.

    aStream := FileStream readonlyFileNamed:changeFileName.

    aStream isNil ifTrue:[^ nil].

    self withCursor:(Cursor read) do:[

	|tabSpec myProcess myPriority|

	tabSpec := TabulatorSpecification new.

	tabSpec unit:#inch.

	tabSpec positions:#(0         4.5       4.65   5.5 ).

	"                   cls>>sel  +/-       type   info"

	tabSpec align:    #(#left     #left     #left  #left).

	"

	 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|

	    changeChunks := OrderedCollection new.

	    changeHeaderLines := OrderedCollection new.

	    changePositions := OrderedCollection new.

	    excla := aStream class chunkSeparator.

	    [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.

		sawExcla := aStream peekFor:excla.

		chunkText := aStream nextChunk.

		chunkText notNil ifTrue:[

		    |index headerLine|

		    "

		     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:[

			    chunkText := chunkText , '... %}'''

			].

			(chunkText endsWith:'primitiveVariables:''%{') ifTrue:[

			    chunkText := chunkText , '... %}'''

			].

			(chunkText endsWith:'primitiveFunctions:''%{') ifTrue:[

			    chunkText := chunkText , '... %}'''

			].

		    ].

		    changeChunks add:chunkText.

		    changePositions add:chunkPos.

		    headerLine := nil.

		    changeDelta := ' '.

		    sawExcla ifFalse:[

			(chunkText startsWith:'''---- snap') ifTrue:[

			    changeType := ''.

			    headerLine := chunkText.

			    changeString := (chunkText contractTo:maxLen).

			] ifFalse:[

			    |p sel cls|

			    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).

			    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.

			    ].

			    (sel == #category:) ifTrue:[

				(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 := (p receiver args at:1) evaluate.

				    changeType := '(category change)'.

				    changeString := self contractClass:cls selector:sel to:maxLen.

				]

			    ].

			    (#(#'subclass:'

			      #'variableSubclass:'

			      #'variableByteSubclass:'

			      #'variableWordSubclass:'

			      #'variableLongSubclass:'

			      #'variableFloatSubclass:'

			      #'variableDoubleSubclass:'

			     ) includes:sel) ifTrue:[

				changeType := '(class definition)'.

			    ].

			].

		    ] ifTrue:[

			|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.

			(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 , ''')'.

				    ].

				    compareChanges ifTrue:[    

					(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[

					    changeDelta := '?'

					] ifFalse:[

					    (changeClass implements:sel asSymbol) ifFalse:[

						changeDelta := '+'.

					    ] ifTrue:[

						|m currentText|

						m := changeClass compiledMethodAt:sel asSymbol.

						currentText := m source.

						currentText notNil ifTrue:[

						    text asString = currentText asString ifTrue:[

							changeDelta := '='

						    ]

						]

					    ]

					]

				    ]

				]

			    ]

			]

		    ].

		    changeString notNil ifTrue:[

			entry := MultiColListEntry new.

			entry tabulatorSpecification:tabSpec.

			entry colAt:1 put:changeString.

			entry colAt:2 put:changeDelta.

			entry colAt:3 put:changeType.

			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].

	].

    ]

!