Merge pull request #523 from MarcusDenker/Cleanup-AbstractTool

Cleanup-AbstractTool

src/NewTools-ChangeSorter/ChangeSorterModel.class.st

@@ -3,7 +3,7 @@ A ChangeSorterModel is a model used by Change Sorter UIs for computation
 "
 Class {
 	#name : #ChangeSorterModel,
-	#superclass : #AbstractTool,
+	#superclass : #Model,
 	#classVars : [
 		'ClassDescriptionsMap'
 	],
@@ -50,6 +50,17 @@ ChangeSorterModel >> allChanges [
 	^ ChangeSet allChangeSets reverse
 ]
 
+{ #category : #method }
+ChangeSorterModel >> 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 : #text }
 ChangeSorterModel >> buildChangeSetDescriptionFor: changeSet [
 
@@ -173,7 +184,7 @@ ChangeSorterModel >> forgetSelector: selector inClass: aClass fromChangeSet: aCh
 ChangeSorterModel >> removeChangeSet: aChangeSet prompting: doPrompt [
 	"Completely destroy my change set.  Check if it's OK first, and if doPrompt is true, get the user to confirm his intentions first."
 
-	| message aName changeSetNumber msg |
+	| message aName msg |
 	aName := aChangeSet name.
 	aChangeSet okayToRemove ifFalse: [^ self]. "forms current changes for some project"
 	(aChangeSet isEmpty or: [doPrompt not]) ifFalse:
@@ -204,8 +215,6 @@ lost if you destroy the change set.
 Do you really want to go ahead with this?') ifFalse: [^ self]]].
 
 	"Go ahead and remove the change set"
-	changeSetNumber := aChangeSet name initialIntegerOrNil.
-	changeSetNumber ifNotNil: [SystemVersion current unregisterUpdate: changeSetNumber].
 	ChangeSet removeChangeSet: aChangeSet.
 ]
 

src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st

@@ -65,8 +65,7 @@ SpChangeSorterPresenter >> browseChangeSet [
 
 { #category : #'menu - message' }
 SpChangeSorterPresenter >> browseImplementorsOfMessages [
-
-	self model browseMessagesFrom: self selectedSelector
+	SystemNavigation new browseAllImplementorsOf: self selectedSelector
 ]
 
 { #category : #'menu - message' }
@@ -80,7 +79,7 @@ SpChangeSorterPresenter >> browseMethodFull [
 { #category : #'menu - message' }
 SpChangeSorterPresenter >> browseSendersOfMessages [
 
-	self model browseSendersOfMessagesFrom: self selectedSelector
+	self systemNavigation browseAllSendersOf: self selectedSelector
 ]
 
 { #category : #'menu - message' }
@@ -616,7 +615,7 @@ SpChangeSorterPresenter >> remove [
 SpChangeSorterPresenter >> removeClass [
 	"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."
 
-	(self model removeClass: self selectedClass)
+	(SystemNavigation new removeClass: self selectedClass)
 		ifTrue: [ self setSelectedChangeSet: self selectedChangeSet ]
 ]
 
@@ -631,7 +630,7 @@ SpChangeSorterPresenter >> removeMessage [
 			class := self selectedClass.
 				(class includesSelector: selector) ifFalse:[^ self].
 				method := class>>selector.
-				(self model removeMethod: method inClass: class)
+				(SystemNavigation new removeMethod: method inClass: class)
 					ifTrue: [ self updateMessagesList ]]
 ]
 

src/NewTools-Debugger/StDebugger.class.st

@@ -919,6 +919,23 @@ StDebugger >> proceedDebugSession [
 	self close
 ]
 
+{ #category : #private }
+StDebugger >> 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 : #actions }
 StDebugger >> recompileMethodTo: aString inContext: aContext notifying: aNotifyer [
 
@@ -995,7 +1012,7 @@ StDebugger >> requestProtocolIn: aClass [
 
 	| entryCompletion applicants choice |
 	self class fastTDD ifTrue: [ ^ Protocol unclassified ].
-	applicants := AbstractTool protocolSuggestionsFor: aClass.
+	applicants := self protocolSuggestionsFor: aClass.
 	entryCompletion := EntryCompletion new
 		                   dataSourceBlock: [ :currText | applicants ];
 		                   filterBlock: [ :currApplicant :currText | 

src/NewTools-Debugger/StDebuggerContextInteractionModel.class.st

@@ -69,8 +69,7 @@ StDebuggerContextInteractionModel >> doItReceiver [
 
 { #category : #testing }
 StDebuggerContextInteractionModel >> hasBindingInContextOf: aString [
-	"we lookup the name without creating a new variable"
-	^ (context lookupVar: aString declare: false) notNil
+	^ (context lookupVar: aString) notNil
 ]
 
 { #category : #testing }

src/NewTools-MethodBrowsers/MessageBrowser.class.st

@@ -4,7 +4,7 @@ A MessageBrowser is a UI to browse a list of method, regardless of what they cou
 example: 
 
 MessageBrowser new
-	openWithSpec;
+	open;
 	messages: (SystemNavigation new allSendersOf: #at:)
 	yourself
 "

src/NewTools-MethodBrowsers/MessageList.class.st

@@ -20,7 +20,6 @@ Class {
 	#instVars : [
 		'cachedHierarchy',
 		'topologySort',
-		'model',
 		'method',
 		'listPresenter'
 	],
@@ -44,8 +43,9 @@ MessageList >> browseClassRefs [
 
 { #category : #actions }
 MessageList >> browseMessages [
+
 	self currentMethod ifNotNil: [ :aMethod |
-		 model browseMessagesFrom: aMethod selector ]
+		SystemNavigation new browseImplementorsOf: aMethod selector ]
 ]
 
 { #category : #actions }
@@ -167,9 +167,9 @@ MessageList >> ensureKeyBindingsFor: aWidget [
 
 { #category : #initialization }
 MessageList >> initialize [
-	topologySort := true.
-	model := AbstractTool new.
-	super initialize
+	super initialize.
+	topologySort := true
+
 ]
 
 { #category : #initialization }
@@ -267,11 +267,6 @@ MessageList >> methodClassNameForItem: anItem [
 	^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ]
 ]
 
-{ #category : #accessing }
-MessageList >> model [ 
-	^model
-]
-
 { #category : #accessing }
 MessageList >> numberOfElements [
 	^ listPresenter listSize
@@ -312,7 +307,7 @@ MessageList >> protocolNameForItem: anItem [
 MessageList >> removeMethods [
 
 	self currentMethod ifNotNil: [ :aMethod |
-		model removeMethod: aMethod inClass: aMethod methodClass ]
+		SystemNavigation new removeMethod: aMethod inClass: aMethod methodClass ]
 ]
 
 { #category : #selecting }