From e40934e09735c3ae83b98ee0f234d8990e28e064 Mon Sep 17 00:00:00 2001
From: Tom Beckmann <tomjonabc@gmail.com>
Date: Tue, 26 Sep 2023 16:57:40 +0200
Subject: [PATCH] dc: add draft for ast diffing, ported from gumtree

---
 .squot                                        |   4 +-
 packages/DomainCode-Core/.squot-contents      |   6 +
 .../DomainCode-Core/DCFileEditor.class.st     |  34 +++
 packages/DomainCode-Core/DCProject.class.st   |  54 +++++
 .../DomainCode-Core/DCProjectView.class.st    |  45 ++++
 packages/DomainCode-Core/DCQuery.class.st     |  54 +++++
 packages/DomainCode-Core/DCWorkspace.class.st |  46 ++++
 .../DomainCode-Core/FSReference.extension.st  |   7 +
 packages/DomainCode-Core/Object.extension.st  |  44 ++++
 packages/DomainCode-Core/package.st           |   1 +
 packages/DomainCode-Diff/.squot-contents      |   6 +
 .../DCChawatheScriptGenerator.class.st        | 119 ++++++++++
 .../DCGreedyBottomUpMatcher.class.st          |  66 ++++++
 .../DCGreedySubtreeMatcher.class.st           |  58 +++++
 .../DCHashBasedMapper.class.st                |  53 +++++
 .../DCMappingComparator.class.st              | 208 ++++++++++++++++++
 .../DomainCode-Diff/DCMappingStore.class.st   |  76 +++++++
 packages/DomainCode-Diff/DCMatchTest.class.st |  23 ++
 packages/DomainCode-Diff/DCMatcher.class.st   |  14 ++
 .../DCPriorityTreeQueue.class.st              |  98 +++++++++
 ...SimplifiedChawatheScriptGenerator.class.st |   5 +
 .../DCZhangShashaMatcher.class.st             | 143 ++++++++++++
 .../DCZhangShashaMatcherTest.class.st         |  17 ++
 .../DCZhangShashaTree.class.st                |  70 ++++++
 packages/DomainCode-Diff/String.extension.st  |  33 +++
 packages/DomainCode-Diff/package.st           |   1 +
 packages/DomainCode-Parser/DCBlock.class.st   |  72 ++++--
 .../DomainCode-Parser/DCEditTest.class.st     |  30 +++
 packages/DomainCode-Parser/DCText.class.st    |  24 ++
 packages/DomainCode-Parser/DCUnknown.class.st |   6 +
 .../SBTSSmalltalk.class.st                    |   8 +-
 .../Sandblocks-TreeSitter/Morph.extension.st  |  13 ++
 .../Sandblocks-TreeSitter/SBFileTree.class.st |  27 ++-
 .../SBTypescript.class.st                     |   7 +
 34 files changed, 1449 insertions(+), 23 deletions(-)
 create mode 100644 packages/DomainCode-Core/.squot-contents
 create mode 100644 packages/DomainCode-Core/DCFileEditor.class.st
 create mode 100644 packages/DomainCode-Core/DCProject.class.st
 create mode 100644 packages/DomainCode-Core/DCProjectView.class.st
 create mode 100644 packages/DomainCode-Core/DCQuery.class.st
 create mode 100644 packages/DomainCode-Core/DCWorkspace.class.st
 create mode 100644 packages/DomainCode-Core/FSReference.extension.st
 create mode 100644 packages/DomainCode-Core/Object.extension.st
 create mode 100644 packages/DomainCode-Core/package.st
 create mode 100644 packages/DomainCode-Diff/.squot-contents
 create mode 100644 packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
 create mode 100644 packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
 create mode 100644 packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
 create mode 100644 packages/DomainCode-Diff/DCHashBasedMapper.class.st
 create mode 100644 packages/DomainCode-Diff/DCMappingComparator.class.st
 create mode 100644 packages/DomainCode-Diff/DCMappingStore.class.st
 create mode 100644 packages/DomainCode-Diff/DCMatchTest.class.st
 create mode 100644 packages/DomainCode-Diff/DCMatcher.class.st
 create mode 100644 packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
 create mode 100644 packages/DomainCode-Diff/DCSimplifiedChawatheScriptGenerator.class.st
 create mode 100644 packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
 create mode 100644 packages/DomainCode-Diff/DCZhangShashaMatcherTest.class.st
 create mode 100644 packages/DomainCode-Diff/DCZhangShashaTree.class.st
 create mode 100644 packages/DomainCode-Diff/String.extension.st
 create mode 100644 packages/DomainCode-Diff/package.st

diff --git a/.squot b/.squot
index 741e460..3bb2218 100644
--- a/.squot
+++ b/.squot
@@ -20,5 +20,7 @@ OrderedDictionary {
 	'packages/Sandblocks-Kotlin' : #SquotTonelSerializer,
 	'packages/Sandblocks-Cpp' : #SquotTonelSerializer,
 	'packages/Sandblocks-Wing' : #SquotTonelSerializer,
-	'packages/DomainCode-Parser' : #SquotTonelSerializer
+	'packages/DomainCode-Parser' : #SquotTonelSerializer,
+	'packages/DomainCode-Core' : #SquotTonelSerializer,
+	'packages/DomainCode-Diff' : #SquotTonelSerializer
 }
