Update users of IceTipStandardAction to use #newXAction + #executeWit…

…hContext: pattern (fixes pharo-vcs#1779) Fixes nil DNU #application errors for package reload/remove/unload, tag delete, and method version load. Also remove extraneous IceRepositoryModified when the action already has #onSuccessRepositoryModified. Add missing ^return in IceTipVersionHistoryModel>>retrieveHistory Remove IceTipStandardAction>>execute: as execution without a context will ~always fail and the pattern is to assign the action first, then the context at time of execution. No references remain in Iceberg packages, and in fact all remaining references are self-sends, so clearly aren't sent to IceTipStandardAction.
shoshanatech · Dec 16, 2023 · 2174862 · 2174862
1 parent 4733a87
commit 2174862
Show file tree

Hide file tree

Showing 13 changed files with 84 additions and 89 deletions.
diff --git a/Iceberg-TipUI/IceTipInstallVersionCommand.class.st b/Iceberg-TipUI/IceTipInstallVersionCommand.class.st
@@ -22,10 +22,10 @@ IceTipInstallVersionCommand class >> defaultName [
 	^ 'Install this version'
 ]
 
-{ #category : 'execution' }
+{ #category : 'executing' }
 IceTipInstallVersionCommand >> execute [
-	
-	self version install
+
+	self version newInstallAction executeWithContext: self context
 ]
 
 { #category : 'activation' }

diff --git a/Iceberg-TipUI/IceTipLoadPackageCommand.class.st b/Iceberg-TipUI/IceTipLoadPackageCommand.class.st
@@ -30,9 +30,7 @@ IceTipLoadPackageCommand >> canBeExecuted [
 { #category : 'executing' }
 IceTipLoadPackageCommand >> execute [
 
-	self packageModel newLoadAction executeWithContext: self context.
-	Iceberg announcer announce:
-		(IceRepositoryModified for: self repository)
+	self packageModel newLoadAction executeWithContext: self context
 ]
 
 { #category : 'accessing' }

diff --git a/Iceberg-TipUI/IceTipPackageModel.class.st b/Iceberg-TipUI/IceTipPackageModel.class.st
@@ -77,37 +77,54 @@ IceTipPackageModel >> newLoadAction [
 		yourself
 ]
 
-{ #category : 'accessing' }
-IceTipPackageModel >> packageName [
-	^ self entity packageName
+{ #category : 'actions' }
+IceTipPackageModel >> newReloadAction [
+
+	<noCache>
+	^ IceTipStandardAction new
+		  repository: self entity repository;
+		  message: ('Reloading package {1}' format: { self entity name });
+		  onSuccessRepositoryModified;
+		  action: [
+			  Iceberg announcer
+				  suspendAllForRepository: self entity repository
+				  while: [ self entity reload ] ];
+		  yourself
 ]
 
 { #category : 'actions' }
-IceTipPackageModel >> reload [
-	<noCache>
+IceTipPackageModel >> newRemoveAction [
 
-	IceTipStandardAction new 
+	<noCache>
+	^IceTipStandardAction new
 		repository: self entity repository;
-		message: ('Reloading package {1}' format: { self entity name }) ;
+		message: ('Removing package {1}' format: { self entity name });
 		onSuccessRepositoryModified;
-		execute: [ 
-			Iceberg announcer 
-				suspendAllForRepository: self entity repository 
-				while: [ self entity reload ] ]
+		action: [
+			Iceberg announcer
+				suspendAllForRepository: self entity repository
+				while: [ self entity remove ] ];
+		yourself
 ]
 
 { #category : 'actions' }
-IceTipPackageModel >> remove [
+IceTipPackageModel >> newUnloadAction [
+
 	<noCache>
+	^ IceTipStandardAction new
+		  repository: self entity repository;
+		  message: ('Unloading package {1}' format: { self entity name });
+		  onSuccessRepositoryModified;
+		  action: [
+			  Iceberg announcer
+				  suspendAllForRepository: self entity repository
+				  while: [ self entity unload ] ];
+		  yourself
+]
 
-	IceTipStandardAction new 
-		repository: self entity repository;
-		message: ('Removing package {1}' format: { self entity name });
-		onSuccessRepositoryModified; 
-		execute: [ 
-			Iceberg announcer
-				suspendAllForRepository: self entity repository
-				while: [ self entity remove ] ]
+{ #category : 'accessing' }
+IceTipPackageModel >> packageName [
+	^ self entity packageName
 ]
 
 { #category : 'accessing' }
@@ -129,17 +146,3 @@ IceTipPackageModel >> statusDecorator [
 		ifFalse: [ IceTipDescriptionDecorator notLoaded ].
 	^ super statusDecorator
 ]
-
-{ #category : 'actions' }
-IceTipPackageModel >> unload [
-	<noCache>
-
-	IceTipStandardAction new 
-		repository: self entity repository;
-		message: ('Unloading package {1}' format: { self entity name });
-		onSuccessRepositoryModified; 
-		execute: [ 
-			Iceberg announcer
-				suspendAllForRepository: self entity repository
-				while: [ self entity unload ] ]
-]
diff --git a/Iceberg-TipUI/IceTipReloadPackageCommand.class.st b/Iceberg-TipUI/IceTipReloadPackageCommand.class.st
@@ -30,9 +30,7 @@ IceTipReloadPackageCommand >> canBeExecuted [
 { #category : 'executing' }
 IceTipReloadPackageCommand >> execute [
 
-	self packageModel reload.
-	Iceberg announcer announce:
-		(IceRepositoryModified for: self repository)
+	self packageModel newReloadAction executeWithContext: self context.
 ]
 
 { #category : 'accessing' }

diff --git a/Iceberg-TipUI/IceTipRemoveFromRepositoryPackageCommand.class.st b/Iceberg-TipUI/IceTipRemoveFromRepositoryPackageCommand.class.st
@@ -24,7 +24,7 @@ IceTipRemoveFromRepositoryPackageCommand class >> defaultName [
 { #category : 'executing' }
 IceTipRemoveFromRepositoryPackageCommand >> execute [
 
-	self packageModel remove
+	self packageModel newRemoveAction executeWithContext: self context
 ]
 
 { #category : 'accessing' }

diff --git a/Iceberg-TipUI/IceTipRemovePackageDialogPresenter.class.st b/Iceberg-TipUI/IceTipRemovePackageDialogPresenter.class.st
@@ -17,9 +17,9 @@ Class {
 IceTipRemovePackageDialogPresenter >> accept [
 
 	self removeFromRepositoryCheckbox state
-		ifTrue: [ self model remove ].
+		ifTrue: [ self model newRemoveAction executeWithContext: self ].
 	self unloadFromImageCheckbox state
-		ifTrue: [ self model unload ].
+		ifTrue: [ self model newUnloadAction executeWithContext: self ].
 ]
 
 { #category : 'accessing - ui' }

diff --git a/Iceberg-TipUI/IceTipRepositoryModel.class.st b/Iceberg-TipUI/IceTipRepositoryModel.class.st
@@ -272,13 +272,14 @@ IceTipRepositoryModel >> newAddRemoteActionName: aName url: anUrl [
 
 { #category : 'actions' }
 IceTipRepositoryModel >> newCheckoutNewBranchNamed: aString inCommit: aCommit [
-	<noCache>
 
-	^ IceTipStandardAction new 
-		repository: self entity;
-		message: ('Checking out new branch {1}' format: { aString });
-		onSuccessRepositoryModified;
-		action: [ self entity createBranch: aString inCommit: aCommit ]
+	<noCache>
+	^ IceTipStandardAction new
+		  repository: self entity;
+		  message: ('Checking out new branch {1}' format: { aString });
+		  onSuccessRepositoryModified;
+		  action: [ self entity createBranch: aString inCommit: aCommit ];
+		  yourself
 ]
 
 { #category : 'actions' }

diff --git a/Iceberg-TipUI/IceTipStandardAction.class.st b/Iceberg-TipUI/IceTipStandardAction.class.st
@@ -45,13 +45,6 @@ IceTipStandardAction >> do: aBlock [
 	self execute
 ]
 
-{ #category : 'executing' }
-IceTipStandardAction >> execute: aBlock [
-
-	self action: aBlock.
-	self execute
-]
-
 { #category : 'accessing' }
 IceTipStandardAction >> message [
 	^ message

diff --git a/Iceberg-TipUI/IceTipTagModel.class.st b/Iceberg-TipUI/IceTipTagModel.class.st
@@ -19,17 +19,6 @@ IceTipTagModel >> commitModels [
 	^ commits
 ]
 
-{ #category : 'actions' }
-IceTipTagModel >> delete [
-	<noCache>
-
-	IceTipStandardAction new
-		repository: self repositoryModel entity;
-		message: ('Removing tag {1}' format: { self name });
-		onSuccessRepositoryModified;
-		do: [ self repositoryModel entity removeTag: self entity ]
-]
-
 { #category : 'accessing' }
 IceTipTagModel >> description [
 
@@ -42,6 +31,18 @@ IceTipTagModel >> name [
 	^ self entity name
 ]
 
+{ #category : 'actions' }
+IceTipTagModel >> newDeleteAction [
+
+	<noCache>
+	^ IceTipStandardAction new
+		  repository: self repositoryModel entity;
+		  message: ('Removing tag {1}' format: { self name });
+		  onSuccessRepositoryModified;
+		  action: [ self entity delete ];
+		  yourself
+]
+
 { #category : 'actions' }
 IceTipTagModel >> previewCheckout [
 	"this will open a 'checkout browser' that will allow user to validate the changes before 

diff --git a/Iceberg-TipUI/IceTipUnloadPackageCommand.class.st b/Iceberg-TipUI/IceTipUnloadPackageCommand.class.st
@@ -30,7 +30,7 @@ IceTipUnloadPackageCommand >> canBeExecuted [
 { #category : 'executing' }
 IceTipUnloadPackageCommand >> execute [
 
-	self packageModel unload
+	self packageModel newUnloadAction executeWithContext: self context
 ]
 
 { #category : 'accessing' }

diff --git a/Iceberg-TipUI/IceTipVersionHistoryModel.class.st b/Iceberg-TipUI/IceTipVersionHistoryModel.class.st
@@ -44,7 +44,7 @@ IceTipVersionHistoryModel >> name [
 IceTipVersionHistoryModel >> retrieveHistory [
 
 	self repositoryModel checkMissing.
-	self application 
+	^self application 
 		informUser: ('Retrieving history of {1}' format: { self entity printString }) 
 		during: [ self repositoryModel entity log historyOfMethod: self entity ]
 ]
diff --git a/Iceberg-TipUI/IceTipVersionModel.class.st b/Iceberg-TipUI/IceTipVersionModel.class.st
@@ -12,30 +12,23 @@ Class {
 	#tag : 'Model'
 }
 
-{ #category : 'private' }
-IceTipVersionModel >> basicInstall [
-	| definition |
-
-	definition := self entity definition.
-	definition realClass 
-		compile: definition sourceCode
-		classified: definition category	
-]
-
 { #category : 'accessing' }
 IceTipVersionModel >> commit [
 	^ self entity commit
 ]
 
 { #category : 'actions' }
-IceTipVersionModel >> install [
-	<noCache>
+IceTipVersionModel >> newInstallAction [
 
-	IceTipStandardAction new 
-		repository: self repositoryModel entity; 
-		message: ('Installing {1} - {2}' format: { self entity definition. self name });
-		onSuccessRepositoryModified;
-		execute: [ self basicInstall ]
+	<noCache>
+	^ IceTipStandardAction new
+		  repository: self repositoryModel entity;
+		  message: ('Installing {1} - {2}' format: {
+						   self entity definition.
+						   self name });
+		  onSuccessRepositoryModified;
+		  action: [ self entity install ];
+		  yourself
 ]
 
 { #category : 'accessing' }

diff --git a/Iceberg/IceLogVersion.class.st b/Iceberg/IceLogVersion.class.st
@@ -72,6 +72,14 @@ IceLogVersion >> id [
 	^ self commit id
 ]
 
+{ #category : 'actions' }
+IceLogVersion >> install [
+
+	definition realClass
+		compile: definition sourceCode
+		classified: definition category
+]
+
 { #category : 'accessing' }
 IceLogVersion >> originMethod [
 	^ (Smalltalk at: self definition methodClass name) >> self definition selector