dc: integrate incremental editing

packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st

@@ -5,7 +5,7 @@ Class {
 }
 
 { #category : #'as yet unclassified' }
-DCChawatheScriptGenerator >> alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping do: aBlock [
+DCChawatheScriptGenerator >> alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping [
 
 	| s1 s2 lcs |
 	w submorphs do: [:c | srcInOrder remove: c ifAbsent: []].
@@ -23,33 +23,43 @@ DCChawatheScriptGenerator >> alignChildrenSrc: w dest: x srcInOrder: srcInOrder
 		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.
+				self move: a to: w at: k.
 				srcInOrder add: a.
-				srcInOrder add: b]]]
+				destInOrder add: b]]]
+]
+
+{ #category : #actions }
+DCChawatheScriptGenerator >> delete: aMorph [
+
+	aMorph delete
 ]
 
 { #category : #'as yet unclassified' }
-DCChawatheScriptGenerator >> findPosition: aTree dest: destInorder in: aMapping [
+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]]].
+	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]].
+	(siblings viewFirst: aTree submorphIndex) do: [:c | (destInOrder includes: c) ifTrue: [v := c]].
 
 	v ifNil: [^ 1].
 
 	u := aMapping srcForDest: v.
 
-	^ u submorphIndex
+	^ u submorphIndex + 1
 ]
 
 { #category : #'as yet unclassified' }
-DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping do: aBlock [
+DCChawatheScriptGenerator >> flashChanges [
+
+	^ true
+]
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping [
 
 	| srcInOrder destInOrder inserted |
 	srcInOrder := Set new.
@@ -61,32 +71,30 @@ DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping do: aBlock
 		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}.
+			ifFalse: [
 				w := x shallowCopyBlock.
 				inserted add: w.
-				z addMorph: w asElementNumber: k.
+				self insert: w at: (self findPosition: x dest: destInOrder in: aMapping) in: z.
 				aMapping addMappingFrom: w to: x]
 			ifTrue: [
 				w := aMapping srcForDest: x.
+				w range: x range.
 				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]]].
+					w treeLabel = x treeLabel ifFalse: [self update: w with: x contents].
+					z = v ifFalse: [self move: w to: z at: (self findPosition: x dest: destInOrder in: aMapping)]]].
 
 		srcInOrder add: w.
 		destInOrder add: x.
-		self alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping do: aBlock].
+		self alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping].
 
