pharo-vcs · guillep · Jun 27, 2018 · Jun 25, 2018 · Jun 25, 2018 · Jun 25, 2018
diff --git a/BaselineOfIceberg.package/BaselineOfIceberg.class/instance/libGit..st b/BaselineOfIceberg.package/BaselineOfIceberg.class/instance/libGit..st
@@ -4,7 +4,7 @@ libgit: spec
 		baseline: 'LibGit' 
 		with: [ 
 			spec
-				repository: 'github://pharo-vcs/libgit2-pharo-bindings:v1.4.0';
+				repository: 'github://pharo-vcs/libgit2-pharo-bindings:v1.5.0';
   				loads: 'default' ].
 	spec  
 		project: 'LibGit-Tests'

diff --git a/Iceberg-Libgit.package/IceGitClone.class/instance/execute.st b/Iceberg-Libgit.package/IceGitClone.class/instance/execute.st
@@ -1,15 +1,22 @@
 actions
 execute
 
-	| repo cloneOptions |
+	| repo cloneOptions checkoutOptions callbacks |
 	location exists
 		ifTrue: [ IceCloneLocationAlreadyExists signalFor: location ].
 
 	[location ensureCreateDirectory.
 
 	repo := LGitRepository on: location.
 	cloneOptions := LGitCloneOptions withCredentialsProvider: (IceCredentialsProvider defaultForRemoteUrl: url).
-	cloneOptions checkoutOptions checkoutStrategy: LGitCheckoutStrategyEnum git_checkout_force.
+
+	"Keeping references, because if not the GC take them."
+	checkoutOptions := cloneOptions checkoutOptions.
+	callbacks := cloneOptions fetchOptions callbacks.
+	callbacks transferProgress: IceGitTransferProgress new.
+
+	checkoutOptions checkoutStrategy: LGitCheckoutStrategyEnum git_checkout_force.
+	checkoutOptions progressCallback: IceGitCheckoutProgress new.
 
 	repo clone: url options: cloneOptions.
 

diff --git a/Iceberg-Libgit.package/IceGitLocalBranch.class/instance/pushTo..st b/Iceberg-Libgit.package/IceGitLocalBranch.class/instance/pushTo..st
@@ -1,22 +1,29 @@
 API-remotes
 pushTo: aRemote
+
 	repository
 		handleLibgitError: [ | gitRemote |
 			gitRemote := (LGitRemote of: self repositoryHandle named: aRemote name) lookup.
-			[ gitRemote
+			[ 
+			 | pushProgress |
+			 pushProgress := IcePushTransferProgress new.
+			 gitRemote
 				pushWithRefSpec:
 					(LGitRefSpec new
 						source: self fullname;
 						destination: self fullname;
 						yourself)
 				pushOptions:
 					(LGitPushOptions defaults
-						callbacks: (LGitRemoteCallbacks withProvider: (IceCredentialsProvider defaultForRemote: aRemote));
+						callbacks: ((LGitRemoteCallbacks withProvider: (IceCredentialsProvider defaultForRemote: aRemote)) 
+											pushTransferProgress: pushProgress; 
+											yourself );
 						yourself).
 
 			"Push tags!"
 			self tags
-				do: [ :tag | 
+				do: [ :tag |
+					| tagProgress | 
 					gitRemote
 						pushWithRefSpec:
 							(LGitRefSpec new
@@ -25,7 +32,9 @@ pushTo: aRemote
 								yourself)
 						pushOptions:
 							(LGitPushOptions defaults
-								callbacks: (LGitRemoteCallbacks withProvider: (IceCredentialsProvider defaultForRemote: aRemote));
+								callbacks: ((LGitRemoteCallbacks withProvider: (IceCredentialsProvider defaultForRemote: aRemote))
+													pushTransferProgress: pushProgress;
+													yourself);
 								yourself) ] ]
 				on: LGit_GIT_ENONFASTFORWARD
 				do: [ :e | 

diff --git a/Iceberg-Libgit.package/IceGitRemote.class/instance/fetch.st b/Iceberg-Libgit.package/IceGitRemote.class/instance/fetch.st
@@ -4,7 +4,8 @@ fetch
 	localRepository handleLibgitError: [
 		[ (LGitRemote of: self repositoryHandle named: self name)
 			lookup;
-			fetchWithCredentials: (IceCredentialsProvider defaultForRemote: self) ]
+			fetchWithCredentials: (IceCredentialsProvider defaultForRemote: self)
+			andProgressCallback: IceGitTransferProgress new ]
 			on: LGitAbstractError
 			do: [ :e | e acceptError: (IceLibgitErrorVisitor onContext: self) ].
 

diff --git a/Iceberg-Libgit.package/IceLibgitRepository.class/instance/setHead..st b/Iceberg-Libgit.package/IceLibgitRepository.class/instance/setHead..st
@@ -1,10 +1,15 @@
 API-accessing
 setHead: anIceGitCommitish
 
+	"Need to keep the reference, if not it is garbage collected. As the options are only passed to a FFI call"
+	| progress |
+	progress := IceGitCheckoutProgress new.
+
 	self handleLibgitError: [ 
 		self repositoryHandle
 			checkout: anIceGitCommitish gitRef
 			options:
 				(LGitCheckoutOptions defaults
 					checkoutStrategy: LGitCheckoutStrategyEnum git_checkout_force;
+					progressCallback: progress;
 					yourself) ]
diff --git a/Iceberg-TipUI.package/IceTipRepairLocateRepository.class/instance/basicExecute.st b/Iceberg-TipUI.package/IceTipRepairLocateRepository.class/instance/basicExecute.st
@@ -3,15 +3,12 @@ basicExecute
 	| dialog |
 	dialog := IceTipLocalRepositoryPanel new
 		location: (self repository location ifNil: [ self defaultLocation ]);
-		subdirectory: (self repository subdirectory ifNil: [ self defaultSubdirectory ]);
 		yourself.
 	dialog openDialogWithSpec 
 		okAction: [ 
 			[ 
 				dialog validate.
-				self repositoryModel
-					updateLocation: dialog location 
-					subdirectory: dialog subdirectory.
+				self repositoryModel updateLocation: dialog location.
 				true ]
 			on: AssertionFailure 
 			do: [ :e | 

diff --git a/.../instance/updateLocation.subdirectory..st → ...ryModel.class/instance/updateLocation..st b/.../instance/updateLocation.subdirectory..st → ...ryModel.class/instance/updateLocation..st
@@ -1,10 +1,8 @@
 actions
-updateLocation: aReference subdirectory: aString
+updateLocation: aReference
 
 	"change location"
-	self entity
-		location: aReference;
-		subdirectory: aString.
+	self entity location: aReference.
 	"force refresh packages"
 	self entity workingCopy project: self entity project.
 

diff --git a/Iceberg.package/IceExternalJob.class/README.md b/Iceberg.package/IceExternalJob.class/README.md
diff --git a/Iceberg.package/IceExternalJob.class/instance/changed.st b/Iceberg.package/IceExternalJob.class/instance/changed.st
@@ -0,0 +1,5 @@
+events
+changed
+
+	current >= max ifTrue: [ ^ Job jobAnnouncer announce: (JobEnd on: self) ].
+	Job jobAnnouncer announce: (JobChange on: self)
diff --git a/Iceberg.package/IceExternalJob.class/instance/current..st b/Iceberg.package/IceExternalJob.class/instance/current..st
@@ -0,0 +1,3 @@
+accessing
+current: anInteger 
+	current := anInteger 
diff --git a/Iceberg.package/IceExternalJob.class/instance/end.st b/Iceberg.package/IceExternalJob.class/instance/end.st
@@ -0,0 +1,3 @@
+events
+end
+	Job jobAnnouncer announce: (JobEnd on: self)
diff --git a/Iceberg.package/IceExternalJob.class/instance/ensureStarted.st b/Iceberg.package/IceExternalJob.class/instance/ensureStarted.st
@@ -0,0 +1,3 @@
+events
+ensureStarted
+	started ifFalse: [ self start ]
diff --git a/Iceberg.package/IceExternalJob.class/instance/initialize.st b/Iceberg.package/IceExternalJob.class/instance/initialize.st
@@ -0,0 +1,4 @@
+initialization
+initialize
+	super initialize.
+	started := false
diff --git a/Iceberg.package/IceExternalJob.class/instance/max..st b/Iceberg.package/IceExternalJob.class/instance/max..st
@@ -0,0 +1,3 @@
+accessing
+max: anInteger 
+	max := anInteger
diff --git a/Iceberg.package/IceExternalJob.class/instance/min..st b/Iceberg.package/IceExternalJob.class/instance/min..st
@@ -0,0 +1,3 @@
+accessing
+min: anInteger 
+	min := anInteger 
diff --git a/Iceberg.package/IceExternalJob.class/instance/owner.st b/Iceberg.package/IceExternalJob.class/instance/owner.st
@@ -0,0 +1,3 @@
+accessing
+owner
+	^ nil
diff --git a/Iceberg.package/IceExternalJob.class/instance/progress.st b/Iceberg.package/IceExternalJob.class/instance/progress.st
@@ -0,0 +1,3 @@
+accessing
+progress
+	^ min >= max ifTrue: [ 1 ] ifFalse: [ (current - min) / (max - min) ]
diff --git a/Iceberg.package/IceExternalJob.class/instance/start.st b/Iceberg.package/IceExternalJob.class/instance/start.st
@@ -0,0 +1,5 @@
+events
+start
+	started := true.
+
+	Job jobAnnouncer announce: (JobStart on: self)
diff --git a/Iceberg.package/IceExternalJob.class/instance/title..st b/Iceberg.package/IceExternalJob.class/instance/title..st
@@ -0,0 +1,3 @@
+accessing
+title: aString 
+	title := aString
diff --git a/Iceberg.package/IceExternalJob.class/instance/title.st b/Iceberg.package/IceExternalJob.class/instance/title.st
@@ -0,0 +1,3 @@
+accessing
+title
+	^ title
diff --git a/Iceberg.package/IceExternalJob.class/properties.json b/Iceberg.package/IceExternalJob.class/properties.json
@@ -0,0 +1,17 @@
+{
+	"commentStamp" : "",
+	"super" : "Object",
+	"category" : "Iceberg-Progress",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"title",
+		"started",
+		"min",
+		"max",
+		"current"
+	],
+	"name" : "IceExternalJob",
+	"type" : "normal"
+}
diff --git a/Iceberg.package/IceGitCheckoutProgress.class/README.md b/Iceberg.package/IceGitCheckoutProgress.class/README.md
diff --git a/Iceberg.package/IceGitCheckoutProgress.class/instance/block.st b/Iceberg.package/IceGitCheckoutProgress.class/instance/block.st
@@ -0,0 +1,12 @@
+accessing
+block
+	^ [ :path :completed :total :payload | 
+		job ensureStarted.
+
+		job min: 0.
+		job max: total.
+		job current: completed.
+		job title: ('Checking out... ({1}/{2})' format: { completed. total}).
+
+		job changed.
+	]
diff --git a/Iceberg.package/IceGitCheckoutProgress.class/instance/initialize.st b/Iceberg.package/IceGitCheckoutProgress.class/instance/initialize.st
@@ -0,0 +1,9 @@
+initialization
+initialize
+	super initialize.
+
+	job := IceExternalJob new
+		title: 'Checking out...';
+		yourself.
+
+	self initializeBlock.
diff --git a/Iceberg.package/IceGitCheckoutProgress.class/instance/initializeBlock.st b/Iceberg.package/IceGitCheckoutProgress.class/instance/initializeBlock.st
@@ -0,0 +1,3 @@
+initialization
+initializeBlock
+	self signature: self class fnSpec block: self block.
diff --git a/Iceberg.package/IceGitCheckoutProgress.class/properties.json b/Iceberg.package/IceGitCheckoutProgress.class/properties.json
@@ -0,0 +1,13 @@
+{
+	"commentStamp" : "",
+	"super" : "LGitCheckoutProgressCallback",
+	"category" : "Iceberg-Progress",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"job"
+	],
+	"name" : "IceGitCheckoutProgress",
+	"type" : "normal"
+}
diff --git a/Iceberg.package/IceGitTransferProgress.class/README.md b/Iceberg.package/IceGitTransferProgress.class/README.md
diff --git a/Iceberg.package/IceGitTransferProgress.class/instance/block.st b/Iceberg.package/IceGitTransferProgress.class/instance/block.st
@@ -0,0 +1,16 @@
+accessing
+block
+	^ [ :stats :payload | 
+		| gitStats |
+		gitStats := LGitTransferProgress fromHandle: stats.
+		job ensureStarted.
+
+		job min: 0.
+		job max: gitStats prim_total_objects.
+		job current: gitStats prim_received_objects.
+		job title: ('Fetching Git objects... ({1}/{2})' format: { gitStats prim_received_objects. gitStats prim_total_objects}).
+
+		job changed.
+
+		0
+	]
diff --git a/Iceberg.package/IceGitTransferProgress.class/instance/initialize.st b/Iceberg.package/IceGitTransferProgress.class/instance/initialize.st
@@ -0,0 +1,9 @@
+accessing
+initialize
+	super initialize.
+
+	job := IceExternalJob new
+		title: 'Fetching Git objects...';
+		yourself.
+
+	self initializeBlock.
diff --git a/Iceberg.package/IceGitTransferProgress.class/instance/initializeBlock.st b/Iceberg.package/IceGitTransferProgress.class/instance/initializeBlock.st
@@ -0,0 +1,3 @@
+initialize - release
+initializeBlock
+	self signature: self class fnSpec block: self block.
diff --git a/Iceberg.package/IceGitTransferProgress.class/properties.json b/Iceberg.package/IceGitTransferProgress.class/properties.json
@@ -0,0 +1,13 @@
+{
+	"commentStamp" : "",
+	"super" : "LGitTransferProgressCallback",
+	"category" : "Iceberg-Progress",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"job"
+	],
+	"name" : "IceGitTransferProgress",
+	"type" : "normal"
+}
diff --git a/Iceberg.package/IcePushTransferProgress.class/README.md b/Iceberg.package/IcePushTransferProgress.class/README.md
diff --git a/Iceberg.package/IcePushTransferProgress.class/instance/block.st b/Iceberg.package/IcePushTransferProgress.class/instance/block.st
@@ -0,0 +1,14 @@
+accessing
+block
+	^ [ :current :total :bytes :payload | 
+		job ensureStarted.
+
+		job min: 0.
+		job max: total.
+		job current: current.
+		job title: ((self title, ' ({1}/{2})') format: { current. total}).
+
+		job changed.
+
+		0
+	]
diff --git a/Iceberg.package/IcePushTransferProgress.class/instance/initialize.st b/Iceberg.package/IcePushTransferProgress.class/instance/initialize.st
@@ -0,0 +1,9 @@
+accessing
+initialize
+	super initialize.
+
+	job := IceExternalJob new
+		title: self title;
+		yourself.
+
+	self initializeBlock.
diff --git a/Iceberg.package/IcePushTransferProgress.class/instance/initializeBlock.st b/Iceberg.package/IcePushTransferProgress.class/instance/initializeBlock.st
@@ -0,0 +1,3 @@
+initialization
+initializeBlock
+	self signature: self class fnSpec block: self block.
diff --git a/Iceberg.package/IcePushTransferProgress.class/instance/title.st b/Iceberg.package/IcePushTransferProgress.class/instance/title.st
@@ -0,0 +1,3 @@
+accessing
+title
+	^ 'Pushing...'
diff --git a/Iceberg.package/IcePushTransferProgress.class/properties.json b/Iceberg.package/IcePushTransferProgress.class/properties.json
@@ -0,0 +1,13 @@
+{
+	"commentStamp" : "",
+	"super" : "LGitPushTransferProgressCallback",
+	"category" : "Iceberg-Progress",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"job"
+	],
+	"name" : "IcePushTransferProgress",
+	"type" : "normal"
+}
diff --git a/Iceberg.package/IceRepository.class/instance/fetch.st b/Iceberg.package/IceRepository.class/instance/fetch.st
@@ -1,4 +1,6 @@
 API-remotes
 fetch
 	"Fetch all commits and branches from all remotes"
-	self remotes do: [ :each | each fetch ]
+
+	self remotes do: [ :each | each fetch ] 
+		displayingProgress: [ :each | 'Remote: ' , each name asString ]
diff --git a/Iceberg.package/IceWorkingCopy.class/instance/refreshProjectFromRepository.st b/Iceberg.package/IceWorkingCopy.class/instance/refreshProjectFromRepository.st
@@ -4,4 +4,6 @@ refreshProjectFromRepository
 	project := (referenceCommit isCollection
 		ifTrue: [ referenceCommit first ]
 		ifFalse: [ referenceCommit ]) project.
-	self refreshProject
+	self refreshProject.
+
+	^ project