'From Squeak3.11alpha of 13 February 2010 [latest update: #9711] on 16 September 2010 at 7:47:07 am'! !MCDependencySorter methodsFor: 'private' stamp: 'edc 7/11/2008 09:04'! removeRequirement: anObject required removeKey: anObject ifAbsent: [#()]. ! ! !MCFileRepositoryInspector methodsFor: 'private' stamp: 'edc 12/8/2006 11:20'! repository ^ repository! ! !MCMczReader methodsFor: 'as yet unclassified' stamp: 'edc 11/4/2009 11:32'! loadPackage | dict resources aFileName | dict := self parseMember: 'package'. resources := Dictionary new. (self zip membersMatching: 'resources/*') do: [:ea | aFileName := (ea fileName findTokens: '/') last. resources at: aFileName put: ea contentStream]. package := MCPackage named: (dict at: #name) resources: resources! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/7/2006 11:24'! basicNewChangeSet: newName Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs basicNewChangeSet: newName ]. (self changeSetNamed: newName) ifNotNil: [ self inform: 'Sorry that name is already used'. ^nil ]. ^ChangeSet basicNewNamed: newName.! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/7/2006 11:22'! changeSetNamed: newName Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ]. ^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/5/2006 07:26'! currentChangeSet "I copy from SARInstaller currentChangeSet " ^[ ChangeSet current ] on: MessageNotUnderstood do: [ :ex | ex return: Smalltalk changes ]! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/5/2006 07:28'! errorNoSuchMember: aMemberName (self confirm: 'No member named ', aMemberName, '. Do you want to stop loading?') == true ifTrue: [ self error: 'aborted' ].! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/7/2006 11:26'! fileInMemberNamed: csName "This is to be used from preamble/postscript code to file in zip members as ChangeSets." | cs | cs _ self zip memberNamed: csName. cs ifNil: [ ^self errorNoSuchMember: csName ]. self fileIntoChangeSetNamed: csName fromStream: cs contentStream text setConverterForCode. ! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 6/1/2009 09:05'! fileInMorphNamed: aName "This is to be used from preamble/postscript code to file in zip members as Morphs." | member object| member := self zip memberNamed: aName. object := member contentStream reset. ^ object fileInObjectAndCode! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 5/28/2009 08:58'! fileInObjectNamed: aName "This is to be used from preamble/postscript code to file in zip members as ChangeSets." | member aStream object| member := self zip memberNamed: aName. aStream := member contentStream binary setConverterForCode. object := (MultiByteBinaryOrTextStream with: (GZipReadStream on: aStream) upToEnd) reset. ^ object fileInObjectAndCode! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/5/2006 07:28'! fileIntoChangeSetNamed: aString fromStream: aStream "We let the user confirm filing into an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists. Duplicated from SMSimpleInstaller. Should be a class-side method." ^self withCurrentChangeSetNamed: aString do: [ :cs | | newName | newName := cs name. aStream setConverterForCode. aStream fileInAnnouncing: 'Loading ' , newName , ' into change set ''' , newName, ''''. aStream close]! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/7/2006 11:25'! newChanges: aChangeSet ^[ ChangeSet newChanges: aChangeSet ] on: MessageNotUnderstood do: [ :ex | ex return: (Smalltalk newChanges: aChangeSet) ]! ! !MCMczReader class methodsFor: 'sarMimic' stamp: 'edc 12/7/2006 11:21'! withCurrentChangeSetNamed: aString do: aOneArgumentBlock "Evaluate the one-argument block aOneArgumentBlock while the named change set is active. We let the user confirm operating on an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists. Duplicated from SMSimpleInstaller. Returns change set." | changeSet newName oldChanges | newName := aString. changeSet := self changeSetNamed: newName. changeSet ifNotNil: [newName := UIManager default request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' initialAnswer: newName. newName isEmpty ifTrue: [self error: 'Cancelled by user']. changeSet := self changeSetNamed: newName]. changeSet ifNil: [changeSet := self basicNewChangeSet: newName]. changeSet ifNil: [self error: 'User did not specify a valid ChangeSet name']. oldChanges := self currentChangeSet. [ self newChanges: changeSet. aOneArgumentBlock value: changeSet] ensure: [ self newChanges: oldChanges]. ^changeSet! ! !MCMczWriter methodsFor: 'visiting' stamp: 'edc 5/29/2009 11:04'! writeDefinitions: aVersion self writeSnapshot: aVersion snapshot! ! !MCMczWriter methodsFor: 'visiting' stamp: 'edc 5/27/2009 10:20'! writePostscript: postscript self addString: postscript at: 'install/postscript'! ! !MCMczWriter methodsFor: 'visiting' stamp: 'edc 5/27/2009 10:20'! writePreamble: preamble self addString: preamble at: 'install/preamble'! ! !MCMczWriter methodsFor: 'visiting' stamp: 'edc 11/7/2009 09:20'! writeResources: aVersion | resources member | resources := aVersion package resources. resources keysAndValuesDo: [:fname :file | member := (zip addString: file reset contents as: 'resources/' , fname). member desiredCompressionMethod: ZipArchive compressionDeflated]! ! !MCMczWriter methodsFor: 'visiting' stamp: 'edc 12/7/2006 11:03'! 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: 'edc 11/5/2009 06:14'! writeVersion: aVersion self writeFormat. self writePackage: aVersion package. self writeVersionInfo: aVersion info. self writeDefinitions: aVersion. aVersion dependencies do: [:ea | self writeVersionDependency: ea]. aVersion package hasResources ifTrue: [self writeResources: aVersion]! ! !MCMczWriter class methodsFor: 'as yet unclassified' stamp: 'edc 6/2/2009 09:56'! fileOut: aVersion on: aStream | inst | inst := self on: aStream. inst writeVersion: aVersion. inst flush! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'edc 12/2/2006 09:40'! hasResources ^ self packageInfo hasResources! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'edc 11/5/2009 11:14'! named: aString resources: aDict name := aString. self packageInfo resources: aDict! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'edc 12/2/2006 09:29'! resources ^ self packageInfo resources! ! !MCPackage methodsFor: 'as yet unclassified' stamp: 'edc 6/3/2009 11:43'! resources: aDict self packageInfo resources: aDict! ! !MCPackage class methodsFor: 'as yet unclassified' stamp: 'edc 6/3/2009 11:50'! named: aString resources: aDict | instance | instance := self new name: aString. instance resources: aDict. ^ instance! ! !MCPackageLoader methodsFor: 'private' stamp: 'edc 7/11/2008 09:39'! analyze | sorter solved | sorter := self sorterForItems: additions. additions := sorter orderedItems. requirements := sorter externalRequirements. solved := Set new. requirements do: [:cl | Object lookForClass: cl. sorter removeRequirement: cl. solved add: cl]. requirements := requirements difference: solved. unloadableDefinitions := sorter itemsWithMissingRequirements asSortedCollection. sorter := self sorterForItems: removals. removals := sorter orderedItems reversed ! ! !MCPackageLoader methodsFor: 'private' stamp: 'edc 2/13/2010 17:46'! useChangeSetNamed: baseName during: aBlock "Use the named change set, or create one with the given name." | changeHolder oldChanges newChanges csName | changeHolder := (ChangeSet respondsTo: #newChanges:) ifTrue: [ChangeSet] ifFalse: [Smalltalk]. oldChanges := (ChangeSet respondsTo: #current) ifTrue: [ChangeSet current] ifFalse: [Smalltalk changes]. self class changeHighestUpdate ifTrue: [csName := (SystemVersion current highestUpdate + 1) asString , baseName. newChanges := (ChangesOrganizer changeSetNamed: csName) ifNil: [ChangeSet new name: csName]. changeHolder newChanges: newChanges. [aBlock value] ensure: [changeHolder newChanges: oldChanges]. SystemVersion current registerUpdate: SystemVersion current highestUpdate + 1] ifFalse: [newChanges := (ChangesOrganizer changeSetNamed: baseName) ifNil: [ChangeSet new name: baseName]. changeHolder newChanges: newChanges. [aBlock value] ensure: [changeHolder newChanges: oldChanges]]! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'edc 9/29/2009 12:03'! changeHighestUpdate " MCPackageLoader changeHighestUpdate" "Whether change highestUpdate by default. If true, logs to a file named after the configuration (config.nn.log). If false, logs to the transcript." ^ChangeHIghUp ifNil:[ChangeHIghUp := false].! ! !MCPackageLoader class methodsFor: 'as yet unclassified' stamp: 'edc 10/1/2009 16:29'! setHighestUpdate: aBoolean " MCPackageLoader togleHighestUpdate" self changeHighestUpdate. ^ChangeHIghUp := aBoolean! ! !MCVersion methodsFor: 'actions' stamp: 'edc 12/2/2006 09:46'! fileOutOn: aStream self writerClass fileOut: self on: aStream. ! ! !MCVersion methodsFor: 'actions' stamp: 'edc 12/8/2006 11:15'! load: v fromDirectory: d MCMczReader loadVersionStream: v fromDirectory: d! ! !MCVersion methodsFor: 'initialize-release' stamp: 'edc 6/2/2009 09:54'! initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection . package := aPackage. info := aVersionInfo. snapshot := aSnapshot. dependencies := aCollection. self addToCache! ! !MCVersion methodsFor: 'testing' stamp: 'edc 5/29/2009 09:58'! hasPostscript snapshot definitions ifEmpty:[^false ]. ^ snapshot definitions last isKindOf: MCPostscriptDefinition! ! !MCVersion methodsFor: 'testing' stamp: 'edc 5/29/2009 09:58'! hasPreamble snapshot definitions ifEmpty:[^false ]. ^ snapshot definitions first isKindOf: MCPostscriptDefinition! ! !MCVersionLoader methodsFor: 'loading' stamp: 'edc 12/5/2006 09:25'! load | loader preamble postscript package | self checkForModifications. loader := MCPackageLoader new. versions do: [:ea | ea canOptimizeLoading ifTrue: [ea patch applyTo: loader] ifFalse: [loader updatePackage: ea package withSnapshot: ea snapshot]]. package := versions first package packageInfo . postscript := (versions first snapshot definitions last) isKindOf: MCPostscriptDefinition . postscript ifTrue:[ package postscript: (versions first snapshot definitions last) source]. preamble := (versions first snapshot definitions first) isKindOf: MCPreambleDefinition. preamble ifTrue:[ package preamble: (versions first snapshot definitions first) source]. loader loadWithNameLike: versions first info name. versions do: [:ea | ea workingCopy loaded: ea]! ! !MCWorkingCopy methodsFor: 'operations' stamp: 'edc 6/2/2009 10:51'! 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! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'edc 12/2/2006 11:17'! addResources workingCopy packageInfo addResources! ! !MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'edc 6/2/2009 10:58'! saveVersion | repo | self canSave ifFalse: [^ self]. self checkForNewerVersions ifFalse: [^ self]. repo := self repository. workingCopy newVersion ifNotNilDo: [:v | (MCVersionInspector new version: v) show. Cursor wait showWhile: [repo storeVersion: v]. MCCacheRepository default cacheAllFileNamesDuring: [repo cacheAllFileNamesDuring: [v allAvailableDependenciesDo: [:dep | (repo includesVersionNamed: dep info name) ifFalse: [repo storeVersion: dep]]]]]! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'edc 12/2/2006 11:10'! 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 add: 'add non code resources to this package' selector: #addResources argument: nil. menu popUpInWorld.! ! !MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'edc 5/29/2009 10:56'! editScript: scriptSymbol | setter title |. setter := (scriptSymbol , ':' asString) asSymbol. title := scriptSymbol asString , ' of the Package ' , workingCopy package name. UIManager default edit: (workingCopy packageInfo perform: scriptSymbol) label: title accept: [:aString | workingCopy packageInfo perform: setter with: aString]! !