[Pkg] DeltaStreams: DeltaStreams-Browser-Igor.Stasenko.1.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sun Sep 6 18:58:31 UTC 2009


Igor Stasenko uploaded a new version of DeltaStreams-Browser to project DeltaStreams:
http://www.squeaksource.com/DeltaStreams/DeltaStreams-Browser-Igor.Stasenko.1.mcz

==================== Summary ====================

Name: DeltaStreams-Browser-Igor.Stasenko.1
Author: Igor.Stasenko
Time: 6 September 2009, 9:47:52 am
UUID: c99ae673-1f78-8a45-9f2d-5e82533ae62b
Ancestors: 

initial implementation of DSDeltaInspector

==================== Snapshot ====================

SystemOrganization addCategory: #'DeltaStreams-Browser'!

DSVisitor subclass: #DSDeltaChangeViewer
	instanceVariableNames: 'before change builder'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DeltaStreams-Browser'!

----- Method: DSDeltaChangeViewer>>applyChange: (in category 'dschange dispatch') -----
applyChange: change
	^ 'boom...'!

----- Method: DSDeltaChangeViewer>>applyClassCategoryChanged: (in category 'dschange dispatch') -----
applyClassCategoryChanged: aChange
	^ {
		(self makeTextLabel: 'Class category changed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		builder pluggableTextSpec new
		model:
			(self diffFrom: 
		 		((self getEditorFor: aChange) category: aChange oldCategory; yourself) definition
				to: (self getEditorFor: aChange) definition);
		getText: #value;
		frame: (0 at 0.05 corner: 1 @ 1);
		yourself.

	}!

----- Method: DSDeltaChangeViewer>>applyClassChange: (in category 'dschange dispatch') -----
applyClassChange: aChange
	"Default handler for any class change."
	^ {
		(self makeTextLabel: 'No view for ' , aChange class name)
			frame: (0 at 0 corner: 1 @ 1); yourself.
	}
!

----- Method: DSDeltaChangeViewer>>applyClassCreated: (in category 'dschange dispatch') -----
applyClassCreated: aChange

	^ {
		(self makeTextLabel: 'Class added - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.
			
		builder pluggableCodePaneSpec new
		model: (self getEditorFor: aChange) definition;
		getText: #value;
		frame: (0 at 0.05 corner: 1 @ 1);
		yourself.
		}!

----- Method: DSDeltaChangeViewer>>applyClassInstVarsChanged: (in category 'dschange dispatch') -----
applyClassInstVarsChanged: aChange
	^ {
		(self makeTextLabel: 'ClassInstance variables changed - ',  aChange timeStampString )
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: (
			self diffFrom: ((self getEditorFor: aChange) classSide
					instanceVariableNames: aChange oldVars; yourself) definitionST80
				to: (self getEditorFor: aChange) classSide definitionST80))
			frame: (0 at 0.05 corner: 1 @ 1);
			yourself.
	}!

----- Method: DSDeltaChangeViewer>>applyClassRemoved: (in category 'dschange dispatch') -----
applyClassRemoved: aChange

	^ {
		(self makeTextLabel: 'Class removed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.
			
		builder pluggableCodePaneSpec new
		model: (self getEditorFor: aChange) definition;
		getText: #value;
		frame: (0 at 0.05 corner: 1 @ 1);
		yourself.
	}!

----- Method: DSDeltaChangeViewer>>applyInstVarsChanged: (in category 'dschange dispatch') -----
applyInstVarsChanged: aChange
	^ {
		(self makeTextLabel: 'Instance variables changed - ',  aChange timeStampString )
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: (
			self diffFrom: ((self getEditorFor: aChange) 
					instanceVariableNames: aChange oldVars; yourself) definition 
				to: (self getEditorFor: aChange) definition))
			frame: (0 at 0.05 corner: 1 @ 1);
			yourself.
	}!

----- Method: DSDeltaChangeViewer>>applyMethodAdded: (in category 'dschange dispatch') -----
applyMethodAdded: aChange

	^ {
		(self makeTextLabel: 'Method added - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: aChange stamp, ' - ', aChange protocol)
			frame: (0 at 0.05 corner: 1 @ 0.1); yourself.

		builder pluggableTextSpec new
		model: aChange;
		getText: #source;
		frame: (0 at 0.1 corner: 1 @ 1);
		yourself.

	}!

----- Method: DSDeltaChangeViewer>>applyMethodChange: (in category 'dschange dispatch') -----
applyMethodChange: aChange
	^ {
		(self makeTextLabel: 'No view for ' , aChange class name)
			frame: (0 at 0 corner: 1 @ 1); yourself.
	}
!

----- Method: DSDeltaChangeViewer>>applyMethodProtocolChanged: (in category 'dschange dispatch') -----
applyMethodProtocolChanged: aChange

	^ {
		(self makeTextLabel: 
			'Method protocol changed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: 
			(self diffFrom: aChange stamp, ' - ', aChange oldProtocol to:
			aChange stamp, ' - ', aChange newProtocol))
			frame: (0 at 0.05 corner: 1 @ 0.15); yourself.
	
		
		builder pluggableTextSpec new
			model: aChange;
			getText: #source;
			frame: (0 at 0.15 corner: 1 @ 1);
			yourself.
	}!

----- Method: DSDeltaChangeViewer>>applyMethodRemoved: (in category 'dschange dispatch') -----
applyMethodRemoved: aChange

	^ {
		(self makeTextLabel: 'Method removed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: aChange stamp, ' - ', aChange protocol)
			frame: (0 at 0.05 corner: 1 @ 0.1); yourself.
		
		builder pluggableTextSpec new
		model: aChange;
		getText: #source;
		frame: (0 at 0.1 corner: 1 @ 1);
		yourself.

	}!

----- Method: DSDeltaChangeViewer>>applyMethodSourceChanged: (in category 'dschange dispatch') -----
applyMethodSourceChanged: aChange
	"Change the source of a method"

	^ {
		(self makeTextLabel: 'Method source changed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel: 
			(self diffFrom: aChange oldStamp, ' - ', aChange protocol to:
			aChange newStamp, ' - ', aChange protocol))
			frame: (0 at 0.05 corner: 1 @ 0.15); yourself.
		
		builder pluggableTextSpec new
		model: (self diffFrom: aChange oldSource to: aChange source);
		getText: #value;
		frame: (0 at 0.15 corner: 1 @ 1);
		yourself.
		}
		
	!

----- Method: DSDeltaChangeViewer>>applySuperclassChanged: (in category 'dschange dispatch') -----
applySuperclassChanged: aChange
	"Default handler for any class change."
	| ed |
	ed := self getEditorFor: aChange.
	ed superclass: (ed system ensureClassNamed: aChange oldSuperclassName).
	
	^ {
		(self makeTextLabel: 'Class superclass changed - ', aChange timeStampString)
			frame: (0 at 0 corner: 1 @ 0.05); yourself.

		(self makeTextLabel:
			(self diffFrom: ed definition to: (self getEditorFor: aChange) definition))			
		frame: (0 at 0.05 corner: 1 @ 1);
		yourself.

	}!

----- Method: DSDeltaChangeViewer>>buildViewOf:using: (in category 'as yet unclassified') -----
buildViewOf: aChange using: aBuilder

	builder := aBuilder.
	^ aChange applyUsing: self.!

----- Method: DSDeltaChangeViewer>>diffFrom:to: (in category 'as yet unclassified') -----
diffFrom: oldStr to: newStr
	^ TextDiffBuilder 
		buildDisplayPatchFrom: oldStr to: newStr!

----- Method: DSDeltaChangeViewer>>getEditorFor: (in category 'as yet unclassified') -----
getEditorFor: change

	| superclassEditor classEditor |
	superclassEditor := SystemEditor new ensureClassNamed: change superclassName.
	
	classEditor := superclassEditor 
			subclass: change className
			instanceVariableNames: change instVarNames asSpaceString
			classVariableNames: change classVarNames asSpaceString
			poolDictionaries: change poolDictionaryNames asSpaceString
			category: change category.

	classEditor typeOfClass: change type.
	classEditor class instanceVariableNames: change classInstVarNames asSpaceString.
	classEditor classComment: change comment stamp: change stamp.

	^ classEditor!

----- Method: DSDeltaChangeViewer>>makeLabel (in category 'as yet unclassified') -----
makeLabel
	^ builder pluggableInputFieldSpec new
		model: self;
		yourself!

----- Method: DSDeltaChangeViewer>>makeTextLabel: (in category 'as yet unclassified') -----
makeTextLabel: aString

	^ self makeLabel model: aString; getText: #value;
		yourself.
!

Object subclass: #DSDeltaInspector
	instanceVariableNames: 'subject changeSelected displayBefore chViewer rightPane'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DeltaStreams-Browser'!

----- Method: DSDeltaInspector class>>buildOn: (in category 'as yet unclassified') -----
buildOn: aDelta
	^ ToolBuilder build: (self new subject: aDelta)!

----- Method: DSDeltaInspector class>>openOn: (in category 'as yet unclassified') -----
openOn: aDelta
	| i m |
	i := self new subject: aDelta.
	m := ToolBuilder build: i.
	i applyLayoutTo: m.
.
	^ m openInWorld!

----- Method: DSDeltaInspector>>applyLayoutTo: (in category 'layout') -----
applyLayoutTo: morph
	morph layoutPolicy: self!

----- Method: DSDeltaInspector>>buildChangesListWith: (in category 'building') -----
buildChangesListWith: builder

	^ builder pluggableListSpec new
		model: self;
		name: #changes;
		list: #changeList;
		getIndex: #changeSelected;
		setIndex: #changeSelected: ;
		yourself!

----- Method: DSDeltaInspector>>buildRightPane (in category 'building') -----
buildRightPane
	| change builder |
	builder := ToolBuilder default.
	change := self currentChange.
	change ifNotNil: [ 
		builder buildAll: (DSDeltaChangeViewer new buildViewOf: change using: builder)
			in: rightPane ]!

----- Method: DSDeltaInspector>>buildWith: (in category 'building') -----
buildWith: builder
	| spec window |
	
	spec := builder pluggableWindowSpec new
		model: self; label: (subject class name, ' ' , subject name);
		children: {
			(self buildChangesListWith: builder) 
				frame:(0 @ 0 corner: 0.5 @ 1 );
				yourself.
			builder pluggablePanelSpec new
				children: #();
				name: #rightPane;
				frame:(0.5 @ 0 corner: 1 @ 1 );
				yourself
		}.
	
	window := builder build: spec.
	rightPane := builder widgetAt: #rightPane.
	^window!

----- Method: DSDeltaInspector>>changeList (in category 'as yet unclassified') -----
changeList
	^ subject changes!

----- Method: DSDeltaInspector>>changeSelected (in category 'as yet unclassified') -----
changeSelected

	changeSelected ifNil: [ changeSelected := 0 ].
	^ changeSelected!

----- Method: DSDeltaInspector>>changeSelected: (in category 'as yet unclassified') -----
changeSelected: index
	changeSelected := index.
	self 
		changed: #changeSelected.

	rightPane removeAllMorphs.
	self buildRightPane.!

----- Method: DSDeltaInspector>>currentChange (in category 'as yet unclassified') -----
currentChange
	^ changeSelected = 0 ifTrue: [ nil ]
		ifFalse: [ self changeList at: changeSelected ]!

----- Method: DSDeltaInspector>>flushLayoutCache (in category 'as yet unclassified') -----
flushLayoutCache!

----- Method: DSDeltaInspector>>initialize (in category 'as yet unclassified') -----
initialize
	chViewer := DSDeltaChangeViewer new!

----- Method: DSDeltaInspector>>layout:in: (in category 'layout') -----
layout: aMorph in: newBounds

	"Compute the layout for the given morph based on the new bounds"
	aMorph submorphsDo:[:m| m layoutProportionallyIn: newBounds].!

----- Method: DSDeltaInspector>>subject (in category 'as yet unclassified') -----
subject
	^ subject!

----- Method: DSDeltaInspector>>subject: (in category 'as yet unclassified') -----
subject: aDelta
	subject := aDelta!



More information about the Packages mailing list