\ No newline at end of file
diff --git a/packages/DomainCode-Core/.squot-contents b/packages/DomainCode-Core/.squot-contents
new file mode 100644
index 0000000..130376e
--- /dev/null
+++ b/packages/DomainCode-Core/.squot-contents
@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ 'b0f8b91f48b140dab0d584ce30237423' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotTonelSerializer
+}
\ No newline at end of file
diff --git a/packages/DomainCode-Core/DCFileEditor.class.st b/packages/DomainCode-Core/DCFileEditor.class.st
new file mode 100644
index 0000000..05e210e
--- /dev/null
+++ b/packages/DomainCode-Core/DCFileEditor.class.st
@@ -0,0 +1,34 @@
+Class {
+	#name : #DCFileEditor,
+	#superclass : #SBBlock,
+	#instVars : [
+		'file'
+	],
+	#category : #'DomainCode-Core'
+}
+
+{ #category : #'as yet unclassified' }
+DCFileEditor >> file: aFile [
+
+	file := aFile.
+	
+	self
+		changeTableLayout;
+		hResizing: #spaceFill;
+		vResizing: #spaceFill;
+		addMorphBack: (ScrollPane new
+			hResizing: #spaceFill;
+			vResizing: #spaceFill;
+			hScrollBarPolicy: #never;
+			in: [:scroll |
+				scroll scroller
+					changeTableLayout;
+					hResizing: #spaceFill;
+					addMorphBack: ((SBTSFile languageForPathAskInstall: aFile basename)
+						ifNotNil: [:language |
+							(DCBlock parseBlock: file contents language: language)
+								hResizing: #spaceFill;
+								vResizing: #shrinkWrap]
+						ifNil: [self shouldBeImplemented])];
+			yourself)
+]
diff --git a/packages/DomainCode-Core/DCProject.class.st b/packages/DomainCode-Core/DCProject.class.st
new file mode 100644
index 0000000..bfd5e28
--- /dev/null
+++ b/packages/DomainCode-Core/DCProject.class.st
@@ -0,0 +1,54 @@
+Class {
+	#name : #DCProject,
+	#superclass : #SBBlock,
+	#instVars : [
+		'directory',
+		'name'
+	],
+	#category : #'DomainCode-Core'
+}
+
+{ #category : #'as yet unclassified' }
+DCProject >> directory [
+
+	^ directory
+]
+
+{ #category : #'as yet unclassified' }
+DCProject >> directory: aDirectory [
+
+	directory := aDirectory asFSReference.
+	
+	self
+		removeAllMorphs;
+		changeTableLayout;
+		hResizing: #shrinkWrap;
+		vResizing: #shrinkWrap;
+		listDirection: #leftToRight;
+		addMorphBack: (name := SBTextBubble new contents: directory basename);
+		addMorphBack: (SBButton new icon: SBIcon iconFolderOpen do: [self addProp: #open])
+]
+
+{ #category : #'as yet unclassified' }
+DCProject >> domainParent [
+
+	^ self owner owner
+]
+
+{ #category : #'as yet unclassified' }
+DCProject >> domainReferencesDo: aClosure [
+
+	aClosure value: self directory
+]
+
+{ #category : #'as yet unclassified' }
+DCProject >> name [
+
+	^ name contents
+]
+
+{ #category : #'as yet unclassified' }
+DCProject >> name: aString [
+
+	name contents: aString
+]
diff --git a/packages/DomainCode-Core/DCProjectView.class.st b/packages/DomainCode-Core/DCProjectView.class.st
new file mode 100644
index 0000000..c691d43
--- /dev/null
+++ b/packages/DomainCode-Core/DCProjectView.class.st
@@ -0,0 +1,45 @@
+Class {
+	#name : #DCProjectView,
+	#superclass : #SBBlock,
+	#instVars : [
+		'files'
+	],
+	#category : #'DomainCode-Core'
+}
+
+{ #category : #'as yet unclassified' }
+DCProjectView class >> queryOpenProject: aRoot [
+	<domainQuery>
+
+	aRoot
+		queryFirst: [:obj | obj class = DCProject and: [obj hasProp: #open]]
+		ifFound: [:match | aRoot sandblockEditor openMorphInView: (self new project: match)]
+		ifNone: []
+]
+
+{ #category : #'as yet unclassified' }
+DCProjectView >> openFile: aFile [
+
+	self submorphCount > 1 ifTrue: [self lastSubmorph delete].
+	self addMorphBack: (DCFileEditor new file: aFile)
+]
+
+{ #category : #'as yet unclassified' }
+DCProjectView >> project: aProject [
+
+	self
+		changeTableLayout;
+		hResizing: #rigid;
+		vResizing: #shrinkWrap;
+		listDirection: #leftToRight;
+		layoutInset: 8;
+		width: 600;
+		attachDecorator: SBForceMoveDecorator newConfigured;
+		attachDecorator: SBResizableDecorator new;
+		addMorphBack: (files := SBColumn new).
+	
+	aProject
+		queryFirst: [:obj | obj class = FSReference and: [obj = aProject directory]]
+		ifFound: [:rootFile | files addMorphBack: ((SBFileTree new on: rootFile) when: #open send: #openFile: to: self)]
+		ifNone: []
+]
diff --git a/packages/DomainCode-Core/DCQuery.class.st b/packages/DomainCode-Core/DCQuery.class.st
new file mode 100644
index 0000000..3230075
--- /dev/null
+++ b/packages/DomainCode-Core/DCQuery.class.st
@@ -0,0 +1,54 @@
+Class {
+	#name : #DCQuery,
+	#superclass : #Object,
+	#classVars : [
+		'Properties'
+	],
+	#category : #'DomainCode-Core'
+}
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> addProperty: anObject to: aDomainObject [
+
+	(self properties at: aDomainObject ifAbsentPut: [OrderedCollection new]) add: anObject.
+	self checkQueriesFor: aDomainObject domainRoot
+]
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> checkQueriesFor: aRoot [
+
+	Object allSubclassesDo: [:cls |
+		Pragma
+			withPragmasIn: cls
+			do: [:pragma | pragma keyword = #domainQuery ifTrue: [cls theNonMetaClass perform: pragma selector with: aRoot]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> does: aDomainObject haveProperty: anObject [
+
+	^ self properties
+		at: aDomainObject
+		ifPresent: [:properties | properties includes: anObject]
+		ifAbsent: [false]
+]
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> match: aClosure with: anObject do: anotherClosure [
+
+	(aClosure value: anObject) ifTrue: [anotherClosure value: anObject].
+	anObject domainReferencesDo: [:ref | self match: aClosure with: ref do: anotherClosure]
+]
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> properties [
+
+	^ Properties ifNil: [Properties := WeakKeyDictionary new]
+]
+
+{ #category : #'as yet unclassified' }
+DCQuery class >> removeProperty: anObject from: aDomainObject [
+
+	self properties
+		at: aDomainObject
+		ifPresent: [:properties | properties remove: aDomainObject]
+]
diff --git a/packages/DomainCode-Core/DCWorkspace.class.st b/packages/DomainCode-Core/DCWorkspace.class.st
new file mode 100644
index 0000000..c88f1bd
--- /dev/null
+++ b/packages/DomainCode-Core/DCWorkspace.class.st
@@ -0,0 +1,46 @@
+Class {
+	#name : #DCWorkspace,
+	#superclass : #SBBlock,
+	#instVars : [
+		'projects'
+	],
+	#category : #'DomainCode-Core'
+}
+
+{ #category : #'as yet unclassified' }
+DCWorkspace >> domainParent [
+
+	^ nil
+]
+
+{ #category : #'as yet unclassified' }
+DCWorkspace >> domainReferencesDo: aClosure [
+
+	projects submorphsDo: aClosure
+]
+
+{ #category : #'as yet unclassified' }
+DCWorkspace >> initialize [
+
+	super initialize.
+	
+	self
+		hResizing: #shrinkWrap;
+		vResizing: #shrinkWrap;
+		changeTableLayout;
+		addMorphBack: (SBButton new label: 'Open Project' do: [self openProject]);
+		addMorphBack: (projects := SBColumn new)
+]
+
+{ #category : #'as yet unclassified' }
+DCWorkspace >> openProject [
+	<action>
+
+	UIManager default chooseDirectory ifNotNil: [:directory | projects addMorphFront: (DCProject new directory: directory)]
+]
+
+{ #category : #'as yet unclassified' }
+DCWorkspace >> projects [
+
+	^ projects submorphs
+]
diff --git a/packages/DomainCode-Core/FSReference.extension.st b/packages/DomainCode-Core/FSReference.extension.st
new file mode 100644
index 0000000..58fbb5f
--- /dev/null
+++ b/packages/DomainCode-Core/FSReference.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #FSReference }
+
+{ #category : #'*DomainCode-Core' }
+FSReference >> domainReferencesDo: aClosure [
+
+	self isDirectory ifTrue: [self children do: aClosure]
+]
diff --git a/packages/DomainCode-Core/Object.extension.st b/packages/DomainCode-Core/Object.extension.st
new file mode 100644
index 0000000..ce2cf7c
--- /dev/null
+++ b/packages/DomainCode-Core/Object.extension.st
@@ -0,0 +1,44 @@
+Extension { #name : #Object }
+
+{ #category : #'*DomainCode-Core' }
+Object >> addProp: anObject [
+
+	DCQuery addProperty: anObject to: self
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> domainParent [
+
+	^ self subclassResponsibility
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> domainReferencesDo: aClosure [
+
+	
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> domainRoot [
+
+	^ self domainParent ifNil: [self] ifNotNil: [:p | p domainRoot]
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> hasProp: anObject [
+
+	^ DCQuery does: self haveProperty: anObject
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> query: aClosure do: anotherClosure [
+
+	^ DCQuery match: aClosure with: self do: anotherClosure
+]
+
+{ #category : #'*DomainCode-Core' }
+Object >> queryFirst: aClosure ifFound: anotherClosure ifNone: aThirdClosure [
+
+	DCQuery match: aClosure with: self do: [:match | ^ anotherClosure value: match].
+	^ aThirdClosure value
+]
diff --git a/packages/DomainCode-Core/package.st b/packages/DomainCode-Core/package.st
new file mode 100644
index 0000000..cef1bcf
--- /dev/null
+++ b/packages/DomainCode-Core/package.st
@@ -0,0 +1 @@
+Package { #name : #'DomainCode-Core' }
diff --git a/packages/DomainCode-Diff/.squot-contents b/packages/DomainCode-Diff/.squot-contents
new file mode 100644
index 0000000..06935f0
--- /dev/null
+++ b/packages/DomainCode-Diff/.squot-contents
@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ 'c4feeb7baa0d4f32a5bba86de4f6057a' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotTonelSerializer
+}
\ No newline at end of file
diff --git a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
new file mode 100644
index 0000000..ef93e35
--- /dev/null
+++ b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
@@ -0,0 +1,119 @@
+Class {
+	#name : #DCChawatheScriptGenerator,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping do: aBlock [
+
+	| s1 s2 lcs |
+	w submorphs do: [:c | srcInOrder remove: c ifAbsent: []].
+	x submorphs do: [:c | destInOrder remove: c ifAbsent: []].
+	
+	s1 := w submorphs select: [:c | (aMapping isSrcMapped: c) and: [x submorphs includes: (aMapping destForSrc: c)]].
+	s2 := x submorphs select: [:c | (aMapping isDestMapped: c) and: [x submorphs includes: (aMapping srcForDest: c)]].
+	
+	lcs := self lcsWith: s1 and: s2 in: aMapping.
+	lcs do: [:mapping |
+		srcInOrder add: mapping first.
+		destInOrder add: mapping second].
+	
+	s2 do: [:b |
+		s1 do: [:a |
+			(aMapping includes: {a. b}) ifFalse: [ | k |
+				"FIXME delete first or find position first?"
+				a delete.
+				k := self findPosition: b dest: destInOrder in: aMapping.
+				aBlock value: #move value: {a. w. k}.
+				w addMorph: a asElementNumber: k.
+				srcInOrder add: a.
+				srcInOrder add: b]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> findPosition: aTree dest: destInorder in: aMapping [
+
+	| siblings v u |
+	siblings := aTree owner submorphs.
+	siblings do: [:c | (destInorder includes: c) ifTrue: [c = aTree ifTrue: [^ 1]]].
+	
+	v := nil.
+	(siblings viewFirst: aTree submorphIndex) do: [:c | (destInorder includes: c) ifTrue: [v := c]].
+	
+	v ifNil: [^ 1].
+	
+	u := aMapping srcForDest: v.
+	
+	^ u submorphIndex
+]
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping do: aBlock [
+
+	| actions srcInOrder destInOrder |
+	actions := DCEditScript new.
+	
+	srcInOrder := Set new.
+	destInOrder := Set new.
+	
+	dest allMorphsBreadthFirstDo: [:x | | y z w |
+		w := nil.
+		y := x owner.
+		z := aMapping srcForDest: y.
+		(aMapping isDestMapped: x)
+			ifFalse: [ | k |
+				k := self findPosition: x dest: destInOrder in: aMapping.
+				aBlock value: #insert value: {x. z. k}.
+				w := x copy.
+				z addMorph: w asElementNumber: k.
+				aMapping addMappingFrom: w to: x]
+			ifTrue: [
+				w := aMapping srcForDest: x.
+				x = dest ifFalse: [ | v |
+					v := w owner.
+					w treeLabel = x treeLabel ifFalse: [
+						self assert: (w isTextMorph and: [x isTextMorph]).
+						w contents: x contents.
+						aBlock value: #update value: {w. x contents}].
+					z = v ifFalse: [ | k |
+						k := self findPosition: x dest: destInOrder in: aMapping.
+						aBlock value: #move value: {w. z. k}.
+						w delete.
+						z addMorph: w asElementNumber: k]]].
+		
+		srcInOrder add: w.
+		destInOrder add: x.
+		self alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping do: aBlock].
+	
+	src allMorphsDo: [:w | (aMapping isSrcMapped: w) ifFalse: [aBlock value: #delete value: {w}]]
+]
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> lcsWith: x and: y in: aMapping [
+
+	| opt lcs ix jy |
+	opt := Matrix rows: x size + 1 columns: y size + 1.
+	lcs := OrderedCollection new.
+	
+	x size to: 1 by: -1 do: [:i |
+		y size to: 1 by: -1 do: [:j |
+			opt at: i at: j put: ((aMapping srcForDest: (y at: j)) = (x at: i)
+				ifTrue: [(opt at: i + 1 at: j + 1) + 1]
+				ifFalse: [(opt at: i + 1 at: j) max: (opt at: i at: j + 1)])]].
+	
+	ix := 0.
+	jy := 0.
+	[ix < x size and: [jy < y size]] whileTrue: [
+		(aMapping srcForDest: (y at: jy)) = (x at: ix)
+			ifTrue: [
+				lcs add: {x at: ix. y at: jy}.
+				ix := ix + 1.
+				jy := jy + 1]
+			ifFalse: [
+				(opt at: ix + 1 at: jy) >= (opt at: ix at: jy + 1)
+					ifTrue: [ix := ix + 1]
+					ifFalse: [jy := jy + 1]]].
+	
+	^ lcs
+]
diff --git a/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st b/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
new file mode 100644
index 0000000..38fe801
--- /dev/null
+++ b/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
@@ -0,0 +1,66 @@
+Class {
+	#name : #DCGreedyBottomUpMatcher,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> destCandidatesFor: src in: aMapping [
+
+	| seeds candidates visited |
+	seeds := OrderedCollection new.
+	src descendantsPreOrder do: [:c | (aMapping isSrcMapped: c) ifTrue: [seeds add: (aMapping destForSrc: c)]].
+	
+	candidates := OrderedCollection new.
+	visited := Set new.
+	seeds do: [:seed | | parent current |
+		current := seed.
+		self assert: seed notNil.
+		[
+			parent := current owner.
+			parent notNil and: [(visited includes: parent) not]] whileTrue: [
+			visited add: parent.
+			(parent type = src type and: [((aMapping isDestMapped: parent) or: [parent = parent rootBlock]) not]) ifTrue: [candidates add: parent].
+			current := parent]].
+	
+	^ candidates
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> lastChanceMatchFrom: src to: dest in: aMapping [
+
+	(src recursiveSubmorphCount < self sizeThreshold or: [dest recursiveSubmorphCount < self sizeThreshold]) ifTrue: [ | m zsMappings |
+		m := DCZhangShashaMatcher new.
+		zsMappings := DCMappingStore new.
+		m matchFrom: src to: dest in: zsMappings.
+		zsMappings keysAndValuesDo: [:srcCandidate :destCandidate | (aMapping allowedToMapFrom: srcCandidate to: destCandidate) ifTrue: [aMapping addMappingFrom: srcCandidate to: destCandidate]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> matchFrom: src to: dest in: aMapping [
+	"post-order"
+
+	src allMorphsDo: [:t |
+		src = t
+			ifTrue: [
+				aMapping addMappingFrom: t to: dest.
+				self lastChanceMatchFrom: t to: dest in: aMapping]
+			ifFalse: [
+				((aMapping isSrcMapped: t) not or: [t hasSubmorphs not]) ifTrue: [
+					"TODO similarity threshold 0.5"
+					(((self destCandidatesFor: t in: aMapping) select: [:candidate | (DCMappingComparator diceSimilarityFrom: t to: candidate in: aMapping) >= self similarityThreshold]) detectMax: [:candidate | DCMappingComparator diceSimilarityFrom: t to: candidate in: aMapping]) ifNotNil: [:best |
+						self lastChanceMatchFrom: t to: best in: aMapping.
+						aMapping addMappingFrom: t to: best]]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> similarityThreshold [
+
+	^ 0.5
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> sizeThreshold [
+
+	^ 1000
+]
diff --git a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
new file mode 100644
index 0000000..4e15cc3
--- /dev/null
+++ b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
@@ -0,0 +1,58 @@
+Class {
+	#name : #DCGreedySubtreeMatcher,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
+
+	| comparator |
+	comparator := DCMappingComparator new mappingStore: aMapping.
+	
+	aCollection sort: [:m1 :m2 | | s1 s2 |
+		s1 := m1 detectMax: [:t | t recursiveSubmorphCount].
+		s2 := m2 detectMax: [:t | t recursiveSubmorphCount].
+		s1 < s2].
+	
+	aCollection do: [:entry | | candidates |
+		candidates := Array streamContents: [:s | entry first do: [:src | entry second do: [:dest | s nextPut: {src. dest}]]].
+		
+		(candidates sort: [:m1 :m2 | comparator compare: m1 with: m2]) do: [:mapping | (aMapping areBothUnmappedSrc: mapping first dest: mapping second) ifTrue: [aMapping addRecursiveMappingFrom: mapping first to: mapping second]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedySubtreeMatcher >> matchFrom: src to: dest in: aMapping [
+
+	| ambiguousMappings srcTrees destTrees |
+	ambiguousMappings := OrderedCollection new.
+	srcTrees := DCPriorityTreeQueue new add: src.
+	destTrees := DCPriorityTreeQueue new add: dest.
+	[
+		self synchronizePriority: srcTrees with: destTrees.
+		srcTrees notEmpty and: [destTrees notEmpty]] whileTrue: [ | mapper |
+		mapper := DCHashBasedMapper new.
+		srcTrees removeHighest do: [:t | mapper addSrc: t].
+		destTrees removeHighest do: [:t | mapper addDest: t].
+		mapper uniqueEntries do: [:entry | aMapping addRecursiveMappingFrom: entry first anyOne to: entry second anyOne].
+		ambiguousMappings addAll: mapper ambiguousEntries.
+		mapper unmappedEntries do: [:entry |
+			entry first do: [:t | srcTrees addTree: t].
+			entry second do: [:t | destTrees addTree: t]]].
+	self handleAmbiguousMappings: ambiguousMappings for: aMapping
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedySubtreeMatcher >> synchronizePriority: aQueue with: anotherQueue [
+
+	[(aQueue notEmpty and: [anotherQueue notEmpty]) and: [aQueue first treeHeight ~= anotherQueue first treeHeight]] whileTrue: [
+		aQueue first treeHeight > anotherQueue first treeHeight
+			ifTrue: [aQueue removeHighestAndOpen]
+			ifFalse: [anotherQueue removeHighestAndOpen]].
+	
+	(aQueue isEmpty or: [anotherQueue isEmpty]) ifTrue: [
+		aQueue removeAll.
+		anotherQueue removeAll.
+		^ false].
+	^ true
+]
diff --git a/packages/DomainCode-Diff/DCHashBasedMapper.class.st b/packages/DomainCode-Diff/DCHashBasedMapper.class.st
new file mode 100644
index 0000000..d896f77
--- /dev/null
+++ b/packages/DomainCode-Diff/DCHashBasedMapper.class.st
@@ -0,0 +1,53 @@
+Class {
+	#name : #DCHashBasedMapper,
+	#superclass : #Object,
+	#instVars : [
+		'mappings'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> addDest: tree [
+
+	(self entryForTree: tree) second add: tree
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> addSrc: tree [
+
+	(self entryForTree: tree) first add: tree
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> ambiguousEntries [
+
+	^ mappings select: [:entry | (entry first size > 1 and: [entry second size >= 1]) or: [entry first size >= 1 and: [entry second size > 1]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> entryForTree: tree [
+
+	^ mappings at: tree treeHash ifAbsentPut: [
+		{Set new. Set new}]
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> initialize [
+
+	super initialize.
+	
+	mappings := Dictionary new
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> uniqueEntries [
+
+	^ mappings select: [:entry | entry first size = 1 and: [entry second size = 1]]
+]
+
+{ #category : #'as yet unclassified' }
+DCHashBasedMapper >> unmappedEntries [
+
+	^ mappings select: [:entry | entry first isEmpty or: [entry second isEmpty]]
+]
diff --git a/packages/DomainCode-Diff/DCMappingComparator.class.st b/packages/DomainCode-Diff/DCMappingComparator.class.st
new file mode 100644
index 0000000..1ebde7a
--- /dev/null
+++ b/packages/DomainCode-Diff/DCMappingComparator.class.st
@@ -0,0 +1,208 @@
+Class {
+	#name : #DCMappingComparator,
+	#superclass : #Object,
+	#instVars : [
+		'srcDescendants',
+		'destDescendants',
+		'mappingStore',
+		'srcAncestors',
+		'destAncestors'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator class >> diceCoefficientCommon: aCommonNumber left: aLeftNumber right: aRightNumber [
+
+	^ 2.0 * aCommonNumber / (aLeftNumber + aRightNumber)
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator class >> diceSimilarityFrom: src to: dest in: aMapping [
+
+	^ self
+		diceCoefficientCommon: (self numberOfMappedDescendantsFrom: src to: dest in: aMapping)
+		left: src recursiveSubmorphCount - 1
+		right: dest recursiveSubmorphCount - 1
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator class >> numberOfMappedDescendantsFrom: src to: dest in: aMapping [
+
+	| dstDescendants mappedDescendants |
+	dstDescendants := dest descendantsPreOrder asSet.
+	mappedDescendants := 0.
+	
+	src descendantsPreOrder do: [:srcDescendant | ((aMapping isSrcMapped: srcDescendant) and: [dstDescendants includes: (aMapping destForSrc: srcDescendant)]) ifTrue: [mappedDescendants := mappedDescendants + 1]].
+	
+	^ mappedDescendants
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> compare: aMapping with: anotherMapping [
+
+	| result |
+	result := self similaritySiblingsCompare: aMapping with: anotherMapping.
+	result = 0 ifFalse: [^ result].
+	
+	result := self similarityParentsCompare: aMapping with: anotherMapping.
+	result = 0 ifFalse: [^ result].
+	
+	result := self similarityPositionInParentsCompare: aMapping with: anotherMapping.
+	result = 0 ifFalse: [^ result].
+	
+	result := self distanceTextualCompare: aMapping with: anotherMapping.
+	result = 0 ifFalse: [^ result].
+	
+	result := self distanceAbsoluteCompare: aMapping with: anotherMapping.
+	result = 0 ifFalse: [^ result].
+	
+	^ 0
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> distanceAbsoluteCompare: aMapping with: anotherMapping [
+	"TODO compare the post-order position in the tree of the mapping, between src and dest"
+
+	^ SBToggledCode comment: '' active: 1 do: {
+		[0].
+		[
+			distance := [:mapping | (mapping first range start index - mapping second range start index) abs + (mapping first range end index - mapping second range end index) abs].
+			((distance value: anotherMapping) - (distance value: aMapping)) sign]}
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> distanceTextualCompare: aMapping with: anotherMapping [
+
+	| distance |
+	"compares how far each mapping moved from src to dest in terms of its textual start and end indices"
+	distance := [:mapping | (mapping first range start index - mapping second range start index) abs + (mapping first range end index - mapping second range end index) abs].
+	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> initialize [
+
+	super initialize.
+	
+	srcDescendants := Dictionary new.
+	destDescendants := Dictionary new.
+	srcAncestors := Dictionary new.
+	destAncestors := Dictionary new
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> longestCommonSubsequenceWith: aCollection and: anotherCollection [
+
+	| lengths x y indices |
+	lengths := Matrix rows: aCollection size + 1 columns: anotherCollection size + 1.
+	1 to: aCollection size + 1 do: [:i |
+		1 to: anotherCollection size + 1 do: [:j |
+			(aCollection at: i) type = (anotherCollection at: j) type
+				ifTrue: [lengths at: i + 1 at: j + 1 put: (lengths at: i at: j)]
+				ifFalse: [lengths at: i + 1 at: j + 1 put: ((lengths at: i + 1 at: j) max: (lengths at: i at: j + 1))]]].
+	
+	indices := OrderedCollection new.
+	x := aCollection size.
+	y := anotherCollection size.
+	[x ~= 0 and: [y ~= 0]] whileTrue: [
+		(lengths at: x at: y) = (lengths at: x - 1 at: y)
+			ifTrue: [x := x - 1]
+			ifFalse: [
+				(lengths at: x at: y) = (lengths at: x at: y - 1)
+					ifTrue: [y := y - 1]
+					ifFalse: [
+						indices add: {x - 1. y - 1}.
+						x := x - 1.
+						y := y - 1]]].
+	
+	^ indices reverseInPlace
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> mappingStore: aMapping [
+
+	mappingStore := aMapping
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> numberOfCommonDescendantsIn: src and: dest [
+
+	| common |
+	srcDescendants at: src ifAbsentPut: src descendantsPreOrder asSet.
+	destDescendants at: dest ifAbsentPut: dest descendantsPreOrder asSet.
+	
+	common := 0.
+	srcDescendants keysDo: [:t | | m |
+		m := mappingStore destForSrc: t.
+		(m notNil and: [(destDescendants at: dest) includes: m]) ifTrue: [common := common + 1]].
+	^ common
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> numberOfCommonParentsIn: src and: dest [
+
+	
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
+
+	| s1 s2 |
+	(aMapping first owner = anotherMapping first owner and: [aMapping second owner = anotherMapping second owner]) ifTrue: [^ 0].
+	
+	srcAncestors at: aMapping first ifAbsentPut: aMapping first allParents.
+	destAncestors at: aMapping second ifAbsentPut: aMapping second allParents.
+	srcAncestors at: anotherMapping first ifAbsentPut: anotherMapping first allParents.
+	destAncestors at: anotherMapping second ifAbsentPut: anotherMapping second allParents.
+	
+	s1 := self class
+		diceCoefficientCommon: (self numberOfCommonParentsIn: aMapping first and: aMapping second)
+		left: (srcAncestors at: aMapping first) recursiveSubmorphCount
+		right: (destAncestors at: aMapping second) recursiveSubmorphCount.
+	s2 := self class
+		diceCoefficientCommon: (self numberOfCommonParentsIn: anotherMapping first and: anotherMapping second)
+		left: (srcAncestors at: anotherMapping first) recursiveSubmorphCount
+		right: (destAncestors at: anotherMapping second) recursiveSubmorphCount.
+	
+	^ (s2 - s1) sign
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> similarityPositionInParentsCompare: aMapping with: anotherMapping [
+
+	| indicesInOwnerSubmorphs distance |
+	indicesInOwnerSubmorphs := [:src | | current |
+		indicesInOwnerSubmorphs := OrderedCollection new.
+		current := src.
+		[current notNil and: [current owner notNil]] whileTrue: [
+			indicesInOwnerSubmorphs add: current submorphIndex.
+			current := current owner]].
+	distance := [:mapping | | indicesVec1 indicesVec2 sum |
+		indicesVec1 := indicesInOwnerSubmorphs value: mapping first.
+		indicesVec2 := indicesInOwnerSubmorphs value: mapping second.
+		sum := 0.0.
+		1
+			to: (indicesVec1 size min: indicesVec2 size)
+			do: [:index | sum := sum + ((indicesVec1 at: index) - (indicesVec2 at: index)) squared].
+		sum sqrt].
+	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> similaritySiblingsCompare: aMapping with: anotherMapping [
+
+	| s1 s2 |
+	(aMapping first owner = anotherMapping first owner and: [aMapping second owner = anotherMapping second owner]) ifTrue: [^ 0].
+	
+	s1 := self class
+		diceCoefficientCommon: (self numberOfCommonDescendantsIn: aMapping first owner and: aMapping second owner)
+		left: (srcDescendants at: aMapping first owner) recursiveSubmorphCount
+		right: (destDescendants at: aMapping second owner) recursiveSubmorphCount.
+	s2 := self class
+		diceCoefficientCommon: (self numberOfCommonDescendantsIn: anotherMapping first owner and: anotherMapping second owner)
+		left: (srcDescendants at: anotherMapping first owner) recursiveSubmorphCount
+		right: (destDescendants at: anotherMapping second owner) recursiveSubmorphCount.
+	
+	^ (s2 - s1) sign
+]
diff --git a/packages/DomainCode-Diff/DCMappingStore.class.st b/packages/DomainCode-Diff/DCMappingStore.class.st
new file mode 100644
index 0000000..5878adf
--- /dev/null
+++ b/packages/DomainCode-Diff/DCMappingStore.class.st
@@ -0,0 +1,76 @@
+Class {
+	#name : #DCMappingStore,
+	#superclass : #Object,
+	#instVars : [
+		'srcToDest',
+		'destToSrc'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> addMappingFrom: src to: dest [
+
+	SBToggledCode comment: '' active: 0 do: {[src contents = 'abc' ifTrue: [self halt]]}.
+	self assert: src rootBlock ~= dest rootBlock.
+	srcToDest at: src put: dest.
+	destToSrc at: dest put: src
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> addRecursiveMappingFrom: src to: dest [
+
+	self addMappingFrom: src to: dest.
+	src submorphs with: dest submorphs do: [:a :b | self addRecursiveMappingFrom: a to: b]
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> allowedToMapFrom: srcCandidate to: destCandidate [
+
+	^ srcCandidate type = destCandidate type and: [self areBothUnmappedSrc: srcCandidate dest: destCandidate]
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> areBothUnmappedSrc: src dest: dest [
+
+	^ (self isSrcMapped: src) not and: [(self isDestMapped: dest) not]
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> destForSrc: t [
+
+	^ srcToDest at: t ifAbsent: [nil]
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> initialize [
+
+	super initialize.
+	
+	srcToDest := Dictionary new.
+	destToSrc := Dictionary new
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> isDestMapped: dest [
+
+	^ destToSrc includesKey: dest
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> isSrcMapped: src [
+
+	^ srcToDest includesKey: src
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> keysAndValuesDo: aBlock [
+
+	srcToDest keysAndValuesDo: aBlock
+]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> srcForDest: t [
+
+	^ destToSrc at: t ifAbsent: [nil]
+]
diff --git a/packages/DomainCode-Diff/DCMatchTest.class.st b/packages/DomainCode-Diff/DCMatchTest.class.st
new file mode 100644
index 0000000..76b3f1f
--- /dev/null
+++ b/packages/DomainCode-Diff/DCMatchTest.class.st
@@ -0,0 +1,23 @@
+Class {
+	#name : #DCMatchTest,
+	#superclass : #TestCase,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCMatchTest >> testSimple [
+
+	| src dest mappings |
+	Transcript clear.
+	src := DCBlock parseBlock: '' language: SBJavascript.
+	dest := DCBlock parseBlock: 'abc' language: SBJavascript.
+	mappings := DCMappingStore new.
+	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
+	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
+	Transcript showln: (Array streamContents: [:stream |
+		DCChawatheScriptGenerator new
+			generateFrom: src
+			to: dest
+			in: mappings
+			do: [:op :args | stream nextPut: {op. args}]])
+]
diff --git a/packages/DomainCode-Diff/DCMatcher.class.st b/packages/DomainCode-Diff/DCMatcher.class.st
new file mode 100644
index 0000000..6fbe274
--- /dev/null
+++ b/packages/DomainCode-Diff/DCMatcher.class.st
@@ -0,0 +1,14 @@
+Class {
+	#name : #DCMatcher,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> matchFrom: src to: dest [
+
+	| mappings |
+	mappings := DCMappingStore new.
+	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
+	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings
+]
diff --git a/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
new file mode 100644
index 0000000..66106e5
--- /dev/null
+++ b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
@@ -0,0 +1,98 @@
+Class {
+	#name : #DCPriorityTreeQueue,
+	#superclass : #Object,
+	#instVars : [
+		'collection'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> add: tree [
+
+	tree treeHeight >= self minimumHeight ifTrue: [collection add: tree]
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> addTree: tree [
+
+	tree submorphs do: [:child | self add: child]
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> first [
+
+	^ collection first
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> initialize [
+
+	super initialize.
+	
+	collection := SortedCollection sortBlock: [:a :b | a treeHeight > b treeHeight]
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> isEmpty [
+
+	^ collection isEmpty
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> minimumHeight [
+
+	^ 1
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> notEmpty [
+
+	^ collection notEmpty
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> removeAll [
+
+	collection removeAll
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> removeFirst [
+
+	^ collection removeFirst
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> removeHighest [
+
+	^ Array streamContents: [:stream | | tree |
+		tree := self removeFirst.
+		stream nextPut: tree.
+		[self notEmpty and: [tree treeHeight = self first treeHeight]] whileTrue: [
+			tree := self removeFirst.
+			stream nextPut: tree]]
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> removeHighestAndOpen [
+
+	^ self removeHighest
+		do: [:tree | self addTree: tree];
+		yourself
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> synchronizePriorityWith: anotherQueue do: aBlock [
+
+	[(self notEmpty and: [anotherQueue notEmpty]) and: [self first treeHeight ~= anotherQueue first treeHeight]] whileTrue: [
+		self first treeHeight > anotherQueue first treeHeight
+			ifTrue: [self removeFirst]
+			ifFalse: [anotherQueue removeFirst]].
+	
+	(self isEmpty or: [anotherQueue isEmpty]) ifTrue: [
+		self removeAll.
+		anotherQueue removeAll.
+		^ false].
+	^ true
+]
diff --git a/packages/DomainCode-Diff/DCSimplifiedChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCSimplifiedChawatheScriptGenerator.class.st
new file mode 100644
index 0000000..ae79972
--- /dev/null
+++ b/packages/DomainCode-Diff/DCSimplifiedChawatheScriptGenerator.class.st
@@ -0,0 +1,5 @@
+Class {
+	#name : #DCSimplifiedChawatheScriptGenerator,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
diff --git a/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
new file mode 100644
index 0000000..95b2c40
--- /dev/null
+++ b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
@@ -0,0 +1,143 @@
+Class {
+	#name : #DCZhangShashaMatcher,
+	#superclass : #Object,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> computeForestDistFrom: zsSrc at: i to: zsDest at: j in: forestDist treeDist: treeDist [
+
+	forestDist at: (zsSrc lldAt: i) at: (zsDest lldAt: j) put: 0.
+	(zsSrc lldAt: i) to: i do: [:di | | costDeletion |
+		costDeletion := self deletionCostOf: (zsSrc treeAt: di).
+		forestDist
+			at: di + 1
+			at: (zsDest lldAt: j)
+			put: (forestDist at: di at: (zsDest lldAt: j)) + costDeletion.
+		(zsDest lldAt: j) to: j do: [:dj | | constInsertion |
+			constInsertion := self insertionCostOf: (zsDest lldAt: dj).
+			forestDist
+				at: (zsSrc lldAt: i)
+				at: dj + 1
+				put: (forestDist at: (zsSrc lldAt: i) at: dj) + constInsertion.
+			((zsSrc lldAt: di) = (zsSrc lldAt: i) and: [(zsDest lldAt: dj) = (zsDest lldAt: j)])
+				ifTrue: [ | costUpdate cost |
+					costUpdate := self updateCostFrom: (zsSrc treeAt: di) to: (zsDest treeAt: dj).
+					cost := {
+						(forestDist at: di at: dj + 1) + costDeletion.
+						(forestDist at: di + 1 at: dj) + constInsertion.
+						(forestDist at: di at: dj) + costUpdate} min.
+					forestDist at: di + 1 at: dj + 1 put: cost.
+					treeDist at: di + 1 at: dj + 1 put: cost]
+				ifFalse: [
+					forestDist at: di + 1 at: dj + 1 put: {
+						(forestDist at: di at: dj + 1) + costDeletion.
+						(forestDist at: di + 1 at: dj) + constInsertion.
+						(forestDist at: (zsSrc lldAt: di) at: (zsDest lldAt: dj)) + (treeDist at: di + 1 at: dj + 1)} min]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> computeTreeDistFrom: zsSrc to: zsDest [
+
+	| treeDist forestDist |
+	treeDist := Matrix rows: zsSrc nodeCount + 1 columns: zsDest nodeCount + 1.
+	forestDist := Matrix rows: zsSrc nodeCount + 1 columns: zsDest nodeCount + 1.
+	
+	1 to: zsSrc keyRoots size - 1 do: [:i |
+		1
+			to: zsDest keyRoots size - 1
+			do: [:j | self computeForestDistFrom: zsSrc at: i to: zsDest at: j in: forestDist treeDist: treeDist]].
+	
+	^ forestDist
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> deletionCostOf: tree [
+
+	^ 1
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> insertionCostOf: tree [
+
+	^ 1
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> levenshteinDistanceFrom: aString to: anotherString [
+	"distances at: i at: j will hold the Levenshtein distance between the first i characters of the receiver and the first j characters of anotherString."
+
+	| distances |
+	distances := Matrix rows: aString size columns: anotherString size element: 0.
+	
+	"source prefixes can be transformed into empty string by dropping all characters"
+	1 to: aString size do: [:i | distances at: i at: 1 put: i].
+	"target prefixes can be reached from empty source prefix by inserting every character"
+	1 to: anotherString size do: [:j | distances at: 1 at: j put: j].
+	
+	2 to: anotherString size do: [:j |
+		2 to: aString size do: [:i | | deletionCost insertionCost substitutionCost |
+			deletionCost := (distances at: i - 1 at: j) + 1.
+			insertionCost := (distances at: i at: j - 1) + 1.
+			substitutionCost := (distances at: i - 1 at: j - 1) + ((aString at: i) = (anotherString at: j) ifTrue: [0] ifFalse: [1]).
+			distances at: i at: j put: ((deletionCost min: insertionCost) min: substitutionCost)]].
+	
+	^ distances at: aString size at: anotherString size
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> matchFrom: src to: dest in: aMappingStore [
+
+	| zsSrc zsDest treePairQueue rootNodePair forestDist |
+	zsSrc := DCZhangShashaTree new for: src.
+	zsDest := DCZhangShashaTree new for: dest.
+	
+	forestDist := self computeTreeDistFrom: zsSrc to: zsDest.
+	rootNodePair := true.
+	
+	treePairQueue := OrderedCollection with: {zsSrc nodeCount. zsDest nodeCount}.
+	[treePairQueue notEmpty] whileTrue: [ | treePair lastRow lastCol firstRow firstCol row col |
+		treePair := treePairQueue removeFirst.
+		lastRow := treePair first.
+		lastCol := treePair second.
+		
+		rootNodePair ifTrue: [rootNodePair := false] ifFalse: ["need to recalc tree/forestDist?"
+		self flag: #todo].
+		
+		firstRow := (zsSrc lldAt: lastRow) - 1.
+		firstCol := (zsDest lldAt: lastCol) - 1.
+		
+		row := lastRow.
+		col := lastCol.
+		[row > firstRow or: [col > firstCol]] whileTrue: [
+			(row > firstRow and: [(forestDist at: row at: col + 1) + 1 = (forestDist at: row + 1 at: col + 1)])
+				ifTrue: [row := row - 1]
+				ifFalse: [
+					(col > firstCol and: [(forestDist at: row + 1 at: col) + 1 = (forestDist at: row + 1 at: col + 1)])
+						ifTrue: [col := col - 1]
+						ifFalse: [
+							((zsSrc lldAt: row) = (zsSrc lldAt: lastRow) and: [(zsDest lldAt: col) = (zsDest lldAt: lastCol)])
+								ifTrue: [ | tSrc tDest |
+									tSrc := zsSrc treeAt: row.
+									tDest := zsDest treeAt: col.
+									tSrc type = tDest type
+										ifTrue: [aMappingStore addMappingFrom: tSrc to: tDest]
+										ifFalse: [self error: 'should not map incompatible nodes.'].
+									row := row - 1.
+									col := col - 1]
+								ifFalse: [
+									treePairQueue addFirst: {row. col}.
+									row := (zsSrc lldAt: row) - 1.
+									col := (zsDest lldAt: col) - 1]]]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcher >> updateCostFrom: src to: dest [
+
+	^ src type = dest type
+		ifTrue: [
+			((src isTextMorph not or: [src contents isEmpty]) or: [dest isTextMorph not or: [dest contents isEmpty]])
+				ifTrue: [1]
+				ifFalse: [1 - (src contents levenshteinRatioTo: dest contents)]]
+		ifFalse: [900000000]
+]
diff --git a/packages/DomainCode-Diff/DCZhangShashaMatcherTest.class.st b/packages/DomainCode-Diff/DCZhangShashaMatcherTest.class.st
new file mode 100644
index 0000000..6b0e274
--- /dev/null
+++ b/packages/DomainCode-Diff/DCZhangShashaMatcherTest.class.st
@@ -0,0 +1,17 @@
+Class {
+	#name : #DCZhangShashaMatcherTest,
+	#superclass : #TestCase,
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaMatcherTest >> testSimpleTree [
+
+	| src dest mappings |
+	src := DCBlock parseBlock: '2+c' language: SBJavascript.
+	dest := DCBlock parseBlock: '2+ab+c' language: SBJavascript.
+	
+	mappings := DCMappingStore new.
+	DCZhangShashaMatcher new matchFrom: src to: dest in: mappings.
+	mappings
+]
diff --git a/packages/DomainCode-Diff/DCZhangShashaTree.class.st b/packages/DomainCode-Diff/DCZhangShashaTree.class.st
new file mode 100644
index 0000000..1a6dfcf
--- /dev/null
+++ b/packages/DomainCode-Diff/DCZhangShashaTree.class.st
@@ -0,0 +1,70 @@
+Class {
+	#name : #DCZhangShashaTree,
+	#superclass : #Object,
+	#instVars : [
+		'nodeCount',
+		'leafCount',
+		'llds',
+		'labels',
+		'keyRoots'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> for: aTree [
+
+	| index tmpData visited k |
+	nodeCount := aTree recursiveSubmorphCount.
+	leafCount := 0.
+	llds := Array new: nodeCount.
+	labels := Array new: nodeCount.
+	
+	index := 1.
+	tmpData := Dictionary new.
+	aTree allMorphsDo: [:n |
+		tmpData at: n put: index.
+		labels at: index put: n.
+		llds at: index put: (tmpData at: n firstDeepSubmorph).
+		n hasSubmorphs ifFalse: [leafCount := leafCount + 1].
+		index := index + 1].
+	
+	keyRoots := Array new: nodeCount + 1.
+	visited := Array new: nodeCount + 1 withAll: false.
+	k := nodeCount.
+	nodeCount to: 1 by: -1 do: [:i |
+		(visited at: (self lldAt: i)) ifFalse: [
+			keyRoots at: k put: i.
+			visited at: (self lldAt: i) put: true.
+			k := k - 1]]
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> isLeaf: i [
+
+	^ (self lldAt: i) = i
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> keyRoots [
+
+	^ keyRoots
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> lldAt: i [
+
+	^ llds at: i
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> nodeCount [
+
+	^ nodeCount
+]
+
+{ #category : #'as yet unclassified' }
+DCZhangShashaTree >> treeAt: i [
+
+	^ labels at: i
+]
diff --git a/packages/DomainCode-Diff/String.extension.st b/packages/DomainCode-Diff/String.extension.st
new file mode 100644
index 0000000..466d369
--- /dev/null
+++ b/packages/DomainCode-Diff/String.extension.st
@@ -0,0 +1,33 @@
+Extension { #name : #String }
+
+{ #category : #'*DomainCode-Diff' }
+String >> levenshteinDistanceTo: anotherString [
+
+	| stab cost |
+	"if a string is empty, answer the length of the another string"
+	"code taken from Olivier Auverlot's Phonetix package"
+	self size = 0 ifTrue: ["return the Levenshtein distance between two strings"
+	^ anotherString size].
+	anotherString size = 0 ifTrue: [^ self size].
+	stab := Matrix rows: anotherString size + 1 columns: self size + 1.
+	1 to: stab columnCount do: [:i | stab at: 1 at: i put: i - 1].
+	1 to: stab rowCount do: [:i | stab at: i at: 1 put: i - 1].
+	2 to: stab columnCount do: [:i |
+		2 to: stab rowCount do: [:j |
+			(self at: i - 1) = (anotherString at: j - 1)
+				ifTrue: [cost := 0]
+				ifFalse: [cost := 1].
+			stab
+				at: j
+				at: i
+				put: ({(stab at: j at: i - 1) + 1. (stab at: j - 1 at: i) + 1. (stab at: j - 1 at: i - 1) + cost} asSortedCollection: [:a :b | a < b]) first]].
+	^ stab at: stab rowCount at: stab columnCount
+]
+
+{ #category : #'*DomainCode-Diff' }
+String >> levenshteinRatioTo: anotherString [
+
+	| lengthSum |
+	lengthSum := self size + anotherString size.
+	^ (lengthSum - (self levenshteinDistanceTo: anotherString) / lengthSum) asFloat
+]
diff --git a/packages/DomainCode-Diff/package.st b/packages/DomainCode-Diff/package.st
new file mode 100644
index 0000000..38ea7ec
--- /dev/null
+++ b/packages/DomainCode-Diff/package.st
@@ -0,0 +1 @@
+Package { #name : #'DomainCode-Diff' }
diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st
index 425b2ee..2763ea2 100644
--- a/packages/DomainCode-Parser/DCBlock.class.st
+++ b/packages/DomainCode-Parser/DCBlock.class.st
@@ -46,12 +46,7 @@ DCBlock class >> fromCursor: aCursor language: aLanguage [
 { #category : #'as yet unclassified' }
 DCBlock class >> parse: aString language: aLanguage [
 
-	| api |
-	api := SBTreeSitter new.
-	^ (api parseAsCursor: aString language: aLanguage language do: [:cursor |
-		self
-			fromCursor: (SBTSCursorRaw new library: api cursor: cursor factory: aLanguage instance grammar)
-			language: aLanguage])
+	^ (self parseBlock: aString language: aLanguage)
 		layoutInset: 4;
 		hResizing: #rigid;
 		attachDecorator: SBResizableDecorator new;
@@ -59,12 +54,32 @@ DCBlock class >> parse: aString language: aLanguage [
 		yourself
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock class >> parseBlock: aString language: aLanguage [
+
+	| api |
+	api := SBTreeSitter new.
+	^ api parseAsCursor: aString language: aLanguage language do: [:cursor |
+		self
+			fromCursor: (SBTSCursorRaw new library: api cursor: cursor factory: aLanguage instance grammar)
+			language: aLanguage]
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> alias [
 
 	^ nil
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> allParents [
+
+	^ Array streamContents: [:s |
+		self ownerSatisfying: [:o |
+			s nextPut: o.
+			o = self rootBlock]]
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> allTextMorphsDo: aBlock [
 
@@ -306,12 +321,13 @@ DCBlock >> insertStatementAboveOrBelow: anAboveBoolean [
 			in: self
 			morph: (DCUnknown new language: self language))].
 	
-	(self orOwnerSuchThat: [:morph | morph isTSBlock and: [morph isStatement]]) ifNotNil: [:adjacent |
-		self sandblockEditor do: (SBRelInsertCommand new
-			near: adjacent
-			before: anAboveBoolean
-			in: adjacent owner
-			morph: (DCUnknown new language: self language))]
+	(self orOwnerSuchThat: [:morph | morph isTSBlock and: [morph isStatement]]) ifNotNil: [:statement | | target |
+		target := (statement morphBeforeOrAfter: anAboveBoolean) contents = self language statementTerminator
+			ifTrue: [statement morphBeforeOrAfter: anAboveBoolean]
+			ifFalse: [statement].
+		self sandblockEditor do: (SBRelInsertCommand new near: target before: anAboveBoolean in: statement owner morph: (DCUnknown new
+			language: self language;
+			contents: self language statementTerminator))]
 ]
 
 { #category : #'as yet unclassified' }
@@ -453,6 +469,13 @@ DCBlock >> range: aRange [
 	range := aRange
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> rootBlock [
+
+	self owner ifNil: [^ self].
+	^ self ownerSatisfying: [:o | o isTSBlock and: [o type = self language rootRuleName]]
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> slot [
 
@@ -584,12 +607,31 @@ DCBlock >> textMorphs [
 	^ self submorphs select: [:t | t isTextMorph]
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> treeHash [
+
+	self hasSubmorphs ifFalse: [^ self treeHashChildren: 0].
+	^ self treeHashChildren: (self submorphs inject: 0 into: [:hash :morph | hash bitXor: morph treeHash])
+]
+
+{ #category : #'as yet unclassified' }
+DCBlock >> treeHashChildren: anotherNumber [
+
+	^ ((self type hash bitXor: 'ENTER' hash) bitXor: anotherNumber) bitXor: 'LEAVE' hash
+]
+
+{ #category : #'as yet unclassified' }
+DCBlock >> treeLabel [
+
+	^ ''
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> tryApplyChange: aClosure [
 
 	| newTree oldTree oldCursorOffset oldSource |
 	oldCursorOffset := self activeTextMorph ifNotNil: #cursor.
-	oldTree := self containingFloat.
+	oldTree := self rootBlock.
 	oldSource := oldTree getSourceStringAndMark.
 	
 	aClosure
@@ -598,8 +640,8 @@ DCBlock >> tryApplyChange: aClosure [
 		value: (self activeTextMorph ifNotNil: [self activeTextMorph range start index + (oldCursorOffset - 1)])
 		value: [:newSource :newIndex |
 			newTree := (DCBlock parse: newSource language: self language)
-				position: self containingFloat position;
-				width: self containingFloat width.
+				position: oldTree position;
+				width: oldTree width.
 			self sandblockEditor do: (SBReplaceCommand new
 				target: oldTree replacer: newTree;
 				shouldMergeWithNext: true).
diff --git a/packages/DomainCode-Parser/DCEditTest.class.st b/packages/DomainCode-Parser/DCEditTest.class.st
index 6e6be86..d82bbc0 100644
--- a/packages/DomainCode-Parser/DCEditTest.class.st
+++ b/packages/DomainCode-Parser/DCEditTest.class.st
@@ -17,6 +17,36 @@ b;' language: SBJavascript.
 	self assert: 2 equals: editor childSandblocks first childSandblocks size
 ]
 
+{ #category : #'as yet unclassified' }
+DCEditTest >> testInsertsStatementTerminator [
+
+	| program editor |
+	program := DCBlock parse: 'a
+b.
+c.' language: SBTSSmalltalk.
+	editor := self editorAndWorldFor: program.
+	program childSandblocks second startInputAtEnd.
+	self type: '
+x' in: editor.
+	self assert: 'a
+b.
+x.
+c.' equals: editor childSandblocks first sourceString
+]
+
+{ #category : #'as yet unclassified' }
+DCEditTest >> testSmalltalkAssignmentKeywordMethod [
+
+	| program editor |
+	program := DCBlock parse: 'a: arg
+x := 3' language: SBTSSmalltalk.
+	editor := self editorAndWorldFor: program.
+	program lastDeepChild startInputAtEnd.
+	self type: '4' in: editor.
+	self assert: 'a:arg
+x := 34' equals: editor childSandblocks first sourceString
+]
+
 { #category : #'as yet unclassified' }
 DCEditTest >> testSwapBinaryAddition [
 
diff --git a/packages/DomainCode-Parser/DCText.class.st b/packages/DomainCode-Parser/DCText.class.st
index d76b773..6f0dcf4 100644
--- a/packages/DomainCode-Parser/DCText.class.st
+++ b/packages/DomainCode-Parser/DCText.class.st
@@ -117,6 +117,12 @@ DCText >> range: aRange [
 	range := aRange
 ]
 
+{ #category : #'as yet unclassified' }
+DCText >> rootBlock [
+
+	^ self owner rootBlock
+]
+
 { #category : #'as yet unclassified' }
 DCText >> shownColor [
 
@@ -129,6 +135,24 @@ DCText >> slot [
 	^ DCMockSlot new for: self
 ]
 
+{ #category : #'as yet unclassified' }
+DCText >> treeHash [
+
+	^ (self contents hash bitXor: 'LABEL_ENTER' hash) bitXor: 'LABEL_LEAVE' hash
+]
+
+{ #category : #'as yet unclassified' }
+DCText >> treeLabel [
+
+	^ self contents
+]
+
+{ #category : #'as yet unclassified' }
+DCText >> type [
+
+	^ ''
+]
+
 { #category : #'as yet unclassified' }
 DCText >> writeSourceOn: aStream indent: aNumber forCompare: aBoolean [
 
diff --git a/packages/DomainCode-Parser/DCUnknown.class.st b/packages/DomainCode-Parser/DCUnknown.class.st
index ed20797..ab6dc50 100644
--- a/packages/DomainCode-Parser/DCUnknown.class.st
+++ b/packages/DomainCode-Parser/DCUnknown.class.st
@@ -4,6 +4,12 @@ Class {
 	#category : #'DomainCode-Parser'
 }
 
+{ #category : #'as yet unclassified' }
+DCUnknown >> contents: aString [
+
+	self firstSubmorph contents: aString
+]
+
 { #category : #'as yet unclassified' }
 DCUnknown >> initialize [
 
diff --git a/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st b/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st
index a3c71da..f8cefa8 100644
--- a/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st
+++ b/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st
@@ -1134,9 +1134,14 @@ SBTSSmalltalk class >> grammarJson [
 { #category : #'configuration - layout' }
 SBTSSmalltalk class >> hardLineBreakBetween: aBlock and: anotherBlock [
 
+	(anotherBlock contents = '.' and: [aBlock contents ~= '.']) ifTrue: [^ false].
 	(({#statement. #empty. #comment} includes: aBlock slot lastNode type) and: [{#statement. #empty. #comment} includes: anotherBlock slot lastNode type]) ifTrue: [^ true].
 	(({#statement. #empty. #comment} includes: anotherBlock slot lastNode type) and: [(anotherBlock owner submorphs count: [:m | m slot lastNode type = #statement]) > 1]) ifTrue: [^ true].
-	(aBlock parentSandblock ifNotNil: #type) = #method ifTrue: [^ true].
+	SBToggledCode
+		comment: ''
+		active: 0
+		do: {[(aBlock parentSandblock ifNotNil: #type) = #method ifTrue: [^ true]]}.
+	(#(#'keyword_selector' #'unary_selector' #'binary_selector') includes: aBlock type) ifTrue: [^ true].
 	((aBlock slot isStatementIn: aBlock parentSandblock) and: [aBlock ~= aBlock parentSandblock childSandblocks last]) ifTrue: [^ true].
 	^ false
 ]
@@ -1238,6 +1243,7 @@ SBTSSmalltalk class >> softLineBreakBetween: aBlock and: anotherBlock [
 { #category : #'as yet unclassified' }
 SBTSSmalltalk class >> spaceBetween: aBlock and: anotherBlock lastCharacterOfFirst: aCharacter [
 
+	(aBlock contents = ':=' or: [anotherBlock contents = ':=']) ifTrue: [^ true].
 	anotherBlock alias = #'unary_identifier' ifTrue: [^ true].
 	^ super spaceBetween: aBlock and: anotherBlock lastCharacterOfFirst: aCharacter
 ]
diff --git a/packages/Sandblocks-TreeSitter/Morph.extension.st b/packages/Sandblocks-TreeSitter/Morph.extension.st
index 05a65a4..043f7c0 100644
--- a/packages/Sandblocks-TreeSitter/Morph.extension.st
+++ b/packages/Sandblocks-TreeSitter/Morph.extension.st
@@ -13,6 +13,12 @@ Morph >> containingInlineBlock [
 	^ self owner ifNotNil: [:o | o containingInlineBlock]
 ]
 
+{ #category : #'*Sandblocks-TreeSitter' }
+Morph >> descendantsPreOrder [
+
+	^ Array streamContents: [:s | self submorphs do: [:p | p allMorphsPreorderDo: [:m | s nextPut: m]]]
+]
+
 { #category : #'*Sandblocks-TreeSitter' }
 Morph >> firstDeepSubmorph [
 
@@ -57,3 +63,10 @@ Morph >> recursiveSubmorphCount [
 	self allMorphsDo: [:m | i := i + 1].
 	^ i
 ]
+
+{ #category : #'*Sandblocks-TreeSitter' }
+Morph >> treeHeight [
+
+	self hasSubmorphs ifFalse: [^ 0].
+	^ (self submorphs collect: [:m | m treeHeight]) max + 1
+]
diff --git a/packages/Sandblocks-TreeSitter/SBFileTree.class.st b/packages/Sandblocks-TreeSitter/SBFileTree.class.st
index a7f3d51..dcbf0cb 100644
--- a/packages/Sandblocks-TreeSitter/SBFileTree.class.st
+++ b/packages/Sandblocks-TreeSitter/SBFileTree.class.st
@@ -61,7 +61,13 @@ SBFileTree >> file [
 { #category : #'as yet unclassified' }
 SBFileTree >> handlesMouseOver: evt [
 
-	^ SBWatch report: true for: 619305281
+	^ false
+]
+
+{ #category : #'as yet unclassified' }
+SBFileTree >> hovered [
+
+	^ (self valueOfProperty: #actions ifAbsent: nil) notNil
 ]
 
 { #category : #'as yet unclassified' }
@@ -81,6 +87,7 @@ SBFileTree >> mouseEnter: evt [
 
 	super mouseEnter: evt.
 	
+	self firstSubmorph color: (Color gray: 0.9).
 	self toggleActions: true
 ]
 
@@ -89,7 +96,8 @@ SBFileTree >> mouseLeave: evt [
 
 	super mouseLeave: evt.
 	
-	self toggleActions: false
+	self toggleActions: false.
+	self firstSubmorph color: (Color gray alpha: 0)
 ]
 
 { #category : #'as yet unclassified' }
@@ -107,7 +115,9 @@ SBFileTree >> on: aFile [
 		addMorphBack: (SBRow new
 			hResizing: #spaceFill;
 			cellPositioning: #center;
-			cellGap: 8;
+			cellGap: 4;
+			on: #mouseEnter send: #mouseEnter: to: self;
+			on: #mouseLeave send: #mouseLeave: to: self;
 			addMorphBack: (aFile isDirectory
 				ifTrue: [SBIcon iconAngleRight on: #click send: #toggleExpand to: self]
 				ifFalse: [((SBTSFile languageForPath: aFile name) ifNil: [SBTSLanguage]) iconMorph]);
@@ -125,9 +135,7 @@ SBFileTree >> on: aFile [
 SBFileTree >> open [
 
 	self isDirectory ifTrue: [self toggleExpand].
-	(self ownerSatisfying: [:o | (o ownerThatIsA: self class) isNil])
-		triggerEvent: #open
-		with: file
+	self rootDirectory triggerEvent: #open with: file
 ]
 
 { #category : #'as yet unclassified' }
@@ -137,6 +145,12 @@ SBFileTree >> reload [
 	self toggleExpand
 ]
 
+{ #category : #'as yet unclassified' }
+SBFileTree >> rootDirectory [
+
+	^ self ownerSatisfying: [:o | (o ownerThatIsA: self class) isNil]
+]
+
 { #category : #'as yet unclassified' }
 SBFileTree >> toggleActions: aBoolean [
 
@@ -163,6 +177,7 @@ SBFileTree >> toggleExpand [
 	self firstSubmorph firstSubmorph changeIconName: #iconAngleDown.
 	self addMorphBack: (list := SBColumn new
 		layoutInset: (SBEdgeInsets left: 16);
+		cellGap: 1;
 		hResizing: #spaceFill).
 	file children
 		ifNotEmpty: [
diff --git a/packages/Sandblocks-Typescript/SBTypescript.class.st b/packages/Sandblocks-Typescript/SBTypescript.class.st
index 223dc82..e10b3d6 100644
--- a/packages/Sandblocks-Typescript/SBTypescript.class.st
+++ b/packages/Sandblocks-Typescript/SBTypescript.class.st
@@ -13,6 +13,12 @@ SBTypescript class >> addIndent: aBlock [
 	^ super addIndent: aBlock
 ]
 
+{ #category : #configuration }
+SBTypescript class >> blockBodyTypes [
+
+	^ {#'class_body'. #program. #'statement_block'}
+]
+
 { #category : #'as yet unclassified' }
 SBTypescript class >> defaultRuntimeClass [
 
@@ -11036,6 +11042,7 @@ SBTypescript class >> hardLineBreakBetween: aBlock and: anotherBlock [
 
 	(super hardLineBreakBetween: aBlock and: anotherBlock) ifTrue: [^ true].
 	aBlock parentSandblock type = #'class_body' ifTrue: [^ true].
+	({#'class_body'. #program. #'statement_block'} includes: aBlock parentSandblock type) ifTrue: [^ true].
 	anotherBlock type = #'else_clause' ifTrue: [^ true].
 	(aBlock contents = '{' and: [aBlock parentSandblock type = #'statement_block']) ifTrue: [^ true].
 	^ #(#'statement_block' #'class_body') includes: anotherBlock type