Merge branch 'dev-2.0' into multi-working-copy

pharo-vcs · Jan 19, 2024 · 3078763 · 3078763
2 parents a140995 + 7880973
commit 3078763
Show file tree

Hide file tree

Showing 19 changed files with 94 additions and 66 deletions.
diff --git a/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesCommand.class.st b/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesCommand.class.st
@@ -15,7 +15,7 @@ IceGitHubRemoveBranchesCommand class >> defaultName [
 	^ 'Remove Branches...'
 ]
 
-{ #category : 'execute' }
+{ #category : 'executing' }
 IceGitHubRemoveBranchesCommand >> execute [
 
 	^ IceGitHubRemoveBranchesAction new

diff --git a/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestsCommand.class.st b/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestsCommand.class.st
@@ -15,7 +15,7 @@ IceGitHubViewPullRequestsCommand class >> defaultName [
 	^ 'View Pull Requests...'
 ]
 
-{ #category : 'execute' }
+{ #category : 'executing' }
 IceGitHubViewPullRequestsCommand >> execute [
 
 	^ IceGitHubViewPullRequestAction new

diff --git a/Iceberg-TipUI/IceTipAddSshCredentialCommand.class.st b/Iceberg-TipUI/IceTipAddSshCredentialCommand.class.st
@@ -19,7 +19,7 @@ IceTipAddSshCredentialCommand class >> defaultName [
 	^ 'SSH Pair'
 ]
 
-{ #category : 'execution' }
+{ #category : 'executing' }
 IceTipAddSshCredentialCommand >> execute [
 
 	((IceTipAddSSHCredentialsPresenter newApplication: context application)

diff --git a/Iceberg-TipUI/IceTipEntityModel.class.st b/Iceberg-TipUI/IceTipEntityModel.class.st
@@ -80,6 +80,24 @@ IceTipEntityModel >> isModelOf: anObject [
 	^ self entity = anObject
 ]
 
+{ #category : 'accessing' }
+IceTipEntityModel >> name [
+
+	^ self entity name
+]
+
+{ #category : 'tagging' }
+IceTipEntityModel >> newCreateTagAction: aString [
+	<noCache>
+
+	^ IceTipStandardAction new 
+		repository: self entity;
+		message: ('Creating tag {1} on commit {2}' format: { aString. self commit shortId });
+		onSuccessRepositoryModified;
+		action: [ self commit createTag: aString ]
+		yourself
+]
+
 { #category : 'accessing' }
 IceTipEntityModel >> repositoryModel [
 	^ repositoryModel

diff --git a/Iceberg-TipUI/IceTipExistingBranchPanel.class.st b/Iceberg-TipUI/IceTipExistingBranchPanel.class.st
@@ -58,16 +58,16 @@ IceTipExistingBranchPanel >> initializeBranchesList [
 
 	branchesList
 		hideColumnHeaders;
-		addColumn: (SpStringTableColumn evaluated: #shortDescription);
+		addColumn: (SpStringTableColumn evaluated: [: branch | self shortDescriptionFor: branch ]);
 		items: self model branchModels.
 
 	self model branchModels
 		detect: #isHead
 		ifFound: [ :head | branchesList selectItem: head ]
-		ifNone: [ self model hasBranches ifTrue: [ branchesList selectIndex: 1 ] ].
-
-	self flag: #pharoTodo. "Instead of detecting 'isHead', we would prefer to select 'self model defaultBranchSelection' but we have a bug with the caches. The reason is that #branchModels returns the same cache used by the list but not #defaultBranchSelection."
+		ifNone: [
+		self model hasBranches ifTrue: [ branchesList selectIndex: 1 ] ].
 
+	self flag: #pharoTodo "Instead of detecting 'isHead', we would prefer to select 'self model defaultBranchSelection' but we have a bug with the caches. The reason is that #branchModels returns the same cache used by the list but not #defaultBranchSelection."
 ]
 
 { #category : 'initialization' }
@@ -83,6 +83,12 @@ IceTipExistingBranchPanel >> selectedBranch [
 	^ self branchesList selection selectedItem
 ]
 
+{ #category : 'initialization' }
+IceTipExistingBranchPanel >> shortDescriptionFor: aBranch [
+	aBranch isHead ifFalse: [ ^aBranch shortDescription  ].
+	^aBranch shortDescription , ' (current)'
+]
+
 { #category : 'initialization' }
 IceTipExistingBranchPanel >> titleForWindow [
 

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/IceTipMergeBranchDialogPresenter.class.st b/Iceberg-TipUI/IceTipMergeBranchDialogPresenter.class.st
@@ -37,22 +37,20 @@ IceTipMergeBranchDialogPresenter >> beSwitchAndMerge [
 IceTipMergeBranchDialogPresenter >> createMergeBranchTypes [
 
 	| allTypes |
-	"Collect types local+remotes"	
-	allTypes :=  { 
-	 	(IceTipMergeBranchPanel on: self model) 
-			titleForWindow: 'Local';
-			withoutHead;
-			icon: (self iconNamed: #branch);
-			yourself }, 
-	(self model remoteModels collect: [ :each | 
-		(IceTipMergeBranchPanel on: each)
-			titleForWindow: each name;
-			icon: (self iconNamed: #remote);
-			yourself ]).
-
+	"Collect types local+remotes"
+	allTypes := { ((IceTipMergeBranchPanel on: self model)
+		             titleForWindow: 'Local';
+		             icon: (self iconNamed: #branch);
+		             yourself) }
+	            , (self model remoteModels collect: [ :each |
+			             (IceTipMergeBranchPanel on: each)
+				             titleForWindow: each name;
+				             icon: (self iconNamed: #remote);
+				             yourself ]).
+
 	"Doing this because I can trigger the accept inside the panels."
 	allTypes do: [ :each | each onAccept: [ self closeWindow ] ].
-	
+
 	^ allTypes
 ]
 

diff --git a/Iceberg-TipUI/IceTipPackageModel.class.st b/Iceberg-TipUI/IceTipPackageModel.class.st
@@ -107,8 +107,8 @@ IceTipPackageModel >> newRemoveAction [
 	^ IceTipStandardAction new 
 		repository: self entity repository;
 		message: ('Removing package {1}' format: { self entity name });
-		onSuccessRepositoryModified; 
-		action: [ 
+		onSuccessRepositoryModified;
+		action: [
 			Iceberg announcer
 				suspendAllForRepository: self entity repository
 				while: [ self entity remove ] ];

diff --git a/Iceberg-TipUI/IceTipReloadPackageCommand.class.st b/Iceberg-TipUI/IceTipReloadPackageCommand.class.st
@@ -31,7 +31,6 @@ IceTipReloadPackageCommand >> canBeExecuted [
 IceTipReloadPackageCommand >> execute [
 
 	self packageModel newReloadAction executeWithContext: self context.
-	Iceberg announcer announce: (IceRepositoryModified for: self repository)
 ]
 
 { #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
@@ -260,11 +260,13 @@ IceTipRepositoryModel >> newAddRemoteActionName: aName url: anUrl [
 { #category : 'actions' }
 IceTipRepositoryModel >> newCheckoutNewBranchNamed: aString inCommit: aCommit [
 
-	^ 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 : 'tagging' }

diff --git a/Iceberg-TipUI/IceTipResetBranchToThisCommitCommand.class.st b/Iceberg-TipUI/IceTipResetBranchToThisCommitCommand.class.st
@@ -26,7 +26,7 @@ IceTipResetBranchToThisCommitCommand >> defaultNameFromContext [
 
 	| shortId branchName |
 	shortId := self selectedCommitish ifNotNil: [ :commitish | commitish shortId ] ifNil: [''].
-	branchName := self selectedBranch ifNotNil: [:branch | branch branchName] ifNil: [ '' ].
+	branchName := self selectedBranch ifNotNil: [:branch | branch name ] ifNil: [ '' ].
 
 	^ 'Reset ', branchName, ' to commit ', shortId
 ]

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
@@ -33,10 +33,16 @@ IceTipTagModel >> description [
 	^ self entity name
 ]
 
-{ #category : 'accessing' }
-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' }

diff --git a/Iceberg-TipUI/IceTipVersionHistoryModel.class.st b/Iceberg-TipUI/IceTipVersionHistoryModel.class.st
@@ -45,7 +45,7 @@ IceTipVersionHistoryModel >> retrieveHistory [
 	| history |
 
 	self repositoryModel checkMissing.
-	self application 
+	^self application 
 		informUser: ('Retrieving history of {1}' format: { self entity printString }) 
 		during: [ history := self repositoryModel entity log historyOfMethod: self entity ].
 	^ history

diff --git a/Iceberg-TipUI/IceTipVersionModel.class.st b/Iceberg-TipUI/IceTipVersionModel.class.st
@@ -12,29 +12,22 @@ 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 [
+IceTipVersionModel >> newInstallAction [
 
-	IceTipStandardAction new 
-		repository: self repositoryModel entity; 
-		message: ('Installing {1} - {2}' format: { self entity definition. self name });
-		onSuccessRepositoryModified;
-		execute: [ self basicInstall ]
+	^ 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

diff --git a/Iceberg/IceWorkingCopyPatcherVisitor.class.st b/Iceberg/IceWorkingCopyPatcherVisitor.class.st
@@ -89,6 +89,13 @@ IceWorkingCopyPatcherVisitor >> visitDirectoryDefinition: anIceDirectoryDefiniti
 	self visitChildrenOf: currentNode
 ]
 
+{ #category : 'visiting' }
+IceWorkingCopyPatcherVisitor >> visitExtensionDefinition: anIceExtensionDefinition [
+	"An extension definition represents no changes on its own, visit the individual extension-method changes."
+
+	self visitChildrenOf: currentNode
+]
+
 { #category : 'visiting' }
 IceWorkingCopyPatcherVisitor >> visitFileNode: anIceFileDefinition [