Source

newspeak / VCSMercurialBackendProvider.ns3

The default branch has multiple heads

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
Newspeak3
'StructuredVCS'
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.

|)
(
class Backend = AbstractBackend ()
(
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.
|)
(
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 = (

	^ 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 = (

	super merge: internalId.
	resetCaches
)
notRestoringBookmarksPull: revision from: remoteSource = (

	super notRestoringBookmarksPull: revision from: remoteSource.
	resetCaches
)
pathOf: source  = (

	^ cachedPaths
		at: source
		ifAbsentPut: [super pathOf: source]
)
remoteBookmarksFrom: source ifFail: failBlock = (

	^ source = repositoryId
		ifTrue: [
			nil = cachedBookmarks ifTrue: [
				cachedBookmarks:: super remoteBookmarksFrom: source ifFail: failBlock].
			cachedBookmarks]
		ifFalse: [super remoteBookmarksFrom: source ifFail: failBlock]
)
renameBookmark: oldName to: newName  = (

	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 = (

	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 = (

	^ 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 = (

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 = (

	^ 'newspeak'
)
createEmptyRepository = (

	launcher noDefaultArgumentsRun: {'init'. repository repositoryDirectory pathName}.
	launcher run: {'bookmark'. 'master'}.
	addStream: '' readStream asFileNamed: ignoredFilename.
	launcher run: {'commit'.  '-m'. 'Initial Commit'}.
)
currentHistorianNameIfNone: block = (

	^ configFileDo: [:configFile |
		(configFile section: configSectionNewspeak)
			at: configKeyHistorian
			ifAbsent: block]
)
defaultArguments = (

	^ super defaultArguments, {'--cwd'. repositoryDirectory fullName}
)
makeHistorianCurrent: id = (

	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  = (

	filenames isEmpty ifFalse: [
		launcher run: {'rm' .'-f'}, filenames]
)
sourceIds = (

	^ (configLinesStartingWith: 'paths') collect: [:each |
		(each subStrings: '.=') second]
)
tipStream = (

	^ launcher runStream: {'tip'}, logTemplate
))'accessing'
MercurialCommand = (

	^ outer LocalRepository MercurialCommand
)
repositoryId = (

	^ 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 = (

	"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 = (

	^ '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 = (

	| 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 = (

	"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 = (

	^ otherVersion isRepositoryVersion
		ifTrue: [{otherVersion}]
		ifFalse: [otherVersion parents collect: [:each | 
					closestAncestorsWithInternalIdOf: each]]
)
commonAncestorWith: otherVersion = (

	^ (closestAncestorsWithInternalIdOf: otherVersion) inject: self into: [:acc :each | 
		commonAncestorWithRepositoryVersion: each].
)
commonAncestorWithRepositoryVersion: otherVersion = (

	| commonInternalId |
	commonInternalId:: command commonAncestorOf: internalId and: otherVersion internalId.
	^ versionAtInternalId: commonInternalId
)
mirrors = (

	nil = cachedMirrors ifTrue: [
		cachedMirrors:: mirrorAccessor loadMirrorsFor: self].
	^ cachedMirrors
)
parents = (

	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 = (

	"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 = (

	^ cachedVersionAtInternalId
		at: internalId
		ifAbsent: [
			cacheAllVersionsFrom: internalId.
			cachedVersionAtInternalId at: internalId]
)
logStream = (

	^ RepositoryVersionStream onStream: command logStream
)
versionAtInternalId: internalId = (

	^ (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 = (

	command disabledBookmarksPush: internalId to: remoteRepository repositoryId.
)
importVersionId: internalId from: remoteRepository = (

	cachedVersionAtInternalId
		at: internalId
		ifAbsent: [
			command disabledBookmarksPull: internalId from: remoteRepository repositoryId].
))'accessing'
command = (

	^ 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 = (

	^ super repositoryDirectory
)'actions'
clone: repositoryLocation = (

	| remoteHistorian |
	command clone: repositoryLocation.
	remoteHistorian:: remoteRepositories anyOne historians anyOne.
	remoteHistorian trackAs: remoteHistorian name.
	historians anyOne loadIntoImage
)
create = (

	command createEmptyRepository
)
refresh = (

	command resetCaches.
	cachedRemoteRepositories:: nil
)
trackMain = (

	| 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.

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 = (

	nil = cachedVersion ifTrue: [
		cachedVersion:: super version].
	^ cachedVersion
)) : ('as yet unclassified'
named: historianName version: version = (

	^ self named: historianName versionId: version internalId
))'as yet unclassified'
Command = (

	^ 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. "|

	commandLine = 'hg'.
|)
('as yet unclassified'
bookmarksDisabledRun: commands = (

	launcher run: {'--config'. 'extensions.hgext.bookmarks=!'}, commands
)
createRemoteBookmark: bookmarkName 
to: newId
on: repositoryId
ifFail: failBlock = (

	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 = (

	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 = (

	| 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 = (

	^ {'--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 = (

	^ 'null'
)
parentStream = (

	^ launcher runStream: {'parents'}, logTemplate
)
remoteBookmarksFrom: source ifFail: failBlock = (

	"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 = (

	"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 = (

	^ ''
))
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 = (

	activatedDo: [
		withoutActivationCommit]
)
mergeIfNeeded = (

	1 = newVersion parents size ifFalse: [ | mergeSource |
		mergeSource:: newVersion parents detect: [:each | (each = historian version) not].
		command merge: mergeSource internalId].
)
withoutActivationCommit = (

	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 = (

	"Doesn't check for nested calls. Could be added if required more than once"
	^ command stayOnCurrentHistorianNameDo: [
		makeCurrentHistorian.
		block value]
)
createIfFail: failBlock = (

	command
		createRemoteBookmark: name
		to: version internalId
		on: repositoryId
		ifFail: failBlock.
)
deleteIfFail: failBlock  = (

	command
		deleteRemoteBookmark: name
		withId: version internalId
		on: repositoryId
		ifFail: failBlock 
)
makeCurrentHistorian = (

	command makeHistorianCurrent: name.
)
repository = (
	
	^ outer Repository repository
)
setTo: newVersion ifFail: failBlock = (

	"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 = (

	^ subclassResponsibility
)
Historian = (

	^ MercurialHistorian
)
command = (

	^ super command
)
historians = (

	^ (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 = (

	^ super sourceMirrors
)))