diff --git a/.github/workflows/newtools-all.yml b/.github/workflows/newtools-all.yml index 12e1471a2..2abcd4ac3 100644 --- a/.github/workflows/newtools-all.yml +++ b/.github/workflows/newtools-all.yml @@ -6,9 +6,9 @@ env: on: push: - branches: [ Pharo11 ] + branches: [ Pharo12 ] pull_request: - branches: [ Pharo11 ] + branches: [ Pharo12 ] # Allows you to run this workflow manually from the Actions tab workflow_dispatch: @@ -19,15 +19,15 @@ jobs: strategy: matrix: os: [ ubuntu-latest ] - smalltalk: [ Pharo64-11 ] + smalltalk: [ Pharo64-12 ] runs-on: ${{ matrix.os }} name: ${{ matrix.smalltalk }} on ${{ matrix.os }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - name: Setup smalltalkCI uses: hpi-swa/setup-smalltalkCI@v1 with: - smalltalk-version: ${{ matrix.smalltalk }} + smalltalk-image: ${{ matrix.smalltalk }} - name: Load Image and Run Release Tests run: smalltalkci -s ${{ matrix.smalltalk }} .smalltalk.release.ston timeout-minutes: 10 diff --git a/.github/workflows/newtools.yml b/.github/workflows/newtools.yml index 7efe2520b..25e61cfc4 100644 --- a/.github/workflows/newtools.yml +++ b/.github/workflows/newtools.yml @@ -6,9 +6,9 @@ env: on: push: - branches: [ Pharo11, dev-1.0 ] + branches: [ Pharo12, dev-1.0 ] pull_request: - branches: [ Pharo11, dev-1.0 ] + branches: [ Pharo12, dev-1.0 ] # Allows you to run this workflow manually from the Actions tab workflow_dispatch: @@ -19,15 +19,15 @@ jobs: strategy: matrix: os: [ ubuntu-latest ] - smalltalk: [ Pharo64-11 ] + smalltalk: [ Pharo64-12 ] runs-on: ${{ matrix.os }} name: ${{ matrix.smalltalk }} on ${{ matrix.os }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - name: Setup smalltalkCI uses: hpi-swa/setup-smalltalkCI@v1 with: - smalltalk-version: ${{ matrix.smalltalk }} + smalltalk-image: ${{ matrix.smalltalk }} - name: Load Image and Run Tests run: smalltalkci -s ${{ matrix.smalltalk }} .smalltalk.ston timeout-minutes: 15 diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st index e68adbc6d..2022b2576 100644 --- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st +++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st @@ -187,6 +187,6 @@ BaselineOfNewTools >> sindarin: spec [ spec baseline: 'Sindarin' with: [ spec repository: (self packageRepositoryURL - ifEmpty: [ 'github://pharo-spec/ScriptableDebugger:Pharo-11' ]); + ifEmpty: [ 'github://pharo-spec/ScriptableDebugger:Pharo12/src' ]); loads: 'default' ] ] diff --git a/src/NewTools-ChangeSorter/ChangeSorterModel.class.st b/src/NewTools-ChangeSorter/ChangeSorterModel.class.st index ed27935a5..2fdd2e2cc 100644 --- a/src/NewTools-ChangeSorter/ChangeSorterModel.class.st +++ b/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. ] @@ -254,13 +263,13 @@ ChangeSorterModel >> setContentsOfChangeSet: changeSet forClass: class andSelect ifNil: [ "Only the change set is currently selected" ^ self buildChangeSetDescriptionFor: changeSet ]. - selector + ^ selector ifNil: [ "class is selected but not the selector" - ^ self buildClassDescriptionFor: changeSet class: class ] + self buildClassDescriptionFor: changeSet class: class ] ifNotNil: [ "a class and a selector are selected" - ^ self buildSelectorDescriptionFor: changeSet class: class selector: selector ] + self buildSelectorDescriptionFor: changeSet class: class selector: selector ] ] { #category : #'change set' } diff --git a/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st b/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st index 253d11929..ce7fc9bd9 100644 --- a/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st +++ b/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 ]] ] diff --git a/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st b/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st index 589c5f4ae..a1a04e2bc 100644 --- a/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st +++ b/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st @@ -159,11 +159,11 @@ StDebuggerCommandTest >> testCommandsInMissingClassContext [ self assert: (StReturnValueCommand forContext: debugger) canBeExecuted. "Non-executable commands relative to context" - self deny: (StStepIntoCommand forContext: debugger) canBeExecuted. - self deny: (StStepOverCommand forContext: debugger) canBeExecuted. - self deny: (StStepThroughCommand forContext: debugger) canBeExecuted. - self deny: (StRunToSelectionCommand forContext: debugger) canBeExecuted. - self deny: (StProceedCommand forContext: debugger) canBeExecuted. + self assert: (StStepIntoCommand forContext: debugger) canBeExecuted. + self assert: (StStepOverCommand forContext: debugger) canBeExecuted. + self assert: (StStepThroughCommand forContext: debugger) canBeExecuted. + self assert: (StRunToSelectionCommand forContext: debugger) canBeExecuted. + self assert: (StProceedCommand forContext: debugger) canBeExecuted. self deny: (StDefineSubclassResponsabilityCommand forContext: debugger) canBeExecuted. diff --git a/src/NewTools-Debugger-Tests/StDebuggerContextInteractionModelTest.class.st b/src/NewTools-Debugger-Tests/StDebuggerContextInteractionModelTest.class.st index e04e43427..ba66fb6e2 100644 --- a/src/NewTools-Debugger-Tests/StDebuggerContextInteractionModelTest.class.st +++ b/src/NewTools-Debugger-Tests/StDebuggerContextInteractionModelTest.class.st @@ -121,6 +121,36 @@ StDebuggerContextInteractionModelTest >> testBindingOfPrioritizesContextBindings equals: 42. ] +{ #category : #tests } +StDebuggerContextInteractionModelTest >> testCompile [ + + | result | + model context + step; + step; + step; + step. "Perform the two first assigments of the method `helperMethodForBindings`" + + result := model compiler evaluate: 'instanceVariableForTest'. + self assert: result equals: 42. + instanceVariableForTest := 52. + result := model compiler evaluate: 'instanceVariableForTest'. + self assert: result equals: 52. + + result := model compiler evaluate: 'instanceVariableForTest := 62'. + self assert: result equals: 62. + result := model compiler evaluate: 'instanceVariableForTest'. + self assert: result equals: 62. + self assert: instanceVariableForTest equals: 62. + + result := model compiler evaluate: 'tempVariableForTest'. + self assert: result equals: 43. + result := model compiler evaluate: 'tempVariableForTest := 53'. + self assert: result equals: 53. + result := model compiler evaluate: 'tempVariableForTest'. + self assert: result equals: 53 +] + { #category : #tests } StDebuggerContextInteractionModelTest >> testHasBindingsInContextOf [ diff --git a/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st b/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st index 98d78b414..e0427b502 100644 --- a/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st +++ b/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st @@ -13,9 +13,9 @@ Class { { #category : #helpers } StTestDebuggerProvider class >> compileMissingClassContextBuilder [ - self compile: 'buildDebuggerWithMissingClassContext + self compiler permitUndeclared: true; install: 'buildDebuggerWithMissingClassContext - [ MissingClass new ] + [ ^ MissingClass ] on: Error do: [ :err | self sessionFor: err signalerContext copy exception: err. diff --git a/src/NewTools-Debugger/StDebugger.class.st b/src/NewTools-Debugger/StDebugger.class.st index 68ff45959..ae9b681f6 100644 --- a/src/NewTools-Debugger/StDebugger.class.st +++ b/src/NewTools-Debugger/StDebugger.class.st @@ -383,7 +383,7 @@ StDebugger >> createMissingClass [ [ | newClassBinding | self flag: 'This method is actually hard to test because it requires user input to complete. How to test that automatically?'. - newClassBinding := OCUndeclaredVariableWarning new + newClassBinding := OCCodeReparator new node: variableNode; defineClass: variableNode name ] on: Abort @@ -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 | diff --git a/src/NewTools-Debugger/StDebuggerContextInteractionModel.class.st b/src/NewTools-Debugger/StDebuggerContextInteractionModel.class.st index 74ae18a6b..3ee2e1685 100644 --- a/src/NewTools-Debugger/StDebuggerContextInteractionModel.class.st +++ b/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 } diff --git a/src/NewTools-Debugger/StDebuggerErrorContextPredicate.class.st b/src/NewTools-Debugger/StDebuggerErrorContextPredicate.class.st index ea3fb270e..ad0b7f74b 100644 --- a/src/NewTools-Debugger/StDebuggerErrorContextPredicate.class.st +++ b/src/NewTools-Debugger/StDebuggerErrorContextPredicate.class.st @@ -55,7 +55,7 @@ StDebuggerErrorContextPredicate >> isContextDoesNotUnderstand [ { #category : #predicates } StDebuggerErrorContextPredicate >> isContextMissingClassException [ - ^ exception class == VariableNotDeclared + ^ #(#VariableNotDeclared #UndeclaredVariableRead #UndeclaredVariableWrite) includes: exception class name ] { #category : #predicates } diff --git a/src/NewTools-Inspector-Extensions/Bag.extension.st b/src/NewTools-Inspector-Extensions/Bag.extension.st index a4b2596c5..d8734ee24 100644 --- a/src/NewTools-Inspector-Extensions/Bag.extension.st +++ b/src/NewTools-Inspector-Extensions/Bag.extension.st @@ -9,10 +9,12 @@ Bag >> inspectionItems: aBuilder [ title: 'Items'; evaluated: [ :each | StObjectPrinter asTruncatedTextFrom: each key ]; beNotExpandable; + beSortable; yourself); addColumn: (SpStringTableColumn new title: 'Occurences'; evaluated: [ :each | StObjectPrinter asTruncatedTextFrom: (self occurrencesOf: each key) ]; + beSortable; yourself); items: contents associations; yourself diff --git a/src/NewTools-Inspector-Extensions/Collection.extension.st b/src/NewTools-Inspector-Extensions/Collection.extension.st index 813054ab1..ff7655c08 100644 --- a/src/NewTools-Inspector-Extensions/Collection.extension.st +++ b/src/NewTools-Inspector-Extensions/Collection.extension.st @@ -13,7 +13,7 @@ Collection >> inspectionItems: aBuilder [ addColumn: (SpStringTableColumn new title: 'Value'; evaluated: [ :each | StObjectPrinter asTruncatedTextFrom: each ]; - sortFunction: #printString ascending; + beSortable; yourself); items: self asOrderedCollection; yourself diff --git a/src/NewTools-Inspector-Extensions/RPackage.extension.st b/src/NewTools-Inspector-Extensions/RPackage.extension.st new file mode 100644 index 000000000..4b462db9a --- /dev/null +++ b/src/NewTools-Inspector-Extensions/RPackage.extension.st @@ -0,0 +1,31 @@ +Extension { #name : #RPackage } + +{ #category : #'*NewTools-Inspector-Extensions' } +RPackage >> baselineInspector [ + + + | items | + items := BaselineOf allSubclasses select: [ :e | e allPackageNames includes: self name ]. + ^ SpListPresenter new + items: items; + yourself +] + +{ #category : #'*NewTools-Inspector-Extensions' } +RPackage >> overwiew [ + + + | items | + items :={ 'Classes' -> self classes . 'Defined classes' -> self definedClasses . 'Methods' -> self methods }. + items := items collect: [ :e | StInspectorAssociationNode hostObject: e ]. + ^ SpTablePresenter new + alternateRowsColor; + items: items; + addColumn: (SpStringTableColumn + title: 'Title' + evaluated: [ :e | e key ] ); + addColumn: (SpStringTableColumn + title: 'Value' + evaluated: [ :e | e value size ] ); + yourself +] diff --git a/src/NewTools-Inspector/StInspectorTransmissionNode.class.st b/src/NewTools-Inspector/StInspectorTransmissionNode.class.st new file mode 100644 index 000000000..56b76c7a1 --- /dev/null +++ b/src/NewTools-Inspector/StInspectorTransmissionNode.class.st @@ -0,0 +1,38 @@ +" +I am an inspector node that allows the user to specify a custom transmission. I am made to be used inside the Inspector. The user can specify the `transmissionBlock:` +" +Class { + #name : #StInspectorTransmissionNode, + #superclass : #StInspectorNode, + #instVars : [ + 'transmissionBlock' + ], + #category : #'NewTools-Inspector-Model' +} + +{ #category : #'instance initialization' } +StInspectorTransmissionNode class >> hostObject: anObject transmissionBlock: aFullBlockClosure [ + + ^ self new + hostObject: anObject; + transmissionBlock: aFullBlockClosure; + yourself +] + +{ #category : #accessing } +StInspectorTransmissionNode >> key [ + + ^ self hostObject +] + +{ #category : #accessing } +StInspectorTransmissionNode >> rawValue [ + + ^ transmissionBlock value: hostObject +] + +{ #category : #accessing } +StInspectorTransmissionNode >> transmissionBlock: aBlock [ + + transmissionBlock := aBlock +] diff --git a/src/NewTools-MethodBrowsers/MessageBrowser.class.st b/src/NewTools-MethodBrowsers/MessageBrowser.class.st index e61c170c1..2f2345dbd 100644 --- a/src/NewTools-MethodBrowsers/MessageBrowser.class.st +++ b/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 " @@ -362,10 +362,6 @@ MessageBrowser >> methodModified: anAnnouncement [ self handleMethodModified: anAnnouncement ] ] -{ #category : #announcements } -MessageBrowser >> methodRecategorized: aMethod [ -] - { #category : #announcements } MessageBrowser >> methodRemoved: anAnnouncement [ "this method forces the announcement to be handled in the UI process" @@ -389,7 +385,6 @@ MessageBrowser >> registerToAnnouncements [ SystemAnnouncer uniqueInstance weak when: MethodAdded send: #methodAdded: to: self; when: MethodModified send: #methodModified: to: self; - when: MethodRecategorized send: #methodRecategorized: to: self; when: MethodRemoved send: #methodRemoved: to: self; when: ClassRenamed send: #classRenamed: to: self ] diff --git a/src/NewTools-MethodBrowsers/MessageList.class.st b/src/NewTools-MethodBrowsers/MessageList.class.st index 359a41523..1a6ced146 100644 --- a/src/NewTools-MethodBrowsers/MessageList.class.st +++ b/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 } diff --git a/src/NewTools-Spotter-Processors/StGenericGenerator.class.st b/src/NewTools-Spotter-Processors/StGenericGenerator.class.st index 1a57a9eee..904dbf781 100644 --- a/src/NewTools-Spotter-Processors/StGenericGenerator.class.st +++ b/src/NewTools-Spotter-Processors/StGenericGenerator.class.st @@ -1,5 +1,5 @@ " -I wrap a generator to provide the same API than the iterators. +I wrap a generator to provide the same API as the iterators. My subclasses should implement #elementsDo: to iterate the collection or implement the values. In this method, each of the generated values should be used with the valuable pased. @@ -11,7 +11,7 @@ elementsDo: aValuable This example generates an infinite iterator always returning 42. Using the generator will produce that the method is only executed on demand. -This Iterator can also wrap collections, iterating one element at the time. +This Iterator can also wrap collections, iterating one element at a time. Ex: elementsDo: aValuable