dc: add draft for ast diffing, ported from gumtree

.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
 }

packages/DomainCode-Core/.squot-contents

@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ 'b0f8b91f48b140dab0d584ce30237423' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotTonelSerializer
+}

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)
+]

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
+]

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: []
+]

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]
+]

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
+]

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]
+]

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
+]

packages/DomainCode-Core/package.st

@@ -0,0 +1 @@
+Package { #name : #'DomainCode-Core' }

packages/DomainCode-Diff/.squot-contents

@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ 'c4feeb7baa0d4f32a5bba86de4f6057a' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotTonelSerializer
+}