-	src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [aBlock value: #delete value: {w}]]
+	src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [self delete: w]]
+]
+
+{ #category : #actions }
+DCChawatheScriptGenerator >> insert: aMorph at: aNumber in: anOwnerMorph [
+
+	anOwnerMorph addMorph: aMorph asElementNumber: aNumber
 ]
 
 { #category : #'as yet unclassified' }
@@ -117,3 +125,21 @@ DCChawatheScriptGenerator >> lcsWith: x and: y in: aMapping [
 
 	^ lcs
 ]
+
+{ #category : #'as yet unclassified' }
+DCChawatheScriptGenerator >> maybeAttachFlash: aMorph [
+
+	self flashChanges ifTrue: [aMorph containingSandblock attachDecorator: SBFlashDecorator new]
+]
+
+{ #category : #actions }
+DCChawatheScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [
+
+	anOwnerMorph addMorph: aMorph asElementNumber: aNumber
+]
+
+{ #category : #actions }
+DCChawatheScriptGenerator >> update: aMorph with: aString [
+
+	aMorph contents: aString
+]

packages/DomainCode-Diff/DCCommandScriptGenerator.class.st

@@ -0,0 +1,80 @@
+Class {
+	#name : #DCCommandScriptGenerator,
+	#superclass : #DCChawatheScriptGenerator,
+	#instVars : [
+		'editor'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #actions }
+DCCommandScriptGenerator >> delete: aMorph [
+
+	self editor do: (SBDeleteCommand new
+		target: aMorph;
+		shouldMergeWithNext: true).
+	self logChanges ifTrue: [Transcript showln: {#delete. aMorph}]
+]
+
+{ #category : #accessing }
+DCCommandScriptGenerator >> editor [
+
+	^ editor
+]
+
+{ #category : #accessing }
+DCCommandScriptGenerator >> editor: anEditor [
+
+	editor := anEditor
+]
+
+{ #category : #'initialize-release' }
+DCCommandScriptGenerator >> initialize [
+
+	super initialize.
+
+	commands := OrderedCollection new
+]
+
+{ #category : #actions }
+DCCommandScriptGenerator >> insert: aMorph at: aNumber in: anOwnerMorph [
+
+	self editor do: (SBInsertCommand new
+		shouldMergeWithNext: true;
+		index: aNumber;
+		container: anOwnerMorph;
+		morph: aMorph).
+	self logChanges ifTrue: [Transcript showln: {#insert. anOwnerMorph. aNumber. aMorph}]
+]
+
+{ #category : #testing }
+DCCommandScriptGenerator >> logChanges [
+
+	^ false
+]
+
+{ #category : #actions }
+DCCommandScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [
+
+	self editor do: (SBMoveCommand new
+		shouldMergeWithNext: true;
+		container: anOwnerMorph;
+		morph: aMorph;
+		index: aNumber).
+	self logChanges ifTrue: [Transcript showln: {#move. anOwnerMorph. aNumber. aMorph}]
+]
+
+{ #category : #actions }
+DCCommandScriptGenerator >> update: aMorph with: aString [
+	"check if we have an active input command for this morph"
+
+	(editor currentInputCommand ifNotNil: #textMorph) = aMorph
+		ifTrue: [aMorph contents: aString]
+		ifFalse: [
+			self editor do: (SBMutatePropertyCommand new
+				shouldMergeWithNext: true;
+				target: aMorph;
+				selector: #contents;
+				value: aString)].
+	self logChanges ifTrue: [Transcript showln: {#update. aMorph. aString}]
+]

packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st

@@ -47,7 +47,6 @@ DCGreedyBottomUpMatcher >> matchFrom: src to: dest in: aMapping [
 				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]]]]

packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st

@@ -11,9 +11,9 @@ DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 	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].
+		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}]]].

packages/DomainCode-Diff/DCMatchTest.class.st

@@ -5,20 +5,23 @@ Class {
 }
 
 { #category : #'as yet unclassified' }
-DCMatchTest >> testSimple [
+DCMatchTest >> testAppendBinary [
 
-	| src dest mappings |
+	| src dest |
 	Transcript clear.
-	src := DCBlock parseBlock: 'a+1' language: SBJavascript.
-	dest := DCBlock parseBlock: '[a+1]' language: SBJavascript.
-	mappings := DCMappingStore new.
-	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
-	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
-	self halt.
-	Transcript showln: (Array streamContents: [:stream |
-		DCChawatheScriptGenerator new
-			generateFrom: src
-			to: dest
-			in: mappings
-			do: [:op :args | stream nextPut: {op. args}]])
+	src := DCBlock parseBlock: 'a' language: SBJavascript.
+	dest := DCBlock parseBlock: 'a+' language: SBJavascript.
+	DCMatcher new matchFrom: src to: dest.
+	self assert: 'a+' equals: src sourceString
+]
+
+{ #category : #'as yet unclassified' }
+DCMatchTest >> testSplitBinary [
+
+	| src dest |
+	Transcript clear.
+	src := DCBlock parseBlock: 'a2' language: SBJavascript.
+	dest := DCBlock parseBlock: 'a+2' language: SBJavascript.
+	DCMatcher new matchFrom: src to: dest.
+	self assert: 'a+2' equals: src sourceString
 ]

packages/DomainCode-Diff/DCMatcher.class.st

@@ -5,15 +5,28 @@ Class {
 }
 
 { #category : #'as yet unclassified' }
-DCMatcher >> matchFrom: src to: dest do: aBlock [
+DCMatcher >> applyEditsIn: aDest to: aSrc [
+
+	DCChawatheScriptGenerator new
+		generateFrom: aSrc
+		to: aDest
+		in: (self matchFrom: aSrc to: aDest)
+]
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [
+
+	DCCommandScriptGenerator new
+		editor: anEditor;
+		generateFrom: aSrc to: aDest in: (self matchFrom: aSrc to: aDest)
+]
+
+{ #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.
-	DCChawatheScriptGenerator new
-		generateFrom: src
-		to: dest
-		in: mappings
-		do: aBlock
+	^ mappings
 ]