From 9b9acb23b7ec8d9422c45c18e3a48766926a99f4 Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Sat, 13 May 2023 00:09:15 +0200 Subject: [PATCH] finally remove AbstractTool merge after https://github.com/pharo-spec/NewTools/pull/523 --- src/Manifest-Core/TheManifestBuilder.class.st | 41 +++- .../AbstractTool.extension.st | 28 --- .../RBRefactoryChangeManager.class.st | 27 +++ src/System-Support/SystemNavigation.class.st | 50 +++++ src/Tool-Base/AbstractTool.class.st | 212 ------------------ 5 files changed, 116 insertions(+), 242 deletions(-) delete mode 100644 src/Refactoring-Changes/AbstractTool.extension.st delete mode 100644 src/Tool-Base/AbstractTool.class.st diff --git a/src/Manifest-Core/TheManifestBuilder.class.st b/src/Manifest-Core/TheManifestBuilder.class.st index cb7b8d46287..e76d8889f44 100644 --- a/src/Manifest-Core/TheManifestBuilder.class.st +++ b/src/Manifest-Core/TheManifestBuilder.class.st @@ -6,7 +6,7 @@ My name is strange but this is to avoid to match with a Manifest class which is " Class { #name : #TheManifestBuilder, - #superclass : #AbstractTool, + #superclass : #Model, #instVars : [ 'manifestClass' ], @@ -524,6 +524,36 @@ TheManifestBuilder >> removeAllToDo: fp of: ruleId version: versionId [ self removeAllItem: fp selector: selector ] +{ #category : #class } +TheManifestBuilder >> removeClasses: aCollection [ + "Remove the selected classes from the system. Check that the user really wants to do this, since it is not reversible. Answer true if removal actually happened." + + | classNames classesToRemove result | + aCollection isEmptyOrNil + ifTrue: [ ^ false ]. + classesToRemove := aCollection collect: [:each | each instanceSide]. + classNames := (classesToRemove collect: [:each | each name]) joinUsing: ', '. + (result := self confirm: (self removeClassesMessageFor: classNames)) + ifTrue: [ + classesToRemove + do: [ :classToRemove | + classToRemove subclasses notEmpty + ifTrue: [ + (self confirm: (self removedClassHasSubclassesMessageFor: classToRemove name)) + ifTrue: [ classToRemove removeFromSystem ] ] + ifFalse: [ classToRemove removeFromSystem ] ] ]. + ^ result +] + +{ #category : #class } +TheManifestBuilder >> removeClassesMessageFor: classNames [ + ^ 'Are you certain that you +want to REMOVE the classes ' , classNames + , + ' +from the system?' +] + { #category : #'adding-removing' } TheManifestBuilder >> removeFalsePositive: fp of: ruleId version: versionId [ @@ -541,7 +571,7 @@ TheManifestBuilder >> removeItem: fp selector: selector [ TheManifestBuilder >> removeManifestOf: aItem [ (self manifestOf: aItem) ifNotNil: [ :myManifest | - self removeClass: myManifest ] + SystemNavigation new removeClass: myManifest ] ] { #category : #private } @@ -582,6 +612,13 @@ TheManifestBuilder >> removeToDo: fp of: ruleId version: versionId [ self removeItem: fp selector: selector ] +{ #category : #class } +TheManifestBuilder >> removedClassHasSubclassesMessageFor: className [ + + ^ className, ' has subclasses. +Do you really want to REMOVE it from the system ?' +] + { #category : #'adding-removing' } TheManifestBuilder >> resetFalsePositiveOf: ruleId version: versionId [ diff --git a/src/Refactoring-Changes/AbstractTool.extension.st b/src/Refactoring-Changes/AbstractTool.extension.st deleted file mode 100644 index 5c25059969a..00000000000 --- a/src/Refactoring-Changes/AbstractTool.extension.st +++ /dev/null @@ -1,28 +0,0 @@ -Extension { #name : #AbstractTool } - -{ #category : #'*Refactoring-Changes' } -AbstractTool class >> menuCommandOn: aBuilder [ - - (aBuilder item: #'Undo last refactoring') - action: [self undoLastRefactoring]; - parent: #Refactoring; - help: 'Undo last refactoring'; - order: 10; - iconName: #smallUndo -] - -{ #category : #'*Refactoring-Changes' } -AbstractTool class >> undoLastRefactoring [ - | manager | - manager := RBRefactoryChangeManager instance. - manager undoPointers ifNotEmpty: [ - [ |limit list| - list := OrderedCollection new. - limit := manager lastUndoPointer . - 1 to: limit do:[ :i | list add: manager undoChange ]. - list do: [ :e | e execute ] - ] asJob - title: 'Refactoring'; - run] - ifEmpty: [ self inform: 'There aren''t refactorings to undo.' ] -] diff --git a/src/Refactoring-Changes/RBRefactoryChangeManager.class.st b/src/Refactoring-Changes/RBRefactoryChangeManager.class.st index 64d364185fa..c73a047b9e0 100644 --- a/src/Refactoring-Changes/RBRefactoryChangeManager.class.st +++ b/src/Refactoring-Changes/RBRefactoryChangeManager.class.st @@ -47,6 +47,17 @@ RBRefactoryChangeManager class >> instance [ ^ Instance ifNil: [ Instance := self basicNew initialize ] ] +{ #category : #'world menu' } +RBRefactoryChangeManager class >> menuCommandOn: aBuilder [ + + (aBuilder item: #'Undo last refactoring') + action: [self undoLastRefactoring]; + parent: #Refactoring; + help: 'Undo last refactoring'; + order: 10; + iconName: #smallUndo +] + { #category : #'instance creation' } RBRefactoryChangeManager class >> new [ @@ -73,6 +84,22 @@ RBRefactoryChangeManager class >> resetCounter [ Counter := nil ] +{ #category : #menu } +RBRefactoryChangeManager class >> undoLastRefactoring [ + | manager | + manager := RBRefactoryChangeManager instance. + manager undoPointers ifNotEmpty: [ + [ |limit list| + list := OrderedCollection new. + limit := manager lastUndoPointer . + 1 to: limit do:[ :i | list add: manager undoChange ]. + list do: [ :e | e execute ] + ] asJob + title: 'Refactoring'; + run] + ifEmpty: [ self inform: 'There aren''t refactorings to undo.' ] +] + { #category : #'class initialization' } RBRefactoryChangeManager class >> undoSize [ diff --git a/src/System-Support/SystemNavigation.class.st b/src/System-Support/SystemNavigation.class.st index c54b5a14ba5..6c719a0874e 100644 --- a/src/System-Support/SystemNavigation.class.st +++ b/src/System-Support/SystemNavigation.class.st @@ -402,3 +402,53 @@ SystemNavigation new browseAllSelect: found] " ] + +{ #category : #removing } +SystemNavigation >> removeClass: aClass [ + "Remove the selected class from the system, at interactive user request. Make certain the user really wants to do this, since it is not reversible. Answer true if removal actually happened." + + | message className classToRemove result | + aClass ifNil: [ ^ false ]. + classToRemove := aClass instanceSide. + className := classToRemove name. + message := self removeClassMessageFor: className. + (result := self confirm: message) + ifTrue: [ + classToRemove subclasses notEmpty + ifTrue: [ + (self confirm: 'class has subclasses: ' , message) + ifFalse: [ ^ false ] ]. + classToRemove removeFromSystem ]. + ^ result +] + +{ #category : #removing } +SystemNavigation >> removeClassMessageFor: className [ + ^ 'Are you certain that you +want to REMOVE the class ' , className + , + ' +from the system?' +] + +{ #category : #removing } +SystemNavigation >> removeMethod: aMethod inClass: aClass [ + "If a message is selected, create a Confirmer so the user can verify that + the currently selected message should be removed from the system. If + so, remove it. " + | messageName confirmation | + + aMethod ifNil: [^ false]. + messageName := aMethod selector. + confirmation := self confirmRemovalOf: messageName on: aClass. + confirmation = 3 + ifTrue: [^ false]. + (aClass includesLocalSelector: messageName) + ifTrue: [ aClass removeSelector: messageName ]. + + "In case organization not cached" + confirmation = 2 + ifTrue: [self browseAllSendersOf: messageName]. + + ^ true +] diff --git a/src/Tool-Base/AbstractTool.class.st b/src/Tool-Base/AbstractTool.class.st deleted file mode 100644 index bc4dead6f52..00000000000 --- a/src/Tool-Base/AbstractTool.class.st +++ /dev/null @@ -1,212 +0,0 @@ -" -I'm an abstract class grouping generic methods for managing packages/classes/groups/methods from a browser -" -Class { - #name : #AbstractTool, - #superclass : #Model, - #category : #'Tool-Base-Utilities' -} - -{ #category : #private } -AbstractTool class >> protocolSuggestionsFor: aClass [ - - | classProtocols reject allExistingProtocols interestingProtocols | - classProtocols := aClass organization protocolNames. - reject := Set with: Protocol unclassified. - allExistingProtocols := (SystemNavigation default - allExistingProtocolsFor: aClass isMeta not) - reject: [ :p | classProtocols includes: p ]. - interestingProtocols := classProtocols - , - (allExistingProtocols asOrderedCollection - sort: [ :a :b | - a asLowercase < b asLowercase ]). - ^ interestingProtocols reject: [ :e | reject includes: e ] -] - -{ #category : #method } -AbstractTool >> browseAllStoresInto: aVariableName from: aClass [ - ^self systemNavigation browseAllStoresInto: aVariableName from: aClass -] - -{ #category : #class } -AbstractTool >> browseClassRefsOf: aClass [ - - | class | - aClass ifNil: [ ^self ]. - class := aClass instanceSide ifNil: [^self]. - class isTrait - ifTrue: [self systemNavigation browseAllUsersOfTrait: class] - ifFalse: [self systemNavigation browseAllCallsOnClass: class] -] - -{ #category : #method } -AbstractTool >> browseMessagesFrom: aSelector [ - " badly named, it browses implementors " - - self getSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation with: {} selector: aSelector -] - -{ #category : #method } -AbstractTool >> browseSendersOfMessagesFrom: aSelector [ - "Present a menu of the currently selected message, as well as all messages sent by it. Open a message set browser of all senders of the selector chosen." - - self getSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation with: {} selector: aSelector -] - -{ #category : #method } -AbstractTool >> browseVersionsFrom: aMethod [ - "Create and schedule a Versions Browser, showing all versions of the - currently selected message. Answer the browser or nil." - - aMethod selector - ifNil: [ self inform: 'Sorry, only actual methods have retrievable versions.'. ^nil ] - ifNotNil: [:selector | - Smalltalk tools versionBrowser browseVersionsForMethod: aMethod ] -] - -{ #category : #method } -AbstractTool >> defaultGetSelectorAndSendQuery: array to: queryPerformer with: querySelector [ - | selector | - - selector := UIManager default request: 'Type selector:' initialAnswer: 'flag:'. - selector ifNil: [ selector := String new ]. - selector := selector copyWithout: Character space. - ^ selector isEmptyOrNil - ifFalse: [ - (Symbol - hasInterned: selector - ifTrue: [ :aSymbol | - array at: 1 put: aSymbol. - queryPerformer perform: querySelector withArguments: array ]) - ifFalse: [ self inform: 'no such selector' ] ] -] - -{ #category : #method } -AbstractTool >> getSelectorAndSendQuery: querySelector to: queryPerformer with: queryArgs selector: aSelector [ - "Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments. If no message is currently selected, then obtain a method name from a user type-in" - | strm array | - - array := Array new: queryArgs size + 1. - strm := array writeStream. - strm nextPut: nil. - strm nextPutAll: queryArgs. - - aSelector ifNil: [ ^ self - defaultGetSelectorAndSendQuery: querySelector - to: queryPerformer - with: array ]. - - array at: 1 put: aSelector. - queryPerformer perform: querySelector withArguments: array -] - -{ #category : #class } -AbstractTool >> removeClass: aClass [ - "Remove the selected class from the system, at interactive user request. Make certain the user really wants to do this, since it is not reversible. Answer true if removal actually happened." - - | message className classToRemove result | - aClass ifNil: [ ^ false ]. - classToRemove := aClass instanceSide. - className := classToRemove name. - message := self removeClassMessageFor: className. - (result := self confirm: message) - ifTrue: [ - classToRemove subclasses notEmpty - ifTrue: [ - (self confirm: 'class has subclasses: ' , message) - ifFalse: [ ^ false ] ]. - classToRemove removeFromSystem ]. - ^ result -] - -{ #category : #class } -AbstractTool >> removeClassMessageFor: className [ - ^ 'Are you certain that you -want to REMOVE the class ' , className - , - ' -from the system?' -] - -{ #category : #class } -AbstractTool >> removeClasses: aCollection [ - "Remove the selected classes from the system. Check that the user really wants to do this, since it is not reversible. Answer true if removal actually happened." - - | classNames classesToRemove result | - aCollection isEmptyOrNil - ifTrue: [ ^ false ]. - classesToRemove := aCollection collect: [:each | each instanceSide]. - classNames := (classesToRemove collect: [:each | each name]) joinUsing: ', '. - (result := self confirm: (self removeClassesMessageFor: classNames)) - ifTrue: [ - classesToRemove - do: [ :classToRemove | - classToRemove subclasses notEmpty - ifTrue: [ - (self confirm: (self removedClassHasSubclassesMessageFor: classToRemove name)) - ifTrue: [ classToRemove removeFromSystem ] ] - ifFalse: [ classToRemove removeFromSystem ] ] ]. - ^ result -] - -{ #category : #class } -AbstractTool >> removeClassesMessageFor: classNames [ - ^ 'Are you certain that you -want to REMOVE the classes ' , classNames - , - ' -from the system?' -] - -{ #category : #method } -AbstractTool >> removeMethod: aMethod inClass: aClass [ - "If a message is selected, create a Confirmer so the user can verify that - the currently selected message should be removed from the system. If - so, remove it. " - | messageName confirmation | - - aMethod ifNil: [^ false]. - messageName := aMethod selector. - confirmation := self systemNavigation confirmRemovalOf: messageName on: aClass. - confirmation = 3 - ifTrue: [^ false]. - (aClass includesLocalSelector: messageName) - ifTrue: [ aClass removeSelector: messageName ] - ifFalse: [ self removeNonLocalSelector: messageName ]. - - "In case organization not cached" - confirmation = 2 - ifTrue: [self systemNavigation browseAllSendersOf: messageName]. - - self removeEmptyUnclassifiedCategoryFrom: aClass. - ^ true -] - -{ #category : #class } -AbstractTool >> removedClassHasSubclassesMessageFor: className [ - - ^ className, ' has subclasses. -Do you really want to REMOVE it from the system ?' -] - -{ #category : #class } -AbstractTool >> renameClass: aClass [ - | oldName newName obs | - - aClass ifNil: [ ^ self ]. - - oldName := aClass name. - newName := UIManager default request: 'Please type new class name' initialAnswer: oldName. - newName isEmptyOrNil ifTrue: [ ^ self ]. "Cancel returns" - newName := newName asSymbol. - newName = oldName ifTrue: [ ^ self ]. - (self class environment includesKey: newName) - ifTrue: [ ^ self error: newName , ' already exists' ]. - aClass rename: newName. - - obs := self systemNavigation allReferencesTo: (aClass environment associationAt: newName). - obs isEmpty - ifFalse: [ self systemNavigation browseMessageList: obs name: 'Obsolete References to ' , oldName autoSelect: oldName ]. - ^ newName -]