Random changes during ESUG + visual debugger demo.

OpenPonk · Sep 11, 2017 · c3e898f · c3e898f
1 parent 769ef0d
commit c3e898f
Show file tree

Hide file tree

Showing 42 changed files with 223 additions and 14 deletions.
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugSession.class/README.md b/repository/LiveInstanceVisualization.package/LIVDebugSession.class/README.md
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugSession.class/class/modelHistory..st b/repository/LiveInstanceVisualization.package/LIVDebugSession.class/class/modelHistory..st
@@ -0,0 +1,3 @@
+accessing
+modelHistory: aHistory
+	modelHistory := aHistory
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugSession.class/class/modelHistory.st b/repository/LiveInstanceVisualization.package/LIVDebugSession.class/class/modelHistory.st
@@ -0,0 +1,3 @@
+accessing
+modelHistory
+	^ modelHistory
diff --git a/...tory/LiveInstanceVisualization.package/LIVDebugSession.class/instance/process.context..st b/...tory/LiveInstanceVisualization.package/LIVDebugSession.class/instance/process.context..st
@@ -0,0 +1,4 @@
+initialization
+process: aProcess context: aContext
+
+	super process: aProcess context: aContext
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugSession.class/properties.json b/repository/LiveInstanceVisualization.package/LIVDebugSession.class/properties.json
@@ -0,0 +1,13 @@
+{
+	"commentStamp" : "",
+	"super" : "DebugSession",
+	"category" : "LiveInstanceVisualization-Debugger",
+	"classinstvars" : [
+		"modelHistory"
+	],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "LIVDebugSession",
+	"type" : "normal"
+}
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/README.md b/repository/LiveInstanceVisualization.package/LIVDebugger.class/README.md
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/defaultTitle.st b/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/defaultTitle.st
@@ -0,0 +1,3 @@
+accessing
+defaultTitle
+	^ 'LIV Debugger'
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/register.st b/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/register.st
@@ -0,0 +1,4 @@
+accessing
+register
+
+	self registerToolsOn: Smalltalk tools.
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/registerToolsOn..st b/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/registerToolsOn..st
@@ -0,0 +1,5 @@
+accessing
+registerToolsOn: registry
+
+	"Add ourselves to registry. See [Smalltalk tools]" 
+	registry registerDebugger: self withRank: 10.
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/sessionClass.st b/repository/LiveInstanceVisualization.package/LIVDebugger.class/class/sessionClass.st
@@ -0,0 +1,3 @@
+accessing
+sessionClass
+	^ LIVDebugSession
diff --git a/...tory/LiveInstanceVisualization.package/LIVDebugger.class/instance/debuggerStructureIn..st b/...tory/LiveInstanceVisualization.package/LIVDebugger.class/instance/debuggerStructureIn..st
@@ -0,0 +1,9 @@
+building
+debuggerStructureIn: browser
+
+	browser
+		row: #stack;
+		row: [ :c | c
+			column: #code;
+			column: #view ] span: 2;
+		row: #inspector.
diff --git a/.../LiveInstanceVisualization.package/LIVDebugger.class/instance/debuggerTransmissionsIn..st b/.../LiveInstanceVisualization.package/LIVDebugger.class/instance/debuggerTransmissionsIn..st
@@ -0,0 +1,9 @@
+building
+debuggerTransmissionsIn: browser
+	super debuggerTransmissionsIn: browser.
+	browser transmit
+		from: #stack port: #selection;
+		to: #view;
+		andShow: [ :composite :aContext | 
+			self liveViewIn: composite forContext: aContext.
+			self modelHistoryIn: composite forContext: aContext ]
diff --git a/...ry/LiveInstanceVisualization.package/LIVDebugger.class/instance/liveViewIn.forContext..st b/...ry/LiveInstanceVisualization.package/LIVDebugger.class/instance/liveViewIn.forContext..st
@@ -0,0 +1,9 @@
+building
+liveViewIn: composite forContext: aContext
+	| history |
+	history := self class sessionClass modelHistory.
+	history ifNil: [ ^ self ].
+	history models ifEmpty: [ ^ self ].
+	(history models last gtInspectorModelViewIn: composite)
+		onChangeOfPort: #selection act: [ :historyPresentation | 
+			self inspect: historyPresentation selection ]
diff --git a/...iveInstanceVisualization.package/LIVDebugger.class/instance/modelHistoryIn.forContext..st b/...iveInstanceVisualization.package/LIVDebugger.class/instance/modelHistoryIn.forContext..st
@@ -0,0 +1,6 @@
+building
+modelHistoryIn: composite forContext: aContext
+	| history |
+	history := self class sessionClass modelHistory.
+	history ifNil: [ ^ self ].
+	history gtInspectorModelViewIn: composite
diff --git a/...iveInstanceVisualization.package/LIVDebugger.class/instance/transmitFromStackToCodeIn..st b/...iveInstanceVisualization.package/LIVDebugger.class/instance/transmitFromStackToCodeIn..st
@@ -0,0 +1,9 @@
+building
+transmitFromStackToCodeIn: browser
+	super transmitFromStackToCodeIn: browser
+"	browser transmit
+		from: #stack port: #selection;
+		to: #code;
+		andShow: [ :composite :aContext | 
+			self methodCodeIn: composite forContext: aContext.
+			self liveViewIn: composite forContext: aContext]"
diff --git a/repository/LiveInstanceVisualization.package/LIVDebugger.class/properties.json b/repository/LiveInstanceVisualization.package/LIVDebugger.class/properties.json
@@ -0,0 +1,11 @@
+{
+	"commentStamp" : "",
+	"super" : "GTGenericStackDebugger",
+	"category" : "LiveInstanceVisualization-Debugger",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "LIVDebugger",
+	"type" : "normal"
+}
diff --git a/...nceVisualization.package/LIVExpandableCallGraphVisualization.class/instance/initialize.st b/...nceVisualization.package/LIVExpandableCallGraphVisualization.class/instance/initialize.st
@@ -1,4 +1,4 @@
-as yet unclassified
+initialization
 initialize
 	super initialize.
 	mondrian := RTMondrian new
