Commits

Felix Geller  committed 8ab0a07

Dropping --quiet default argument to hg, which caused #1

  • Participants
  • Parent commits 201beb8

Comments (0)

Files changed (1)

File VCSMercurialBackendProvider.ns3

-Newspeak3
+Newspeak3
+'StructuredVCS'
+class VCSMercurialBackendProvider usingPlatform: platform 
+vcs: vcs = NewspeakObject (
+"Back-end for accessing mercurial repositories
 
-'StructuredVCS'
+Copyright (c) 2010-2011 Matthias Kleine
 
-
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ''Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
 
-class VCSMercurialBackendProvider usingPlatform: platform 
-vcs: vcs = NewspeakObject (
-"Back-end for accessing mercurial repositories
-
-Copyright (c) 2010-2011 Matthias Kleine
-
-Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ''Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE."|
-	private AbstractBackend = vcs core AbstractBackend.
-	
-	private diffing = vcs diffing.
-	private logger = vcs core logger.
-
-	private Differencer = diffing Differencer.
-
-	"Collections"
-	private Set = platform Collections Set.
-	private Dictionary = platform Collections Dictionary.
-
-	private CrLfFileStream = platform Files CrLfFileStream.
-	
-	private INIFile = platform INIFile.
-	private Semaphore = platform Semaphore.
-
-|)
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
 
-(
+THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE."|
+	private AbstractBackend = vcs core AbstractBackend.
+	
+	private diffing = vcs diffing.
+	private logger = vcs core logger.
 
-
+	private Differencer = diffing Differencer.
 
-class Backend = AbstractBackend ()
+	"Collections"
+	private Set = platform Collections Set.
+	private Dictionary = platform Collections Dictionary.
 
-(
+	private CrLfFileStream = platform Files CrLfFileStream.
+	
+	private INIFile = platform INIFile.
+	private Semaphore = platform Semaphore.
 
-
+|)
+(
+class Backend = AbstractBackend ()
+(
+class LocalRepository onRepositoryId: repositoryId = AbstractLocalRepository onRepositoryId: repositoryId ("Implements historians using mercurial's bookmarks
 
-class RemoteRepository onLocalRepository: lr onRepositoryId: repositoryId  onName: n = AbstractRemoteRepository onLocalRepository: lr onRepositoryId: repositoryId onName: n ("A remote mercurial repository
-
-Mercurial offers only a limited way to interact with remote repositories. E.g., in order to access a file at a revision that is stored in a remote repository, this revision first has to be pulled into a local repository. Thus, a remote repository always needs a local repository in order to be functional.
-
-Yet, the class RemoteRepository is *not* nested within LocalRepository. By not making it a nested class, all access to its local repository has to be funelled through the slot localRepository. As both, Local- and RemoteRepository have similar interfaces, having to make access to the local repository explicit is a good thing, as it prevents accidentially accessing the local repository using implicit outer sends.")
+Mercurial's bookmarks behave different than historians in several ways.
 
-(
+Although not the default, mercurial can be configured to store the 'current bookmark'. But even if it is configured to do so, the current bookmark is reset when existing bookmarks are set to point to other versions. We can fix this for local repositories by restoring the current bookmark after certain operations, but we cannot fix this for remote operations. If remote repositories are also to be used as local repositories and this becomes too much of a nuisance, we must store the current historian differently.
 
-
+If new versions are added to a repository, mercurial moves all bookmarks that point to an ancestor version to the new version. This is not what we want. Therefore we have to ensure bookmarks are restored after push and pull operations.
 
-class Historian named: historianName versionId: vId = AbstractRemoteHistorian named: historianName versionId: vId (|
-	private cachedVersion
-|)
+Mercurial's 'bookmarks' command works only on local repositories. We use the 'debugpushkey' command instead. This allows using one implementation to access local and remote bookmarks."|
 
-('as yet unclassified'
+private Command = Commands new Command.
+protected cachedRemoteRepositories
 
-setTo: newVersion ifFail: failBlock = (
+private configFileMutex = Semaphore forMutualExclusion.
+|)
+(
+class Commands = ()
+(
+class Command = NonCachingCommand (|
+	cachedBookmarks = nil.
+	cachedHistorianName = nil.
+	cachedCommonAncestors = Dictionary new.
+	
+	cachedPaths = Dictionary new.
+	cachedFileAtRevision = Dictionary new.
+|)
+('as yet unclassified'
+cat: filename atInternalId: internalId = (
+	
+	| result |
+	result:: cachedFileAtRevision
+		at: {filename. internalId asString}
+		ifAbsentPut: [ | stream |
+			stream:: super cat: filename atInternalId: internalId.
+			[stream contents] ifError: [stream collection]].
+	^ result readStream
+)
+commit: message = (
 
-
+	super commit: message.
+	resetCaches
+)
+commonAncestorOf: revA and: revB = (
 
-version = (
+	^ cachedCommonAncestors
+		at: (Set withAll: {revA. revB})
+		ifAbsentPut: [
+			super commonAncestorOf: revA and: revB]
+)
+currentHistorianNameIfNone: block = (
 
-
+	nil = cachedHistorianName ifTrue: [
+		cachedHistorianName:: super currentHistorianNameIfNone: block.].
+	^ cachedHistorianName
+)
+makeHistorianCurrent: id = (
 
-) : (
+	super makeHistorianCurrent: id.
+	resetCaches.
+)
+merge: internalId = (
 
-'as yet unclassified'
+	super merge: internalId.
+	resetCaches
+)
+notRestoringBookmarksPull: revision from: remoteSource = (
 
-named: historianName version: version = (
+	super notRestoringBookmarksPull: revision from: remoteSource.
+	resetCaches
+)
+pathOf: source  = (
 
-
+	^ cachedPaths
+		at: source
+		ifAbsentPut: [super pathOf: source]
+)
+remoteBookmarksFrom: source ifFail: failBlock = (
 
-)'as yet unclassified'
+	^ source = repositoryId
+		ifTrue: [
+			nil = cachedBookmarks ifTrue: [
+				cachedBookmarks:: super remoteBookmarksFrom: source ifFail: failBlock].
+			cachedBookmarks]
+		ifFalse: [super remoteBookmarksFrom: source ifFail: failBlock]
+)
+renameBookmark: oldName to: newName  = (
 
-Command = (
+	super renameBookmark: oldName to: newName.
+	resetCaches
+)
+resetCaches = (
 
-
+	"Clearing all caches every time something might have changed in the repository is less than optimal, e.g. when we change a bookmark's version we don't have to throw away the complete bookmark version cache."
+	cachedBookmarks:: nil.
+	cachedCommonAncestors:: Dictionary new.
+	cachedHistorianName:: nil
+)
+setRemoteBookmark: bookmarkName 
+from: originalId
+to: newId
+on: otherRepositoryId
+ifFail: failBlock = (
 
-localRepository = (
+	repositoryId = otherRepositoryId ifTrue: [resetCaches].
+	super
+		setRemoteBookmark: bookmarkName 
+		from: originalId
+		to: newId
+		on: otherRepositoryId
+		ifFail: failBlock
+)
+stayOnCurrentHistorianNameDo: aBlock = (
 
-
+	| result oldHistorianName |
+	oldHistorianName:: currentHistorianNameIfNone: [
+		^aBlock value].
+	result:: aBlock value.
+	(currentHistorianNameIfNone: [nil]) = oldHistorianName ifFalse: [
+		makeHistorianCurrent: oldHistorianName].
+	^ result
+))
+class NonCachingCommand = MercurialCommand ("Mercurial commands specific to a local repository"|
+	
+|)
+('as yet unclassified'
+addStream: stream asFileNamed: filename = (
 
-)
+	writeStream: stream toFileNamed: filename.
+	launcher run: {'add'. filename}
+)
+cat: filename atInternalId: internalId = (
 
-
+	^ launcher runStream: {'cat'. filename. '--rev'. internalId asString}
+)
+clone: repositoryLocation = (
 
-class LocalRepository onRepositoryId: repositoryId = AbstractLocalRepository onRepositoryId: repositoryId ("Implements historians using mercurial's bookmarks
-
-Mercurial's bookmarks behave different than historians in several ways.
-
-Although not the default, mercurial can be configured to store the 'current bookmark'. But even if it is configured to do so, the current bookmark is reset when existing bookmarks are set to point to other versions. We can fix this for local repositories by restoring the current bookmark after certain operations, but we cannot fix this for remote operations. If remote repositories are also to be used as local repositories and this becomes too much of a nuisance, we must store the current historian differently.
-
-If new versions are added to a repository, mercurial moves all bookmarks that point to an ancestor version to the new version. This is not what we want. Therefore we have to ensure bookmarks are restored after push and pull operations.
-
-Mercurial's 'bookmarks' command works only on local repositories. We use the 'debugpushkey' command instead. This allows using one implementation to access local and remote bookmarks."|
-
-private Command = Commands new Command.
-protected cachedRemoteRepositories
-
-private configFileMutex = Semaphore forMutualExclusion.
-|)
+	^ launcher noDefaultArgumentsRun: {'clone'. repositoryLocation. repositoryDirectory pathName}
+)
+commit: message = (
 
-(
+	launcher run: {'add'. '-X'. '.*'}.
+	launcher run: {'commit'. '-m'. message}.
+)
+commonAncestorOf: revA and: revB = (
 
-
+	| line |
+	line:: launcher run: {'debugancestor'. revA asString. revB asString}.
+	^ (line subStrings: ':') second withBlanksTrimmed
+)
+configFileDo: block = (
 
-class Commands = ()
+configFileMutex critical: [
+	| configFile fileStream result filename |
+	
+	filename:: (repositoryDirectory / '.hg' / 'hgrc') pathName.
+	fileStream:: CrLfFileStream fileNamed: filename.
+	nil = fileStream ifTrue: [logger error: 'Could not open ', filename].
+	configFile:: INIFile readFrom: fileStream.
+	result:: block value: configFile.
+	fileStream reset.
+	configFile writeOn: fileStream.
+	fileStream close.
+	^ result
+]
+)
+configKeyHistorian = (
 
-(
+	^ 'current_historian'
+)
+configLinesStartingWith: prefix = (
 
-
+	| lines |
+	lines:: launcher runLines: {'showconfig'}.
+	^ lines select: [:each | each startsWith: prefix]
+)
+configSectionNewspeak = (
 
-class NonCachingCommand = MercurialCommand ("Mercurial commands specific to a local repository"|
-	
-|)
+	^ 'newspeak'
+)
+createEmptyRepository = (
 
-('as yet unclassified'
+	launcher noDefaultArgumentsRun: {'init'. repository repositoryDirectory pathName}.
+	launcher run: {'bookmark'. 'master'}.
+	addStream: '' readStream asFileNamed: ignoredFilename.
+	launcher run: {'commit'.  '-m'. 'Initial Commit'}.
+)
+currentHistorianNameIfNone: block = (
 
-addStream: stream asFileNamed: filename = (
+	^ configFileDo: [:configFile |
+		(configFile section: configSectionNewspeak)
+			at: configKeyHistorian
+			ifAbsent: block]
+)
+defaultArguments = (
 
-
+	^ super defaultArguments, {'--cwd'. repositoryDirectory fullName}
+)
+makeHistorianCurrent: id = (
 
-cat: filename atInternalId: internalId = (
+	launcher run: {'update'. '-C'. id asString}.
+	configFileDo: [:configFile |
+		(configFile section: configSectionNewspeak)
+			at: configKeyHistorian
+			put: id]
+)
+pathOf: source = (
 
-
+	| lines |
+	lines:: launcher runLines: {'paths'}.
+	lines do: [:each | | subStrings |
+		subStrings:: each subStrings: ' ='.
+		subStrings first = source ifTrue: [
+			^ subStrings second]].
+	"Assume source is already a path"
+	^ source
+)
+removeAll: filenames  = (
 
-clone: repositoryLocation = (
+	filenames isEmpty ifFalse: [
+		launcher run: {'rm' .'-f'}, filenames]
+)
+sourceIds = (
 
-
+	^ (configLinesStartingWith: 'paths') collect: [:each |
+		(each subStrings: '.=') second]
+)
+tipStream = (
 
-commit: message = (
+	^ launcher runStream: {'tip'}, logTemplate
+))'accessing'
+MercurialCommand = (
 
-
+	^ outer LocalRepository MercurialCommand
+)
+repositoryId = (
 
-commonAncestorOf: revA and: revB = (
+	^ outer LocalRepository repositoryId
+))
+class Historian named: historianName version: v = AbstractLocalHistorian named: historianName version: v ("Specialization for local historians
 
-
+Mercurial does not support bookmark tracking. Tracking information is therefore stored in the mercurial conifig file. This works only for local historians, though."|
+	protected cachedTrackedHistorian
+|)
+('accessing'
+trackedHistorianifPresent: presentBlock ifAbsent: absentBlock ifError: errorBlock = (
 
-configFileDo: block = (
+	"Returns nil if not existing"
+	| remoteRepositoryId remoteHistorianName |
+	nil = cachedTrackedHistorian ifTrue: [
+		cachedTrackedHistorian:: command configFileDo: [:configFile | | remoteRepositoryPath |
+			remoteHistorianName:: (configFile section: configSectionNewspeakTrackingHistorian) at: name ifAbsent: [
+				^ absentBlock value].
+			remoteRepositoryId:: (configFile section: configSectionNewspeakTrackingRepository) at: name ifAbsent: [
+				^ absentBlock value].
+			remoteRepositoryPath:: command pathOf: remoteRepositoryId.
+			(repository remoteRepositoryAt: remoteRepositoryPath)
+				historianNamed: remoteHistorianName
+				ifFail: [
+					logger warn: 'Failed to load remote historian ', remoteHistorianName.
+					^ errorBlock value]]].
+	^ presentBlock value: cachedTrackedHistorian 
+)'actions'
+trackedHistorian: otherHistorian = (
 
-
+	command configFileDo: [:configFile |
+		configFile section: configSectionNewspeakTrackingRepository at: name put: otherHistorian repository repositoryId.
+		configFile section: configSectionNewspeakTrackingHistorian at: name put: otherHistorian name]
+)'private'
+configSectionNewspeakTrackingHistorian = (
 
-configKeyHistorian = (
+	^ 'newspeak_tracking_historian'
+)
+configSectionNewspeakTrackingRepository = (
 
-
+	^ 'newspeak_tracking_repository'
+))
+class RepositoryVersionAccessing = AbstractRepositoryVersionAccessing (|
+	private mirrorAccessor = MirrorAccessor new.
+	private cachedVersionAtInternalId = Dictionary new.
+|)
+(
+class MirrorAccessor = (
+"Reading all mirrors of a version from the back end can be slow. Versions that are closely related often are identical in most mirrors. Mercurial can efficiently determine which files changed across revisions. Using this knowledge we can reuse mirrors of previously loaded versions. Thus, loading mirrors becomes more efficient.
+The same applies for writing mirrors; only mirrors that changed are written to the back end"|
+	"For the moment we store the mirrors of the version that was fetched most recently. We could also store mirrors of multiple versions and try to find a version close to the one to be loaded."
+	private lastLoadedRevision = 'null'.
+	private lastLoadedMirrors = Dictionary new.
+|)
+(
+class VersionLoader onVersion: v = (|
+	version = v.
+|)
+('as yet unclassified'
+applyFileChange: change toMirrors: result = (
 
-configLinesStartingWith: prefix = (
+	| filename changeCode |
+	changeCode:: change first.
+	filename:: change second.
+	$R = changeCode ifTrue: [
+		result removeKey: filename].
+	('MA' includes: changeCode) ifTrue: [ | mirror |
+			#BOGUS yourself. "There should be a better way to communicate whether a file has a source mirror or is something else, like .hgignore or noncode resources like pictures"
+			((filename endsWith: '.ns3') or: [filename endsWith: '.st']) ifTrue: [
+			mirror:: createMirrorForFilenamed: filename.
+			result
+				at: filename
+				put: mirror]]
+)
+createMirrorForFilenamed: filename = (
 
-
+	| stream result |
+	logger log: 'Loading mirror for ', filename.
+	stream:: command cat: filename atInternalId: version internalId.
+	result:: sourceMirrors mirrorForStream: stream.
+	logger log: 'Finished loading mirror for ', filename.
+	^ result
+)
+loadMirrors = (
 
-configSectionNewspeak = (
+	"This isn't thread safe. Access to last loaded revision/mirrors isn't synchronized"
+	| changes |
+	changes:: command statusFrom: lastLoadedRevision to: version internalId.
+	lastLoadedRevision:: version internalId.
+	lastLoadedMirrors:: lastLoadedMirrors value copy.
+	changes do: [:each |
+		applyFileChange: each toMirrors: lastLoadedMirrors].
+	^ lastLoadedMirrors
+))'as yet unclassified'
+loadMirrorsFor: version = (
 
-
+	^ (VersionLoader onVersion: version) loadMirrors
+))
+class RepositoryVersion = AbstractRepositoryVersion (|
+parentInternalIds
+branchName
+cachedMirrors
+cachedParents
+|)
+('as yet unclassified'
+closestAncestorsWithInternalIdOf: otherVersion = (
 
-createEmptyRepository = (
+	^ otherVersion isRepositoryVersion
+		ifTrue: [{otherVersion}]
+		ifFalse: [otherVersion parents collect: [:each | 
+					closestAncestorsWithInternalIdOf: each]]
+)
+commonAncestorWith: otherVersion = (
 
-
+	^ (closestAncestorsWithInternalIdOf: otherVersion) inject: self into: [:acc :each | 
+		commonAncestorWithRepositoryVersion: each].
+)
+commonAncestorWithRepositoryVersion: otherVersion = (
 
-currentHistorianNameIfNone: block = (
+	| commonInternalId |
+	commonInternalId:: command commonAncestorOf: internalId and: otherVersion internalId.
+	^ versionAtInternalId: commonInternalId
+)
+mirrors = (
 
-
+	nil = cachedMirrors ifTrue: [
+		cachedMirrors:: mirrorAccessor loadMirrorsFor: self].
+	^ cachedMirrors
+)
+parents = (
 
-defaultArguments = (
+	nil = cachedParents ifTrue: [
+		cachedParents:: super parents].
+	^ cachedParents
+)
+streamVersionsTo: otherVersion  = (
 
-
+	^ RepositoryVersionStream onStream:
+		(command streamLogFrom: internalId to: otherVersion internalId)
+))
+class RepositoryVersionStream onStream: stream = AbstractRepositoryVersionStream onStream: stream (|
+|)
+('as yet unclassified'
+extractParents: line = (
 
-makeHistorianCurrent: id = (
+	"Format is rev:node rev:node, e.g.
+	1:533ba6a30a2a8d4ba869ee3d2cc5e90e08bfd2ac -1:0000000000000000000000000000000000000000 "
+	| substrings |
+	substrings:: line subStrings: ': '.
+	^ (substrings at: 3) = '-1' "No parent / null revision"
+		ifTrue: [
+			(substrings at: 1) = '-1'
+				ifTrue: [{}]
+				ifFalse: [{substrings at: 2}]]
+		ifFalse: [{substrings at: 2. substrings at: 4}]
+)
+next = (
 
-
+	| internalId parentInternalIds message author version branch |
+	internalId:: nextLine.
+	parentInternalIds:: extractParents: nextLine.
+	author:: nextLine.
+	branch:: nextLine.
+	branch = '' ifTrue: [
+		branch:: 'default'].
+	message:: nextLine.
+	version:: RepositoryVersion new
+		internalId: internalId;
+		parentInternalIds: parentInternalIds;
+		author: author;
+		branchName: branch;
+		message: message;
+		yourself.
+	cachedVersionAtInternalId
+		at: internalId
+		put: version.
+	^ version
+))'accessing'
+immutableVersionAt: internalId = (
 
-pathOf: source = (
+	^ cachedVersionAtInternalId
+		at: internalId
+		ifAbsent: [
+			cacheAllVersionsFrom: internalId.
+			cachedVersionAtInternalId at: internalId]
+)
+logStream = (
 
-
+	^ RepositoryVersionStream onStream: command logStream
+)
+versionAtInternalId: internalId = (
 
-removeAll: filenames  = (
+	^ (command isImmutableId: internalId)
+		ifTrue: [ | stream |
+			immutableVersionAt: internalId]
+		ifFalse: [(RepositoryVersionStream onStream: (command streamAtInternalId: internalId)) next]
+)'actions'
+cacheAllVersionsFrom: internalId = (
 
-
+	| stream |
+	stream:: RepositoryVersionStream onStream:(
+		command streamFromInternalId: internalId).
+	[stream atEnd] whileFalse: [ | version |
+		version:: stream next.
+		cachedVersionAtInternalId
+			at: version internalId
+			put: version]
+)
+exportVersionId: internalId to: remoteRepository = (
 
-sourceIds = (
+	command disabledBookmarksPush: internalId to: remoteRepository repositoryId.
+)
+importVersionId: internalId from: remoteRepository = (
 
-
+	cachedVersionAtInternalId
+		at: internalId
+		ifAbsent: [
+			command disabledBookmarksPull: internalId from: remoteRepository repositoryId].
+))'accessing'
+command = (
 
-tipStream = (
+	^ super command
+)
+imageHistorian = (
 
-
+	"TODO: Consider introducing an unnamed historian"
+	^ (command currentHistorianNameIfNone: [nil])
+		ifNil: [trackMain]
+		ifNotNilDo: [:it | historianNamed: it ifFail: [logger halt: 'Could not load', it]]
+)
+remoteRepositories = (
 
-)
+	nil = cachedRemoteRepositories ifTrue: [
+		cachedRemoteRepositories:: command sourceIds collect: [:each | RemoteRepository onLocalRepository: self onRepositoryId: (command pathOf: each) onName: each]].
+	^ cachedRemoteRepositories
+)
+repository = (
 
-
+	^ self
+)
+repositoryDirectory = (
 
-class Command = NonCachingCommand (|
-	cachedBookmarks = nil.
-	cachedHistorianName = nil.
-	cachedCommonAncestors = Dictionary new.
-	
-	cachedPaths = Dictionary new.
-	cachedFileAtRevision = Dictionary new.
-|)
+	^ super repositoryDirectory
+)'actions'
+clone: repositoryLocation = (
 
-('as yet unclassified'
+	| remoteHistorian |
+	command clone: repositoryLocation.
+	remoteHistorian:: remoteRepositories anyOne historians anyOne.
+	remoteHistorian trackAs: remoteHistorian name.
+	historians anyOne loadIntoImage
+)
+create = (
 
-cat: filename atInternalId: internalId = (
+	command createEmptyRepository
+)
+refresh = (
 
-
+	command resetCaches.
+	cachedRemoteRepositories:: nil
+)
+trackMain = (
 
-commit: message = (
+	| remoteHistorian newHistorian |
+	historians isEmpty ifFalse: [
+		logger halt: 'No current historian is set, even though the repository already contains historians.'].
+	logger info: 'The repository does not have any historians. We''ll try to import ''main'' from a random remote repository'.
+	remoteHistorian:: remoteRepositories anyOne historianNamed: 'main' ifFail: [
+		logger halt: 'Failed to load main historian'].
+	newHistorian:: remoteHistorian trackAs: remoteHistorian name.
+	^ newHistorian
+		makeCurrentHistorian;
+		yourself
+))
+class RemoteRepository onLocalRepository: lr onRepositoryId: repositoryId  onName: n = AbstractRemoteRepository onLocalRepository: lr onRepositoryId: repositoryId onName: n ("A remote mercurial repository
 
-
+Mercurial offers only a limited way to interact with remote repositories. E.g., in order to access a file at a revision that is stored in a remote repository, this revision first has to be pulled into a local repository. Thus, a remote repository always needs a local repository in order to be functional.
 
-commonAncestorOf: revA and: revB = (
+Yet, the class RemoteRepository is *not* nested within LocalRepository. By not making it a nested class, all access to its local repository has to be funelled through the slot localRepository. As both, Local- and RemoteRepository have similar interfaces, having to make access to the local repository explicit is a good thing, as it prevents accidentially accessing the local repository using implicit outer sends.")
+(
+class Historian named: historianName versionId: vId = AbstractRemoteHistorian named: historianName versionId: vId (|
+	private cachedVersion
+|)
+('as yet unclassified'
+setTo: newVersion ifFail: failBlock = (
 
-
+	"import the version *before* setting the version"
+	repository importVersionId: newVersion internalId.
+	super setTo: newVersion ifFail: failBlock.
+	versionId:: newVersion internalId
+)
+version = (
 
-currentHistorianNameIfNone: block = (
+	nil = cachedVersion ifTrue: [
+		cachedVersion:: super version].
+	^ cachedVersion
+)) : ('as yet unclassified'
+named: historianName version: version = (
 
-
+	^ self named: historianName versionId: version internalId
+))'as yet unclassified'
+Command = (
 
-makeHistorianCurrent: id = (
+	^ MercurialCommand
+)
+localRepository = (
 
-
+	^ super localRepository
+))
+class Repository onRepositoryId: id = AbstractRepository onRepositoryId: id (|
+protected repositoryType = 'hg'.
+|)
+(
+class MercurialCommand = AbstractCommand ("We're using mercurial's bookmarks to implement historians. Unfortunately, 
+bookmarks have some undesirable properties that we must try to compensate for. 
+ 
+Mercurial does not by default have a notion of a current bookmark. It does 
+provide an option to track the current bookmark, but that doesn't always work. 
+So we track the current historian ourselves in .hg/hgrc. 
+ 
+Mercurial's bookmarks do not support tracking/upstream relations to be defined. 
+We store them ourselves in .hg/hgrc. 
+ 
+A historian is always owned by a single repository. Historian 'master' on repo1 
+is different from historian 'master' on repo2. This is not the case with 
+bookmarks. Bookmarks share a single global namespace. If a repository pushes 
+revisions to another repository, it automatically updates all bookmarks on that 
+destination repository. In order to transfer versions between repositories 
+without changing historians we must reset historians to the state that we found 
+them at before. The current code that does this has not yet been checked for 
+problems that might occur in case of concurrent access to repositories. "|
 
-merge: internalId = (
+	commandLine = 'hg'.
+|)
+('as yet unclassified'
+bookmarksDisabledRun: commands = (
 
-
+	launcher run: {'--config'. 'extensions.hgext.bookmarks=!'}, commands
+)
+createRemoteBookmark: bookmarkName 
+to: newId
+on: repositoryId
+ifFail: failBlock = (
 
-notRestoringBookmarksPull: revision from: remoteSource = (
+	setRemoteBookmark: bookmarkName 
+	from: unexistingVersionId
+	to: newId
+	on: repositoryId
+	ifFail: failBlock 
+)
+defaultArguments = (
+	^ {}
+)
+deleteRemoteBookmark: bookmarkName withId: originalId on: repositoryId ifFail: failBlock = (
 
-
+	^ self
+		setRemoteBookmark: bookmarkName 
+		from: originalId
+		to: ''
+		on: repositoryId
+		ifFail: failBlock 
+)
+disabledBookmarksPull: revision from: remoteSource = (
 
-pathOf: source  = (
+	bookmarksDisabledRun: {'pull'. remoteSource. '--rev'. revision}
+)
+disabledBookmarksPush: internalId to: destination = (
 
-
+	"We must use '-f' as we might create a new head, if the current historian is not a head"
+	bookmarksDisabledRun: {'push'. destination. '-f'. '--rev'. internalId}
+)
+isImmutableId: internalId = (
 
-remoteBookmarksFrom: source ifFail: failBlock = (
+	| isNode trimmedId |
+	trimmedId:: internalId withBlanksTrimmed .
+	^ trimmedId size = 40 and: [
+		trimmedId allSatisfy: [:each | each isDigit or: [each >= $a and: [each <= $f]]]]
+)
+logStream = (
 
-
+	^ launcher runStream: {'log'}, logTemplate
+)
+logTemplate = (
 
-renameBookmark: oldName to: newName  = (
+	^ {'--debug'. '--template'. '{node}\n{parents}\n{author|person}\n{branches}\n{desc|firstline}\n'}
+)
+merge: internalId = (
 
-
+	launcher run: {'--config'. 'ui.merge=internal:local'. 'merge'. internalId asString}.
+)
+nullRevision = (
 
-resetCaches = (
+	^ 'null'
+)
+parentStream = (
 
-
+	^ launcher runStream: {'parents'}, logTemplate
+)
+remoteBookmarksFrom: source ifFail: failBlock = (
 
-setRemoteBookmark: bookmarkName 
+	"Currently returns {} on failure. This is less than ideal, as it does not expose the problem."
+	| lines |
+"	logger log: 'Getting remote bookmarks from ', source."
+	lines:: launcher runLines: {'debugpushkey'. source. 'bookmarks'} ifFail: [^ failBlock value].
+"	logger log: 'Finished remote bookmarks from ', source."
+	^ lines collect: [:each | each subStrings: '	']
+)
+renameBookmark: oldName to: newName  = (
 
-
+	launcher runLines: {'bookmarks'. '--config'. 'bookmarks.track.current=True'. '--rename'. oldName. newName}.
+)
+setRemoteBookmark: bookmarkName 
+from: originalId
+to: newId
+on: repositoryId
+ifFail: failBlock = (
 
-stayOnCurrentHistorianNameDo: aBlock = (
+	"restoringBookmarksPush: newId to: repositoryId."
+	launcher run: {'debugpushkey'. repositoryId. 'bookmarks'. bookmarkName. originalId. newId} ifFail: failBlock
+)
+statusFrom: revA to: revB = (
+	
+	| lines statusAndFilenames |
+	lines:: launcher runLines: {'status'. '--rev'. revA asString, ':', revB asString}.
+	statusAndFilenames:: lines collect: [:each | {each first. each allButFirst: 2}].
+	^ statusAndFilenames reject: [:each | isFilenameIgnored: each second]
+)
+streamAtInternalId: internalId = (
+	
+	^ launcher runStream: {'log'. '-r'.  internalId asString, ':',  internalId asString}, logTemplate
+)
+streamFromInternalId: internalId = (
+	
+	^ launcher runStream: {'log'. '-r'.  internalId asString, ':', nullRevision}, logTemplate
+)
+streamLogFrom: fromId to: toId = (
 
-
+	^ launcher runStream: {'log' .'--rev'. fromId asString, '::', toId asString}, logTemplate
+)
+unexistingVersionId = (
 
-)'accessing'
+	^ ''
+))
+class MercurialHistorian named: historianName = AbstractHistorian named: historianName ("Implements historians using mercurial's bookmarks
 
-MercurialCommand = (
+Mercurial's bookmarks behave different than historians in several ways.
 
-
+Although not the default, mercurial can be configured to store the 'current bookmark'. But even if it is configured to do so, the current bookmark is reset when existing bookmarks are set to point to other versions. We can fix this for local repositories by restoring the current bookmark after certain operations, but we cannot fix this for remote operations. If remote repositories are also to be used as local repositories and this becomes too much of a nuisance, we must store the current historian differently.
 
-repositoryId = (
+If new versions are added to a repository, mercurial moves all bookmarks that point to an ancestor version to the new version. This is not what we want. Therefore we have to ensure bookmarks are restored after push and pull operations.
 
-
+Mercurial's 'bookmarks' command works only on local repositories. We use the 'debugpushkey' command instead. This allows using one implementation to access local and remote bookmarks."|
+|)
+(
+class HistorianChange onVersion: v = AbstractHistorianChange onVersion: v (|
+|)
+('as yet unclassified'
+commit = (
 
-)
+	activatedDo: [
+		withoutActivationCommit]
+)
+mergeIfNeeded = (
 
-
+	1 = newVersion parents size ifFalse: [ | mergeSource |
+		mergeSource:: newVersion parents detect: [:each | each ~= historian version].
+		command merge: mergeSource internalId].
+)
+withoutActivationCommit = (
 
-class Historian named: historianName version: v = AbstractLocalHistorian named: historianName version: v ("Specialization for local historians
-
-Mercurial does not support bookmark tracking. Tracking information is therefore stored in the mercurial conifig file. This works only for local historians, though."|
-	protected cachedTrackedHistorian
-|)
+	mergeIfNeeded.
+	changedMirrors do: [:each | 
+		command addStream: each source readStream asFileNamed: each filename].
+	command removeAll: (
+		deletedOriginalMirrors collect: [:each | each filename]).
+	command commit: newVersion message
+))'as yet unclassified'
+activatedDo: block = (
 
-('actions'
+	"Doesn't check for nested calls. Could be added if required more than once"
+	^ command stayOnCurrentHistorianNameDo: [
+		makeCurrentHistorian.
+		block value]
+)
+createIfFail: failBlock = (
 
-trackedHistorian: otherHistorian = (
+	command
+		createRemoteBookmark: name
+		to: version internalId
+		on: repositoryId
+		ifFail: failBlock.
+)
+deleteIfFail: failBlock  = (
 
-
+	command
+		deleteRemoteBookmark: name
+		withId: version internalId
+		on: repositoryId
+		ifFail: failBlock 
+)
+makeCurrentHistorian = (
 
-'private'
+	command makeHistorianCurrent: name.
+)
+repository = (
+	
+	^ outer Repository repository
+)
+setTo: newVersion ifFail: failBlock = (
 
-configSectionNewspeakTrackingHistorian = (
+	"Subclasses must ensure that newVersion is available in the owning repository"
+	command
+		setRemoteBookmark: name
+		from: version internalId
+		to: newVersion internalId
+		on: repositoryId
+		ifFail: failBlock
+)
+version = (
 
-
+	subclassResponsibility
+))'as yet unclassified'
+Command = (
 
-configSectionNewspeakTrackingRepository = (
+	^ subclassResponsibility
+)
+Historian = (
 
-
+	^ MercurialHistorian
+)
+command = (
 
-'accessing'
+	^ super command
+)
+historians = (
 
-trackedHistorianifPresent: presentBlock ifAbsent: absentBlock ifError: errorBlock = (
+	^ (command
+		remoteBookmarksFrom: repositoryId
+		ifFail: [logger error: 'Could not access remote repository']) collect: [:each |
+			historianNamed: each first versionId: each second]
+)
+repository = (
 
-
+	^ self
+)
+repositoryId = (
 
-)
+	^ super repositoryId
+))'as yet unclassified'
+Version = (
 
-
+	^ super Version
+)
+sourceMirrors = (
 
-class RepositoryVersionAccessing = AbstractRepositoryVersionAccessing (|
-	private mirrorAccessor = MirrorAccessor new.
-	private cachedVersionAtInternalId = Dictionary new.
-|)
-
-(
-
-
-
-class RepositoryVersionStream onStream: stream = AbstractRepositoryVersionStream onStream: stream (|
-|)
-
-('as yet unclassified'
-
-extractParents: line = (
-
-
-
-next = (
-
-
-
-)
-
-
-
-class MirrorAccessor = (
-"Reading all mirrors of a version from the back end can be slow. Versions that are closely related often are identical in most mirrors. Mercurial can efficiently determine which files changed across revisions. Using this knowledge we can reuse mirrors of previously loaded versions. Thus, loading mirrors becomes more efficient.
-The same applies for writing mirrors; only mirrors that changed are written to the back end"|
-	"For the moment we store the mirrors of the version that was fetched most recently. We could also store mirrors of multiple versions and try to find a version close to the one to be loaded."
-	private lastLoadedRevision = 'null'.
-	private lastLoadedMirrors = Dictionary new.
-|)
-
-(
-
-
-
-class VersionLoader onVersion: v = (|
-	version = v.
-|)
-
-('as yet unclassified'
-
-applyFileChange: change toMirrors: result = (
-
-
-
-createMirrorForFilenamed: filename = (
-
-
-
-loadMirrors = (
-
-
-
-)'as yet unclassified'
-
-loadMirrorsFor: version = (
-
-
-
-)
-
-
-
-class RepositoryVersion = AbstractRepositoryVersion (|
-parentInternalIds
-branchName
-cachedMirrors
-cachedParents
-|)
-
-('as yet unclassified'
-
-closestAncestorsWithInternalIdOf: otherVersion = (
-
-
-
-commonAncestorWith: otherVersion = (
-
-
-
-commonAncestorWithRepositoryVersion: otherVersion = (
-
-
-
-mirrors = (
-
-
-
-parents = (
-
-
-
-streamVersionsTo: otherVersion  = (
-
-
-
-)'actions'
-
-cacheAllVersionsFrom: internalId = (
-
-
-
-exportVersionId: internalId to: remoteRepository = (
-
-
-
-importVersionId: internalId from: remoteRepository = (
-
-
-
-'accessing'
-
-immutableVersionAt: internalId = (
-
-
-
-logStream = (
-
-
-
-versionAtInternalId: internalId = (
-
-
-
-)'accessing'
-
-command = (
-
-
-
-imageHistorian = (
-
-
-
-remoteRepositories = (
-
-
-
-repository = (
-
-
-
-repositoryDirectory = (
-
-
-
-'actions'
-
-clone: repositoryLocation = (
-
-
-
-create = (
-
-
-
-refresh = (
-
-
-
-trackMain = (
-
-
-
-)
-
-
-
-class Repository onRepositoryId: id = AbstractRepository onRepositoryId: id (|
-protected repositoryType = 'hg'.
-|)
-
-(
-
-
-
-class MercurialCommand = AbstractCommand ("We're using mercurial's bookmarks to implement historians. Unfortunately, 
-bookmarks have some undesirable properties that we must try to compensate for. 
- 
-Mercurial does not by default have a notion of a current bookmark. It does 
-provide an option to track the current bookmark, but that doesn't always work. 
-So we track the current historian ourselves in .hg/hgrc. 
- 
-Mercurial's bookmarks do not support tracking/upstream relations to be defined. 
-We store them ourselves in .hg/hgrc. 
- 
-A historian is always owned by a single repository. Historian 'master' on repo1 
-is different from historian 'master' on repo2. This is not the case with 
-bookmarks. Bookmarks share a single global namespace. If a repository pushes 
-revisions to another repository, it automatically updates all bookmarks on that 
-destination repository. In order to transfer versions between repositories 
-without changing historians we must reset historians to the state that we found 
-them at before. The current code that does this has not yet been checked for 
-problems that might occur in case of concurrent access to repositories. "|
-
-	commandLine = 'hg'.
-|)
-
-('as yet unclassified'
-
-bookmarksDisabledRun: commands = (
-
-
-
-createRemoteBookmark: bookmarkName 
-
-
-
-defaultArguments = (
-
-
-
-deleteRemoteBookmark: bookmarkName withId: originalId on: repositoryId ifFail: failBlock = (
-
-
-
-disabledBookmarksPull: revision from: remoteSource = (
-
-
-
-disabledBookmarksPush: internalId to: destination = (
-
-
-
-isImmutableId: internalId = (
-
-
-
-logStream = (
-
-
-
-logTemplate = (
-
-
-
-merge: internalId = (
-
-
-
-nullRevision = (
-
-
-
-parentStream = (
-
-
-
-remoteBookmarksFrom: source ifFail: failBlock = (
-
-
-
-renameBookmark: oldName to: newName  = (
-
-
-
-setRemoteBookmark: bookmarkName 
-
-
-
-statusFrom: revA to: revB = (
-
-
-
-streamAtInternalId: internalId = (
-
-
-
-streamFromInternalId: internalId = (
-
-
-
-streamLogFrom: fromId to: toId = (
-
-
-
-unexistingVersionId = (
-
-
-
-)
-
-
-
-class MercurialHistorian named: historianName = AbstractHistorian named: historianName ("Implements historians using mercurial's bookmarks
-
-Mercurial's bookmarks behave different than historians in several ways.
-
-Although not the default, mercurial can be configured to store the 'current bookmark'. But even if it is configured to do so, the current bookmark is reset when existing bookmarks are set to point to other versions. We can fix this for local repositories by restoring the current bookmark after certain operations, but we cannot fix this for remote operations. If remote repositories are also to be used as local repositories and this becomes too much of a nuisance, we must store the current historian differently.
-
-If new versions are added to a repository, mercurial moves all bookmarks that point to an ancestor version to the new version. This is not what we want. Therefore we have to ensure bookmarks are restored after push and pull operations.
-
-Mercurial's 'bookmarks' command works only on local repositories. We use the 'debugpushkey' command instead. This allows using one implementation to access local and remote bookmarks."|
-|)
-
-(
-
-
-
-class HistorianChange onVersion: v = AbstractHistorianChange onVersion: v (|
-|)
-
-('as yet unclassified'
-
-commit = (
-
-
-
-mergeIfNeeded = (
-
-
-
-withoutActivationCommit = (
-
-
-
-)'as yet unclassified'
-
-activatedDo: block = (
-
-
-
-createIfFail: failBlock = (
-
-
-
-deleteIfFail: failBlock  = (
-
-
-
-makeCurrentHistorian = (
-
-
-
-repository = (
-
-
-
-setTo: newVersion ifFail: failBlock = (
-
-
-
-version = (
-
-
-
-)'as yet unclassified'
-
-Command = (
-
-
-
-Historian = (
-
-
-
-command = (
-
-
-
-historians = (
-
-
-
-repository = (
-
-
-
-repositoryId = (
-
-
-
-)'as yet unclassified'
-
-Version = (
-
-
-
-sourceMirrors = (
-
-
-
-))
+	^ super sourceMirrors
+)))