Fix #1140: [Finder] Feature request: Allow saving edited method code

src/NewTools-Finder-Tests/StFinderSaveCodeTest.class.st

@@ -0,0 +1,159 @@
+Class {
+	#name : 'StFinderSaveCodeTest',
+	#superclass : 'StFinderTest',
+	#instVars : [
+		'oldMethod'
+	],
+	#category : 'NewTools-Finder-Tests-Core',
+	#package : 'NewTools-Finder-Tests',
+	#tag : 'Core'
+}
+
+{ #category : 'running' }
+StFinderSaveCodeTest >> setUp [
+
+	super setUp.
+
+	oldMethod := StFinderMockC
+	             >> #aBCSelectorSearchForRegexpStartWithCase
+]
+
+{ #category : 'running' }
+StFinderSaveCodeTest >> tearDown [
+
+	StFinderMockC methodDict at: oldMethod selector put: oldMethod.
+
+	(StFinderMockC includesSelector: #toto) ifTrue: [
+		StFinderMockC removeSelector: #toto ].
+
+	super tearDown
+]
+
+{ #category : 'tests' }
+StFinderSaveCodeTest >> testCodeEditionInFinderShouldBeSavedWisely [
+
+	self openInstance.
+	self setExactAndCaseInsensitive.
+	self doSearch: 'aBCSelectorSearchForRegexpStartWithCase'.
+
+	"Precondition to know we are in the right state before the real test"
+	self assert: presenter results size equals: 1.
+	self
+		assert: presenter previewSourcePresenter behavior
+		equals: StFinderMockC.
+
+	"Change the text, simulate cmd/ctrl s"
+	presenter previewSourcePresenter text: 'toto "source"'.
+	presenter previewSourcePresenter triggerSubmitAction.
+
+	self
+		assert: (StFinderMockC >> #toto) sourceCode
+		equals: 'toto "source"'.
+
+	self
+		assert: (StFinderMockC >> #toto) protocol
+		equals:
+		(StFinderMockC >> #aBCSelectorSearchForRegexpStartWithCase) protocol
+]
+
+{ #category : 'tests' }
+StFinderSaveCodeTest >> testFinderShouldModifyExistingMethod [
+
+	| existingProtocol |
+	self openInstance.
+	self setExactAndCaseInsensitive.
+	self doSearch: 'aBCSelectorSearchForRegexpStartWithCase'.
+
+	"Precondition to know we are in the right state before the real test"
+	self assert: presenter results size equals: 1.
+	existingProtocol := presenter previewSourcePresenter interactionModel
+		                    method protocol.
+	self
+		assert: presenter previewSourcePresenter behavior
+		equals: StFinderMockC.
+
+	"Change the text, simulate cmd/ctrl s"
+	presenter previewSourcePresenter text:
+		'aBCSelectorSearchForRegexpStartWithCase "source"'.
+	presenter previewSourcePresenter triggerSubmitAction.
+
+	self
+		assert:
+		(StFinderMockC >> #aBCSelectorSearchForRegexpStartWithCase)
+			sourceCode
+		equals: 'aBCSelectorSearchForRegexpStartWithCase "source"'.
+
+	self
+		assert:
+		(StFinderMockC >> #aBCSelectorSearchForRegexpStartWithCase) protocol
+		equals: existingProtocol
+]
+
+{ #category : 'tests' }
+StFinderSaveCodeTest >> testNewMethodCreation [
+
+	self openInstance.
+	self setExactAndCaseInsensitive.
+	self doSearch: 'aBCSelectorSearchForRegexpStartWithCase'.
+
+	"Precondition to know we are in the right state before the real test"
+	self assert: presenter results size equals: 1.
+	self
+		assert: presenter previewSourcePresenter behavior
+		equals: StFinderMockC.
+
+	"Change the text, simulate cmd/ctrl s"
+	presenter previewSourcePresenter text: 'toto "source"'.
+	presenter previewSourcePresenter triggerSubmitAction.
+
+	self
+		assert: (StFinderMockC >> #toto) sourceCode
+		equals: 'toto "source"'.
+
+	self
+		assert: (StFinderMockC >> #toto) protocol
+		equals:
+		(StFinderMockC >> #aBCSelectorSearchForRegexpStartWithCase) protocol
+]
+
+{ #category : 'tests' }
+StFinderSaveCodeTest >> testSearchMethodThenClassAndSubmitTextOnClassDoesNothing [
+
+	self openInstance.
+
+	"First find a method. This will set the wrong callback"
+	presenterModel currentSearch: StFinderSelectorSearch new.
+	self doSearch: 'aBCSelectorSearchForRegexpStartWithCase'.
+
+	"Now search the class. This should change the callback"
+	presenterModel currentSearch: StFinderClassSearch new.
+	self doSearch: 'mockC'.
+
+	"We find the class and metaclass"
+	self assert: presenter results size equals: 2.
+
+	"Change the text, simulate cmd/ctrl s"
+	presenter previewSourcePresenter text:
+		'aBCSelectorSearchForRegexpStartWithCase "source"'.
+
+	"This should to nothing. Smoke test..."
+	presenter previewSourcePresenter triggerSubmitAction
+]
+
+{ #category : 'tests' }
+StFinderSaveCodeTest >> testSubmitTextOnClassDoesNothing [
+
+	self openInstance.
+	presenterModel currentSearch: StFinderClassSearch new.
+	self doSearch: 'mockC'.
+
+	"We find the class and metaclass"
+	self assert: presenter results size equals: 2.
+
+	"Change the text, simulate cmd/ctrl s"
+	presenter previewSourcePresenter text:
+		'aBCSelectorSearchForRegexpStartWithCase "source"'.
+
+	"This should to nothing. Smoke test..."
+	presenter previewSourcePresenter triggerSubmitAction
+]

src/NewTools-Finder/StFinderClassResult.class.st

@@ -67,6 +67,7 @@ StFinderClassResult >> forFinderPreview: aSpCodePresenter [
 				displaySource: self getCompiledMethod
 				in: aSpCodePresenter ]
 		ifFalse: [ 
+			acceptTextCallback := nil.
 			aSpCodePresenter 
 				beForScripting;
 				text: self content definitionString ]

src/NewTools-Finder/StFinderExampleResult.class.st

@@ -36,6 +36,7 @@ StFinderExampleResult >> displayString [
 { #category : 'private' }
 StFinderExampleResult >> forFinderPreview: aSpCodePresenter [ 
 
+	acceptTextCallback := nil.
 	^ String empty
 ]
 

src/NewTools-Finder/StFinderPackageResult.class.st

@@ -33,6 +33,7 @@ StFinderPackageResult >> displayString [
 { #category : 'private' }
 StFinderPackageResult >> forFinderPreview: aSpCodePresenter [ 
 
+	acceptTextCallback := nil.
 	^ String empty
 ]
 

src/NewTools-Finder/StFinderPragmaResult.class.st

@@ -22,14 +22,17 @@ StFinderPragmaResult >> displayIcon [
 ]
 
 { #category : 'private' }
-StFinderPragmaResult >> forFinderPreview: aSpCodePresenter [ 
+StFinderPragmaResult >> forFinderPreview: aSpCodePresenter [
 
 	self parent
-		ifNil: [ aSpCodePresenter text: 'Please select a method expanding the selected item' ]
-		ifNotNil: [ 
-			self 
-				displaySource: (self content >> self parent content) 
-				in: aSpCodePresenter ]
+		ifNil: [
+				acceptTextCallback := nil.
+				aSpCodePresenter
+					text: 'Please select a method expanding the selected item' ]
+		ifNotNil: [
+				self
+					displaySource: self content >> self parent content
+					in: aSpCodePresenter ]
 ]
 
 { #category : 'instance creation' }

src/NewTools-Finder/StFinderPresenter.class.st

@@ -289,6 +289,9 @@ StFinderPresenter >> cleanResults [
 StFinderPresenter >> connectPresenters [
 
 	self connectSearchBar.
+	previewSourcePresenter whenSubmitDo: [ :text |
+		resultTree selectedItem 
+			acceptText: text in: previewSourcePresenter ].
 
 	configButton action: [
 		SettingBrowser new
@@ -455,6 +458,18 @@ StFinderPresenter >> notifySearchStarted [
 
 ]
 
+{ #category : 'accessing' }
+StFinderPresenter >> previewSourcePresenter [
+
+	^ previewSourcePresenter
+]
+
+{ #category : 'accessing' }
+StFinderPresenter >> previewSourcePresenter: anObject [
+
+	previewSourcePresenter := anObject
+]
+
 { #category : 'accessing' }
 StFinderPresenter >> resultButtonBar [
 
@@ -467,6 +482,12 @@ StFinderPresenter >> resultTree [
 	^ resultTree
 ]
 
+{ #category : 'accessing' }
+StFinderPresenter >> results [
+
+	^ self resultTree roots
+]
+
 { #category : 'accessing' }
 StFinderPresenter >> searchBar [
 

src/NewTools-Finder/StFinderResult.class.st

@@ -13,7 +13,8 @@ Class {
 		'content',
 		'parent',
 		'children',
-		'application'
+		'application',
+		'acceptTextCallback'
 	],
 	#category : 'NewTools-Finder-Result',
 	#package : 'NewTools-Finder',
@@ -31,6 +32,13 @@ StFinderResult class >> newFor: aCompiledMethod [
 
 ]
 
+{ #category : 'visiting' }
+StFinderResult >> acceptText: aString in: aSpCodePresenter [ 
+
+	acceptTextCallback ifNil: [ ^ nil ].
+	^ acceptTextCallback	value: aString value: aSpCodePresenter
+]
+
 { #category : 'adding' }
 StFinderResult >> addChild: aFinderResult [
 
@@ -69,6 +77,18 @@ StFinderResult >> children: anObject [
 	children := anObject
 ]
 
+{ #category : 'compiling' }
+StFinderResult >> compileMethodWithSource: text in: aSpCodePresenter [
+
+	| selectedClass |
+	selectedClass := aSpCodePresenter behavior.
+
+	^ selectedClass
+		  compile: text
+		  classified: aSpCodePresenter interactionModel method protocol name
+		  notifying: nil
+]
+
 { #category : 'accessing' }
 StFinderResult >> content [
 
@@ -90,7 +110,9 @@ StFinderResult >> displayIcon [
 { #category : 'displaying' }
 StFinderResult >> displaySource: aCompiledMethod in: aSpCodePresenter [
 
-	aSpCodePresenter 
+	acceptTextCallback := [ :text :codePresenter |
+		self compileMethodWithSource: text in: codePresenter ].
+	aSpCodePresenter
 		beForMethod: aCompiledMethod;
 		text: aCompiledMethod sourceCode
 ]

src/NewTools-Finder/StFinderSelectorResult.class.st

@@ -41,7 +41,8 @@ StFinderSelectorResult >> displayIcon [
 StFinderSelectorResult >> forFinderPreview: aSpCodePresenter [ 
 
 	self parent
-		ifNil: [ 
+		ifNil: [
+			acceptTextCallback := nil.
 			aSpCodePresenter 
 				beForScripting;
 				text: 'Please select a method implementation expanding the selected item' ]

src/NewTools-Finder/StFinderTraitResult.class.st

@@ -34,10 +34,11 @@ StFinderTraitResult >> displayIcon [
 { #category : 'action' }
 StFinderTraitResult >> forFinderPreview: aSpCodePresenter [
 
-	^ self parent
-		  ifNotNil: [ self displaySource: self getCompiledMethod in: aSpCodePresenter ]
-		  ifNil: [
-			  aSpCodePresenter
-				  beForScripting;
-				  text: self content definitionString ]
+	^ self parent ifNotNil: [
+		  self displaySource: self getCompiledMethod in: aSpCodePresenter
+		] ifNil: [
+			acceptTextCallback := nil.
+			aSpCodePresenter
+				beForScripting;
+				text: self content definitionString ]
 ]