Implement external clone

src/FileSystem-Git.package/FileSystemGitRepository.class/instance/cloneExternalFrom..st

@@ -0,0 +1,9 @@
+git porcelain
+cloneExternalFrom: aStringOrUrl
+	| directory children |
+	directory := repository workingDir.
+	children := directory children.
+	(children isEmpty or: [children size = 1 and: [children first basename = '.git']])
+		ifFalse: [^ self error: 'Target directory is not empty'].
+	directory deleteAll.
+	self externalCommand: ('git clone "{1}" "{2}"' format: {aStringOrUrl. directory pathName}).

src/FileSystem-Git.package/FileSystemGitRepository.class/instance/cloneFrom..st

@@ -1,17 +1,11 @@
 git porcelain
 cloneFrom: aStringOrUrl
-	| url remoteRefs head |
-	url := aStringOrUrl asUrl.
-	self addRemote: 'origin' url: aStringOrUrl.
-	remoteRefs := self fetchFrom: 'origin'.
-	head := self remoteHead: remoteRefs.
-	head ifNotNil: [self unitOfWork updateHeadToRef: head message: 'clone: from ', url].
-	self unitOfWork allReferencesPrefixedWith: 'refs/remotes/origin/'
-		do: [:each | | branchName |
-			branchName := each allButFirst: 'refs/remotes/origin/' size.
-			self unitOfWork
-				updateRef: 'refs/heads/', branchName
-				to: (self unitOfWork resolveRef: each);
-				setUpstreamRemoteOfBranchNamed: branchName to: 'origin';
-				setUpstreamRefOfBranchNamed: branchName
-				to: (self expandRemoteRef: branchName)].
+	GitFeatureFlags externalFetchAndPush
+		ifTrue: [self cloneExternalFrom: aStringOrUrl]
+		ifFalse: [[self cloneInternalFrom: aStringOrUrl]
+					on: ConnectionClosed
+					do: [:exception |
+						self
+							handleConnectionClosed: exception
+							whileTryingTo: 'clone'
+							ifRetry: [self cloneFrom: aStringOrUrl]]].

src/FileSystem-Git.package/FileSystemGitRepository.class/instance/cloneInternalFrom..st

@@ -0,0 +1,17 @@
+git porcelain
+cloneInternalFrom: aStringOrUrl
+	| url remoteRefs head |
+	url := aStringOrUrl asUrl.
+	self addRemote: 'origin' url: aStringOrUrl.
+	remoteRefs := self fetchInternalFrom: 'origin'.
+	head := self remoteHead: remoteRefs.
+	head ifNotNil: [self unitOfWork updateHeadToRef: head message: 'clone: from ', url].
+	self unitOfWork allReferencesPrefixedWith: 'refs/remotes/origin/'
+		do: [:each | | branchName |
+			branchName := each allButFirst: 'refs/remotes/origin/' size.
+			self unitOfWork
+				updateRef: 'refs/heads/', branchName
+				to: (self unitOfWork resolveRef: each);
+				setUpstreamRemoteOfBranchNamed: branchName to: 'origin';
+				setUpstreamRefOfBranchNamed: branchName
+				to: (self expandRemoteRef: branchName)].

src/FileSystem-Git.package/FileSystemGitRepository.class/methodProperties.json

@@ -6,7 +6,9 @@
 		"branchNamed:" : "jr 3/2/2020 22:13",
 		"branchNames" : "jr 3/3/2020 21:45",
 		"branches" : "jr 3/4/2020 00:46",
-		"cloneFrom:" : "mad 10/1/2023 16:52",
+		"cloneExternalFrom:" : "mad 5/23/2024 21:12",
+		"cloneFrom:" : "mad 5/23/2024 18:12",
+		"cloneInternalFrom:" : "mad 5/23/2024 18:11",
 		"commandExists:" : "mad 4/3/2024 15:10",
 		"commitNamed:" : "jr 8/13/2020 23:08",
 		"createBranchNamed:at:" : "jr 3/4/2020 00:47",

src/Squot.package/SqueakWorkingCopy.class/instance/cloneFrom..st

@@ -1,13 +1,13 @@
 git-operations
 cloneFrom: aStringOrUrl
-	self handleCredentialsDuring: [ | remote refs head |
-		remote := self fsgitRepository addRemote: 'origin' url: aStringOrUrl asUrl.
-		refs := self fsgitRepository fetchFrom: remote name.
-		head := self fsgitRepository remoteHead: refs.
-		head ifNotNil: [ | branchName trackingRef branch commit |
-			branchName := head allButFirst: 'refs/heads/' size.
-			trackingRef := remote trackingRefOf: head.
-			commit := self unitOfWork objectReferenced: trackingRef.
-			branch := (self createBranchNamed: branchName at: commit) ifNil: [^ self].
-			self setUpstreamRemoteName: remote name andRef: branchName for: branch.
-			self updateSymbolicHeadToRef: branch]].
+	| gitHead target |
+	self handleCredentialsDuring: [self fsgitRepository cloneFrom: aStringOrUrl].
+	gitHead := self unitOfWork ref: self headRefBasename.
+	gitHead ifNil: [^ self error: 'No HEAD found after clone.'].
+	target := self unitOfWork objectReferenced: self headRefBasename.
+	(gitHead isSymbolic and: [self isGitBranchRef: gitHead targetRef]) ifTrue: [ | branchName branch |
+		branchName := gitHead targetRef allButFirst: self gitBranchesBaseName size.
+		branch := self createBranchNamed: branchName at: target.
+		self setUpstreamRemoteName: self unitOfWork remoteNames first andRef: branchName for: branch.
+		target := branch].
+	self updateSymbolicHeadTo: target.

src/Squot.package/SqueakWorkingCopy.class/instance/isGitBranchRef..st

@@ -0,0 +1,3 @@
+refs
+isGitBranchRef: aString
+	^ aString beginsWith: self gitBranchesBaseName

src/Squot.package/SqueakWorkingCopy.class/methodProperties.json

@@ -53,7 +53,7 @@
 		"checkoutReflogMessageTo:" : "mad 11/30/2023 13:19",
 		"chooseRemoteName" : "mad 10/16/2023 20:48",
 		"clearLastImageHashForMigration" : "mad 11/29/2023 15:08",
-		"cloneFrom:" : "mad 4/29/2024 22:38",
+		"cloneFrom:" : "mad 5/23/2024 21:00",
 		"commitChangeSets:message:additionalParents:onlyAdditionalParents:" : "mad 4/29/2024 20:55",
 		"commitChangeSets:onCommit:message:additionalParents:onlyAdditionalParents:" : "mad 4/5/2024 00:19",
 		"commitImportedMappers:on:" : "mad 4/29/2024 22:24",
@@ -98,6 +98,7 @@
 		"initialRemoteRefNameFor:" : "mad 9/18/2023 13:58",
 		"initialize" : "mad 11/28/2023 19:19",
 		"initializeHead" : "mad 11/30/2023 13:17",
+		"isGitBranchRef:" : "mad 5/23/2024 18:37",
 		"isHeadDetached" : "mad 11/30/2023 13:17",
 		"isImageClean" : "mad 11/7/2023 15:17",
 		"isReferencedByHead:" : "mad 10/16/2023 22:52",