Merge 6207419

.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

.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

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -4,7 +4,7 @@ Class {
 	#instVars : [
 		'initializersEnabled'
 	],
-	#category : #BaselineOfNewTools
+	#category : 'BaselineOfNewTools'
 }
 
 { #category : #baselines }
@@ -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' ]
 ]

src/NewTools-ChangeSorter/ChangeSorterModel.class.st

@@ -3,11 +3,11 @@ A ChangeSorterModel is a model used by Change Sorter UIs for computation
 "
 Class {
 	#name : #ChangeSorterModel,
-	#superclass : #AbstractTool,
+	#superclass : #Model,
 	#classVars : [
 		'ClassDescriptionsMap'
 	],
-	#category : #'NewTools-ChangeSorter'
+	#category : 'NewTools-ChangeSorter'
 }
 
 { #category : #accessing }
@@ -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' }

src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st

@@ -15,7 +15,7 @@ Class {
 		'classesListPresenter',
 		'textPresenter'
 	],
-	#category : #'NewTools-ChangeSorter'
+	#category : 'NewTools-ChangeSorter'
 }
 
 { #category : #layout }
@@ -50,23 +50,26 @@ SpChangeSorterPresenter class >> title [
 SpChangeSorterPresenter >> addPreamble [
 	self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ].
 	self model addPreambleTo: self selectedChangeSet.
-	changesListPresenter setSelectedItem: self selectedChangeSet
+	changesListPresenter selectItem: self selectedChangeSet
 ]
 
 { #category : #'menu - change set' }
 SpChangeSorterPresenter >> browseChangeSet [
 	"Open a message list browser on methods in the current change set"
 
 	| messages |
-	self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ].
-	messages := self selectedChangeSet changedMessageList select: [ :each | each isValid ].
-	self application tools messageList browse: messages title: 'Methods in Change Set ' , self selectedChangeSet name
+	self selectedChangeSet ifNil: [
+		^ self inform: 'No change set selected' ].
+	messages := self selectedChangeSet changedMessageList select: [ :each |
+		            each isValid ].
+	self application tools messageList
+		browse: messages
+		title: 'Methods in Change Set ' , self selectedChangeSet name
 ]
 
 { #category : #'menu - message' }
 SpChangeSorterPresenter >> browseImplementorsOfMessages [
-
-	self model browseMessagesFrom: self selectedSelector
+	SystemNavigation new browseAllImplementorsOf: self selectedSelector
 ]
 
 { #category : #'menu - message' }
@@ -80,7 +83,7 @@ SpChangeSorterPresenter >> browseMethodFull [
 { #category : #'menu - message' }
 SpChangeSorterPresenter >> browseSendersOfMessages [
 
-	self model browseSendersOfMessagesFrom: self selectedSelector
+	self systemNavigation browseAllSendersOf: self selectedSelector
 ]
 
 { #category : #'menu - message' }
@@ -338,7 +341,7 @@ SpChangeSorterPresenter >> findChangeSet [
 
 	| set |
 	set := self model findChangeSetIn: self changeSets.
-	changesListPresenter setSelectedItem: set
+	changesListPresenter selectItem: set
 ]
 
 { #category : #private }
@@ -347,7 +350,7 @@ SpChangeSorterPresenter >> forceChangesListRefresh [
 	| sel |	
 	sel := self selectedChangeSet.
 	changesListPresenter items: self model allChanges.
-	changesListPresenter setSelectedItem: sel
+	changesListPresenter selectItem: sel
 ]
 
 { #category : #'menu - class' }
@@ -389,11 +392,8 @@ SpChangeSorterPresenter >> initialize [
 { #category : #initialization }
 SpChangeSorterPresenter >> initializeAnnouncements [
 
-	SystemAnnouncer uniqueInstance weak 
-		when:
-			ClassAdded , ClassCommented , ClassRecategorized , ClassModifiedClassDefinition , ClassRemoved , ClassRenamed
-				, ClassReorganized , MethodAdded , MethodModified , MethodRecategorized , MethodRemoved , ProtocolAdded
-				, ProtocolRemoved
+	SystemAnnouncer uniqueInstance weak
+		when: ClassAdded , ClassCommented , ClassRepackaged , ClassModifiedClassDefinition , ClassRemoved , ClassRenamed , MethodAdded , MethodModified , MethodRecategorized , MethodRemoved , ProtocolAnnouncement
 		send: #updateClassesList
 		to: self
 ]
@@ -520,7 +520,7 @@ SpChangeSorterPresenter >> newSet [
 	aSet := self model createNewSet.
 	aSet
 		ifNotNil: [ self updateChangesList.
-			changesListPresenter setSelectedItem: aSet.
+			changesListPresenter selectItem: aSet.
 			self updateWindowTitle ]
 ]
 
@@ -616,7 +616,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 +631,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 ]]
 ]
 
@@ -640,7 +640,7 @@ SpChangeSorterPresenter >> removePostscript [
 
 	self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ].
 	self model removePostscriptFrom: self selectedChangeSet.
-	changesListPresenter setSelectedItem: self selectedChangeSet
+	changesListPresenter selectItem: self selectedChangeSet
 ]
 
 { #category : #'menu - change set' }
@@ -649,7 +649,7 @@ SpChangeSorterPresenter >> removePreamble [
 	self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ].
 	self selectedChangeSet hasPreamble ifFalse: [ ^ self inform: 'Change set has no preamble' ].
 	self selectedChangeSet removePreamble.
-	changesListPresenter setSelectedItem: self selectedChangeSet
+	changesListPresenter selectItem: self selectedChangeSet
 ]
 
 { #category : #'menu - change set' }
@@ -660,7 +660,7 @@ SpChangeSorterPresenter >> rename [
 
 	changesListPresenter
 		updateList;
-		setSelectedItem: set.
+		selectItem: set.
 	self updateWindowTitle
 ]
 
@@ -726,19 +726,19 @@ SpChangeSorterPresenter >> setSelectedChangeSet: aChangeSet [
 { #category : #api }
 SpChangeSorterPresenter >> setSelectedChangeSetIndex: anIndex [
 
-	 ^ changesListPresenter setSelectedIndex: anIndex
+	 ^ changesListPresenter selectIndex: anIndex
 ]
 
 { #category : #api }
 SpChangeSorterPresenter >> setSelectedClass: aClass [
 
-	 ^ classesListPresenter setSelectedItem: aClass
+	 ^ classesListPresenter selectItem: aClass
 ]
 
 { #category : #api }
 SpChangeSorterPresenter >> setSelectedClassIndex: anIndex [
 
-	 ^ classesListPresenter setSelectedIndex: anIndex
+	 ^ classesListPresenter selectIndex: anIndex
 ]
 
 { #category : #accessing }
@@ -780,7 +780,7 @@ SpChangeSorterPresenter >> updateClassesListAndMessagesList [
 	| sel |
 	sel := methodsListPresenter selectedItem.
 	self updateClassesList.
-	methodsListPresenter setSelectedItem: sel.
+	methodsListPresenter selectItem: sel.
 	self updateMessagesList
 ]
 
@@ -794,7 +794,7 @@ SpChangeSorterPresenter >> updateMessagesList [
 			ifNil: [ methodsListPresenter items: {} ]
 			ifNotNil: [:class | methodsListPresenter items: (self selectedChangeSet selectorsInClass: class name) sort].
 
-	methodsListPresenter setSelectedItem: sel
+	methodsListPresenter selectItem: sel
 ]
 
 { #category : #private }
@@ -809,6 +809,11 @@ SpChangeSorterPresenter >> updateTextContents [
 	textPresenter text: text
 ]
 
+{ #category : #'private - updating' }
+SpChangeSorterPresenter >> updateTitle [
+	self withWindowDo: [ :window | window title: self title ]
+]
+
 { #category : #api }
 SpChangeSorterPresenter >> updateWindowTitle [
 

src/NewTools-CodeCritiques/ClassDescription.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #ClassDescription }
+
+{ #category : #'*NewTools-CodeCritiques' }
+ClassDescription >> criticNameOn: aStream [
+	"This behavior may be folded later by changing the name of this method or using another one."
+
+	aStream << self name << ' (' << self package name << ')'
+]

src/NewTools-CodeCritiques/CompiledMethod.extension.st

@@ -0,0 +1,14 @@
+Extension { #name : #CompiledMethod }
+
+{ #category : #'*NewTools-CodeCritiques' }
+CompiledMethod >> criticNameOn: aStream [
+	"This behavior may be folded later by changing the name of this method or using another one."
+
+	aStream
+		<< self methodClass name
+		<< '>>#'
+		<< self selector
+		<< ' ('
+		<< self methodClass package name
+		<< ')'
+]

src/NewTools-CodeCritiques/RPackage.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #RPackage }
+
+{ #category : #'*NewTools-CodeCritiques' }
+RPackage >> criticNameOn: aStream [
+	"This behavior may be folded later by changing the name of this method or using another one."
+
+	aStream << self packageName
+]