diff --git a/...ceVisualization.package/LIVExpandableCallGraphVisualization.class/instance/view.class..st b/...ceVisualization.package/LIVExpandableCallGraphVisualization.class/instance/view.class..st
@@ -20,4 +20,5 @@ view: aView class: aClassDescription
 	b layout horizontalDominanceTree
 		verticalGap: 40;
 		horizontalGap: 70.
+	b view @ RTZoomableView.
 	b build
diff --git a/...InstanceVisualization.package/LIVInstanceDiffColorer.class/instance/colorAdditions.in..st b/...InstanceVisualization.package/LIVInstanceDiffColorer.class/instance/colorAdditions.in..st
@@ -7,13 +7,13 @@ colorAdditions: aCollection in: aView
 		do: [ :el | 
 			| fig |
 			fig := el model.
-			fig sharedStyle fillColor: Color green muchLighter.
+			fig style fillColor: Color green muchLighter.
 			fig update.
 			fig sourceEdges , fig targetEdges
 				do: [ :each | 
 					each ownedElements
 						do: [ :lbl | 
-							lbl sharedStyle fontColor: Color green muchDarker.
+							lbl style fontColor: Color green muchDarker.
 							lbl update ].
 					each localStyle strokeColor: Color green muchDarker.
 					each update ] ]
