From e8bacc97a4854494969453e09cbbf83ad8db66bd Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Thu, 23 May 2024 11:43:01 +0200
Subject: [PATCH 1/7] Introduce NewTools-Utils

---
 src/BaselineOfNewTools/BaselineOfNewTools.class.st    | 11 +++--------
 src/NewTools-Compression-Utils/package.st             |  1 -
 src/NewTools-Fuel/package.st                          |  1 -
 .../FLFuelCommandLineHandler.class.st                 |  6 +++---
 .../FLMaterializer.extension.st                       |  6 +++---
 .../InflateStream.extension.st                        |  4 ++--
 .../Object.extension.st                               |  2 +-
 .../ZipArchive.extension.st                           |  2 +-
 src/NewTools-Utils/package.st                         |  1 +
 9 files changed, 14 insertions(+), 20 deletions(-)
 delete mode 100644 src/NewTools-Compression-Utils/package.st
 delete mode 100644 src/NewTools-Fuel/package.st
 rename src/{NewTools-Fuel => NewTools-Utils}/FLFuelCommandLineHandler.class.st (96%)
 rename src/{NewTools-Fuel => NewTools-Utils}/FLMaterializer.extension.st (80%)
 rename src/{NewTools-Compression-Utils => NewTools-Utils}/InflateStream.extension.st (87%)
 rename src/{NewTools-Fuel => NewTools-Utils}/Object.extension.st (83%)
 rename src/{NewTools-Compression-Utils => NewTools-Utils}/ZipArchive.extension.st (90%)
 create mode 100644 src/NewTools-Utils/package.st

diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
index 844ae94ea..22e5bbee2 100644
--- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st
+++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
@@ -81,7 +81,6 @@ BaselineOfNewTools >> baseline: spec [
 			"Fuel"
 			package: 'NewTools-Debugger-Fuel';
 			package: 'NewTools-Debugger-Fuel-Tests' with: [ spec requires: #( 'NewTools-Debugger-Fuel' ) ];
-			package: 'NewTools-Fuel';
      		"Rewriter Tools"
 			package: 'NewTools-RewriterTools-Backend';
 			package: 'NewTools-RewriterTools' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
@@ -104,7 +103,7 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-SettingsBrowser' with: [ spec requires: #('ColorPicker') ];
 			package: 'NewTools-SettingsBrowser-Tests' with: [ spec requires: #('NewTools-SettingsBrowser') ];
 			
-			package: 'NewTools-Compression-Utils' with: [ spec requires: #('NewTools-FileBrowser') ].			
+			package: 'NewTools-Utils' with: [ spec requires: #('NewTools-FileBrowser') ].			
 
 		spec
 			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
@@ -124,7 +123,7 @@ BaselineOfNewTools >> baseline: spec [
 				    	'NewTools-Debugger-Tests' 
 					 	'NewTools-Debugger-Fuel'
 				    	'NewTools-Debugger-Fuel-Tests' 
-					 	'NewTools-Fuel'
+					 	'NewTools-Utils'
 						'NewTools-DebugPointsBrowser'
 						'NewTools-ObjectCentricDebugPoints' );
 			group: 'Spotter' with: #( 
@@ -172,9 +171,6 @@ BaselineOfNewTools >> baseline: spec [
 			group: 'SettingsBrowser' with: #(
 						'NewTools-SettingsBrowser'
 						'NewTools-SettingsBrowser-Tests');
-			"Compression Utilities"
-			group: 'CompressionUtilities' with: #(
-						'NewTools-Compression-Utils');
 
 			group: 'default' with: #( 
 						'Playground' 
@@ -190,8 +186,7 @@ BaselineOfNewTools >> baseline: spec [
 						'FileBrowser'
 						'Finder'
 						'Profiler'
-						'SettingsBrowser'
-						'CompressionUtilities') ]
+						'SettingsBrowser' ) ]
 ]
 
 { #category : 'external projects' }
diff --git a/src/NewTools-Compression-Utils/package.st b/src/NewTools-Compression-Utils/package.st
deleted file mode 100644
index 6f8533202..000000000
--- a/src/NewTools-Compression-Utils/package.st
+++ /dev/null
@@ -1 +0,0 @@
-Package { #name : 'NewTools-Compression-Utils' }
diff --git a/src/NewTools-Fuel/package.st b/src/NewTools-Fuel/package.st
deleted file mode 100644
index 291216045..000000000
--- a/src/NewTools-Fuel/package.st
+++ /dev/null
@@ -1 +0,0 @@
-Package { #name : 'NewTools-Fuel' }
diff --git a/src/NewTools-Fuel/FLFuelCommandLineHandler.class.st b/src/NewTools-Utils/FLFuelCommandLineHandler.class.st
similarity index 96%
rename from src/NewTools-Fuel/FLFuelCommandLineHandler.class.st
rename to src/NewTools-Utils/FLFuelCommandLineHandler.class.st
index 72c2de8a2..22419ec80 100644
--- a/src/NewTools-Fuel/FLFuelCommandLineHandler.class.st
+++ b/src/NewTools-Utils/FLFuelCommandLineHandler.class.st
@@ -28,9 +28,9 @@ Class {
 	#instVars : [
 		'files'
 	],
-	#category : 'NewTools-Fuel-CommandLineHandler',
-	#package : 'NewTools-Fuel',
-	#tag : 'CommandLineHandler'
+	#category : 'NewTools-Utils-Fuel',
+	#package : 'NewTools-Utils',
+	#tag : 'Fuel'
 }
 
 { #category : 'accessing' }
diff --git a/src/NewTools-Fuel/FLMaterializer.extension.st b/src/NewTools-Utils/FLMaterializer.extension.st
similarity index 80%
rename from src/NewTools-Fuel/FLMaterializer.extension.st
rename to src/NewTools-Utils/FLMaterializer.extension.st
index 72cec8d2a..f7385c6c8 100644
--- a/src/NewTools-Fuel/FLMaterializer.extension.st
+++ b/src/NewTools-Utils/FLMaterializer.extension.st
@@ -1,6 +1,6 @@
 Extension { #name : 'FLMaterializer' }
 
-{ #category : '*NewTools-Fuel-FileRegistry' }
+{ #category : '*NewTools-Utils-Fuel-FileRegistry' }
 FLMaterializer class >> fileReaderServicesForFile: fullName suffix: suffix [
 	<fileService>
 	suffix = 'fuel'
@@ -8,7 +8,7 @@ FLMaterializer class >> fileReaderServicesForFile: fullName suffix: suffix [
 	^ { self serviceFuelMaterialize }
 ]
 
-{ #category : '*NewTools-Fuel-FileRegistry' }
+{ #category : '*NewTools-Utils-Fuel-FileRegistry' }
 FLMaterializer class >> inspectMaterializationFromFileNamed: aString [
 	| result |
 	result := self new
@@ -17,7 +17,7 @@ FLMaterializer class >> inspectMaterializationFromFileNamed: aString [
 	^ result inspect
 ]
 
-{ #category : '*NewTools-Fuel-FileRegistry' }
+{ #category : '*NewTools-Utils-Fuel-FileRegistry' }
 FLMaterializer class >> serviceFuelMaterialize [
 	^ SimpleServiceEntry 
 		provider: self 
diff --git a/src/NewTools-Compression-Utils/InflateStream.extension.st b/src/NewTools-Utils/InflateStream.extension.st
similarity index 87%
rename from src/NewTools-Compression-Utils/InflateStream.extension.st
rename to src/NewTools-Utils/InflateStream.extension.st
index 04df1adf6..413f910f6 100644
--- a/src/NewTools-Compression-Utils/InflateStream.extension.st
+++ b/src/NewTools-Utils/InflateStream.extension.st
@@ -1,6 +1,6 @@
 Extension { #name : 'InflateStream' }
 
-{ #category : '*NewTools-Compression-Utils' }
+{ #category : '*NewTools-Utils-Compression' }
 InflateStream class >> openWithContents: contentsString label: titleString [
 	"Open a text viewer on contentsString and window label titleString"
 
@@ -13,7 +13,7 @@ InflateStream class >> openWithContents: contentsString label: titleString [
 				extent: 600 @ 800 ]
 ]
 
-{ #category : '*NewTools-Compression-Utils' }
+{ #category : '*NewTools-Utils-Compression' }
 InflateStream class >> viewContents: fullFileName [
 	"Open the decompressed contents of fullFileName"
 
diff --git a/src/NewTools-Fuel/Object.extension.st b/src/NewTools-Utils/Object.extension.st
similarity index 83%
rename from src/NewTools-Fuel/Object.extension.st
rename to src/NewTools-Utils/Object.extension.st
index c9060bb82..232264e91 100644
--- a/src/NewTools-Fuel/Object.extension.st
+++ b/src/NewTools-Utils/Object.extension.st
@@ -1,6 +1,6 @@
 Extension { #name : 'Object' }
 
-{ #category : '*NewTools-Fuel' }
+{ #category : '*NewTools-Utils-Fuel' }
 Object >> fuelOut [
 	| target |
 	target := FileLocator imageDirectory / self printString asFileName, 'fuel'.
diff --git a/src/NewTools-Compression-Utils/ZipArchive.extension.st b/src/NewTools-Utils/ZipArchive.extension.st
similarity index 90%
rename from src/NewTools-Compression-Utils/ZipArchive.extension.st
rename to src/NewTools-Utils/ZipArchive.extension.st
index 092738a54..1980a446e 100644
--- a/src/NewTools-Compression-Utils/ZipArchive.extension.st
+++ b/src/NewTools-Utils/ZipArchive.extension.st
@@ -1,6 +1,6 @@
 Extension { #name : 'ZipArchive' }
 
-{ #category : '*NewTools-Compression-Utils' }
+{ #category : '*NewTools-Utils-Compression' }
 ZipArchive class >> extractAllIn: aFileReferenceOrFileName [
 	"Service method to extract all contents of a zip.
 	Example: 
diff --git a/src/NewTools-Utils/package.st b/src/NewTools-Utils/package.st
new file mode 100644
index 000000000..577af31e4
--- /dev/null
+++ b/src/NewTools-Utils/package.st
@@ -0,0 +1 @@
+Package { #name : 'NewTools-Utils' }

From b5fedde9097517be9ca810607a00ee3c78e797aa Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Fri, 24 May 2024 11:15:46 +0200
Subject: [PATCH 2/7] First iteration over the new protocol chooser presenter

---
 .../StProtocolNameChooser.class.st            | 91 +++++++++++++++++++
 1 file changed, 91 insertions(+)
 create mode 100644 src/NewTools-Utils/StProtocolNameChooser.class.st

diff --git a/src/NewTools-Utils/StProtocolNameChooser.class.st b/src/NewTools-Utils/StProtocolNameChooser.class.st
new file mode 100644
index 000000000..967a05a3e
--- /dev/null
+++ b/src/NewTools-Utils/StProtocolNameChooser.class.st
@@ -0,0 +1,91 @@
+"
+I am a little interface to let the user choose the name of a protocol.
+
+This interface will suggest the name of the protocol as the user types the beginning of the name.
+"
+Class {
+	#name : 'StProtocolNameChooser',
+	#superclass : 'StPresenter',
+	#instVars : [
+		'suggestionList',
+		'protocolNameField',
+		'concernedClass'
+	],
+	#category : 'NewTools-Utils-ProtocolChooser',
+	#package : 'NewTools-Utils',
+	#tag : 'ProtocolChooser'
+}
+
+{ #category : 'helpers' }
+StProtocolNameChooser class >> forClass: aClass [
+
+	^ self new
+		  concernedClass: aClass;
+		  yourself
+]
+
+{ #category : 'instance creation' }
+StProtocolNameChooser class >> open [
+
+	<script>
+	self new open
+]
+
+{ #category : 'accessing' }
+StProtocolNameChooser >> concernedClass [
+
+	^ concernedClass
+]
+
+{ #category : 'accessing' }
+StProtocolNameChooser >> concernedClass: anObject [
+
+	concernedClass := anObject
+]
+
+{ #category : 'layout' }
+StProtocolNameChooser >> defaultLayout [
+
+	^ SpBoxLayout newTopToBottom
+		  add: suggestionList;
+		  add: protocolNameField expand: false;
+		  yourself
+]
+
+{ #category : 'initialization' }
+StProtocolNameChooser >> initializeDialogWindow: aDialogWindowPresenter [
+
+	super initializeDialogWindow: aDialogWindowPresenter.
+	protocolNameField whenSubmitDo: [ :protocolName | aDialogWindowPresenter triggerOkAction ]
+]
+
+{ #category : 'initialization' }
+StProtocolNameChooser >> initializePresenters [
+
+	super initializePresenters.
+
+	suggestionList := self newList.
+
+	protocolNameField := self newTextInput
+]
+
+{ #category : 'initialization' }
+StProtocolNameChooser >> initializeWindow: aWindowPresenter [
+
+	super initializeWindow: aWindowPresenter.
+	aWindowPresenter title: 'New protocol name'.
+
+	aWindowPresenter whenOpenedDo: [ protocolNameField takeKeyboardFocus ]
+]
+
+{ #category : 'accessing - defaults' }
+StProtocolNameChooser >> protocolName [
+	^ protocolNameField text asSymbol
+]
+
+{ #category : 'accessing' }
+StProtocolNameChooser >> protocolName: aString [
+	"I allow to set a default protocol name to the list."
+
+	protocolNameField text: aString
+]

From a2abaf2da10d133a210a73f5bcc4b1c4f5ad7c6d Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Fri, 24 May 2024 11:32:53 +0200
Subject: [PATCH 3/7] Add suggestion list to the protocol chooser

---
 .../StProtocolNameChooser.class.st            | 29 +++++++++++++++++--
 1 file changed, 27 insertions(+), 2 deletions(-)

diff --git a/src/NewTools-Utils/StProtocolNameChooser.class.st b/src/NewTools-Utils/StProtocolNameChooser.class.st
index 967a05a3e..b11d63594 100644
--- a/src/NewTools-Utils/StProtocolNameChooser.class.st
+++ b/src/NewTools-Utils/StProtocolNameChooser.class.st
@@ -43,6 +43,14 @@ StProtocolNameChooser >> concernedClass: anObject [
 	concernedClass := anObject
 ]
 
+{ #category : 'initialization' }
+StProtocolNameChooser >> connectPresenters [
+
+	super connectPresenters.
+
+	protocolNameField whenTextChangedDo: [ self updatePresenter ]
+]
+
 { #category : 'layout' }
 StProtocolNameChooser >> defaultLayout [
 
@@ -56,7 +64,8 @@ StProtocolNameChooser >> defaultLayout [
 StProtocolNameChooser >> initializeDialogWindow: aDialogWindowPresenter [
 
 	super initializeDialogWindow: aDialogWindowPresenter.
-	protocolNameField whenSubmitDo: [ :protocolName | aDialogWindowPresenter triggerOkAction ]
+	protocolNameField whenSubmitDo: [ :protocolName | aDialogWindowPresenter triggerOkAction ].
+	suggestionList whenSelectedDo: [ :protocolName | self protocolName: protocolName ]
 ]
 
 { #category : 'initialization' }
@@ -87,5 +96,21 @@ StProtocolNameChooser >> protocolName [
 StProtocolNameChooser >> protocolName: aString [
 	"I allow to set a default protocol name to the list."
 
-	protocolNameField text: aString
+	protocolNameField text: aString.
+	self updatePresenter
+]
+
+{ #category : 'initialization' }
+StProtocolNameChooser >> updatePresenter [
+
+	| existingProtocols |
+	existingProtocols := concernedClass environment allClasses flatCollect: [ :class |
+		                     (concernedClass isNil or: [ concernedClass isInstanceSide ])
+			                     ifTrue: [ class protocols ]
+			                     ifFalse: [ class class protocols ] ].
+	existingProtocols := existingProtocols reject: [ :protocol | protocol isExtensionProtocol ].
+	existingProtocols := existingProtocols collect: [ :protocol | protocol name ] as: Bag.
+	existingProtocols := existingProtocols sortedCounts collect: [ :association | association value ].
+
+	suggestionList items: (existingProtocols select: [ :protocolName | protocolName includesSubstring: self protocolName ])
 ]

From af1ae0d1415e990c23e737d390c97a1981a878d1 Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Fri, 24 May 2024 13:55:21 +0200
Subject: [PATCH 4/7] Finish first version of the protocol name chooser

---
 .../StProtocolNameChooser.class.st            | 55 +++++++++++++++++--
 1 file changed, 49 insertions(+), 6 deletions(-)

diff --git a/src/NewTools-Utils/StProtocolNameChooser.class.st b/src/NewTools-Utils/StProtocolNameChooser.class.st
index b11d63594..b8cd92bd1 100644
--- a/src/NewTools-Utils/StProtocolNameChooser.class.st
+++ b/src/NewTools-Utils/StProtocolNameChooser.class.st
@@ -2,6 +2,14 @@
 I am a little interface to let the user choose the name of a protocol.
 
 This interface will suggest the name of the protocol as the user types the beginning of the name.
+
+I can be configured with a concerned class to refine the UI such as proposing instance or class side protocols in the suggestion list.
+
+See my class side for an example of usage and some helpers.
+
+Idea of improvements for the future:
+- Suggest protocols from super classes first?
+- Add tests
 "
 Class {
 	#name : 'StProtocolNameChooser',
@@ -16,12 +24,15 @@ Class {
 	#tag : 'ProtocolChooser'
 }
 
-{ #category : 'helpers' }
-StProtocolNameChooser class >> forClass: aClass [
+{ #category : 'examples' }
+StProtocolNameChooser class >> exampleConfiguringPresenter [
 
-	^ self new
-		  concernedClass: aClass;
-		  yourself
+	<example>
+	self requestProtocolNameConfiguring: [ :presenter :dialog |
+		presenter
+			concernedClass: self class; "Giving the concerned class can allow some customizations such as knowing if we should suggest instance or class side protocols"
+			protocolName: 'ac'.
+		dialog title: 'Updated title' ]
 ]
 
 { #category : 'instance creation' }
@@ -31,8 +42,39 @@ StProtocolNameChooser class >> open [
 	self new open
 ]
 
+{ #category : 'instance creation' }
+StProtocolNameChooser class >> requestProtocolName [
+	"See comment of StProtocolNameChooser class>>#requestProtocolNameConfiguring:"
+
+	<script>
+	^ self requestProtocolNameConfiguring: [ :presenter :dialog |  ]
+]
+
+{ #category : 'instance creation' }
+StProtocolNameChooser class >> requestProtocolNameConfiguring: aBlock [
+	"I request a protocol name through a dialog and signal a CmdCommandAborted in case the provided protocol is empty or an extension name.
+	I allow the user to configure the presenter or the dialog via a configuration block."
+
+	<script>
+	| protocolName presenter dialog |
+	dialog := (presenter := self new) asBlockedDialogWindow.
+
+	aBlock cull: presenter cull: dialog.
+
+	dialog open.
+
+	protocolName := presenter protocolName.
+
+	protocolName isEmptyOrNil ifTrue: [ CmdCommandAborted signal ].
+	(protocolName beginsWith: '*') ifTrue: [
+		self inform: 'Star is forbidden for protocol name since this is used for method extensions.'.
+		^ CmdCommandAborted signal ].
+	^ protocolName
+]
+
 { #category : 'accessing' }
 StProtocolNameChooser >> concernedClass [
+	"Giving the concerned class can allow some customizations such as knowing if we should suggest instance or class side protocols"
 
 	^ concernedClass
 ]
@@ -75,7 +117,8 @@ StProtocolNameChooser >> initializePresenters [
 
 	suggestionList := self newList.
 
-	protocolNameField := self newTextInput
+	protocolNameField := self newTextInput.
+	protocolNameField placeholder: 'Protocol name (e.g. accessing)'
 ]
 
 { #category : 'initialization' }

From 741d0fb0532cdc00974216783e62c7da3228003f Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Fri, 24 May 2024 14:11:03 +0200
Subject: [PATCH 5/7] Rename the presenter

---
 ...> StProtocolNameChooserPresenter.class.st} | 58 ++++++++++---------
 1 file changed, 32 insertions(+), 26 deletions(-)
 rename src/NewTools-Utils/{StProtocolNameChooser.class.st => StProtocolNameChooserPresenter.class.st} (66%)

diff --git a/src/NewTools-Utils/StProtocolNameChooser.class.st b/src/NewTools-Utils/StProtocolNameChooserPresenter.class.st
similarity index 66%
rename from src/NewTools-Utils/StProtocolNameChooser.class.st
rename to src/NewTools-Utils/StProtocolNameChooserPresenter.class.st
index b8cd92bd1..7e36974dc 100644
--- a/src/NewTools-Utils/StProtocolNameChooser.class.st
+++ b/src/NewTools-Utils/StProtocolNameChooserPresenter.class.st
@@ -12,7 +12,7 @@ Idea of improvements for the future:
 - Add tests
 "
 Class {
-	#name : 'StProtocolNameChooser',
+	#name : 'StProtocolNameChooserPresenter',
 	#superclass : 'StPresenter',
 	#instVars : [
 		'suggestionList',
@@ -25,7 +25,7 @@ Class {
 }
 
 { #category : 'examples' }
-StProtocolNameChooser class >> exampleConfiguringPresenter [
+StProtocolNameChooserPresenter class >> exampleConfiguringPresenter [
 
 	<example>
 	self requestProtocolNameConfiguring: [ :presenter :dialog |
@@ -36,14 +36,14 @@ StProtocolNameChooser class >> exampleConfiguringPresenter [
 ]
 
 { #category : 'instance creation' }
-StProtocolNameChooser class >> open [
+StProtocolNameChooserPresenter class >> open [
 
 	<script>
 	self new open
 ]
 
 { #category : 'instance creation' }
-StProtocolNameChooser class >> requestProtocolName [
+StProtocolNameChooserPresenter class >> requestProtocolName [
 	"See comment of StProtocolNameChooser class>>#requestProtocolNameConfiguring:"
 
 	<script>
@@ -51,7 +51,7 @@ StProtocolNameChooser class >> requestProtocolName [
 ]
 
 { #category : 'instance creation' }
-StProtocolNameChooser class >> requestProtocolNameConfiguring: aBlock [
+StProtocolNameChooserPresenter class >> requestProtocolNameConfiguring: aBlock [
 	"I request a protocol name through a dialog and signal a CmdCommandAborted in case the provided protocol is empty or an extension name.
 	I allow the user to configure the presenter or the dialog via a configuration block."
 
@@ -73,20 +73,20 @@ StProtocolNameChooser class >> requestProtocolNameConfiguring: aBlock [
 ]
 
 { #category : 'accessing' }
-StProtocolNameChooser >> concernedClass [
+StProtocolNameChooserPresenter >> concernedClass [
 	"Giving the concerned class can allow some customizations such as knowing if we should suggest instance or class side protocols"
 
 	^ concernedClass
 ]
 
 { #category : 'accessing' }
-StProtocolNameChooser >> concernedClass: anObject [
+StProtocolNameChooserPresenter >> concernedClass: anObject [
 
 	concernedClass := anObject
 ]
 
 { #category : 'initialization' }
-StProtocolNameChooser >> connectPresenters [
+StProtocolNameChooserPresenter >> connectPresenters [
 
 	super connectPresenters.
 
@@ -94,7 +94,7 @@ StProtocolNameChooser >> connectPresenters [
 ]
 
 { #category : 'layout' }
-StProtocolNameChooser >> defaultLayout [
+StProtocolNameChooserPresenter >> defaultLayout [
 
 	^ SpBoxLayout newTopToBottom
 		  add: suggestionList;
@@ -103,7 +103,7 @@ StProtocolNameChooser >> defaultLayout [
 ]
 
 { #category : 'initialization' }
-StProtocolNameChooser >> initializeDialogWindow: aDialogWindowPresenter [
+StProtocolNameChooserPresenter >> initializeDialogWindow: aDialogWindowPresenter [
 
 	super initializeDialogWindow: aDialogWindowPresenter.
 	protocolNameField whenSubmitDo: [ :protocolName | aDialogWindowPresenter triggerOkAction ].
@@ -111,7 +111,7 @@ StProtocolNameChooser >> initializeDialogWindow: aDialogWindowPresenter [
 ]
 
 { #category : 'initialization' }
-StProtocolNameChooser >> initializePresenters [
+StProtocolNameChooserPresenter >> initializePresenters [
 
 	super initializePresenters.
 
@@ -122,7 +122,7 @@ StProtocolNameChooser >> initializePresenters [
 ]
 
 { #category : 'initialization' }
-StProtocolNameChooser >> initializeWindow: aWindowPresenter [
+StProtocolNameChooserPresenter >> initializeWindow: aWindowPresenter [
 
 	super initializeWindow: aWindowPresenter.
 	aWindowPresenter title: 'New protocol name'.
@@ -131,12 +131,12 @@ StProtocolNameChooser >> initializeWindow: aWindowPresenter [
 ]
 
 { #category : 'accessing - defaults' }
-StProtocolNameChooser >> protocolName [
+StProtocolNameChooserPresenter >> protocolName [
 	^ protocolNameField text asSymbol
 ]
 
 { #category : 'accessing' }
-StProtocolNameChooser >> protocolName: aString [
+StProtocolNameChooserPresenter >> protocolName: aString [
 	"I allow to set a default protocol name to the list."
 
 	protocolNameField text: aString.
@@ -144,16 +144,22 @@ StProtocolNameChooser >> protocolName: aString [
 ]
 
 { #category : 'initialization' }
-StProtocolNameChooser >> updatePresenter [
-
-	| existingProtocols |
-	existingProtocols := concernedClass environment allClasses flatCollect: [ :class |
-		                     (concernedClass isNil or: [ concernedClass isInstanceSide ])
-			                     ifTrue: [ class protocols ]
-			                     ifFalse: [ class class protocols ] ].
-	existingProtocols := existingProtocols reject: [ :protocol | protocol isExtensionProtocol ].
-	existingProtocols := existingProtocols collect: [ :protocol | protocol name ] as: Bag.
-	existingProtocols := existingProtocols sortedCounts collect: [ :association | association value ].
-
-	suggestionList items: (existingProtocols select: [ :protocolName | protocolName includesSubstring: self protocolName ])
+StProtocolNameChooserPresenter >> protocolsToSuggest [
+
+	| suggestedProtocols |
+	suggestedProtocols := concernedClass environment allClasses flatCollect: [ :class |
+		                      (concernedClass isNil or: [ concernedClass isInstanceSide ])
+			                      ifTrue: [ class protocols ]
+			                      ifFalse: [ class class protocols ] ].
+	suggestedProtocols := suggestedProtocols reject: [ :protocol | protocol isExtensionProtocol ].
+	suggestedProtocols := suggestedProtocols collect: [ :protocol | protocol name ] as: Bag.
+	suggestedProtocols := suggestedProtocols sortedCounts collect: [ :association | association value ].
+	suggestedProtocols := suggestedProtocols select: [ :protocolName | protocolName includesSubstring: self protocolName ].
+	^ suggestedProtocols
+]
+
+{ #category : 'initialization' }
+StProtocolNameChooserPresenter >> updatePresenter [
+
+	suggestionList items: self protocolsToSuggest
 ]

From e4931b4a10da29de9baab8b85326e71618016602 Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Fri, 24 May 2024 15:10:45 +0200
Subject: [PATCH 6/7] Adding tests

---
 .../BaselineOfNewTools.class.st               |  4 +-
 ...tProtocolNameChooserPresenterTest.class.st | 75 +++++++++++++++++++
 src/NewTools-Utils-Tests/package.st           |  1 +
 3 files changed, 79 insertions(+), 1 deletion(-)
 create mode 100644 src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st
 create mode 100644 src/NewTools-Utils-Tests/package.st

diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
index 22e5bbee2..53fe6e99e 100644
--- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st
+++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
@@ -103,7 +103,8 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-SettingsBrowser' with: [ spec requires: #('ColorPicker') ];
 			package: 'NewTools-SettingsBrowser-Tests' with: [ spec requires: #('NewTools-SettingsBrowser') ];
 			
-			package: 'NewTools-Utils' with: [ spec requires: #('NewTools-FileBrowser') ].			
+			package: 'NewTools-Utils' with: [ spec requires: #('NewTools-FileBrowser') ];
+			package: 'NewTools-Utils-Tests' with: [  spec requires: #('NewTools-Utils') ].			
 
 		spec
 			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
@@ -124,6 +125,7 @@ BaselineOfNewTools >> baseline: spec [
 					 	'NewTools-Debugger-Fuel'
 				    	'NewTools-Debugger-Fuel-Tests' 
 					 	'NewTools-Utils'
+						'NewTools-Utils-Tests'
 						'NewTools-DebugPointsBrowser'
 						'NewTools-ObjectCentricDebugPoints' );
 			group: 'Spotter' with: #( 
diff --git a/src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st b/src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st
new file mode 100644
index 000000000..23d5d8b19
--- /dev/null
+++ b/src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st
@@ -0,0 +1,75 @@
+"
+A StProtocolNameChooserPresenterTest is a test class for testing the behavior of StProtocolNameChooserPresenter
+"
+Class {
+	#name : 'StProtocolNameChooserPresenterTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'presenter'
+	],
+	#category : 'NewTools-Utils-Tests-ProtocolChooser',
+	#package : 'NewTools-Utils-Tests',
+	#tag : 'ProtocolChooser'
+}
+
+{ #category : 'running' }
+StProtocolNameChooserPresenterTest >> setUp [
+	super setUp.
+	presenter := StProtocolNameChooserPresenter new
+]
+
+{ #category : 'tests' }
+StProtocolNameChooserPresenterTest >> testSmokeTest [
+
+	| window |
+	[ self shouldnt: [ window := presenter open ] raise: Error ] ensure: [ window close ].
+
+	[ self shouldnt: [ window := presenter openDialog ] raise: Error ] ensure: [ window close ].
+
+	presenter concernedClass: self class.
+	presenter protocolName: 'test'.
+
+	[ self shouldnt: [ window := presenter open ] raise: Error ] ensure: [ window close ]
+]
+
+{ #category : 'tests' }
+StProtocolNameChooserPresenterTest >> testSuggestedProtocolsAreOrderedByPriority [
+	"I'm not sure how to test this without using the sae code as #protocolsToSuggest so I'm hardcoding 3 of the most used protocols in the system"
+
+	self assert: ((presenter protocolsToSuggest first: 5) includesAll: #( accessing initialization testing ))
+]
+
+{ #category : 'tests' }
+StProtocolNameChooserPresenterTest >> testSuggestedProtocolsDependOnInstanceOrClassSide [
+
+	| protocolName classProtocolName |
+	protocolName := UUID new asString36.
+	classProtocolName := UUID new asString36.
+
+	[
+	self class addProtocol: protocolName.
+	self class class addProtocol: classProtocolName.
+
+	presenter concernedClass: self class.
+	self assert: (presenter protocolsToSuggest includes: protocolName).
+	self deny: (presenter protocolsToSuggest includes: classProtocolName).
+
+	presenter concernedClass: self class class.
+	self deny: (presenter protocolsToSuggest includes: protocolName).
+	self assert: (presenter protocolsToSuggest includes: classProtocolName) ] ensure: [
+		self class removeProtocol: protocolName.
+		self class class removeProtocol: classProtocolName ]
+]
+
+{ #category : 'tests' }
+StProtocolNameChooserPresenterTest >> testSuggestedProtocolsIncludesProtocolsOfTheImage [
+
+	| protocolName |
+	protocolName := UUID new asString36.
+
+	self deny: (presenter protocolsToSuggest includes: protocolName).
+	[
+	self class addProtocol: protocolName.
+
+	self assert: (presenter protocolsToSuggest includes: protocolName) ] ensure: [ self class removeProtocol: protocolName ]
+]
diff --git a/src/NewTools-Utils-Tests/package.st b/src/NewTools-Utils-Tests/package.st
new file mode 100644
index 000000000..4182ddcd0
--- /dev/null
+++ b/src/NewTools-Utils-Tests/package.st
@@ -0,0 +1 @@
+Package { #name : 'NewTools-Utils-Tests' }

From 328bd057faf4ba6fbb3e0cb6f2a40e5932017cf5 Mon Sep 17 00:00:00 2001
From: CyrilFerlicot <cyril@ferlicot.me>
Date: Mon, 27 May 2024 12:03:59 +0200
Subject: [PATCH 7/7] Move protocol chooser in Core as Steph suggested

---
 src/BaselineOfNewTools/BaselineOfNewTools.class.st         | 7 +++----
 .../StProtocolNameChooserPresenterTest.class.st            | 4 ++--
 src/NewTools-Core-Tests/package.st                         | 1 +
 .../StProtocolNameChooserPresenter.class.st                | 4 ++--
 src/NewTools-Utils-Tests/package.st                        | 1 -
 5 files changed, 8 insertions(+), 9 deletions(-)
 rename src/{NewTools-Utils-Tests => NewTools-Core-Tests}/StProtocolNameChooserPresenterTest.class.st (96%)
 create mode 100644 src/NewTools-Core-Tests/package.st
 rename src/{NewTools-Utils => NewTools-Core}/StProtocolNameChooserPresenter.class.st (98%)
 delete mode 100644 src/NewTools-Utils-Tests/package.st

diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
index 53fe6e99e..844b6cf4e 100644
--- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st
+++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
@@ -22,6 +22,7 @@ BaselineOfNewTools >> baseline: spec [
 
 		spec
 			package: 'NewTools-Core';
+			package: 'NewTools-Core-Tests' with: [  spec requires: #('NewTools-Core') ];
 			package: 'NewTools-Morphic';
 			package: 'NewTools-Gtk';
 			"Basic tools (inherited from Spec)"
@@ -103,11 +104,10 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-SettingsBrowser' with: [ spec requires: #('ColorPicker') ];
 			package: 'NewTools-SettingsBrowser-Tests' with: [ spec requires: #('NewTools-SettingsBrowser') ];
 			
-			package: 'NewTools-Utils' with: [ spec requires: #('NewTools-FileBrowser') ];
-			package: 'NewTools-Utils-Tests' with: [  spec requires: #('NewTools-Utils') ].			
+			package: 'NewTools-Utils' with: [ spec requires: #('NewTools-FileBrowser') ].			
 
 		spec
-			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
+			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Core-Tests' 'NewTools-Morphic' );
 			group: 'Playground' with: #( 'Core' 'NewTools-Playground' 'NewTools-Playground-Tests' );
 			group: 'Inspector' with: #( 'Core' 'NewTools-Inspector' 'NewTools-Inspector-Tests' );
 			group: 'Debugger' with: #( 
@@ -125,7 +125,6 @@ BaselineOfNewTools >> baseline: spec [
 					 	'NewTools-Debugger-Fuel'
 				    	'NewTools-Debugger-Fuel-Tests' 
 					 	'NewTools-Utils'
-						'NewTools-Utils-Tests'
 						'NewTools-DebugPointsBrowser'
 						'NewTools-ObjectCentricDebugPoints' );
 			group: 'Spotter' with: #( 
diff --git a/src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st b/src/NewTools-Core-Tests/StProtocolNameChooserPresenterTest.class.st
similarity index 96%
rename from src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st
rename to src/NewTools-Core-Tests/StProtocolNameChooserPresenterTest.class.st
index 23d5d8b19..685bda2d8 100644
--- a/src/NewTools-Utils-Tests/StProtocolNameChooserPresenterTest.class.st
+++ b/src/NewTools-Core-Tests/StProtocolNameChooserPresenterTest.class.st
@@ -7,8 +7,8 @@ Class {
 	#instVars : [
 		'presenter'
 	],
-	#category : 'NewTools-Utils-Tests-ProtocolChooser',
-	#package : 'NewTools-Utils-Tests',
+	#category : 'NewTools-Core-Tests-ProtocolChooser',
+	#package : 'NewTools-Core-Tests',
 	#tag : 'ProtocolChooser'
 }
 
diff --git a/src/NewTools-Core-Tests/package.st b/src/NewTools-Core-Tests/package.st
new file mode 100644
index 000000000..f4dd22321
--- /dev/null
+++ b/src/NewTools-Core-Tests/package.st
@@ -0,0 +1 @@
+Package { #name : 'NewTools-Core-Tests' }
diff --git a/src/NewTools-Utils/StProtocolNameChooserPresenter.class.st b/src/NewTools-Core/StProtocolNameChooserPresenter.class.st
similarity index 98%
rename from src/NewTools-Utils/StProtocolNameChooserPresenter.class.st
rename to src/NewTools-Core/StProtocolNameChooserPresenter.class.st
index 7e36974dc..d69e4b7a0 100644
--- a/src/NewTools-Utils/StProtocolNameChooserPresenter.class.st
+++ b/src/NewTools-Core/StProtocolNameChooserPresenter.class.st
@@ -19,8 +19,8 @@ Class {
 		'protocolNameField',
 		'concernedClass'
 	],
-	#category : 'NewTools-Utils-ProtocolChooser',
-	#package : 'NewTools-Utils',
+	#category : 'NewTools-Core-ProtocolChooser',
+	#package : 'NewTools-Core',
 	#tag : 'ProtocolChooser'
 }
 
diff --git a/src/NewTools-Utils-Tests/package.st b/src/NewTools-Utils-Tests/package.st
deleted file mode 100644
index 4182ddcd0..000000000
--- a/src/NewTools-Utils-Tests/package.st
+++ /dev/null
@@ -1 +0,0 @@
-Package { #name : 'NewTools-Utils-Tests' }