diff --git a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
index 3adf3c8..67fbf3b 100644
--- a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
+++ b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st
@@ -88,7 +88,7 @@ DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping [
 		destInOrder add: x.
 		self alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping].
 	
-	src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [self delete: w]]
+	(Array streamContents: [:s | src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [s nextPut: w]]]) do: [:w | self delete: w]
 ]
 
 { #category : #actions }
diff --git a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st b/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st
index 5c1e2bb..d337eb5 100644
--- a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st
+++ b/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st
@@ -44,6 +44,7 @@ DCCommandScriptGenerator >> insert: aMorph at: aNumber in: anOwnerMorph [
 		index: aNumber;
 		container: anOwnerMorph;
 		morph: aMorph).
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#insert. anOwnerMorph. aNumber. aMorph}]
 ]
 
@@ -61,6 +62,7 @@ DCCommandScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [
 		container: anOwnerMorph;
 		morph: aMorph;
 		index: aNumber).
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#move. anOwnerMorph. aNumber. aMorph}]
 ]
 
@@ -76,5 +78,6 @@ DCCommandScriptGenerator >> update: aMorph with: aString [
 				target: aMorph;
 				selector: #contents;
 				value: aString)].
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#update. aMorph. aString}]
 ]
diff --git a/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st b/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
index 7bc622a..4ac4a9d 100644
--- a/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
+++ b/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st
@@ -1,6 +1,10 @@
 Class {
 	#name : #DCGreedyBottomUpMatcher,
 	#superclass : #Object,
+	#instVars : [
+		'rootDest',
+		'sizeThreshold'
+	],
 	#category : #'DomainCode-Diff'
 }
 
@@ -20,7 +24,7 @@ DCGreedyBottomUpMatcher >> destCandidatesFor: src in: aMapping [
 			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].
+			(parent type = src type and: [((aMapping isDestMapped: parent) or: [parent = rootDest]) not]) ifTrue: [candidates add: parent].
 			current := parent]].
 	
 	^ candidates