diff --git a/...anceVisualization.package/LIVInstanceDiffColorer.class/instance/colorModifications.in..st b/...anceVisualization.package/LIVInstanceDiffColorer.class/instance/colorModifications.in..st
@@ -14,14 +14,14 @@ colorModifications: aDictionary in: aView
 					subFigs
 						detect: [ :each | each modelElement = key ]
 						ifFound: [ :each | 
-							each sharedStyle fontColor: Color green muchDarker.
+							each style fontColor: Color green muchDarker.
 							each update ] ].
 			(dict at: #modified)
 				keysAndValuesDo: [ :key :value | 
 					subFigs
 						detect: [ :each | each modelElement = key ]
 						ifFound: [ :each | 
-							each sharedStyle fontColor: Color blue.
+							each style fontColor: Color blue.
 							each update ].
 					aView edges
 						detect: [ :each | 
@@ -31,7 +31,7 @@ colorModifications: aDictionary in: aView
 							each model ownedElements
 								detect: [ :lbl | lbl modelElement = key ]
 								ifFound: [ :lbl | 
-									lbl sharedStyle fontColor: Color blue.
+									lbl style fontColor: Color blue.
 									lbl update ].
 							each model localStyle strokeColor: Color blue.
 							each model update ] ] ]
diff --git a/...eInstanceVisualization.package/LIVInstanceDiffColorer.class/instance/colorRemovals.in..st b/...eInstanceVisualization.package/LIVInstanceDiffColorer.class/instance/colorRemovals.in..st
@@ -7,5 +7,5 @@ colorRemovals: aCollection in: aView
 		do: [ :el | 
 			| fig |
 			fig := el model.
-			fig sharedStyle fillColor: Color red muchLighter.
+			fig style fillColor: Color red muchLighter.
 			fig update ]
