'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 30 June 2005 at 11:11:20 pm'! "Change Set: Monticello-bf.261 Date: 30 June 2005 Author: Doug Way Initial Monticello install, based on Monticello-bf.261.mcz from http://source.impara.de."! Object subclass: #MCAncestry instanceVariableNames: 'ancestors stepChildren' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! !MCAncestry commentStamp: '' prior: 0! Abstract superclass of records of ancestry.! Notification subclass: #MCChangeSelectionRequest instanceVariableNames: 'patch label' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Object subclass: #MCConflict instanceVariableNames: 'operation chooseRemote' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Merging'! Object subclass: #MCDefinition instanceVariableNames: '' classVariableNames: 'Instances' poolDictionaries: '' category: 'Monticello-Base'! MCDefinition subclass: #MCClassDefinition instanceVariableNames: 'name superclassName variables category type comment commentStamp' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! Object subclass: #MCDefinitionIndex instanceVariableNames: 'definitions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Object subclass: #MCDependencySorter instanceVariableNames: 'required provided orderedItems' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Loading'! TestCase subclass: #MCDependencySorterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! ListItemWrapper subclass: #MCDependentsWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! PackageInfo subclass: #MCDirtyPackageInfo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object subclass: #MCDoItParser instanceVariableNames: 'source' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Chunk Format'! PackageInfo subclass: #MCEmptyPackageInfo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object subclass: #MCMergeRecord instanceVariableNames: 'version packageSnapshot ancestorInfo ancestor ancestorSnapshot imagePatch mergePatch' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Notification subclass: #MCMergeResolutionRequest instanceVariableNames: 'merger' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Object subclass: #MCMerger instanceVariableNames: 'conflicts' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Merging'! MCDefinition subclass: #MCMethodDefinition instanceVariableNames: 'classIsMeta source category selector className timeStamp' classVariableNames: 'Definitions' poolDictionaries: '' category: 'Monticello-Modeling'! Object subclass: #MCMock instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! SharedPool subclass: #MCMockAPoolDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object subclass: #MCMockClassD instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object variableSubclass: #MCMockClassE instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object subclass: #MCMockClassF instanceVariableNames: '' classVariableNames: 'Foo' poolDictionaries: '' category: 'Monticello-Mocks'! Object variableWordSubclass: #MCMockClassG instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object variableByteSubclass: #MCMockClassH instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object weakSubclass: #MCMockClassI instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! MCDefinition subclass: #MCMockDefinition instanceVariableNames: 'token' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Object subclass: #MCMockDependency instanceVariableNames: 'name children hasResolution' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! PackageInfo subclass: #MCMockPackageInfo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Mocks'! Exception subclass: #MCNoChangesException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCDefinition subclass: #MCOrganizationDefinition instanceVariableNames: 'categories' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! Object subclass: #MCPackage instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Base'! Object subclass: #MCPackageCache instanceVariableNames: 'sorter fileNames' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! Object subclass: #MCPackageLoader instanceVariableNames: 'requirements unloadableDefinitions obsoletions additions removals errorDefinitions provisions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Loading'! Object subclass: #MCPackageManager instanceVariableNames: 'package modified' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCPackageManager class instanceVariableNames: 'registry'! Object subclass: #MCPatch instanceVariableNames: 'operations' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Object subclass: #MCPatcher instanceVariableNames: 'definitions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Object subclass: #MCPatchOperation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! MCPatchOperation subclass: #MCAddition instanceVariableNames: 'definition' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! MCPatchOperation subclass: #MCModification instanceVariableNames: 'obsoletion modification' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Object subclass: #MCReader instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCPatchOperation subclass: #MCRemoval instanceVariableNames: 'definition' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Object subclass: #MCRepository instanceVariableNames: 'creationTemplate storeDiffs' classVariableNames: 'Settings' poolDictionaries: '' category: 'Monticello-Repositories'! MCRepository subclass: #MCDictionaryRepository instanceVariableNames: 'description dict' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCRepository subclass: #MCFileBasedRepository instanceVariableNames: 'cache' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCFileBasedRepository subclass: #MCDirectoryRepository instanceVariableNames: 'directory' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCDirectoryRepository subclass: #MCCacheRepository instanceVariableNames: 'packageCaches seenFiles' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCFileBasedRepository subclass: #MCFtpRepository instanceVariableNames: 'host directory user password connection' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCRepository subclass: #MCGOODSRepository instanceVariableNames: 'hostname port connection' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCFileBasedRepository subclass: #MCHttpRepository instanceVariableNames: 'location user password' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCCacheRepository class instanceVariableNames: 'default'! Object subclass: #MCRepositoryGroup instanceVariableNames: 'repositories' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! !MCRepositoryGroup commentStamp: '' prior: 0! A singleton class, holds the list of repositories. Can look for a requested VersionInfo among its repositories.! MCRepositoryGroup class instanceVariableNames: 'default'! Object subclass: #MCScanner instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Chunk Format'! MCDefinition subclass: #MCScriptDefinition instanceVariableNames: 'script packageName' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCScriptDefinition subclass: #MCPostscriptDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCScriptDefinition subclass: #MCPreambleDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCScriptDefinition subclass: #MCRemovalPostscriptDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCScriptDefinition subclass: #MCRemovalPreambleDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCFileBasedRepository subclass: #MCSMCacheRepository instanceVariableNames: 'smCache' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! !MCSMCacheRepository commentStamp: 'nk 1/23/2004 09:57' prior: 0! I am a Monticello repository that reflects the caching of SqueakMap v2. I refer write attempts to the default MCCacheRepository.! Object subclass: #MCSnapshot instanceVariableNames: 'definitions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Base'! MCReader subclass: #MCSnapshotReader instanceVariableNames: 'definitions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! TestResource subclass: #MCSnapshotResource instanceVariableNames: 'snapshot' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! TestCase subclass: #MCSortingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCSnapshotReader subclass: #MCStReader instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Chunk Format'! MCDirectoryRepository subclass: #MCSubDirectoryRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! !MCSubDirectoryRepository commentStamp: 'nk 6/11/2004 18:56' prior: 0! A MCDirectoryRepository that looks in subdirectories too.! MCDoItParser subclass: #MCSystemCategoryParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Chunk Format'! TestCase subclass: #MCTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCAncestryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCChangeNotificationTest instanceVariableNames: 'workingCopy' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCClassDefinitionTest instanceVariableNames: 'previousChangeSet' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCFileInTest instanceVariableNames: 'stream expected diff' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCInitializationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCMczInstallerTest instanceVariableNames: 'expected diff' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCMergingTest instanceVariableNames: 'conflictBlock conflicts' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCMethodDefinitionTest instanceVariableNames: 'navigation isModified' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCOrganizationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCPackageTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCPatchTest instanceVariableNames: 'patch' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCRepositoryTest instanceVariableNames: 'repository ancestors' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCRepositoryTest subclass: #MCDictionaryRepositoryTest instanceVariableNames: 'dict' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCRepositoryTest subclass: #MCDirectoryRepositoryTest instanceVariableNames: 'directory' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCScannerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCSerializationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCSnapshotBrowserTest instanceVariableNames: 'model morph' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCSnapshotTest instanceVariableNames: 'snapshot' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCStReaderTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCTestCase subclass: #MCStWriterTest instanceVariableNames: 'stream writer' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCMerger subclass: #MCThreeWayMerger instanceVariableNames: 'index operations provisions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Merging'! Object subclass: #MCTool instanceVariableNames: 'morph label modal modalValue' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCTool subclass: #MCCodeTool instanceVariableNames: 'items' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! !MCCodeTool commentStamp: 'nk 11/10/2003 22:00' prior: 0! MCCodeTool is an abstract superclass for those Monticello browsers that display code. It contains copies of the various CodeHolder methods that perform the various menu operations in the method list. ! MCCodeTool subclass: #MCPatchBrowser instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCPatchBrowser subclass: #MCChangeSelector instanceVariableNames: 'kept' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCPatchBrowser subclass: #MCMergeBrowser instanceVariableNames: 'conflicts merger ok' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCTool subclass: #MCSaveVersionDialog instanceVariableNames: 'name message' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCCodeTool subclass: #MCSnapshotBrowser instanceVariableNames: 'categorySelection classSelection protocolSelection methodSelection switch' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Object subclass: #MCToolWindowBuilder instanceVariableNames: 'builder window currentFrame tool' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Object subclass: #MCVariableDefinition instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCVariableDefinition subclass: #MCClassInstanceVariableDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCVariableDefinition subclass: #MCClassVariableDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCVariableDefinition subclass: #MCInstanceVariableDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! MCVariableDefinition subclass: #MCPoolImportDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling'! Object subclass: #MCVersion instanceVariableNames: 'package info snapshot dependencies' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCVersion subclass: #MCDiffyVersion instanceVariableNames: 'base patch' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Object subclass: #MCVersionDependency instanceVariableNames: 'package versionInfo' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCTool subclass: #MCVersionHistoryBrowser instanceVariableNames: 'ancestry index repositoryGroup package' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCAncestry subclass: #MCVersionInfo instanceVariableNames: 'id name message date time author' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! !MCVersionInfo commentStamp: '' prior: 0! Adds to the record of ancestry, other identifying details.! MCTool subclass: #MCVersionInspector instanceVariableNames: 'version' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCVersionInspector subclass: #MCFileRepositoryInspector instanceVariableNames: 'repository versions loaded newer inherited selectedPackage selectedVersion order' classVariableNames: 'Order' poolDictionaries: '' category: 'Monticello-UI'! MCVersionInspector subclass: #MCRepositoryInspector instanceVariableNames: 'repository packages versions loaded selectedPackage selectedVersion' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Object subclass: #MCVersionLoader instanceVariableNames: 'versions' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Loading'! Object subclass: #MCVersionMerger instanceVariableNames: 'records merger' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Notification subclass: #MCVersionNameAndMessageRequest instanceVariableNames: 'suggestion' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Object subclass: #MCVersionNotification instanceVariableNames: 'version ancestor repository changes' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCReader subclass: #MCVersionReader instanceVariableNames: 'package info definitions dependencies stepChildren' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCVersionReader subclass: #MCMczReader instanceVariableNames: 'zip infoCache' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCMczReader subclass: #MCMcdReader instanceVariableNames: 'baseInfo patch' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! Object subclass: #MCVersionSorter instanceVariableNames: 'layers depthIndex depths stepparents roots' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCVersionSorter subclass: #MCFilteredVersionSorter instanceVariableNames: 'target' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCTestCase subclass: #MCVersionTest instanceVariableNames: 'version' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCAncestry subclass: #MCWorkingAncestry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! !MCWorkingAncestry commentStamp: '' prior: 0! The interim record of ancestry for a working copy, gets merged version added to the ancestry, and is used to create the VersionInfo when the working copy becomes a version. ! MCPackageManager subclass: #MCWorkingCopy instanceVariableNames: 'versionInfo ancestry counter repositoryGroup requiredPackages' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! MCTool subclass: #MCWorkingCopyBrowser instanceVariableNames: 'workingCopy workingCopyWrapper repository defaults' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCTestCase subclass: #MCWorkingCopyTest instanceVariableNames: 'savedInitials workingCopy repositoryGroup versions versions2' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Tests'! MCVersionHistoryBrowser subclass: #MCWorkingHistoryBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! MCRepository subclass: #MCWriteOnlyRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCWriteOnlyRepository subclass: #MCSMReleaseRepository instanceVariableNames: 'packageName user password' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! MCWriteOnlyRepository subclass: #MCSmtpRepository instanceVariableNames: 'email' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'! Object subclass: #MCWriter instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCWriter subclass: #MCMczWriter instanceVariableNames: 'zip infoWriter' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCMczWriter subclass: #MCMcdWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! MCWriter subclass: #MCStWriter instanceVariableNames: 'initStream' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Chunk Format'! MCWriter subclass: #MCVersionInfoWriter instanceVariableNames: 'written' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Storing'! !Object methodsFor: '*monticello' stamp: 'dvf 8/10/2004 23:25'! isConflict ^false! ! !ChangeList methodsFor: '*monticello' stamp: 'dvf 7/23/2003 14:44'! changeTo: changeSubset | newList newChangeList | newChangeList _ OrderedCollection new. newList _ OrderedCollection new. 1 to: changeList size do: [:i | (changeSubset includes: (changeList at: i)) ifTrue: [newChangeList add: (changeList at: i). newList add: (list at: i)]]. newChangeList size < changeList size ifTrue: [changeList _ newChangeList. list _ newList. listIndex _ 0. listSelections _ Array new: list size withAll: false]. self changed: #list ! ! !ChangeRecord methodsFor: '*monticello' stamp: 'avi 9/14/2004 14:27'! asMethodDefinition ^ MCMethodDefinition className: class classIsMeta: meta selector: self methodSelector category: category timeStamp: stamp source: self string! ! !Class methodsFor: '*monticello' stamp: 'cwp 8/10/2003 16:41'! asClassDefinition ^ MCClassDefinition name: self name superclassName: self superclass name category: self category instVarNames: self instVarNames classVarNames: self classVarNames poolDictionaryNames: self poolDictionaryNames classInstVarNames: self class instVarNames type: self typeOfClass comment: self organization classComment asString commentStamp: self organization commentStamp ! ! !Class methodsFor: '*monticello' stamp: 'avi 3/10/2004 13:32'! classDefinitions ^ Array with: self asClassDefinition! ! !Class methodsFor: '*monticello' stamp: 'ab 4/14/2003 22:30'! poolDictionaryNames ^ self sharedPools collect: [:ea | self environment keyAtIdentityValue: ea]! ! !ChangeList class methodsFor: '*monticello' stamp: 'dvf 7/23/2003 15:12'! recentLogOn: origChangesFile startingFrom: initialPos "Prompt with a menu of how far back to go when browsing a changes file." | end banners positions pos chunk i changesFile | changesFile _ origChangesFile readOnlyCopy. banners _ OrderedCollection new. positions _ OrderedCollection new. end _ changesFile size. pos _ initialPos. [pos = 0 or: [banners size > 20]] whileFalse: [changesFile position: pos. chunk _ changesFile nextChunk. i _ chunk indexOfSubCollection: 'priorSource: ' startingAt: 1. i > 0 ifTrue: [positions addLast: pos. banners addLast: (chunk copyFrom: 5 to: i - 2). pos _ Number readFrom: (chunk copyFrom: i + 13 to: chunk size)] ifFalse: [pos _ 0]]. changesFile close. banners size == 0 ifTrue: [^self recent: end on: origChangesFile]. pos _ (SelectionMenu labelList: banners selections: positions) startUpWithCaption: 'Browse as far back as...'. pos == nil ifTrue: [^ self]. ^self recent: end - pos on: origChangesFile! ! !ChangeList class methodsFor: '*monticello' stamp: 'dvf 7/23/2003 14:20'! recent: charCount on: origChangesFile "Opens a changeList on the end of the specified changes log file" | changeList end changesFile | changesFile _ origChangesFile readOnlyCopy. end _ changesFile size. Cursor read showWhile: [changeList _ self new scanFile: changesFile from: (0 max: end - charCount) to: end]. changesFile close. ^changeList! ! !FileList2 class methodsFor: '*monticello' stamp: 'ab 7/5/2003 19:32'! modalFileSelectorForSuffixes: aList directory: aDirectory | window aFileList | window _ self morphicViewFileSelectorForSuffixes: aList directory: aDirectory. aFileList _ window valueOfProperty: #fileListModel. window openCenteredInWorld. [window world notNil] whileTrue: [ window outermostWorldMorph doOneCycleNow. ]. ^aFileList getSelectedFile! ! !FileList2 class methodsFor: '*monticello' stamp: 'ab 7/5/2003 19:31'! morphicViewFileSelectorForSuffixes: aList directory: dir "Answer a morphic file-selector tool for the given suffix list" | aFileList window fixedSize midLine gap | aFileList _ self new directory: dir. aFileList optionalButtonSpecs: aFileList okayAndCancelServices. aList ifNotNil: [aFileList fileSelectionBlock: [:entry :myPattern | entry isDirectory ifTrue: [false] ifFalse: [aList includes: (FileDirectory extensionFor: entry name asLowercase)]] fixTemps]. window _ BorderedMorph new layoutPolicy: ProportionalLayout new; color: Color lightBlue; borderColor: Color blue; borderWidth: 4; layoutInset: 4; extent: 600@400; useRoundedCorners. window setProperty: #fileListModel toValue: aFileList. aFileList modalView: window. midLine _ 0.4. fixedSize _ 25. gap _ 5. self addFullPanesTo: window from: { {self textRow: 'Please select a file'. 0 @ 0 corner: 1 @ 0. 0@0 corner: 0@fixedSize}. {aFileList optionalButtonRow. 0 @ 0 corner: 1 @ 0. 0@fixedSize corner: 0@(fixedSize * 2)}. {aFileList morphicDirectoryTreePane. 0@0 corner: midLine@1. gap @(fixedSize * 2) corner: gap negated@0}. {aFileList morphicFileListPane. midLine @ 0 corner: 1@1. gap@(fixedSize * 2) corner: gap negated@0}. }. aFileList postOpen. ^ window ! ! !FilePackage methodsFor: '*monticello' stamp: 'avi 1/19/2004 23:47'! doIts ^ doIts! ! !HTTPSocket class methodsFor: '*monticello-override' stamp: 'nk 10/11/2003 17:41'! httpGetDocument: url args: args accept: mimeType request: requestString "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf. The parsed header is saved. Use a proxy server if one has been registered. tk 7/23/97 17:12" "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'." | serverName serverAddr port sock header length bare page list firstData aStream index connectToHost connectToPort type newUrl | Socket initializeNetwork. bare _ (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. bare _ bare copyUpTo: $#. "remove fragment, if specified" serverName _ bare copyUpTo: $/. page _ bare copyFrom: serverName size + 1 to: bare size. (serverName includes: $:) ifTrue: [ index _ serverName indexOf: $:. port _ (serverName copyFrom: index+1 to: serverName size) asNumber. serverName _ serverName copyFrom: 1 to: index-1. ] ifFalse: [ port _ self defaultPort ]. page size = 0 ifTrue: [page _ '/']. "add arguments" args ifNotNil: [page _ page, (self argString: args) ]. (self shouldUseProxy: serverName) ifFalse: [ connectToHost _ serverName. connectToPort _ port ] ifTrue: [ page _ 'http://', serverName, ':', port printString, page. "put back together" connectToHost _ HTTPProxyServer. connectToPort _ HTTPProxyPort]. serverAddr _ NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', connectToHost]. 3 timesRepeat: [ sock _ HTTPSocket new. sock connectTo: serverAddr port: connectToPort. (sock waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [ Socket deadServer: connectToHost. sock destroy. ^ 'Server ',connectToHost,' is not responding']. "Transcript cr;show: url; cr. Transcript show: page; cr." sock sendCommand: 'GET ', page, ' HTTP/1.0', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Host: ', serverName, ':', port printString, CrLf. "blank line automatically added" list _ sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. "Transcript show: page; cr; show: header; cr." firstData _ list at: 3. header isEmpty ifTrue: [aStream _ 'server aborted early'] ifFalse: [ "dig out some headers" sock header: header. length _ sock getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ sock getHeader: 'content-type'. sock responseCode first = $3 ifTrue: [ newUrl _ sock getHeader: 'location'. newUrl ifNotNil: [ Transcript show: 'redirecting to ', newUrl; cr. sock destroy. newUrl _ self expandUrl: newUrl ip: serverAddr port: connectToPort. ^self httpGetDocument: newUrl args: args accept: mimeType request: requestString] ]. aStream _ sock getRestOfBuffer: firstData totalLength: length. "a 400-series error" sock responseCode first = $4 ifTrue: [^ header, aStream contents]. ]. sock destroy. "Always OK to destroy!!" aStream class ~~ String ifTrue: [ ^ MIMEDocument contentType: type content: aStream contents url: url]. aStream = 'server aborted early' ifTrue: [ ^aStream ]. ]. {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect. ^'some other bad thing happened!!'! ! !HTTPSocket class methodsFor: '*monticello' stamp: 'avi 2/10/2004 14:02'! httpGet: url args: args user: user passwd: passwd | authorization | authorization _ (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents. ^self httpGet: url args: args accept: '*/*' request: 'Authorization: Basic ' , authorization , CrLf! ! !HTTPSocket class methodsFor: '*monticello' stamp: 'avi 2/10/2004 15:04'! httpPost: url args: args user: user passwd: passwd | authorization | authorization _ (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents. ^self httpPostDocument: url args: args accept: '*/*' request: 'Authorization: Basic ' , authorization , CrLf! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'! allAncestors ^ MCVersionSorter new addAllVersionInfos: self ancestors; sortedVersionInfos! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'! allAncestorsDo: aBlock self ancestors do: [:ea | aBlock value: ea. ea allAncestorsDo: aBlock]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'! allAncestorsOnPathTo: aVersionInfo ^ MCFilteredVersionSorter new target: aVersionInfo; addAllVersionInfos: self ancestors; sortedVersionInfos! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'! ancestorString ^ String streamContents: [:s | self ancestors do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'! ancestors ^ ancestors ifNil: [#()]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'bf 12/22/2004 21:55'! ancestorsDoWhileTrue: aBlock self ancestors do: [:ea | (aBlock value: ea) ifTrue: [ea ancestorsDoWhileTrue: aBlock]]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/11/2004 14:18'! commonAncestorsWith: aVersionInfo | sharedAncestors mergedOrder sorter | sorter _ MCVersionSorter new addVersionInfo: self; addVersionInfo: aVersionInfo. mergedOrder _ sorter sortedVersionInfos. sharedAncestors _ (sorter allAncestorsOf: self) intersection: (sorter allAncestorsOf: aVersionInfo). ^ mergedOrder select: [:ea | sharedAncestors includes: ea]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:58'! commonAncestorWith: aNode | commonAncestors | commonAncestors _ self commonAncestorsWith: aNode. ^ commonAncestors at: 1 ifAbsent: [nil]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'jrp 7/12/2004 08:16'! hasAncestor: aVersionInfo ^ self hasAncestor: aVersionInfo alreadySeen: OrderedCollection new! ! !MCAncestry methodsFor: 'ancestry' stamp: 'jrp 7/12/2004 08:16'! hasAncestor: aVersionInfo alreadySeen: aList (aList includes: self) ifTrue: [^ false]. aList add: self. ^ self = aVersionInfo or: [self ancestors anySatisfy: [:ea | ea hasAncestor: aVersionInfo alreadySeen: aList]] ! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:58'! isRelatedTo: aVersionInfo ^ aVersionInfo timeStamp < self timeStamp ifTrue: [self hasAncestor: aVersionInfo] ifFalse: [aVersionInfo hasAncestor: self]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/11/2004 15:08'! stepChildren ^ stepChildren ifNil: [#()]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/14/2004 15:21'! stepChildrenString ^ String streamContents: [:s | self stepChildren do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! ! !MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:58'! withAllAncestors ^ (Array with: self), self allAncestors! ! !MCAncestry methodsFor: 'initializing' stamp: 'avi 9/11/2004 10:42'! initialize ancestors _ #(). stepChildren _ #()! ! !MCAncestry class methodsFor: 'as yet unclassified' stamp: 'avi 2/12/2004 21:02'! new ^ self basicNew initialize! ! !MCChangeSelectionRequest methodsFor: 'as yet unclassified' stamp: 'avi 9/14/2004 15:01'! defaultAction ^ (MCChangeSelector new patch: patch; label: label) showModally! ! !MCChangeSelectionRequest methodsFor: 'as yet unclassified' stamp: 'avi 9/14/2004 15:02'! label ^ label! ! !MCChangeSelectionRequest methodsFor: 'as yet unclassified' stamp: 'avi 9/14/2004 15:01'! label: aString label _ aString! ! !MCChangeSelectionRequest methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 15:12'! patch ^ patch! ! !MCChangeSelectionRequest methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 15:12'! patch: aPatch patch _ aPatch! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 11/10/2003 21:57'! annotations ^operation ifNotNilDo: [ :op | op annotations ]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:04'! applyTo: anObject self isResolved ifFalse: [self error: 'Cannot continue until this conflict has been resolved']. self remoteChosen ifTrue: [operation applyTo: anObject].! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:03'! chooseLocal chooseRemote _ false! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 10/21/2003 23:16'! chooseNewer self isLocalNewer ifTrue: [ self chooseLocal ] ifFalse: [ self isRemoteNewer ifTrue: [ self chooseRemote ]]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 10/21/2003 23:22'! chooseOlder self isRemoteNewer ifTrue: [ self chooseLocal ] ifFalse: [ self isLocalNewer ifTrue: [ self chooseRemote ]]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:03'! chooseRemote chooseRemote _ true! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 16:39'! clearChoice chooseRemote _ nil! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 11/10/2003 21:58'! definition ^operation ifNotNilDo: [ :op | op definition ]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'dvf 8/10/2004 23:24'! isConflict ^true! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 10/21/2003 23:11'! isLocalNewer ^ self localDefinition fullTimeStamp > self remoteDefinition fullTimeStamp! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'nk 10/21/2003 23:15'! isRemoteNewer ^ self localDefinition fullTimeStamp < self remoteDefinition fullTimeStamp! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:02'! isResolved ^ chooseRemote notNil! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:45'! localChosen ^ chooseRemote notNil and: [chooseRemote not]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:10'! localDefinition ^ operation baseDefinition! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:07'! operation: anOperation operation _ anOperation! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:45'! remoteChosen ^ chooseRemote notNil and: [chooseRemote]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:10'! remoteDefinition ^ operation targetDefinition! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 16:47'! source ^ self localChosen ifTrue: [operation fromSource] ifFalse: [operation source]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:48'! status ^ self isResolved ifFalse: [''] ifTrue: [self remoteChosen ifFalse: ['L'] ifTrue: ['R']]! ! !MCConflict methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 16:54'! summary | attribute | attribute _ self isResolved ifTrue: [self remoteChosen ifTrue: [#underlined] ifFalse: [#struckOut]] ifFalse: [#bold]. ^ Text string: operation summary attribute: (TextEmphasis perform: attribute)! ! !MCConflict class methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 13:07'! operation: anOperation ^ self new operation: anOperation ! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:14'! description self subclassResponsibility! ! !MCDefinition methodsFor: 'comparing' stamp: 'nk 10/21/2003 23:18'! fullTimeStamp ^TimeStamp current! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:14'! hash ^ self description hash! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 12/5/2002 21:24'! isRevisionOf: aDefinition ^ aDefinition description = self description! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:25'! isSameRevisionAs: aDefinition ^ self = aDefinition! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:04'! sortKey self subclassResponsibility ! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 17:59'! <= other ^ self sortKey <= other sortKey! ! !MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:24'! = aDefinition ^ self isRevisionOf: aDefinition! ! !MCDefinition methodsFor: 'annotations' stamp: 'nk 7/24/2003 12:27'! annotations ^self annotations: Preferences defaultAnnotationRequests! ! !MCDefinition methodsFor: 'annotations' stamp: 'nk 7/24/2003 12:26'! annotations: requests "Answer a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" ^String streamContents: [ :s | self printAnnotations: requests on: s ].! ! !MCDefinition methodsFor: 'annotations' stamp: 'nk 11/10/2003 21:46'! printAnnotations: requests on: aStream "Add a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" aStream nextPutAll: 'not yet implemented'! ! !MCDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:51'! isClassDefinition ^false! ! !MCDefinition methodsFor: 'testing' stamp: 'bf 11/12/2004 14:46'! isClassDefinitionExtension "Answer true if this definition extends the regular class definition" ^false! ! !MCDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:51'! isMethodDefinition ^false! ! !MCDefinition methodsFor: 'testing' stamp: 'cwp 7/11/2003 01:32'! isOrganizationDefinition ^false! ! !MCDefinition methodsFor: 'installing' stamp: 'ab 7/18/2003 21:31'! load ! ! !MCDefinition methodsFor: 'installing' stamp: 'avi 2/17/2004 13:19'! loadOver: aDefinition self load ! ! !MCDefinition methodsFor: 'installing' stamp: 'ab 7/18/2003 19:48'! postload! ! !MCDefinition methodsFor: 'installing' stamp: 'avi 2/17/2004 13:19'! postloadOver: aDefinition self postload! ! !MCDefinition methodsFor: 'installing' stamp: 'ab 11/14/2002 00:08'! unload! ! !MCDefinition methodsFor: 'printing' stamp: 'ab 7/18/2003 19:43'! printOn: aStream super printOn: aStream. aStream nextPutAll: '(', self summary, ')'! ! !MCDefinition methodsFor: 'printing' stamp: 'ab 7/19/2003 18:23'! summary self subclassResponsibility ! ! !MCDefinition methodsFor: 'accessing' stamp: 'ab 5/24/2003 14:12'! provisions ^ #()! ! !MCDefinition methodsFor: 'accessing' stamp: 'ab 5/24/2003 14:12'! requirements ^ #()! ! !MCClassDefinition methodsFor: 'comparing' stamp: 'avi 1/17/2004 17:40'! hash | hash | hash _ String stringHash: name initialHash: 0. hash _ String stringHash: superclassName initialHash: hash. hash _ String stringHash: (category ifNil: ['']) initialHash: hash. hash _ String stringHash: type initialHash: hash. variables do: [ :v | hash _ String stringHash: v name initialHash: hash. ]. ^ hash! ! !MCClassDefinition methodsFor: 'comparing' stamp: 'ab 5/24/2003 14:12'! provisions ^ Array with: name! ! !MCClassDefinition methodsFor: 'comparing' stamp: 'avi 2/17/2004 03:13'! requirements ^ (Array with: superclassName), self poolDictionaries! ! !MCClassDefinition methodsFor: 'comparing' stamp: 'cwp 8/12/2003 02:35'! = aDefinition ^ ((super = aDefinition) and: [superclassName = aDefinition superclassName] and: [category = aDefinition category] and: [type = aDefinition type]) and: [variables = aDefinition variables] and: [comment = aDefinition comment] ! ! !MCClassDefinition methodsFor: 'visiting' stamp: 'ab 7/18/2003 21:48'! accept: aVisitor ^ aVisitor visitClassDefinition: self! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'nk 2/25/2005 09:49'! actualClass ^Smalltalk classNamed: self className! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/24/2002 06:23'! category ^ category! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:32'! classInstVarNames ^ self selectVariables: #isClassInstanceVariable! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:52'! className ^ name! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:33'! classVarNames ^ self selectVariables: #isClassVariable! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'ab 1/15/2003 13:42'! comment ^ comment! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 8/10/2003 16:40'! commentStamp ^ commentStamp! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'ab 12/5/2002 21:24'! description ^ Array with: name ! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:33'! instVarNames ^ self selectVariables: #isInstanceVariable! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:53'! poolDictionaries ^ self selectVariables: #isPoolImport! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:28'! selectVariables: aSelector ^ variables select: [:v | v perform: aSelector] thenCollect: [:v | v name]! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'ab 7/19/2003 18:00'! sortKey ^ self className! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 17:41'! superclassName ^ superclassName! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/24/2002 22:35'! type ^ type! ! !MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 06:51'! variables ^ variables! ! !MCClassDefinition methodsFor: 'initializing' stamp: 'cwp 7/7/2003 23:19'! addVariables: aCollection ofType: aClass variables addAll: (aCollection collect: [:var | aClass name: var asString]).! ! !MCClassDefinition methodsFor: 'initializing' stamp: 'cwp 8/10/2003 17:39'! defaultCommentStamp ^ String new "The version below avoids stomping on stamps already in the image ^ (Smalltalk at: name ifPresent: [:c | c organization commentStamp]) ifNil: [''] " ! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:35'! classInstanceVariablesString ^ self stringForVariablesOfType: #isClassInstanceVariable! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:36'! classVariablesString ^ self stringForVariablesOfType: #isClassVariable! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 8/2/2003 02:03'! definitionString ^ String streamContents: [:stream | self printDefinitionOn: stream]! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:35'! instanceVariablesString ^ self stringForVariablesOfType: #isInstanceVariable! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 11/24/2002 22:16'! kindOfSubclass type = #normal ifTrue: [^ ' subclass: ']. type = #words ifTrue: [^ ' variableWordSubclass: ']. type = #variable ifTrue: [^ ' variableSubclass: ']. type = #bytes ifTrue: [^ ' variableByteSubclass: ']. type = #weak ifTrue: [^ ' weakSubclass: ' ]. type = #compiledMethod ifTrue: [^ ' variableByteSubclass: ' ]. self error: 'Unrecognized class type'! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 8/2/2003 02:03'! printDefinitionOn: stream stream nextPutAll: self superclassName; nextPutAll: self kindOfSubclass; nextPut: $# ; nextPutAll: self className; cr; tab; nextPutAll: 'instanceVariableNames: '; store: self instanceVariablesString; cr; tab; nextPutAll: 'classVariableNames: '; store: self classVariablesString; cr; tab; nextPutAll: 'poolDictionaries: '; store: self sharedPoolsString; cr; tab; nextPutAll: 'category: '; store: self category asString! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:54'! sharedPoolsString ^ self stringForVariablesOfType: #isPoolImport! ! !MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/10/2003 01:29'! source ^ self definitionString! ! !MCClassDefinition methodsFor: 'printing' stamp: 'ab 11/16/2002 17:33'! summary ^ name! ! !MCClassDefinition methodsFor: 'installing' stamp: 'avi 1/24/2004 18:38'! createClass | superClass | superClass _ Smalltalk at: superclassName. ^ (ClassBuilder new) name: name inEnvironment: superClass environment subclassOf: superClass type: type instanceVariableNames: self instanceVariablesString classVariableNames: self classVariablesString poolDictionaries: self sharedPoolsString category: category ! ! !MCClassDefinition methodsFor: 'installing' stamp: 'cwp 8/10/2003 17:03'! load self createClass ifNotNilDo: [:class | class class instanceVariableNames: self classInstanceVariablesString. self hasComment ifTrue: [class classComment: comment stamp: commentStamp]]! ! !MCClassDefinition methodsFor: 'installing' stamp: 'cwp 2/3/2004 21:35'! stringForVariablesOfType: aSymbol ^ String streamContents: [:stream | (self selectVariables: aSymbol) do: [:ea | stream nextPutAll: ea] separatedBy: [stream space]]! ! !MCClassDefinition methodsFor: 'installing' stamp: 'ab 11/13/2002 19:39'! unload Smalltalk removeClassNamed: name! ! !MCClassDefinition methodsFor: 'testing' stamp: 'cwp 8/2/2003 02:54'! hasClassInstanceVariables ^ (self selectVariables: #isClassInstanceVariable) isEmpty not! ! !MCClassDefinition methodsFor: 'testing' stamp: 'cwp 8/10/2003 17:01'! hasComment ^ comment notNil and: [comment ~= '']! ! !MCClassDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:52'! isClassDefinition ^ true! ! !MCClassDefinition methodsFor: 'testing' stamp: 'ab 5/24/2003 13:49'! isCodeDefinition ^ true! ! !MCClassDefinition methodsFor: 'serializing' stamp: 'avi 3/4/2004 02:19'! initializeWithName: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: stampStringOrNil name _ nameString asSymbol. superclassName _ superclassString ifNil: ['nil'] ifNotNil: [superclassString asSymbol]. category _ categoryString. name = #CompiledMethod ifTrue: [type _ #compiledMethod] ifFalse: [type _ typeSymbol]. comment _ commentString withSqueakLineEndings. commentStamp _ stampStringOrNil ifNil: [self defaultCommentStamp]. variables _ OrderedCollection new. self addVariables: ivarArray ofType: MCInstanceVariableDefinition. self addVariables: cvarArray ofType: MCClassVariableDefinition. self addVariables: poolArray ofType: MCPoolImportDefinition. self addVariables: civarArray ofType: MCClassInstanceVariableDefinition.! ! !MCClassDefinition methodsFor: 'annotations' stamp: 'nk 7/24/2003 16:05'! printAnnotations: requests on: aStream "Add a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" requests do: [ :aRequest | aRequest == #requirements ifTrue: [ self requirements do: [ :req | aStream nextPutAll: req ] separatedBy: [ aStream space ]] ] separatedBy: [ aStream space ].! ! !MCDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 18:17'! clearInstances WeakArray removeWeakDependent: Instances. Instances _ nil! ! !MCDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 9/17/2003 21:52'! instanceLike: aDefinition Instances ifNil: [Instances _ WeakSet new]. ^ (Instances like: aDefinition) ifNil: [Instances add: aDefinition]! ! !MCClassDefinition class methodsFor: 'obsolete' stamp: 'ab 4/1/2003 01:22'! name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray comment: commentString ^ self name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: #normal comment: commentString ! ! !MCClassDefinition class methodsFor: 'obsolete' stamp: 'cwp 8/10/2003 16:33'! name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString ^ self name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: nil! ! !MCClassDefinition class methodsFor: 'obsolete' stamp: 'ab 4/1/2003 01:22'! name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray comment: commentString ^ self name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() comment: commentString ! ! !MCClassDefinition class methodsFor: 'instance creation' stamp: 'cwp 8/10/2003 16:30'! name: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: stampString ^ self instanceLike: (self new initializeWithName: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: stampString)! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:38'! addAll: aCollection aCollection do: [:ea | self add: ea]! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:38'! add: aDefinition definitions at: aDefinition description put: aDefinition! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:45'! definitionLike: aDefinition ifPresent: foundBlock ifAbsent: errorBlock | definition | definition _ definitions at: aDefinition description ifAbsent: []. ^ definition ifNil: errorBlock ifNotNil: [foundBlock value: definition]! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:42'! definitions ^ definitions values! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:34'! initialize definitions _ Dictionary new! ! !MCDefinitionIndex methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:40'! remove: aDefinition definitions removeKey: aDefinition description ifAbsent: []! ! !MCDefinitionIndex class methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:29'! definitions: aCollection ^ self new addAll: aCollection! ! !MCDefinitionIndex class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCDependencySorter methodsFor: 'building' stamp: 'bf 11/12/2004 14:50'! addAll: aCollection aCollection asArray sort do: [:ea | self add: ea]! ! !MCDependencySorter methodsFor: 'building' stamp: 'avi 10/7/2004 22:47'! addExternalProvisions: aCollection (aCollection intersection: self externalRequirements) do: [:ea | self addProvision: ea]! ! !MCDependencySorter methodsFor: 'building' stamp: 'ab 5/22/2003 23:13'! add: anItem | requirements | requirements _ self unresolvedRequirementsFor: anItem. requirements isEmpty ifTrue: [self addToOrder: anItem] ifFalse: [self addRequirements: requirements for: anItem]! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:25'! addProvision: anObject | newlySatisfied | provided add: anObject. newlySatisfied _ required removeKey: anObject ifAbsent: [#()]. self addAll: newlySatisfied.! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:23'! addRequirements: aCollection for: anObject aCollection do: [:ea | self addRequirement: ea for: anObject]! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:24'! addRequirement: reqObject for: itemObject (self itemsRequiring: reqObject) add: itemObject! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:15'! addToOrder: anItem orderedItems add: anItem. anItem provisions do: [:ea | self addProvision: ea].! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:24'! itemsRequiring: anObject ^ required at: anObject ifAbsentPut: [Set new]! ! !MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:22'! unresolvedRequirementsFor: anItem ^ anItem requirements difference: provided! ! !MCDependencySorter methodsFor: 'accessing' stamp: 'dvf 9/8/2004 00:49'! externalRequirements | unloaded providedByUnloaded | unloaded := self itemsWithMissingRequirements. providedByUnloaded := (unloaded gather: [:e | e provisions]) asSet. ^ required keys reject: [:ea | providedByUnloaded includes: ea ]! ! !MCDependencySorter methodsFor: 'accessing' stamp: 'ab 5/25/2003 01:15'! itemsWithMissingRequirements | items | items _ Set new. required do: [:ea | items addAll: ea]. ^ items ! ! !MCDependencySorter methodsFor: 'initialize-release' stamp: 'ab 5/22/2003 23:23'! initialize provided _ Set new. required _ Dictionary new. orderedItems _ OrderedCollection new.! ! !MCDependencySorter methodsFor: 'sorting' stamp: 'ab 5/22/2003 23:25'! orderedItems ^ orderedItems! ! !MCDependencySorter class methodsFor: 'as yet unclassified' stamp: 'ab 5/23/2003 14:17'! items: aCollection ^ self new addAll: aCollection! ! !MCDependencySorter class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCDependencySorter class methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 15:16'! sortItems: aCollection | sorter | sorter _ self items: aCollection. sorter externalRequirements do: [:req | sorter addProvision: req]. ^ sorter orderedItems.! ! !MCDependencySorterTest methodsFor: 'asserting' stamp: 'avi 10/7/2004 22:32'! assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems self assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems extraProvisions: #()! ! !MCDependencySorterTest methodsFor: 'asserting' stamp: 'avi 10/7/2004 22:47'! assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems extraProvisions: provisions | order sorter items missing unloadable | items _ anArray collect: [:ea | self itemWithSpec: ea]. sorter _ MCDependencySorter items: items. sorter addExternalProvisions: provisions. order _ (sorter orderedItems collect: [:ea | ea name]) asArray. self assert: order = depOrder. missing _ sorter externalRequirements. self assert: missing asSet = missingDeps asSet. unloadable _ (sorter itemsWithMissingRequirements collect: [:ea | ea name]) asArray. self assert: unloadable asSet = unloadableItems asSet! ! !MCDependencySorterTest methodsFor: 'building' stamp: 'ab 5/24/2003 14:08'! itemWithSpec: anArray ^ MCMockDependentItem new name: anArray first; provides: anArray second; requires: anArray third! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'! testCascadingUnresolved self assertItems: #( (a (x) (z)) (b () (x)) (c () ())) orderAs: #(c) withRequired: #(z) toLoad: #(a b) ! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'! testCycle self assertItems: #( (a (x) (y)) (b (y) (x))) orderAs: #() withRequired: #() toLoad: #(a b) ! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'avi 10/7/2004 22:35'! testExtraProvisions self assertItems: #((a (x) (z)) (b () (x))) orderAs: #(a b) withRequired: #() toLoad: #() extraProvisions: #(x z)! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'! testMultiRequirementOrdering self assertItems: #( (a (x) (z)) (b (y) ()) (c (z) ()) (d () (x y z))) orderAs: #(b c a d) withRequired: #() toLoad: #()! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'! testSimpleOrdering self assertItems: #((a (x) ()) (c () (y)) (b (y) (x))) orderAs: #(a b c) withRequired: #() toLoad: #()! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:12'! testSimpleUnresolved self assertItems: #( (a () (z))) orderAs: #() withRequired: #(z) toLoad: #(a) ! ! !MCDependencySorterTest methodsFor: 'tests' stamp: 'avi 10/7/2004 22:12'! testUnusedAlternateProvider self assertItems: #( (a (x) (z)) (b () (x)) (c (x) ())) orderAs: #(c b) withRequired: #(z) toLoad: #(a) ! ! !MCDependentsWrapper methodsFor: 'as yet unclassified' stamp: 'ar 2/14/2004 02:31'! asString ^item description! ! !MCDependentsWrapper methodsFor: 'as yet unclassified' stamp: 'avi 9/10/2004 17:54'! contents | list workingCopies | workingCopies := model unsortedWorkingCopies. list := item requiredPackages collect: [:each | workingCopies detect: [:wc | wc package = each] ifNone: [nil]] thenSelect: [:x | x notNil]. ^list collect: [:each | self class with: each model: model]! ! !MCDependentsWrapper methodsFor: 'as yet unclassified' stamp: 'ar 2/14/2004 02:31'! hasContents ^item requiredPackages isEmpty not! ! !MCDependentsWrapper methodsFor: 'as yet unclassified' stamp: 'ar 2/14/2004 02:41'! item ^item! ! !MCDirtyPackageInfo class methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 14:04'! initialize [self new register] on: MessageNotUnderstood do: []! ! !MCDoItParser methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:40'! addDefinitionsTo: aCollection self subclassResponsibility ! ! !MCDoItParser methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:40'! source ^ source! ! !MCDoItParser methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:40'! source: aString source _ aString! ! !MCDoItParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:29'! concreteSubclasses ^ self allSubclasses reject: [:c | c isAbstract]! ! !MCDoItParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:40'! forDoit: aString ^ (self subclassForDoit: aString) ifNotNilDo: [:c | c new source: aString]! ! !MCDoItParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:51'! isAbstract ^ self pattern isNil! ! !MCDoItParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:30'! pattern ^ nil! ! !MCDoItParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:30'! subclassForDoit: aString ^ self concreteSubclasses detect: [:ea | ea pattern match: aString] ifNone: []! ! !MCEmptyPackageInfo class methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 14:04'! initialize [self new register] on: MessageNotUnderstood do: []! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:24'! ancestorInfo ^ ancestorInfo ifNil: [ancestorInfo _ version info commonAncestorWith: version workingCopy ancestry]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:23'! ancestorSnapshot ^ ancestorSnapshot ifNil: [ancestorSnapshot _ version workingCopy findSnapshotWithVersionInfo: self ancestorInfo]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 17:11'! imageIsClean | ancestors | ancestors _ version workingCopy ancestors. ^ ancestors size = 1 and: [ancestors first = self ancestorInfo] and: [self imagePatch isEmpty]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:31'! imagePatch ^ imagePatch ifNil: [imagePatch _ self packageSnapshot patchRelativeToBase: self ancestorSnapshot]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:21'! initializeWithVersion: aVersion version _ aVersion! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 17:14'! isAncestorMerge ^ version workingCopy ancestry hasAncestor: version info! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:31'! mergePatch ^ mergePatch ifNil: [mergePatch _ version snapshot patchRelativeToBase: self ancestorSnapshot]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:21'! packageSnapshot ^ packageSnapshot ifNil: [packageSnapshot _ version package snapshot]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 17:14'! updateWorkingCopy self isAncestorMerge ifFalse: [self imageIsClean ifTrue: [version workingCopy loaded: version] ifFalse: [version workingCopy merged: version]]! ! !MCMergeRecord methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:52'! version ^ version! ! !MCMergeRecord class methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:52'! version: aVersion ^ self basicNew initializeWithVersion: aVersion! ! !MCMergeResolutionRequest methodsFor: 'as yet unclassified' stamp: 'bf 4/26/2005 14:25'! defaultAction ^ (MCMergeBrowser new merger: merger; label: messageText) showModally! ! !MCMergeResolutionRequest methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 18:19'! merger ^ merger! ! !MCMergeResolutionRequest methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 18:18'! merger: aMerger merger _ aMerger! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:10'! addConflictWithOperation: anOperation self conflicts add: (MCConflict operation: anOperation)! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:01'! applyTo: anObject self isMerged ifFalse: [self error: 'You must resolve all the conflicts first']. conflicts do: [:ea | ea applyTo: anObject]! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:02'! conflicts ^ conflicts ifNil: [conflicts _ OrderedCollection new]! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2003 19:09'! isMerged ^ self conflicts allSatisfy: [:ea | ea isResolved]! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'avi 10/6/2004 15:19'! load | loader | loader _ MCPackageLoader new. loader provisions addAll: self provisions. self applyTo: loader. loader load! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'bf 12/5/2004 12:23'! loadWithNameLike: baseName | loader | loader _ MCPackageLoader new. loader provisions addAll: self provisions. self applyTo: loader. loader loadWithNameLike: baseName! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:11'! mergedSnapshot ^ MCPatcher apply: self to: self baseSnapshot! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 16:34'! operations ^ #()! ! !MCMerger methodsFor: 'as yet unclassified' stamp: 'avi 10/6/2004 15:19'! provisions ^ #()! ! !MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 8/22/2003 17:48'! hash | hash | hash _ String stringHash: classIsMeta asString initialHash: 0. hash _ String stringHash: source initialHash: hash. hash _ String stringHash: category initialHash: hash. hash _ String stringHash: className initialHash: hash. ^ hash! ! !MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 5/24/2003 14:11'! requirements ^ Array with: className! ! !MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:01'! sortKey ^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector! ! !MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 8/22/2003 17:49'! = aDefinition ^(super = aDefinition) and: [aDefinition source = self source] and: [aDefinition category = self category] and: [aDefinition timeStamp = self timeStamp]! ! !MCMethodDefinition methodsFor: 'visiting' stamp: 'ab 7/18/2003 21:47'! accept: aVisitor ^ aVisitor visitMethodDefinition: self! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/15/2002 01:12'! actualClass ^Smalltalk at: className ifPresent: [:class | classIsMeta ifTrue: [class class] ifFalse: [class]]! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:59'! category ^ category! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 07:26'! classIsMeta ^ classIsMeta! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/15/2002 01:12'! className ^className! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'nk 10/21/2003 23:08'! fullTimeStamp ^TimeStamp fromMethodTimeStamp: timeStamp! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'avi 1/24/2004 18:38'! load self actualClass compile: source classified: category withStamp: timeStamp notifying: (SyntaxError new category: category)! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/15/2002 01:11'! selector ^selector! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:59'! source ^ source! ! !MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 1/15/2003 13:42'! timeStamp ^ timeStamp! ! !MCMethodDefinition methodsFor: 'printing' stamp: 'ab 12/5/2002 21:25'! description ^ Array with: className with: selector with: classIsMeta! ! !MCMethodDefinition methodsFor: 'printing' stamp: 'ab 4/8/2003 18:05'! fullClassName ^ self classIsMeta ifFalse: [self className] ifTrue: [self className, ' class']! ! !MCMethodDefinition methodsFor: 'printing' stamp: 'ab 4/8/2003 18:04'! summary ^ self fullClassName , '>>' , selector! ! !MCMethodDefinition methodsFor: 'serializing' stamp: 'nk 6/21/2003 08:38'! initializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString className _ classString asSymbol. selector _ selectorString asSymbol. category _ catString asSymbol. timeStamp _ timeString. classIsMeta _ metaBoolean. source _ sourceString withSqueakLineEndings. ! ! !MCMethodDefinition methodsFor: 'testing' stamp: 'ab 5/24/2003 13:49'! isCodeDefinition ^ true! ! !MCMethodDefinition methodsFor: 'testing' stamp: 'ab 8/8/2003 17:05'! isInitializer ^ selector = #initialize and: [classIsMeta] ! ! !MCMethodDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:52'! isMethodDefinition ^true! ! !MCMethodDefinition methodsFor: 'installing' stamp: 'avi 9/17/2003 22:27'! isExtensionMethod ^ category beginsWith: '*'! ! !MCMethodDefinition methodsFor: 'installing' stamp: 'avi 11/10/2003 15:45'! isOverrideMethod "this oughta check the package" ^ self isExtensionMethod and: [category endsWith: '-override']! ! !MCMethodDefinition methodsFor: 'installing' stamp: 'ab 8/8/2003 17:05'! postload self isInitializer ifTrue: [self actualClass theNonMetaClass initialize]! ! !MCMethodDefinition methodsFor: 'installing' stamp: 'cwp 11/7/2004 23:28'! scanForPreviousVersion | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp method file methodCategory | method _ self actualClass compiledMethodAt: selector ifAbsent: [^ nil]. position _ method filePosition. sourceFilesCopy _ SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. [method fileIndex == 0 ifTrue: [^ nil]. file _ sourceFilesCopy at: method fileIndex. [position notNil & file notNil] whileTrue: [file position: (0 max: position-150). "Skip back to before the preamble" [file position < (position-1)] "then pick it up from the front" whileTrue: [preamble _ file nextChunk]. "Preamble is likely a linked method preamble, if we're in a changes file (not the sources file). Try to parse it for prior source position and file index" prevPos _ nil. stamp _ ''. (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [tokens _ Scanner new scanTokens: preamble] ifFalse: [tokens _ Array new "ie cant be back ref"]. ((tokens size between: 7 and: 8) and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue: [(tokens at: tokens size-3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size-2. prevPos _ tokens last. prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos] ifFalse: ["Old format gives no stamp; prior pointer in two parts" prevPos _ tokens at: tokens size-2. prevFileIndex _ tokens last]. (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]]. ((tokens size between: 5 and: 6) and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue: [(tokens at: tokens size-1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size]]. methodCategory _ tokens after: #methodsFor: ifAbsent: ['as yet unclassifed']. methodCategory = category ifFalse: [methodCategory = (Smalltalk at: #Categorizer ifAbsent: [Smalltalk at: #ClassOrganizer]) default ifTrue: [methodCategory _ methodCategory, ' ']. ^ ChangeRecord new file: file position: position type: #method class: className category: methodCategory meta: classIsMeta stamp: stamp]. position _ prevPos. prevPos notNil ifTrue: [file _ sourceFilesCopy at: prevFileIndex]]. ^ nil] ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]] ! ! !MCMethodDefinition methodsFor: 'installing' stamp: 'avi 7/22/2004 14:24'! unload | previousVersion | self isOverrideMethod ifTrue: [previousVersion _ self scanForPreviousVersion]. previousVersion ifNil: [self actualClass ifNotNilDo: [:class | class removeSelector: selector]] ifNotNil: [previousVersion fileIn] ! ! !MCMethodDefinition methodsFor: 'annotations' stamp: 'nk 7/24/2003 16:06'! printAnnotations: requests on: aStream "Add a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" requests do: [ :aRequest | aRequest == #timeStamp ifTrue: [ aStream nextPutAll: self timeStamp ]. aRequest == #messageCategory ifTrue: [ aStream nextPutAll: self category ]. aRequest == #requirements ifTrue: [ self requirements do: [ :req | aStream nextPutAll: req ] separatedBy: [ aStream space ]]. ] separatedBy: [ aStream space ].! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 18:15'! cachedDefinitions Definitions ifNil: [Definitions _ WeakIdentityKeyDictionary new. WeakArray addWeakDependent: Definitions]. ^ Definitions! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:05'! className: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString ^ self instanceLike: (self new initializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString)! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 4/1/2003 01:40'! className: classString selector: selectorString category: catString timeStamp: timeString source: sourceString ^ self className: classString classIsMeta: false selector: selectorString category: catString timeStamp: timeString source: sourceString! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'dvf 9/8/2004 00:20'! forMethodReference: aMethodReference | definition | definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: []. (definition isNil or: [definition selector ~= aMethodReference methodSymbol] or: [definition className ~= aMethodReference classSymbol] or: [definition classIsMeta ~= aMethodReference classIsMeta] or: [definition category ~= aMethodReference category]) ifTrue: [definition := self className: aMethodReference classSymbol classIsMeta: aMethodReference classIsMeta selector: aMethodReference methodSymbol category: aMethodReference category timeStamp: aMethodReference timeStamp source: aMethodReference source. self cachedDefinitions at: aMethodReference compiledMethod put: definition]. ^ definition ! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 18:14'! initialize Smalltalk addToShutDownList: self! ! !MCMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 18:14'! shutDown WeakArray removeWeakDependent: Definitions. Definitions _ nil.! ! !MCMockClassD methodsFor: 'as yet unclassified' stamp: 'cwp 7/8/2003 21:21'! one ^ 1! ! !MCMockClassE class methodsFor: 'as yet unclassified' stamp: 'cwp 7/8/2003 21:22'! two ^ 2! ! !MCMockDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 23:21'! token: aString ^ self new token: aString! ! !MCMockDependency methodsFor: 'comparing' stamp: 'cwp 11/7/2004 13:33'! hash ^ self name hash! ! !MCMockDependency methodsFor: 'comparing' stamp: 'cwp 11/7/2004 13:32'! = other ^ self name = other name! ! !MCMockDependency methodsFor: 'accessing' stamp: 'cwp 11/7/2004 14:43'! children ^ children collect: [:ea | self class fromTree: ea]! ! !MCMockDependency methodsFor: 'accessing' stamp: 'cwp 11/7/2004 14:46'! initializeWithTree: expr expr isSymbol ifTrue: [name _ expr. children _ Array new. hasResolution _ true.] ifFalse: [name _ expr first. expr second isSymbol ifTrue: [hasResolution _ false. children _ Array new] ifFalse: [hasResolution _ true. children _ expr second]]! ! !MCMockDependency methodsFor: 'accessing' stamp: 'cwp 11/7/2004 14:38'! name ^ name! ! !MCMockDependency methodsFor: 'resolving' stamp: 'cwp 11/7/2004 14:42'! hasResolution ^ hasResolution! ! !MCMockDependency methodsFor: 'resolving' stamp: 'cwp 11/7/2004 14:16'! resolve ^ self hasResolution ifTrue: [MCVersion new setPackage: MCSnapshotResource mockPackage info: self mockVersionInfo snapshot: MCSnapshotResource current snapshot dependencies: self children] ifFalse: [nil]! ! !MCMockDependency methodsFor: 'mocks' stamp: 'cwp 11/7/2004 14:41'! mockVersionInfo ^ MCVersionInfo name: self name id: (self uuidForName: name) message: '' date: nil time: nil author: '' ancestors: #()! ! !MCMockDependency methodsFor: 'mocks' stamp: 'nk 2/22/2005 21:17'! uuidForName: aName | nm id | nm := aName asString. id := '00000000-0000-0000-0000-0000000000' , (nm size = 1 ifTrue: [nm , '0'] ifFalse: [nm]). ^UUID fromString: id! ! !MCMockDependency class methodsFor: 'instance creation' stamp: 'cwp 11/7/2004 14:43'! fromTree: anArray ^ self new initializeWithTree: anArray! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 01:12'! classes ^ self classNames select: [:name | Smalltalk hasClassNamed: name] thenCollect: [:name | Smalltalk at: name]! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 01:09'! classNames ^ #( MCMockClassA MCMockASubclass MCMockClassB MCMockClassD MCMockClassE MCMockClassF MCMockClassG MCMockClassH MCMockClassI )! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'cwp 8/1/2003 20:25'! extensionMethods ^ Array with: (MethodReference new setStandardClass: MCSnapshotTest methodSymbol: #mockClassExtension)! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'bf 5/20/2005 16:54'! includesClass: aClass ^self classes includes: aClass! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'bf 5/20/2005 17:18'! includesSystemCategory: categoryName ^self systemCategories anySatisfy: [:cat | cat sameAs: categoryName]! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'cwp 8/1/2003 20:31'! packageName ^ 'MonticelloMocks'! ! !MCMockPackageInfo methodsFor: 'as yet unclassified' stamp: 'cwp 7/31/2003 15:30'! systemCategories ^ Array with: 'Monticello-Mocks'! ! !MCMockPackageInfo class methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 14:04'! initialize [self new register] on: MessageNotUnderstood do: []! ! !MCNoChangesException methodsFor: 'as yet unclassified' stamp: 'jf 8/21/2003 19:49'! defaultAction self inform: 'No changes'! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 21:47'! accept: aVisitor ^ aVisitor visitOrganizationDefinition: self! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 5/24/2003 13:51'! categories ^ categories! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 5/24/2003 13:39'! categories: anArray categories _ anArray! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'avi 9/30/2004 21:56'! commonPrefix | stream | categories isEmpty ifTrue: [^ '']. stream _ String new writeStream. categories first withIndexDo: [:c :i| categories do: [:ea | (ea at: i ifAbsent: []) = c ifFalse: [^ stream contents]]. stream nextPut: c]. ^ stream contents! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2004 14:53'! description ^ Array with: #organization with: self commonPrefix! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'cwp 7/11/2003 01:33'! isOrganizationDefinition ^ true! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 13:46'! postloadOver: oldDefinition SystemOrganization categories: (self reorderCategories: SystemOrganization categories original: (oldDefinition ifNil: [#()] ifNotNil: [oldDefinition categories]))! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 13:26'! reorderCategories: allCategories original: oldCategories | first | first _ allCategories detect: [:ea | categories includes: ea] ifNone: [^ allCategories]. ^ ((allCategories copyUpTo: first) copyWithoutAll: oldCategories, categories), categories, ((allCategories copyAfter: first) copyWithoutAll: oldCategories, categories) ! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 18:01'! sortKey ^ ''! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 7/22/2003 01:14'! source ^ String streamContents: [:s | categories do: [:ea | s nextPutAll: ea] separatedBy: [s cr]]! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 5/24/2003 13:55'! summary ^ categories asArray printString! ! !MCOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 18:25'! = aDefinition ^ (super = aDefinition) and: [categories = aDefinition categories]! ! !MCOrganizationDefinition class methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:06'! categories: anArray ^ self instanceLike: (self new categories: anArray)! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ar 4/26/2005 21:57'! hash ^ name asLowercase hash! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'bf 4/19/2005 16:26'! hasWorkingCopy ^ MCWorkingCopy registry includesKey: self! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 00:57'! name ^ name! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 00:57'! name: aString name _ aString! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 13:33'! packageInfo ^ PackageInfo named: name! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'nk 7/28/2003 13:30'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: name; nextPut: $)! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'bf 3/17/2005 18:35'! snapshot | packageInfo definitions categories | packageInfo := self packageInfo. definitions := OrderedCollection new. categories := packageInfo systemCategories. categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ]. packageInfo methods do: [:ea | definitions add: ea asMethodDefinition] displayingProgress: 'Snapshotting methods...'. (packageInfo respondsTo: #overriddenMethods) ifTrue: [packageInfo overriddenMethods do: [:ea | definitions add: (packageInfo changeRecordForOverriddenMethod: ea) asMethodDefinition] displayingProgress: 'Searching for overrides...']. packageInfo classes do: [:ea | definitions addAll: ea classDefinitions] displayingProgress: 'Snapshotting classes...'. (packageInfo respondsTo: #hasPreamble) ifTrue: [ packageInfo hasPreamble ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)]. packageInfo hasPostscript ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)]. packageInfo hasPreambleOfRemoval ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)]. packageInfo hasPostscriptOfRemoval ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]]. ^ MCSnapshot fromDefinitions: definitions ! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ab 7/10/2003 01:13'! storeOn: aStream aStream nextPutAll: 'MCPackage'; space; nextPutAll: 'named: '; store: name.! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'cwp 11/13/2003 13:32'! unload ^ self workingCopy unload! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'cwp 11/13/2003 13:33'! workingCopy ^ MCWorkingCopy forPackage: self.! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'ar 4/26/2005 21:57'! = other ^ other species = self species and: [other name sameAs: name]! ! !MCPackage class methodsFor: 'as yet unclassified' stamp: 'ab 7/10/2003 01:17'! named: aString ^ self new name: aString! ! !MCPackageCache methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:12'! initialize sorter _ MCVersionSorter new. fileNames _ Dictionary new.! ! !MCPackageCache methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:25'! recordVersionInfo: aVersionInfo forFileNamed: aString Transcript cr; show: aString. fileNames at: aVersionInfo put: aString. sorter addVersionInfo: aVersionInfo! ! !MCPackageCache methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:21'! versionInfos ^ sorter sortedVersionInfos ! ! !MCPackageCache class methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:12'! new ^ self basicNew initialize! ! !MCPackageLoader methodsFor: 'patch ops' stamp: 'ab 5/24/2003 16:13'! addDefinition: aDefinition additions add: aDefinition! ! !MCPackageLoader methodsFor: 'patch ops' stamp: 'avi 2/17/2004 13:14'! modifyDefinition: old to: new self addDefinition: new. obsoletions at: new put: old.! ! !MCPackageLoader methodsFor: 'patch ops' stamp: 'ab 5/24/2003 16:14'! removeDefinition: aDefinition removals add: aDefinition! ! !MCPackageLoader methodsFor: 'private' stamp: 'ab 7/19/2003 18:02'! analyze | sorter | sorter _ self sorterForItems: additions. additions _ sorter orderedItems. requirements _ sorter externalRequirements. unloadableDefinitions _ sorter itemsWithMissingRequirements asSortedCollection. sorter _ self sorterForItems: removals. removals _ sorter orderedItems reversed.! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 9/1/2004 01:13'! basicLoad errorDefinitions _ OrderedCollection new. [[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'. removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'. self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea loadOver: (self obsoletionFor: ea)] displayingProgress: 'Reloading...'. additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...'] on: InMidstOfFileinNotification do: [:n | n resume: true]] ensure: [self flushChangesFile]! ! !MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:24'! dependencyWarning ^ String streamContents: [:s | s nextPutAll: 'This package depends on the following classes:'; cr. requirements do: [:ea | s space; space; nextPutAll: ea; cr]. s nextPutAll: 'You must resolve these dependencies before you will be able to load these definitions: '; cr. unloadableDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 1/24/2004 17:44'! errorDefinitionWarning ^ String streamContents: [:s | s nextPutAll: 'The following definitions had errors while loading. Press Proceed to try to load them again (they may work on a second pass):'; cr. errorDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! ! !MCPackageLoader methodsFor: 'private' stamp: 'cwp 11/13/2003 02:01'! flushChangesFile "The changes file is second in the SourceFiles array" (SourceFiles at: 2) flush! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 2/17/2004 13:13'! initialize additions _ OrderedCollection new. removals _ OrderedCollection new. obsoletions _ Dictionary new. ! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 2/17/2004 13:15'! obsoletionFor: aDefinition ^ obsoletions at: aDefinition ifAbsent: [nil]! ! !MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:19'! orderDefinitionsForLoading: aCollection ^ (self sorterForItems: aCollection) orderedItems! ! !MCPackageLoader methodsFor: 'private' stamp: 'ab 5/24/2003 16:52'! orderedAdditions ^ additions! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 9/1/2004 01:09'! provisions ^ provisions ifNil: [provisions _ Set withAll: Smalltalk keys]! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 1/25/2004 13:32'! shouldWarnAboutErrors ^ errorDefinitions isEmpty not and: [false "should make this a preference"]! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 10/7/2004 22:49'! sorterForItems: aCollection | sorter | sorter _ MCDependencySorter items: aCollection. sorter addExternalProvisions: self provisions. ^ sorter! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 2/17/2004 13:15'! tryToLoad: aDefinition [aDefinition loadOver: (self obsoletionFor: aDefinition)] on: Error do: [errorDefinitions add: aDefinition].! ! !MCPackageLoader methodsFor: 'private' stamp: 'nk 2/23/2005 07:34'! useChangeSetNamed: baseName during: aBlock "Use the named change set, or create one with the given name." | changeHolder oldChanges newChanges | changeHolder _ (ChangeSet respondsTo: #newChanges:) ifTrue: [ChangeSet] ifFalse: [Smalltalk]. oldChanges _ (ChangeSet respondsTo: #current) ifTrue: [ChangeSet current] ifFalse: [Smalltalk changes]. newChanges _ (ChangeSorter changeSetNamed: baseName) ifNil: [ ChangeSet new name: baseName ]. changeHolder newChanges: newChanges. [aBlock value] ensure: [changeHolder newChanges: oldChanges]. ! ! !MCPackageLoader methodsFor: 'private' stamp: 'nk 8/30/2004 08:38'! useNewChangeSetDuring: aBlock ^self useNewChangeSetNamedLike: 'MC' during: aBlock! ! !MCPackageLoader methodsFor: 'private' stamp: 'nk 2/23/2005 07:50'! useNewChangeSetNamedLike: baseName during: aBlock ^self useChangeSetNamed: (ChangeSet uniqueNameLike: baseName) during: aBlock! ! !MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:22'! warnAboutDependencies self notify: self dependencyWarning! ! !MCPackageLoader methodsFor: 'private' stamp: 'avi 1/24/2004 17:42'! warnAboutErrors self notify: self errorDefinitionWarning. ! ! !MCPackageLoader methodsFor: 'public' stamp: 'ab 7/6/2003 23:30'! installSnapshot: aSnapshot | patch | patch _ aSnapshot patchRelativeToBase: MCSnapshot empty. patch applyTo: self. ! ! !MCPackageLoader methodsFor: 'public' stamp: 'ab 8/24/2003 01:03'! load self analyze. unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. self useNewChangeSetDuring: [self basicLoad]! ! !MCPackageLoader methodsFor: 'public' stamp: 'nk 8/30/2004 08:39'! loadWithNameLike: baseName self analyze. unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. self useNewChangeSetNamedLike: baseName during: [self basicLoad]! ! !MCPackageLoader methodsFor: 'public' stamp: 'nk 2/23/2005 07:51'! loadWithName: baseName self analyze. unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. self useChangeSetNamed: baseName during: [self basicLoad]! ! !MCPackageLoader methodsFor: 'public' stamp: 'avi 10/5/2003 11:09'! unloadPackage: aPackage self updatePackage: aPackage withSnapshot: MCSnapshot empty! ! !MCPackageLoader methodsFor: 'public' stamp: 'avi 9/1/2004 01:09'! updatePackage: aPackage withSnapshot: aSnapshot | patch packageSnap | packageSnap _ aPackage snapshot. patch _ aSnapshot patchRelativeToBase: packageSnap. patch applyTo: self. packageSnap definitions do: [:ea | self provisions addAll: ea provisions] ! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 23:30'! installSnapshot: aSnapshot self new installSnapshot: aSnapshot; load! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'bf 12/5/2004 12:00'! unloadPackage: aPackage self new unloadPackage: aPackage; loadWithNameLike: aPackage name, '-unload'! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 12:11'! updatePackage: aPackage withSnapshot: aSnapshot self new updatePackage: aPackage withSnapshot: aSnapshot; load! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! classModified: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! classMoved: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! classRemoved: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! methodModified: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! methodMoved: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! methodRemoved: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! registerForNotifications "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! registerForNotificationsFrom: aNotifier "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:17'! systemChange: anEvent "obsolete - remove this later"! ! !MCPackageManager methodsFor: 'system changes' stamp: 'avi 11/11/2003 12:06'! update: aSymbol InMidstOfFileinNotification signal ifFalse: [ [((aSymbol = #recentMethodSubmissions) and: [self packageInfo includesMethodReference: Utilities recentMethodSubmissions last]) ifTrue: [self modified: true]] on: Error do: []]! ! !MCPackageManager methodsFor: 'initialize-release' stamp: 'avi 3/4/2004 16:43'! initialize modified _ false. self registerForNotifications.! ! !MCPackageManager methodsFor: 'initialize-release' stamp: 'ab 7/7/2003 16:27'! initializeWithPackage: aPackage package _ aPackage. self initialize.! ! !MCPackageManager methodsFor: 'accessing' stamp: 'cwp 11/13/2003 14:12'! modified ^ modified! ! !MCPackageManager methodsFor: 'accessing' stamp: 'avi 9/10/2004 17:44'! modified: aBoolean modified = aBoolean ifTrue: [^ self]. modified _ aBoolean. self changed: #modified. modified ifFalse: [(((Smalltalk classNamed: 'SmalltalkImage') ifNotNilDo: [:si | si current]) ifNil: [Smalltalk]) logChange: '"', self packageName, '"'].! ! !MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/7/2003 16:47'! package ^ package! ! !MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/7/2003 13:33'! packageInfo ^ package packageInfo! ! !MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/7/2003 12:18'! packageName ^ package name! ! !MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/5/2003 23:18'! packageNameWithStar ^ modified ifTrue: ['* ', self packageName] ifFalse: [self packageName]! ! !MCPackageManager methodsFor: 'operations' stamp: 'ab 7/19/2003 23:30'! unregister self class registry removeKey: package. self class changed: #allManagers! ! !MCPackageManager class methodsFor: 'as yet unclassified' stamp: 'ab 3/31/2003 20:45'! allManagers ^ self registry values! ! !MCPackageManager class methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 16:28'! forPackage: aPackage ^ self registry at: aPackage ifAbsent: [|mgr| mgr _ self new initializeWithPackage: aPackage. self registry at: aPackage put: mgr. self changed: #allManagers. mgr]! ! !MCPackageManager class methodsFor: 'as yet unclassified' stamp: 'ar 4/27/2005 02:09'! initialize "Remove this later" Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| (cls uniqueInstance) noMoreNotificationsFor: self. ].! ! !MCPackageManager class methodsFor: 'as yet unclassified' stamp: 'ab 5/9/2003 12:59'! registry ^ registry ifNil: [registry _ Dictionary new]! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/27/2005 14:28'! classModified: anEvent self managersForClass: anEvent item do:[:mgr| mgr modified: true].! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:31'! classMoved: anEvent self classModified: anEvent. self managersForCategory: anEvent oldCategory do:[:mgr| mgr modified: true].! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:31'! classRemoved: anEvent self classModified: anEvent! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'bf 5/20/2005 17:15'! managersForCategory: aSystemCategory do: aBlock "Got to be careful here - we might get method categories where capitalization is problematic." | cat foundOne index | foundOne := false. cat := aSystemCategory. "first ask PackageInfos, their package name might not match the category" self registry do: [:mgr | (mgr packageInfo includesSystemCategory: aSystemCategory) ifTrue: [ aBlock value: mgr. foundOne := true. ] ]. foundOne ifTrue: [^self]. ["Loop over categories until we found a matching one" self registry at: (MCPackage named: cat) ifPresent:[:mgr| aBlock value: mgr. foundOne := true. ]. index := cat lastIndexOf: $-. index > 0]whileTrue:[ "Step up to next level package" cat := cat copyFrom: 1 to: index-1. ]. foundOne ifFalse:[ "Create a new (but only top-level)" aBlock value: (MCWorkingCopy forPackage: (MCPackage named: (aSystemCategory upTo: $-) capitalized)). ].! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/27/2005 14:11'! managersForClass: aClass category: methodCategory do: aBlock (methodCategory isEmptyOrNil or:[methodCategory first ~= $*]) ifTrue:[ "Not an extension method" ^self managersForClass: aClass do: aBlock. ]. self managersForCategory: methodCategory allButFirst do: aBlock.! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'bf 5/20/2005 16:50'! managersForClass: aClass do: aBlock self registry do: [:mgr | (mgr packageInfo includesClass: aClass) ifTrue: [aBlock value: mgr]]! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:40'! managersForClass: aClass selector: aSelector do: aBlock ^self managersForClass: aClass category: (aClass organization categoryOfElement: aSelector) do: aBlock! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:40'! methodModified: anEvent ^self managersForClass: anEvent itemClass selector: anEvent itemSelector do:[:mgr| mgr modified: true].! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:40'! methodMoved: anEvent self managersForClass: anEvent itemClass category: anEvent oldCategory do:[:mgr| mgr modified: true]. self methodModified: anEvent.! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:12'! methodRemoved: anEvent self managersForClass: anEvent itemClass category: anEvent itemProtocol do:[:mgr| mgr modified: true]. ! ! !MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 22:18'! registerForNotifications Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| (cls uniqueInstance) noMoreNotificationsFor: self; notify: self ofSystemChangesOfItem: #class change: #Added using: #classModified:; notify: self ofSystemChangesOfItem: #class change: #Modified using: #classModified:; notify: self ofSystemChangesOfItem: #class change: #Renamed using: #classModified:; notify: self ofSystemChangesOfItem: #class change: #Commented using: #classModified:; notify: self ofSystemChangesOfItem: #class change: #Recategorized using: #classMoved:; notify: self ofSystemChangesOfItem: #class change: #Removed using: #classRemoved:; notify: self ofSystemChangesOfItem: #method change: #Added using: #methodModified:; notify: self ofSystemChangesOfItem: #method change: #Modified using: #methodModified:; notify: self ofSystemChangesOfItem: #method change: #Recategorized using: #methodMoved:; notify: self ofSystemChangesOfItem: #method change: #Removed using: #methodRemoved: ].! ! !MCPatch methodsFor: 'applying' stamp: 'ab 5/24/2003 16:12'! applyTo: anObject operations do: [:ea | ea applyTo: anObject]. ! ! !MCPatch methodsFor: 'ui' stamp: 'cwp 8/2/2003 13:34'! browse ^ (MCPatchBrowser forPatch: self) show! ! !MCPatch methodsFor: 'intializing' stamp: 'ab 6/2/2003 00:44'! initializeWithBase: baseSnapshot target: targetSnapshot | base target | operations _ OrderedCollection new. base _ MCDefinitionIndex definitions: baseSnapshot definitions. target _ MCDefinitionIndex definitions: targetSnapshot definitions. target definitions do: [:t | base definitionLike: t ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]] ifAbsent: [operations add: (MCAddition of: t)]] displayingProgress: 'Diffing...'. base definitions do: [:b | target definitionLike: b ifPresent: [:t] ifAbsent: [operations add: (MCRemoval of: b)]] ! ! !MCPatch methodsFor: 'intializing' stamp: 'avi 9/11/2004 15:49'! initializeWithOperations: aCollection operations _ aCollection! ! !MCPatch methodsFor: 'querying' stamp: 'cwp 6/9/2003 11:53'! isEmpty ^ operations isEmpty! ! !MCPatch methodsFor: 'accessing' stamp: 'ab 5/13/2003 12:18'! operations ^ operations! ! !MCPatch class methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 15:49'! fromBase: baseSnapshot target: targetSnapshot ^ self new initializeWithBase: baseSnapshot target: targetSnapshot! ! !MCPatch class methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 15:50'! operations: aCollection ^ self basicNew initializeWithOperations: aCollection! ! !MCPatcher methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:46'! addDefinition: aDefinition definitions add: aDefinition! ! !MCPatcher methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 23:49'! initializeWithSnapshot: aSnapshot definitions _ MCDefinitionIndex definitions: aSnapshot definitions! ! !MCPatcher methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 14:23'! modifyDefinition: baseDefinition to: targetDefinition self addDefinition: targetDefinition! ! !MCPatcher methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 23:48'! patchedSnapshot ^ MCSnapshot fromDefinitions: definitions definitions! ! !MCPatcher methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:46'! removeDefinition: aDefinition definitions remove: aDefinition! ! !MCPatcher class methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 00:53'! apply: aPatch to: aSnapshot | loader | loader _ self snapshot: aSnapshot. aPatch applyTo: loader. ^ loader patchedSnapshot! ! !MCPatcher class methodsFor: 'as yet unclassified' stamp: 'ab 6/1/2003 14:22'! snapshot: aSnapshot ^ self new initializeWithSnapshot: aSnapshot! ! !MCPatchOperation methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:11'! <= other ^ self definition <= other definition! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'nk 11/10/2003 21:38'! annotations ^self annotations: Preferences defaultAnnotationRequests! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'nk 11/10/2003 21:39'! annotations: requests "Answer a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" ^String streamContents: [ :s | self printAnnotations: requests on: s ].! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'cwp 11/28/2002 06:59'! definition ^ self subclassResponsibility ! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:26'! inverse self subclassResponsibility! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'avi 8/31/2003 17:53'! prefixForOperation: aSymbol aSymbol == #insert ifTrue: [^ '+']. aSymbol == #remove ifTrue: [^ '-']. ^ ' '! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'nk 11/10/2003 21:40'! printAnnotations: requests on: aStream "Add a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" self definition printAnnotations: requests on: aStream.! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'avi 8/31/2003 17:55'! source ^ self sourceText! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'nk 2/25/2005 17:26'! sourceString ^self sourceText asString! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'nk 2/25/2005 17:29'! sourceText | builder | builder := (Preferences diffsWithPrettyPrint and: [ self targetClass notNil and: [ self isClassPatch not ] ]) ifTrue: [PrettyTextDiffBuilder from: self fromSource to: self toSource inClass: self targetClass] ifFalse: [TextDiffBuilder from: self fromSource to: self toSource]. ^builder buildDisplayPatch.! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'ab 7/6/2003 00:06'! summary ^ self definition summary, self summarySuffix! ! !MCPatchOperation methodsFor: 'accessing' stamp: 'ab 7/6/2003 00:06'! summarySuffix ^ ''! ! !MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'! isAddition ^ false! ! !MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'! isModification ^ false! ! !MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'! isRemoval ^ false! ! !MCPatchOperation methodsFor: 'as yet unclassified' stamp: 'nk 2/25/2005 17:28'! isClassPatch ^false! ! !MCPatchOperation methodsFor: 'as yet unclassified' stamp: 'nk 2/23/2005 18:17'! targetClass self subclassResponsibility.! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 5/24/2003 16:11'! applyTo: anObject anObject addDefinition: definition! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:09'! baseDefinition ^ nil! ! !MCAddition methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:32'! definition ^ definition! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:45'! fromSource ^ ''! ! !MCAddition methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:39'! sourceString ^(self toSource asText) addAttribute: TextColor red; yourself! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 5/13/2003 12:18'! summary ^ definition summary! ! !MCAddition methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:17'! targetClass ^definition actualClass ! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:09'! targetDefinition ^ definition! ! !MCAddition methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:45'! toSource ^ definition source! ! !MCAddition methodsFor: 'initializing' stamp: 'cwp 11/27/2002 10:01'! intializeWithDefinition: aDefinition definition _ aDefinition! ! !MCAddition methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 02:26'! inverse ^ MCRemoval of: definition! ! !MCAddition methodsFor: 'as yet unclassified' stamp: 'nk 2/25/2005 17:28'! isClassPatch ^definition isClassDefinition! ! !MCAddition methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:22'! isAddition ^ true! ! !MCAddition class methodsFor: 'as yet unclassified' stamp: 'cwp 11/27/2002 10:03'! of: aDefinition ^ self new intializeWithDefinition: aDefinition! ! !MCModification methodsFor: 'accessing' stamp: 'ab 5/24/2003 16:12'! applyTo: anObject anObject modifyDefinition: obsoletion to: modification! ! !MCModification methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'! baseDefinition ^ obsoletion! ! !MCModification methodsFor: 'accessing' stamp: 'cwp 11/28/2002 06:55'! definition ^ modification! ! !MCModification methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:44'! fromSource ^ obsoletion source! ! !MCModification methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:46'! modification ^ modification! ! !MCModification methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:48'! obsoletion ^ obsoletion! ! !MCModification methodsFor: 'accessing' stamp: 'nk 10/21/2003 22:54'! summarySuffix ^self fromSource = self toSource ifTrue: [ ' (source same but rev changed)' ] ifFalse: [ ' (changed)' ]! ! !MCModification methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:18'! targetClass ^ obsoletion actualClass! ! !MCModification methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'! targetDefinition ^ modification! ! !MCModification methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:44'! toSource ^ modification source! ! !MCModification methodsFor: 'initializing' stamp: 'cwp 11/28/2002 07:18'! initializeWithBase: base target: target obsoletion _ base. modification _ target.! ! !MCModification methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 02:27'! inverse ^ MCModification of: modification to: obsoletion! ! !MCModification methodsFor: 'as yet unclassified' stamp: 'nk 2/25/2005 17:29'! isClassPatch ^obsoletion isClassDefinition! ! !MCModification methodsFor: 'as yet unclassified' stamp: 'nk 11/10/2003 21:44'! printAnnotations: request on: aStream aStream nextPutAll: 'old: '. obsoletion printAnnotations: request on: aStream. aStream cr. aStream nextPutAll: 'new: '. modification printAnnotations: request on: aStream.! ! !MCModification methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:23'! isModification ^ true! ! !MCModification class methodsFor: 'as yet unclassified' stamp: 'cwp 11/28/2002 07:19'! of: base to: target ^ self new initializeWithBase: base target: target! ! !MCReader methodsFor: 'lifecycle' stamp: 'avi 1/24/2004 17:52'! initialize! ! !MCReader methodsFor: 'accessing' stamp: 'avi 1/21/2004 19:00'! stream: aStream stream _ aStream! ! !MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:00'! canReadFileNamed: fileName ^ (fileName endsWith: self extension)! ! !MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:01'! concreteSubclasses ^ self allSubclasses reject: [:c | c isAbstract]! ! !MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:01'! isAbstract ^ (self respondsTo: #extension) not! ! !MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:03'! readerClassForFileNamed: fileName ^ self concreteSubclasses detect: [:c | c canReadFileNamed: fileName] ifNone: [nil]! ! !MCReader class methodsFor: 'instance creation' stamp: 'avi 1/21/2004 19:02'! new ^ self basicNew initialize! ! !MCReader class methodsFor: 'instance creation' stamp: 'avi 1/21/2004 19:02'! on: aStream ^ self new stream: aStream! ! !MCReader class methodsFor: 'instance creation' stamp: 'avi 1/21/2004 19:02'! on: aStream name: aFileName | class | class _ self readerClassForFileNamed: aFileName. ^ class ifNil: [self error: 'Unsupported format: ', aFileName] ifNotNil: [class on: aStream]! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 5/24/2003 16:11'! applyTo: anObject anObject removeDefinition: definition! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'! baseDefinition ^ definition! ! !MCRemoval methodsFor: 'accessing' stamp: 'cwp 11/27/2002 10:02'! definition ^ definition! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:44'! fromSource ^ definition source! ! !MCRemoval methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:38'! sourceString ^self fromSource asText addAttribute: TextEmphasis struckOut; addAttribute: TextColor blue; yourself! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 5/13/2003 12:22'! summary ^ definition summary, ' (removed)'! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 7/6/2003 00:05'! summarySuffix ^ ' (removed)'! ! !MCRemoval methodsFor: 'accessing' stamp: 'nk 2/25/2005 17:23'! targetClass ^ definition actualClass! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'! targetDefinition ^ nil! ! !MCRemoval methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:44'! toSource ^ ''! ! !MCRemoval methodsFor: 'initializing' stamp: 'cwp 11/27/2002 10:02'! intializeWithDefinition: aDefinition definition _ aDefinition! ! !MCRemoval methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 02:26'! inverse ^ MCAddition of: definition! ! !MCRemoval methodsFor: 'as yet unclassified' stamp: 'nk 2/25/2005 17:28'! isClassPatch ^definition isClassDefinition! ! !MCRemoval methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:24'! isRemoval ^ true! ! !MCRemoval class methodsFor: 'as yet unclassified' stamp: 'cwp 11/27/2002 10:03'! of: aDefinition ^ self new intializeWithDefinition: aDefinition! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2004 01:08'! alwaysStoreDiffs ^ storeDiffs ifNil: [false]! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:48'! asCreationTemplate ^ self creationTemplate! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:20'! basicStoreVersion: aVersion self subclassResponsibility! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:06'! closestAncestorVersionFor: anAncestry ifNone: errorBlock anAncestry allAncestors do: [:ancestorInfo | (self versionWithInfo: ancestorInfo) ifNotNilDo: [:v | ^ v]]. ^ errorBlock value! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:46'! creationTemplate ^ creationTemplate! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:47'! creationTemplate: aString self creationTemplate ifNotNil: [ self error: 'Creation template already set for this MCRepository instance.' ]. creationTemplate _ aString.! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:53'! description ^ self class name! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2004 01:08'! doAlwaysStoreDiffs storeDiffs _ true! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2004 01:09'! doNotAlwaysStoreDiffs storeDiffs _ false! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:36'! hash ^ self description hash! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 20:13'! initialize! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:27'! notificationForVersion: aVersion ^ MCVersionNotification version: aVersion repository: self! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:23'! notifyList ^ #()! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'bf 3/10/2005 23:01'! possiblyNewerVersionsOfAnyOf: someVersions ^#()! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2004 01:06'! prepareVersionForStorage: aVersion ^ self alwaysStoreDiffs ifTrue: [aVersion asDiffAgainst: (self closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])] ifFalse: [aVersion]! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'mas 9/24/2003 04:21'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self description; nextPut: $).! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:24'! sendNotificationsForVersion: aVersion | notification notifyList | notifyList _ self notifyList. notifyList isEmpty ifFalse: [notification _ self notificationForVersion: aVersion. notifyList do: [:ea | notification notify: ea]]! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2004 01:05'! storeVersion: aVersion self basicStoreVersion: (self prepareVersionForStorage: aVersion). self sendNotificationsForVersion: aVersion! ! !MCRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:36'! = other ^ other species = self species and: [other description = self description]! ! !MCRepository methodsFor: 'interface' stamp: 'ab 8/21/2003 12:40'! includesVersionNamed: aString self subclassResponsibility! ! !MCRepository methodsFor: 'interface' stamp: 'lr 9/26/2003 20:03'! morphicOpen self morphicOpen: nil! ! !MCRepository methodsFor: 'interface' stamp: 'lr 9/26/2003 20:03'! morphicOpen: aWorkingCopy self subclassResponsibility ! ! !MCRepository methodsFor: 'interface' stamp: 'bf 4/14/2005 17:30'! openAndEditTemplateCopy ^ self class fillInTheBlankConfigure: (self asCreationTemplate ifNil: [^nil])! ! !MCRepository methodsFor: 'interface' stamp: 'avi 10/9/2003 12:42'! versionWithInfo: aVersionInfo ^ self versionWithInfo: aVersionInfo ifAbsent: [nil]! ! !MCRepository methodsFor: 'interface' stamp: 'ab 8/16/2003 18:22'! versionWithInfo: aVersionInfo ifAbsent: aBlock self subclassResponsibility ! ! !MCRepository methodsFor: 'testing' stamp: 'nk 11/2/2003 10:55'! isValid ^true! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/20/2003 21:04'! allVersionInfos ^ dict values collect: [:ea | ea info]! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:20'! basicStoreVersion: aVersion dict at: aVersion info put: aVersion! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:06'! closestAncestorVersionFor: anAncestry ifNone: errorBlock | info | info _ anAncestry allAncestors detect: [:ea | self includesVersionWithInfo: ea] ifNone: [^ errorBlock value]. ^ self versionWithInfo: info! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:47'! description ^ description ifNil: ['cache']! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:50'! description: aString description _ aString ! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:47'! dictionary ^ dict! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:47'! dictionary: aDictionary dict _ aDictionary! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/21/2003 23:39'! includesVersionNamed: aString ^ dict anySatisfy: [:ea | ea info name = aString]! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 19:49'! includesVersionWithInfo: aVersionInfo ^ dict includesKey: aVersionInfo! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/12/2004 19:33'! initialize dict _ Dictionary new. ! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'lr 9/26/2003 20:03'! morphicOpen: aWorkingCopy | names index infos | infos _ self sortedVersionInfos. infos isEmpty ifTrue: [^ self inform: 'No versions']. names _ infos collect: [:ea | ea name]. index _ (PopUpMenu labelArray: names) startUpWithCaption: 'Open version:'. index = 0 ifFalse: [(self versionWithInfo: (infos at: index)) open]! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:40'! sortedVersionInfos | sorter | sorter _ MCVersionSorter new. self allVersionInfos do: [:ea | sorter addVersionInfo: ea]. ^ sorter sortedVersionInfos ! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/16/2003 18:22'! versionWithInfo: aVersionInfo ifAbsent: errorBlock ^ dict at: aVersionInfo ifAbsent: errorBlock! ! !MCDictionaryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:56'! = other ^ self == other! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 00:35'! allFileNames self subclassResponsibility! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 20:01'! allFileNamesForVersionNamed: aString ^ self filterFileNames: self readableFileNames forVersionNamed: aString! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 00:40'! allVersionNames ^ self readableFileNames collect: [:ea | self versionNameFromFileName: ea]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 6/20/2005 15:02'! basicStoreVersion: aVersion self writeStreamForFileNamed: aVersion fileName do: [:s | aVersion fileOutOn: s]. aVersion isCacheable ifTrue: [ cache ifNil: [cache _ Dictionary new]. cache at: aVersion fileName put: aVersion]. ! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 6/9/2005 15:47'! cachedFileNames ^cache == nil ifTrue: [#()] ifFalse: [cache keys]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/21/2004 22:57'! canReadFileNamed: aString | reader | reader _ MCVersionReader readerClassForFileNamed: aString. ^ reader notNil! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 20:01'! filterFileNames: aCollection forVersionNamed: aString ^ aCollection select: [:ea | (self versionNameFromFileName: ea) = aString] ! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/3/2005 00:43'! flushCache cache _ nil! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 00:36'! includesVersionNamed: aString ^ self allVersionNames includes: aString! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 13:34'! loadVersionFromFileNamed: aString ^ self versionReaderForFileNamed: aString do: [:r | r version]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 18:32'! morphicOpen: aWorkingCopy (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:34'! notifyList | list | (self allFileNames includes: 'notify') ifFalse: [^ #()]. ^ self readStreamForFileNamed: 'notify' do: [:s | s upToEnd withSqueakLineEndings findTokens: (String with: Character cr)]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 3/11/2005 18:01'! possiblyNewerVersionsOfAnyOf: someVersions | pkgs | pkgs := Dictionary new. someVersions do: [:aVersionInfo | pkgs at: (aVersionInfo name copyUpToLast: $-) put: (aVersionInfo name copyAfterLast: $.) asNumber]. ^[self allVersionNames select: [:each | (pkgs at: (each copyUpToLast: $-) ifPresent: [:verNumber | verNumber < (each copyAfterLast: $.) asNumber or: [verNumber = (each copyAfterLast: $.) asNumber and: [someVersions noneSatisfy: [:v | v name = each]]]]) == true] ] on: Error do: [:ex | ex return: #()]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 6/9/2005 17:02'! readableFileNames | all cached new | all := self allFileNames. "from repository" cached := self cachedFileNames. "in memory" new := all difference: cached. ^ (cached asArray, new) select: [:ea | self canReadFileNamed: ea]! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 5/23/2005 18:45'! versionFromFileNamed: aString | v | cache ifNil: [cache _ Dictionary new]. v := cache at: aString ifAbsent: [self loadVersionFromFileNamed: aString]. (v notNil and: [v isCacheable]) ifTrue: [cache at: aString put: v]. ^ v! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 5/30/2005 22:52'! versionNameFromFileName: aString ^ (aString copyUpToLast: $.) copyUpTo: $(! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'bf 3/23/2005 01:19'! versionReaderForFileNamed: aString do: aBlock ^ self readStreamForFileNamed: aString do: [:s | (MCVersionReader readerClassForFileNamed: aString) ifNotNilDo: [:class | aBlock value: (class on: s fileName: aString)]] ! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/26/2003 16:27'! versionWithInfo: aVersionInfo ifAbsent: errorBlock | version | (self allFileNamesForVersionNamed: aVersionInfo name) do: [:fileName | version _ self versionFromFileNamed: fileName. version info = aVersionInfo ifTrue: [^ version]]. ^ errorBlock value! ! !MCFileBasedRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/31/2003 14:32'! writeStreamForFileNamed: aString do: aBlock ^ self writeStreamForFileNamed: aString replace: false do: aBlock! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2003 15:28'! allFileNames ^ (directory entries sortBy: [:a :b | a modificationTime >= b modificationTime]) collect: [:ea | ea name]! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:57'! description ^ directory pathName! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 17:49'! directory ^ directory! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 12:56'! directory: aDirectory directory _ aDirectory! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:37'! initialize directory _ FileDirectory default! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'nk 11/2/2003 10:55'! isValid ^directory exists! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:45'! readStreamForFileNamed: aString do: aBlock | file val | file _ FileStream readOnlyFileNamed: (directory fullNameFor: aString). val _ aBlock value: file. file close. ^ val! ! !MCDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/31/2003 14:35'! writeStreamForFileNamed: aString replace: aBoolean do: aBlock | file sel | sel _ aBoolean ifTrue: [#forceNewFileNamed:] ifFalse: [#newFileNamed:]. file _ FileStream perform: sel with: (directory fullNameFor: aString). aBlock value: file. file close.! ! !MCDirectoryRepository methodsFor: 'comparing' stamp: 'ab 7/19/2003 21:40'! hash ^ directory pathName hash! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'bf 3/23/2005 00:52'! basicStoreVersion: aVersion (aVersion isCacheable and: [self allFileNames includes: aVersion fileName]) ifFalse: [super basicStoreVersion: aVersion] ! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:13'! cacheForPackage: aPackage packageCaches ifNil: [packageCaches _ Dictionary new]. ^ packageCaches at: aPackage ifAbsentPut: [MCPackageCache new]! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:15'! newFileNames ^ self allFileNames difference: self seenFileNames! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 15:13'! packageForFileNamed: aString ^ self packageCache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r package]]! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:29'! rescan self newFileNames do: [:ea | self versionReaderForFileNamed: ea do: [:reader | (self cacheForPackage: reader package) recordVersionInfo: reader info forFileNamed: ea. self seenFileNames add: ea]] displayingProgress: 'Scanning cache...'! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 18:15'! seenFileNames ^ seenFiles ifNil: [seenFiles _ OrderedCollection new]! ! !MCCacheRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 15:05'! versionInfoForFileNamed: aString ^ self infoCache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r info]]! ! !MCFtpRepository methodsFor: 'required' stamp: 'avi 9/16/2003 14:04'! allFileNames ^ self clientDo: [:client | self parseDirectoryListing: client getDirectory]! ! !MCFtpRepository methodsFor: 'required' stamp: 'avi 9/17/2003 12:52'! description ^ 'ftp://', user, '@', host, '/', directory! ! !MCFtpRepository methodsFor: 'required' stamp: 'avi 9/16/2003 16:57'! readStreamForFileNamed: aString do: aBlock | stream | ^ self clientDo: [:client | client binary. stream _ RWBinaryOrTextStream on: String new. stream nextPutAll: (client getFileNamed: aString). aBlock value: stream reset]! ! !MCFtpRepository methodsFor: 'required' stamp: 'avi 10/31/2003 14:35'! writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream | stream _ RWBinaryOrTextStream on: String new. aBlock value: stream. self clientDo: [:client | client binary. client putFileStreamContents: stream reset as: aString]! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 16:57'! clientDo: aBlock | client | client _ FTPClient openOnHostNamed: host. client loginUser: user password: password. directory isEmpty ifFalse: [client changeDirectoryTo: directory]. ^ [aBlock value: client] ensure: [client close]! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:56'! directory: dirPath directory _ dirPath! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:57'! host: hostname host _ hostname! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/23/2003 17:11'! parseDirectoryListing: aString | stream files line tokens | stream _ aString readStream. files _ OrderedCollection new. [stream atEnd] whileFalse: [line _ stream nextLine. tokens _ line findTokens: ' '. tokens size > 2 ifTrue: [files add: tokens last]]. ^ files! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:56'! password: passwordString password _ passwordString! ! !MCFtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:56'! user: userString user _ userString! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:20'! basicStoreVersion: aVersion self root at: aVersion info put: aVersion. self db commit.! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:34'! db (connection isNil or: [connection isConnected not]) ifTrue: [connection _ KKDatabase onHost:hostname port: port]. ^ connection! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:35'! description ^ 'goods://', hostname asString, ':', port asString! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:34'! host: aString hostname _ aString! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:10'! morphicOpen: aWorkingCopy (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:17'! packages ^ (self root collect: [:ea | ea package]) asSet asSortedCollection! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:36'! port: aNumber port _ aNumber! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 14:35'! root self db root ifNil: [self db root: Dictionary new]. ^ self db root! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:18'! versionsAvailableForPackage: aPackage ^ self root asArray select: [:ea | ea package = aPackage] thenCollect: [:ea | ea info]! ! !MCGOODSRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:21'! versionWithInfo: aVersionInfo ifAbsent: errorBlock ^ self root at: aVersionInfo ifAbsent: errorBlock! ! !MCHttpRepository methodsFor: 'required' stamp: 'bf 12/17/2004 17:12'! allFileNames | index | index _ HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. index isString ifTrue: [self error: 'Could not access ', location]. ^ self parseFileNamesFromStream: index ! ! !MCHttpRepository methodsFor: 'required' stamp: 'ab 7/24/2003 21:10'! description ^ location! ! !MCHttpRepository methodsFor: 'required' stamp: 'bf 12/17/2004 17:12'! readStreamForFileNamed: aString do: aBlock | contents | contents _ HTTPSocket httpGet: (self urlForFileNamed: aString) args: nil user: self user passwd: self password. ^ contents isString ifFalse: [aBlock value: contents]! ! !MCHttpRepository methodsFor: 'required' stamp: 'bf 12/17/2004 17:12'! writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream response | stream _ RWBinaryOrTextStream on: String new. aBlock value: stream. response _ HTTPSocket httpPut: stream contents to: (self urlForFileNamed: aString) user: self user passwd: self password. (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [:code | response beginsWith: code ]) ifFalse: [self error: response].! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'bf 4/14/2005 17:49'! asCreationTemplate ^self class creationTemplateLocation: location user: user password: password! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 22:17'! locationWithTrailingSlash ^ (location endsWith: '/') ifTrue: [location] ifFalse: [location, '/']! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 20:41'! location: aUrlString location _ aUrlString! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'avi 9/21/2003 16:03'! parseFileNamesFromStream: aStream | names fullName | names _ OrderedCollection new. [aStream atEnd] whileFalse: [[aStream upTo: $<. {$a. $A. nil} includes: aStream next] whileFalse. aStream upTo: $". aStream atEnd ifFalse: [ fullName _ aStream upTo: $". names add: fullName unescapePercents]]. ^ names! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'bf 1/10/2005 17:38'! password self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd]. self user isEmpty ifTrue: [^password]. [password isEmpty] whileTrue: [ | answer | "Give the user a chance to change the login" answer _ FillInTheBlank request: 'User name for ', String cr, location initialAnswer: self user. answer isEmpty ifTrue: [^password] ifFalse: [self user: answer]. password := FillInTheBlank requestPassword: 'Password for "', self user, '" at ', String cr, location. ]. ^ password! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 20:41'! password: passwordString password _ passwordString! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 13:08'! urlForFileNamed: aString ^ self locationWithTrailingSlash, aString encodeForHTTP! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'bf 1/10/2005 17:37'! user self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr]. "not in settings" ^user! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'bf 4/14/2005 14:11'! userAndPasswordFromSettingsDo: aBlock "The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account: account1: *myhost.mydomain* user:password account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA== That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string. To not have the clear text password on your disc, you can base64 encode it: (Base64MimeConverter mimeEncode: 'user:password' readStream) contents " | entry userAndPassword | Settings ifNotNil: [ Settings keysAndValuesDo: [:key :value | (key asLowercase beginsWith: 'account') ifTrue: [ entry _ value findTokens: ' '. (entry first match: location) ifTrue: [ userAndPassword := entry second. (userAndPassword includes: $:) ifFalse: [ userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents]. userAndPassword := userAndPassword findTokens: $:. ^aBlock value: userAndPassword first value: userAndPassword second ] ] ] ]. ^nil! ! !MCHttpRepository methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 20:41'! user: userString user _ userString! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 00:30'! allConcreteSubclasses ^ self withAllSubclasses reject: [:ea | ea isAbstract]! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:59'! creationTemplate self subclassResponsibility.! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 00:29'! description ^ nil! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:05'! fillInTheBlankConfigure ^ self fillInTheBlankConfigure: self creationTemplate ! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:14'! fillInTheBlankConfigure: aTemplateString | chunk repo | aTemplateString ifNil: [ ^ false ]. chunk _ FillInTheBlankMorph request: self fillInTheBlankRequest initialAnswer: aTemplateString centerAt: Sensor cursorPoint inWorld: World onCancelReturn: nil acceptOnCR: false answerExtent: 400@120. chunk ifNotNil: [ repo _ self readFrom: chunk readStream. repo creationTemplate: chunk. ]. ^ repo! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:58'! fillInTheBlankRequest self subclassResponsibility.! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'ab 8/21/2003 12:59'! isAbstract ^ self description isNil! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 21:01'! morphicConfigure ^ self new! ! !MCRepository class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCRepository class methodsFor: 'external settings' stamp: 'bf 4/14/2005 12:18'! fetchExternalSettingsIn: aDirectory "Scan for settings file" "MCRepository fetchExternalSettingsIn: ExternalSettings preferenceDirectory" | stream | (aDirectory fileExists: self settingsFileName) ifFalse: [^self]. stream _ aDirectory readOnlyFileNamed: self settingsFileName. stream ifNotNil: [ [Settings _ ExternalSettings parseServerEntryArgsFrom: stream] ensure: [stream close]]. ! ! !MCRepository class methodsFor: 'external settings' stamp: 'bf 12/17/2004 20:30'! releaseExternalSettings Settings := nil. ! ! !MCRepository class methodsFor: 'external settings' stamp: 'bf 12/17/2004 20:36'! settingsFileName ^ 'mcSettings'! ! !MCRepository class methodsFor: 'class initialization' stamp: 'bf 4/15/2005 10:19'! initialize "self initialize" ExternalSettings registerClient: self. ! ! !MCFileBasedRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/3/2005 00:43'! flushAllCaches self allSubInstancesDo: [:ea | ea flushCache]! ! !MCDirectoryRepository class methodsFor: 'instance creation' stamp: 'ab 7/24/2003 21:20'! description ^ 'directory'! ! !MCDirectoryRepository class methodsFor: 'instance creation' stamp: 'ab 7/24/2003 21:01'! morphicConfigure ^ FileList2 modalFolderSelector ifNotNilDo: [:directory | self new directory: directory]! ! !MCCacheRepository class methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:46'! cacheDirectory ^ (FileDirectory default directoryNamed: 'package-cache') assureExistence; yourself! ! !MCCacheRepository class methodsFor: 'as yet unclassified' stamp: 'avi 1/24/2004 17:49'! checkCacheDirectory default notNil and: [default directory exists ifFalse: [default _ nil]]! ! !MCCacheRepository class methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 16:24'! default self checkCacheDirectory. ^ default ifNil: [default _ self new directory: self cacheDirectory]! ! !MCCacheRepository class methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:56'! description ^ nil! ! !MCCacheRepository class methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 16:21'! initialize self checkCacheDirectory! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:57'! creationTemplate ^ 'MCFtpRepository host: ''modules.squeakfoundation.org'' directory: ''mc'' user: ''squeak'' password: ''squeak''' ! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:57'! description ^ 'FTP'! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:02'! fillInTheBlankRequest ^ 'FTP Repository:' ! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'avi 9/16/2003 13:57'! host: host directory: directory user: user password: password ^ self new host: host; directory: directory; user: user; password: password! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:02'! morphicConfigure ^ self fillInTheBlankConfigure! ! !MCFtpRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 20:38'! templateCreationSelector ^ #host:directory:user:password: ! ! !MCGOODSRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:36'! creationTemplate ^ 'MCGOODSRepository host: ''localhost'' port: 6100'! ! !MCGOODSRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 14:33'! description ^ 'GOODS'! ! !MCGOODSRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:33'! fillInTheBlankRequest ^ 'GOODS Repository:'! ! !MCGOODSRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:36'! host: hostname port: portNumber ^ self new host: hostname; port: portNumber! ! !MCGOODSRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:35'! morphicConfigure ^ self fillInTheBlankConfigure! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'bf 4/14/2005 15:26'! creationTemplate ^self creationTemplateLocation: 'http://foo.com/bar' user: 'squeak' password: 'squeak' ! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'bf 4/14/2005 15:27'! creationTemplateLocation: location user: user password: password ^ 'MCHttpRepository location: {1} user: {2} password: {3}' format: {location printString. user printString. password printString}! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 21:20'! description ^ 'HTTP'! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:00'! fillInTheBlankRequest ^ 'HTTP Repository:' ! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'ab 7/24/2003 21:32'! location: location user: user password: password ^ self new location: location; user: user; password: password! ! !MCHttpRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:01'! morphicConfigure ^ self fillInTheBlankConfigure! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'avi 1/27/2004 00:29'! addRepository: aRepository ((repositories includes: aRepository) or: [aRepository == MCCacheRepository default]) ifFalse: [repositories add: aRepository. self class default addRepository: aRepository]. self changed: #repositories! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'abc 11/6/2004 20:32'! includesVersionNamed: aString self repositoriesDo: [:ea | (ea includesVersionNamed: aString) ifTrue: [^ true]]. ^ false ! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'avi 11/7/2003 00:20'! includes: aRepository ^ self repositories includes: aRepository! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2003 00:14'! initialize repositories _ OrderedCollection new! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'ab 7/22/2003 00:11'! removeRepository: aRepository repositories remove: aRepository ifAbsent: []. self changed: #repositories! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'nk 11/2/2003 10:57'! repositories ^ ((Array with: MCCacheRepository default), repositories) select: [ :ea | ea isValid ]! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'avi 11/7/2003 00:51'! repositoriesDo: aBlock self repositories do: [:ea | [aBlock value: ea] on: Error do: []]! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'dvf 8/10/2004 23:02'! versionWithInfo: aVersionInfo ^self versionWithInfo: aVersionInfo ifNone: [ self error: 'Could not find version ', aVersionInfo name printString,'. Maybe you need to add a repository?' ]! ! !MCRepositoryGroup methodsFor: 'as yet unclassified' stamp: 'nk 1/23/2004 18:15'! versionWithInfo: aVersionInfo ifNone: aBlock self repositoriesDo: [:ea | (ea versionWithInfo: aVersionInfo) ifNotNilDo: [:v | ^ v]]. ^aBlock value! ! !MCRepositoryGroup class methodsFor: 'as yet unclassified' stamp: 'ab 7/22/2003 00:17'! default ^ default ifNil: [default _ self new]! ! !MCRepositoryGroup class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCScanner methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:22'! next | c | stream skipSeparators. c _ stream peek. c = $# ifTrue: [c _ stream next; peek]. c = $' ifTrue: [^ self nextString]. c = $( ifTrue: [^ self nextArray]. c isAlphaNumeric ifTrue: [^ self nextSymbol]. self error: 'Unknown token type'. ! ! !MCScanner methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:27'! nextArray stream next. "(" ^ Array streamContents: [:s | [stream skipSeparators. (stream peek = $)) or: [stream atEnd]] whileFalse: [s nextPut: self next]. stream next = $) ifFalse: [self error: 'Unclosed array']]! ! !MCScanner methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:09'! nextString ^ stream nextDelimited: $'! ! !MCScanner methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:16'! nextSymbol ^ (String streamContents: [:s | [stream peek isAlphaNumeric] whileTrue: [s nextPut: stream next]]) asSymbol ! ! !MCScanner methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:06'! stream: aStream stream _ aStream! ! !MCScanner class methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:32'! scanTokens: aString "compatibility" ^ Array with: (self scan: aString readStream)! ! !MCScanner class methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:14'! scan: aStream ^ (self new stream: aStream) next! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:19'! accept: aVisitor "do nothing for now - this means it won't appear in the .st file"! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:12'! description ^ Array with: packageName with: self scriptSelector! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:03'! evaluate Compiler evaluate: script! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 16:57'! initializeWithScript: aString packageName: packageString script _ aString. packageName _ packageString! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:11'! installScript self installScript: script! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:11'! installScript: aString self packageInfo perform: (self scriptSelector, ':') asSymbol with: aString! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:12'! load self installScript! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:22'! packageInfo ^ PackageInfo named: packageName! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 16:54'! script ^ script! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:10'! scriptSelector ^ self class scriptSelector! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:12'! sortKey ^ '<', self scriptSelector, '>'! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:04'! source ^ script! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:12'! summary ^ packageName, ' ', self scriptSelector! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:12'! unload self installScript: nil! ! !MCScriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 16:55'! = aDefinition ^ (super = aDefinition) and: [script = aDefinition script]! ! !MCPostscriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:18'! accept: aWriter "do nothing"! ! !MCPostscriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:16'! postload self evaluate! ! !MCPostscriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:16'! sortKey ^ 'zzz' "force to the end so it gets loaded late"! ! !MCPreambleDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:15'! load super load. self evaluate! ! !MCRemovalPostscriptDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:15'! unload super unload. self evaluate! ! !MCRemovalPreambleDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:14'! sortKey ^ 'zzz' "force to the end so it gets unloaded early"! ! !MCRemovalPreambleDefinition methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:15'! unload super unload. self evaluate! ! !MCScriptDefinition class methodsFor: 'as yet unclassified' stamp: 'bf 4/4/2005 12:20'! from: aPackageInfo ^ self script: (aPackageInfo perform: self scriptSelector) contents asString packageName: aPackageInfo name! ! !MCScriptDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:00'! scriptSelector self subclassResponsibility! ! !MCScriptDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 16:59'! script: aString packageName: packageString ^ self instanceLike: (self new initializeWithScript: aString packageName: packageString)! ! !MCPostscriptDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:04'! scriptSelector ^ #postscript! ! !MCPreambleDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:04'! scriptSelector ^ #preamble! ! !MCRemovalPostscriptDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:04'! scriptSelector ^ #postscriptOfRemoval ! ! !MCRemovalPreambleDefinition class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2005 17:04'! scriptSelector ^ #preambleOfRemoval! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:46'! allFileNames ^self allFullFileNames collect: [ :ea | self directory localNameFor: ea ]! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 10:03'! allFullFileNames | cachedPackages | cachedPackages _ smCache map installedPackages select: [ :ea | ea isCached ]. ^Array streamContents: [ :s | cachedPackages do: [ :ea | | d | d _ ea cacheDirectory. (d fileNamesMatching: '*.mcz') do: [ :fn | s nextPut: (d fullNameFor: fn) ]]]! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:40'! description ^ smCache directory pathName! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:40'! directory ^ smCache directory! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:40'! directory: aDirectory ! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:55'! fullNameFor: aFileName ^self allFullFileNames detect: [ :ffn | (self directory localNameFor: ffn) = aFileName ] ifNone: []! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:37'! smCache ^smCache! ! !MCSMCacheRepository methodsFor: 'accessing' stamp: 'nk 1/23/2004 09:45'! smCache: aSMFileCache | | smCache := aSMFileCache. self directory: aSMFileCache directory. ! ! !MCSMCacheRepository methodsFor: 'comparing' stamp: 'nk 1/23/2004 09:55'! hash ^ smCache hash! ! !MCSMCacheRepository methodsFor: 'initialize-release' stamp: 'nk 1/23/2004 09:47'! initialize super initialize. smCache _ SMSqueakMap default cache.! ! !MCSMCacheRepository methodsFor: 'testing' stamp: 'nk 1/23/2004 09:47'! isValid ^smCache notNil and: [ self directory exists ]! ! !MCSMCacheRepository methodsFor: 'file streaming' stamp: 'nk 1/23/2004 09:57'! readStreamForFileNamed: aString do: aBlock | file fileName | fileName _ self fullNameFor: aString. fileName ifNil: [ "assume that this will come from the cache." ^MCCacheRepository default readStreamForFileNamed: aString do: aBlock ]. file _ FileStream readOnlyFileNamed: fileName. ^[ aBlock value: file ] ensure: [ file close ]. ! ! !MCSMCacheRepository methodsFor: 'file streaming' stamp: 'nk 1/23/2004 09:57'! writeStreamForFileNamed: aString replace: aBoolean do: aBlock "Can't write into the SM cache, so..." ^MCCacheRepository default writeStreamForFileNamed: aString replace: aBoolean do: aBlock! ! !MCSMCacheRepository class methodsFor: 'instance creation' stamp: 'nk 1/23/2004 10:04'! description ^ 'SqueakMap Cache'! ! !MCSMCacheRepository class methodsFor: 'instance creation' stamp: 'nk 1/23/2004 10:05'! morphicConfigure ^self new! ! !MCSnapshot methodsFor: 'accessing' stamp: 'ab 12/4/2002 18:09'! definitions ^ definitions! ! !MCSnapshot methodsFor: 'accessing' stamp: 'ab 7/10/2003 01:05'! hash ^ definitions asArray hash! ! !MCSnapshot methodsFor: 'accessing' stamp: 'ab 7/10/2003 01:05'! = other ^ definitions asArray = other definitions asArray! ! !MCSnapshot methodsFor: 'initializing' stamp: 'ab 7/6/2003 23:48'! initializeWithDefinitions: aCollection definitions _ aCollection.! ! !MCSnapshot methodsFor: 'loading' stamp: 'ab 7/6/2003 23:31'! install MCPackageLoader installSnapshot: self! ! !MCSnapshot methodsFor: 'loading' stamp: 'ab 7/7/2003 12:11'! updatePackage: aPackage MCPackageLoader updatePackage: aPackage withSnapshot: self! ! !MCSnapshot methodsFor: 'patching' stamp: 'ab 7/7/2003 00:37'! patchRelativeToBase: aSnapshot ^ MCPatch fromBase: aSnapshot target: self! ! !MCSnapshot class methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 23:48'! empty ^ self fromDefinitions: #()! ! !MCSnapshot class methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 23:48'! fromDefinitions: aCollection ^ self new initializeWithDefinitions: aCollection! ! !MCSnapshotReader methodsFor: 'as yet unclassified' stamp: 'avi 1/21/2004 23:09'! definitions definitions ifNil: [self loadDefinitions]. ^ definitions! ! !MCSnapshotReader methodsFor: 'as yet unclassified' stamp: 'avi 1/21/2004 23:10'! snapshot ^ MCSnapshot fromDefinitions: self definitions! ! !MCSnapshotReader class methodsFor: 'as yet unclassified' stamp: 'avi 1/21/2004 22:56'! snapshotFromStream: aStream ^ (self on: aStream) snapshot! ! !MCSnapshotResource methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 14:50'! definitions ^ snapshot definitions! ! !MCSnapshotResource methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:20'! setUp snapshot _ self class takeSnapshot.! ! !MCSnapshotResource methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 14:51'! snapshot ^ snapshot! ! !MCSnapshotResource class methodsFor: 'as yet unclassified' stamp: 'cwp 8/1/2003 20:18'! mockPackage ^ (MCPackage new name: self mockPackageName)! ! !MCSnapshotResource class methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 13:54'! mockPackageName ^ MCMockPackageInfo new packageName! ! !MCSnapshotResource class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:19'! takeSnapshot ^ self mockPackage snapshot! ! !MCSortingTest methodsFor: 'building' stamp: 'ab 4/8/2003 17:56'! classNamed: aSymbol ^ MCClassDefinition name: aSymbol superclassName: #Object category: '' instVarNames: #() comment: ''! ! !MCSortingTest methodsFor: 'building' stamp: 'ab 4/8/2003 18:03'! methodNamed: aSymbol class: className meta: aBoolean ^ MCMethodDefinition className: className classIsMeta: aBoolean selector: aSymbol category: '' timeStamp: '' source: ''! ! !MCSortingTest methodsFor: 'building' stamp: 'ab 7/19/2003 17:56'! sortKeyFor: aDefinition ^ String streamContents: [:s | aDefinition description do: [:ea | s nextPutAll: ea asString] separatedBy: [s nextPut: $.]]! ! !MCSortingTest methodsFor: 'actions' stamp: 'ab 7/19/2003 18:01'! sortDefinitions: aCollection ^ aCollection asSortedCollection asArray! ! !MCSortingTest methodsFor: 'tests' stamp: 'ab 7/19/2003 17:57'! testConsistentSorting | definitions shuffledAndSorted| definitions _ {self methodNamed: #a class: #A meta: false. self methodNamed: #a class: #A meta: true. self methodNamed: #a class: #B meta: false. self methodNamed: #b class: #A meta: false. self methodNamed: #b class: #B meta: false. self classNamed: #A. self classNamed: #B}. shuffledAndSorted _ (1 to: 100) collect: [:ea | self sortDefinitions: definitions shuffled]. self assert: shuffledAndSorted asSet size = 1. ! ! !MCSortingTest methodsFor: 'tests' stamp: 'ab 5/6/2003 17:08'! testSortOrder | aA aAm aB bA bB A B cA bAm cAm | aA _ self methodNamed: #a class: #A meta: false. bA _ self methodNamed: #b class: #A meta: false. cA _ self methodNamed: #c class: #A meta: false. aAm _ self methodNamed: #a class: #A meta: true. bAm _ self methodNamed: #b class: #A meta: true. cAm _ self methodNamed: #c class: #A meta: true. aB _ self methodNamed: #a class: #B meta: false. bB _ self methodNamed: #b class: #B meta: false. A _ self classNamed: #A. B _ self classNamed: #B. self assert: (self sortDefinitions: {aA. aAm. cAm. aB. bAm. bA. bB. A. cA. B}) = {A. aAm. bAm. cAm. aA. bA. cA. B. aB. bB}! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:52'! addDefinitionsFromDoit: aString (MCDoItParser forDoit: aString) ifNotNilDo: [:parser | parser addDefinitionsTo: definitions]! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:02'! categoryFromDoIt: aString | tokens | tokens _ Scanner new scanTokens: aString. tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. ^ tokens at: 3! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 22:13'! classDefinitionFrom: aPseudoClass | tokens | tokens _ Scanner new scanTokens: aPseudoClass definition. tokens size = 11 ifFalse: [self error: 'Unrecognized class definition']. ^ MCClassDefinition name: (tokens at: 3) superclassName: (tokens at: 1) category: (tokens at: 11) instVarNames: ((tokens at: 5) findTokens: ' ') classVarNames: ((tokens at: 7) findTokens: ' ') poolDictionaryNames: ((tokens at: 9) findTokens: ' ') classInstVarNames: (self classInstVarNamesFor: aPseudoClass) type: (self typeOfSubclass: (tokens at: 2)) comment: (self commentFor: aPseudoClass) commentStamp: (self commentStampFor: aPseudoClass)! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 21:49'! classInstVarNamesFor: aPseudoClass | tokens | aPseudoClass metaClass hasDefinition ifFalse: [^ #()]. tokens _ Scanner new scanTokens: aPseudoClass metaClass definition. tokens size = 4 ifFalse: [self error: 'Unrecognized metaclass definition']. ^ tokens last findTokens: ' '! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:52'! commentFor: aPseudoClass | comment | comment _ aPseudoClass organization classComment. ^ comment asString = '' ifTrue: [comment] ifFalse: [comment string]! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 3/8/2004 21:09'! commentStampFor: aPseudoClass | comment | comment _ aPseudoClass organization classComment. ^ [comment stamp] on: MessageNotUnderstood do: [nil]! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 3/3/2004 15:23'! methodDefinitionsFor: aPseudoClass ^ aPseudoClass selectors collect: [:ea | MCMethodDefinition className: aPseudoClass name classIsMeta: aPseudoClass isMeta selector: ea category: (aPseudoClass organization categoryOfElement: ea) timeStamp: (aPseudoClass stampAt: ea) source: (aPseudoClass sourceCodeAt: ea)]! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:15'! systemOrganizationFromRecords: changeRecords | categories | categories _ changeRecords select: [:ea | 'SystemOrganization*' match: ea string] thenCollect: [:ea | (self categoryFromDoIt: ea string)]. ^ categories isEmpty ifFalse: [MCOrganizationDefinition categories: categories asArray]! ! !MCStReader methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 21:56'! typeOfSubclass: aSymbol #( (subclass: normal) (variableSubclass: variable) (variableByteSubclass: bytes) (variableWordSubclass: words) (weakSubclass: weak) ) do: [:ea | ea first = aSymbol ifTrue: [^ ea second]]. self error: 'Unrecognized class definition'! ! !MCStReader methodsFor: 'evaluating' stamp: 'avi 3/10/2004 12:28'! loadDefinitions | filePackage | filePackage _ FilePackage new fullName: 'ReadStream'; fileInFrom: self readStream. definitions _ OrderedCollection new. filePackage classes do: [:pseudoClass | pseudoClass hasDefinition ifTrue: [definitions add: (self classDefinitionFrom: pseudoClass)]. definitions addAll: (self methodDefinitionsFor: pseudoClass). definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)]. filePackage doIts do: [:ea | self addDefinitionsFromDoit: ea string]. ! ! !MCStReader methodsFor: 'evaluating' stamp: 'avi 1/21/2004 14:21'! readStream ^ ('!!!! ', stream contents) readStream! ! !MCStReader class methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:17'! extension ^ 'st'! ! !MCSubDirectoryRepository methodsFor: 'enumeration' stamp: 'nk 6/11/2004 18:55'! allDirectories | remaining dir dirs | remaining := OrderedCollection new. dirs := OrderedCollection new. remaining addLast: directory. [remaining isEmpty] whileFalse: [dir := remaining removeFirst. dirs add: dir. dir entries do: [:ent | ent isDirectory ifTrue: [remaining addLast: (dir directoryNamed: ent name)]]]. ^ dirs! ! !MCSubDirectoryRepository methodsFor: 'enumeration' stamp: 'nk 6/11/2004 20:25'! allFileNames "sorting {entry. dirName. name}" | sorted | sorted := SortedCollection sortBlock: [:a :b | a first modificationTime >= b first modificationTime ]. self allDirectories do: [:dir | dir entries do: [:ent | ent isDirectory ifFalse: [sorted add: {ent. dir fullName. ent name}]]]. ^ sorted collect: [:ea | ea third ]! ! !MCSubDirectoryRepository methodsFor: 'user interface' stamp: 'nk 6/11/2004 18:23'! description ^ directory pathName, '/*'! ! !MCSubDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'nk 6/11/2004 20:32'! findFullNameForReading: aBaseName "Answer the latest version of aBaseName" | possible | possible _ SortedCollection sortBlock: [ :a :b | b first modificationTime < a first modificationTime ]. self allDirectories do: [:dir | dir entries do: [:ent | ent isDirectory ifFalse: [ (ent name = aBaseName) ifTrue: [ possible add: {ent. dir fullNameFor: ent name}]]]]. ^(possible at: 1 ifAbsent: [ ^nil ]) second ! ! !MCSubDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'bf 10/27/2004 13:37'! findFullNameForWriting: aBaseName | possible split dirScore fileScore prefix fpattern parts now | split _ directory splitNameVersionExtensionFor: aBaseName. fpattern _ split first, '*'. possible _ SortedCollection sortBlock: [ :a :b | a first = b first ifTrue: [ a second = b second ifFalse: [ a second < b second ] ifTrue: [ a third fullName size < b third fullName size ]] ifFalse: [ a first > b first ] ]. now _ Time totalSeconds. prefix _ directory pathParts size. self allDirectories do: [:dir | parts _ dir pathParts allButFirst: prefix. dirScore _ (parts select: [ :part | fpattern match: part ]) size. fileScore _ (dir entries collect: [ :ent | (ent isDirectory not and: [ fpattern match: ent name ]) ifFalse: [ SmallInteger maxVal ] ifTrue: [ now - ent modificationTime ]]). "minimum age" fileScore _ fileScore isEmpty ifTrue: [ SmallInteger maxVal ] ifFalse: [ fileScore min ]. possible add: { dirScore. fileScore. dir } ]. ^ (possible first third) fullNameFor: aBaseName! ! !MCSubDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'nk 6/11/2004 20:32'! readStreamForFileNamed: aString do: aBlock | file val | file _ FileStream readOnlyFileNamed: (self findFullNameForReading: aString). val _ aBlock value: file. file close. ^ val! ! !MCSubDirectoryRepository methodsFor: 'as yet unclassified' stamp: 'nk 6/11/2004 20:34'! writeStreamForFileNamed: aString replace: aBoolean do: aBlock | file | file := aBoolean ifTrue: [FileStream forceNewFileNamed: (self findFullNameForReading: aString)] ifFalse: [FileStream newFileNamed: (self findFullNameForWriting: aString)]. aBlock value: file. file close! ! !MCSubDirectoryRepository class methodsFor: 'user interface' stamp: 'nk 6/11/2004 18:48'! description ^ 'directory with subdirectories'! ! !MCSystemCategoryParser methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:49'! addDefinitionsTo: aCollection | definition | definition _ aCollection detect: [:ea | ea isOrganizationDefinition ] ifNone: [aCollection add: (MCOrganizationDefinition categories: #())]. definition categories: (definition categories copyWith: self category).! ! !MCSystemCategoryParser methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:42'! category | tokens | tokens _ Scanner new scanTokens: source. tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. ^ tokens at: 3! ! !MCSystemCategoryParser class methodsFor: 'as yet unclassified' stamp: 'avi 3/10/2004 12:41'! pattern ^ 'SystemOrganization*'! ! !MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 14:58'! assertPackage: actual matches: expected self assert: actual = expected ! ! !MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 23:25'! assertSnapshot: actual matches: expected | diff | diff _ actual patchRelativeToBase: expected. self assert: diff isEmpty ! ! !MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 15:50'! assertVersionInfo: actual matches: expected self assert: actual name = expected name. self assert: actual message = expected message. self assert: actual ancestors size = expected ancestors size. actual ancestors with: expected ancestors do: [:a :e | self assertVersionInfo: a matches: e] ! ! !MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 14:58'! assertVersion: actual matches: expected self assertPackage: actual package matches: expected package. self assertVersionInfo: actual info matches: expected info. self assertSnapshot: actual snapshot matches: expected snapshot.! ! !MCTestCase methodsFor: 'compiling' stamp: 'cwp 8/10/2003 02:12'! change: aSelector toReturn: anObject self compileClass: self mockClassA source: aSelector, ' ^ ', anObject printString category: 'numeric'! ! !MCTestCase methodsFor: 'compiling' stamp: 'cwp 7/21/2003 22:51'! compileClass: aClass source: source category: category aClass compileInobtrusively: source classified: category! ! !MCTestCase methodsFor: 'compiling' stamp: 'cwp 8/2/2003 15:05'! restoreMocks self mockSnapshot updatePackage: self mockPackage! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:51'! commentForClass: name ^ 'This is a comment for ', name! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:53'! commentStampForClass: name ^ 'tester-', name, ' 1/1/2000 00:00'! ! !MCTestCase methodsFor: 'mocks' stamp: 'ab 7/19/2003 15:43'! mockCategoryName ^ 'Monticello-Mocks'! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 02:05'! mockClassA ^ Smalltalk at: #MCMockClassA! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 9/14/2003 19:39'! mockClassB ^ Smalltalk at: #MCMockClassB! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:50'! mockClass: className super: superclassName ^ MCClassDefinition name: className superclassName: superclassName category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className)! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 1/19/2004 15:54'! mockDependencies ^ Array with: (MCVersionDependency package: self mockEmptyPackage info: (self mockVersionInfo: 'x'))! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 2/22/2004 14:08'! mockEmptyPackage ^ MCPackage named: (MCEmptyPackageInfo new packageName)! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 2/22/2004 13:56'! mockExtensionMethodCategory ^ MCMockPackageInfo new methodCategoryPrefix.! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 02:06'! mockInstanceA ^ self mockClassA new! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:24'! mockMessageString ^ 'A version generated for testing purposes.'! ! !MCTestCase methodsFor: 'mocks' stamp: 'ab 4/1/2003 02:02'! mockMethod: aSymbol class: className source: sourceString meta: aBoolean ^ MCMethodDefinition className: className classIsMeta: aBoolean selector: aSymbol category: 'as yet unclassified' timeStamp: '' source: sourceString! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 11/13/2003 13:24'! mockOverrideMethodCategory ^ self mockExtensionMethodCategory, '-override'! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/1/2003 20:27'! mockPackage ^ MCSnapshotResource mockPackage! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/14/2003 15:07'! mockSnapshot ^ MCSnapshotResource current snapshot! ! !MCTestCase methodsFor: 'mocks' stamp: 'ab 1/15/2003 17:55'! mockToken: aSymbol ^ MCMockDefinition token: aSymbol! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:23'! mockVersion ^ MCVersion package: self mockPackage info: self mockVersionInfo snapshot: self mockSnapshot! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 2/12/2004 19:58'! mockVersionInfo ^ self treeFrom: #(d ((b ((a))) (c)))! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 11/6/2004 16:06'! mockVersionInfoWithAncestor: aVersionInfo ^ MCVersionInfo name: aVersionInfo name, '-child' id: UUID new message: self mockMessageString date: Date today time: Time now author: Utilities authorInitials ancestors: {aVersionInfo} ! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 2/12/2004 21:01'! mockVersionInfo: tag ^ MCVersionInfo name: self mockVersionName, '-', tag asString id: UUID new message: self mockMessageString, '-', tag asString date: Date today time: Time now author: Utilities authorInitials ancestors: #() ! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:25'! mockVersionName ^ 'MonticelloTest-xxx.1'! ! !MCTestCase methodsFor: 'mocks' stamp: 'cwp 11/6/2004 16:03'! mockVersionWithAncestor: aMCVersion ^ MCVersion package: self mockPackage info: (self mockVersionInfoWithAncestor: aMCVersion info) snapshot: self mockSnapshot! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 1/19/2004 15:15'! mockVersionWithDependencies ^ MCVersion package: self mockPackage info: self mockVersionInfo snapshot: self mockSnapshot dependencies: self mockDependencies! ! !MCTestCase methodsFor: 'mocks' stamp: 'avi 2/12/2004 20:00'! treeFrom: anArray | name id | name _ anArray first. id _ '00000000-0000-0000-0000-0000000000', (name asString size = 1 ifTrue: [name asString, '0'] ifFalse: [name asString]). ^ MCVersionInfo name: name id: (UUID fromString: id) message: '' date: nil time: nil author: '' ancestors: (anArray size > 1 ifTrue: [(anArray second collect: [:ea | self treeFrom: ea])] ifFalse: [#()])! ! !MCAncestryTest methodsFor: 'asserting' stamp: 'jf 8/16/2003 23:00'! assertCommonAncestorOf: leftName and: rightName is: ancestorName in: tree | left right ancestor | left _ self versionForName: leftName in: tree. right _ self versionForName: rightName in: tree. ancestor _ left commonAncestorWith: right. self assert: ancestor name = ancestorName! ! !MCAncestryTest methodsFor: 'asserting' stamp: 'jf 8/16/2003 20:30'! assertNamesOf: versionInfoCollection are: nameArray | names | names _ versionInfoCollection collect: [:ea | ea name]. self assert: names asArray = nameArray! ! !MCAncestryTest methodsFor: 'asserting' stamp: 'jf 8/16/2003 23:42'! assertPathTo: aSymbol is: anArray self assertNamesOf: (self tree allAncestorsOnPathTo: (self treeFrom: {aSymbol})) are: anArray! ! !MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 22:42'! testAllAncestors "- ancestors appear in the order in which they were merged in (hence e2 before a2) - children always come before parents (e1 before a1 and b1 before 00 at same depth; b0 before 00 even though b0 is deeper)" self assertNamesOf: self tree allAncestors are: #(e2 a2 b3 d1 e1 b2 a1 b1 b0 '00')! ! !MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 23:48'! testCommonAncestors self assertCommonAncestorOf: #a2 and: #e2 is: #a1 in: self tree. self assertCommonAncestorOf: #e2 and: #b3 is: #a1 in: self tree. self assertCommonAncestorOf: #b2 and: #e2 is: #'00' in: self tree. self assertCommonAncestorOf: #a4 and: #b5 is: #b2 in: self twoPersonTree. self assertCommonAncestorOf: #b5 and: #b3 is: #b2 in: self twoPersonTree. self assertCommonAncestorOf: #b2 and: #a4 is: #b2 in: self twoPersonTree. self assertCommonAncestorOf: #b2 and: #b2 is: #b2 in: self twoPersonTree. self assertCommonAncestorOf: #b2 and: #a1 is: #a1 in: self twoPersonTree. self assertCommonAncestorOf: #a1 and: #b2 is: #a1 in: self twoPersonTree.! ! !MCAncestryTest methodsFor: 'tests' stamp: 'bf 11/23/2004 18:18'! testDescendants | c1 a1 b3 q1 q2 c2 | c1 _ self tree. a1 _ self treeFrom: #(a1 (('00'))). b3 _ self treeFrom: #(b3 ((b2 ((b1 ((b0 (('00'))))))) (a1 (('00'))))). q1 _ MCWorkingAncestry new addAncestor: a1. q2 _ MCWorkingAncestry new addAncestor: q1. self assert: (q2 commonAncestorWith: b3) = a1. self assert: (b3 commonAncestorWith: q2) = a1. self assert: (q2 commonAncestorWith: c1) = a1. self assert: (c1 commonAncestorWith: q2) = a1. q1 addStepChild: c1. self assert: (q2 commonAncestorWith: c1) = q1. self assert: (c1 commonAncestorWith: q2) = q1. c2 _ MCWorkingAncestry new addAncestor: c1. self assert: (q2 commonAncestorWith: c2) = q1. self assert: (c2 commonAncestorWith: q2) = q1. ! ! !MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 20:45'! testLinearPath self assertPathTo: #b1 is: #(b3 b2)! ! !MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 20:42'! testPathToMissingAncestor self assert: (self tree allAncestorsOnPathTo: MCVersionInfo new) isEmpty! ! !MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 22:42'! testWithAllAncestors "see comments in testAllAncestors" self assertNamesOf: self tree withAllAncestors are: #(c1 e2 a2 b3 d1 e1 b2 a1 b1 b0 '00')! ! !MCAncestryTest methodsFor: 'building' stamp: 'jf 8/16/2003 21:21'! tree ^ self treeFrom: #(c1 ((e2 ((e1 ((a1 (('00'))))))) (a2 ((a1 (('00'))))) (b3 ((b2 ((b1 ((b0 (('00'))))))) (a1 (('00'))))) (d1)))! ! !MCAncestryTest methodsFor: 'building' stamp: 'jf 8/16/2003 22:55'! twoPersonTree ^ self treeFrom: #(c1 ((a4 ((a1) (b3 ((b2 ((a1))))))) (b5 ((b2 ((a1)))))))! ! !MCAncestryTest methodsFor: 'building' stamp: 'jf 8/16/2003 23:14'! versionForName: name in: tree (tree name = name) ifTrue: [^ tree]. tree ancestors do: [:ea | (self versionForName: name in: ea) ifNotNilDo: [:v | ^ v]]. ^ nil! ! !MCChangeNotificationTest methodsFor: 'private' stamp: 'bf 5/20/2005 16:19'! foreignMethod "see testForeignMethodModified"! ! !MCChangeNotificationTest methodsFor: 'events' stamp: 'cwp 11/6/2004 22:32'! modifiedEventFor: aSelector ofClass: aClass | method | method := aClass compiledMethodAt: aSelector. ^ ModifiedEvent methodChangedFrom: method to: method selector: aSelector inClass: aClass. ! ! !MCChangeNotificationTest methodsFor: 'running' stamp: 'bf 5/20/2005 16:31'! setUp workingCopy _ MCWorkingCopy forPackage: self mockPackage. ! ! !MCChangeNotificationTest methodsFor: 'running' stamp: 'bf 5/20/2005 17:02'! tearDown workingCopy unregister! ! !MCChangeNotificationTest methodsFor: 'tests' stamp: 'bf 5/20/2005 19:54'! testCoreMethodModified | event | workingCopy modified: false. event := self modifiedEventFor: #one ofClass: self mockClassA. MCWorkingCopy methodModified: event. self assert: workingCopy modified! ! !MCChangeNotificationTest methodsFor: 'tests' stamp: 'bf 5/20/2005 17:05'! testExtMethodModified | event mref | workingCopy modified: false. mref := workingCopy packageInfo extensionMethods first. event := self modifiedEventFor: mref methodSymbol ofClass: mref actualClass. MCWorkingCopy methodModified: event. self assert: workingCopy modified! ! !MCChangeNotificationTest methodsFor: 'tests' stamp: 'bf 5/20/2005 17:00'! testForeignMethodModified | event | workingCopy modified: false. event := self modifiedEventFor: #foreignMethod ofClass: self class. MCWorkingCopy methodModified: event. self deny: workingCopy modified! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 01:20'! classAComment ^ self class classAComment! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 17:17'! creationMessage ^ MessageSend receiver: MCClassDefinition selector: #name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp:! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:57'! tearDown Smalltalk at: 'MCMockClassC' ifPresent: [:c | c removeFromSystem]! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'avi 1/24/2004 20:31'! testCannotLoad | d | d _ self mockClass: 'MCMockClassC' super: 'NotAnObject'. self should: [d load] raise: Error. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'ab 1/15/2003 17:53'! testComparison | d1 d2 d3 d4 | d1 _ self mockClass: 'A' super: 'X'. d2 _ self mockClass: 'A' super: 'Y'. d3 _ self mockClass: 'B' super: 'X'. d4 _ self mockClass: 'B' super: 'X'. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self assert: (d3 isRevisionOf: d4). self assert: (d3 isSameRevisionAs: d4). self deny: (d1 isRevisionOf: d3). self deny: (d4 isRevisionOf: d2).! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:39'! testCreation | d | d _ self mockClassA asClassDefinition. self assert: d className = #MCMockClassA. self assert: d superclassName = #MCMock. self assert: d type = #normal. self assert: d category = self mockCategoryName. self assert: d instVarNames asArray = #('ivar'). self assert: d classVarNames asArray = #('CVar'). self assert: d classInstVarNames asArray = #(). self assert: d comment isString. self assert: d comment = self classAComment. self assert: d commentStamp = self mockClassA organization commentStamp! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 02:06'! testDefinitionString | d | d _ self mockClassA asClassDefinition. self assert: d definitionString = self mockClassA definition.! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 17:20'! testEquals | a b | a _ self mockClass: 'ClassA' super: 'SuperA'. b _ self mockClass: 'ClassA' super: 'SuperA'. self assert: a = b! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/12/2003 02:37'! testEqualsSensitivity | message a b defA args defB | message _ self creationMessage. a _ #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA) typeA 'A comment' 'A'). b _ #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB) typeB 'B comment' 'B'). defA _ message valueWithArguments: a. 1 to: 8 do: [:index | args _ a copy. args at: index put: (b at: index). defB _ message valueWithArguments: args. self deny: defA = defB.]! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 02:07'! testKindOfSubclass | classes d | classes _ {self mockClassA. String. MethodContext. WeakArray. Float}. classes do: [:c | d _ c asClassDefinition. self assert: d kindOfSubclass = c kindOfSubclass. ].! ! !MCClassDefinitionTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:54'! testLoadAndUnload | d c | d _ self mockClass: 'MCMockClassC' super: 'Object'. d load. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). c _ (Smalltalk classNamed: 'MCMockClassC'). self assert: (c isKindOf: Class). self assert: c superclass = Object. self assert: c instVarNames isEmpty. self assert: c classVarNames isEmpty. self assert: c sharedPools isEmpty. self assert: c category = self mockCategoryName. self assert: c organization classComment = (self commentForClass: 'MCMockClassC'). self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC'). d unload. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! ! !MCFileInTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:08'! alterInitialState self mockClassA touchCVar! ! !MCFileInTest methodsFor: 'testing' stamp: 'avi 2/17/2004 03:21'! assertFileOutFrom: writerClass canBeFiledInWith: aBlock (writerClass on: stream) writeSnapshot: self mockSnapshot. self alterInitialState. self assertSuccessfulLoadWith: aBlock. self mockPackage unload. self assertSuccessfulLoadWith: aBlock. ! ! !MCFileInTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:08'! assertInitializersCalled | cvar | cvar _ self mockClassA cVar. self assert: cvar = #initialized! ! !MCFileInTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:30'! assertSuccessfulLoadWith: aBlock stream reset. aBlock value. self assertNoChange. self assertInitializersCalled.! ! !MCFileInTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 00:13'! testStWriter self assertFileOutFrom: MCStWriter canBeFiledInWith: [stream fileIn]. ! ! !MCFileInTest methodsFor: 'asserting' stamp: 'cwp 8/2/2003 13:02'! assertNoChange | actual | actual _ MCSnapshotResource takeSnapshot. diff _ actual patchRelativeToBase: expected. self assert: diff isEmpty! ! !MCFileInTest methodsFor: 'running' stamp: 'cwp 8/2/2003 13:01'! setUp expected _ self mockSnapshot. stream _ RWBinaryOrTextStream on: String new.! ! !MCFileInTest methodsFor: 'running' stamp: 'cwp 8/10/2003 00:27'! tearDown (diff isNil or: [diff isEmpty not]) ifTrue: [expected updatePackage: self mockPackage]! ! !MCInitializationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/11/2003 23:06'! tearDown (MCWorkingCopy forPackage: self mockPackage) unregister! ! !MCInitializationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/11/2003 23:50'! testWorkingCopy MczInstaller storeVersionInfo: self mockVersion. MCWorkingCopy initialize. MCWorkingCopy allManagers detect: [:man | man package name = self mockPackage name] ifNone: [self assert: false]! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'avi 2/22/2004 14:11'! assertDict: dict matchesInfo: info #(name id message date time author) do: [:sel | (info perform: sel) ifNotNilDo: [:i | dict at: sel ifPresent: [:d | self assert: i = d]]]. info ancestors with: (dict at: #ancestors) do: [:i :d | self assertDict: d matchesInfo: i]! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 19:38'! assertNoChange | actual | actual _ MCSnapshotResource takeSnapshot. diff _ actual patchRelativeToBase: expected snapshot. self assert: diff isEmpty! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:25'! assertVersionInfoPresent | dict info | dict _ MczInstaller versionInfo at: self mockPackage name. info _ expected info. self assertDict: dict matchesInfo: info.! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 18:18'! deleteFile (FileDirectory default fileExists: self fileName) ifTrue: [FileDirectory default deleteFileNamed: self fileName]! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 18:15'! fileName ^ 'InstallerTest.mcz'! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 18:16'! fileStream ^ FileStream forceNewFileNamed: self fileName.! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 19:31'! setUp expected _ self mockVersion. self change: #one toReturn: 2.! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 19:36'! tearDown expected snapshot updatePackage: self mockPackage. self deleteFile.! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:25'! testInstallFromFile MCMczWriter fileOut: expected on: self fileStream. MczInstaller installFileNamed: self fileName. self assertNoChange.! ! !MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:25'! testInstallFromStream | stream | stream _ RWBinaryOrTextStream on: String new. MCMczWriter fileOut: expected on: stream. MczInstaller installStream: stream reset. self assertNoChange. self assertVersionInfoPresent. ! ! !MCMergingTest methodsFor: 'asserting' stamp: 'ab 6/2/2003 01:25'! assertMerge: local with: remote base: ancestor gives: result conflicts: conflictResult | merger | conflicts _ #(). merger _ MCThreeWayMerger base: (self snapshotWithElements: local) target: (self snapshotWithElements: remote) ancestor: (self snapshotWithElements: ancestor). merger conflicts do: [:ea | self handleConflict: ea]. self assert: merger mergedSnapshot definitions hasElements: result. self assert: conflicts asSet = conflictResult asSet.! ! !MCMergingTest methodsFor: 'asserting' stamp: 'ab 1/15/2003 16:46'! assert: aCollection hasElements: anArray self assert: (aCollection collect: [:ea | ea token]) asSet = anArray asSet! ! !MCMergingTest methodsFor: 'emulating' stamp: 'ab 6/2/2003 01:42'! handleConflict: aConflict |l r| l _ #removed. r _ #removed. aConflict localDefinition ifNotNilDo: [:d | l _ d token]. aConflict remoteDefinition ifNotNilDo: [:d | r _ d token]. conflicts _ conflicts copyWith: (Array with: r with: l). (l = #removed or: [r = #removed]) ifTrue: [aConflict chooseRemote] ifFalse: [l > r ifTrue: [aConflict chooseLocal] ifFalse: [aConflict chooseRemote]] ! ! !MCMergingTest methodsFor: 'emulating' stamp: 'ab 7/6/2003 23:48'! snapshotWithElements: anArray ^ MCSnapshot fromDefinitions: (anArray collect: [:t | self mockToken: t])! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:28'! testAdditiveConflictlessMerge self assertMerge: #(a1 b1) with: #(a1 c1) base: #(a1) gives: #(a1 b1 c1) conflicts: #()! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:27'! testComplexConflictlessMerge self assertMerge: #(a1 b1 d1) with: #(a2 c1) base: #(a1 c1 d1) gives: #(a2 b1) conflicts: #()! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:28'! testIdenticalModification self assertMerge: #(a2 b1) with: #(a2 b1) base: #(a1 b1) gives: #(a2 b1) conflicts: #()! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:44'! testLocalModifyRemoteRemove self assertMerge: #(a2 b1) with: #(b1) base: #(a1 b1) gives: #(b1) conflicts: #((removed a2)). self assertMerge: #(a1 b1) with: #(b1) base: #(a2 b1) gives: #(b1) conflicts: #((removed a1)).! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:43'! testLocalRemoveRemoteModify self assertMerge: #(b1) with: #(a1 b1) base: #(a2 b1) gives: #(a1 b1) conflicts: #((a1 removed)). self assertMerge: #(b1) with: #(a2 b1) base: #(a1 b1) gives: #(a2 b1) conflicts: #((a2 removed)).! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:38'! testMultipleConflicts self assertMerge: #(a1 b3 c1) with: #(a1 b2 d1) base: #(a1 b1 c2) gives: #(a1 b3 d1) conflicts: #((removed c1) (b2 b3)) ! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:38'! testSimultaneousModification self assertMerge: #(a2) with: #(a3) base: #(a1) gives: #(a3) conflicts: #((a3 a2)).! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 01:27'! testSimultaneousRemove self assertMerge: #(a1) with: #(a1) base: #(a1 b1) gives: #(a1) conflicts: #()! ! !MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 01:31'! testSubtractiveConflictlessMerge self assertMerge: #(a1 b1) with: #() base: #(a1) gives: #(b1) conflicts: #()! ! !MCMethodDefinitionTest methodsFor: 'mocks' stamp: 'bf 5/20/2005 18:07'! override ^ 1! ! !MCMethodDefinitionTest methodsFor: 'running' stamp: 'cwp 11/13/2003 14:15'! ownPackage ^ MCWorkingCopy forPackage: (MCPackage named: 'Monticello')! ! !MCMethodDefinitionTest methodsFor: 'running' stamp: 'cwp 11/13/2003 14:14'! setUp navigation _ (Smalltalk hasClassNamed: #SystemNavigation) ifTrue: [(Smalltalk at: #SystemNavigation) new] ifFalse: [Smalltalk]. isModified _ self ownPackage modified.! ! !MCMethodDefinitionTest methodsFor: 'running' stamp: 'bf 5/20/2005 18:23'! tearDown self restoreMocks. (MCWorkingCopy forPackage: (MCPackage named: 'FooBarBaz')) unregister. self class compile: 'override ^ 1' classified: 'mocks'. self ownPackage modified: isModified! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'avi 1/24/2004 20:31'! testCannotLoad | definition | definition _ self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false. self should: [definition load] raise: Error. self assert: (navigation allImplementorsOf: #kjahs87) isEmpty! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'ab 1/15/2003 17:52'! testComparison |d1 d2 d3 d4 d5 | d1 _ self mockMethod: #one class: 'A' source: '1' meta: false. d2 _ self mockMethod: #one class: 'A' source: '2' meta: false. d3 _ self mockMethod: #one class: 'A' source: '1' meta: true. d4 _ self mockMethod: #two class: 'A' source: '1' meta: false. d5 _ self mockMethod: #two class: 'A' source: '1' meta: false. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self deny: (d1 isRevisionOf: d3). self deny: (d1 isRevisionOf: d4). self assert: (d4 isSameRevisionAs: d5).! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:09'! testLoadAndUnload |definition| definition _ self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false. self assert: self mockInstanceA one = 1. definition load. self assert: self mockInstanceA one = 2. definition unload. self deny: (self mockInstanceA respondsTo: #one)! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'cwp 11/13/2003 13:28'! testPartiallyRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz'. self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory. self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory. definition _ (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod. self assert: self override = 4. definition unload. self assert: self override = 2. self assert: (MethodReference class: self class selector: #override) category = '*foobarbaz'. ! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'avi 2/22/2004 13:57'! testRevertOldMethod | definition changeRecord | Object compile: 'yourself ^ self' classified: MCMockPackageInfo new methodCategoryPrefix. definition _ (MethodReference class: Object selector: #yourself) asMethodDefinition. changeRecord _ definition scanForPreviousVersion. self assert: changeRecord notNil. self assert: changeRecord category = 'accessing'. changeRecord fileIn.! ! !MCMethodDefinitionTest methodsFor: 'testing' stamp: 'cwp 11/13/2003 13:24'! testRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: self mockOverrideMethodCategory. definition _ (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod. self assert: self override = 2. definition unload. self assert: self override = 1. self assert: (MethodReference class: self class selector: #override) category = 'mocks'. ! ! !MCOrganizationTest methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 13:25'! testReordering |dec cats newCats | dec _ MCOrganizationDefinition categories: #(A B C). cats _ #(X Y B Z C A Q). newCats _ dec reorderCategories: cats original: #(B C A). self assert: newCats asArray = #(X Y A B C Z Q).! ! !MCOrganizationTest methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 13:21'! testReorderingWithNoCategoriesInVersion |dec cats newCats | dec _ MCOrganizationDefinition categories: #(). cats _ #(X Y B Z C A Q). newCats _ dec reorderCategories: cats original: #(). self assert: newCats asArray = cats.! ! !MCOrganizationTest methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 13:22'! testReorderingWithRemovals |dec cats newCats | dec _ MCOrganizationDefinition categories: #(A B C). cats _ #(X Y B Z C A Q). newCats _ dec reorderCategories: cats original: #(Y B C A Q). self assert: newCats asArray = #(X A B C Z).! ! !MCPackageTest methodsFor: 'running' stamp: 'cwp 8/9/2003 23:43'! tearDown self mockSnapshot install! ! !MCPackageTest methodsFor: 'tests' stamp: 'cwp 9/14/2003 19:30'! testUnload | mock | self mockPackage unload. self deny: (Smalltalk hasClassNamed: #MCMockClassA). self deny: (MCSnapshotTest includesSelector: #mockClassExtension). mock _ (Smalltalk at: #MCMock). self assert: (mock subclasses detect: [:c | c name = #MCMockClassA] ifNone: []) isNil! ! !MCPatchTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/2/2003 17:24'! setUp |rev1 rev2| rev1 _ MCSnapshotResource takeSnapshot. self change: #one toReturn: 2. rev2 _ MCSnapshotResource takeSnapshot. patch _ rev2 patchRelativeToBase: rev1. self change: #one toReturn: 1.! ! !MCPatchTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/2/2003 17:24'! tearDown self restoreMocks! ! !MCPatchTest methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:31'! testPatchContents self assert: patch operations size = 1. self assert: patch operations first isModification. self assert: patch operations first definition selector = #one. ! ! !MCRepositoryTest methodsFor: 'actions' stamp: 'ab 8/16/2003 17:46'! addVersionWithSnapshot: aSnapshot name: aString | version | version _ self versionWithSnapshot: aSnapshot name: aString. self addVersion: version. ^ version info! ! !MCRepositoryTest methodsFor: 'actions' stamp: 'ab 8/16/2003 17:46'! addVersion: aVersion self subclassResponsibility ! ! !MCRepositoryTest methodsFor: 'actions' stamp: 'ab 7/19/2003 16:20'! saveSnapshot1 ^ self saveSnapshot: self snapshot1 named: 'rev1'! ! !MCRepositoryTest methodsFor: 'actions' stamp: 'ab 7/19/2003 16:20'! saveSnapshot2 ^ self saveSnapshot: self snapshot2 named: 'rev2'! ! !MCRepositoryTest methodsFor: 'actions' stamp: 'ab 8/16/2003 17:45'! saveSnapshot: aSnapshot named: aString | version | version _ self versionWithSnapshot: aSnapshot name: aString. repository storeVersion: version. ^ version info ! ! !MCRepositoryTest methodsFor: 'asserting' stamp: 'ab 7/19/2003 23:59'! assertMissing: aVersionInfo self assert: (repository versionWithInfo: aVersionInfo) isNil! ! !MCRepositoryTest methodsFor: 'asserting' stamp: 'ab 8/16/2003 18:07'! assertVersionInfos: aCollection self assert: repository allVersionInfos asSet = aCollection asSet! ! !MCRepositoryTest methodsFor: 'building' stamp: 'ab 7/10/2003 01:03'! snapshot1 ^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('y'))))! ! !MCRepositoryTest methodsFor: 'building' stamp: 'ab 7/10/2003 01:03'! snapshot2 ^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('x'))))! ! !MCRepositoryTest methodsFor: 'building' stamp: 'avi 2/12/2004 21:01'! versionWithSnapshot: aSnapshot name: aString | info | info _ self mockVersionInfo: aString. ^ MCVersion package: (MCPackage new name: aString) info: info snapshot: aSnapshot! ! !MCRepositoryTest methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:32'! snapshotAt: aVersionInfo ^ (repository versionWithInfo: aVersionInfo) snapshot! ! !MCRepositoryTest methodsFor: 'tests' stamp: 'ab 8/16/2003 17:52'! testAddAndLoad | node | node _ self addVersionWithSnapshot: self snapshot1 name: 'rev1'. self assert: (self snapshotAt: node) = self snapshot1. ! ! !MCRepositoryTest methodsFor: 'tests' stamp: 'avi 2/17/2004 03:24'! testIncludesName self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1'). self saveSnapshot1. self assert: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1'). self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2'). self saveSnapshot2. self assert: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2').! ! !MCRepositoryTest methodsFor: 'tests' stamp: 'ab 7/19/2003 23:59'! testLoadMissingNode | node | node _ MCVersionInfo new. self assertMissing: node! ! !MCRepositoryTest methodsFor: 'tests' stamp: 'ab 7/7/2003 14:22'! testStoreAndLoad | node node2 | node _ self saveSnapshot1. node2 _ self saveSnapshot2. self assert: (self snapshotAt: node) = self snapshot1. self assert: (self snapshotAt: node2) = self snapshot2.! ! !MCDictionaryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 8/16/2003 17:53'! addVersion: aVersion dict at: aVersion info put: aVersion! ! !MCDictionaryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 16:06'! deleteNode: aNode dict removeKey: aNode! ! !MCDictionaryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 16:06'! dictionary ^ dict ifNil: [dict _ Dictionary new]! ! !MCDictionaryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/26/2003 02:49'! setUp repository _ MCDictionaryRepository new dictionary: self dictionary! ! !MCDirectoryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 12:41'! addVersion: aVersion | file | file _ FileStream newFileNamed: (directory fullNameFor: aVersion fileName). aVersion fileOutOn: file. file close.! ! !MCDirectoryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 12:48'! directory directory ifNil: [directory _ FileDirectory default directoryNamed: 'mctest'. directory assureExistence]. ^ directory! ! !MCDirectoryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 12:49'! setUp repository _ MCDirectoryRepository new directory: self directory! ! !MCDirectoryRepositoryTest methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 12:53'! tearDown self directory recursiveDelete! ! !MCScannerTest methodsFor: 'asserting' stamp: 'avi 1/22/2004 20:23'! assertScans: anArray self assert: (MCScanner scan: anArray printString readStream) = anArray! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:19'! test1 self assertScans: #(a '23' (x))! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:22'! test2 self assertScans: 'it''s alive'! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:23'! test3 self assert: (MCScanner scan: '(a #b c)' readStream) = #(a #b c)! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:23'! test4 self assertScans: #(a '23' (x () ')''q' y12)).! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:26'! test5 self assertScans: #((a) b)! ! !MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:28'! test6 self should: [MCScanner scan: '(a b' readStream] raise: Error! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'cwp 8/8/2003 23:01'! assertClass: readerClass providesServices: labels | services suffix | suffix _ readerClass extension. self assert: (FileList isReaderNamedRegistered: readerClass name). services _ readerClass fileReaderServicesForFile: 'foo' suffix: suffix. self assert: ((services collect: [:service | service buttonLabel]) includesAllOf: labels)! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'avi 1/21/2004 22:57'! assertDependenciesMatchWith: writerClass | stream readerClass expected actual | readerClass _ writerClass readerClass. expected _ self mockVersionWithDependencies. stream _ RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual _ (readerClass on: stream reset) dependencies. self assert: actual = expected dependencies.! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'cwp 8/1/2003 14:57'! assertExtensionProvidedBy: aClass self shouldnt: [aClass readerClass extension] raise: Exception.! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'avi 2/17/2004 02:00'! assertSnapshotsMatchWith: writerClass | readerClass expected stream actual | readerClass _ writerClass readerClass. expected _ self mockSnapshot. stream _ RWBinaryOrTextStream on: String new. (writerClass on: stream) writeSnapshot: expected. actual _ readerClass snapshotFromStream: stream reset. self assertSnapshot: actual matches: expected.! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'ab 8/20/2003 20:22'! assertVersionInfosMatchWith: writerClass | stream readerClass expected actual | readerClass _ writerClass readerClass. expected _ self mockVersion. stream _ RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual _ readerClass versionInfoFromStream: stream reset. self assert: actual = expected info.! ! !MCSerializationTest methodsFor: 'asserting' stamp: 'cwp 8/8/2003 15:02'! assertVersionsMatchWith: writerClass | stream readerClass expected actual | readerClass _ writerClass readerClass. expected _ self mockVersion. stream _ RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual _ readerClass versionFromStream: stream reset. self assertVersion: actual matches: expected.! ! !MCSerializationTest methodsFor: 'mocks' stamp: 'cwp 11/6/2004 16:00'! mockDiffyVersion | repos workingCopy base next | repos _ MCDictionaryRepository new. workingCopy _ MCWorkingCopy forPackage: self mockPackage. workingCopy repositoryGroup addRepository: repos. MCRepositoryGroup default removeRepository: repos. base _ self mockVersion. repos storeVersion: base. self change: #a toReturn: 'a2'. next _ self mockVersionWithAncestor: base. ^ next asDiffAgainst: base ! ! !MCSerializationTest methodsFor: 'testing' stamp: 'avi 2/13/2004 23:28'! testMcdSerialization | stream expected actual | expected _ self mockDiffyVersion. stream _ RWBinaryOrTextStream on: String new. MCMcdWriter fileOut: expected on: stream. actual _ MCMcdReader versionFromStream: stream reset. self assertVersion: actual matches: expected.! ! !MCSerializationTest methodsFor: 'testing' stamp: 'avi 1/19/2004 15:14'! testMczSerialization self assertVersionsMatchWith: MCMczWriter. self assertExtensionProvidedBy: MCMczWriter. self assertVersionInfosMatchWith: MCMczWriter. self assertDependenciesMatchWith: MCMczWriter.! ! !MCSerializationTest methodsFor: 'testing' stamp: 'cwp 8/3/2003 18:43'! testStSerialization self assertSnapshotsMatchWith: MCStWriter.! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:46'! allCategories ^ Array with: model extensionsCategory with: self mockCategoryName.! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:58'! allMethods ^ MCSnapshotResource current definitions select: [:def | def isMethodDefinition] thenCollect: [:def | def selector] ! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:58'! allProtocols ^ MCSnapshotResource current definitions select: [:def | def isMethodDefinition] thenCollect: [:def | def category] ! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/13/2003 02:23'! classABooleanMethods ^ #(falsehood moreTruth truth)! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'! classAClassProtocols ^ self protocolsForClass: self mockClassA class.! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'! classAComment ^ self mockClassA organization classComment.! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'! classADefinitionString ^ self mockClassA definition! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'! classAProtocols ^ self protocolsForClass: self mockClassA.! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:59'! definedClasses ^ MCSnapshotResource current definitions select: [:def | def isClassDefinition] thenCollect: [:def | def className].! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/13/2003 02:53'! falsehoodMethodSource ^ 'falsehood ^ false'! ! !MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/13/2003 13:15'! protocolsForClass: aClass | protocols | protocols _ aClass organization categories. protocols size > 1 ifTrue: [protocols _ protocols copyWith: '-- all --']. ^ protocols.! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/28/2003 22:21'! annotationTextMorph ^ (self morphsOfClass: TextMorph) first! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 09:12'! buttonMorphs ^ self morphsOfClass: PluggableButtonMorph! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 09:19'! findButtonWithLabel: aString ^ self buttonMorphs detect: [:m | m label = aString]! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 01:28'! findListContaining: aString ^ self listMorphs detect: [:m | m getList includes: aString]! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 02:34'! listMorphs ^ self morphsOfClass: PluggableListMorph! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/14/2003 14:44'! morphsOfClass: aMorphClass | morphs | morphs _ OrderedCollection new. morph allMorphsDo: [:m | (m isKindOf: aMorphClass) ifTrue: [morphs add: m]]. ^ morphs! ! !MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/28/2003 22:21'! textMorph ^ (self morphsOfClass: TextMorph) last! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 01:19'! assertAListIncludes: anArrayOfStrings self listMorphs detect: [:m | m getList includesAllOf: anArrayOfStrings] ifNone: [self assert: false].! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 01:39'! assertAListMatches: strings | listMorphs list | listMorphs _ self listMorphs. listMorphs detect: [:m | list _ m getList. (list size = strings size) and: [list includesAllOf: strings]] ifNone: [self assert: false].! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:12'! assertButtonExists: aString self buttonMorphs detect: [:m | m label = aString] ifNone: [self assert: false]. ! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:26'! assertButtonOn: aString self assert: (self findButtonWithLabel: aString) getModelState. ! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 02:38'! assertTextIs: aString self assert: self textMorph contents = aString.! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 08:51'! denyAListHasSelection: aString | found | found _ true. self listMorphs detect: [:m | m selection = aString] ifNone: [found _ false]. self deny: found.! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 02:05'! denyAListIncludesAnyOf: anArrayOfStrings | found | found _ true. self listMorphs detect: [:m | m getList includesAnyOf: anArrayOfStrings] ifNone: [found _ false]. self deny: found.! ! !MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:27'! denyButtonOn: aString self deny: (self findButtonWithLabel: aString) getModelState. ! ! !MCSnapshotBrowserTest methodsFor: 'simulating' stamp: 'cwp 7/13/2003 09:22'! clickOnButton: aString (self findButtonWithLabel: aString) performAction.! ! !MCSnapshotBrowserTest methodsFor: 'simulating' stamp: 'cwp 7/13/2003 01:53'! clickOnListItem: aString | listMorph | listMorph _ self findListContaining: aString. listMorph changeModelSelection: (listMorph getList indexOf: aString).! ! !MCSnapshotBrowserTest methodsFor: 'selecting' stamp: 'cwp 7/13/2003 13:04'! selectMockClassA self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. ! ! !MCSnapshotBrowserTest methodsFor: 'running' stamp: 'ab 7/16/2003 14:41'! setUp model _ MCSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot. morph _ model buildWindow.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/28/2003 22:29'! testAnnotationPane | oldPref | oldPref _ Preferences annotationPanes. Preferences disable: #annotationPanes. morph _ model buildWindow. self assert: (self morphsOfClass: TextMorph) size = 1. Preferences enable: #annotationPanes. morph _ model buildWindow. self assert: (self morphsOfClass: TextMorph) size = 2. Preferences setPreference: #annotationPanes toValue: oldPref! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 09:31'! testButtonMutex self assertButtonOn: 'instance'. self denyButtonOn: '?'. self denyButtonOn: 'class'. self clickOnButton: '?'. self assertButtonOn: '?'. self denyButtonOn: 'instance'. self denyButtonOn: 'class'. self clickOnButton: 'class'. self assertButtonOn: 'class'. self denyButtonOn: '?'. self denyButtonOn: 'instance'. ! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:40'! testCategorySelected self clickOnListItem: self mockCategoryName. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: ''.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 13:04'! testClassSelected self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 13:06'! testClassSideClassSelected self clickOnButton: 'class'. self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAClassProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 12:52'! testComment self clickOnButton: '?'. self assertTextIs: ''. self clickOnListItem: self mockCategoryName. self assertTextIs: ''. self clickOnListItem: 'MCMockClassA'. self assertTextIs: self classAComment.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:30'! testFourColumns self assert: self listMorphs size = 4.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 09:00'! testMethodIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self clickOnListItem: '-- all --'. self denyAListHasSelection: 'falsehood'.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:50'! testMethodSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: self falsehoodMethodSource.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:39'! testNoSelection self assertAListMatches: self allCategories. self denyAListIncludesAnyOf: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: ''.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 08:46'! testProtocolIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockASubclass'. self clickOnListItem: 'as yet unclassified'. self clickOnListItem: 'MCMockClassA'. self denyAListHasSelection: 'as yet unclassified'.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 08:52'! testProtocolSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: ''. ! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:37'! testTextPane self shouldnt: [self textMorph] raise: Exception.! ! !MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 09:14'! testThreeButtons self assertButtonExists: 'instance'. self assertButtonExists: '?'. self assertButtonExists: 'class'.! ! !MCSnapshotTest methodsFor: '*monticello-mocks' stamp: 'ab 7/7/2003 23:21'! mockClassExtension! ! !MCSnapshotTest methodsFor: 'running' stamp: 'ab 7/7/2003 13:38'! setUp snapshot _ self mockSnapshot.! ! !MCSnapshotTest methodsFor: 'tests' stamp: 'ab 7/7/2003 13:38'! testCreation |d| d _ self mockSnapshot definitions. self assert: (d anySatisfy: [:ea | ea isClassDefinition and: [ea className = #MCMockClassA]]). self assert: (d anySatisfy: [:ea | ea isMethodDefinition and: [ea selector = #mockClassExtension]]). self assert: (d allSatisfy: [:ea | ea isClassDefinition not or: [ea category endsWith: 'Mocks']]). ! ! !MCSnapshotTest methodsFor: 'tests' stamp: 'ab 7/26/2003 02:14'! testInstanceReuse | x m n y | x _ (MCPackage new name: self mockCategoryName) snapshot. Smalltalk garbageCollect. n _ MCDefinition allSubInstances size. y _ (MCPackage new name: self mockCategoryName) snapshot. Smalltalk garbageCollect. m _ MCDefinition allSubInstances size. self assert: m = n! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'ab 8/17/2003 16:52'! commentWithoutStyle ^ ' CharacterScanner subclass: #CanvasCharacterScanner instanceVariableNames: ''canvas fillBlt foregroundColor runX lineY '' classVariableNames: '''' poolDictionaries: '''' category: ''Morphic-Support''!! !!CanvasCharacterScanner commentStamp: '''' prior: 0!! A displaying scanner which draws its output to a Morphic canvas.!! !!CanvasCharacterScanner methodsFor: ''stop conditions'' stamp: ''ar 12/15/2001 23:27''!! setStopConditions "Set the font and the stop conditions for the current run." self setFont. stopConditions at: Space asciiValue + 1 put: (alignment = Justified ifTrue: [#paddedSpace])!! !!'! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/16/2003 23:35'! commentWithStyle ^ '!!AEDesc commentStamp: '''' prior: 0!! I represent an Apple Event Descriptor. I am a low-level representation of Apple Event (and hence Applescript) information. For further Information, see Apple''s Inside Macintosh: Interapplication Communications, at http://developer.apple.com/techpubs/mac/IAC/IAC-2.html. Essentially, I represent a record comprising a one-word "string" (treating the word as fourbyte characters) representing a data type, followed by a pointer to a pointer (a handle) to the data I represent. Care must be taken to assure that the Handle data is disposed after use, or memory leaks result. At this time, I make no effort to do this automatically through finalization.!! ]style[(218 54 384)f1,f1Rhttp://developer.apple.com/techpubs/mac/IAC/IAC-2.html;,f1!! '! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/16/2003 23:07'! methodWithStyle ^ '!!EventHandler methodsFor: ''copying'' stamp: ''tk 1/22/2001 17:39''!! veryDeepInner: deepCopier "ALL fields are weakly copied. Can''t duplicate an object by duplicating a button that activates it. See DeepCopier." super veryDeepInner: deepCopier. "just keep old pointers to all fields" clickRecipient _ clickRecipient.!! ]style[(25 108 10 111)f1b,f1,f1LDeepCopier Comment;,f1!! !! '! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:16'! testCommentWithoutStyle | reader | reader _ MCStReader on: self commentWithoutStyle readStream. self assert: (reader definitions anySatisfy: [:ea | ea isMethodDefinition]).! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:16'! testCommentWithStyle | reader | reader _ MCStReader on: self commentWithStyle readStream. reader definitions! ! !MCStReaderTest methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:16'! testMethodWithStyle | reader | reader _ MCStReader on: self methodWithStyle readStream. self assert: reader definitions first isMethodDefinition.! ! !MCStWriterTest methodsFor: 'asserting' stamp: 'cwp 8/2/2003 12:13'! assertAllChunksAreWellFormed stream reset. stream untilEnd: [self assertChunkIsWellFormed: stream nextChunk] displayingProgress: 'Checking syntax...'! ! !MCStWriterTest methodsFor: 'asserting' stamp: 'cwp 8/2/2003 11:34'! assertChunkIsWellFormed: chunk Parser new parse: chunk readStream class: UndefinedObject noPattern: true context: nil notifying: nil ifFail: [self assert: false]! ! !MCStWriterTest methodsFor: 'asserting' stamp: 'nk 2/22/2005 21:17'! assertContentsOf: strm match: expected | actual | actual := strm contents. self assert: actual size = expected size. actual with: expected do: [:a :e | self assert: a = e]! ! !MCStWriterTest methodsFor: 'asserting' stamp: 'cwp 8/2/2003 12:47'! assertMethodChunkIsWellFormed: chunk Parser new parse: chunk readStream class: UndefinedObject noPattern: false context: nil notifying: nil ifFail: [self assert: false]! ! !MCStWriterTest methodsFor: 'data' stamp: 'cwp 2/3/2004 21:39'! expectedClassDefinitionA ^ ' MCMock subclass: #MCMockClassA instanceVariableNames: ''ivar'' classVariableNames: ''CVar'' poolDictionaries: '''' category: ''Monticello-Mocks''!! !!MCMockClassA commentStamp: ''cwp 8/10/2003 16:43'' prior: 0!! This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.!! '! ! !MCStWriterTest methodsFor: 'data' stamp: 'avi 2/17/2004 03:23'! expectedClassDefinitionB ^ ' MCMock subclass: #MCMockClassB instanceVariableNames: ''ivarb'' classVariableNames: ''CVar'' poolDictionaries: ''MCMockAPoolDictionary'' category: ''Monticello-Mocks''!! MCMockClassB class instanceVariableNames: ''ciVar''!! !!MCMockClassB commentStamp: '''' prior: 0!! This comment has a bang!!!! Bang!!!! Bang!!!!!! '! ! !MCStWriterTest methodsFor: 'data' stamp: 'cwp 8/2/2003 14:43'! expectedClassMethodDefinition ^ ' !!MCMockClassA class methodsFor: ''as yet unclassified'' stamp: ''ab 7/7/2003 23:21''!! one ^ 1!! !! '! ! !MCStWriterTest methodsFor: 'data' stamp: 'cwp 8/2/2003 17:27'! expectedMethodDefinition ^ ' !!MCMockClassA methodsFor: ''numeric'' stamp: ''cwp 8/2/2003 17:26''!! one ^ 1!! !! '! ! !MCStWriterTest methodsFor: 'data' stamp: 'cwp 8/9/2003 14:58'! expectedMethodDefinitionWithBangs ^ ' !!MCStWriterTest methodsFor: ''testing'' stamp: ''cwp 8/9/2003 14:55''!! methodWithBangs ^ '' ^ ReadStream on: ''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!! MCOrganizationDeclaration categories: #( ''''Monticello-Mocks'''')!!!!!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''''Monticello-Mocks'''' instVarNames: #() comment: ''''''''!!!!!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''''as yet unclassified'''' timeStamp: ''''cwp 7/8/2003 21:21'''' source: ''''one ^ 1''''!!!!!!!! '''' '' !! !! '! ! !MCStWriterTest methodsFor: 'data' stamp: 'cwp 8/2/2003 12:14'! expectedOrganizationDefinition ^ 'SystemOrganization addCategory: ''Monticello-Mocks''!! '! ! !MCStWriterTest methodsFor: 'testing' stamp: 'ab 8/8/2003 17:01'! expectedInitializerA ^ 'MCMockClassA initialize'! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/9/2003 14:55'! methodWithBangs ^ ' ^ ReadStream on: ''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!! MCOrganizationDeclaration categories: #( ''Monticello-Mocks'')!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''Monticello-Mocks'' instVarNames: #() comment: ''''!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''as yet unclassified'' timeStamp: ''cwp 7/8/2003 21:21'' source: ''one ^ 1''!!!! '' ' ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/2/2003 12:03'! setUp stream _ RWBinaryOrTextStream on: String new. writer _ MCStWriter on: stream. ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:11'! testClassDefinitionA writer visitClassDefinition: (self mockClassA asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionA. stream reset. 2 timesRepeat: [self assertChunkIsWellFormed: stream nextChunk]! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 9/14/2003 19:39'! testClassDefinitionB writer visitClassDefinition: (self mockClassB asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionB. ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:11'! testClassMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA class selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedClassMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'avi 2/17/2004 01:50'! testInitializerDefinition |chunk lastChunk| writer writeSnapshot: self mockSnapshot. stream reset. [stream atEnd] whileFalse: [chunk _ stream nextChunk. chunk isAllSeparators ifFalse: [lastChunk _ chunk]]. self assertContentsOf: lastChunk readStream match: self expectedInitializerA! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:11'! testMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/9/2003 14:52'! testMethodDefinitionWithBangs writer visitMethodDefinition: (MethodReference class: self class selector: #methodWithBangs) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinitionWithBangs. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! ! !MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/2/2003 12:13'! testOrganizationDefinition | definition | definition _ MCOrganizationDefinition categories: (self mockPackage packageInfo systemCategories). writer visitOrganizationDefinition: definition. self assertContentsOf: stream match: self expectedOrganizationDefinition. self assertAllChunksAreWellFormed.! ! !MCTestCase class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:12'! isAbstract ^ self = MCTestCase! ! !MCTestCase class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:05'! resources ^ Array with: MCSnapshotResource! ! !MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 01:20'! classAComment ^ 'This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.'! ! !MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 17:59'! classACommentStamp ^ 'cwp 8/10/2003 16:43'! ! !MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 18:01'! restoreClassAComment Smalltalk at: #MCMockClassA ifPresent: [:a | a classComment: self classAComment stamp: self classACommentStamp]! ! !MCInitializationTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/13/2003 12:11'! isAbstract ^ (Smalltalk hasClassNamed: #MczInstaller) not ! ! !MCMczInstallerTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/13/2003 12:11'! isAbstract ^ (Smalltalk hasClassNamed: #MczInstaller) not ! ! !MCMczInstallerTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/13/2003 11:56'! suite ^ (Smalltalk hasClassNamed: #MczInstaller) ifTrue: [super suite] ifFalse: [TestSuite new name: self name asString]! ! !MCRepositoryTest class methodsFor: 'as yet unclassified' stamp: 'ab 7/6/2003 12:45'! isAbstract ^ self = MCRepositoryTest! ! !MCSnapshotBrowserTest class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 14:59'! resources ^ Array with: MCSnapshotResource! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'avi 10/6/2004 15:18'! addBaseSnapshot: aSnapshot aSnapshot definitions do: [:ea | index add: ea. provisions addAll: ea provisions]! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:31'! addDefinition: aDefinition index definitionLike: aDefinition ifPresent: [:other | other = aDefinition ifFalse: [self addConflictWithOperation: (MCModification of: other to: aDefinition)]] ifAbsent: [self addOperation: (MCAddition of: aDefinition)]! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:30'! addOperation: anOperation self operations add: anOperation! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:52'! applyPatch: aPatch aPatch applyTo: self! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:32'! applyTo: anObject super applyTo: anObject. self operations do: [:ea | ea applyTo: anObject]! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:49'! baseSnapshot ^ (MCSnapshot fromDefinitions: index definitions)! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'avi 10/6/2004 15:18'! initialize index _ MCDefinitionIndex new. provisions _ Set new! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:34'! modifyDefinition: baseDefinition to: targetDefinition index definitionLike: baseDefinition ifPresent: [:other | other = baseDefinition ifTrue: [self addOperation: (MCModification of: baseDefinition to: targetDefinition)] ifFalse: [other = targetDefinition ifFalse: [self addConflictWithOperation: (MCModification of: other to: targetDefinition)]]] ifAbsent: [self addConflictWithOperation: (MCAddition of: targetDefinition)]! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:30'! operations ^ operations ifNil: [operations _ OrderedCollection new]! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'avi 10/6/2004 15:19'! provisions ^ provisions! ! !MCThreeWayMerger methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:31'! removeDefinition: aDefinition index definitionLike: aDefinition ifPresent: [:other | other = aDefinition ifTrue: [self addOperation: (MCRemoval of: aDefinition)] ifFalse: [self addConflictWithOperation: (MCRemoval of: other)]] ifAbsent: []! ! !MCThreeWayMerger class methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:53'! base: aSnapshot patch: aPatch aPatch isEmpty ifTrue: [MCNoChangesException signal]. ^ self new addBaseSnapshot: aSnapshot; applyPatch: aPatch; yourself ! ! !MCThreeWayMerger class methodsFor: 'as yet unclassified' stamp: 'ab 6/2/2003 01:09'! base: aSnapshot target: targetSnapshot ancestor: ancestorSnapshot ^ self base: aSnapshot patch: (targetSnapshot patchRelativeToBase: ancestorSnapshot)! ! !MCThreeWayMerger class methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:52'! new ^ self basicNew initialize! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:52'! answer: anObject modalValue _ anObject. self close.! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 16:50'! arrowKey: aCharacter from: aPluggableListMorph "backstop"! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 2/17/2004 12:50'! buildWindow | window | window _ SystemWindow labelled: self label. window model: self. self widgetSpecs do: [:pair | |send fractions offsets| send _ pair first. fractions _ pair at: 2 ifAbsent: [#(0 0 1 1)]. offsets _ pair at: 3 ifAbsent: [#(0 0 0 0)]. window addMorph: (self perform: send first withArguments: send allButFirst ) fullFrame: (LayoutFrame fractions: ((fractions first)@(fractions second) corner: (fractions third)@(fractions fourth)) offsets: ((offsets first)@(offsets second) corner: (offsets third)@(offsets fourth)))]. ^ window! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:04'! buildWith: builder | windowBuilder | windowBuilder _ MCToolWindowBuilder builder: builder tool: self. self widgetSpecs do: [:spec | | send fractions offsets origin corner | send _ spec first. fractions _ spec at: 2 ifAbsent: [#(0 0 1 1)]. offsets _ spec at: 3 ifAbsent: [#(0 0 0 0)]. origin _ (offsets first @ offsets second) / self defaultExtent asFloatPoint + (fractions first @ fractions second). corner _ (offsets third @ offsets fourth) / self defaultExtent asFloatPoint + (fractions third @ fractions fourth). windowBuilder frame: (origin corner: corner). windowBuilder perform: send first withArguments: send allButFirst]. ^ windowBuilder build ! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:19'! buttonEnabled ^ true! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 18:34'! buttonRow ^ self buttonRow: self buttonSpecs! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:28'! buttonRow: specArray | aRow aButton enabled selected | aRow _ AlignmentMorph newRow. aRow color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]); borderWidth: 0. aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true. aRow clipSubmorphs: true. aRow layoutInset: 5@2; cellInset: 3. aRow wrapCentering: #center; cellPositioning: #leftCenter. specArray do: [:triplet | enabled _ triplet at: 4 ifAbsent: [#buttonEnabled]. selected _ triplet at: 5 ifAbsent: [enabled]. aButton _ PluggableButtonMorph on: self getState: selected action: #performButtonAction:enabled:. aButton hResizing: #spaceFill; vResizing: #spaceFill; useRoundedCorners; label: triplet first asString; arguments: (Array with: triplet second with: enabled); onColor: Color transparent offColor: Color white. aRow addMorphBack: aButton. aButton setBalloonText: triplet third]. Preferences alternativeWindowLook ifTrue:[ aRow color: Color transparent. aRow submorphsDo:[:m| m borderWidth: 2; borderColor: #raised]. ]. ^ aRow! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:22'! buttonSelected ^ false! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:23'! buttonSpecs ^ #()! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 00:45'! buttonState ^ true! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:42'! close self window delete! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 7/24/2003 13:31'! defaultAnnotationPaneHeight "Answer the receiver's preferred default height for new annotation panes." ^ Preferences parameterAt: #defaultAnnotationPaneHeight ifAbsentPut: [25]! ! !MCTool methodsFor: 'morphic ui' stamp: 'avi 2/18/2004 19:56'! defaultBackgroundColor ^ (Color r: 0.627 g: 0.69 b: 0.976)! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:22'! defaultButtonPaneHeight "Answer the user's preferred default height for new button panes." ^ Preferences parameterAt: #defaultButtonPaneHeight ifAbsentPut: [25]! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:10'! defaultExtent ^ 500@500! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:11'! defaultLabel ^ self class name! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 22:33'! fillMenu: aMenu fromSpecs: anArray anArray do: [:pair | aMenu add: pair first target: self selector: pair second]. ^ aMenu! ! !MCTool methodsFor: 'morphic ui' stamp: 'bf 3/16/2005 14:48'! findListMorph: aSymbol ^ morph submorphs detect: [:ea | (ea respondsTo: #getListSelector) and: [ea getListSelector = aSymbol]] ifNone: []! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 8/24/2003 20:15'! findTextMorph: aSymbol ^ morph submorphs detect: [:ea | (ea respondsTo: #getTextSelector) and: [ea getTextSelector = aSymbol]] ifNone: []! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:23'! getMenu: aMenu ^aMenu! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:36'! label ^ label ifNil: [self defaultLabel]! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:36'! label: aString label _ aString! ! !MCTool methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 17:30'! listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 17:03'! listMorph: listSymbol keystroke: keystrokeSymbol ^ (self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol) keystrokeActionSelector: keystrokeSymbol; yourself! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:46'! listMorph: listSymbol selection: selectionSymbol ^ PluggableListMorph on: self list: listSymbol selected: selectionSymbol changeSelected: (selectionSymbol, ':') asSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:46'! listMorph: listSymbol selection: selectionSymbol menu: menuSymbol ^ PluggableListMorph on: self list: listSymbol selected: selectionSymbol changeSelected: (selectionSymbol, ':') asSymbol menu: menuSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 16:50'! listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol ^ (PluggableListMorph on: self list: listSymbol selected: selectionSymbol changeSelected: (selectionSymbol, ':') asSymbol menu: menuSymbol) keystrokeActionSelector: keystrokeSymbol; yourself! ! !MCTool methodsFor: 'morphic ui' stamp: 'avi 9/11/2004 16:19'! multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol ^ PluggableListMorphOfMany on: self list: listSymbol primarySelection: selectionSymbol changePrimarySelection: (selectionSymbol, ':') asSymbol listSelection: listSelectionSymbol changeListSelection: (listSelectionSymbol, 'put:') asSymbol menu: menuSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'lr 10/5/2003 09:09'! performButtonAction: anActionSelector enabled: anEnabledSelector (self perform: anEnabledSelector) ifTrue: [ self perform: anActionSelector ]! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:18'! perform: selector orSendTo: otherTarget "Selector was just chosen from a menu by a user. If can respond, then perform it on myself. If not, send it to otherTarget, presumably the editPane from which the menu was invoked." (self respondsTo: selector) ifTrue: [^ self perform: selector] ifFalse: [^ otherTarget perform: selector]! ! !MCTool methodsFor: 'morphic ui' stamp: 'avi 2/13/2005 17:58'! show modal _ false. Smalltalk at: #ToolBuilder ifPresent: [:tb | tb open: self. ^ self]. ^self window openInWorldExtent: self defaultExtent; yourself! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 4/17/2004 10:01'! showLabelled: labelString modal _ false. self label: labelString. ^(self window) openInWorldExtent: self defaultExtent; yourself! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:51'! showModally modal _ true. self window openInWorldExtent: (400@400). [self window world notNil] whileTrue: [ self window outermostWorldMorph doOneCycle. ]. morph _ nil. ^ modalValue! ! !MCTool methodsFor: 'morphic ui' stamp: 'nk 6/12/2004 14:11'! step ! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:36'! textMorph: aSymbol ^ PluggableTextMorph on: self text: aSymbol accept: (aSymbol, ':') asSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:27'! treeMorph: listSymbol ^ self treeMorph: (listSymbol, 'Tree') asSymbol selection: (listSymbol, 'SelectionWrapper') asSymbol menu: (listSymbol, 'TreeMenu:') asSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:43'! treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol ^ SimpleHierarchicalListMorph on: self list: listSymbol selected: selectionSymbol changeSelected: (selectionSymbol, ':') asSymbol menu: menuSymbol keystroke: nil! ! !MCTool methodsFor: 'morphic ui' stamp: 'avi 3/6/2005 22:31'! treeOrListMorph: aSymbol ^ self treeMorph: aSymbol! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:40'! widgetSpecs ^ #()! ! !MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:38'! window ^ morph ifNil: [morph _ self buildWindow]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 21:00'! adoptMessageInCurrentChangeset "Add the receiver's method to the current change set if not already there" self selectedClassOrMetaClass ifNotNilDo: [ :cl | self selectedMessageName ifNotNilDo: [ :sel | ChangeSet current adoptSelector: sel forClass: cl. self changed: #annotations ]] ! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:57'! browseFullProtocol "Open up a protocol-category browser on the value of the receiver's current selection. If in mvc, an old-style protocol browser is opened instead. Someone who still uses mvc might wish to make the protocol-category-browser work there too, thanks." | aClass | (Smalltalk isMorphic and: [Smalltalk includesKey: #Lexicon]) ifFalse: [^ self spawnFullProtocol]. (aClass _ self selectedClassOrMetaClass) ifNotNil: [(Smalltalk at: #Lexicon) new openOnClass: aClass inWorld: ActiveWorld showingSelector: self selectedMessageName]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 21:26'! browseMessages "Present a menu of the currently selected message, as well as all messages sent by it. Open a message set browser of all implementors of the selector chosen." self systemNavigation browseAllImplementorsOf: (self selectedMessageName ifNil: [ ^nil ])! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:57'! browseMethodFull "Create and schedule a full Browser and then select the current class and message." | myClass | (myClass _ self selectedClassOrMetaClass) ifNotNil: [Browser fullOnClass: myClass selector: self selectedMessageName]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:54'! browseSendersOfMessages "Present a menu of the currently selected message, as well as all messages sent by it. Open a message set browser of all senders of the selector chosen." self systemNavigation browseAllCallsOn: (self selectedMessageName ifNil: [ ^nil ])! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 4/17/2004 09:30'! browseVersions "Create and schedule a message set browser on all versions of the currently selected message selector." | class selector compiledMethod | class _ self selectedClassOrMetaClass. selector _ self selectedMessageName. compiledMethod _ class compiledMethodAt: selector ifAbsent: [ ^self ]. VersionsBrowser browseVersionsOf: compiledMethod class: class theNonMetaClass meta: class isMeta category: self selectedMessageCategoryName selector: selector! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 7/30/2004 17:56'! classHierarchy "Create and schedule a class list browser on the receiver's hierarchy." self systemNavigation spawnHierarchyForClass: self selectedClassOrMetaClass selector: self selectedMessageName "OK if nil"! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 6/12/2004 14:01'! classListMenu: aMenu aMenu addList: #( - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse protocol (p)' browseFullProtocol) " - ('printOut' printOutClass) ('fileOut' fileOutClass) " - ('show hierarchy' methodHierarchy) " ('show definition' editClass) ('show comment' editComment) " " - ('inst var refs...' browseInstVarRefs) ('inst var defs...' browseInstVarDefs) - ('class var refs...' browseClassVarRefs) ('class vars' browseClassVariables) ('class refs (N)' browseClassRefs) - ('rename class ...' renameClass) ('copy class' copyClass) ('remove class (x)' removeClass) " - ('find method...' findMethodInChangeSets)). ^aMenu! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:55'! copySelector "Copy the selected selector to the clipboard" | selector | (selector _ self selectedMessageName) ifNotNil: [Clipboard clipboardText: selector asString]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:55'! fileOutMessage "Put a description of the selected message on a file" self selectedMessageName ifNotNil: [Cursor write showWhile: [self selectedClassOrMetaClass fileOutMethod: self selectedMessageName]]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:55'! findMethodInChangeSets "Find and open a changeSet containing the current method." | aName | (aName _ self selectedMessageName) ifNotNil: [ ChangeSorter browseChangeSetsWithClass: self selectedClassOrMetaClass selector: aName]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 7/30/2004 17:56'! methodHierarchy "Create and schedule a method browser on the hierarchy of implementors." self systemNavigation methodHierarchyBrowserForClass: self selectedClassOrMetaClass selector: self selectedMessageName! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 2/16/2004 17:00'! methodListKey: aKeystroke from: aListMorph aKeystroke caseOf: { [$b] -> [self browseMethodFull]. [$h] -> [self classHierarchy]. [$O] -> [self openSingleMessageBrowser]. [$p] -> [self browseFullProtocol]. [$o] -> [self fileOutMessage]. [$c] -> [self copySelector]. [$n] -> [self browseSendersOfMessages]. [$m] -> [self browseMessages]. [$i] -> [self methodHierarchy]. [$v] -> [self browseVersions]} otherwise: []! ! !MCCodeTool methodsFor: 'menus' stamp: 'avi 4/17/2004 11:42'! methodListMenu: aMenu "Build the menu for the selected method, if any." self selectedMessageName ifNotNil: [ aMenu addList:#( ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut (o)' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector)). aMenu addList: #( - ('browse senders (n)' browseSendersOfMessages) ('browse implementors (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) ('change sets with this method' findMethodInChangeSets) " ('x revert to previous version' revertToPreviousVersion)" ('remove from current change set' removeFromCurrentChanges) " ('x revert & remove from changes' revertAndForget)" ('add to current change set' adoptMessageInCurrentChangeset) " ('x copy up or copy down...' copyUpOrCopyDown)" " ('x remove method (x)' removeMessage)" "-" ). ]. " aMenu addList: #( ('x inst var refs...' browseInstVarRefs) ('x inst var defs...' browseInstVarDefs) ('x class var refs...' browseClassVarRefs) ('x class variables' browseClassVariables) ('x class refs (N)' browseClassRefs) ). " ^ aMenu ! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:55'! openSingleMessageBrowser | msgName mr | "Create and schedule a message list browser populated only by the currently selected message" (msgName _ self selectedMessageName) ifNil: [^ self]. mr _ MethodReference new setStandardClass: self selectedClassOrMetaClass methodSymbol: msgName. self systemNavigation browseMessageList: (Array with: mr) name: mr asStringOrText autoSelect: nil! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:55'! perform: selector orSendTo: otherTarget "Selector was just chosen from a menu by a user. If can respond, then perform it on myself. If not, send it to otherTarget, presumably the editPane from which the menu was invoked." (self respondsTo: selector) ifTrue: [^ self perform: selector] ifFalse: [^ super perform: selector orSendTo: otherTarget]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 20:58'! printOutMessage "Write a file with the text of the selected message, for printing by a web browser" self selectedMessageName ifNotNil: [ self selectedClassOrMetaClass fileOutMethod: self selectedMessageName asHtml: true]! ! !MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 21:00'! removeFromCurrentChanges "Tell the changes mgr to forget that the current msg was changed." ChangeSet current removeSelectorChanges: self selectedMessageName class: self selectedClassOrMetaClass. self changed: #annotations! ! !MCCodeTool methodsFor: 'subclassResponsibility' stamp: 'nk 11/10/2003 22:01'! annotations "Build an annotations string for the various browsers" ^''! ! !MCCodeTool methodsFor: 'subclassResponsibility' stamp: 'nk 11/10/2003 22:02'! selectedClass "Answer the class that is selected, or nil" self subclassResponsibility! ! !MCCodeTool methodsFor: 'subclassResponsibility' stamp: 'nk 11/10/2003 22:02'! selectedClassOrMetaClass "Answer the class that is selected, or nil" self subclassResponsibility! ! !MCCodeTool methodsFor: 'subclassResponsibility' stamp: 'nk 11/10/2003 22:02'! selectedMessageCategoryName "Answer the method category of the method that is selected, or nil" self subclassResponsibility! ! !MCCodeTool methodsFor: 'subclassResponsibility' stamp: 'nk 11/10/2003 22:02'! selectedMessageName "Answer the name of the selected message" self subclassResponsibility! ! !MCPatchBrowser methodsFor: 'as yet unclassified' stamp: 'nk 11/10/2003 21:41'! annotations ^selection ifNil: [ super annotations ] ifNotNil: [ selection annotations ]! ! !MCPatchBrowser methodsFor: 'as yet unclassified' stamp: 'nk 2/23/2005 08:04'! changeSetNameForInstall "Answer the name of the change set into which my selection will be installed. Derive this from my label. If I have no label, use the current change set." | tokens | label ifNil: [ ^ChangeSet current name ]. tokens := label findTokens: ' '. tokens removeAllFoundIn: { 'changes'. 'between'. 'and' }. (tokens size = 3 and: [ tokens second = ' 1) ifTrue: [protocols add: '-- all --']. ^ protocols ! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:52'! categoryListMenu: aMenu categorySelection ifNotNil: [aMenu add: (categorySelection = '*Extensions' ifTrue: ['load all extension methods' translated] ifFalse: ['load class category {1}' translated format: {categorySelection}]) action: #loadCategorySelection]. ^ aMenu! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 6/12/2004 14:01'! classListMenu: aMenu classSelection ifNil: [ ^aMenu ]. super classListMenu: aMenu. aMenu addLine; add: ('load class {1}' translated format: {classSelection}) action: #loadClassSelection. ^ aMenu! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'cwp 7/10/2003 18:03'! inspectSelection ^ self methodSelection inspect! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:53'! loadCategorySelection "Load the entire selected category" categorySelection ifNil: [ ^self ]. self methodsForSelectedClassCategory do: [ :m | m load ].! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/30/2004 15:06'! loadClassSelection classSelection ifNil: [ ^self ]. (self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) load. self methodsForSelectedClass do: [ :m | m load ].! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:45'! loadMethodSelection methodSelection ifNil: [ ^self ]. methodSelection load.! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:46'! loadProtocolSelection protocolSelection ifNil: [ ^self ]. self methodsForSelectedProtocol do: [ :m | m load ].! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:41'! methodListMenu: aMenu super methodListMenu: aMenu. self selectedMessageName ifNotNilDo: [:msgName | aMenu addLine; add: 'load method' translated action: #loadMethodSelection]. ^ aMenu! ! !MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:43'! protocolListMenu: aMenu protocolSelection ifNotNil: [aMenu add: ('load protocol ''{1}''' translated format: {protocolSelection}) action: #loadProtocolSelection ]. ^ aMenu! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 18:33'! categorySelection ^ categorySelection ifNil: [0] ifNotNil: [self visibleCategories indexOf: categorySelection]! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'nk 7/24/2003 13:42'! categorySelection: aNumber categorySelection _ aNumber = 0 ifFalse: [self visibleCategories at: aNumber]. self classSelection: 0. self changed: #categorySelection; changed: #annotations; changed: #classList. ! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 18:28'! classSelection ^ classSelection ifNil: [0] ifNotNil: [self visibleClasses indexOf: classSelection]! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'nk 7/24/2003 13:42'! classSelection: aNumber classSelection _ aNumber = 0 ifFalse: [self visibleClasses at: aNumber]. self protocolSelection: 0. self changed: #classSelection; changed: #protocolList; changed: #annotations; changed: #methodList. ! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 20:26'! methodSelection ^ methodSelection ifNil: [0] ifNotNil: [self visibleMethods indexOf: methodSelection]! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'nk 7/24/2003 13:42'! methodSelection: aNumber methodSelection _ aNumber = 0 ifFalse: [self visibleMethods at: aNumber]. self changed: #methodSelection; changed: #text; changed: #annotations! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 19:35'! protocolSelection ^ protocolSelection ifNil: [0] ifNotNil: [self visibleProtocols indexOf: protocolSelection]! ! !MCSnapshotBrowser methodsFor: 'selecting' stamp: 'nk 7/24/2003 13:43'! protocolSelection: anInteger protocolSelection _ (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]). self methodSelection: 0. self changed: #protocolSelection; changed: #methodList; changed: #annotations! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:57'! signalSwitchChanged self protocolSelection: 0. self changed: #switchIsInstance; changed: #switchIsComment; changed: #switchIsClass; changed: #protocolList; changed: #methodList; changed: #text.! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:11'! switchBeClass switch _ #class. self signalSwitchChanged.! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:12'! switchBeComment switch _ #comment. self signalSwitchChanged.! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:12'! switchBeInstance switch _ #instance. self signalSwitchChanged.! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:05'! switchIsClass ^ switch = #class! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:04'! switchIsComment ^ switch = #comment.! ! !MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:03'! switchIsInstance switch ifNil: [switch _ #instance]. ^ switch = #instance.! ! !MCSnapshotBrowser class methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 18:03'! forSnapshot: aSnapshot ^ self new snapshot: aSnapshot! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:03'! build ^ builder build: window! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:04'! buttonRow ^ self buttonRow: tool buttonSpecs! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'bf 5/27/2005 19:29'! buttonRow: specArray | panel button | panel _ builder pluggablePanelSpec new. panel children: OrderedCollection new. specArray do: [:spec | button := builder pluggableButtonSpec new. button model: tool. button label: spec first asString. button action: spec second. button help: spec third. button enabled: (spec at: 4 ifAbsent: [#buttonEnabled]). button state: (spec at: 5 ifAbsent: [#buttonSelected]). panel children add: button]. panel layout: #horizontal. panel frame: currentFrame. window children add: panel! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 11:47'! frame: aLayoutFrame currentFrame _ aLayoutFrame! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2005 17:57'! initializeWithBuilder: aBuilder tool: aTool builder _ aBuilder. tool _ aTool. window _ builder pluggableWindowSpec new. window children: OrderedCollection new. window label: tool label asString. window model: tool. window extent: tool defaultExtent.! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:04'! listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:04'! listMorph: listSymbol keystroke: keystrokeSymbol ^ (self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol) keystrokeActionSelector: keystrokeSymbol; yourself! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:15'! listMorph: listSymbol selection: selectionSymbol self listMorph: listSymbol selection: selectionSymbol menu: nil! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:16'! listMorph: listSymbol selection: selectionSymbol menu: menuSymbol self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2005 17:51'! listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol | list | list := builder pluggableListSpec new. list model: tool; list: listSymbol; getIndex: selectionSymbol; setIndex: (selectionSymbol, ':') asSymbol; frame: currentFrame. menuSymbol ifNotNil: [list menu: menuSymbol]. keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. window children add: list ! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2005 17:52'! multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol | list | list := builder pluggableMultiSelectionListSpec new. list model: tool; list: listSymbol; getIndex: selectionSymbol; setIndex: (selectionSymbol, ':') asSymbol; getSelectionList: listSelectionSymbol; setSelectionList: (listSelectionSymbol, 'put:') asSymbol; frame: currentFrame. menuSymbol ifNotNil: [list menu: menuSymbol]. window children add: list ! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2005 17:52'! textMorph: aSymbol | text | text := builder pluggableTextSpec new. text model: tool; getText: aSymbol; setText: (aSymbol, ':') asSymbol; frame: currentFrame. window children add: text! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:05'! treeMorph: listSymbol ^ self treeMorph: (listSymbol, 'Tree') asSymbol selection: (listSymbol, 'SelectionWrapper') asSymbol menu: (listSymbol, 'TreeMenu:') asSymbol! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2005 17:52'! treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol self notYetImplemented! ! !MCToolWindowBuilder methodsFor: 'as yet unclassified' stamp: 'avi 3/6/2005 22:31'! treeOrListMorph: listSymbol ^ self listMorph: listSymbol! ! !MCToolWindowBuilder class methodsFor: 'as yet unclassified' stamp: 'avi 2/11/2005 12:02'! builder: aBuilder tool: aTool ^ self basicNew initializeWithBuilder: aBuilder tool: aTool! ! !MCVariableDefinition methodsFor: 'comparing' stamp: 'cwp 7/7/2003 23:02'! hash ^ name hash! ! !MCVariableDefinition methodsFor: 'comparing' stamp: 'cwp 7/7/2003 23:02'! = other ^ (self species = other species) and: [self name = other name]! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:31'! isClassInstanceVariable ^ false! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:08'! isClassInstanceVariableDefinition ^ false! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:30'! isClassVariable ^ false! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:31'! isInstanceVariable ^ false! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:10'! isInstanceVariableDefinition ^ false! ! !MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:51'! isPoolImport ^ false! ! !MCVariableDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 05:57'! name ^ name! ! !MCVariableDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 06:00'! name: aString name _ aString! ! !MCVariableDefinition methodsFor: 'as yet unclassified' stamp: 'nk 7/24/2003 14:56'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $)! ! !MCClassInstanceVariableDefinition methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 23:31'! isClassInstanceVariable ^ true! ! !MCClassVariableDefinition methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 23:32'! isClassVariable ^ true! ! !MCInstanceVariableDefinition methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 23:32'! isInstanceVariable ^ true! ! !MCPoolImportDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:51'! isPoolImport ^ true! ! !MCVariableDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 23:18'! name: aString ^ self new name: aString ! ! !MCClassInstanceVariableDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 22:59'! type ^ #classInstance! ! !MCClassVariableDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 22:58'! type ^ #class! ! !MCInstanceVariableDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 22:59'! type ^ #instance! ! !MCPoolImportDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2003 22:59'! type ^ #pool! ! !MCVersion methodsFor: 'actions' stamp: 'avi 10/9/2003 13:00'! addToCache MCCacheRepository default storeVersion: self! ! !MCVersion methodsFor: 'actions' stamp: 'avi 2/12/2004 19:37'! adopt self workingCopy adopt: self! ! !MCVersion methodsFor: 'actions' stamp: 'bf 3/22/2005 22:12'! browse (MCSnapshotBrowser forSnapshot: self snapshot) showLabelled: 'Snapshot of ', self fileName! ! !MCVersion methodsFor: 'actions' stamp: 'avi 1/22/2004 12:44'! fileOutOn: aStream self writerClass fileOut: self on: aStream! ! !MCVersion methodsFor: 'actions' stamp: 'avi 1/24/2004 20:13'! load MCVersionLoader loadVersion: self! ! !MCVersion methodsFor: 'actions' stamp: 'abc 2/13/2004 15:58'! merge MCVersionMerger mergeVersion: self! ! !MCVersion methodsFor: 'actions' stamp: 'ab 7/12/2003 00:19'! open (MCVersionInspector new version: self) show! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 14:54'! allAvailableDependenciesDo: aBlock | version | self dependencies do: [:ea | [version _ ea resolve. version allAvailableDependenciesDo: aBlock. aBlock value: version] on: Error do: []]! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 11:58'! allDependenciesDo: aBlock self allDependenciesDo: aBlock ifUnresolved: [:ignored | true]! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 11:53'! allDependenciesDo: aBlock ifUnresolved: failBlock | dict | dict _ Dictionary new. self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 14:24'! allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock | version | self dependencies do: [:ea | version := aDictionary at: ea ifAbsent: [ea resolve]. version ifNil: [failBlock value: ea] ifNotNil: [(aDictionary includes: version) ifFalse: [aDictionary at: ea put: version. version allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock. aBlock value: version]]]! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 14:24'! withAllDependenciesDo: aBlock self allDependenciesDo: aBlock ifUnresolved: [:ignored]. aBlock value: self! ! !MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 14:49'! withAllDependenciesDo: aBlock ifUnresolved: failBlock | dict | dict _ Dictionary new. self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock. aBlock value: self! ! !MCVersion methodsFor: 'converting' stamp: 'avi 2/19/2004 21:00'! asDiffAgainst: aVersion aVersion info = self info ifTrue: [self error: 'Cannot diff against self!!']. ^ MCDiffyVersion package: self package info: self info snapshot: self snapshot dependencies: self dependencies baseVersion: aVersion! ! !MCVersion methodsFor: 'testing' stamp: 'bf 5/23/2005 15:43'! canOptimizeLoading "Answer wether I can provide a patch for the working copy without the usual diff pass" ^false! ! !MCVersion methodsFor: 'testing' stamp: 'bf 3/22/2005 23:00'! isCacheable ^true! ! !MCVersion methodsFor: 'testing' stamp: 'avi 2/13/2004 23:24'! isDiffy ^ false! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 2/13/2004 22:42'! changes ^ self snapshot patchRelativeToBase: package snapshot! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 00:24'! dependencies ^ dependencies ifNil: [#()]! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 12:44'! fileName ^ info name, '.', self writerClass extension! ! !MCVersion methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:28'! info ^ info! ! !MCVersion methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:19'! package ^ package! ! !MCVersion methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:10'! snapshot ^ snapshot! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 1/20/2004 16:07'! summary ^ String streamContents: [:s | s nextPutAll: info summaryHeader. (dependencies isNil or: [dependencies isEmpty]) ifFalse: [s cr; nextPutAll: 'Dependencies: '. dependencies do: [:ea | s nextPutAll: ea versionInfo name] separatedBy: [s nextPutAll: ', ']]. s cr; cr; nextPutAll: info message]! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 2/12/2004 19:38'! workingCopy ^ package workingCopy! ! !MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 12:44'! writerClass ^ MCMczWriter ! ! !MCVersion methodsFor: 'initialize-release' stamp: 'avi 1/19/2004 13:11'! initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection package _ aPackage. info _ aVersionInfo. snapshot _ aSnapshot. dependencies _ aCollection. self addToCache.! ! !MCVersion methodsFor: 'initialize-release' stamp: 'cwp 11/7/2004 13:08'! setPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection package _ aPackage. info _ aVersionInfo. snapshot _ aSnapshot. dependencies _ aCollection! ! !MCVersion methodsFor: 'printing' stamp: 'nk 3/8/2004 23:54'! printOn: aStream super printOn: aStream. aStream nextPut: $(. aStream nextPutAll: self info name. aStream nextPut: $).! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:17'! baseInfo ^ base! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:39'! baseSnapshot ^ (self workingCopy repositoryGroup versionWithInfo: base) snapshot! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'bf 5/23/2005 15:42'! canOptimizeLoading "Answer wether I can provide a patch for the working copy without the usual diff pass" ^ package hasWorkingCopy and: [package workingCopy modified not and: [package workingCopy ancestors includes: self baseInfo]]! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'bf 5/30/2005 17:39'! fileName ^ (self class nameForVer: info name base: base name), '.', self writerClass extension! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/19/2004 20:55'! initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: aPatch patch _ aPatch. base _ baseVersionInfo. super initializeWithPackage: aPackage info: aVersionInfo snapshot: nil dependencies: aCollection. ! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:24'! isDiffy ^ true! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:17'! patch ^ patch! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 22:47'! snapshot ^ snapshot ifNil: [snapshot _ MCPatcher apply: patch to: self baseSnapshot]! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/19/2004 22:03'! summary ^ '(Diff against ', self baseInfo name, ')', String cr, super summary! ! !MCDiffyVersion methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:17'! writerClass ^ MCMcdWriter ! ! !MCVersion class methodsFor: 'instance creation' stamp: 'ab 7/7/2003 16:13'! package: aPackage ^ self package: aPackage info: MCVersionInfo new! ! !MCVersion class methodsFor: 'instance creation' stamp: 'ab 7/7/2003 16:13'! package: aPackage info: aVersionInfo ^ self package: aPackage info: aVersionInfo snapshot: aPackage snapshot! ! !MCVersion class methodsFor: 'instance creation' stamp: 'cwp 11/7/2004 13:02'! package: aPackage info: aVersionInfo snapshot: aSnapshot ^ self package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: #()! ! !MCVersion class methodsFor: 'instance creation' stamp: 'avi 1/19/2004 13:11'! package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection ^ self new initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection! ! !MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:45'! baseNameFrom: diffName | baseId verName | baseId := (diffName copyAfter: $() copyUpTo: $). baseId ifEmpty: [^baseId]. (baseId beginsWith: '@') ifTrue: [^baseId copyAfter: $@]. verName := self verNameFrom: diffName. ^(baseId includes: $.) ifTrue: [(verName copyUpToLast: $-), '-', baseId] ifFalse: [(verName copyUpToLast: $.), '.', baseId] ! ! !MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:58'! canonicalNameFor: aFileName ^(self nameForVer: (self verNameFrom: aFileName) base: (self baseNameFrom: aFileName)) , '.', MCMcdReader extension ! ! !MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 17:39'! nameForVer: versionName base: baseName | baseId | baseId := (versionName copyUpToLast: $.) = (baseName copyUpToLast: $.) ifTrue: [baseName copyAfterLast: $.] ifFalse: [(versionName copyUpToLast: $-) = (baseName copyUpToLast: $-) ifTrue: [baseName copyAfterLast: $-] ifFalse: ['@', baseName]]. ^ versionName, '(', baseId, ')'! ! !MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:19'! verNameFrom: diffName ^diffName copyUpTo: $(! ! !MCDiffyVersion class methodsFor: 'instance creation' stamp: 'avi 2/13/2004 23:07'! package: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: aPatch ^ self basicNew initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: aPatch! ! !MCDiffyVersion class methodsFor: 'instance creation' stamp: 'avi 2/13/2004 23:06'! package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection baseVersion: aVersion ^ self package: aPackage info: aVersionInfo dependencies: aCollection baseInfo: aVersion info patch: (aSnapshot patchRelativeToBase: aVersion snapshot)! ! !MCVersionDependency methodsFor: 'comparing' stamp: 'avi 1/19/2004 16:06'! hash ^ versionInfo hash! ! !MCVersionDependency methodsFor: 'comparing' stamp: 'avi 1/19/2004 16:12'! = other ^ other species = self species and: [other versionInfo = versionInfo and: [other package = package]]! ! !MCVersionDependency methodsFor: 'initialize-release' stamp: 'avi 1/19/2004 13:12'! initializeWithPackage: aPackage info: aVersionInfo package _ aPackage. versionInfo _ aVersionInfo! ! !MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'! isCurrent ^ package hasWorkingCopy and: [self isFulfilled and: [package workingCopy modified not]]! ! !MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'! isFulfilled ^package hasWorkingCopy and: [self isFulfilledBy: package workingCopy ancestry]! ! !MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'! isFulfilledByAncestors ^ package hasWorkingCopy and: [self isFulfilledByAncestorsOf: package workingCopy ancestry]! ! !MCVersionDependency methodsFor: 'testing' stamp: 'nk 7/13/2004 08:45'! isFulfilledByAncestorsOf: anAncestry ^ anAncestry hasAncestor: versionInfo! ! !MCVersionDependency methodsFor: 'testing' stamp: 'avi 3/4/2004 00:34'! isFulfilledBy: anAncestry ^ anAncestry ancestors includes: versionInfo! ! !MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'! isOlder "Answer true if I represent an older version of a package that is loaded." ^ package hasWorkingCopy and: [self isFulfilled not and: [ self isFulfilledByAncestors and: [package workingCopy modified not]]]! ! !MCVersionDependency methodsFor: 'accessing' stamp: 'avi 1/19/2004 15:40'! package ^ package! ! !MCVersionDependency methodsFor: 'accessing' stamp: 'avi 2/12/2004 19:38'! repositoryGroup ^ self package workingCopy repositoryGroup! ! !MCVersionDependency methodsFor: 'accessing' stamp: 'avi 1/19/2004 15:40'! versionInfo ^ versionInfo! ! !MCVersionDependency methodsFor: 'resolving' stamp: 'nk 6/13/2004 19:21'! resolve ^ self repositoryGroup versionWithInfo: versionInfo ifNone: [ MCRepositoryGroup default versionWithInfo: versionInfo ifNone: []]! ! !MCVersionDependency class methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 13:13'! package: aPackage info: aVersionInfo ^ self basicNew initializeWithPackage: aPackage info: aVersionInfo! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:11'! ancestry: anAncestry ancestry _ anAncestry! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:10'! baseSnapshot ^ self snapshotForInfo: ancestry! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:41'! index "Answer the value of index" ^ index! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'nk 7/28/2003 18:17'! index: anObject "Set the value of index" index _ anObject! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:08'! list ^ ancestry withAllAncestors collect: [:ea | ea name]! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'nk 7/28/2003 18:27'! package: aMCPackage package _ aMCPackage! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/7/2003 21:27'! repositoryGroup ^ MCRepositoryGroup default! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:08'! selectedInfo ^ ancestry withAllAncestors at: self selection ifAbsent: [nil]! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:39'! selectedSnapshot ^ self snapshotForInfo: self selectedInfo! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:24'! selection ^ index ifNil: [0]! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:31'! selection: aNumber index _ aNumber. self changed: #selection; changed: #summary! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:38'! snapshotForInfo: aVersionInfo ^ (self repositoryGroup versionWithInfo: aVersionInfo) snapshot! ! !MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:34'! summary | selInfo | selInfo _ self selectedInfo. ^ selInfo ifNil: [''] ifNotNil: [selInfo summary]! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:41'! defaultExtent ^ 440@169. ! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:09'! defaultLabel ^ ancestry name, ' History'! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:09'! getMenu: aMenu index < 2 ifTrue: [^ aMenu]. self fillMenu: aMenu fromSpecs: (Array with: (Array with: 'view changes -> ', ancestry name with: #viewChanges) with: #('spawn history' spawnHistory)). ^ aMenu! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:10'! spawnHistory MCVersionHistoryBrowser new ancestry: self selectedInfo; package: package; show! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'nk 2/23/2005 07:56'! viewChanges "Note that the patchLabel will be parsed in MCPatchBrowser>>installSelection, so don't translate it!!" | patch patchLabel | patchLabel _ 'changes between {1} and {2}' format: { self selectedInfo name. ancestry name }. patch _ self baseSnapshot patchRelativeToBase: self selectedSnapshot. (MCPatchBrowser forPatch: patch) label: patchLabel; show! ! !MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'nk 7/28/2003 18:05'! widgetSpecs ^ #( ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) )! ! !MCVersionInfo methodsFor: 'comparing' stamp: 'ab 7/5/2003 14:09'! hash ^ id hash! ! !MCVersionInfo methodsFor: 'comparing' stamp: 'ab 7/5/2003 14:23'! = other ^ other species = self species and: [other hasID: id]! ! !MCVersionInfo methodsFor: 'converting' stamp: 'nk 1/23/2004 21:09'! asDictionary ^ Dictionary new at: #name put: name; at: #id put: id; at: #message put: message; at: #date put: date; at: #time put: time; at: #author put: author; at: #ancestors put: (self ancestors collect: [:a | a asDictionary]); yourself! ! !MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'! author ^ author! ! !MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'! date ^ date! ! !MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:24'! id ^ id ! ! !MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'! time ^ time! ! !MCVersionInfo methodsFor: 'private' stamp: 'ab 7/5/2003 14:10'! hasID: aUUID ^ id = aUUID! ! !MCVersionInfo methodsFor: 'initialize-release' stamp: 'avi 9/11/2004 10:44'! initializeWithName: vName id: aUUID message: aString date: aDate time: aTime author: initials ancestors: aCollection stepChildren: stepCollection name _ vName. id _ aUUID. message _ aString. date _ aDate. time _ aTime. author _ initials. ancestors _ aCollection. stepChildren _ stepCollection! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'ab 7/12/2003 00:04'! message ^ message ifNil: ['']! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:33'! name ^ name ifNil: ['']! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'avi 1/20/2004 16:08'! summary ^ String streamContents: [:s | s nextPutAll: self summaryHeader; cr; cr; nextPutAll: self message. ]! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'avi 9/14/2004 15:22'! summaryHeader ^ String streamContents: [:s | s nextPutAll: 'Name: '; nextPutAll: self name; cr. date ifNotNil: [s nextPutAll: 'Author: '; nextPutAll: author; cr; nextPutAll: 'Time: '; nextPutAll: date asString, ', ', time asString; cr]. id ifNotNil: [s nextPutAll: 'UUID: '; nextPutAll: id asString; cr]. s nextPutAll: 'Ancestors: '; nextPutAll: self ancestorString. self stepChildren isEmpty ifFalse: [s cr; nextPutAll: 'Backported From: '; nextPutAll: self stepChildrenString]. ]! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'avi 1/22/2004 16:45'! timeStamp ^ TimeStamp date: date time: time! ! !MCVersionInfo methodsFor: 'accessing' stamp: 'avi 9/17/2003 11:24'! timeString ^ date asString, ', ', time asString! ! !MCVersionInfo methodsFor: 'printing' stamp: 'ab 7/5/2003 18:00'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $) ! ! !MCVersionInfo class methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:44'! name: vName id: id message: message date: date time: time author: author ancestors: ancestors ^ self name: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: #()! ! !MCVersionInfo class methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:43'! name: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: stepChildren ^ self new initializeWithName: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: stepChildren! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:19'! adopt (self confirm: 'Modifying ancestry can be dangerous unless you know what you are doing. Are you sure you want to adopt ',self version info name, ' as an ancestor of your working copy?') ifTrue: [self version adopt]! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'bf 3/22/2005 22:12'! browse self version browse! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'nk 4/17/2004 10:05'! changes (MCPatchBrowser forPatch: self version changes) showLabelled: 'Changes from ', self version info name! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:19'! diff | ancestorVersion | self pickAncestor ifNotNilDo: [:ancestor | ancestorVersion _ self version workingCopy repositoryGroup versionWithInfo: ancestor. (version asDiffAgainst: ancestorVersion) open]! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'lr 9/26/2003 20:15'! hasVersion ^version notNil! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:18'! history (MCVersionHistoryBrowser new ancestry: self version info) show! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'bf 3/14/2005 15:32'! load Cursor wait showWhile: [self version load]! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:19'! merge self version merge! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:18'! save self pickRepository ifNotNilDo: [:ea | ea storeVersion: self version]! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:19'! summary ^self hasVersion ifTrue: [ self version summary ] ifFalse: [ String new ]! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:19'! version ^ version! ! !MCVersionInspector methodsFor: 'as yet unclassified' stamp: 'ab 7/12/2003 00:13'! version: aVersion version _ aVersion! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'Rik 12/17/2004 06:07'! buttonSpecs ^ #((Browse browse 'Browse this version' hasVersion) (History history 'Browse the history of this version' hasVersion) (Changes changes 'Browse the changes this version would make to the image' hasVersion) (Load load 'Load this version into the image' hasVersion) (Merge merge 'Merge this version into the image' hasVersion) (Adopt adopt 'Adopt this version as an ancestor of your working copy' hasVersion) (Copy save 'Copy this version to another repository' hasVersion) (Diff diff 'Create an equivalent version based on an earlier release' hasVersion))! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 8/31/2003 00:45'! defaultExtent ^ 400@200! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:18'! defaultLabel ^ 'Version: ', self version info name! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:18'! pickAncestor | index versions | versions _ self version info allAncestors. index _ (PopUpMenu labelArray: (versions collect: [:ea | ea name])) startUpWithCaption: 'Ancestor:'. ^ index = 0 ifFalse: [versions at: index]! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 8/31/2003 00:43'! pickRepository | index | index _ (PopUpMenu labelArray: (self repositories collect: [:ea | ea description])) startUpWithCaption: 'Repository:'. ^ index = 0 ifFalse: [self repositories at: index]! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 8/31/2003 00:44'! repositories ^ MCRepositoryGroup default repositories! ! !MCVersionInspector methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 18:43'! widgetSpecs ^ #( ((buttonRow) (0 0 1 0) (0 0 0 30)) ((textMorph: summary) (0 0 1 1) (0 30 0 0)) )! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 11/10/2003 22:35'! buttonSpecs ^#(('Refresh' refresh 'refresh the version-list')) , super buttonSpecs! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 11/10/2003 22:37'! defaultExtent ^450@300! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:06'! defaultLabel ^'Repository: ' , repository description! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:26'! orderSpecs ^{ 'unchanged' -> nil. 'order by package' -> [ :x :y | x first <= y first ]. 'order by author' -> [ :x :y | x second <= y second ]. 'order by version-string' -> [ :x :y | x third <= y third ]. 'order by version-number' -> [ :x :y | x third asNumber >= y third asNumber ]. 'order by filename' -> [ :x :y | x fourth <= y fourth ]. }! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:07'! orderString: anIndex ^String streamContents: [ :stream | order = anIndex ifTrue: [ stream nextPutAll: '' ] ifFalse: [ stream nextPutAll: '' ]. stream nextPutAll: (self orderSpecs at: anIndex) key ]! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:21'! order: anInteger self class order: (order _ anInteger). self changed: #versionList.! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 2/24/2005 18:29'! packageHighlight: aString newer ifNil: [newer := #()]. ^(loaded anySatisfy: [:each | (each copyUpToLast: $-) = aString]) ifTrue: [ Text string: aString attribute: (TextEmphasis new emphasisCode: ( ((newer includes: aString) ifTrue: [5] ifFalse: [4])))] ifFalse: [aString]! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 2/24/2005 18:29'! packageList | result | result _ versions inject: Set new into: [ :set :each | set add: each first; yourself ]. "sort loaded packages first, then alphabetically" result _ result asSortedCollection: [:a :b | | loadedA loadedB | loadedA _ loaded anySatisfy: [:each | (each copyUpToLast: $-) = a]. loadedB _ loaded anySatisfy: [:each | (each copyUpToLast: $-) = b]. loadedA = loadedB ifTrue: [a < b] ifFalse: [loadedA]]. ^result collect: [:each | self packageHighlight: each]! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 17:25'! packageListMenu: aMenu ^aMenu! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:17'! packageSelection ^self packageList indexOf: selectedPackage! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 2/28/2005 17:29'! packageSelection: aNumber selectedPackage _ aNumber isZero ifFalse: [ (self packageList at: aNumber) asString ]. self versionSelection: 0. self changed: #packageSelection; changed: #versionList! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 5/30/2005 19:10'! versionHighlight: aString | verName | inherited ifNil: [inherited := #()]. 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" ] ])))! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 2/24/2005 18:29'! versionList | result sortBlock | result _ selectedPackage isNil ifTrue: [ versions ] ifFalse: [ versions select: [ :each | selectedPackage = each first ] ]. sortBlock _ (self orderSpecs at: order) value. sortBlock isNil ifFalse: [ result _ result asSortedCollection: [:a :b | [sortBlock value: a value: b] on: Error do: [true]]]. ^result _ result collect: [ :each | self versionHighlight: each fourth ]! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:07'! versionListMenu: aMenu 1 to: self orderSpecs size do: [ :index | aMenu addUpdating: #orderString: target: self selector: #order: argumentList: { index } ]. ^aMenu! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:18'! versionSelection ^self versionList indexOf: selectedVersion! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'bf 6/23/2005 17:45'! versionSelection: aNumber aNumber isZero ifTrue: [ selectedVersion _ version _ nil ] ifFalse: [ selectedVersion _ (self versionList at: aNumber) asString. Cursor wait showWhile: [version _ repository versionFromFileNamed: selectedVersion]]. self changed: #versionSelection; changed: #summary; changed: #hasVersion! ! !MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:26'! widgetSpecs ^#( ((buttonRow) (0 0 1 0) (0 0 0 30)) ((listMorph: package) (0 0 0.5 0.6) (0 30 0 0)) ((listMorph: version) (0.5 0 1 0.6) (0 30 0 0)) ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! ! !MCFileRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'bf 3/24/2005 02:11'! load self hasVersion ifTrue: [version isCacheable ifTrue: [version workingCopy repositoryGroup addRepository: repository]. super load. self refresh].! ! !MCFileRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'bf 11/16/2004 11:56'! merge super merge. self refresh. ! ! !MCFileRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'bf 5/30/2005 16:28'! refresh | packageNames name latest av | packageNames _ Set new. versions _ repository readableFileNames collect: [ :each | name _ (each copyUpToLast: $.) copyUpTo: $(. name last isDigit ifFalse: [Array with: name with: '' with: '' with: each] ifTrue: [Array with: (packageNames add: (name copyUpToLast: $-)) "pkg name" with: ((name copyAfterLast: $-) upTo: $.) "user" with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version" with: each]]. 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 = each package name]) detectMax: [:v | v third]. (latest notNil and: [ each ancestors allSatisfy: [:ancestor | av _ ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger. av < latest third or: [ av = latest third and: [((ancestor name copyAfterLast: $-) upTo: $.) ~= latest second]]]]) ifTrue: [newer add: each package name ]]. self changed: #packageList; changed: #versionList! ! !MCFileRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'bf 6/24/2005 15:56'! setRepository: aFileBasedRepository workingCopy: aWorkingCopy order _ self class order. repository _ aFileBasedRepository. self refresh. aWorkingCopy ifNil: [selectedPackage _ self packageList isEmpty ifFalse: [self packageList first]] ifNotNil: [ selectedPackage _ aWorkingCopy ancestry ancestorString copyUpToLast: $- ]. MCWorkingCopy addDependent: self. ! ! !MCFileRepositoryInspector class methodsFor: 'class initialization' stamp: 'bf 3/16/2005 14:41'! initialize "self initialize" self migrateInstances! ! !MCFileRepositoryInspector class methodsFor: 'class initialization' stamp: 'bf 3/16/2005 14:53'! migrateInstances self allSubInstancesDo: [:inst | #(packageList versionList) do: [:each | [(inst findListMorph: each) highlightSelector: nil] on: Error do: [:ignore | ]]].! ! !MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'avi 10/2/2003 00:55'! order Order isNil ifTrue: [ Order _ 5 ]. ^Order! ! !MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'lr 9/26/2003 21:21'! order: anInteger Order _ anInteger! ! !MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'lr 9/26/2003 20:09'! repository: aFileBasedRepository workingCopy: aWorkingCopy ^self new setRepository: aFileBasedRepository workingCopy: aWorkingCopy; yourself! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'! buttonSpecs ^#(('Refresh' refresh 'refresh the version-list')) , super buttonSpecs! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'! defaultExtent ^450@300! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'! defaultLabel ^'Repository: ' , repository description! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:09'! packageList ^ packages collect: [:ea | ea name]! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'! packageListMenu: aMenu ^aMenu! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:07'! packageSelection ^ packages indexOf: selectedPackage! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:08'! packageSelection: aNumber selectedPackage _ aNumber isZero ifFalse: [ packages at: aNumber ]. versions _ repository versionsAvailableForPackage: selectedPackage. self changed: #packageSelection; changed: #versionList! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/29/2004 11:33'! sortedVersions | sorter | sorter _ MCVersionSorter new. sorter addAllVersionInfos: versions. ^ sorter sortedVersionInfos select: [:ea | versions includes: ea]! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/29/2004 11:32'! versionList ^ self sortedVersions collect: [:ea | ea name]! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:57'! versionListMenu: aMenu ^aMenu! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:07'! versionSelection ^ versions indexOf: selectedVersion! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:08'! versionSelection: aNumber aNumber isZero ifTrue: [ selectedVersion _ nil ] ifFalse: [ selectedVersion _ versions at: aNumber]. self changed: #versionSelection; changed: #summary! ! !MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'! widgetSpecs ^#( ((buttonRow) (0 0 1 0) (0 0 0 30)) ((listMorph: package) (0 0 0.5 0.6) (0 30 0 0)) ((listMorph: version) (0.5 0 1 0.6) (0 30 0 0)) ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:20'! hasVersion ^ selectedVersion notNil! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 18:51'! load self hasVersion ifTrue: [super load. version workingCopy repositoryGroup addRepository: repository].! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:11'! refresh packages _ repository packages. self changed: #packageList. self packageSelection: self packageSelection. ! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:06'! setRepository: aRepository workingCopy: aWorkingCopy repository _ aRepository. aWorkingCopy isNil ifFalse: [ selectedPackage _ aWorkingCopy package]. self refresh! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:20'! summary ^ selectedVersion ifNotNil: [selectedVersion summary] ifNil: ['']! ! !MCRepositoryInspector methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 20:20'! version ^ version ifNil: [version _ repository versionWithInfo: selectedVersion]! ! !MCRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'avi 2/28/2004 18:51'! repository: aFileBasedRepository workingCopy: aWorkingCopy ^self new setRepository: aFileBasedRepository workingCopy: aWorkingCopy; yourself! ! !MCVersionLoader methodsFor: 'loading' stamp: 'cwp 11/7/2004 17:06'! addDependency: aDependency | dep | aDependency isCurrent ifTrue: [^ self]. (self depAgeIsOk: aDependency) ifFalse: [^ self]. dep := aDependency resolve. dep ifNil: [self confirmMissingDependency: aDependency] ifNotNil: [(versions includes: dep) ifFalse: [self addVersion: dep]]! ! !MCVersionLoader methodsFor: 'loading' stamp: 'cwp 11/7/2004 17:04'! addVersion: aVersion aVersion dependencies do: [ :ea | self addDependency: ea]. versions add: aVersion. ! ! !MCVersionLoader methodsFor: 'loading' stamp: 'bf 5/23/2005 12:08'! load | loader | self checkForModifications. loader _ MCPackageLoader new. versions do: [:ea | ea canOptimizeLoading ifTrue: [ea patch applyTo: loader] ifFalse: [loader updatePackage: ea package withSnapshot: ea snapshot]]. loader loadWithNameLike: versions first info name. versions do: [:ea | ea workingCopy loaded: ea]! ! !MCVersionLoader methodsFor: 'checking' stamp: 'avi 1/24/2004 20:15'! checkForModifications | modifications | modifications _ versions select: [:ea | ea package workingCopy modified]. modifications isEmpty ifFalse: [self warnAboutLosingChangesTo: modifications].! ! !MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:00'! checkIfDepIsOlder: aDependency ^ aDependency isOlder not or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! ! !MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:06'! confirmMissingDependency: aDependency | name | name := aDependency versionInfo name. (self confirm: 'Can''t find dependency ', name, '. ignore?') ifFalse: [self error: 'Can''t find dependency ', name]! ! !MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:02'! depAgeIsOk: aDependency ^ aDependency isOlder not or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! ! !MCVersionLoader methodsFor: 'checking' stamp: 'avi 1/24/2004 20:17'! warnAboutLosingChangesTo: versionCollection self notify: (String streamContents: [:s | s nextPutAll: 'You are about to load new versions of the following packages that have unsaved changes in the image. If you continue, you will lose these changes.'; cr. versionCollection do: [:ea | s cr; space; space; nextPutAll: ea package name]])! ! !MCVersionLoader methodsFor: 'initialize-release' stamp: 'avi 1/24/2004 19:51'! initialize versions _ OrderedCollection new! ! !MCVersionLoader class methodsFor: 'as yet unclassified' stamp: 'avi 1/24/2004 20:06'! loadVersion: aVersion self new addVersion: aVersion; load! ! !MCVersionLoader class methodsFor: 'as yet unclassified' stamp: 'avi 1/24/2004 19:51'! new ^ self basicNew initialize! ! !MCVersionMerger methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:50'! addVersion: aVersion | dep | records add: (MCMergeRecord version: aVersion). aVersion dependencies do: [:ea | dep _ ea resolve. (records anySatisfy: [:r | r version = dep]) ifFalse: [self addVersion: dep]]! ! !MCVersionMerger methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 15:50'! initialize records _ OrderedCollection new. merger _ MCThreeWayMerger new.! ! !MCVersionMerger methodsFor: 'as yet unclassified' stamp: 'abc 2/13/2004 17:15'! merge records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger load. records do: [:ea | ea updateWorkingCopy]].! ! !MCVersionMerger methodsFor: 'as yet unclassified' stamp: 'bf 12/5/2004 12:32'! mergeWithNameLike: baseName records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger loadWithNameLike: baseName. records do: [:ea | ea updateWorkingCopy]].! ! !MCVersionMerger methodsFor: 'as yet unclassified' stamp: 'bf 4/26/2005 14:29'! resolveConflicts (records allSatisfy: [:ea | ea isAncestorMerge]) ifTrue: [MCNoChangesException signal. ^ false]. ^ ((MCMergeResolutionRequest new merger: merger) signal: 'Merging ', records first version info name) = true! ! !MCVersionMerger class methodsFor: 'as yet unclassified' stamp: 'bf 12/5/2004 12:35'! mergeVersion: aVersion self new addVersion: aVersion; mergeWithNameLike: aVersion info name! ! !MCVersionMerger class methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:41'! new ^ self basicNew initialize! ! !MCVersionNameAndMessageRequest methodsFor: 'as yet unclassified' stamp: 'ab 8/24/2003 20:39'! defaultAction ^ MCSaveVersionDialog new versionName: suggestion; showModally! ! !MCVersionNameAndMessageRequest methodsFor: 'as yet unclassified' stamp: 'ab 7/10/2003 01:07'! suggestedName ^ suggestion! ! !MCVersionNameAndMessageRequest methodsFor: 'as yet unclassified' stamp: 'ab 7/10/2003 01:07'! suggestedName: aString suggestion _ aString! ! !MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:13'! fromAddress ^ 'monticello@beta4.com'! ! !MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:10'! initializeWithVersion: aVersion repository: aRepository version _ aVersion. repository _ aRepository. ancestor _ repository closestAncestorVersionFor: version info ifNone: []. changes _ ancestor ifNil: [#()] ifNotNil: [(version snapshot patchRelativeToBase: ancestor snapshot) operations asSortedCollection]! ! !MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:12'! messageText ^ String streamContents: [:s | s nextPutAll: 'Committed to repository: ', repository description; cr; cr. s nextPutAll: version summary. changes isEmpty ifFalse: [s cr; cr. s nextPutAll: '-----------------------------------------------------'; cr. s nextPutAll: 'Changes since ', ancestor info name, ':'; cr. changes do: [:ea | s cr; nextPutAll: ea summary; cr. s nextPutAll: ea sourceString]]]! ! !MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:15'! messageTo: aString | message | message _ MailMessage empty. message setField: 'from' toString: self fromAddress. message setField: 'to' toString: aString. message setField: 'subject' toString: '[MC] ', version info name. message body: (MIMEDocument contentType: 'text/plain' content: self messageText). ^ message! ! !MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:16'! notify: aString | message | message _ self messageTo: aString. SMTPClient deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: MailSender smtpServer! ! !MCVersionNotification class methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:27'! version: aVersion repository: aRepository ^ self basicNew initializeWithVersion: aVersion repository: aRepository! ! !MCVersionReader methodsFor: 'accessing' stamp: 'avi 1/19/2004 16:52'! basicVersion ^ MCVersion package: self package info: self info snapshot: self snapshot dependencies: self dependencies! ! !MCVersionReader methodsFor: 'accessing' stamp: 'avi 1/21/2004 23:10'! definitions definitions ifNil: [self loadDefinitions]. ^ definitions! ! !MCVersionReader methodsFor: 'accessing' stamp: 'avi 1/19/2004 14:50'! dependencies dependencies ifNil: [self loadDependencies]. ^ dependencies! ! !MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:53'! info info ifNil: [self loadVersionInfo]. ^ info! ! !MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:53'! package package ifNil: [self loadPackage]. ^ package! ! !MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:54'! snapshot ^ MCSnapshot fromDefinitions: self definitions! ! !MCVersionReader methodsFor: 'accessing' stamp: 'avi 10/9/2003 12:38'! version ^ self basicVersion! ! !MCVersionReader methodsFor: 'lifecycle' stamp: 'cwp 8/3/2003 18:48'! initialize! ! !MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'! loadDefinitions self subclassResponsibility ! ! !MCVersionReader methodsFor: 'loading' stamp: 'avi 1/19/2004 14:50'! loadDependencies self subclassResponsibility ! ! !MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'! loadPackage self subclassResponsibility ! ! !MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'! loadVersionInfo self subclassResponsibility! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'cwp 8/13/2003 01:55'! associate: tokens | result | result _ Dictionary new. tokens pairsDo: [:key :value | value isString ifFalse: [value _ value collect: [:ea | self associate: ea]]. result at: key put: value]. ^ result! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/21/2004 18:59'! extractDefinitionsFrom: member | reader | (MCSnapshotReader readerClassForFileNamed: member fileName) ifNotNilDo: [:rc | reader _ rc on: member contentStream text. definitions addAll: reader definitions] ! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 16:11'! extractDependencyFrom: zipMember ^ MCVersionDependency package: (MCPackage named: (zipMember fileName copyAfterLast: $/)) info: (self extractInfoFrom: (self parseMember: zipMember fileName))! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 17:26'! extractInfoFrom: dict ^ self infoCache at: (dict at: #id) ifAbsentPut: [MCVersionInfo name: (dict at: #name) id: (UUID fromString: (dict at: #id)) message: (dict at: #message) date: ([Date fromString: (dict at: #date) ] on: Error do: [ :ex | ex return: nil ]) time: ([ Time fromString:(dict at: #time)] on: Error do: [ :ex | ex return: nil ]) author: (dict at: #author) ancestors: ((dict at: #ancestors) collect: [:ea | self extractInfoFrom: ea]) stepChildren: ((dict at: #stepChildren ifAbsent: [#()]) collect: [:ea | self extractInfoFrom: ea])]! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:59'! infoCache ^ infoCache ifNil: [infoCache _ Dictionary new]! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'bf 3/18/2005 09:47'! loadDefinitions definitions _ OrderedCollection new. (self zip memberNamed: 'snapshot.bin') ifNotNilDo: [:m | [^ definitions _ (DataStream on: m contentStream) next definitions] on: Error do: [:fallThrough ]]. "otherwise" (self zip membersMatching: 'snapshot/*') do: [:m | self extractDefinitionsFrom: m]. ! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/19/2004 16:06'! loadDependencies dependencies _ (self zip membersMatching: 'dependencies/*') collect: [:m | self extractDependencyFrom: m]. dependencies _ dependencies asArray. ! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'ab 8/20/2003 19:58'! loadPackage | dict | dict _ self parseMember: 'package'. package _ MCPackage named: (dict at: #name)! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 21:18'! loadVersionInfo info _ self extractInfoFrom: (self parseMember: 'version')! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:32'! parseMember: fileName | tokens | tokens _ (self scanner scanTokens: (self zip contentsOf: fileName)) first. ^ self associate: tokens! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 20:33'! scanner ^ MCScanner! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'ab 8/18/2003 00:50'! zip zip ifNil: [zip _ ZipArchive new. zip readFrom: stream]. ^ zip! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'avi 2/14/2004 21:33'! baseInfo ^ baseInfo ifNil: [self loadBaseInfo]! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:41'! basicVersion ^ MCDiffyVersion package: self package info: self info dependencies: self dependencies baseInfo: self baseInfo patch: self patch! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'avi 2/14/2004 21:37'! buildPatchFrom: oldDefinitions to: newDefinitions ^ MCPatch fromBase: (MCSnapshot fromDefinitions: oldDefinitions) target: (MCSnapshot fromDefinitions: newDefinitions)! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'avi 2/20/2004 00:13'! loadBaseInfo ^ baseInfo _ self extractInfoFrom: (self parseMember: 'base')! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'bf 5/30/2005 21:47'! loadPatch | old new | (self zip memberNamed: 'patch.bin') ifNotNilDo: [:m | [^ patch _ (DataStream on: m contentStream) next ] on: Error do: [:fallThrough ]]. definitions _ OrderedCollection new. (self zip membersMatching: 'old/*') do: [:m | self extractDefinitionsFrom: m]. old _ definitions asArray. definitions _ OrderedCollection new. (self zip membersMatching: 'new/*') do: [:m | self extractDefinitionsFrom: m]. new _ definitions asArray. ^ patch _ self buildPatchFrom: old to: new. ! ! !MCMcdReader methodsFor: 'as yet unclassified' stamp: 'avi 2/14/2004 21:34'! patch ^ patch ifNil: [self loadPatch]! ! !MCVersionReader class methodsFor: 'testing' stamp: 'cwp 8/4/2003 00:32'! canReadFileNamed: fileName ^ (fileName endsWith: self extension)! ! !MCVersionReader class methodsFor: 'reading' stamp: 'cwp 7/31/2003 23:02'! file: fileName streamDo: aBlock | file | ^ [file _ FileStream readOnlyFileNamed: fileName. aBlock value: file] ensure: [file close]! ! !MCVersionReader class methodsFor: 'reading' stamp: 'bf 3/23/2005 01:20'! on: s fileName: f ^ self on: s! ! !MCVersionReader class methodsFor: 'reading' stamp: 'cwp 7/31/2003 23:03'! versionFromFile: fileName ^ self file: fileName streamDo: [:stream | self versionFromStream: stream]! ! !MCVersionReader class methodsFor: 'reading' stamp: 'avi 1/21/2004 22:58'! versionFromStream: aStream ^ (self on: aStream) version! ! !MCVersionReader class methodsFor: 'reading' stamp: 'avi 1/21/2004 22:59'! versionInfoFromStream: aStream ^ (self on: aStream) info! ! !MCVersionReader class methodsFor: 'file services' stamp: 'avi 10/15/2003 02:01'! fileReaderServicesForFile: fullName suffix: suffix self isAbstract ifTrue: [^ #()]. ^ ((suffix = self extension) or: [ suffix = '*' ]) ifTrue: [self services] ifFalse: [Array new: 0] ! ! !MCVersionReader class methodsFor: 'file services' stamp: 'avi 1/24/2004 19:01'! initialize "MCVersionReader initialize" Smalltalk at: #MczInstaller ifPresent: [:installer | FileList unregisterFileReader: installer]. self concreteSubclasses do: [:aClass | FileList registerFileReader: aClass]. "get rid of AnObsoleteMCMcReader and AnObsoleteMCMcvReader" (FileList registeredFileReaderClasses select: [ :ea | ea isObsolete ]) do: [ :ea | FileList unregisterFileReader: ea ] ! ! !MCVersionReader class methodsFor: 'file services' stamp: 'avi 2/12/2004 19:39'! loadVersionFile: fileName | version | version _ self versionFromFile: fileName. version workingCopy repositoryGroup addRepository: (MCDirectoryRepository new directory: (FileDirectory on: (FileDirectory dirPathFor: fileName))). version load. ! ! !MCVersionReader class methodsFor: 'file services' stamp: 'cwp 8/1/2003 14:46'! mergeVersionFile: fileName (self versionFromFile: fileName) merge! ! !MCVersionReader class methodsFor: 'file services' stamp: 'cwp 8/1/2003 14:46'! openVersionFile: fileName (self versionFromFile: fileName) open! ! !MCVersionReader class methodsFor: 'file services' stamp: 'avi 1/21/2004 22:55'! services ^ Array with: self serviceLoadVersion with: self serviceMergeVersion with: self serviceOpenVersion! ! !MCVersionReader class methodsFor: 'file services' stamp: 'cwp 8/1/2003 14:33'! unload FileList unregisterFileReader: self ! ! !MCVersionReader class methodsFor: '*monticello-file services' stamp: 'nk 2/25/2005 11:14'! loadVersionStream: stream fromDirectory: directory | version | version _ self versionFromStream: stream. directory isRemoteDirectory ifFalse: [ version workingCopy repositoryGroup addRepository: (MCDirectoryRepository new directory: directory). ]. version load. ! ! !MCVersionReader class methodsFor: '*monticello-file services' stamp: 'nk 2/25/2005 11:17'! mergeVersionStream: stream (self versionFromStream: stream) merge! ! !MCVersionReader class methodsFor: '*monticello-file services' stamp: 'nk 2/25/2005 11:12'! openVersionFromStream: stream (self versionFromStream: stream) open! ! !MCVersionReader class methodsFor: '*monticello-file services-override-override' stamp: 'nk 2/25/2005 11:15'! serviceLoadVersion ^ (SimpleServiceEntry provider: self label: 'load version' selector: #loadVersionStream:fromDirectory: description: 'load a package version' buttonLabel: 'load') argumentGetter: [ :fileList | { fileList readOnlyStream . fileList directory } ]! ! !MCVersionReader class methodsFor: '*monticello-file services-override-override' stamp: 'nk 2/25/2005 11:16'! serviceMergeVersion ^ (SimpleServiceEntry provider: self label: 'merge version' selector: #mergeVersionStream: description: 'merge a package version into the image' buttonLabel: 'merge') argumentGetter: [ :fileList | fileList readOnlyStream ]! ! !MCVersionReader class methodsFor: '*monticello-file services-override-override' stamp: 'nk 2/25/2005 11:16'! serviceOpenVersion ^ (SimpleServiceEntry provider: self label: 'open version' selector: #openVersionFromStream: description: 'open a package version' buttonLabel: 'open') argumentGetter: [ :fileList | fileList readOnlyStream ]! ! !MCMczReader class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 14:59'! extension ^ 'mcz'! ! !MCMczReader class methodsFor: 'testing' stamp: 'avi 1/19/2004 14:48'! supportsDependencies ^ true! ! !MCMczReader class methodsFor: 'testing' stamp: 'cwp 8/1/2003 12:19'! supportsVersions ^ true! ! !MCMcdReader class methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:09'! extension ^ 'mcd'! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 14:19'! addAllAncestorsOf: aVersionInfo to: aSet (aSet includes: aVersionInfo) ifTrue: [^ self]. aSet add: aVersionInfo. (self knownAncestorsOf: aVersionInfo) do: [:ea | self addAllAncestorsOf: ea to: aSet]! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2003 21:30'! addAllVersionInfos: aCollection aCollection do: [:ea | self addVersionInfo: ea]! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 3/2/2004 12:53'! addToCurrentLayer: aVersionInfo | layer | layer _ layers at: depthIndex. (layer includes: aVersionInfo) ifFalse: [depths at: aVersionInfo ifPresent: [:i | i < depthIndex ifTrue: [(layers at: i) remove: aVersionInfo] ifFalse: [^ false]]. layer add: aVersionInfo. depths at: aVersionInfo put: depthIndex. ^ true]. ^ false ! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:49'! addVersionInfo: aVersionInfo roots add: aVersionInfo. self registerStepChildrenOf: aVersionInfo seen: Set new! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 14:17'! allAncestorsOf: aVersionInfo | all | all _ Set new. self addAllAncestorsOf: aVersionInfo to: all. ^ all! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:37'! initialize stepparents _ Dictionary new. roots _ OrderedCollection new.! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 14:37'! knownAncestorsOf: aVersionInfo ^ aVersionInfo ancestors, (self stepParentsOf: aVersionInfo) asArray! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'ab 8/17/2003 15:53'! layers ^ layers! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'ab 8/17/2003 15:33'! popLayer depthIndex _ depthIndex - 1! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:39'! processVersionInfo: aVersionInfo (self addToCurrentLayer: aVersionInfo) ifTrue: [self pushLayer. (self knownAncestorsOf: aVersionInfo) do: [:ea | self processVersionInfo: ea]. self popLayer] ! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2003 21:34'! pushLayer depthIndex _ depthIndex + 1. depthIndex > layers size ifTrue: [layers add: OrderedCollection new]. ! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 14:34'! registerStepChildrenOf: aVersionInfo seen: aSet (aSet includes: aVersionInfo) ifTrue: [^ self]. aSet add: aVersionInfo. aVersionInfo stepChildren do: [:ea | (self stepParentsOf: ea) add: aVersionInfo]. aVersionInfo ancestors do: [:ea | self registerStepChildrenOf: ea seen: aSet].! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:37'! sortedVersionInfos layers _ OrderedCollection with: OrderedCollection new. depthIndex _ 1. depths _ Dictionary new. roots do: [:ea | self processVersionInfo: ea]. ^ layers gather: [:ea | ea]! ! !MCVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:40'! stepParentsOf: aVersionInfo ^ (stepparents at: aVersionInfo ifAbsentPut: [Set new])! ! !MCFilteredVersionSorter methodsFor: 'as yet unclassified' stamp: 'bf 5/28/2005 01:14'! addVersionInfo: aVersionInfo (aVersionInfo hasAncestor: target) ifTrue: [super addVersionInfo: aVersionInfo] ! ! !MCFilteredVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:40'! processVersionInfo: aVersionInfo | success | aVersionInfo = target ifTrue: [^ true]. self pushLayer. success _ (self knownAncestorsOf: aVersionInfo) anySatisfy: [:ea | self processVersionInfo: ea]. self popLayer. success ifTrue: [self addToCurrentLayer: aVersionInfo]. ^ success ! ! !MCFilteredVersionSorter methodsFor: 'as yet unclassified' stamp: 'avi 8/31/2003 21:27'! target: aVersionInfo target _ aVersionInfo! ! !MCVersionSorter class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCVersionTest methodsFor: 'asserting' stamp: 'cwp 11/7/2004 14:32'! assert: aSelector orders: sexpr as: array | expected | expected := OrderedCollection new. version := self versionFromTree: sexpr. version perform: aSelector with: [:ea | expected add: ea info name]. self assert: expected asArray = array! ! !MCVersionTest methodsFor: 'asserting' stamp: 'cwp 11/7/2004 14:47'! assert: aSelector orders: sexpr as: expected unresolved: unresolved | missing visited | visited := OrderedCollection new. missing := OrderedCollection new. version := self versionFromTree: sexpr. version perform: aSelector with: [:ea | visited add: ea info name] with: [:ea | missing add: ea name]. self assert: visited asArray = expected. self assert: missing asArray = unresolved.! ! !MCVersionTest methodsFor: 'building' stamp: 'cwp 11/7/2004 12:29'! dependencyFromTree: sexpr ^ MCMockDependency fromTree: sexpr! ! !MCVersionTest methodsFor: 'building' stamp: 'cwp 11/7/2004 12:40'! versionFromTree: sexpr ^ (self dependencyFromTree: sexpr) resolve! ! !MCVersionTest methodsFor: 'running' stamp: 'cwp 11/7/2004 13:49'! setUp visited _ OrderedCollection new.! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:53'! testAllAvailablePostOrder self assert: #allAvailableDependenciesDo: orders: #(a ((b (d e)) c)) as: #(d e b c)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:50'! testAllMissing self assert: #allDependenciesDo: orders: #(a ((b (d e)) (c missing))) as: #(d e b)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:47'! testAllUnresolved self assert: #allDependenciesDo:ifUnresolved: orders: #(a ((b (d e)) (c missing))) as: #(d e b) unresolved: #(c)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 13:55'! testDependencyOrder self assert: #allDependenciesDo: orders: #(a (b c)) as: #(b c)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:25'! testPostOrder self assert: #allDependenciesDo: orders: #(a ((b (d e)) c)) as: #(d e b c)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:22'! testWithAll self assert: #withAllDependenciesDo: orders: #(a ((b (d e)) c)) as: #(d e b c a)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:56'! testWithAllMissing self assert: #withAllDependenciesDo: orders: #(a ((b (d e)) (c missing))) as: #(d e b a)! ! !MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:29'! testWithAllUnresolved self assert: #withAllDependenciesDo:ifUnresolved: orders: #(a ((b (d e)) (c missing))) as: #(d e b a) unresolved: #(c)! ! !MCWorkingAncestry methodsFor: 'as yet unclassified' stamp: 'bf 4/26/2005 14:06'! addAncestor: aNode ancestors _ (self ancestors reject: [:each | aNode hasAncestor: each]) copyWith: aNode! ! !MCWorkingAncestry methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 10:43'! addStepChild: aVersionInfo stepChildren _ stepChildren copyWith: aVersionInfo! ! !MCWorkingAncestry methodsFor: 'as yet unclassified' stamp: 'avi 9/11/2004 16:31'! infoWithName: nameString message: messageString ^ MCVersionInfo name: nameString id: UUID new message: messageString date: Date today time: Time now author: Utilities authorInitials ancestors: ancestors asArray stepChildren: self stepChildren asArray! ! !MCWorkingAncestry methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:14'! name ^ ''! ! !MCWorkingAncestry methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 01:14'! summary ^ 'Ancestors: ', self ancestorString! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:07'! adopt: aVersion ancestry addAncestor: aVersion info. self changed.! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 9/14/2004 15:03'! backportChangesTo: aVersionInfo | baseVersion fullPatch currentVersionInfo currentVersion newSnapshot newAncestry | currentVersionInfo := self currentVersionInfo. baseVersion := self repositoryGroup versionWithInfo: aVersionInfo. currentVersion := self repositoryGroup versionWithInfo: currentVersionInfo. fullPatch := currentVersion snapshot patchRelativeToBase: baseVersion snapshot. (MCChangeSelectionRequest new patch: fullPatch; label: 'Changes to Backport'; signal ) ifNotNilDo: [:partialPatch | newSnapshot := MCPatcher apply: partialPatch to: baseVersion snapshot. newAncestry := MCWorkingAncestry new addAncestor: aVersionInfo; addStepChild: currentVersionInfo; yourself. MCPackageLoader updatePackage: package withSnapshot: newSnapshot. ancestry := newAncestry. self modified: false; modified: true]! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:05'! changesRelativeToRepository: aRepository | ancestorVersion ancestorSnapshot | ancestorVersion _ aRepository closestAncestorVersionFor: ancestry ifNone: []. ancestorSnapshot _ ancestorVersion ifNil: [MCSnapshot empty] ifNotNil: [ancestorVersion snapshot]. ^ package snapshot patchRelativeToBase: ancestorSnapshot! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:06'! loaded: aVersion ancestry _ MCWorkingAncestry new addAncestor: aVersion info. requiredPackages _ OrderedCollection withAll: (aVersion dependencies collect: [:ea | ea package]). self modified: false. self changed! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'abc 2/13/2004 15:57'! merged: aVersion ancestry addAncestor: aVersion info. self changed! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'bf 4/26/2005 14:29'! merge: targetVersion | ancestorInfo merger ancestorSnapshot packageSnapshot | targetVersion dependencies do: [:ea | ea resolve merge]. ancestorInfo _ targetVersion info commonAncestorWith: ancestry. ancestorInfo = targetVersion info ifTrue: [^ MCNoChangesException signal]. packageSnapshot _ package snapshot. ancestorSnapshot _ ancestorInfo ifNotNil: [(self findSnapshotWithVersionInfo: ancestorInfo)] ifNil: [self notifyNoCommonAncestorWith: targetVersion. MCSnapshot empty]. (ancestry ancestors size = 1 and: [ancestry ancestors first = ancestorInfo] and: [(packageSnapshot patchRelativeToBase: ancestorSnapshot) isEmpty]) ifTrue: [^ targetVersion load]. merger _ MCThreeWayMerger base: packageSnapshot target: targetVersion snapshot ancestor: ancestorSnapshot. ((MCMergeResolutionRequest new merger: merger) signal: 'Merging ', targetVersion info name) = true ifTrue: [merger loadWithNameLike: targetVersion info name. ancestry addAncestor: targetVersion info]. self changed! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 1/19/2004 16:18'! newVersion ^ (self requestVersionNameAndMessageWithSuggestion: self uniqueVersionName) ifNotNilDo: [:pair | self newVersionWithName: pair first message: pair last]. ! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 9/24/2004 10:21'! newVersionWithName: nameString message: messageString | info deps | info _ ancestry infoWithName: nameString message: messageString. ancestry _ MCWorkingAncestry new addAncestor: info. self modified: true; modified: false. deps _ self requiredPackages collect: [:ea | MCVersionDependency package: ea info: ea workingCopy currentVersionInfo]. ^ MCVersion package: package info: info snapshot: package snapshot dependencies: deps! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:07'! notifyNoCommonAncestorWith: aVersion self notify: 'Could not find a common ancestor between (', aVersion info name, ') and (', ancestry ancestorString, '). Proceeding with this merge may cause spurious conflicts.'! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'avi 10/5/2003 11:09'! unload MCPackageLoader unloadPackage: self package. self unregister.! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:07'! ancestors ^ ancestry ancestors! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:13'! ancestry ^ ancestry! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 1/19/2004 16:30'! clearRequiredPackages requiredPackages _ nil! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 20:01'! currentVersionInfo ^ (self needsSaving or: [ancestry ancestors isEmpty]) ifTrue: [self newVersion info] ifFalse: [ancestry ancestors first]! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:05'! description ^ self packageNameWithStar, ' (', ancestry ancestorString, ')'! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 20:02'! needsSaving ^ self modified or: [self requiredPackages anySatisfy: [:ea | ea workingCopy needsSaving]]! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 1/19/2004 16:30'! requiredPackages ^ requiredPackages ifNil: [requiredPackages _ OrderedCollection new]! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 1/20/2004 16:04'! requirePackage: aPackage (self requiredPackages includes: aPackage) ifFalse: [requiredPackages add: aPackage]! ! !MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:06'! versionInfo: aVersionInfo ancestry _ MCWorkingAncestry new addAncestor: aVersionInfo! ! !MCWorkingCopy methodsFor: 'private' stamp: 'avi 9/24/2004 12:15'! findSnapshotWithVersionInfo: aVersionInfo ^ aVersionInfo ifNil: [MCSnapshot empty] ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo) snapshot]! ! !MCWorkingCopy methodsFor: 'private' stamp: 'avi 2/13/2004 01:07'! initialize super initialize. ancestry _ MCWorkingAncestry new! ! !MCWorkingCopy methodsFor: 'private' stamp: 'bf 11/5/2004 17:32'! nextVersionName | branch oldName | ancestry ancestors isEmpty ifTrue: [counter ifNil: [counter _ 0]. branch _ package name] ifFalse: [oldName _ ancestry ancestors first name. oldName last isDigit ifFalse: [branch _ oldName] ifTrue: [branch _ oldName copyUpToLast: $-]. counter ifNil: [ counter _ (ancestry ancestors collect: [:each | each name last isDigit ifFalse: [0] ifTrue: [(each name copyAfterLast: $-) extractNumber]]) max]]. counter _ counter + 1. ^ branch, '-', Utilities authorInitials, '.', counter asString! ! !MCWorkingCopy methodsFor: 'private' stamp: 'bf 3/10/2005 22:58'! possiblyNewerVersions ^Array streamContents: [:strm | self repositoryGroup repositories do: [:repo | strm nextPutAll: (repo possiblyNewerVersionsOfAnyOf: self ancestors)]]! ! !MCWorkingCopy methodsFor: 'private' stamp: 'ab 8/24/2003 20:38'! requestVersionNameAndMessageWithSuggestion: aString ^ (MCVersionNameAndMessageRequest new suggestedName: aString) signal! ! !MCWorkingCopy methodsFor: 'private' stamp: 'avi 2/4/2004 14:03'! uniqueVersionName |versionName| counter _ nil. [versionName _ self nextVersionName. self repositoryGroup includesVersionNamed: versionName] whileTrue. ^ versionName! ! !MCWorkingCopy methodsFor: 'private' stamp: 'avi 2/4/2004 14:11'! versionSeparator ^ $_! ! !MCWorkingCopy methodsFor: 'repositories' stamp: 'avi 8/31/2003 00:14'! repositoryGroup ^ repositoryGroup ifNil: [repositoryGroup _ MCRepositoryGroup new]! ! !MCWorkingCopy methodsFor: 'repositories' stamp: 'ab 7/22/2003 00:20'! repositoryGroup: aRepositoryGroup repositoryGroup _ aRepositoryGroup! ! !MCWorkingCopy methodsFor: 'migration' stamp: 'avi 2/17/2004 02:36'! updateInstVars ancestry ifNil: [ancestry _ MCWorkingAncestry new. versionInfo ifNotNil: [versionInfo ancestors do: [:ea | ancestry addAncestor: ea]. versionInfo _ nil]]! ! !MCWorkingCopy class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:00'! adoptVersionInfoFrom: anInstaller |viCache| viCache := Dictionary new. anInstaller versionInfo keysAndValuesDo: [:packageName :info | (self forPackage: (MCPackage named: packageName)) versionInfo: (self infoFromDictionary: info cache: viCache)]. [anInstaller clearVersionInfo] on: Error do: ["backwards compat"].! ! !MCWorkingCopy class methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 01:23'! ancestorsFromArray: anArray cache: aDictionary ^ anArray ifNotNil: [anArray collect: [:dict | self infoFromDictionary: dict cache: aDictionary]]! ! !MCWorkingCopy class methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 02:59'! infoFromDictionary: aDictionary cache: cache | id | id _ aDictionary at: #id. ^ cache at: id ifAbsentPut: [MCVersionInfo name: (aDictionary at: #name) id: (aDictionary at: #id) message: (aDictionary at: #message) date: (aDictionary at: #date) time: (aDictionary at: #time) author: (aDictionary at: #author) ancestors: (self ancestorsFromArray: (aDictionary at: #ancestors) cache: cache)]! ! !MCWorkingCopy class methodsFor: 'as yet unclassified' stamp: 'ar 4/27/2005 02:09'! initialize Smalltalk at: #MczInstaller ifPresent: [:installer | self adoptVersionInfoFrom: installer]. self updateInstVars. "Temporary conversion code -- remove later" registry ifNotNil:[registry rehash]. "changed #=" self allInstancesDo:[:each| "moved notifications" Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| cls uniqueInstance noMoreNotificationsFor: each. ]. ]. self registerForNotifications.! ! !MCWorkingCopy class methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 02:36'! updateInstVars self allInstances do: [:ea | ea updateInstVars]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bkv 2/18/2004 21:22'! addRepository self newRepository ifNotNilDo: [:repos | self addRepository: repos ]. ! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:57'! 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]]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:57'! addRepositoryToWorkingCopy workingCopy ifNotNilDo: [:wc | workingCopy repositoryGroup addRepository: self repository. self changed: #workingCopySelection; changed: #repositoryList; changed: #repositorySelection. self changedButtons]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:58'! addRepository: aRepository self repository: aRepository. self repositoryGroup addRepository: aRepository. self changed: #repositoryList; changed: #repositorySelection. self changedButtons.! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:45'! addRequiredPackage workingCopy ifNotNilDo: [:wc | self pickWorkingCopy ifNotNilDo: [:required | wc requirePackage: required package. self workingCopyListChanged]]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:58'! 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.! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:38'! 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]]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ab 7/19/2003 22:58'! browseWorkingCopy workingCopy ifNotNil: [(MCSnapshotBrowser forSnapshot: workingCopy package snapshot) label: 'Snapshot Browser: ', workingCopy packageName; show]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 9/14/2004 14:57'! canBackport ^ self hasWorkingCopy and: [workingCopy needsSaving not]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 3/10/2005 23:09'! checkForNewerVersions | newer | newer _ workingCopy possiblyNewerVersions. ^ 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?'].! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:46'! clearRequiredPackages workingCopy ifNotNilDo: [:wc | wc clearRequiredPackages. self workingCopyListChanged]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:46'! deleteWorkingCopy workingCopy unregister. self workingCopySelection: 0. self workingCopyListChanged.! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 4/14/2005 15:31'! 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!!']] ! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/3/2005 15:08'! 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'! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 9/11/2004 15:32'! inspectWorkingCopy workingCopy ifNotNil: [workingCopy inspect]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:58'! loadRepositories FileStream fileIn: 'MCRepositories.st'. self changed: #repositoryList. self changedButtons. ! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ab 8/21/2003 00:30'! 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]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'lr 9/26/2003 20:04'! openRepository self repository ifNotNilDo: [:repos | repos morphicOpen: workingCopy ]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'jf 1/25/2004 14:06'! recompilePackage workingCopy package packageInfo methods do: [:ea | ea actualClass recompile: ea methodSymbol] displayingProgress: 'Recompiling...'! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 15:58'! removeRepository self repository ifNotNilDo: [:repos | self repositoryGroup removeRepository: repos. self repositorySelection: (1 min: self repositories size)]. self changed: #repositoryList. self changedButtons. ! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 11/16/2003 20:21'! repository workingCopy ifNotNil: [repository _ self defaults at: workingCopy ifAbsent: []]. ^ repository! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 11/16/2003 20:21'! repository: aRepository repository _ aRepository. workingCopy ifNotNil: [self defaults at: workingCopy put: aRepository]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 5/11/2005 15:20'! revertPackage self pickAncestorVersionInfo ifNotNilDo: [:info | (self repositoryGroup versionWithInfo: info ifNone: [^self inform: 'No repository found for ', info name] ) load]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 9/10/2004 17:46'! saveRepositories | f | f := FileStream forceNewFileNamed: 'MCRepositories.st'. MCRepositoryGroup default repositoriesDo: [:r | f nextPutAll: 'MCRepositoryGroup default addRepository: (', r asCreationTemplate, ')!!'; cr.]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/21/2005 16:08'! saveVersion self canSave ifFalse: [^self]. self checkForNewerVersions ifFalse: [^self]. workingCopy newVersion ifNotNilDo: [:v | (MCVersionInspector new version: v) show. Cursor wait showWhile: [self repository storeVersion: v]. v allAvailableDependenciesDo: [:dep | (self repository includesVersionNamed: dep info name) ifFalse: [self repository storeVersion: dep]]] ! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:46'! unloadPackage workingCopy unload. self workingCopySelection: 0. self workingCopyListChanged.! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'nk 3/9/2004 19:19'! 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]]! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 2/13/2004 01:13'! viewHistory workingCopy ifNotNil: [(MCWorkingHistoryBrowser new ancestry: workingCopy ancestry; package: workingCopy package) label: 'Version History: ', workingCopy packageName; show]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 2/28/2005 16:28'! 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) )! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 8/7/2003 21:22'! canSave ^ self hasWorkingCopy and: [self hasRepository]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:50'! changedButtons self changed: #hasWorkingCopy. self changed: #canSave. self changed: #canBackport. self changed: #hasRepository. ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 2/28/2005 16:28'! defaultExtent ^ 550@200! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 23:38'! defaultLabel ^ 'Monticello Browser'! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 11/16/2003 20:22'! defaults ^ defaults ifNil: [defaults _ Dictionary new]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:46'! 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.! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'mist 2/19/2005 00:54'! editScript: scriptSymbol | script | script _ workingCopy packageInfo perform: scriptSymbol. script openLabel: scriptSymbol asString, ' of the Package ', workingCopy package name.! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 02:21'! hasRepository ^ self repository notNil! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 00:46'! hasWorkingCopy ^ workingCopy notNil! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 11/16/2003 20:21'! initialize MCWorkingCopy addDependent: self. self workingCopies do: [:ea | ea addDependent: self].! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 9/11/2004 15:07'! pickAncestorVersionInfo | ancestors index | ancestors _ workingCopy ancestry allAncestors. index _ (PopUpMenu labelArray: (ancestors collect: [:ea | ea name])) startUpWithCaption: 'Ancestor:'. ^ index = 0 ifFalse: [ ancestors at: index]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'nk 3/9/2004 14:39'! pickWorkingCopy ^self pickWorkingCopySatisfying: [ :c | true ]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'nk 3/9/2004 20:22'! 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]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 8/7/2003 21:32'! repositories ^ self repositoryGroup repositories! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 8/7/2003 21:32'! repositoryGroup ^ workingCopy ifNil: [MCRepositoryGroup default] ifNotNil: [workingCopy repositoryGroup]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 22:04'! repositoryList ^ self repositories collect: [:ea | ea description]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/6/2005 13:20'! 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 ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 02:22'! repositorySelection ^ self repositories indexOf: self repository! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:56'! repositorySelection: aNumber aNumber = 0 ifTrue: [self repository: nil] ifFalse: [self repository: (self repositories at: aNumber)]. self changed: #repositorySelection. self changedButtons. ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 8/31/2004 01:14'! toggleDiffs self repository alwaysStoreDiffs ifTrue: [self repository doNotAlwaysStoreDiffs] ifFalse: [self repository doAlwaysStoreDiffs]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 9/10/2004 17:54'! unsortedWorkingCopies ^ MCWorkingCopy allManagers ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 9/10/2004 17:54'! update: aSymbol self unsortedWorkingCopies do: [:ea | ea addDependent: self]. self workingCopyListChanged.! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 3/6/2005 22:30'! 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)) )! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 1/20/2004 16:09'! workingCopies ^ MCWorkingCopy allManagers asSortedCollection: [ :a :b | a package name <= b package name ]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 1/19/2004 16:41'! 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]]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:51'! workingCopyListChanged self changed: #workingCopyList. self changed: #workingCopyTree. self changedButtons. ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 5/11/2005 15:26'! 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) ('unload package' #unloadPackage) ('delete working copy' #deleteWorkingCopy)). (Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [ aMenu add: 'make SAR' target: self selector: #fileOutAsSAR ]. ^aMenu! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 23:11'! workingCopyListMorph ^ PluggableMultiColumnListMorph on: self list: #workingCopyList selected: #workingCopySelection changeSelected: #workingCopySelection: menu: #workingCopyListMenu:! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 22:05'! workingCopySelection ^ self workingCopies indexOf: workingCopy! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:38'! workingCopySelectionWrapper ^workingCopyWrapper! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:57'! workingCopySelectionWrapper: aWrapper workingCopyWrapper := aWrapper. self changed: #workingCopySelectionWrapper. self workingCopy: (aWrapper ifNotNil:[aWrapper item])! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:48'! workingCopySelection: aNumber self workingCopy: (aNumber = 0 ifTrue:[nil] ifFalse:[self workingCopies at: aNumber]). ! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:30'! workingCopyTree ^ self workingCopies collect:[:each| MCDependentsWrapper with: each model: self].! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 5/11/2005 15:25'! 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) ('delete working copy' #deleteWorkingCopy) ('inspect working copy' #inspectWorkingCopy)). (Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [ aMenu add: 'make SAR' target: self selector: #fileOutAsSAR ]. ^aMenu! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:24'! workingCopyTreeMorph ^ SimpleHierarchicalListMorph on: self list: #workingCopyTree selected: #workingCopyWrapper changeSelected: #workingCopyWrapper: menu: #workingCopyListMenu:! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:51'! workingCopy: wc workingCopy _ wc. self changed: #workingCopyList; changed: #workingCopySelection; changed: #repositoryList. self changedButtons. ! ! !MCWorkingCopyBrowser class methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 23:38'! initialize (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [TheWorldMenu registerOpenCommand: {'Monticello Browser'. {self. #open}}]! ! !MCWorkingCopyBrowser class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:04'! new ^ self basicNew initialize! ! !MCWorkingCopyBrowser class methodsFor: 'as yet unclassified' stamp: 'ab 7/19/2003 23:27'! open self new show! ! !MCWorkingCopyTest methodsFor: 'asserting' stamp: 'avi 2/10/2004 12:29'! assertNameWhenSavingTo: aRepository is: aString | name | name _ nil. [aRepository storeVersion: workingCopy newVersion] on: MCVersionNameAndMessageRequest do: [:n | name _ n suggestedName. n resume: (Array with: name with: '')]. self assert: name = aString! ! !MCWorkingCopyTest methodsFor: 'asserting' stamp: 'ab 8/24/2003 20:36'! assertNumberWhenSavingTo: aRepository is: aNumber | name | name _ nil. [aRepository storeVersion: workingCopy newVersion] on: MCVersionNameAndMessageRequest do: [:n | name _ n suggestedName. n resume: (Array with: name with: '')]. self assert: name = (self packageName, '-', Utilities authorInitials, '.', aNumber asString)! ! !MCWorkingCopyTest methodsFor: 'actions' stamp: 'avi 2/13/2004 14:30'! basicMerge: aVersion aVersion merge! ! !MCWorkingCopyTest methodsFor: 'actions' stamp: 'avi 1/24/2004 20:13'! load: aVersion aVersion load! ! !MCWorkingCopyTest methodsFor: 'actions' stamp: 'jf 8/21/2003 20:22'! merge: aVersion [[self basicMerge: aVersion] on: MCMergeResolutionRequest do: [:n | n resume: true]] on: MCNoChangesException do: [:n | ]! ! !MCWorkingCopyTest methodsFor: 'actions' stamp: 'ab 8/24/2003 20:36'! snapshot | version | [version _ workingCopy newVersion] on: MCVersionNameAndMessageRequest do: [:n | n resume: (Array with: n suggestedName with: '')]. versions at: version info put: version. ^ version! ! !MCWorkingCopyTest methodsFor: 'running' stamp: 'bf 5/20/2005 15:56'! clearPackageCache | dir | dir _ MCCacheRepository default directory. (dir fileNamesMatching: 'MonticelloMocks*') do: [:ea | dir deleteFileNamed: ea]. (dir fileNamesMatching: 'MonticelloTest*') do: [:ea | dir deleteFileNamed: ea]. (dir fileNamesMatching: 'rev*') do: [:ea | dir deleteFileNamed: ea]. (dir fileNamesMatching: 'foo-*') do: [:ea | dir deleteFileNamed: ea]. (dir fileNamesMatching: 'foo2-*') do: [:ea | dir deleteFileNamed: ea].! ! !MCWorkingCopyTest methodsFor: 'running' stamp: 'bf 5/20/2005 17:58'! setUp | repos1 repos2 | self clearPackageCache. repositoryGroup _ MCRepositoryGroup new. workingCopy _ MCWorkingCopy forPackage: self mockPackage. versions _ Dictionary new. versions2 _ Dictionary new. repos1 _ MCDictionaryRepository new dictionary: versions. repos2 _ MCDictionaryRepository new dictionary: versions2. repositoryGroup addRepository: repos1. repositoryGroup addRepository: repos2. MCRepositoryGroup default removeRepository: repos1; removeRepository: repos2. workingCopy repositoryGroup: repositoryGroup. savedInitials _ Utilities authorInitials. Utilities setAuthorInitials: 'abc'.! ! !MCWorkingCopyTest methodsFor: 'running' stamp: 'avi 2/10/2004 12:30'! tearDown workingCopy unregister. self restoreMocks. self clearPackageCache. Utilities setAuthorInitials: savedInitials.! ! !MCWorkingCopyTest methodsFor: 'accessing' stamp: 'ab 7/7/2003 18:02'! description ^ self class name! ! !MCWorkingCopyTest methodsFor: 'private' stamp: 'cwp 8/2/2003 15:03'! packageName ^ self mockPackage name! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'jf 8/21/2003 20:23'! testAncestorMerge | base revA revB revC | base _ self snapshot. self change: #a toReturn: 'a1'. revA _ self snapshot. self change: #b toReturn: 'b1'. revB _ self snapshot. self change: #c toReturn: 'c1'. revC _ self snapshot. self should: [self basicMerge: revA] raise: MCNoChangesException. ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'abc 11/6/2004 20:36'! testBackport | inst base final backported | inst _ self mockInstanceA. base _ self snapshot. self assert: inst one = 1. self change: #one toReturn: 2. self change: #two toReturn: 3. final _ self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest do: [:e | e resume: e patch]. self assert: inst one = 2. self assert: inst two = 3. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = final info. backported _ self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest do: [:e | e resume: e patch]. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = backported info. ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'cwp 8/10/2003 02:12'! testDoubleRepeatedMerge | base motherA1 motherA2 motherB1 motherB2 inst | base _ self snapshot. self change: #a toReturn: 'a1'. motherA1 _ self snapshot. self change: #c toReturn: 'c1'. motherA2 _ self snapshot. self load: base. self change: #b toReturn: 'b1'. motherB1 _ self snapshot. self change: #d toReturn: 'd1'. motherB2 _ self snapshot. self load: base. self merge: motherA1. self merge: motherB1. self change: #a toReturn: 'a2'. self change: #b toReturn: 'b2'. self snapshot. self shouldnt: [self merge: motherA2] raise: Error. self shouldnt: [self merge: motherB2] raise: Error. inst _ self mockInstanceA. self assert: inst a = 'a2'. self assert: inst b = 'b2'. self assert: inst c = 'c1'. self assert: inst d = 'd1'. ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'avi 2/12/2004 20:14'! testMergeIntoImageWithNoChanges | base revB revA1 | self change: #a toReturn: 'a'. base _ self snapshot. self change: #b toReturn: 'b'. revB _ self snapshot. self load: base. self change: #a toReturn: 'a1'. revA1 _ self snapshot. self change: #a toReturn: 'a'. self snapshot. self merge: revB. self assert: (workingCopy ancestors size = 2) ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'avi 2/12/2004 20:14'! testMergeIntoUnmodifiedImage | base revA | base _ self snapshot. self change: #a toReturn: 'a1'. revA _ self snapshot. self load: base. self merge: revA. self assert: (workingCopy ancestors size = 1) ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'bf 5/20/2005 18:25'! testNaming | repos version | repos := MCDictionaryRepository new. self assertNameWhenSavingTo: repos is: self packageName, '-abc.1'. self assertNameWhenSavingTo: repos is: self packageName, '-abc.2'. repos := MCDictionaryRepository new. self assertNameWhenSavingTo: repos is: self packageName, '-abc.3'. version := self snapshot. version info instVarNamed: 'name' put: 'foo-jf.32'. version load. self assertNameWhenSavingTo: repos is: 'foo-abc.33'. self assertNameWhenSavingTo: repos is: 'foo-abc.34'. version info instVarNamed: 'name' put: 'foo-abc.35'. repos storeVersion: version. self assertNameWhenSavingTo: repos is: 'foo-abc.36'. self assertNameWhenSavingTo: repos is: 'foo-abc.37'. version info instVarNamed: 'name' put: 'foo-abc.10'. repos storeVersion: version. self assertNameWhenSavingTo: repos is: 'foo-abc.38'. version info instVarNamed: 'name' put: 'foo2-ab.40'. version load. self assertNameWhenSavingTo: repos is: 'foo2-abc.41'.! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'bf 5/23/2005 13:44'! testOptimizedLoad | inst base diffy | inst _ self mockInstanceA. base _ self snapshot. self change: #one toReturn: 2. self assert: inst one = 2. diffy _ self snapshot asDiffAgainst: base. self deny: diffy canOptimizeLoading. self load: base. self assert: inst one = 1. self assert: diffy canOptimizeLoading. self load: diffy. self assert: inst one = 2. ! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'ab 7/7/2003 14:47'! testRedundantMerge | base | base _ self snapshot. self merge: base. self shouldnt: [self merge: base] raise: Error.! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'cwp 8/10/2003 02:13'! testRepeatedMerge | base mother1 mother2 inst | base _ self snapshot. self change: #one toReturn: 2. mother1 _ self snapshot. self change: #two toReturn: 3. mother2 _ self snapshot. self load: base. self change: #truth toReturn: false. self snapshot. inst _ self mockInstanceA. self assert: inst one = 1. self assert: inst two = 2. self merge: mother1. self assert: inst one = 2. self assert: inst two = 2. self change: #one toReturn: 7. self assert: inst one = 7. self assert: inst two = 2. self shouldnt: [self merge: mother2] raise: Error. self assert: inst one = 7. self assert: inst two = 3.! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'avi 10/14/2003 01:21'! testRepositoryFallback | version | version _ self snapshot. self assert: (repositoryGroup versionWithInfo: version info) == version. versions removeKey: version info. versions2 at: version info put: version. self assert: ( repositoryGroup versionWithInfo: version info) == version. versions2 removeKey: version info. self should: [repositoryGroup versionWithInfo: version info] raise: Error.! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'abc 9/11/2004 16:00'! testSelectiveBackport | inst base intermediate final patch selected | inst _ self mockInstanceA. base _ self snapshot. self assert: inst one = 1. self change: #one toReturn: 2. intermediate _ self snapshot. self change: #two toReturn: 3. final _ self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest do: [:e | patch _ e patch. selected _ patch operations select: [:ea | ea definition selector = #two]. e resume: (MCPatch operations: selected)]. self assert: inst one = 1. self assert: inst two = 3. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = final info! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'cwp 8/10/2003 02:13'! testSimpleMerge | mother base inst | inst _ self mockInstanceA. base _ self snapshot. self change: #one toReturn: 2. mother _ self snapshot. self load: base. self change: #two toReturn: 3. self snapshot. self assert: inst one = 1. self assert: inst two = 3. self merge: mother. self assert: inst one = 2. self assert: inst two = 3.! ! !MCWorkingCopyTest methodsFor: 'tests' stamp: 'cwp 8/10/2003 02:14'! testSnapshotAndLoad | base inst | inst _ self mockInstanceA. base _ self snapshot. self change: #one toReturn: 2. self assert: inst one = 2. self load: base. self assert: inst one = 1.! ! !MCWorkingHistoryBrowser methodsFor: 'as yet unclassified' stamp: 'ab 8/22/2003 01:37'! baseSnapshot ^ package snapshot! ! !MCWriteOnlyRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:52'! includesVersionNamed: aString ^ false! ! !MCWriteOnlyRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:53'! morphicOpen: aWorkingCopy self inform: 'This repository is write-only'! ! !MCWriteOnlyRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:52'! versionWithInfo: aVersionInfo ifAbsent: aBlock ^ aBlock value! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:21'! basicStoreVersion: aVersion | url | url _ self uploadVersion: aVersion. self releaseVersion: aVersion url: url! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:11'! checkResult: resultString (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [:code | resultString beginsWith: code ]) ifFalse: [self error: resultString]. ! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:15'! description ^ 'sm://', packageName! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:15'! initializeWithPackage: packageString user: userString password: passString packageName _ packageString. user _ userString. password _ passString. ! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 15:05'! releaseVersion: aVersion url: urlString | result | result _ HTTPSocket httpPost: self squeakMapUrl, '/packagebyname/', packageName, '/newrelease' args: {'version' -> {(aVersion info name copyAfter: $.) extractNumber asString}. 'note' -> {aVersion info message}. 'downloadURL' -> {urlString}} user: user passwd: password. result contents size > 4 ifTrue: [self error: result contents] ! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:58'! squeakMapUrl ^ 'http://localhost:9070/sm' ! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 13:53'! stringForVersion: aVersion | stream | stream _ RWBinaryOrTextStream on: String new. aVersion fileOutOn: stream. ^ stream contents! ! !MCSMReleaseRepository methodsFor: 'as yet unclassified' stamp: 'avi 2/12/2004 19:41'! uploadVersion: aVersion | result stream | result _ HTTPSocket httpPut: (self stringForVersion: aVersion) to: self squeakMapUrl, '/upload/', aVersion fileName user: user passwd: password. self checkResult: result. stream _ result readStream. stream upToAll: 'http://'. ^ 'http://', stream upToEnd! ! !MCSMReleaseRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:15'! creationTemplate ^ 'MCSMReleaseRepository package: ''mypackage'' user: ''squeak'' password: ''squeak''' ! ! !MCSMReleaseRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 13:42'! description ^ 'SqueakMap Release'! ! !MCSMReleaseRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:03'! fillInTheBlankRequest ^ 'SqueakMap Release Repository:' ! ! !MCSMReleaseRepository class methodsFor: 'as yet unclassified' stamp: 'bkv 2/18/2004 21:03'! morphicConfigure ^ self fillInTheBlankConfigure! ! !MCSMReleaseRepository class methodsFor: 'as yet unclassified' stamp: 'avi 2/10/2004 14:14'! package: packageString user: userString password: passString ^ self basicNew initializeWithPackage: packageString user: userString password: passString! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 14:21'! basicStoreVersion: aVersion MailSender sendMessage: (self messageForVersion: aVersion)! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 13:11'! bodyForVersion: aVersion ^ String streamContents: [ :s | s nextPutAll: 'from version info:'; cr; cr. s nextPutAll: aVersion info summary]! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:56'! description ^ 'mailto://', email! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:54'! emailAddress: aString email _ aString ! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 12:40'! messageForVersion: aVersion | message data | message := MailMessage empty. message setField: 'from' toString: MailSender userName. message setField: 'to' toString: email. message setField: 'subject' toString: (self subjectForVersion: aVersion). message body: (MIMEDocument contentType: 'text/plain' content: (self bodyForVersion: aVersion)). "Prepare the gzipped data" data _ RWBinaryOrTextStream on: String new. aVersion fileOutOn: data. message addAttachmentFrom: data reset withName: aVersion fileName. ^ message! ! !MCSmtpRepository methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 13:14'! subjectForVersion: aVersion ^ '[Package] ', aVersion info name! ! !MCSmtpRepository class methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:56'! description ^ 'SMTP'! ! !MCSmtpRepository class methodsFor: 'as yet unclassified' stamp: 'avi 10/9/2003 12:55'! morphicConfigure | address | address _ FillInTheBlankMorph request: 'Email address:'. ^ address isEmpty ifFalse: [self new emailAddress: address]! ! !MCWriter methodsFor: 'as yet unclassified' stamp: 'cwp 8/1/2003 01:14'! stream ^ stream! ! !MCWriter methodsFor: 'as yet unclassified' stamp: 'ab 7/18/2003 21:37'! stream: aStream stream _ aStream! ! !MCMczWriter methodsFor: 'writing' stamp: 'cwp 8/1/2003 01:38'! addString: string at: path | member | member _ zip addString: string as: path. member desiredCompressionMethod: ZipArchive compressionDeflated ! ! !MCMczWriter methodsFor: 'writing' stamp: 'avi 2/17/2004 02:17'! flush zip writeTo: stream. stream close! ! !MCMczWriter methodsFor: 'accessing' stamp: 'avi 2/17/2004 01:54'! format ^ '1'! ! !MCMczWriter methodsFor: 'accessing' stamp: 'avi 2/17/2004 02:07'! snapshotWriterClass ^ MCStWriter! ! !MCMczWriter methodsFor: 'accessing' stamp: 'cwp 8/1/2003 00:06'! zip ^ zip! ! !MCMczWriter methodsFor: 'initializing' stamp: 'cwp 8/1/2003 01:18'! initialize zip _ ZipArchive new. ! ! !MCMczWriter methodsFor: 'serializing' stamp: 'avi 2/17/2004 02:18'! serializeDefinitions: aCollection | writer s | s _ RWBinaryOrTextStream on: String new. writer _ self snapshotWriterClass on: s. writer writeDefinitions: aCollection. ^ s contents! ! !MCMczWriter methodsFor: 'serializing' stamp: 'avi 9/28/2004 14:24'! serializeInBinary: aSnapshot | writer s | s _ RWBinaryOrTextStream on: String new. writer _ DataStream on: s. writer nextPut: aSnapshot. ^ s contents! ! !MCMczWriter methodsFor: 'serializing' stamp: 'cwp 8/13/2003 01:06'! serializePackage: aPackage ^ '(name ''', aPackage name, ''')'! ! !MCMczWriter methodsFor: 'serializing' stamp: 'avi 2/17/2004 01:47'! serializeVersionInfo: aVersionInfo infoWriter ifNil: [infoWriter _ MCVersionInfoWriter new]. ^ String streamContents: [:s | infoWriter stream: s. infoWriter writeVersionInfo: aVersionInfo]! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:48'! writeDefinitions: aVersion self writeSnapshot: aVersion snapshot! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:56'! writeFormat " self addString: self format at: 'format'."! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:48'! writePackage: aPackage self addString: (self serializePackage: aPackage) at: 'package'! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 9/28/2004 14:26'! writeSnapshot: aSnapshot self addString: (self serializeDefinitions: aSnapshot definitions) at: 'snapshot/source.', self snapshotWriterClass extension. self addString: (self serializeInBinary: aSnapshot) at: 'snapshot.bin'! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:47'! writeVersionDependency: aVersionDependency | string | string _ (self serializeVersionInfo: aVersionDependency versionInfo). self addString: string at: 'dependencies/', aVersionDependency package name! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:45'! writeVersionInfo: aVersionInfo | string | string _ self serializeVersionInfo: aVersionInfo. self addString: string at: 'version'. ! ! !MCMczWriter methodsFor: 'visiting' stamp: 'avi 9/13/2004 16:49'! writeVersion: aVersion self writeFormat. self writePackage: aVersion package. self writeVersionInfo: aVersion info. self writeDefinitions: aVersion. aVersion dependencies do: [:ea | self writeVersionDependency: ea]! ! !MCMcdWriter methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:16'! writeBaseInfo: aVersionInfo | string | string _ self serializeVersionInfo: aVersionInfo. self addString: string at: 'base'. ! ! !MCMcdWriter methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 01:48'! writeDefinitions: aVersion self writeBaseInfo: aVersion baseInfo. self writePatch: aVersion patch.! ! !MCMcdWriter methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 02:07'! writeNewDefinitions: aCollection self addString: (self serializeDefinitions: aCollection) at: 'new/source.', self snapshotWriterClass extension.! ! !MCMcdWriter methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 02:07'! writeOldDefinitions: aCollection self addString: (self serializeDefinitions: aCollection) at: 'old/source.', self snapshotWriterClass extension.! ! !MCMcdWriter methodsFor: 'as yet unclassified' stamp: 'bf 5/30/2005 21:40'! writePatch: aPatch | old new | old _ OrderedCollection new. new _ OrderedCollection new. aPatch operations do: [:ea | ea isRemoval ifTrue: [old add: ea definition]. ea isAddition ifTrue: [new add: ea definition]. ea isModification ifTrue: [old add: ea baseDefinition. new add: ea definition]]. self writeOldDefinitions: old. self writeNewDefinitions: new. self addString: (self serializeInBinary: aPatch) at: 'patch.bin'.! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 02:34'! chunkContents: aBlock stream cr; nextChunkPut: (String streamContents: aBlock); cr! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 01:46'! writeCategory: categoryName stream nextChunkPut: 'SystemOrganization addCategory: ', categoryName printString; cr! ! !MCStWriter methodsFor: 'writing' stamp: 'ab 8/17/2003 17:09'! writeClassComment: definition stream cr; nextPut: $!!; nextPutAll: definition className; nextPutAll: ' commentStamp: '; store: definition commentStamp; nextPutAll: ' prior: 0!!'; cr; nextChunkPut: definition comment; cr.! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 02:16'! writeClassDefinition: definition self chunkContents: [:s | definition printDefinitionOn: stream]! ! !MCStWriter methodsFor: 'writing' stamp: 'dvf 9/8/2004 10:28'! writeDefinitions: aCollection "initStream is an ugly hack until we have proper init defs" initStream := String new writeStream. (MCDependencySorter sortItems: aCollection) do: [:ea | ea accept: self] displayingProgress: 'Writing definitions...'. stream nextPutAll: initStream contents.! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 02:32'! writeMetaclassDefinition: definition self chunkContents: [:s | s nextPutAll: definition className; nextPutAll: ' class'; cr; tab; nextPutAll: 'instanceVariableNames: '''; nextPutAll: definition classInstanceVariablesString; nextPut: $'. ]! ! !MCStWriter methodsFor: 'writing' stamp: 'avi 2/17/2004 02:24'! writeMethodInitializer: aMethodDefinition aMethodDefinition isInitializer ifTrue: [initStream nextChunkPut: aMethodDefinition className, ' initialize'; cr]! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 12:43'! writeMethodPostscript stream space; nextPut: $!!; cr! ! !MCStWriter methodsFor: 'writing' stamp: 'avi 9/23/2003 17:42'! writeMethodPreamble: definition stream cr; nextPut: $!!; nextPutAll: definition fullClassName; nextPutAll: ' methodsFor: '; nextPutAll: definition category asString printString; nextPutAll: ' stamp: '; nextPutAll: definition timeStamp asString printString; nextPutAll: '!!'; cr! ! !MCStWriter methodsFor: 'writing' stamp: 'cwp 8/4/2003 01:35'! writeMethodSource: definition stream nextChunkPut: definition source! ! !MCStWriter methodsFor: 'writing' stamp: 'avi 2/17/2004 02:25'! writeSnapshot: aSnapshot self writeDefinitions: aSnapshot definitions! ! !MCStWriter methodsFor: 'visiting' stamp: 'cwp 8/2/2003 11:02'! visitClassDefinition: definition self writeClassDefinition: definition. definition hasClassInstanceVariables ifTrue: [self writeMetaclassDefinition: definition]. definition hasComment ifTrue: [self writeClassComment: definition].! ! !MCStWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 02:23'! visitMethodDefinition: definition self writeMethodPreamble: definition. self writeMethodSource: definition. self writeMethodPostscript. self writeMethodInitializer: definition.! ! !MCStWriter methodsFor: 'visiting' stamp: 'cwp 8/2/2003 11:02'! visitOrganizationDefinition: defintion defintion categories do: [:cat | self writeCategory: cat]. ! ! !MCVersionInfoWriter methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 21:10'! isWritten: aVersionInfo ^ self written includes: aVersionInfo! ! !MCVersionInfoWriter methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 16:53'! writeVersionInfo: aVersionInfo (self isWritten: aVersionInfo) ifTrue: [^ stream nextPutAll: '(id ', aVersionInfo id asString printString, ')']. stream nextPut: $(. #(name message id date time author) do: [:sel | stream nextPutAll: sel. stream nextPut: $ . ((aVersionInfo perform: sel) ifNil: ['']) asString printOn: stream. stream nextPut: $ ]. stream nextPutAll: 'ancestors ('. aVersionInfo ancestors do: [:ea | self writeVersionInfo: ea]. stream nextPutAll: ') stepChildren ('. aVersionInfo stepChildren do: [:ea | self writeVersionInfo: ea]. stream nextPutAll: '))'. self wrote: aVersionInfo! ! !MCVersionInfoWriter methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 21:03'! written ^ written ifNil: [written _ Set new]! ! !MCVersionInfoWriter methodsFor: 'as yet unclassified' stamp: 'avi 1/22/2004 21:10'! wrote: aVersionInfo self written add: aVersionInfo! ! !MCWriter class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 15:00'! extension ^ self readerClass extension! ! !MCWriter class methodsFor: 'accessing' stamp: 'cwp 7/28/2003 23:46'! readerClass ^ self subclassResponsibility ! ! !MCWriter class methodsFor: 'writing' stamp: 'cwp 8/1/2003 01:16'! on: aStream ^ self new stream: aStream! ! !MCMczWriter class methodsFor: 'as yet unclassified' stamp: 'avi 2/17/2004 02:14'! fileOut: aVersion on: aStream | inst | inst _ self on: aStream. inst writeVersion: aVersion. inst flush. ! ! !MCMczWriter class methodsFor: 'as yet unclassified' stamp: 'avi 9/13/2004 18:03'! new ^ self basicNew initialize! ! !MCMczWriter class methodsFor: 'as yet unclassified' stamp: 'cwp 8/1/2003 12:35'! readerClass ^ MCMczReader! ! !MCMcdWriter class methodsFor: 'as yet unclassified' stamp: 'avi 2/13/2004 23:09'! readerClass ^ MCMcdReader! ! !MCStWriter class methodsFor: 'as yet unclassified' stamp: 'avi 1/20/2004 00:16'! readerClass ^ MCStReader! ! !MethodReference methodsFor: '*monticello' stamp: 'ab 8/22/2003 17:55'! asMethodDefinition ^ MCMethodDefinition forMethodReference: self! ! !MethodReference methodsFor: '*monticello' stamp: 'ab 8/22/2003 17:58'! category ^ self actualClass organization categoryOfElement: methodSymbol! ! !MethodReference methodsFor: '*monticello' stamp: 'ab 8/22/2003 17:58'! compiledMethod ^ self actualClass compiledMethodAt: methodSymbol! ! !MethodReference methodsFor: '*monticello' stamp: 'ab 8/22/2003 17:59'! source ^ (self actualClass sourceCodeAt: methodSymbol) asString withSqueakLineEndings! ! !MethodReference methodsFor: '*monticello' stamp: 'ab 8/22/2003 17:58'! timeStamp ^ self compiledMethod timeStamp! ! !MethodReference class methodsFor: '*monticello' stamp: 'cwp 8/2/2003 12:27'! class: aClass selector: aSelector ^ self new setStandardClass: aClass methodSymbol: aSelector! ! !PseudoClass methodsFor: '*monticello' stamp: 'avi 1/19/2004 21:18'! asClassDefinition ^ MCClassDefinition name: self name superclassName: self superclass name category: self category instVarNames: self instVarNames classVarNames: self classVarNames poolDictionaryNames: self poolDictionaryNames classInstVarNames: self class instVarNames type: self typeOfClass comment: self organization classComment asString commentStamp: self organization commentStamp ! ! !PseudoClass methodsFor: '*monticello-override' stamp: 'nk 2/18/2004 18:30'! isMeta ^false! ! !PseudoMetaclass methodsFor: '*monticello-override' stamp: 'nk 2/18/2004 18:30'! isMeta ^true! ! !Stream methodsFor: '*monticello' stamp: 'cwp 8/9/2003 12:02'! isMessageStream ^ false! ! !CrLfFileStream methodsFor: '*monticello' stamp: 'ab 6/26/2003 13:33'! lineEndingConvention: aSymbol lineEndConvention _ aSymbol! ! !String methodsFor: '*monticello' stamp: 'avi 2/4/2004 14:14'! extractNumber ^ ('0', self select: [:ea | ea isDigit]) asNumber! ! !Time class methodsFor: '*monticello' stamp: 'nk 11/2/2003 10:51'! fromString: aString ^ self readFrom: (ReadStream on: aString). ! ! !TimeStamp class methodsFor: '*monticello-instance creation' stamp: 'nk 10/21/2003 23:07'! fromMethodTimeStamp: aString | stream | stream _ ReadStream on: aString. stream skipSeparators. stream skipTo: Character space. ^self readFrom: stream.! ! !TimeStamp class methodsFor: '*monticello-instance creation' stamp: 'nk 10/21/2003 23:05'! fromString: aString "Answer a new instance for the value given by aString. TimeStamp fromString: '1-10-2000 11:55:00 am'. " ^self readFrom: (ReadStream on: aString).! ! !TimeStamp class methodsFor: '*monticello-instance creation' stamp: 'nk 10/21/2003 23:04'! readFrom: stream | date time | stream skipSeparators. date _ Date readFrom: stream. stream skipSeparators. time _ Time readFrom: stream. ^self date: date time: time! ! MCWorkingCopyBrowser initialize! MCWorkingCopy initialize! MCVersionReader initialize! MCFileRepositoryInspector initialize! MCCacheRepository initialize! MCRepository initialize! MCPackageManager initialize! MCMockPackageInfo initialize! MCMethodDefinition initialize! MCEmptyPackageInfo initialize! MCDirtyPackageInfo initialize!