@@ -38,8 +42,8 @@ DCGreedyBottomUpMatcher >> lastChanceMatchFrom: src to: dest in: aMapping [
 
 { #category : #'as yet unclassified' }
 DCGreedyBottomUpMatcher >> matchFrom: src to: dest in: aMapping [
-	"post-order"
 
+	rootDest := dest.
 	src allMorphsDo: [:t |
 		src = t
 			ifTrue: [
@@ -61,5 +65,11 @@ DCGreedyBottomUpMatcher >> similarityThreshold [
 { #category : #'as yet unclassified' }
 DCGreedyBottomUpMatcher >> sizeThreshold [
 
-	^ 1000
+	^ sizeThreshold ifNil: [5]
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> sizeThreshold: aNumber [
+
+	sizeThreshold := aNumber
 ]
diff --git a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
index 917aae4..071fd18 100644
--- a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
+++ b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st
@@ -1,6 +1,10 @@
 Class {
 	#name : #DCGreedySubtreeMatcher,
 	#superclass : #Object,
+	#instVars : [
+		'rootSrc',
+		'rootDest'
+	],
 	#category : #'DomainCode-Diff'
 }
 
@@ -8,7 +12,9 @@ Class {
 DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 
 	| comparator |
-	comparator := DCMappingComparator new mappingStore: aMapping.
+	comparator := DCMappingComparator new
+		rootSrc: rootSrc rootDest: rootDest;
+		mappingStore: aMapping.
 	
 	aCollection sort: [:m1 :m2 | | s1 s2 |
 		s1 := m1 first detectMax: [:t | t recursiveSubmorphCount].
@@ -25,6 +31,9 @@ DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 DCGreedySubtreeMatcher >> matchFrom: src to: dest in: aMapping [
 
 	| ambiguousMappings srcTrees destTrees |
+	rootSrc := src.
+	rootDest := dest.
+	
 	ambiguousMappings := OrderedCollection new.
 	srcTrees := DCPriorityTreeQueue new add: src.
 	destTrees := DCPriorityTreeQueue new add: dest.
@@ -34,6 +43,7 @@ DCGreedySubtreeMatcher >> matchFrom: src to: dest in: aMapping [
 		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 |
diff --git a/packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st b/packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st
new file mode 100644
index 0000000..e98a502
--- /dev/null
+++ b/packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st
@@ -0,0 +1,73 @@
+Class {
+	#name : #DCLeftOverLeafMatcher,
+	#superclass : #Object,
+	#instVars : [
+		'rootSrc',
+		'rootDest'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCLeftOverLeafMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
+
+	| comparator |
+	comparator := DCMappingComparator new
+		rootSrc: rootSrc rootDest: rootDest;
+		mappingStore: aMapping.
+	
+	aCollection sort: [:m1 :m2 | | s1 s2 |
+		s1 := m1 first detectMax: [:t | t recursiveSubmorphCount].
+		s2 := m2 first detectMax: [:t | t recursiveSubmorphCount].
+		s1 recursiveSubmorphCount < s2 recursiveSubmorphCount].
+	
+	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) <= 0]) do: [:mapping | (aMapping areBothUnmappedSrc: mapping first dest: mapping second) ifTrue: [aMapping addRecursiveMappingFrom: mapping first to: mapping second]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCLeftOverLeafMatcher >> matchFrom: src to: dest in: aMapping [
+
+	| ambiguousMappings srcTrees destTrees |
+	rootSrc := src.
+	rootDest := dest.
+	
+	ambiguousMappings := OrderedCollection new.
+	srcTrees := DCPriorityTreeQueue new
+		minimumHeight: 0;
+		addAll: (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]]).
+	destTrees := DCPriorityTreeQueue new
+		minimumHeight: 0;
+		addAll: (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]]).
+	
+	[
+		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' }
+DCLeftOverLeafMatcher >> 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/DCMappingComparator.class.st b/packages/DomainCode-Diff/DCMappingComparator.class.st
index d3d44d4..fe38282 100644
--- a/packages/DomainCode-Diff/DCMappingComparator.class.st
+++ b/packages/DomainCode-Diff/DCMappingComparator.class.st
@@ -6,7 +6,9 @@ Class {
 		'destDescendants',
 		'mappingStore',
 		'srcAncestors',
-		'destAncestors'
+		'destAncestors',
+		'rootSrc',
+		'rootDest'
 	],
 	#category : #'DomainCode-Diff'
 }
@@ -65,9 +67,9 @@ DCMappingComparator >> distanceAbsoluteCompare: aMapping with: anotherMapping [
 
 	| position distance |
 	"compare the post-order position in the tree of the mapping, between src and dest"
-	position := [:tree | tree rootBlock absolutePositionOf: tree].
-	distance := [:mapping | ((position value: mapping first) - (position value: mapping second)) abs].
-	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+	position := [:tree :root | root absolutePositionOf: tree].
+	distance := [:mapping | ((position value: mapping first value: rootSrc) - (position value: mapping second value: rootDest)) abs].
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -76,7 +78,7 @@ 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
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -144,16 +146,27 @@ DCMappingComparator >> numberOfCommonParentsIn: src and: dest [
 	^ (self longestCommonSubsequenceWith: (srcAncestors at: src) and: (destAncestors at: dest)) size
 ]
 
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> rootSrc: aBlock rootDest: anotherBlock [
+
+	rootSrc := aBlock.
+	rootDest := anotherBlock
+]
+
 { #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.
+	srcAncestors at: aMapping first ifAbsentPut: (aMapping first allParentsUpTo: rootSrc).
+	destAncestors at: aMapping second ifAbsentPut: (aMapping second allParentsUpTo: rootDest).
+	srcAncestors
+		at: anotherMapping first
+		ifAbsentPut: (anotherMapping first allParentsUpTo: rootSrc).
+	destAncestors
+		at: anotherMapping second
+		ifAbsentPut: (anotherMapping second allParentsUpTo: rootDest).
 	
 	s1 := self class
 		diceCoefficientCommon: (self numberOfCommonParentsIn: aMapping first and: aMapping second)
@@ -164,7 +177,7 @@ DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
 		left: (srcAncestors at: anotherMapping first) size
 		right: (destAncestors at: anotherMapping second) size.
 	
-	^ (s2 - s1) sign
+	^ (s1 - s2) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -186,7 +199,7 @@ DCMappingComparator >> similarityPositionInParentsCompare: aMapping with: anothe
 			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
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -204,5 +217,5 @@ DCMappingComparator >> similaritySiblingsCompare: aMapping with: anotherMapping
 		left: (srcDescendants at: anotherMapping first owner) size
 		right: (destDescendants at: anotherMapping second owner) size.
 	
-	^ (s2 - s1) sign
+	^ (s1 - s2) sign
 ]
diff --git a/packages/DomainCode-Diff/DCMappingStore.class.st b/packages/DomainCode-Diff/DCMappingStore.class.st
index aa59e5c..43812b8 100644
--- a/packages/DomainCode-Diff/DCMappingStore.class.st
+++ b/packages/DomainCode-Diff/DCMappingStore.class.st
@@ -11,7 +11,7 @@ Class {
 { #category : #'as yet unclassified' }
 DCMappingStore >> addMappingFrom: src to: dest [
 
-	self assert: src rootBlock ~= dest rootBlock.
+	SBToggledCode comment: '' active: 0 do: {[src treeLabel = 'function' ifTrue: [self halt]]}.
 	srcToDest at: src put: dest.
 	destToSrc at: dest put: src
 ]
@@ -41,6 +41,12 @@ DCMappingStore >> destForSrc: t [
 	^ srcToDest at: t ifAbsent: [nil]
 ]
 
+{ #category : #'as yet unclassified' }
+DCMappingStore >> destToSrc [
+
+	^ destToSrc
+]
+
 { #category : #'as yet unclassified' }
 DCMappingStore >> initialize [
 
@@ -73,3 +79,9 @@ DCMappingStore >> srcForDest: t [
 
 	^ destToSrc at: t ifAbsent: [nil]
 ]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> srcToDest [
+
+	^ srcToDest
+]
diff --git a/packages/DomainCode-Diff/DCMatcher.class.st b/packages/DomainCode-Diff/DCMatcher.class.st
index 40cefd0..d32de22 100644
--- a/packages/DomainCode-Diff/DCMatcher.class.st
+++ b/packages/DomainCode-Diff/DCMatcher.class.st
@@ -13,6 +13,20 @@ DCMatcher >> applyEditsIn: aDest to: aSrc [
 		in: (self matchFrom: aSrc to: aDest)
 ]
 
+{ #category : #'as yet unclassified' }
+DCMatcher >> commonAncestorOf: aCollection root: aTree [
+
+	| current |
+	aCollection ifEmpty: [^ nil].
+	
+	current := aCollection first owner.
+	[current ~= aTree] whileTrue: [
+		(aCollection allSatisfy: [:t | t = current or: [t hasOwner: current]]) ifTrue: [^ current].
+		current := current owner].
+	
+	^ aTree
+]
+
 { #category : #'as yet unclassified' }
 DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [
 
@@ -21,6 +35,47 @@ DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [
 		generateFrom: aSrc to: aDest in: (self matchFrom: aSrc to: aDest)
 ]
 
+{ #category : #'as yet unclassified' }
+DCMatcher >> fineGrainedMatch2From: src to: dest in: aMapping [
+
+	| topSrc topDest |
+	topSrc := self
+		commonAncestorOf: (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]])
+		root: src.
+	topDest := self
+		commonAncestorOf: (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]])
+		root: dest.
+	(topSrc notNil and: [topDest notNil]) ifTrue: [
+		SBToggledCode
+			comment: ''
+			active: 0
+			do: {[self assert: (aMapping destForSrc: topSrc owner) = topDest owner]}.
+		DCGreedyBottomUpMatcher new
+			sizeThreshold: 900000000;
+			lastChanceMatchFrom: topSrc to: topDest in: aMapping]
+]
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> fineGrainedMatchFrom: src to: dest in: aMapping [
+
+	| topSrc topDest |
+	topSrc := (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight.
+	topDest := (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight.
+	
+	self halt.
+	topSrc ifNotNil: [
+		self assert: (aMapping destForSrc: topSrc owner) = topDest owner.
+		DCGreedyBottomUpMatcher new
+			sizeThreshold: 900000000;
+			lastChanceMatchFrom: topSrc to: topDest in: aMapping]
+]
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> largestUnmappedFor: aTree isSrc: aBoolean in: aMapping [
+
+	^ (Array streamContents: [:s | aTree allMorphsDo: [:k | (aBoolean ifTrue: [aMapping isSrcMapped: k] ifFalse: [aMapping isDestMapped: k]) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight
+]
+
 { #category : #'as yet unclassified' }
 DCMatcher >> matchFrom: src to: dest [
 
@@ -28,5 +83,11 @@ DCMatcher >> matchFrom: src to: dest [
 	mappings := DCMappingStore new.
 	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
 	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
+	SBToggledCode
+		comment: ''
+		active: 0
+		do: {[DCLeftOverLeafMatcher new matchFrom: src to: dest in: mappings]}.
+	self fineGrainedMatch2From: src to: dest in: mappings.
+	
 	^ mappings
 ]
diff --git a/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
index 66106e5..ff5d9bc 100644
--- a/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
+++ b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st
@@ -2,7 +2,8 @@ Class {
 	#name : #DCPriorityTreeQueue,
 	#superclass : #Object,
 	#instVars : [
-		'collection'
+		'collection',
+		'minimumHeight'
 	],
 	#category : #'DomainCode-Diff'
 }
@@ -13,6 +14,12 @@ DCPriorityTreeQueue >> add: tree [
 	tree treeHeight >= self minimumHeight ifTrue: [collection add: tree]
 ]
 
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> addAll: aCollection [
+
+	aCollection do: [:tree | self add: tree]
+]
+
 { #category : #'as yet unclassified' }
 DCPriorityTreeQueue >> addTree: tree [
 
@@ -42,7 +49,13 @@ DCPriorityTreeQueue >> isEmpty [
 { #category : #'as yet unclassified' }
 DCPriorityTreeQueue >> minimumHeight [
 
-	^ 1
+	^ minimumHeight ifNil: [0]
+]
+
+{ #category : #'as yet unclassified' }
+DCPriorityTreeQueue >> minimumHeight: aNumber [
+
+	minimumHeight := aNumber
 ]
 
 { #category : #'as yet unclassified' }
diff --git a/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
index 9b4fb6d..70e672b 100644
--- a/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
+++ b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st
@@ -24,17 +24,14 @@ DCZhangShashaMatcher >> computeForestDistFrom: zsSrc at: i to: zsDest at: j in:
 				ifTrue: [ | costUpdate cost |
 					1.
 					costUpdate := self updateCostFrom: (zsSrc treeAt: di) to: (zsDest treeAt: dj).
-					cost := {
-						(forestDist at0: di - 1 at0: dj) + costDeletion.
-						(forestDist at0: di at0: dj - 1) + constInsertion.
-						(forestDist at0: di - 1 at0: dj - 1) + costUpdate} min.
+					cost := ((forestDist at0: di at0: dj - 1) + constInsertion min: (forestDist at0: di - 1 at0: dj - 1) + costUpdate) min: (forestDist at0: di - 1 at0: dj) + costDeletion.
 					forestDist at0: di at0: dj put: cost.
 					treeDist at0: di at0: dj put: cost]
 				ifFalse: [
-					forestDist at0: di at0: dj put: {
-						(forestDist at0: di - 1 at0: dj) + costDeletion.
-						(forestDist at0: di at0: dj - 1) + constInsertion.
-						(forestDist at0: (zsSrc lldAt: di) - 1 at0: (zsDest lldAt: dj) - 1) + (treeDist at0: di at0: dj)} min]]]
+					forestDist
+						at0: di
+						at0: dj
+						put: (((forestDist at0: di - 1 at0: dj) + costDeletion min: (forestDist at0: (zsSrc lldAt: di) - 1 at0: (zsDest lldAt: dj) - 1) + (treeDist at0: di at0: dj)) min: (forestDist at0: di at0: dj - 1) + constInsertion)]]]
 ]
 
 { #category : #'as yet unclassified' }
@@ -94,6 +91,7 @@ DCZhangShashaMatcher >> levenshteinDistanceFrom: aString to: anotherString [
 DCZhangShashaMatcher >> matchFrom: src to: dest in: aMappingStore [
 
 	| zsSrc zsDest treePairQueue rootNodePair forestDist treeDist |
+	SBToggledCode comment: '' active: 0 do: {[Transcript showln: {src. dest}]}.
 	zsSrc := DCZhangShashaTree new for: src.
 	zsDest := DCZhangShashaTree new for: dest.
 	
@@ -110,7 +108,7 @@ DCZhangShashaMatcher >> matchFrom: src to: dest in: aMappingStore [
 		rootNodePair ifTrue: [rootNodePair := false] ifFalse: [
 			"need to recalc tree/forestDist?"
 			self flag: #todo.
-			SBToggledCode comment: '' active: 0 do: {
+			SBToggledCode comment: '' active: 1 do: {
 				[self computeForestDistFrom: zsSrc at: lastRow to: zsDest at: lastCol in: forestDist treeDist: treeDist]}].
 		
 		firstRow := (zsSrc lldAt: lastRow) - 1.
diff --git a/packages/DomainCode-Diff/Matrix.extension.st b/packages/DomainCode-Diff/Matrix.extension.st
index 49a9d5c..435d84c 100644
--- a/packages/DomainCode-Diff/Matrix.extension.st
+++ b/packages/DomainCode-Diff/Matrix.extension.st
@@ -3,11 +3,23 @@ Extension { #name : #Matrix }
 { #category : #'*DomainCode-Diff' }
 Matrix >> at0: row at0: column [
 
-	^ self at: row + 1 at: column + 1
+	^ contents at: row * ncols + (column + 1)
 ]
 
 { #category : #'*DomainCode-Diff' }
 Matrix >> at0: row at0: column put: anObject [
 
-	^ self at: row + 1 at: column + 1 put: anObject
+	^ contents at: row * ncols + (column + 1) put: anObject
+]
+
+{ #category : #'*DomainCode-Diff' }
+Matrix >> atFast: row at: column [
+
+	^ contents at: row - 1 * ncols + column
+]
+
+{ #category : #'*DomainCode-Diff' }
+Matrix >> atFast: row at: column put: anObject [
+
+	^ contents at: row - 1 * ncols + column put: anObject
 ]
diff --git a/packages/DomainCode-Diff/String.extension.st b/packages/DomainCode-Diff/String.extension.st
index 466d369..8db4e23 100644
--- a/packages/DomainCode-Diff/String.extension.st
+++ b/packages/DomainCode-Diff/String.extension.st
@@ -4,24 +4,23 @@ Extension { #name : #String }
 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].
+	"consider https://docs.python.org/3/library/difflib.html"
+	self size = 0 ifTrue: [^ 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].
+	1 to: stab columnCount do: [:i | stab atFast: 1 at: i put: i - 1].
+	1 to: stab rowCount do: [:i | stab atFast: 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
+				atFast: 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
+				put: (((stab atFast: j at: i - 1) + 1 min: (stab atFast: j - 1 at: i - 1) + cost) min: (stab atFast: j - 1 at: i) + 1)]].
+	^ stab atFast: stab rowCount at: stab columnCount
 ]
 
 { #category : #'*DomainCode-Diff' }
diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st
index bb2feb0..6fbc8e5 100644
--- a/packages/DomainCode-Parser/DCBlock.class.st
+++ b/packages/DomainCode-Parser/DCBlock.class.st
@@ -133,10 +133,18 @@ DCBlock >> alias [
 { #category : #'as yet unclassified' }
 DCBlock >> allParents [
 
+	^ self allParentsUpTo: self rootBlock
+]
+
+{ #category : #'as yet unclassified' }
+DCBlock >> allParentsUpTo: aBlock [
+
+	self = aBlock ifTrue: [^ #()].
+	
 	^ Array streamContents: [:s |
-		self ownerSatisfying: [:o |
+		self assert: (self ownerSatisfying: [:o |
 			s nextPut: o.
-			o = self rootBlock]]
+			o = aBlock]) notNil]
 ]
 
 { #category : #'as yet unclassified' }
@@ -164,6 +172,13 @@ DCBlock >> contentsToDisplay [
 	^ self contents
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> copyRangesFrom: newTree to: oldTree [
+
+	oldTree range: newTree range.
+	newTree submorphs with: oldTree submorphs do: [:a :b | self copyRangesFrom: a to: b]
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> currentTextMorph [
 
@@ -171,6 +186,17 @@ DCBlock >> currentTextMorph [
 	^ nil
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> deleteAfterCursor [
+	<action>
+
+	self tryApplyChange: [:source :textMorph :cursorIndex :apply |
+		self
+			deleteFrom: source
+			at: cursorIndex + 1
+			do: [:new :edit | apply value: new value: edit value: cursorIndex]]
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> deleteBeforeCursor [
 	<action>
@@ -240,7 +266,7 @@ DCBlock >> findLastMatchingAncesors: aCollection oldTree: aBlock [
 			^ {oldCurrent owner. newCurrent owner}]].
 	
 	self assert: aCollection first type = oldCurrent type.
-	^ {aCollection first. oldCurrent}
+	^ {oldCurrent. aCollection first}
 ]
 
 { #category : #'as yet unclassified' }
@@ -580,8 +606,6 @@ DCBlock >> replace: oldTree with: newTree [
 			editor := self sandblockEditor.
 			DCMatcher new doCommandForEditsIn: newTree to: oldTree in: editor.
 			editor history noMoreMerge.
-			oldTree setProperty: #tsTree toValue: (newTree valueOfProperty: #tsTree).
-			oldTree setProperty: #tsSource toValue: (newTree valueOfProperty: #tsSource).
 			oldTree].
 		[
 			self sandblockEditor do: (SBReplaceCommand new
@@ -767,12 +791,29 @@ DCBlock >> tryApplyChange: aClosure [
 		value: [:newSource :edit :newIndex |
 			newTree := DCBlock parse: newSource old: oldTree edit: edit language: self language.
 			
-			newTree second ifNotEmpty: [:changedRanges | | change newContained |
-				change := SBTSRange merging: changedRanges.
-				newContained := newTree first smallestBlockEncompassig: change.
-				self findLastMatchingAncesors: {newContained}, newContained allParents oldTree: oldTree].
+			SBToggledCode comment: '' active: 1 do: {
+				[self replace: oldTree with: newTree first].
+				[
+					newTree second
+						ifNotEmpty: [:changedRanges | | change newContained pair |
+							change := SBTSRange merging: changedRanges.
+							newContained := newTree first smallestBlockEncompassig: change.
+							pair := self findLastMatchingAncesors: {newContained}, newContained allParents oldTree: oldTree.
+							self replace: pair first with: pair second]
+						ifEmpty: [ | pair |
+							"empty change means no structures were changed, only contents"
+							pair := self
+								findLastMatchingAncesors: {
+									self sandblockEditor currentInputCommand ifNotNil: #textMorph.
+									self sandblockEditor currentInputCommand ifNotNil: #block}, (self sandblockEditor currentInputCommand ifNotNil: #block) allParents
+								oldTree: newTree first.
+							pair second contents: pair first contents].
+					self copyRangesFrom: newTree first to: oldTree]}.
+			
+			oldTree
+				setProperty: #tsTree toValue: (newTree first valueOfProperty: #tsTree);
+				setProperty: #tsSource toValue: (newTree first valueOfProperty: #tsSource).
 			
-			self replace: oldTree with: newTree first.
 			self placeCursorIn: oldTree at: newIndex]
 ]
 
diff --git a/packages/DomainCode-Parser/DCEditTest.class.st b/packages/DomainCode-Parser/DCEditTest.class.st
index d82bbc0..ff341c3 100644
--- a/packages/DomainCode-Parser/DCEditTest.class.st
+++ b/packages/DomainCode-Parser/DCEditTest.class.st
@@ -4,6 +4,18 @@ Class {
 	#category : #'DomainCode-Parser'
 }
 
+{ #category : #'as yet unclassified' }
+DCEditTest >> testAcceptJS [
+	<timeout: 9000>
+
+	| src editor |
+	src := 'function() {}'.
+	editor := self editorFor: (DCBlock parseBlock: src first asString language: SBJavascript).
+	src allButFirst
+		do: [:char | editor handle: (self keyboardEvent: char)]
+		displayingProgress: 'a'
+]
+
 { #category : #'as yet unclassified' }
 DCEditTest >> testDeleteEmptyLine [
 
diff --git a/packages/DomainCode-Parser/DCText.class.st b/packages/DomainCode-Parser/DCText.class.st
index 8006d70..1242509 100644
--- a/packages/DomainCode-Parser/DCText.class.st
+++ b/packages/DomainCode-Parser/DCText.class.st
@@ -15,6 +15,12 @@ DCText >> alias [
 	^ nil
 ]
 
+{ #category : #'as yet unclassified' }
+DCText >> allParentsUpTo: aBlock [
+
+	^ {self}, (self containingSandblock allParentsUpTo: aBlock)
+]
+
 { #category : #'as yet unclassified' }
 DCText >> compatibleWithType: aSymbol [
 
@@ -27,6 +33,12 @@ DCText >> effectiveContents [
 	^ self contents
 ]
 
+{ #category : #'as yet unclassified' }
+DCText >> ensureLayouted [
+
+	self owner ensureLayouted
+]
+
 { #category : #'as yet unclassified' }
 DCText >> field [