"{ Package: 'stx:goodies/monticello' }"

MCTool subclass:#MCWorkingCopyBrowser
	instanceVariableNames:'workingCopy workingCopyWrapper repository defaults'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-UI'
!


!MCWorkingCopyBrowser class methodsFor:'as yet unclassified'!

initialize
	 (TheWorldMenu respondsTo: #registerOpenCommand:)
         ifTrue: [TheWorldMenu registerOpenCommand: {'Monticello Browser'. {self. #open}}]
!

new
	^ self basicNew initialize
!

open
	self new show
! !

!MCWorkingCopyBrowser methodsFor:'actions'!

addRepository
	self newRepository ifNotNilDo:
		[:repos | self addRepository: repos ].
!

addRepository: aRepository
	self repository: aRepository.
	self repositoryGroup addRepository: aRepository.
	self changed: #repositoryList; changed: #repositorySelection.
	self changedButtons.
!

addRepositoryToPackage
	self repository ifNotNilDo:
		[:repos |
		(self pickWorkingCopySatisfying: [ :p | (p repositoryGroup includes: repos) not ]) ifNotNilDo:
			[:wc |
			workingCopy _ wc.
			workingCopy repositoryGroup addRepository: repos.
			self repository: repos.	
			self
				changed: #workingCopySelection;
				changed: #repositoryList;
				changed: #repositorySelection.
			self changedButtons]]
!

addRepositoryToWorkingCopy
	workingCopy ifNotNilDo:
		[:wc |
			workingCopy repositoryGroup addRepository: self repository.
			self
				changed: #workingCopySelection;
				changed: #repositoryList;
				changed: #repositorySelection.
			self changedButtons]
!

addRequiredPackage
	workingCopy ifNotNilDo:
		[:wc |
		self pickWorkingCopy ifNotNilDo:
			[:required |
			wc requirePackage: required package.
			self workingCopyListChanged]]
!

addWorkingCopy
	|name|
	name _ FillInTheBlankMorph request: 'Name of package:'.
	name isEmptyOrNil ifFalse:
		[PackageInfo registerPackageName: name.
		workingCopy _ MCWorkingCopy forPackage: (MCPackage new name: name).
		workingCopyWrapper _ nil.
		self repositorySelection: 0].
	self workingCopyListChanged; changed: #workingCopySelection; changed: #repositoryList.
	self changedButtons.
!

backportChanges
	self canBackport ifFalse: [^self].
	workingCopy ifNotNil:
		[workingCopy needsSaving ifTrue: [^ self inform: 'You must save the working copy before backporting.'].
		self pickAncestorVersionInfo ifNotNilDo:
			[:baseVersionInfo |
			workingCopy backportChangesTo: baseVersionInfo]]
!

browseWorkingCopy
	workingCopy ifNotNil:
		[(MCSnapshotBrowser forSnapshot: workingCopy package snapshot)
			label: 'Snapshot Browser: ', workingCopy packageName;
			show]
!

canBackport
	^ self hasWorkingCopy and: [workingCopy needsSaving not]
!

checkForNewerVersions
	| newer |
	newer _ workingCopy possiblyNewerVersionsIn: self repository.
	^ newer isEmpty or: [
		self confirm: 'CAUTION!! These versions in the repository may be newer:', 
			String cr, newer asString, String cr,
			'Do you really want to save this version?'].
!

clearRequiredPackages
	workingCopy ifNotNilDo:
		[:wc |
		wc clearRequiredPackages.
		self workingCopyListChanged]
!

deleteWorkingCopy
	workingCopy unregister.
	self workingCopySelection: 0.
	self workingCopyListChanged.
!

editRepository
	| newRepo |
	
	newRepo := self repository openAndEditTemplateCopy.
	newRepo ifNotNil: [ 
		newRepo class = self repository class
			ifTrue: [self repository copyFrom: newRepo]
			ifFalse: [self inform: 'Must not change repository type!!']]
!

flushAllCaches
	| beforeBytes afterBytes beforeVersions afterVersions |
	Cursor wait showWhile: [
		beforeBytes := Smalltalk garbageCollect.
		beforeVersions := MCVersion allSubInstances size.
		MCFileBasedRepository flushAllCaches.
		afterBytes := Smalltalk garbageCollect.
		afterVersions := MCVersion allSubInstances size.
	].
	^self inform: (beforeVersions - afterVersions) asString, ' versions flushed', String cr,
 		(afterBytes - beforeBytes) asStringWithCommas, ' bytes reclaimed'
!

inspectWorkingCopy
	workingCopy ifNotNil: [workingCopy inspect]
!

loadRepositories
	FileStream fileIn: 'MCRepositories.st'.
	self changed: #repositoryList.
	self changedButtons.
!

newRepository
	| types index |
	types _ MCRepository allConcreteSubclasses asArray.
	index _ (PopUpMenu labelArray: (types collect: [:ea | ea description]))
				startUpWithCaption: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) morphicConfigure]
!

openRepository
	self repository ifNotNilDo: [:repos | repos morphicOpen: workingCopy ]
!

recompilePackage
	workingCopy package packageInfo methods
		do: [:ea | ea actualClass recompile: ea methodSymbol]
		displayingProgress: 'Recompiling...'
!

removeRepository
	self repository ifNotNilDo:
		[:repos |
		self repositoryGroup removeRepository: repos.
		self repositorySelection: (1 min: self repositories size)].
	self changed: #repositoryList.
	self changedButtons.
!

repository
	workingCopy ifNotNil: [repository _ self defaults at: workingCopy ifAbsent: []].
	^ repository
!

repository: aRepository
	repository _ aRepository.
	workingCopy ifNotNil: [self defaults at: workingCopy put: aRepository]
!

revertPackage
	self pickAncestorVersionInfo ifNotNilDo: [:info |
		(self repositoryGroup versionWithInfo: info
			ifNone: [^self inform: 'No repository found for ', info name]
		) load]
!

saveRepositories
	| f |
	f := FileStream forceNewFileNamed: 'MCRepositories.st'.
	MCRepositoryGroup default repositoriesDo: [:r |
		f nextPutAll: 'MCRepositoryGroup default addRepository: (', r asCreationTemplate, ')!!'; cr.]
!

saveVersion
	| repo |
	self canSave ifFalse: [^self].
	self checkForNewerVersions ifFalse: [^self].
	repo _ self repository.
	workingCopy newVersion ifNotNilDo:
		[:v |
		(MCVersionInspector new version: v) show.
		Cursor wait showWhile: [repo storeVersion: v].
		MCCacheRepository default cacheAllFileNamesDuring: 
			[repo cacheAllFileNamesDuring: 
				[v allAvailableDependenciesDo:
					[:dep |
					(repo includesVersionNamed: dep info name)
						ifFalse: [repo storeVersion: dep]]]]]
!

trimAncestry
	self pickAncestorVersionInfo ifNotNilDo:
		[:ancestor |
		workingCopy ancestry trimAfterVersionInfo: ancestor]
!

unloadPackage
	workingCopy unload.
	self workingCopySelection: 0.
	self workingCopyListChanged.
!

viewChanges
	| patch |
	self canSave ifTrue:
		[patch _ workingCopy changesRelativeToRepository: self repository.
		patch isNil ifTrue: [^ self].
		patch isEmpty
			ifTrue: [ workingCopy modified: false.
				self inform: 'No changes' ]
			ifFalse:
				[ workingCopy modified: true.
				(MCPatchBrowser forPatch: patch)
					label: 'Patch Browser: ', workingCopy description;
					show]]
!

viewHistory
	workingCopy ifNotNil:
		[(MCWorkingHistoryBrowser new
				ancestry: workingCopy ancestry;
				package: workingCopy package)
			label:  'Version History: ',  workingCopy packageName;
			show]
! !

!MCWorkingCopyBrowser methodsFor:'morphic ui'!

buttonSpecs
       ^ #(
               ('+Package' addWorkingCopy 'Add a new package and make it the working copy')
               (Browse browseWorkingCopy 'Browse the working copy of the selected package' hasWorkingCopy)
               (Scripts editLoadScripts 'Edit the load/unload scripts of this package' hasWorkingCopy)
               (History viewHistory 'View the working copy''s history' hasWorkingCopy)
               (Changes viewChanges 'View the working copy''s changes relative to the installed version from the repository' canSave)
               (Backport backportChanges 'Backport the working copy''s changes to an ancestor' canBackport)
               (Save saveVersion 'Save the working copy as a new version to the selected repository' canSave)
             ('+Repository' addRepository 'Add an existing repository to the list of those visible')
               (Open openRepository 'Open a browser on the selected repository' hasRepository)
               )
!

canSave
	^ self hasWorkingCopy and: [self hasRepository]
!

changedButtons
	self changed: #hasWorkingCopy.
	self changed: #canSave.
	self changed: #canBackport.
	self changed: #hasRepository.
!

defaultExtent
	^ 550@200
!

defaultLabel
	^ 'Monticello Browser'
!

defaults
	^ defaults ifNil: [defaults _ Dictionary new]
!

editLoadScripts

	| menu |
	self hasWorkingCopy ifFalse: [^self].
	menu _ MenuMorph new defaultTarget: self.
	menu add: 'edit preamble' selector: #editScript: argument: #preamble.
	menu add: 'edit postscript' selector: #editScript: argument: #postscript.
	menu add: 'edit preambleOfRemoval' selector: #editScript: argument: #preambleOfRemoval.
	menu add: 'edit postscriptOfRemoval' selector: #editScript: argument: #postscriptOfRemoval.
	menu popUpInWorld.
!

editScript: scriptSymbol

| script |
script _ workingCopy packageInfo perform: scriptSymbol.
script openLabel: scriptSymbol asString, ' of the Package ', workingCopy package name.
!

hasRepository
	^ self repository notNil
!

hasWorkingCopy
	^ workingCopy notNil
!

initialize
	MCWorkingCopy addDependent: self.
	self workingCopies do: [:ea | ea addDependent: self].
!

pickAncestorVersionInfo
	| ancestors index |
	ancestors _ workingCopy ancestry breadthFirstAncestors.
	index _ (PopUpMenu labelArray: (ancestors collect: [:ea | ea name]))
				startUpWithCaption: 'Ancestor:'.
	^ index = 0 ifFalse: [ ancestors at: index]
!

pickWorkingCopy
	^self pickWorkingCopySatisfying: [ :c | true ]
!

pickWorkingCopySatisfying: aBlock
	| copies index |
	copies _ self workingCopies select: aBlock.
	copies isEmpty ifTrue: [ ^nil ].
	index _ (PopUpMenu labelArray: (copies collect: [:ea | ea packageName]))
				startUpWithCaption: 'Package:'.
	^ index = 0 ifFalse: [ copies at: index]
!

repositories
	^ self repositoryGroup repositories
!

repositoryGroup
	^ workingCopy
		ifNil: [MCRepositoryGroup default]
		ifNotNil: [workingCopy repositoryGroup]
!

repositoryList
	^ self repositories collect: [:ea | ea description]
!

repositoryListMenu: aMenu
	self repository ifNil: [^ aMenu].
	self fillMenu: aMenu fromSpecs:
		#(('open repository' #openRepository)
		    ('edit repository info' #editRepository)
		   ('add to package...' #addRepositoryToPackage)
		   ('remove repository' #removeRepository)	
		   ('load repositories' #loadRepositories)	
		   ('save repositories' #saveRepositories)
		   ('flush cached versions' #flushAllCaches)	
		).
		aMenu
		add: (self repository alwaysStoreDiffs
					ifTrue: ['store full versions']
					ifFalse: ['store diffs'])
		target: self
		selector: #toggleDiffs.
	^ aMenu
				
!

repositorySelection
	^ self repositories indexOf: self repository
!

repositorySelection: aNumber
	aNumber = 0
		ifTrue: [self repository: nil]
		ifFalse: [self repository: (self repositories at: aNumber)].
	self changed: #repositorySelection.
	self changedButtons.
!

toggleDiffs
	self repository alwaysStoreDiffs
		ifTrue: [self repository doNotAlwaysStoreDiffs]
		ifFalse: [self repository doAlwaysStoreDiffs]
!

unsortedWorkingCopies
	^ MCWorkingCopy allManagers 
!

update: aSymbol
	self unsortedWorkingCopies do: [:ea | ea addDependent: self].
	self workingCopyListChanged.
!

widgetSpecs
	^ #(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((treeOrListMorph: workingCopy) (0 0 0.5 1) (0 30 0 0))
		((listMorph: repository) (0.5 0 1 1) (0 30 0 0))
		)
!

workingCopies
	^ MCWorkingCopy allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ]
!

workingCopy: wc
	workingCopy _ wc.
	self changed: #workingCopyList; changed: #workingCopySelection; changed: #repositoryList.
	self changedButtons.
!

workingCopyList
	^ self workingCopies collect:
		[:ea |
		(workingCopy notNil and: [workingCopy requiredPackages includes: ea package])
			ifTrue: [Text string: ea description emphasis: (Array with: TextEmphasis bold)]
			ifFalse: [ea description]]
!

workingCopyListChanged
	self changed: #workingCopyList.
	self changed: #workingCopyTree.
	self changedButtons.
!

workingCopyListMenu: aMenu
	workingCopy ifNil: [^ aMenu].
	self fillMenu: aMenu fromSpecs:
		#(('add required package' #addRequiredPackage)
			('clear required packages' #clearRequiredPackages)
			('browse package' #browseWorkingCopy)
			('view changes' #viewChanges)
			('view history' #viewHistory)
			('recompile package' #recompilePackage)
			('revert package...' #revertPackage)
			('trim ancestry' #trimAncestry)
			('unload package' #unloadPackage)
			('delete working copy' #deleteWorkingCopy)).
	(Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [
		aMenu add: 'make SAR' target: self selector: #fileOutAsSAR
	].
	^aMenu
!

workingCopyListMorph
	^ PluggableMultiColumnListMorph
		on: self
		list: #workingCopyList
		selected: #workingCopySelection
		changeSelected: #workingCopySelection:
		menu: #workingCopyListMenu:
!

workingCopySelection
	^ self workingCopies indexOf: workingCopy
!

workingCopySelection: aNumber
	self workingCopy: 
		(aNumber = 0 
			ifTrue:[nil]
			ifFalse:[self workingCopies at: aNumber]).	
!

workingCopySelectionWrapper
	^workingCopyWrapper
!

workingCopySelectionWrapper: aWrapper
	workingCopyWrapper := aWrapper.
	self changed: #workingCopySelectionWrapper.
	self workingCopy: (aWrapper ifNotNil:[aWrapper item])
!

workingCopyTree
	^ self workingCopies collect:[:each| MCDependentsWrapper with: each model: self].
!

workingCopyTreeMenu: aMenu
	workingCopy ifNil: [^ aMenu].
	self fillMenu: aMenu fromSpecs:
		#(('add required package' #addRequiredPackage)
			('clear required packages' #clearRequiredPackages)
			('browse package' #browseWorkingCopy)
			('view changes' #viewChanges)
			('view history' #viewHistory)
			('recompile package' #recompilePackage)
			('revert package...' #revertPackage)
			('unload package' #unloadPackage)
			('trim ancestry' #trimAncestry)
			('delete working copy' #deleteWorkingCopy)
			('inspect working copy' #inspectWorkingCopy)).
	(Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [
		aMenu add: 'make SAR' target: self selector: #fileOutAsSAR
	].
	^aMenu
!

workingCopyTreeMorph
	^ SimpleHierarchicalListMorph
		on: self
		list: #workingCopyTree
		selected: #workingCopyWrapper
		changeSelected: #workingCopyWrapper:
		menu: #workingCopyListMenu:
! !

!MCWorkingCopyBrowser class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCWorkingCopyBrowser.st,v 1.2 2012-09-11 21:15:12 cg Exp $'
! !

MCWorkingCopyBrowser initialize!