Streamline the System Browser UX when removing classes.

When trying to remove a class that has references/subclasses/users, ask the user only once if they want to proceed with the removal.

This also prevents the users from blindly deleting classes with references/subclasses/users.

src/Calypso-NavigationModel/ClyQueryResult.class.st

@@ -416,6 +416,11 @@ ClyQueryResult >> needsRebuild [
 	^needsRebuild 
 ]
 
+{ #category : #testing }
+ClyQueryResult >> notEmpty [
+	^self isEmpty not
+]
+
 { #category : #'system changes' }
 ClyQueryResult >> notifyChanges [
 

src/Calypso-SystemTools-Core/ClyBrowserMorph.extension.st

@@ -105,12 +105,52 @@ ClyBrowserMorph >> confirmUnusedVariablesInDefiningClass: variables [
 ClyBrowserMorph >> decorateMethodEditor: aMethodEditor [
 ]
 
+{ #category : #'*Calypso-SystemTools-Core' }
+ClyBrowserMorph >> hasReferencesToClasses: classes [
+
+	| query references |
+
+	query := (ClyClassReferencesQuery toAny: classes from: self systemScope).
+	references := query execute.	
+	^(references notEmpty and: [
+		((references items collect: [:each | each origin])
+			difference: (classes flatCollect: [ :each | { each . each classSide } ])) notEmpty])
+]
+
 { #category : #'*Calypso-SystemTools-Core' }
 ClyBrowserMorph >> isMethodSelected: aMethod [
 
 	^self methodSelection includesActualObject: aMethod
 ]
 
+{ #category : #'*Calypso-SystemTools-Core' }
+ClyBrowserMorph >> requestRemoveClassStrategyFor: classes [
+
+	 | hasReferences hasSubclasses hasUsers result strategies |
+	 hasReferences := self hasReferencesToClasses: classes.
+	 hasSubclasses := ((classes flatCollect: [ :each | each subclasses ]) 
+		                   copyWithoutAll: classes) notEmpty.
+	 hasUsers := ((classes flatCollect: [ :each | each users ]) 
+		              copyWithoutAll: classes) notEmpty.
+
+	 hasReferences | hasSubclasses | hasUsers ifFalse: [ 
+		 ^ SycSilentlyRemoveClassStrategy new ].
+
+	 strategies := SycRemoveClassStrategy
+		               createAllForBrowser: self
+		               references: hasReferences
+		               subclasses: hasSubclasses
+		               users: hasUsers.
+
+	 result := UIManager default
+		           chooseFrom:
+		           (strategies collect: [ :each | each userRequestString ])
+		           values: strategies
+		           title: 'Class has references, subclasses, or users'.
+
+	 ^ result ifNil: [ SycNotRemoveClassStrategy new ]
+]
+
 { #category : #'*Calypso-SystemTools-Core' }
 ClyBrowserMorph >> requestRemoveMethodStrategyFor: methods [
 	| selectors result strategies caption  senders senderCount plural |

src/Calypso-SystemTools-Core/ClySystemBrowserContext.class.st

@@ -180,6 +180,11 @@ ClySystemBrowserContext >> requestMultipleVariables: queryTitle from: classes [
 		inScope: (ClyClassScope ofAll: classes) withInheritedScope
 ]
 
+{ #category : #'user requests' }
+ClySystemBrowserContext >> requestRemoveClassStrategyFor: classes [
+	^tool requestRemoveClassStrategyFor: classes
+]
+
 { #category : #'user requests' }
 ClySystemBrowserContext >> requestRemoveMethodStrategyFor: methods [
 	^tool requestRemoveMethodStrategyFor: methods

src/Calypso-SystemTools-QueryBrowser/ClyInteractiveRemoveClassStrategy.class.st

@@ -0,0 +1,37 @@
+"
+I am the abstract strategy to be used in those cases where a class can't be removed.
+
+My concrete subclasses allow the users to browse the references, subclasses, or users preventing the removal of the class.
+"
+Class {
+	#name : #ClyInteractiveRemoveClassStrategy,
+	#superclass : #SycRemoveClassStrategy,
+	#instVars : [
+		'browser'
+	],
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyInteractiveRemoveClassStrategy class >> isAbstract [
+	^self == ClyInteractiveRemoveClassStrategy 
+]
+
+{ #category : #'instance creation' }
+ClyInteractiveRemoveClassStrategy class >> newForBrowser: aBrowser [
+
+	^self new 
+		browser: aBrowser
+]
+
+{ #category : #accessing }
+ClyInteractiveRemoveClassStrategy >> browser [
+
+	^ browser
+]
+
+{ #category : #accessing }
+ClyInteractiveRemoveClassStrategy >> browser: anObject [
+
+	browser := anObject
+]

src/Calypso-SystemTools-QueryBrowser/ClyNotRemoveAndShowReferencesClassStrategy.class.st

@@ -0,0 +1,31 @@
+"
+I am the strategy to be used when a class can't be removed due to the presence of references.
+
+I allow the user to browse those references.
+"
+Class {
+	#name : #ClyNotRemoveAndShowReferencesClassStrategy,
+	#superclass : #ClyInteractiveRemoveClassStrategy,
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyNotRemoveAndShowReferencesClassStrategy class >> canExecuteWithReferences: hasReferences subclasses: hasSubclasses users: hasUsers [
+	^hasReferences 
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> execute: aSycRemoveClassCommand [
+
+	(ClyShowClassRefCommand forClasses: (aSycRemoveClassCommand classes flatCollect: [ :each | { each. each class } ]) by: browser) execute
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> orderForBrowser [
+	^5
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> userRequestString [
+	^'Don''t remove, but show me those references'
+]

src/Calypso-SystemTools-QueryBrowser/ClyNotRemoveAndShowSubclassesClassStrategy.class.st

@@ -0,0 +1,33 @@
+"
+I am the strategy to be used when a class can't be removed due to the presence of subclasses.
+
+I allow the user to browse those subclasses.
+"
+Class {
+	#name : #ClyNotRemoveAndShowSubclassesClassStrategy,
+	#superclass : #ClyInteractiveRemoveClassStrategy,
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyNotRemoveAndShowSubclassesClassStrategy class >> canExecuteWithReferences: hasReferences subclasses: hasSubclasses users: hasUsers [
+	^hasSubclasses 
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowSubclassesClassStrategy >> execute: aSycRemoveClassCommand [
+	| subclasses |
+	subclasses := (aSycRemoveClassCommand classes flatCollect: [:each | each subclasses])
+						copyWithoutAll: aSycRemoveClassCommand classes.
+	browser spawnQueryBrowserOn: (ClyConstantQuery returning: subclasses)
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowSubclassesClassStrategy >> orderForBrowser [
+	^6
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowSubclassesClassStrategy >> userRequestString [
+	^'Don''t remove, but show me those subclasses'
+]

src/Calypso-SystemTools-QueryBrowser/ClyNotRemoveAndShowUsersClassStrategy.class.st

@@ -0,0 +1,33 @@
+"
+I am the strategy to be used when a trait can't be removed due to the presence of users.
+
+I allow the user to browse those trait users.
+"
+Class {
+	#name : #ClyNotRemoveAndShowUsersClassStrategy,
+	#superclass : #ClyInteractiveRemoveClassStrategy,
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyNotRemoveAndShowUsersClassStrategy class >> canExecuteWithReferences: hasReferences subclasses: hasSubclasses users: hasUsers [
+	^hasUsers
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowUsersClassStrategy >> execute: aSycRemoveClassCommand [
+	| users |
+	users := (aSycRemoveClassCommand classes flatCollect: [:each | each users])
+						copyWithoutAll: aSycRemoveClassCommand classes.
+	browser spawnQueryBrowserOn: (ClyConstantQuery returning: users)
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowUsersClassStrategy >> orderForBrowser [
+	^7
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowUsersClassStrategy >> userRequestString [
+	^'Don''t remove, but show me those users'
+]

src/Calypso-SystemTools-QueryBrowser/ClyShowClassRefCommand.class.st

@@ -17,6 +17,12 @@ Class {
 	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Queries'
 }
 
+{ #category : #'instance creation' }
+ClyShowClassRefCommand class >> forClasses: classes by: aBrowser [ 
+	^(self for: classes) 
+		browser: aBrowser
+]
+
 { #category : #activation }
 ClyShowClassRefCommand class >> fullBrowserMenuActivation [
 	<classAnnotation>
@@ -66,6 +72,18 @@ ClyShowClassRefCommand class >> sourceCodeMenuActivation [
 	^SycSourceCodeMenuActivation byItemOf: ClyQueryMenuGroup for: ClySourceCodeContext
 ]
 
+{ #category : #accessing }
+ClyShowClassRefCommand >> browser [
+
+	^ browser
+]
+
+{ #category : #accessing }
+ClyShowClassRefCommand >> browser: anObject [
+
+	browser := anObject
+]
+
 { #category : #accessing }
 ClyShowClassRefCommand >> defaultMenuItemName [
 	^'Class refs.'

src/NautilusRefactoring/RewriteRuleEditor.class.st

@@ -27,6 +27,7 @@ RewriteRuleEditor class >> defaultSpec [
 			expand: true fill: true padding: 5;
 		add: (SpBoxLayout newVertical 
 			add: #helpText expand: true fill: true padding: 18;
+			addLast: #searchButton;
 			addLast: #replaceButton)
 			expand: false fill: false padding: 0;
 		yourself	

src/Polymorph-Widgets/ListDialogWindow.class.st

@@ -121,7 +121,6 @@ ListDialogWindow >> buildSearchMorph [
 			acceptSelector: #searchAccept:;
 			updateSelector: #searchUpdate:;
 			searchList: self class searchList;
-			keystrokeSelector: #searchKeystroke:
 			yourself.	
 
 ]

src/SystemCommands-ClassCommands/SycClassCommand.class.st

@@ -20,6 +20,12 @@ SycClassCommand class >> canBeExecutedInContext: aToolContext [
 	^aToolContext isClassSelected
 ]
 
+{ #category : #'instance creation' }
+SycClassCommand class >> for: classes [
+	^self new 
+		classes: classes
+]
+
 { #category : #testing }
 SycClassCommand class >> isAbstract [
 	^self = SycClassCommand 

src/SystemCommands-ClassCommands/SycNotRemoveClassStrategy.class.st

@@ -0,0 +1,28 @@
+"
+I am the strategy to be used when a user cancels a class removal. 
+"
+Class {
+	#name : #SycNotRemoveClassStrategy,
+	#superclass : #SycRemoveClassStrategy,
+	#category : #'SystemCommands-ClassCommands'
+}
+
+{ #category : #testing }
+SycNotRemoveClassStrategy class >> canExecuteWithReferences: hasReferences subclasses: hasSubclasses users: hasUsers [
+	^true
+]
+
+{ #category : #execution }
+SycNotRemoveClassStrategy >> execute: aSycRemoveClassCommand [
+]
+
+{ #category : #execution }
+SycNotRemoveClassStrategy >> orderForBrowser [
+	"Cancelling the remove of command should be at the end of list"
+	^super orderForBrowser + 1.
+]
+
+{ #category : #execution }
+SycNotRemoveClassStrategy >> userRequestString [
+	^'Forget it -- do nothing -- sorry I asked'
+]

src/SystemCommands-ClassCommands/SycRemoveClassCommand.class.st

@@ -4,6 +4,9 @@ I am a command to remove all given classes
 Class {
 	#name : #SycRemoveClassCommand,
 	#superclass : #SycClassCommand,
+	#instVars : [
+		'removeStrategy'
+	],
 	#category : #'SystemCommands-ClassCommands'
 }
 
@@ -39,21 +42,18 @@ SycRemoveClassCommand >> defaultMenuItemName [
 { #category : #execution }
 SycRemoveClassCommand >> execute [
 
-	self executeRefactorings
+	removeStrategy execute: self.
 ]
 
 { #category : #testing }
 SycRemoveClassCommand >> isComplexRefactoring [
-	^true
+	^removeStrategy isComplexRefactoring 
 ]
 
 { #category : #execution }
 SycRemoveClassCommand >> prepareFullExecutionInContext: aToolContext [
-	| noUsers answer |
+
 	super prepareFullExecutionInContext: aToolContext.
 
-	noUsers := aToolContext confirmUnusedClasses: classes.
-	noUsers ifFalse: [ 
-		answer := UIManager default confirm: 'Do you want to remove anyway?'.
-		answer ifFalse: [ 	CmdCommandAborted signal ]]
+	removeStrategy := aToolContext requestRemoveClassStrategyFor: classes.
 ]