Skip to content

Commit

Permalink
Rewrite all users of AbstractTool, move some feature to SystemNavigat…
Browse files Browse the repository at this point in the history
…ion (which is a horrible thing, too).

But this way we have one strange things removed (AbstractTool)

- rewrite users of lookupVar:declare:
-
  • Loading branch information
MarcusDenker committed May 12, 2023
1 parent f6867d1 commit 9fdc3d3
Show file tree
Hide file tree
Showing 6 changed files with 42 additions and 21 deletions.
13 changes: 12 additions & 1 deletion src/NewTools-ChangeSorter/ChangeSorterModel.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -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'
],
Expand Down Expand Up @@ -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 [

Expand Down
9 changes: 4 additions & 5 deletions src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -65,8 +65,7 @@ SpChangeSorterPresenter >> browseChangeSet [

{ #category : #'menu - message' }
SpChangeSorterPresenter >> browseImplementorsOfMessages [

self model browseMessagesFrom: self selectedSelector
SystemNavigation new browseAllImplementorsOf: self selectedSelector
]

{ #category : #'menu - message' }
Expand All @@ -80,7 +79,7 @@ SpChangeSorterPresenter >> browseMethodFull [
{ #category : #'menu - message' }
SpChangeSorterPresenter >> browseSendersOfMessages [

self model browseSendersOfMessagesFrom: self selectedSelector
self systemNavigation browseAllSendersOf: self selectedSelector
]

{ #category : #'menu - message' }
Expand Down Expand Up @@ -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 ]
]

Expand All @@ -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 ]]
]

Expand Down
19 changes: 18 additions & 1 deletion src/NewTools-Debugger/StDebugger.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -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 [

Expand Down Expand Up @@ -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 |
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down
2 changes: 1 addition & 1 deletion src/NewTools-MethodBrowsers/MessageBrowser.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -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
"
Expand Down
17 changes: 6 additions & 11 deletions src/NewTools-MethodBrowsers/MessageList.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@ Class {
#instVars : [
'cachedHierarchy',
'topologySort',
'model',
'method',
'listPresenter'
],
Expand All @@ -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 }
Expand Down Expand Up @@ -167,9 +167,9 @@ MessageList >> ensureKeyBindingsFor: aWidget [

{ #category : #initialization }
MessageList >> initialize [
topologySort := true.
model := AbstractTool new.
super initialize
super initialize.
topologySort := true

]

{ #category : #initialization }
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 }
Expand Down

0 comments on commit 9fdc3d3

Please sign in to comment.