diff --git a/.../LiveInstanceVisualization.package/LIVInstanceHistory.class/instance/filterDuplicates..st b/.../LiveInstanceVisualization.package/LIVInstanceHistory.class/instance/filterDuplicates..st
@@ -0,0 +1,13 @@
+as yet unclassified
+filterDuplicates: aCollection
+	| filtered |
+	aCollection ifEmpty: [ ^ aCollection ].
+	filtered := OrderedCollection new.
+	filtered add: aCollection first.
+	aCollection allButFirst
+		do: [ :model | 
+			| diff |
+			diff := LIVInstanceModelDiff new diffBetween: model and: filtered last.
+			(self isEmptyDiffBetween: model and: filtered last)
+				ifFalse: [ filtered add: model ] ].
+	^ filtered
diff --git a/...nstanceVisualization.package/LIVInstanceHistory.class/instance/gtInspectorModelViewIn..st b/...nstanceVisualization.package/LIVInstanceHistory.class/instance/gtInspectorModelViewIn..st
@@ -0,0 +1,10 @@
+as yet unclassified
+gtInspectorModelViewIn: composite
+	<gtInspectorPresentationOrder: 1>
+	^composite fastTable
+		title: 'Models';
+		display: [ self filterDuplicates: self models ];
+		enableElementIndex;
+		column: 'Index' evaluated: [ :value :index | index asString ] width: 40;
+		column: 'Model' evaluated: [ :value | value asString ];
+		column: 'Elements' evaluated: [ :value | value elements size ]
diff --git a/...nstanceVisualization.package/LIVInstanceHistory.class/instance/isEmptyDiffBetween.and..st b/...nstanceVisualization.package/LIVInstanceHistory.class/instance/isEmptyDiffBetween.and..st
@@ -0,0 +1,12 @@
+testing
+isEmptyDiffBetween: a and: b
+	| diff |
+	diff := LIVInstanceModelDiff new diffBetween: a and: b.
+	(diff at: #added) ifNotEmpty: [ ^ false ].
+	(diff at: #removed) ifNotEmpty: [ ^ false ].
+	(diff at: #modified) values
+		do: [ :each | 
+			(each at: #added) ifNotEmpty: [ ^ false ].
+			(each at: #removed) ifNotEmpty: [ ^ false ].
+			(each at: #modified) ifNotEmpty: [ ^ false ] ].
+	^ true
diff --git a/...ceVisualization.package/LIVInstanceModel.class/instance/applyFocusedLayoutIn.on.focus..st b/...ceVisualization.package/LIVInstanceModel.class/instance/applyFocusedLayoutIn.on.focus..st
@@ -0,0 +1,27 @@
+roassal - drawing
+applyFocusedLayoutIn: aView on: shapes focus: aFocus
+	| distance circles els enableCircles |
+	distance := 400.
+	enableCircles := true.
+	enableCircles
+		ifTrue: [ (aView hasAttribute: #circles)
+				ifTrue: [ circles := aView attributeAt: #circles ]
+				ifFalse: [ circles := RTEllipse new
+						color: Color transparent;
+						borderWidth: 1;
+						borderColor: Color red;
+						size: [ :m | distance * m ];
+						elementsOn: (1 to: 4).
+					aView addAll: circles.
+					circles do: [ :each | each trachelShape pushBack ].
+					circles translateTo: aFocus position.
+					aView attributeAt: #circles put: circles ] ].
+	els := shapes.
+	enableCircles
+		ifTrue: [ RTSmoothLayoutTranslator new
+				nbCycles: 1;
+				translate: circles to: aFocus position ].
+	LaFocusedRadialLayout new
+		radius: distance / 2;
+		setFocus: aFocus nodes: els edges: #();
+		apply
diff --git a/...veInstanceVisualization.package/LIVInstanceModel.class/instance/gtInspectorElementsIn..st b/...veInstanceVisualization.package/LIVInstanceModel.class/instance/gtInspectorElementsIn..st
@@ -0,0 +1,9 @@
+as yet unclassified
+gtInspectorElementsIn: composite
+	<gtInspectorPresentationOrder: 1>
+	composite fastTable
+		title: 'Elements';
+		display: [ self elements ];
+		enableElementIndex;
+		column: 'Index' evaluated: [ :value :index | index asString ] width: 40;
+		column: 'Element' evaluated: [ :value | value asString ]
diff --git a/...eInstanceVisualization.package/LIVInstanceModel.class/instance/gtInspectorModelViewIn..st b/...eInstanceVisualization.package/LIVInstanceModel.class/instance/gtInspectorModelViewIn..st
@@ -1,11 +1,13 @@
 inspector - extensions
 gtInspectorModelViewIn: composite
 	<gtInspectorPresentationOrder: -1>
-	composite roassal2
+	^ composite roassal2
 		title: '[LIV] Instance Model';
 		initializeView: [ | v |
 			v := RTView new.
+			OPUMLRTInteractiveViewContext setOnView: v.
 			self renderIn: v.
 			self showDiffIn: v.
 			v @ RTDraggableView @ RTZoomableView.
-			v ]
+			v ];
+	yourself
diff --git a/repository/LiveInstanceVisualization.package/LIVInstanceModel.class/instance/renderIn..st b/repository/LiveInstanceVisualization.package/LIVInstanceModel.class/instance/renderIn..st
@@ -5,8 +5,11 @@ renderIn: aView
 	shapes
 		do: [ :each | 
 			each renderIn: aView.
+			each rtElement
+				when: TRMouseRightClick
+				do: [ :evt | self applyFocusedLayoutIn: aView on: (shapes collect: #rtElement) focus: evt element ].
 			each rtElement when: TRMouseLeftClick do: [ :evt |  ].
-			self addMenuFor: each.
+"			self addMenuFor: each."
 			each rtElement @ RTResizable @ RTDraggable ].
 	shapes do: [ :each | self renderShape: each fromShapes: shapes in: aView ].
 	RTHorizontalFlowLayout new

diff --git a/...tory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/asShape.st b/...tory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/asShape.st
@@ -2,6 +2,7 @@ converting
 asShape
 	| el lbl comp compLbl |
 	el := OPUmlCompartmentableShape new.
+"	el localStyle: style."
 	el modelElement: self.
 	lbl := OPUmlTypedElementLabel new.
 	lbl

diff --git a/...tanceVisualization.package/LIVInstanceSpecification.class/instance/gtInspectorSlotsIn..st b/...tanceVisualization.package/LIVInstanceSpecification.class/instance/gtInspectorSlotsIn..st
@@ -0,0 +1,4 @@
+as yet unclassified
+gtInspectorSlotsIn: composite
+	<gtInspectorPresentationOrder: 1>
+	(self slots gtInspectorItemsIn: composite) title: 'Slots'
diff --git a/...stanceVisualization.package/LIVInstanceSpecification.class/instance/gtInspectorViewIn..st b/...stanceVisualization.package/LIVInstanceSpecification.class/instance/gtInspectorViewIn..st
@@ -0,0 +1,11 @@
+ui
+gtInspectorViewIn: composite
+	<gtInspectorPresentationOrder: 1>
+	composite roassal2
+		title: 'Instance';
+		initializeView: [ | v |
+			v := RTView new.
+			OPUMLRTInteractiveViewContext setOnView: v.
+			self asShape renderIn: v.
+			v @ RTDraggableView @ RTZoomableView.
+			v ]
diff --git a/...y/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/initialize.st b/...y/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/initialize.st
@@ -1,4 +1,8 @@
 initialization
 initialize
 	super initialize.
-	slots := OrderedDictionary new
+	slots := OrderedDictionary new.
+"	style := OPUmlStyle new
+		fillColor: Color veryVeryLightGray;
+		strokeColor: Color black;
+		strokeWidth: 1"
diff --git a/...itory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/style..st b/...itory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/style..st
@@ -0,0 +1,3 @@
+accessing
+style: aStyle
+"	style := aStyle"
diff --git a/...sitory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/style.st b/...sitory/LiveInstanceVisualization.package/LIVInstanceSpecification.class/instance/style.st
@@ -0,0 +1,3 @@
+accessing
+style
+	^ style
diff --git a/repository/LiveInstanceVisualization.package/LIVInstanceSpecification.class/properties.json b/repository/LiveInstanceVisualization.package/LIVInstanceSpecification.class/properties.json
@@ -9,7 +9,8 @@
 		"name",
 		"classifier",
 		"slots",
-		"instanceHash"
+		"instanceHash",
+		"style"
 	],
 	"name" : "LIVInstanceSpecification",
 	"type" : "normal"

diff --git a/...nstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/initialize.st b/...nstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/initialize.st
@@ -2,4 +2,8 @@ initialization
 initialize
 	super initialize.
 	name := nil.
-	slots := OrderedDictionary new
+	slots := OrderedDictionary new.
+	style := OPUmlStyle new
+		fillColor: Color veryVeryLightGray;
+		strokeColor: Color black;
+		strokeWidth: 1
diff --git a/...stanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/instanceOn..st b/...stanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/instanceOn..st
@@ -2,6 +2,7 @@ as yet unclassified
 instanceOn: anObject
 	| model |
 	model := self newModel.
+	model style: style.
 	model classifier: anObject class.
 	model instanceHash: anObject hash.
 	name ifNotNil: [ model name: (name cull: anObject) ].

diff --git a/...iveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/style..st b/...iveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/style..st
@@ -0,0 +1,3 @@
+accessing
+style: anObject
+	style := anObject
diff --git a/...LiveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/style.st b/...LiveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/instance/style.st
@@ -0,0 +1,3 @@
+accessing
+style
+	^ style
diff --git a/...y/LiveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/properties.json b/...y/LiveInstanceVisualization.package/LIVInstanceSpecificationBuilder.class/properties.json
@@ -8,7 +8,8 @@
 	"instvars" : [
 		"name",
 		"slots",
-		"classifier"
+		"classifier",
+		"style"
 	],
 	"name" : "LIVInstanceSpecificationBuilder",
 	"type" : "normal"