SystemOrganization addCategory: #'OB-Monticello-Browser'! SystemOrganization addCategory: #'OB-Monticello-Commands'! SystemOrganization addCategory: #'OB-Monticello-Nodes'! SystemOrganization addCategory: #'OB-Monticello-Other'! !MCWorkingCopy methodsFor: '*ob-monticello' stamp: 'dkh 12/14/2007 11:20'! asNode ^MCWorkingCopyNode on: self! ! !MCWorkingCopy methodsFor: '*ob-monticello' stamp: 'dkh 02/20/2009 14:14'! summary ^ String streamContents: [:s | self modified ifTrue: [s nextPutAll: 'MODIFIED'; cr]. s nextPutAll: self ancestry summary. s cr; nextPutAll: '==========================='. self ancestry ancestors do: [:ea | s cr; cr. s nextPutAll: ea summary. s cr; nextPutAll: '---------------------------' ]. self requiredPackages isEmpty ifFalse: [ s cr; nextPutAll: '---------------------------'. s cr; cr; nextPutAll: 'Required: ' ]. (self requiredPackages sortBy: [:a :b | a name <= b name]) do: [:ea | s nextPutAll: ea name, ', ']] ! ! OBBrowser subclass: #MCBrowser instanceVariableNames: 'hasChanges' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! MCBrowser subclass: #MCAllRepositoryBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCAllRepositoryBrowser class methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! defaultMetaNode | repos versions root branches packages | root := OBMetaNode named: 'root'. repos := OBMetaNode named: 'repositories'. packages := OBMetaNode named: 'packages'. branches := OBMetaNode named: 'branches'. versions := OBMetaNode named: 'bersions'. root - #fileBasedRepositories -> repos. repos - #packagesByName -> packages. packages - #branches -> branches. branches - #sortedVersions -> versions. packages autoSelect: (OBAutoSelection on: branches). packages addFilter: MCModifiedFilter new. ^ root! ! !MCAllRepositoryBrowser class methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:16'! defaultRootNode ^ MCAllRepositoriesNode new! ! !MCAllRepositoryBrowser class methodsFor: 'as yet unclassified' stamp: 'avi 12/6/2007 14:01'! paneCount ^ 4! ! !MCAllRepositoryBrowser class methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 15:50'! title ^ 'Monticello'! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/19/2007 09:27'! cmdAdmin ^ {MCCmdNewRepository}! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:09'! cmdChanges ^ MCCmdChanges! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:10'! cmdHistory ^ MCCmdHistory! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:11'! cmdRefresh ^ MCCmdRefresh ! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:12'! cmdRepository ^ {MCCmdEditRepositoryInfo}! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:12'! cmdVersions ^ MCVersionCommand allSubclasses! ! !MCAllRepositoryBrowser methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:14'! cmdWorkingCopyRepository ^ MCWorkingCopyRepositoryCommand allSubclasses! ! !MCBrowser methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:54'! annotatationPanel! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 15:55'! clearChanges hasChanges ifTrue: [self changed: #clearChanges ]. hasChanges := false! ! !MCBrowser methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:53'! defaultBackgroundColor ^ Color r: 0.627 g: 0.69 b: 0.976! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 16:14'! event: anEvent self noteChanges. ! ! !MCBrowser methodsFor: 'initializing' stamp: 'dkh 02/26/2009 16:17'! initialize super initialize. hasChanges := false. self register ! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 15:56'! noteChanges hasChanges ifFalse: [self changed: #noteChanges ]. hasChanges := true ! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 16:13'! register SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #event:.! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 15:56'! signalRefresh super signalRefresh. hasChanges := false. ^nil! ! !MCBrowser methodsFor: 'morphic' stamp: 'dkh 02/26/2009 16:14'! stepAt: milliseconds in: aSystemWindow hasChanges ifTrue: [self signalRefresh]. self clearChanges! ! !MCBrowser methodsFor: 'updating' stamp: 'dkh 02/26/2009 16:13'! unregister SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self.! ! !MCBrowser methodsFor: 'testing' stamp: 'dkh 03/19/2009 12:06'! wantsStepsIn "only MCPackageBrowser updates correctly at the moment" ^false! ! !MCBrowser methodsFor: 'morphic' stamp: 'dkh 02/26/2009 16:13'! windowIsClosing self unregister. ^nil! ! MCBrowser subclass: #MCCodeBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! MCCodeBrowser subclass: #MCBrowseTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCBrowseTool class methodsFor: 'configuration' stamp: 'lr 5/27/2009 18:44'! title ^ 'MC Browser'! ! !MCCodeBrowser class methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:54'! annotationPanel ^ nil! ! MCCodeBrowser subclass: #MCMergeTool instanceVariableNames: 'versionMerger title' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCMergeTool class methodsFor: 'as yet unclassified' stamp: 'dkh 03/17/2009 12:58'! defaultMetaNode | merger conflicts ops | merger := OBMetaNode named: 'VersionMerger'. conflicts := OBMetaNode named: 'Conflicts'. ops := OBMetaNode named: 'Operations'. merger childAt: #sortedConflicts put: conflicts. merger childAt: #sortedOperations put: ops. ^ merger! ! !MCMergeTool class methodsFor: 'as yet unclassified' stamp: 'avi 12/3/2007 16:48'! paneCount ^ 1! ! !MCMergeTool class methodsFor: 'as yet unclassified' stamp: 'dkh 03/06/2008 12:15'! titleForRoot: aNode ^ aNode mergeTitle! ! !MCMergeTool methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:10'! cmdInstall ^ MCCmdInstallOperation ! ! !MCMergeTool methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:12'! cmdStandard ^ {MCCmdFinishMerge. MCCmdKeepConflict. MCCmdRejectConflict}! ! MCCodeBrowser subclass: #MCPatchTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCPatchTool class methodsFor: 'configuration' stamp: 'dkh 02/27/2009 16:44'! defaultMetaNode | operations patch | patch := OBMetaNode named: 'Patch'. operations := OBMetaNode named: 'Operations'. patch - #sortedOperations -> operations. ^ patch! ! !MCPatchTool class methodsFor: 'configuration' stamp: 'dkh 11/05/2007 08:32'! paneCount ^ 1! ! !MCPatchTool class methodsFor: 'configuration' stamp: 'dkh 12/16/2008 12:39'! panels ^ (Array with: self navigationPanel with: self annotationPanel with: self optionalButtonPanel with: self definitionPanel ) reject: [:ea | ea isNil]! ! !MCPatchTool class methodsFor: 'configuration' stamp: 'dkh 11/05/2007 08:49'! title ^ 'Patch Browser'! ! !MCPatchTool class methodsFor: 'configuration' stamp: 'dkh 02/27/2009 16:39'! titleForRoot: aNode ^ aNode label! ! !MCPatchTool methodsFor: 'as yet unclassified' stamp: 'dkh 12/16/2008 12:30'! cmdBrowse ^ {OBCmdBrowseSenders. OBCmdBrowseImplementors. OBCmdBrowse. OBCmdBrowseHierarchy. OBCmdBrowseReferences. }! ! !MCPatchTool methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:10'! cmdInstall ^ MCCmdInstallOperation ! ! MCBrowser subclass: #MCDependencyBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! MCBrowser subclass: #MCPackageBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCPackageBrowser class methodsFor: 'configuration' stamp: 'dkh 12/14/2007 11:22'! defaultMetaNode | allPackages packages repositories | allPackages := OBMetaNode named: 'All packages'. packages := OBMetaNode named: 'Packages'. allPackages childAt: #packages put: packages. packages addFilter: MCModifiedFilter new. repositories := OBMetaNode named: 'Repositories'. packages childAt: #repositories put: repositories. ^ allPackages! ! !MCPackageBrowser class methodsFor: 'configuration' stamp: 'dkh 12/14/2007 11:16'! defaultRootNode ^ MCAllWorkingCopiesNode new! ! !MCPackageBrowser class methodsFor: 'configuration' stamp: 'dkh 11/05/2007 08:32'! paneCount ^ 2! ! !MCPackageBrowser class methodsFor: 'configuration' stamp: 'dkh 09/12/2007 19:00'! title ^ 'Monticello Browser'! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:09'! cmdAdmin ^ MCAdminCommand allSubclasses! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 03/19/2009 12:39'! cmdBrowse ^ MCCmdBrowsePackage! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:09'! cmdChanges ^ MCCmdChanges! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:10'! cmdHistory ^ MCCmdHistory! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:12'! cmdRepository ^ MCRepositoryCommand allSubclasses! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:13'! cmdWorkingCopy ^ MCWorkingCopyCommand allSubclasses! ! !MCPackageBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:14'! cmdWorkingCopyRepository ^ MCWorkingCopyRepositoryCommand allSubclasses! ! !MCPackageBrowser methodsFor: 'testing' stamp: 'dkh 03/19/2009 12:05'! wantsStepsIn ^true! ! MCBrowser subclass: #MCRepositoryBrowser instanceVariableNames: 'versions newer loaded inherited' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCRepositoryBrowser class methodsFor: 'configuration' stamp: 'dkh 03/06/2008 19:20'! defaultMetaNode | packages repository versions | repository := OBMetaNode named: 'repository'. packages := OBMetaNode named: 'packages'. versions := OBMetaNode named: 'version'. repository childAt: #packagesHighlighted put: packages. packages childAt: #sortedVersions put: versions. ^ repository ! ! !MCRepositoryBrowser class methodsFor: 'configuration' stamp: 'dkh 9/12/2007 16:00'! paneCount ^ 2! ! !MCRepositoryBrowser class methodsFor: 'configuration' stamp: 'dkh 09/12/2007 16:46'! title ^ 'Repository Browser'! ! !MCRepositoryBrowser class methodsFor: 'configuration' stamp: 'avi 12/4/2007 15:41'! titleForRoot: aNode ^ 'Repository: ', aNode name! ! !MCRepositoryBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:13'! cmdAll ^ MCVersionCommand allSubclasses! ! !MCRepositoryBrowser methodsFor: 'commands' stamp: 'dkh 03/19/2009 12:43'! cmdBrowse ^ MCCmdBrowsePackage! ! !MCRepositoryBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:09'! cmdChanges ^ MCCmdChanges! ! !MCRepositoryBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:10'! cmdHistory ^ MCCmdHistory! ! !MCRepositoryBrowser methodsFor: 'commands' stamp: 'dkh 12/14/2007 11:11'! cmdRefresh ^ MCCmdRefresh ! ! !MCRepositoryBrowser methodsFor: 'accessing' stamp: 'dkh 03/06/2008 18:47'! loaded ^loaded! ! !MCRepositoryBrowser methodsFor: 'accessing' stamp: 'dkh 03/06/2008 18:48'! newer ^newer! ! !MCRepositoryBrowser methodsFor: 'updating' stamp: 'dkh 03/06/2008 19:26'! refresh self root refresh! ! !MCRepositoryBrowser methodsFor: 'updating' stamp: 'dkh 03/06/2008 19:26'! refresh: ann self refresh! ! !MCRepositoryBrowser methodsFor: 'initializing' stamp: 'dkh 03/06/2008 18:42'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self refresh! ! !MCRepositoryBrowser methodsFor: 'updating' stamp: 'dkh 03/06/2008 18:37'! subscribe super subscribe. (self announcer) observe: OBRefreshRequired send: #refresh: to: self! ! !MCRepositoryBrowser methodsFor: 'accessing' stamp: 'dkh 03/06/2008 18:47'! versions ^versions! ! MCBrowser subclass: #MCVersionHistoryTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Browser'! !MCVersionHistoryTool class methodsFor: 'configuration' stamp: 'dkh 09/13/2007 15:45'! defaultMetaNode | ancestor ancestors | ancestor := OBMetaNode named: 'Ancestor'. ancestors := OBMetaNode named: 'Ancestors'. ancestor childAt: #withBreadthFirstAncestors put: ancestors. ^ ancestor! ! !MCVersionHistoryTool class methodsFor: 'instance creation' stamp: 'dkh 09/13/2007 15:28'! onPackage: aPackageNode ^self root: aPackageNode! ! !MCVersionHistoryTool class methodsFor: 'instance creation' stamp: 'dkh 09/13/2007 15:28'! openOnPackage: aPackageNode ^(self onPackage: aPackageNode) open! ! !MCVersionHistoryTool class methodsFor: 'configuration' stamp: 'dkh 09/13/2007 15:45'! paneCount ^ 1! ! !MCVersionHistoryTool class methodsFor: 'configuration' stamp: 'dkh 03/24/2009 20:42'! panels ^ (Array with: self navigationPanel with: self definitionPanel) reject: [:ea | ea isNil] ! ! !MCVersionHistoryTool class methodsFor: 'configuration' stamp: 'avi 12/4/2007 16:16'! title ^'Version History'! ! !OBPlatform class methodsFor: '*ob-monticello' stamp: 'dkh 04/17/2008 09:52'! doAutoCommit "Answer true by default" ^true! ! OBInteractionRequest subclass: #MCDirectoryRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Other'! !MCDirectoryRequest methodsFor: 'dispatching' stamp: 'dkh 09/13/2007 13:55'! handleWith: anObject ^ anObject handleDirectoryRequest: self! ! !MCVersionDependency methodsFor: '*ob-monticello' stamp: 'dkh 03/04/2008 12:55'! asNode ^MCVersionDependencyNode new dependency: self; yourself! ! !OBFixedButtonPanel methodsFor: '*ob-monticello' stamp: 'avi 12/4/2007 09:34'! next ^ browser navigationPanel currentColumn next! ! OBFilter subclass: #MCModifiedFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Other'! !MCModifiedFilter methodsFor: 'as yet unclassified' stamp: 'avi 12/7/2007 14:39'! icon: aSymbol forNode: aNode (aNode hasWorkingCopy not or: [aNode workingCopy isNil]) ifTrue: [^ #blank]. ^ aNode workingCopy modified ifTrue: [#breakpoint] ifFalse: [aNode workingCopy needsSaving ifTrue: [#arrowDown] ifFalse: [#blank]]! ! !MCDirectoryRepository class methodsFor: '*ob-monticello' stamp: 'dkh 12/20/2008 02:35'! obConfigureFromTemplate: aString | pathString | pathString := OBTextRequest prompt: 'Enter full path to directory' template: FileDirectory default pathName. pathString == nil ifTrue: [ ^nil ]. ^self new directory: (FileDirectory on: pathString)! ! !MCFileBasedRepository methodsFor: '*ob-monticello' stamp: 'dkh 12/14/2007 11:20'! versionNodes ^ self readableFileNames collect: [:ea | MCFileBasedVersionNode fileName: ea repository: self] ! ! OBNode subclass: #MCNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCNode subclass: #MCAllRepositoriesNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCAllRepositoriesNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:35'! canAddRepository ^true! ! !MCAllRepositoriesNode methodsFor: 'navigating' stamp: 'avi 12/6/2007 14:06'! fileBasedRepositories ^ self repositories select: [:ea | ea repository isKindOf: MCFileBasedRepository]! ! !MCAllRepositoriesNode methodsFor: 'public' stamp: 'dkh 09/14/2007 07:20'! name ^ '--all repositories--'! ! !MCAllRepositoriesNode methodsFor: 'navigating' stamp: 'dkh 09/14/2007 07:30'! repositories | rg | rg := self repositoryGroup. ^ rg repositories collect: [:ea | | node | node := ea asNode. node repositoryGroup: rg. node]! ! !MCAllRepositoriesNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:30'! repositoryGroup ^ MCRepositoryGroup default ! ! MCNode subclass: #MCAllWorkingCopiesNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCAllWorkingCopiesNode methodsFor: 'public' stamp: 'avi 12/6/2007 13:30'! name ^ '--working copies--'! ! !MCAllWorkingCopiesNode methodsFor: 'navigating' stamp: 'dkh 12/14/2007 11:16'! packages ^ (Array with: MCAllRepositoriesNode new), super packages! ! MCNode subclass: #MCAncestryAwareNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCNode subclass: #MCAncestryNode instanceVariableNames: 'ancestry' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCAncestryNode class methodsFor: 'instance creation' stamp: 'dkh 09/13/2007 15:35'! on: anAncestry ^ self new ancestry: anAncestry; yourself! ! !MCAncestryNode methodsFor: 'accessing' stamp: 'dkh 09/13/2007 15:36'! ancestry ^ancestry! ! !MCAncestryNode methodsFor: 'accessing' stamp: 'dkh 09/13/2007 15:36'! ancestry: anAncestry ancestry := anAncestry! ! !MCAncestryNode methodsFor: 'public' stamp: 'dkh 09/13/2007 15:40'! name ^ancestry name! ! !MCAncestryNode methodsFor: 'public' stamp: 'dkh 09/13/2007 15:46'! text ^ancestry summary! ! MCNode subclass: #MCBranchNode instanceVariableNames: 'repoWC branch' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCBranchNode class methodsFor: 'as yet unclassified' stamp: 'avi 12/6/2007 14:39'! parent: parent branch: aString ^ self basicNew initializeWithParent: parent branch: aString! ! !MCBranchNode methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! initializeWithParent: parent branch: aString repoWC := parent. branch := aString! ! !MCBranchNode methodsFor: 'as yet unclassified' stamp: 'avi 12/6/2007 15:51'! name ^ branch isEmptyOrNil ifTrue: ['--trunk--'] ifFalse: [branch]! ! MCNode subclass: #MCMergerNode instanceVariableNames: 'merger' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCMergerNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/06/2008 12:11'! conflicts ^ self merger conflicts collect: [:ea | MCConflictNode new conflict: ea]! ! !MCMergerNode methodsFor: 'testing' stamp: 'dkh 03/06/2008 12:16'! isMerged ^self merger isMerged! ! !MCMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:16'! mergeTitle ^ 'Merging ', self merger class name! ! !MCMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:12'! merger ^merger! ! !MCMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:12'! merger: aMerger merger := aMerger! ! !MCMergerNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/06/2008 12:12'! operations ^ self merger operations collect: [:ea | MCPatchOperationNode new operation: ea]! ! !MCMergerNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/24/2009 14:49'! sortedConflicts ^ self conflicts sortBy: [:a :b | a name asString <= b name asString ]! ! !MCMergerNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/17/2009 12:58'! sortedOperations ^ self operations sortBy: [:a :b | a name <= b name ]! ! MCMergerNode subclass: #MCVersionMergerNode instanceVariableNames: 'versionMerger' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCVersionMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:15'! mergeTitle ^ self versionMerger mergeTitle! ! !MCVersionMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:13'! merger ^self versionMerger merger! ! !MCVersionMergerNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 12:13'! versionMerger ^ versionMerger! ! !MCVersionMergerNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! versionMerger: aMerger versionMerger := aMerger! ! !MCNode methodsFor: 'conversion' stamp: 'dkh 11/01/2007 16:19'! asNode ^self! ! !MCNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:35'! canAddRepository ^false! ! !MCNode methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:03'! canBeBrowsed ^ false! ! !MCNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:04'! hasAncestry ^ false! ! !MCNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:34'! hasChanges ^ false! ! !MCNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:04'! hasRepository ^ false! ! !MCNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:30'! hasRepositoryGroup ^false! ! !MCNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:04'! hasVersion ^ false! ! !MCNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:04'! hasWorkingCopy ^ false! ! !MCNode methodsFor: 'conversion' stamp: 'avi 12/5/2007 16:30'! isVersionNode ^ false! ! !MCNode methodsFor: 'conversion' stamp: 'avi 12/5/2007 16:29'! isWorkingCopyNode ^ false! ! !MCNode methodsFor: 'navigating' stamp: 'dkh 09/14/2007 07:55'! packages ^(MCWorkingCopy allManagers asSortedCollection: [ :a :b | a package name <= b package name ]) collect: [:ea | ea asNode]! ! MCNode subclass: #MCPackageNode instanceVariableNames: 'parent name packageName versions repository repositoryNode' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCPackageNode class methodsFor: 'instance creation' stamp: 'avi 12/7/2007 14:17'! name: aString repository: aRepository ^ self basicNew initializeWithName: aString repository: aRepository! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 11/01/2007 16:33'! addVersion: aVersionNode self versions add: aVersionNode! ! !MCPackageNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! branches | branchDict selector n | selector := name ifNil: [#packageBranch] ifNotNil: [#branch]. branchDict := Dictionary new. self versions do: [:ea | n := ea perform: selector. (branchDict at: n ifAbsentPut: [(MCPackageNode name: n repository: repository) parent: self]) addVersion: ea]. ^ branchDict values asSortedCollection: [:a :b | a name <= b name]! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 02/27/2009 16:41'! browseChanges | patch | patch := self workingCopy changesRelativeToRepository: self repository. patch isNil ifTrue: [^ self]. patch isEmpty ifTrue: [ self workingCopy modified: false. OBInformRequest message: 'No changes' ] ifFalse: [ self workingCopy modified: true. MCPatchTool openRoot: (MCPatchNode new patch: patch; label: self workingCopy packageName; yourself)] ! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:42'! hasAncestry ^ self hasWorkingCopy! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:22'! hasChanges ^ self hasWorkingCopy! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:17'! hasRepository ^ true! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:21'! hasWorkingCopy ^ self workingCopy notNil! ! !MCPackageNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! initializeWithName: aString repository: aRepository name := aString. repository := aRepository! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:28'! name ^name ifNil: ['--not loaded--']! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:37'! name: aString name := aString! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/07/2008 09:02'! packageName ^packageName ifNil: [self name]! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/07/2008 09:02'! packageName: aString packageName := aString! ! !MCPackageNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! parent: aPackageNode parent := aPackageNode! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:17'! repository ^ repository! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:48'! repositoryNode: aNode repositoryNode := aNode! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:53'! sortedVersions | result | result := self versions asSortedCollection: [:a :b | a versionNumber >= b versionNumber ]. ^result := result collect: [ :node | node name: (self versionHighlight: node name asString) ]! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:37'! text ^ self workingCopy ifNotNilDo: [:wc | wc summary]! ! !MCPackageNode methodsFor: 'private' stamp: 'lr 5/27/2009 18:51'! versionHighlight: aString | verName inherited loaded | repositoryNode ifNil: [ ^ aString ]. inherited := repositoryNode inherited. inherited ifNil: [inherited := #()]. loaded := repositoryNode loaded. verName := (aString copyUpToLast: $.) copyUpTo: $(. ^Text string: aString attribute: (TextEmphasis new emphasisCode: ( ((loaded includes: verName) ifTrue: [ 4 "underlined" ] ifFalse: [ (inherited includes: verName) ifTrue: [ 0 ] ifFalse: [ 1 "bold" ] ])))! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 12:04'! versions versions == nil ifTrue: [ versions := OrderedCollection new ]. ^versions! ! !MCPackageNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 14:42'! withBreadthFirstAncestors ^self workingCopy ancestry withBreadthFirstAncestors collect: [:ea | ea asNode ]! ! !MCPackageNode methodsFor: 'accessing' stamp: 'dkh 03/07/2008 09:04'! workingCopy ^ MCWorkingCopy allManagers detect: [:ea | ea package name = self packageName asString] ifNone: [parent ifNotNil: [parent workingCopy]]! ! MCNode subclass: #MCPatchAwareNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCPatchAwareNode subclass: #MCConflictNode instanceVariableNames: 'conflict' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCConflictNode methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 10:19'! conflict ^ conflict! ! !MCConflictNode methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! conflict: aConflict conflict := aConflict! ! !MCConflictNode methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 10:14'! name ^ conflict summary! ! !MCConflictNode methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 10:15'! text ^ conflict source! ! !MCPatchAwareNode methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! install | loader | loader := MCPackageLoader new. self operation applyTo: loader. loader loadWithName: 'Installed Patches'! ! MCPatchAwareNode subclass: #MCPatchOperationNode instanceVariableNames: 'operation' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCPatchOperationNode subclass: #MCBrowseOperationNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCBrowseOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 13:11'! annotationString | def | def := self operation definition. def isMethodDefinition ifFalse: [ ^'' ]. ^(MCDefinitionAnnotationRequest onDefinition: def) getAnnotations! ! !MCBrowseOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:58'! text ^ super text asString! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 01/07/2009 09:55'! annotationString | def | def := self operation definition. def isMethodDefinition ifFalse: [ ^'' ]. ^(OBMessageNode on: def selector inMethod: def selector inClass: def actualClass) annotationString! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/05/2009 15:48'! browse | def | def := self operation definition. def isOrganizationDefinition ifTrue: [ ^nil ]. def isClassDefinition ifTrue: [ ^def actualClass browse ]. (OBMessageNode on: def selector inMethod: def selector inClass: def actualClass) browse! ! !MCPatchOperationNode methodsFor: 'testing' stamp: 'dkh 12/16/2008 12:28'! hasSelector ^self operation definition isMethodDefinition! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'DataCurator 02/05/2009 11:46'! name ^ operation summary! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'avi 12/3/2007 17:04'! operation ^ operation! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! operation: anOperation operation := anOperation! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 12/16/2008 12:27'! selectorAndMessages | def | def := self operation definition. ^{OBMessageNode on: def selector inMethod: def selector inClass: def actualClass }! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 12:45'! text ^ operation source! ! !MCPatchOperationNode methodsFor: 'as yet unclassified' stamp: 'dkh 01/07/2009 09:59'! theClass | def | def := self operation definition. def isOrganizationDefinition ifTrue: [ ^nil ]. ^def actualClass! ! MCNode subclass: #MCPatchNode instanceVariableNames: 'patch label' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCPatchNode subclass: #MCBrowseNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCBrowseNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:58'! label label == nil ifTrue: [ ^'MC Browser' ]. ^'MC Browser: ', label! ! !MCBrowseNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:57'! operationNodeClass ^MCBrowseOperationNode! ! !MCPatchNode methodsFor: 'testing' stamp: 'dkh 12/16/2008 12:44'! hasSelector ^false! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'dkh 02/27/2009 16:38'! label label == nil ifTrue: [ ^'Patch Browser' ]. ^'Patch Browser: ', label! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'dkh 02/27/2009 16:38'! label: aString label := aString! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:56'! operationNodeClass ^MCPatchOperationNode! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:59'! operations ^ patch operations collect: [:ea | self operationNodeClass new operation: ea]! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 18:49'! patch: aPatch patch := aPatch! ! !MCPatchNode methodsFor: 'as yet unclassified' stamp: 'dkh 02/27/2009 16:49'! sortedOperations ^ self operations sortBy: [:a :b | a theClass name <= b theClass name ]! ! MCNode subclass: #MCRepositoryAwareNode instanceVariableNames: 'repository repositoryGroup' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCRepositoryAwareNode class methodsFor: 'instance creation' stamp: 'dkh 09/14/2007 07:29'! on: aRepository ^ self new repository: aRepository; yourself! ! !MCRepositoryAwareNode class methodsFor: 'instance creation' stamp: 'dkh 09/14/2007 07:29'! on: aRepository group: aRepositoryGroup ^ self new repository: aRepository; repositoryGroup: aRepositoryGroup; yourself! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'dkh 02/27/2009 16:41'! browseChanges | patch | patch := self workingCopy changesRelativeToRepository: self repository. patch isNil ifTrue: [^ self]. patch isEmpty ifTrue: [ self workingCopy modified: false. OBInformRequest message: 'No changes' ] ifFalse: [ self workingCopy modified: true. MCPatchTool openRoot: (MCPatchNode new patch: patch; label: self workingCopy packageName; yourself)] ! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'dkh 12/14/2007 15:31'! canAddRepository ^self repositoryGroup notNil! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:34'! hasChanges ^ self hasWorkingCopy! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:21'! hasRepository ^ true! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:31'! hasRepositoryGroup ^self repositoryGroup ~~ nil! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:23'! hasWorkingCopy ^ self workingCopy notNil! ! !MCRepositoryAwareNode methodsFor: 'public' stamp: 'dkh 09/14/2007 07:29'! name ^ repository description! ! !MCRepositoryAwareNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:29'! repository ^ repository ! ! !MCRepositoryAwareNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:29'! repository: aRepository repository := aRepository ! ! !MCRepositoryAwareNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:29'! repositoryGroup ^ repositoryGroup ! ! !MCRepositoryAwareNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:29'! repositoryGroup: aRepositoryGroup repositoryGroup := aRepositoryGroup ! ! !MCRepositoryAwareNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:24'! workingCopy ^ MCWorkingCopy allManagers detect: [:ea | ea repositoryGroup = repositoryGroup] ifNone: []! ! MCRepositoryAwareNode subclass: #MCRepositoryNode instanceVariableNames: 'versions newer loaded inherited packageDictionary' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCRepositoryNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:49'! inherited ^inherited! ! !MCRepositoryNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:50'! loaded ^loaded! ! !MCRepositoryNode methodsFor: 'navigating' stamp: 'lr 5/27/2009 18:49'! packageDictGroupedBy: aSelector | versionNodes packageDict n | versionNodes := self repository versionNodes. packageDict := Dictionary new. versionNodes do: [:ea | n := ea perform: aSelector. n == nil ifTrue: [ n := '--not loaded--' ]. (packageDict at: n ifAbsentPut: [(MCPackageNode name: n repository: repository) packageName: ea packageName; yourself]) addVersion: ea]. ^ packageDict! ! !MCRepositoryNode methodsFor: 'private' stamp: 'dkh 03/11/2008 20:24'! packageHighlight: aString newer ifNil: [newer := #()]. ^(loaded anySatisfy: [:each | (each copyUpToLast: $-) = aString]) ifTrue: [ Text string: aString attribute: (TextEmphasis new emphasisCode: ( ((newer includes: (aString copyUpTo: $.)) ifTrue: [5] ifFalse: [4])))] ifFalse: [aString]! ! !MCRepositoryNode methodsFor: 'navigating' stamp: 'avi 12/7/2007 11:55'! packagesByBranch ^ self packagesGroupedBy: #packageBranch! ! !MCRepositoryNode methodsFor: 'navigating' stamp: 'avi 12/7/2007 11:55'! packagesByName ^ self packagesGroupedBy: #packageName! ! !MCRepositoryNode methodsFor: 'navigating' stamp: 'dkh 03/06/2008 18:52'! packagesGroupedBy: aSelector ^ (self packageDictGroupedBy: aSelector) values asSortedCollection: [:a :b | a name <= b name] ! ! !MCRepositoryNode methodsFor: 'accessing' stamp: 'dkh 03/19/2009 12:03'! packagesHighlighted | result packageDict | versions == nil ifTrue: [ self refresh ]. packageDictionary == nil ifTrue: [ packageDict := Dictionary new. versions do: [:ar | (packageDict at: ar first ifAbsentPut: [(MCPackageNode name: ar first repository: repository) repositoryNode: self; packageName: ar last packageName; yourself]) addVersion: ar last]. packageDictionary := packageDict ]. result := packageDictionary values. "sort loaded packages first, then alphabetically" result := result asSortedCollection: [:a :b | | loadedA loadedB | loadedA := loaded anySatisfy: [:each | (each copyUpToLast: $-) = a name asString ]. loadedB := loaded anySatisfy: [:each | (each copyUpToLast: $-) = b name asString ]. loadedA = loadedB ifTrue: [a name asString < b name asString] ifFalse: [loadedA]]. ^result collect: [:each | each name: (self packageHighlight: each name asString)]! ! !MCRepositoryNode methodsFor: 'actions' stamp: 'dkh 03/19/2009 11:59'! refresh | packageNames name latest av | packageNames := Set new. versions := self repository versionNodes collect: [ :node | | ar | ar := node nameComponents. (ar at: 2) isEmpty ifFalse: [ packageNames add: (ar at: 1) ]. ar]. packageDictionary ~~ nil ifTrue: [ versions do: [:ar | | packageNode | packageNode := packageDictionary at: ar first ifAbsentPut: [(MCPackageNode name: ar first repository: repository) repositoryNode: self; packageName: ar last packageName; yourself]. (packageNode versions includes: ar last) ifFalse: [ packageNode addVersion: ar last ]]]. newer := Set new. inherited := Set new. loaded := Set new. (MCWorkingCopy allManagers " select: [ :each | packageNames includes: each packageName]") do: [:each | each ancestors do: [ :ancestor | loaded add: ancestor name. ancestor ancestorsDoWhileTrue: [:heir | (inherited includes: heir name) ifTrue: [false] ifFalse: [inherited add: heir name. true]]]. latest := (versions select: [:v | (v first copyUpTo: $.) = each package name]) detectMax: [:v | v third]. (latest notNil and: [ each ancestors allSatisfy: [:ancestor | av := [((ancestor name copyAfterLast: $-) copyAfterLast: $.) asInteger] on: Error do: [:ex | ex return: 0]. av < latest third or: [ av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]]) ifTrue: [newer add: each package name ]]. ! ! !MCRepositoryNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 13:09'! text ^self repository description! ! !MCRepositoryNode methodsFor: 'navigating' stamp: 'lr 5/27/2009 18:49'! workingCopyFor: aString | all | all := MCWorkingCopy allManagers select: [:ea | aString beginsWith: ea package name]. all isEmpty ifTrue: [^ nil]. ^ (all detectMax: [:ea | ea package name size])! ! MCNode subclass: #MCVersionDependencyNode instanceVariableNames: 'configuration dependency' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 13:07'! configuration ^configuration! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 13:07'! configuration: anMCConfigurationNode configuration := anMCConfigurationNode! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 12:54'! dependency ^dependency! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 12:54'! dependency: aVersionDependency dependency := aVersionDependency! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 12:56'! name ^self dependency versionInfo name! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 13:09'! repositories ^self configuration repositories! ! !MCVersionDependencyNode methodsFor: 'accessing' stamp: 'dkh 03/04/2008 13:05'! text ^self dependency versionInfo summary! ! MCNode subclass: #MCVersionNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! MCVersionNode subclass: #MCDictionaryBasedVersionNode instanceVariableNames: 'repository versionname' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCDictionaryBasedVersionNode class methodsFor: 'instance creation' stamp: 'dkh 01/09/2008 16:37'! versionName: aString repository: aRepository ^ self basicNew initializeWithVersionName: aString repository: aRepository! ! !MCDictionaryBasedVersionNode methodsFor: 'initialization' stamp: 'lr 5/27/2009 18:49'! initializeWithVersionName: aString repository: aRepository repository := aRepository. versionname := aString! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:51'! name name == nil ifTrue: [ ^versionname ]. ^name! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 03/19/2008 10:40'! nameComponents ^Array with: versionname with: '' with: 0 with: versionname with: self! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:36'! repository ^ repository! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:41'! version ^ self repository versionFromVersionNamed: versionname! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:42'! versionInfo ^ self repository versionInfoFromVersionNamed: versionname! ! !MCDictionaryBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:42'! versionName ^ repository versionNameFromVersionName: versionname! ! MCVersionNode subclass: #MCFileBasedVersionNode instanceVariableNames: 'repository filename' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCFileBasedVersionNode class methodsFor: 'instance creation' stamp: 'avi 12/7/2007 11:39'! fileName: aString repository: aRepository ^ self basicNew initializeWithFileName: aString repository: aRepository! ! !MCFileBasedVersionNode methodsFor: 'initialization' stamp: 'lr 5/27/2009 18:49'! initializeWithFileName: aString repository: aRepository repository := aRepository. filename := aString! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:51'! name name == nil ifTrue: [ ^filename ]. ^name! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'dkh 03/26/2008 09:19'! nameComponents | nm ar | nm := (filename copyUpToLast: $.) copyUpTo: $(. ar := nm last isDigit ifFalse: [Array with: nm with: '' with: 0 with: filename with: self] ifTrue: [ | vrsn str | str := ((nm copyAfterLast: $-) copyAfterLast: $.). vrsn := str isEmpty ifTrue: [0] ifFalse: [str asInteger]. Array with: (nm copyUpToLast: $-) "pkg name" with: ((nm copyAfterLast: $-) copyUpTo: $.) "user" with: vrsn "version" with: filename with: self ]. ^ar! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 11:43'! repository ^ repository! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'avi 12/3/2007 15:05'! version ^ self repository versionFromFileNamed: filename! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'avi 12/4/2007 10:03'! versionInfo ^ self repository versionInfoFromFileNamed: filename! ! !MCFileBasedVersionNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 11:40'! versionName ^ repository versionNameFromFileName: filename! ! !MCVersionNode methodsFor: 'comparing' stamp: 'dkh 03/31/2009 10:29'! = other ^ self class = other class and: [self name asString = other name asString]! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 12/14/2007 11:17'! ancestryNode ^ MCAncestryNode new ancestry: self versionInfo ancestry! ! !MCVersionNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! branch | branch | branch := self packageBranch copyAfter: $.. branch isEmpty ifTrue: [^ ' --trunk--']. ^ branch! ! !MCVersionNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! browseChanges | patch | patch := self version changes. patch isEmpty ifTrue: [OBInformRequest message: 'No changes' ] ifFalse: [MCPatchTool openRoot: (MCPatchNode new patch: patch; label: self version info name; yourself)]! ! !MCVersionNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:44'! browseCode | patch | patch := self version definitionsAsChanges. patch isNil ifTrue: [^ self]. MCBrowseTool openRoot: (MCBrowseNode new patch: patch; label: self version info name; yourself) ! ! !MCVersionNode methodsFor: 'testing' stamp: 'dkh 03/19/2009 12:46'! canBeBrowsed ^ true! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 13:05'! hasAncestry ^ true! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 13:34'! hasChanges ^ true! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/7/2007 13:11'! hasVersion ^ true! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/5/2007 16:30'! isVersionNode ^ true! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:32'! name self subclassResponsibility! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 03/06/2008 19:51'! name: aString name := aString! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:32'! packageBranch ^ ((self versionName copyUpToLast: $.) copyUpToLast: $-)! ! !MCVersionNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:49'! packageName | allNames candidates | allNames := MCWorkingCopy allManagers collect: [:ea | ea package name]. candidates := allNames select: [:ea | self name asString beginsWith: ea]. candidates isEmpty ifTrue: [^ nil]. ^ candidates detectMax: [:ea | ea size]! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/4/2007 10:03'! text ^ self versionInfo summary! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:33'! versionName self subclassResponsibility! ! !MCVersionNode methodsFor: 'accessing' stamp: 'dkh 01/09/2008 16:34'! versionNumber ^ [(self versionName copyAfterLast: $.) asNumber] ifError: [0]! ! !MCVersionNode methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:58'! withBreadthFirstAncestors ^self versionInfo withBreadthFirstAncestors collect: [:ea | ea asNode ]! ! MCNode subclass: #MCWorkingCopyNode instanceVariableNames: 'package workingCopy' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Nodes'! !MCWorkingCopyNode class methodsFor: 'instance creation' stamp: 'dkh 09/14/2007 07:57'! on: aWorkingCopy ^ self new workingCopy: aWorkingCopy; yourself! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'dkh 12/14/2007 11:17'! ancestryNode ^ MCAncestryNode new ancestry: self workingCopy ancestry! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'lr 5/27/2009 18:44'! browseCode | patch | patch := self workingCopy definitionsAsChanges. patch isNil ifTrue: [^ self]. MCBrowseTool openRoot: (MCBrowseNode new patch: patch; label: self workingCopy packageName; yourself) ! ! !MCWorkingCopyNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:57'! canAddRepository ^true! ! !MCWorkingCopyNode methodsFor: 'testing' stamp: 'dkh 09/14/2007 07:57'! canBeBrowsed ^ true! ! !MCWorkingCopyNode methodsFor: 'changes' stamp: 'dkh 11/05/2007 09:13'! changesRelativeToRepository: aReposistoryNode ^self workingCopy changesRelativeToRepository: aReposistoryNode repository. ! ! !MCWorkingCopyNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:05'! hasAncestry ^ true! ! !MCWorkingCopyNode methodsFor: 'testing' stamp: 'avi 12/7/2007 13:05'! hasWorkingCopy ^ true! ! !MCWorkingCopyNode methodsFor: 'testing' stamp: 'avi 12/5/2007 16:30'! isWorkingCopyNode ^ true! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'dkh 11/05/2007 09:20'! modified: aBool self workingCopy modified: aBool. self signalChanged! ! !MCWorkingCopyNode methodsFor: 'public' stamp: 'avi 12/4/2007 15:52'! name ^ self workingCopy packageName! ! !MCWorkingCopyNode methodsFor: 'public' stamp: 'dkh 09/14/2007 07:57'! packageName ^self workingCopy package name! ! !MCWorkingCopyNode methodsFor: 'navigating' stamp: 'dkh 09/14/2007 07:57'! repositories | rg | rg := self repositoryGroup. ^ rg repositories collect: [:ea | | node | node := ea asNode. node repositoryGroup: rg. node]! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:57'! repositoryGroup ^self workingCopy repositoryGroup! ! !MCWorkingCopyNode methodsFor: 'public' stamp: 'avi 12/7/2007 14:36'! text ^ self workingCopy summary! ! !MCWorkingCopyNode methodsFor: 'navigating' stamp: 'dkh 09/14/2007 07:57'! withBreadthFirstAncestors ^self workingCopy ancestry withBreadthFirstAncestors collect: [:ea | ea asNode ]! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:57'! workingCopy ^workingCopy! ! !MCWorkingCopyNode methodsFor: 'accessing' stamp: 'dkh 09/14/2007 07:57'! workingCopy: aWorkingCopy workingCopy := aWorkingCopy! ! !MCHttpRepository class methodsFor: '*ob-monticello' stamp: 'dkh 12/20/2008 10:03'! obConfigureFromTemplate: aString | chunk repo | chunk := OBMultiLineTextRequest prompt: self fillInTheBlankRequest template: (aString ifNil: [self creationTemplate]). chunk ifNotNil: [ chunk isEmpty ifTrue: [ ^nil ]. repo := self readFrom: chunk readStream. repo creationTemplate: chunk. ]. ^ repo! ! OBAnnotationRequest subclass: #MCDefinitionAnnotationRequest instanceVariableNames: 'definition' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Other'! !MCDefinitionAnnotationRequest class methodsFor: 'instance-creation' stamp: 'dkh 03/19/2009 13:06'! onDefinition: aDefinition ^self new onDefinition: aDefinition; yourself! ! !MCDefinitionAnnotationRequest methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 13:09'! messageCategory ^ definition category! ! !MCDefinitionAnnotationRequest methodsFor: 'initialize-release' stamp: 'dkh 03/19/2009 13:13'! onDefinition: aDefinition definition := aDefinition. separator := ' ¥ '.! ! !MCDefinitionAnnotationRequest methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 13:12'! timeStamp ^ definition timeStamp! ! !MCDictionaryRepository methodsFor: '*ob-monticello' stamp: 'dkh 01/09/2008 16:46'! versionNodes ^ self dictionary keys collect: [:versionInfo | MCDictionaryBasedVersionNode versionName: versionInfo name repository: self] ! ! !MCRepository class methodsFor: '*ob-monticello' stamp: 'avi 12/5/2007 11:03'! obConfigure ^ self obConfigureFromTemplate: nil! ! !MCRepository methodsFor: '*ob-monticello' stamp: 'dkh 12/14/2007 11:19'! asNode ^ MCRepositoryNode on: self! ! !MCRepository methodsFor: '*ob-monticello' stamp: 'avi 12/5/2007 11:08'! obConfigure ^ self class obConfigureFromTemplate: self asCreationTemplate! ! !MCRepository methodsFor: '*ob-monticello' stamp: 'dkh 11/01/2007 16:01'! packageNodes self subclassResponsibility! ! OBCommand subclass: #MCCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCCommand subclass: #MCAdminCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCAdminCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 15:10'! group ^ #admin! ! MCAdminCommand subclass: #MCCmdNewPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdNewPackage methodsFor: 'execution' stamp: 'dkh 09/13/2007 13:37'! execute | name workingCopy | name := OBTextRequest prompt: 'Name of package:' template: ''. name isEmptyOrNil ifFalse: [PackageInfo registerPackageName: name. workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name). self refresh].! ! !MCCmdNewPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:12'! label ^ 'add package'! ! !MCCmdNewPackage methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:07'! wantsButton ^ true! ! MCAdminCommand subclass: #MCCmdNewRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdNewRepository methodsFor: 'execution' stamp: 'dkh 02/27/2008 14:13'! execute | types labels cls repos | types := MCRepository allConcreteSubclasses asArray. labels := types collect: [:ea | ea description]. cls := OBChoiceRequest prompt: 'Repository type:' labels: labels values: types. cls == nil ifTrue: [ ^self ]. repos := cls obConfigure. repos ~~ nil ifTrue: [ target repositoryGroup addRepository: repos ]. self refresh! ! !MCCmdNewRepository methodsFor: 'testing' stamp: 'avi 12/4/2007 15:14'! isActive ^ super isActive and: [target canAddRepository]! ! !MCCmdNewRepository methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:12'! label ^ 'add repository'! ! !MCCmdNewRepository methodsFor: 'testing' stamp: 'dkh 12/14/2007 15:21'! wantsButton ^ true! ! MCCommand subclass: #MCCmdBrowsePackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdBrowsePackage methodsFor: 'execution' stamp: 'dkh 03/19/2009 12:39'! execute target browseCode! ! !MCCmdBrowsePackage methodsFor: 'testing' stamp: 'avi 12/4/2007 15:00'! isActive ^ super isActive and: [target canBeBrowsed]! ! !MCCmdBrowsePackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:12'! label ^ 'browse'! ! !MCCmdBrowsePackage methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:05'! wantsButton ^ true! ! MCCommand subclass: #MCCmdChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdChanges methodsFor: 'execution' stamp: 'dkh 01/07/2009 17:40'! execute target browseChanges. self refresh! ! !MCCmdChanges methodsFor: 'testing' stamp: 'avi 12/7/2007 13:33'! isActive ^ target hasChanges and: [requestor isSelected: target]! ! !MCCmdChanges methodsFor: 'accessing' stamp: 'avi 12/7/2007 13:33'! label ^ 'changes'! ! !MCCmdChanges methodsFor: 'testing' stamp: 'avi 12/7/2007 13:33'! wantsButton ^ true! ! MCCommand subclass: #MCCmdHistory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdHistory methodsFor: 'executing' stamp: 'dkh 03/18/2009 14:09'! execute MCVersionHistoryTool openOnPackage: target copy! ! !MCCmdHistory methodsFor: 'testing' stamp: 'avi 12/7/2007 13:25'! isActive ^ target hasAncestry and: [requestor isSelected: target]! ! !MCCmdHistory methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:15'! label ^ 'history'! ! !MCCmdHistory methodsFor: 'testing' stamp: 'dkh 09/13/2007 15:27'! wantsButton ^ true! ! MCCommand subclass: #MCCmdInspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdInspect methodsFor: 'as yet unclassified' stamp: 'dkh 9/12/2007 16:06'! execute target inspect! ! !MCCmdInspect methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:51'! group ^ #zinspect! ! !MCCmdInspect methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:51'! label ^ 'inspect'! ! MCCommand subclass: #MCCmdInstallOperation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdInstallOperation methodsFor: 'as yet unclassified' stamp: 'lr 5/27/2009 19:00'! execute target install. OBPlatform doAutoCommit! ! !MCCmdInstallOperation methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 12:51'! label ^ 'install'! ! !MCCmdInstallOperation methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:18'! targetClass ^ MCPatchAwareNode! ! !MCCmdInstallOperation methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 12:50'! wantsButton ^ true! ! MCCommand subclass: #MCCmdRefresh instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRefresh methodsFor: 'as yet unclassified' stamp: 'dkh 03/19/2009 12:04'! execute self refresh. ! ! !MCCmdRefresh methodsFor: 'as yet unclassified' stamp: 'dkh 03/08/2008 23:19'! isActive ^ (target hasRepository or: [target hasVersion]) and: [requestor isSelected: target]! ! !MCCmdRefresh methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 12:53'! label ^ 'refresh'! ! !MCCmdRefresh methodsFor: 'as yet unclassified' stamp: 'avi 12/5/2007 12:55'! wantsButton ^ true! ! !MCCommand methodsFor: 'testing' stamp: 'avi 12/4/2007 17:02'! execute self halt! ! !MCCommand methodsFor: 'testing' stamp: 'avi 12/4/2007 15:36'! isActive ^ (target isKindOf: self targetClass) and: [self targetMustBeSelected not or: [requestor isSelected: target]]! ! !MCCommand methodsFor: 'actions' stamp: 'dkh 03/05/2008 10:50'! pickRepository ^self pickRepositorySatisfying: [:ea | true] ! ! !MCCommand methodsFor: 'actions' stamp: 'dkh 03/05/2008 10:50'! pickRepositorySatisfying: aBlock | list | list := MCRepositoryGroup default repositories select: aBlock. ^OBChoiceRequest prompt: 'Repository:' labels: (list collect: [:ea | ea description]) values: list. ! ! !MCCommand methodsFor: 'actions' stamp: 'lr 5/27/2009 18:49'! pickWorkingCopiesSatisfying: aBlock | copies item | copies := (MCWorkingCopy allManagers select: aBlock) asSortedCollection: [:a :b | a packageName <= b packageName]. item := OBChoiceRequest prompt: 'Package:' labels: #('match ...'),(copies collect: [:ea | ea packageName]) values: #(match), copies. item == #match ifTrue: [ | pattern | pattern := OBTextRequest prompt: 'Packages matching:' template: '*'. ^pattern isEmptyOrNil ifTrue: [#()] ifFalse: [ (pattern includes: $*) ifFalse: [pattern := '*', pattern, '*']. copies select: [:ea | pattern match: ea packageName]] ]. ^ item == nil ifTrue: [#()] ifFalse: [{item}]! ! !MCCommand methodsFor: 'actions' stamp: 'avi 12/5/2007 11:16'! pickWorkingCopySatisfying: aBlock | workingCopies | workingCopies := self workingCopies select: aBlock. workingCopies isEmpty ifTrue: [ ^nil ]. ^OBChoiceRequest prompt: 'Package:' labels: (workingCopies collect: [:ea | ea packageName]) values: workingCopies.! ! !MCCommand methodsFor: 'actions' stamp: 'lr 5/27/2009 19:01'! refresh requestor announcer announce: OBRefreshRequired. self shouldAutoCommit ifTrue: [ OBPlatform doAutoCommit ].! ! !MCCommand methodsFor: 'testing' stamp: 'dkh 04/17/2008 12:02'! shouldAutoCommit ^true! ! !MCCommand methodsFor: 'testing' stamp: 'dkh 12/14/2007 15:25'! targetClass ^ MCNode! ! !MCCommand methodsFor: 'actions' stamp: 'avi 12/5/2007 11:10'! targetDefinitionChanged requestor announce: (OBDefinitionChanged definition: target definition)! ! !MCCommand methodsFor: 'testing' stamp: 'avi 12/4/2007 14:57'! targetMustBeSelected ^ true! ! !MCCommand methodsFor: 'actions' stamp: 'avi 12/5/2007 11:09'! targetNodeChanged requestor announce: (OBNodeChanged node: target)! ! !MCCommand methodsFor: 'actions' stamp: 'avi 12/5/2007 11:18'! workingCopies ^(MCWorkingCopy allManagers asSortedCollection: [ :a :b | a package name <= b package name ]) ! ! MCCommand subclass: #MCMergeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCMergeCommand subclass: #MCCmdFinishMerge instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdFinishMerge methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute requestor browser root versionMerger loadWithNameLike: nil. requestor browser close. OBPlatform doAutoCommit! ! !MCCmdFinishMerge methodsFor: 'testing' stamp: 'dkh 03/06/2008 12:17'! isActive ^ requestor browser root isMerged! ! !MCCmdFinishMerge methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:51'! label ^ 'finish merge'! ! !MCCmdFinishMerge methodsFor: 'testing' stamp: 'avi 12/4/2007 12:14'! versionMerger ^ requestor browser root versionMerger! ! !MCCmdFinishMerge methodsFor: 'testing' stamp: 'avi 12/4/2007 10:24'! wantsButton ^ true! ! MCMergeCommand subclass: #MCCmdKeepConflict instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdKeepConflict methodsFor: 'execution' stamp: 'avi 12/5/2007 11:10'! execute target conflict chooseRemote. self targetNodeChanged. self targetDefinitionChanged! ! !MCCmdKeepConflict methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:51'! group ^ #conflicts! ! !MCCmdKeepConflict methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:51'! label ^ 'keep'! ! !MCCmdKeepConflict methodsFor: 'testing' stamp: 'avi 12/4/2007 10:16'! wantsButton ^ true! ! MCMergeCommand subclass: #MCCmdRejectConflict instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRejectConflict methodsFor: 'execution' stamp: 'avi 12/5/2007 11:10'! execute target conflict chooseLocal. self targetNodeChanged. self targetDefinitionChanged! ! !MCCmdRejectConflict methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:51'! group ^ #conflicts! ! !MCCmdRejectConflict methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:51'! label ^ 'reject'! ! !MCCmdRejectConflict methodsFor: 'testing' stamp: 'avi 12/4/2007 10:17'! wantsButton ^ true! ! !MCMergeCommand methodsFor: 'testing' stamp: 'dkh 04/17/2008 12:06'! shouldAutoCommit ^false! ! !MCMergeCommand methodsFor: 'as yet unclassified' stamp: 'dkh 12/14/2007 11:18'! targetClass ^ MCConflictNode! ! MCCommand subclass: #MCRepositoryCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCRepositoryCommand subclass: #MCCmdAddRepositoryToPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdAddRepositoryToPackage methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute (self pickWorkingCopySatisfying: [ :p | (p repositoryGroup includes: self repository) not ]) ifNotNilDo: [:wc | wc repositoryGroup addRepository: self repository. OBPlatform doAutoCommit]! ! !MCCmdAddRepositoryToPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:52'! label ^ 'add repository to package'! ! MCRepositoryCommand subclass: #MCCmdEditRepositoryInfo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdEditRepositoryInfo methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute | newRepo | newRepo := target repository obConfigure. newRepo ifNotNil: [ newRepo class = self repository class ifTrue: [ self repository copyFrom: newRepo. OBPlatform doAutoCommit] ifFalse: [OBInformRequest message: 'Must not change repository type!!']]. self targetNodeChanged! ! !MCCmdEditRepositoryInfo methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:56'! label ^ 'edit repository info'! ! MCRepositoryCommand subclass: #MCCmdFlushAllCaches instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdFlushAllCaches methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute MCRepositoryGroup default repositoriesDo: [:rep | rep flushCache ]. OBPlatform doAutoCommit! ! !MCCmdFlushAllCaches methodsFor: 'accessing' stamp: 'dkh 02/22/2008 13:44'! label ^ 'flush all caches'! ! MCRepositoryCommand subclass: #MCCmdOpenRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdOpenRepository methodsFor: 'execution' stamp: 'dkh 03/18/2009 14:11'! execute MCRepositoryBrowser openRoot: target copy! ! !MCCmdOpenRepository methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:55'! label ^ 'open'! ! !MCCmdOpenRepository methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:07'! wantsButton ^ true! ! !MCRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:51'! group ^ #repository! ! !MCRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/7/2007 13:13'! isActive ^ target hasRepository and: [requestor isSelected: target]! ! !MCRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:52'! repository ^target repository! ! MCCommand subclass: #MCVersionCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCVersionCommand subclass: #MCCmdAdopt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdAdopt methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute target version adopt. OBPlatform doAutoCommit! ! !MCCmdAdopt methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:52'! label ^ 'adopt'! ! MCVersionCommand subclass: #MCCmdCopy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdCopy methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute self pickRepository ifNotNilDo: [:ea | ea storeVersion: target version. OBPlatform doAutoCommit]! ! !MCCmdCopy methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'copy to another repository'! ! !MCCmdCopy methodsFor: 'execution' stamp: 'dkh 12/14/2007 15:06'! pickRepository | repos labels | repos := MCRepositoryGroup default repositories. labels := repos collect: [:ea | ea description]. ^OBChoiceRequest prompt: 'Copy to:' labels: labels values: repos! ! MCVersionCommand subclass: #MCCmdLoad instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdLoad methodsFor: 'execution' stamp: 'dkh 04/17/2008 12:02'! execute | version | version := target version. version load. version workingCopy repositoryGroup addRepository: target repository. self refresh! ! !MCCmdLoad methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'load'! ! !MCCmdLoad methodsFor: 'accessing' stamp: 'dkh 9/12/2007 16:06'! longDescription ^ 'Erases all modifications made on your image for this package and load the selected version from the repository'! ! !MCCmdLoad methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:06'! wantsButton ^ true! ! MCVersionCommand subclass: #MCCmdMerge instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdMerge methodsFor: 'execution' stamp: 'lr 5/27/2009 18:49'! execute | versionMerger | versionMerger := MCVersionMerger new addVersion: target version. versionMerger applyRecords. versionMerger isAncestorMerge ifTrue: [^ OBInformRequest message: 'No changes']. MCMergeTool openRoot: (MCVersionMergerNode new versionMerger: versionMerger). ! ! !MCCmdMerge methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'merge'! ! !MCCmdMerge methodsFor: 'accessing' stamp: 'dkh 9/12/2007 16:06'! longDescription ^ 'Displays the differences between what is in the repository and your image. Allows you to install some or all of the changes into your image.'! ! !MCCmdMerge methodsFor: 'testing' stamp: 'dkh 9/12/2007 16:06'! wantsButton ^ true! ! !MCVersionCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/7/2007 13:13'! isActive ^ target hasVersion and: [requestor isSelected: target]! ! MCCommand subclass: #MCWorkingCopyCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCWorkingCopyCommand subclass: #MCCmdAddRequiredPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdAddRequiredPackage methodsFor: 'execution' stamp: 'dkh 02/12/2008 15:52'! execute (self pickWorkingCopySatisfying: [:aWorkingCopy | self selectWorkingCopyAsRequiredCandidate: aWorkingCopy]) ifNotNilDo: [:wc | target workingCopy requirePackage: wc package. self refresh]! ! !MCCmdAddRequiredPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:54'! group ^ #requiredPackages! ! !MCCmdAddRequiredPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'add required package'! ! !MCCmdAddRequiredPackage methodsFor: 'private' stamp: 'dkh 03/31/2009 10:45'! selectWorkingCopyAsRequiredCandidate: aWorkingCopy | wc package aPackage seen remaining packages | wc := target workingCopy. aPackage := aWorkingCopy package. (wc requiredPackages includes: aPackage) ifTrue: [ ^false ]. package := wc package. (package = aPackage) ifTrue: [ ^false ]. "check for requiredPackages cycles" seen := IdentitySet new. packages := aWorkingCopy requiredPackages. [ | newPackages | newPackages := IdentitySet new. packages do: [:pkg | pkg = package ifTrue: [ ^false ]. (seen includes: pkg) ifFalse: [ newPackages addAll: pkg workingCopy requiredPackages ]. seen add: pkg ]. packages := newPackages. packages isEmpty] untilTrue. ^true! ! !MCCmdAddRequiredPackage methodsFor: 'testing' stamp: 'dkh 12/14/2007 11:21'! targetClass ^ MCWorkingCopyNode! ! MCWorkingCopyCommand subclass: #MCCmdClearRequiredPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdClearRequiredPackage methodsFor: 'execution' stamp: 'avi 12/5/2007 11:14'! execute target workingCopy clearRequiredPackages. self refresh! ! !MCCmdClearRequiredPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! group ^ #requiredPackages! ! !MCCmdClearRequiredPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'clear required package'! ! !MCCmdClearRequiredPackage methodsFor: 'testing' stamp: 'dkh 12/14/2007 11:21'! targetClass ^ MCWorkingCopyNode! ! MCWorkingCopyCommand subclass: #MCCmdDeleteWorkingCopy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdDeleteWorkingCopy methodsFor: 'execution' stamp: 'avi 12/5/2007 09:40'! execute target workingCopy unregister. self refresh! ! !MCCmdDeleteWorkingCopy methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'delete working copy'! ! MCWorkingCopyCommand subclass: #MCCmdRecompilePackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRecompilePackage methodsFor: 'execution' stamp: 'lr 5/27/2009 19:00'! execute target workingCopy package packageInfo methods do: [:ea | ea actualClass recompile: ea methodSymbol]. OBPlatform doAutoCommit! ! !MCCmdRecompilePackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'recompile package'! ! MCWorkingCopyCommand subclass: #MCCmdRemoveRequiredPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRemoveRequiredPackage methodsFor: 'execution' stamp: 'dkh 01/15/2008 11:22'! execute self pickRequiredPackage ifNotNilDo: [:required | target workingCopy requiredPackages remove: required. self refresh]! ! !MCCmdRemoveRequiredPackage methodsFor: 'accessing' stamp: 'dkh 01/15/2008 11:21'! group ^ #requiredPackages! ! !MCCmdRemoveRequiredPackage methodsFor: 'accessing' stamp: 'dkh 01/15/2008 11:21'! label ^ 'remove required package'! ! !MCCmdRemoveRequiredPackage methodsFor: 'actions' stamp: 'dkh 01/15/2008 11:26'! pickRequiredPackage | required | required := target workingCopy requiredPackages. required isEmpty ifTrue: [ ^nil ]. ^OBChoiceRequest prompt: 'Package:' labels: (required collect: [:ea | ea name]) values: required.! ! !MCCmdRemoveRequiredPackage methodsFor: 'testing' stamp: 'dkh 01/15/2008 11:21'! targetClass ^ MCWorkingCopyNode! ! MCWorkingCopyCommand subclass: #MCCmdUnloadPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdUnloadPackage methodsFor: 'execution' stamp: 'dkh 03/04/2009 15:21'! execute (self confirm: 'Are you sure you want to unload this package?') ~~ true ifTrue: [ ^self ]. target workingCopy unload. self refresh! ! !MCCmdUnloadPackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:53'! label ^ 'unload package'! ! !MCWorkingCopyCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:53'! group ^ #workingCopy! ! !MCWorkingCopyCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/7/2007 13:12'! isActive ^ target hasWorkingCopy and: [requestor isSelected: target]! ! MCCommand subclass: #MCWorkingCopyRepositoryCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! MCWorkingCopyRepositoryCommand subclass: #MCCmdRemoveRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRemoveRepository methodsFor: 'execution' stamp: 'avi 12/5/2007 10:52'! execute target repositoryGroup removeRepository: target repository. self refresh! ! !MCCmdRemoveRepository methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:54'! group ^ #repository! ! !MCCmdRemoveRepository methodsFor: 'testing' stamp: 'dkh 04/14/2009 14:29'! isActive ^ ((target hasWorkingCopy and: [target hasRepository]) or: [ target canAddRepository]) and: [requestor isSelected: target]! ! !MCCmdRemoveRepository methodsFor: 'accessing' stamp: 'dkh 9/12/2007 16:07'! keystroke ^ $x! ! !MCCmdRemoveRepository methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:54'! label ^ 'remove repository'! ! MCWorkingCopyRepositoryCommand subclass: #MCCmdRevertPackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdRevertPackage methodsFor: 'execution' stamp: 'dkh 03/09/2008 17:25'! execute self pickAncestorVersionInfo ifNotNilDo: [:info | (self repositoryGroup versionWithInfo: info ifNone: [^self inform: 'No repository found for ', info name] ) load]. self refresh! ! !MCCmdRevertPackage methodsFor: 'accessing' stamp: 'dkh 02/22/2008 13:10'! label ^ 'revert package...'! ! !MCCmdRevertPackage methodsFor: 'private' stamp: ''! pickAncestorVersionInfo | ancestors index | ancestors := self workingCopy ancestry breadthFirstAncestors. ^OBChoiceRequest prompt: 'Package:' labels: (ancestors collect: [:ea | ea name]) values: ancestors. ! ! MCWorkingCopyRepositoryCommand subclass: #MCCmdSavePackage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Monticello-Commands'! !MCCmdSavePackage methodsFor: 'private' stamp: 'dkh 02/22/2008 12:48'! checkForNewerVersions | newer | newer := self workingCopy possiblyNewerVersionsIn: self repository. ^ newer isEmpty or: [ | list | list := String streamContents: [:stream | newer do: [:ea | stream nextPutAll: ea, String cr]]. self confirm: 'CAUTION!! These versions in the repository may be newer:', String cr, list, 'Do you really want to save this version?'].! ! !MCCmdSavePackage methodsFor: 'execution' stamp: 'lr 5/27/2009 18:49'! execute | version v m | self checkForNewerVersions == true ifFalse: [^self]. [version := self workingCopy newVersion] on: MCVersionNameAndMessageRequest do: [:n | v := OBTextRequest prompt: 'Please enter a name for your version:' template: n suggestedName. [ v == nil ifTrue: [ n resume: nil ]. v = (v encodeForHTTP) ] whileFalse: [ v := OBTextRequest prompt: (v encodeForHTTP) printString, ' contains illegal characters. Please enter a valid name for your version:' template: n suggestedName ]. m := OBMultiLineTextRequest prompt: 'Please enter a commit message:'. (m ~~ nil and: [ m isEmpty not ]) ifTrue: [ n resume: {v. m} ]. n resume: nil]. version ifNotNil: [self repository storeVersion: version. version allDependenciesDo: [:dep | (self repository includesVersionNamed: dep info name) ifFalse: [self repository storeVersion: dep]]]. self refresh! ! !MCCmdSavePackage methodsFor: 'accessing' stamp: 'avi 12/4/2007 16:54'! label ^ 'save'! ! !MCCmdSavePackage methodsFor: 'testing' stamp: 'dkh 09/12/2007 20:08'! wantsButton ^ true! ! !MCWorkingCopyRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 16:54'! group ^ #workingCopy! ! !MCWorkingCopyRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'dkh 03/17/2009 16:52'! isActive ^ target hasWorkingCopy and: [target hasRepository] and: [requestor isSelected: target]! ! !MCWorkingCopyRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/4/2007 15:43'! repository ^ target repository! ! !MCWorkingCopyRepositoryCommand methodsFor: 'private' stamp: 'dkh 02/22/2008 13:15'! repositoryGroup ^self workingCopy repositoryGroup! ! !MCWorkingCopyRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 12/7/2007 13:23'! workingCopy ^ target workingCopy! ! !MCAncestry methodsFor: '*ob-monticello' stamp: 'dkh 12/14/2007 11:17'! asNode ^MCAncestryNode on: self! ! !MCVersionMerger methodsFor: '*ob-monticello' stamp: 'avi 12/3/2007 16:31'! applyRecords records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]! ! !MCVersionMerger methodsFor: '*ob-monticello' stamp: 'avi 12/3/2007 16:33'! isAncestorMerge ^ records allSatisfy: [:ea | ea isAncestorMerge]! ! !MCVersionMerger methodsFor: '*ob-monticello' stamp: 'avi 12/3/2007 16:32'! loadWithNameLike: aString aString ifNil: [merger load] ifNotNil: [merger loadWithNameLike: aString]. records do: [:ea | ea updateWorkingCopy]! ! !MCVersionMerger methodsFor: '*ob-monticello' stamp: 'avi 12/3/2007 16:51'! mergeTitle ^ 'Merging ', records first version info name! ! !MCVersionMerger methodsFor: '*ob-monticello' stamp: 'avi 12/3/2007 17:06'! merger ^ merger! !