[Pkg] Installer: Installer-Formats-kph.1.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Tue Feb 24 07:39:03 UTC 2009


A new version of Installer-Formats was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Formats-kph.1.mcz

==================== Summary ====================

Name: Installer-Formats-kph.1
Author: kph
Time: 24 February 2009, 7:38:59 am
UUID: 32eb046c-0246-11de-a647-000a95edb42a
Ancestors: 

+ adopt MczInstaller
+ adopt SARInstaller

1. These two classes become maintained external to the image
2. All images can be updated via LPF

Does not depend upon Installer (can be loaded standalone)

==================== Snapshot ====================

SystemOrganization addCategory: #'Installer-Formats'!

Model subclass: #SARInstaller
	instanceVariableNames: 'zip directory fileName installed'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Installer-Formats'!

!SARInstaller commentStamp: 'nk 7/5/2003 21:12' prior: 0!
I am an object that handles the loading of SAR (Squeak ARchive) files.

A SAR file is a Zip file that follows certain simple conventions:

* it may have a member named "install/preamble".

This member, if present, will be filed in as Smalltalk source code at the beginning of installation.
Typically, the code in the preamble will make whatever installation preparations are necessary,
and will then call methods in the "client services" method category to extract or install other zip members.

* It may have a member named "install/postscript".

This member, if present, will be filed in as Smalltalk source code at the end of installation.
Typically, the code in the postscript will set up the operating environment,
and will perhaps put objects in flaps, open projects or README files, or launch samples.

Within the code in the preamble and postscript, "self" is set to the instance of the SARInstaller.

If neither an "install/preamble" nor an "install/postscript" file is present,
all the members will be installed after prompting the user,
based on a best guess of the member file types that is based on member filename extensions.

This is new behavior.!

----- Method: SARInstaller class>>basicNewChangeSet: (in category 'change set utilities') -----
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.!

----- Method: SARInstaller class>>cardForSqueakMap: (in category 'SqueakMap') -----
cardForSqueakMap: aSqueakMap
	"Answer the current card or a new card."

	(aSqueakMap cardWithId: self squeakMapPackageID)
		ifNotNilDo: [ :card |
			(card installedVersion = self squeakMapPackageVersion) ifTrue: [ ^card ]
		].

	^self newCardForSqueakMap: aSqueakMap
!

----- Method: SARInstaller class>>changeSetNamed: (in category 'change set utilities') -----
changeSetNamed: newName
	Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ].
	^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].!

----- Method: SARInstaller class>>currentChangeSet (in category 'change set utilities') -----
currentChangeSet
	"Answer the current change set, in a way that should work in 3.5 as well"

	"SARInstaller currentChangeSet"

	^[ ChangeSet current ]
		on: MessageNotUnderstood
		do: [ :ex | ex return: Smalltalk changes ]!

----- Method: SARInstaller class>>directory:fileName: (in category 'instance creation') -----
directory: dir fileName: fn
	^(self new) directory: dir; fileName: fn; yourself.!

----- Method: SARInstaller class>>ensurePackageWithId: (in category 'package format support') -----
ensurePackageWithId: anIdString

	self squeakMapDo: [ :sm | | card newCS |
		self withCurrentChangeSetNamed: 'updates' do: [ :cs |
			newCS := cs.
			card := sm cardWithId: anIdString.
			(card isNil or: [ card isInstalled not or: [ card isOld ]])
				ifTrue: [ sm installPackageWithId: anIdString ]
		].
		newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ]
	].!

----- Method: SARInstaller class>>fileIntoChangeSetNamed:fromStream: (in category 'change set utilities') -----
fileIntoChangeSetNamed: aString fromStream: stream 
	"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.
			stream setConverterForCode.
			stream 
				fileInAnnouncing: 'Loading ' , newName , ' into change set ''' , newName, ''''.
			stream close]!

----- Method: SARInstaller class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
fileReaderServicesForFile: fullName suffix: suffix 

	^(suffix = 'sar') | (suffix = '*') 
		ifTrue: [Array with: self serviceFileInSAR]
		ifFalse: [#()]
!

----- Method: SARInstaller class>>initialize (in category 'class initialization') -----
initialize
	"SARInstaller initialize"
	(FileList respondsTo: #registerFileReader:)
		ifTrue: [ FileList registerFileReader: self ]!

----- Method: SARInstaller class>>installSAR: (in category 'class initialization') -----
installSAR: relativeOrFullName
	FileDirectory splitName: (FileDirectory default fullNameFor: relativeOrFullName)
		to: [ :dir :fileName | (self directory: (FileDirectory on: dir) fileName: fileName) fileIn ]!

----- Method: SARInstaller class>>loadDVS (in category 'package format support') -----
loadDVS
	"Load the DVS support from SqueakMap"

	self ensurePackageWithId: '100d59d0-bf81-4e74-a4fe-5a2fd0c6b4ec'!

----- Method: SARInstaller class>>loadMonticello (in category 'package format support') -----
loadMonticello
	"Load Monticello support (MCInstaller and Monticello) from SqueakMap"

	self ensurePackageWithId: 'af9d090d-2896-4a4e-82d0-c61cf2fdf40e'.
	self ensurePackageWithId: '66236497-7026-45f5-bcf6-ad00ba7a8a4e'.!

----- Method: SARInstaller class>>loadMonticelloCVS (in category 'package format support') -----
loadMonticelloCVS
	"Load MonticelloCVS support from SqueakMap"

	self ensurePackageWithId: '2be9f7e2-1de2-4eb6-89bd-ec9b60593a93'.
!

----- Method: SARInstaller class>>newCardForSqueakMap: (in category 'SqueakMap') -----
newCardForSqueakMap: aSqueakMap
	"Answer a new card."

	^(aSqueakMap newCardWithId: self squeakMapPackageID)
	created: 3236292323
	updated:3236292323
	name: 'SARInstaller for 3.6'
	currentVersion:'16'
	summary: 'Lets you load SAR (Squeak ARchive) files from SqueakMap and the File List. For 3.6 and later images.'
	description:'Support for installing SAR (Squeak ARchive) packages from SqueakMap and the File List.
For 3.6 and later images.

SMSARInstaller will use this if it''s present to load SAR packages.

Use SARBuilder for making these packages easily.'
	url: 'http://bike-nomad.com/squeak/'
	downloadUrl:'http://bike-nomad.com/squeak/SARInstallerFor36-nk.16.cs.gz'
	author: 'Ned Konz <ned at bike-nomad.com>'
	maintainer:'Ned Konz <ned at bike-nomad.com>'
	registrator:'Ned Konz <ned at bike-nomad.com>'
	password:240495131608326995113451940367316491071470713347
	categories: #('6ba57b6e-946a-4009-beaa-0ac93c08c5d1' '94277ca9-4d8f-4f0e-a0cb-57f4b48f1c8a' 'a71a6233-c7a5-4146-b5e3-30f28e4d3f6b' '8209da9b-8d6e-40dd-b23a-eb7e05d4677b' );
	modulePath: ''
	moduleVersion:''
	moduleTag:''
	versionComment:'v16: same as v16 of SARInstaller for 3.4 but doesn''t include any classes other than SARInstaller.

To be loaded into 3.6 images only. Will de-register the 3.4 version if it''s registered.

Added a default (DWIM) mode in which SAR files that are missing both a preamble and postscript have all their members loaded in a default manner.

Changed the behavior of #extractMemberWithoutPath: to use the same directory as the SAR itself.

Added #extractMemberWithoutPath:inDirectory:

Moved several change set methods to the class side.

Made change set methods work with 3.5 or 3.6a/b

Now supports the following file types:

Projects (with or without construction of a ViewMorph)
Genie gesture dictionaries
Change sets
DVS packages
Monticello packages
Graphics files (loaded as SketchMorphs)
Text files (loaded as text editor windows)
Morph(s) in files

Now keeps track of installed members.'!

----- Method: SARInstaller class>>newChanges: (in category 'change set utilities') -----
newChanges: aChangeSet
	"Change the current change set, in a way that should work in 3.5 as well"
	"SARInstaller newChanges: SARInstaller currentChangeSet"

	^[ ChangeSet newChanges: aChangeSet ]
		on: MessageNotUnderstood
		do: [ :ex | ex return: (Smalltalk newChanges: aChangeSet) ]!

----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') -----
serviceFileInSAR
	"Answer a service for opening a changelist browser on a file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'install SAR'
		selector: #installSAR:
		description: 'install this Squeak ARchive into the image.'
		buttonLabel: 'install'!

----- Method: SARInstaller class>>services (in category 'class initialization') -----
services
	^Array with: self serviceFileInSAR
!

----- Method: SARInstaller class>>squeakMapDo: (in category 'package format support') -----
squeakMapDo: aBlock
	"If SqueakMap is installed, evaluate aBlock with the default map.
	Otherwise, offer to install SqueakMap and continue."

	Smalltalk at: #SMSqueakMap ifPresent: [ :smClass | ^aBlock value: smClass default ].

	(self confirm: 'SqueakMap is not installed in this image.
Would you like to load it from the network?')
		ifTrue: [ TheWorldMenu loadSqueakMap.
			^self squeakMapDo: aBlock ].

	^nil!

----- Method: SARInstaller class>>squeakMapPackageID (in category 'SqueakMap') -----
squeakMapPackageID
	^'75c970ab-dca7-48ee-af42-5a013912c880'!

----- Method: SARInstaller class>>squeakMapPackageVersion (in category 'SqueakMap') -----
squeakMapPackageVersion
	^'16'!

----- Method: SARInstaller class>>unload (in category 'class initialization') -----
unload

	(FileList respondsTo: #unregisterFileReader:)
		ifTrue: [ FileList unregisterFileReader: self ]!

----- Method: SARInstaller class>>withCurrentChangeSetNamed:do: (in category 'change set utilities') -----
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!

----- Method: SARInstaller>>directory (in category 'accessing') -----
directory
	^directory!

----- Method: SARInstaller>>directory: (in category 'accessing') -----
directory: anObject
	directory := anObject!

----- Method: SARInstaller>>errorNoSuchMember: (in category 'private') -----
errorNoSuchMember: aMemberName
	(self confirm: 'No member named ', aMemberName, '. Do you want to stop loading?')
		== true ifTrue: [ self error: 'aborted' ].!

----- Method: SARInstaller>>extractMember: (in category 'client services') -----
extractMember: aMemberOrName
	"Extract aMemberOrName to a file using its filename"
	(self zip extractMember: aMemberOrName)
		ifNil: [ self errorNoSuchMember: aMemberOrName ]
		ifNotNil: [ self installed: aMemberOrName ].!

----- Method: SARInstaller>>extractMember:toFileNamed: (in category 'client services') -----
extractMember: aMemberOrName toFileNamed: aFileName
	"Extract aMemberOrName to a specified filename"
	(self zip extractMember: aMemberOrName toFileNamed: aFileName)
		ifNil: [ self errorNoSuchMember: aMemberOrName ]
		ifNotNil: [ self installed: aMemberOrName ].!

----- Method: SARInstaller>>extractMemberWithoutPath: (in category 'client services') -----
extractMemberWithoutPath: aMemberOrName
	"Extract aMemberOrName to its own filename, but ignore any directory paths, using my directory instead."
	self extractMemberWithoutPath: aMemberOrName inDirectory: self directory.
!

----- Method: SARInstaller>>extractMemberWithoutPath:inDirectory: (in category 'client services') -----
extractMemberWithoutPath: aMemberOrName inDirectory: aDirectory
	"Extract aMemberOrName to its own filename, but ignore any directory paths, using aDirectory instead"
	| member |
	member _ self memberNamed: aMemberOrName.
	member ifNil: [ ^self errorNoSuchMember: aMemberOrName ].
	self zip extractMemberWithoutPath: member inDirectory: aDirectory.
	self installed: member.!

----- Method: SARInstaller>>fileIn (in category 'fileIn') -----
fileIn
	"File in to a change set named like my file"
	| stream newCS |
	stream := directory readOnlyFileNamed: fileName.
	self class withCurrentChangeSetNamed: fileName
		do: [:cs | newCS := cs. self fileInFrom: stream].
	newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ]!

----- Method: SARInstaller>>fileInFrom: (in category 'fileIn') -----
fileInFrom: stream
	"The zip has been saved already by the download.
	Read the zip into my instvar, then file in the correct members"

	| preamble postscript |

	[
		stream position: 0.
		zip _ ZipArchive new readFrom: stream.

		preamble _ zip memberNamed: 'install/preamble'.
		preamble ifNotNil: [
			preamble contentStream text setConverterForCode fileInFor: self announcing: 'Preamble'.
			self class currentChangeSet preambleString: preamble contents.
		].

		postscript _ zip memberNamed: 'install/postscript'.
		postscript ifNotNil: [
			postscript contentStream text setConverterForCode fileInFor: self announcing: 'Postscript'.
			self class currentChangeSet postscriptString: postscript contents.
		].

		preamble isNil & postscript isNil ifTrue: [
			(self confirm: 'No install/preamble or install/postscript member were found.
	Install all the members automatically?') ifTrue: [ self installAllMembers ]
		].

	] ensure: [ stream close ].

!

----- Method: SARInstaller>>fileInGenieDictionaryNamed: (in category 'client services') -----
fileInGenieDictionaryNamed: memberName 
	"This is to be used from preamble/postscript code to file in zip 
	members as Genie gesture dictionaries.
	Answers a dictionary."

	| member object crDictionary stream |

	crDictionary _ Smalltalk at: #CRDictionary ifAbsent: [ ^self error: 'Genie not installed' ].
	"don't know how to recursively load"

	member _ self memberNamed: memberName.
	member ifNil: [ ^self errorNoSuchMember: memberName ].

	stream _ ReferenceStream on: member contentStream.

	[ object _ stream next ]
		on: Error do: 
		[:ex |  stream close.
		self inform: 'Error on loading: ' , ex description. ^ nil ].
	stream close.

	(object notNil and: [object name isEmptyOrNil])
		ifTrue: [object _ crDictionary name: object storedName].

	self installed: member.

	^ object
!

----- Method: SARInstaller>>fileInMCVersion:withBootstrap: (in category 'private') -----
fileInMCVersion: member withBootstrap: mcBootstrap
	"This will use the MCBootstrapLoader to load a (non-compressed) Monticello file (.mc or .mcv)"
	| newCS |
	self class withCurrentChangeSetNamed: member localFileName
		do: [ :cs | 
			newCS := cs.
			mcBootstrap loadStream: member contentStream ascii ].

	newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].

	World doOneCycle.

	self installed: member.!

----- Method: SARInstaller>>fileInMemberNamed: (in category 'client services') -----
fileInMemberNamed: csName
	"This is to be used from preamble/postscript code to file in zip members as ChangeSets."
	| cs |
	cs _ self memberNamed: csName.
	cs ifNil: [ ^self errorNoSuchMember: csName ].
	self class fileIntoChangeSetNamed: csName fromStream: cs contentStream text setConverterForCode.
	self installed: cs.
!

----- Method: SARInstaller>>fileInMonticelloPackageNamed: (in category 'client services') -----
fileInMonticelloPackageNamed: memberName 
	"This is to be used from preamble/postscript code to file in zip 
	members as Monticello packages (.mc)."

	| member file mcPackagePanel mcRevisionInfo mcSnapshot mcFilePackageManager mcPackage info snapshot newCS mcBootstrap |

	mcPackagePanel := Smalltalk at: #MCPackagePanel ifAbsent: [ ].
	mcRevisionInfo := Smalltalk at: #MCRevisionInfo ifAbsent: [ ].
	mcSnapshot := Smalltalk at: #MCSnapshot ifAbsent: [ ].
	mcFilePackageManager := Smalltalk at: #MCFilePackageManager ifAbsent: [ ].
	mcPackage := Smalltalk at: #MCPackage ifAbsent: [ ].
	member := self memberNamed: memberName.
	member ifNil: [ ^self errorNoSuchMember: memberName ].

	"We are missing MCInstaller, Monticello and/or MonticelloCVS.
	If the bootstrap is present, use it. Otherwise interact with the user."
	({ mcPackagePanel. mcRevisionInfo. mcSnapshot. mcFilePackageManager. mcPackage } includes: nil)
		ifTrue: [
			mcBootstrap := self getMCBootstrapLoaderClass.
			mcBootstrap ifNotNil: [ ^self fileInMCVersion: member withBootstrap: mcBootstrap ].

			(self confirm: ('Monticello support is not installed, but must be to load member named ', memberName, '.
Load it from SqueakMap?'))
				ifTrue: [ self class loadMonticello; loadMonticelloCVS.
					^self fileInMonticelloPackageNamed: memberName ]
				ifFalse: [ ^false ] ].

	member extractToFileNamed: member localFileName inDirectory: self directory.
	file := (Smalltalk at: #MCFile)
				name: member localFileName
				directory: self directory.

	self class withCurrentChangeSetNamed: file name do: [ :cs |
		newCS := cs.
		file readStreamDo: [ :stream |
			info := mcRevisionInfo readFrom: stream nextChunk.
			snapshot := mcSnapshot fromStream: stream ].
			snapshot install.
			(mcFilePackageManager forPackage:
				(mcPackage named: info packageName))
					file: file
		].

	newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].

	mcPackagePanel allSubInstancesDo: [ :ea | ea refresh ].
	World doOneCycle.

	self installed: member.
!

----- Method: SARInstaller>>fileInMonticelloVersionNamed: (in category 'client services') -----
fileInMonticelloVersionNamed: memberName 
	"This is to be used from preamble/postscript code to file in zip 
	members as Monticello version (.mcv) files."

	| member newCS mcMcvReader |
	mcMcvReader := Smalltalk at: #MCMcvReader ifAbsent: [].
	member := self memberNamed: memberName.
	member ifNil: [^self errorNoSuchMember: memberName].

	"If we don't have Monticello, offer to get it."
	mcMcvReader ifNil:  [
		(self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
Load it from SqueakMap?') 
			ifTrue:  [ self class loadMonticello.
						^self fileInMonticelloVersionNamed: memberName]
					ifFalse: [^false]].

	self class withCurrentChangeSetNamed: member localFileName
		do: 
			[:cs | 
			newCS := cs.
			(mcMcvReader versionFromStream: member contentStream ascii) load ].
	newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
	World doOneCycle.
	self installed: member!

----- Method: SARInstaller>>fileInMonticelloZipVersionNamed: (in category 'client services') -----
fileInMonticelloZipVersionNamed: memberName 
	"This is to be used from preamble/postscript code to file in zip 
	members as Monticello version (.mcz) files."

	| member mczInstaller newCS mcMczReader |
	mcMczReader := Smalltalk at: #MCMczReader ifAbsent: [].
	mczInstaller := Smalltalk at: #MczInstaller ifAbsent: [].
	member := self memberNamed: memberName.
	member ifNil: [^self errorNoSuchMember: memberName].

	"If we don't have Monticello, but have the bootstrap, use it silently."
	mcMczReader ifNil:  [
		mczInstaller ifNotNil: [ ^mczInstaller installStream: member contentStream ].
		(self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
Load it from SqueakMap?') 
			ifTrue:  [ self class loadMonticello.
						^self fileInMonticelloZipVersionNamed: memberName]
					ifFalse: [^false]].

	self class withCurrentChangeSetNamed: member localFileName
		do: 
			[:cs | 
			newCS := cs.
			(mcMczReader versionFromStream: member contentStream) load ].
	newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
	World doOneCycle.
	self installed: member!

----- Method: SARInstaller>>fileInMorphsNamed:addToWorld: (in category 'client services') -----
fileInMorphsNamed: memberName addToWorld: aBoolean
	"This will load the Morph (or Morphs) from the given member.
	Answers a Morph, or a list of Morphs, or nil if no such member or error.
	If aBoolean is true, also adds them and their models to the World."

	| member morphOrList |
	member _ self memberNamed: memberName.
	member ifNil: [ ^self errorNoSuchMember: memberName ].
	self installed: member.

	morphOrList _ member contentStream fileInObjectAndCode.
	morphOrList ifNil: [ ^nil ].
	aBoolean ifTrue: [ ActiveWorld addMorphsAndModel: morphOrList ].

	^morphOrList
!

----- Method: SARInstaller>>fileInPackageNamed: (in category 'client services') -----
fileInPackageNamed: memberName 
	"This is to be used from preamble/postscript code to file in zip 
	members as DVS packages."
	| member current new baseName imagePackageLoader packageInfo streamPackageLoader packageManager |
	member _ self zip memberNamed: memberName.
	member ifNil: [ ^self errorNoSuchMember: memberName ].

	imagePackageLoader _ Smalltalk at: #ImagePackageLoader ifAbsent: [].
	streamPackageLoader _ Smalltalk at: #StreamPackageLoader ifAbsent: [].
	packageInfo _ Smalltalk at: #PackageInfo ifAbsent: [].
	packageManager _ Smalltalk at: #FilePackageManager ifAbsent: [].

	"If DVS isn't present, do a simple file-in"
	(packageInfo isNil or: [imagePackageLoader isNil or: [streamPackageLoader isNil]])
		ifTrue: [ ^ self fileInMemberNamed: memberName ].

	baseName _ memberName copyReplaceAll: '.st' with: '' asTokens: false.
	(packageManager allManagers anySatisfy: [ :pm | pm packageName = baseName ])
		ifTrue: [
			current _ imagePackageLoader new package: (packageInfo named: baseName).
			new _ streamPackageLoader new stream: member contentStream ascii.
			(new changesFromBase: current) fileIn ]
		ifFalse: [ self class fileIntoChangeSetNamed: baseName fromStream: member contentStream ascii setConverterForCode. ].

	packageManager registerPackage: baseName.

	self installed: member.!

----- Method: SARInstaller>>fileInProjectNamed:createView: (in category 'client services') -----
fileInProjectNamed: projectOrMemberName createView: aBoolean 
	"This is to be used from preamble/postscript code to file in SAR members 
	as Projects. 
	Answers the loaded project, or nil. 
	Does not enter the loaded project. 
	If aBoolean is true, also creates a ProjectViewMorph 
	(possibly in a window, depending on your Preferences)."
	| member project triple memberName |
	member _ self memberNamed: projectOrMemberName.
	member
		ifNotNil: [ memberName _ member fileName ]
		ifNil: [ 	member _ self memberNamed: (memberName _ self memberNameForProjectNamed: projectOrMemberName) ].
	member ifNil: [ ^self errorNoSuchMember: projectOrMemberName ].
	triple _ Project parseProjectFileName: memberName unescapePercents.
	project _ nil.
	[[ProjectLoading
		openName: triple first
		stream: member contentStream
		fromDirectory: nil
		withProjectView: nil]
		on: ProjectViewOpenNotification
		do: [:ex | ex resume: aBoolean]]
		on: ProjectEntryNotification
		do: [:ex | 
			project _ ex projectToEnter.
			ex resume].
	self installed: member.
	^ project!

----- Method: SARInstaller>>fileInTrueTypeFontNamed: (in category 'client services') -----
fileInTrueTypeFontNamed: memberOrName

	| member description |
	member := self memberNamed: memberOrName.
	member ifNil: [^self errorNoSuchMember: memberOrName].

	description _ TTFontDescription addFromTTStream: member contentStream.
	TTCFont newTextStyleFromTT: description.

	World doOneCycle.
	self installed: member!

----- Method: SARInstaller>>fileIntoChangeSetNamed:fromStream: (in category 'fileIn') -----
fileIntoChangeSetNamed: aString fromStream: stream
	"Not recommended for new code"
	^self class fileIntoChangeSetNamed: aString fromStream: stream!

----- Method: SARInstaller>>fileName (in category 'accessing') -----
fileName
	^fileName!

----- Method: SARInstaller>>fileName: (in category 'accessing') -----
fileName: anObject
	fileName := anObject!

----- Method: SARInstaller>>getMCBootstrapLoaderClass (in category 'client services') -----
getMCBootstrapLoaderClass
	^Smalltalk at: #MCBootstrapLoader
		ifAbsent: 
			[(self memberNamed: 'MCBootstrapLoader.st') 
				ifNotNilDo: [:m | self fileInMemberNamed: m.
					Smalltalk at: #MCBootstrapLoader ifAbsent: []]]!

----- Method: SARInstaller>>importImage: (in category 'client services') -----
importImage: memberOrName
	| member form |
	member _ self memberNamed: memberOrName.
	member ifNil: [ ^self errorNoSuchMember: memberOrName ].
	form _ ImageReadWriter formFromStream: member contentStream binary.
	form ifNil: [ ^self ].
	Imports default importImage: form named: (FileDirectory localNameFor: member fileName) sansPeriodSuffix.
	self installed: member.!

----- Method: SARInstaller>>initialize (in category 'initialization') -----
initialize
	installed _ OrderedCollection new.!

----- Method: SARInstaller>>installAllMembers (in category 'fileIn') -----
installAllMembers
	"Try to install all the members, in order, based on their filenames and/or contents."
	| uninstalled |
	uninstalled _ OrderedCollection new.
	zip members do: [ :member | self installMember: member ].
	uninstalled _ self uninstalledMembers.
	uninstalled isEmpty ifTrue: [ ^self ].
	uninstalled inspect.!

----- Method: SARInstaller>>installMember: (in category 'client services') -----
installMember: memberOrName
	| memberName extension isGraphic stream member |
	member _ self memberNamed: memberOrName.
	member ifNil: [ ^false ].
	memberName _ member fileName.
	extension _ (FileDirectory extensionFor: memberName) asLowercase.
	Smalltalk at: #CRDictionary ifPresent: [ :crDictionary |
		(extension = crDictionary fileNameSuffix) ifTrue: [  self fileInGenieDictionaryNamed: memberName. ^true ] ].
	extension caseOf: {
		[ Project projectExtension ] -> [ self fileInProjectNamed: memberName createView: true ].
		[ FileStream st ] -> [ self fileInPackageNamed: memberName ].
		[ FileStream cs ] -> [  self fileInMemberNamed: memberName  ].
"		[ FileStream multiSt ] -> [  self fileInMemberNamedAsUTF8: memberName  ].
		[ FileStream multiCs ] -> [  self fileInMemberNamedAsUTF8: memberName  ].
"
		[ 'mc' ] -> [ self fileInMonticelloPackageNamed: memberName ].
		[ 'mcv' ] -> [ self fileInMonticelloVersionNamed: memberName ].
		[ 'mcz' ] -> [ self fileInMonticelloZipVersionNamed: memberName ].
		[ 'morph' ] -> [ self fileInMorphsNamed: member addToWorld: true ].
		[ 'ttf' ] -> [ self fileInTrueTypeFontNamed: memberName ].
		[ 'translation' ] -> [  self fileInMemberNamed: memberName  ].
	} otherwise: [
		('t*xt' match: extension) ifTrue: [ self openTextFile: memberName ]
			ifFalse: [ stream _ member contentStream.
		isGraphic _ ImageReadWriter understandsImageFormat: stream.
		stream reset.
		isGraphic
			ifTrue: [ self openGraphicsFile: member ]
			ifFalse: [ "now what?" ^false ]]
	].
	^true
!

----- Method: SARInstaller>>installed: (in category 'private') -----
installed: aMemberOrName
	self installedMembers add: (self zip member: aMemberOrName)!

----- Method: SARInstaller>>installedMemberNames (in category 'accessing') -----
installedMemberNames
	"Answer the names of the zip members that have been installed already."
	^self installedMembers collect: [ :ea | ea fileName ]!

----- Method: SARInstaller>>installedMembers (in category 'accessing') -----
installedMembers
	"Answer the zip members that have been installed already."
	^installed ifNil: [ installed _ OrderedCollection new ]!

----- Method: SARInstaller>>memberNameForProjectNamed: (in category 'client services') -----
memberNameForProjectNamed: projectName
	"Answer my member name for the given project, or nil.
	Ignores version numbers and suffixes, and also unescapes percents in filenames."

	^self zip memberNames detect: [ :memberName | | triple |
		triple _ Project parseProjectFileName: memberName unescapePercents.
		triple first asLowercase = projectName asLowercase
	] ifNone: [ nil ].!

----- Method: SARInstaller>>memberNamed: (in category 'client services') -----
memberNamed: aString
	^(zip member: aString)
		ifNil: [ | matching |
			matching _ zip membersMatching: aString.
			matching isEmpty ifFalse: [ matching last ]].!

----- Method: SARInstaller>>memberNames (in category 'accessing') -----
memberNames
	^self zip memberNames!

----- Method: SARInstaller>>membersMatching: (in category 'client services') -----
membersMatching: aString
	^self zip membersMatching: aString!

----- Method: SARInstaller>>openGraphicsFile: (in category 'client services') -----
openGraphicsFile: memberOrName
	| member morph |
	member _ self memberNamed: memberOrName.
	member ifNil: [ ^self errorNoSuchMember: memberOrName ].
	morph _ (World drawingClass fromStream: member contentStream binary).
	morph ifNotNil: [ morph openInWorld ].
	self installed: member.!

----- Method: SARInstaller>>openTextFile: (in category 'client services') -----
openTextFile: memberOrName
	"Open a text window on the given member"
	| member |
	member _ self memberNamed: memberOrName.
	member ifNil: [ ^self errorNoSuchMember: memberOrName ].
	StringHolder new
		acceptContents: member contents;
		openLabel: member fileName.
	self installed: member.!

----- Method: SARInstaller>>prependedDataSize (in category 'client services') -----
prependedDataSize
	^self zip prependedDataSize!

----- Method: SARInstaller>>uninstalledMemberNames (in category 'accessing') -----
uninstalledMemberNames
	"Answer the names of the zip members that have not yet been installed."
	^self uninstalledMembers collect: [ :ea | ea fileName ]!

----- Method: SARInstaller>>uninstalledMembers (in category 'accessing') -----
uninstalledMembers
	"Answer the zip members that haven't been installed or extracted yet."
	^zip members copyWithoutAll: self installedMembers!

----- Method: SARInstaller>>zip (in category 'accessing') -----
zip
	^zip!

----- Method: SARInstaller>>zip: (in category 'accessing') -----
zip: anObject
	^zip := anObject!

----- Method: SARInstaller>>zipFileComment (in category 'client services') -----
zipFileComment
	^self zip zipFileComment!

Object subclass: #MczInstaller
	instanceVariableNames: 'stream fileName zip'
	classVariableNames: 'Versions'
	poolDictionaries: ''
	category: 'Installer-Formats'!

----- Method: MczInstaller class>>clearVersionInfo (in category 'versionInfo') -----
clearVersionInfo
	Versions _ Dictionary new!

----- Method: MczInstaller class>>extension (in category 'services') -----
extension
	^ 'mcz'!

----- Method: MczInstaller class>>fileReaderServicesForFile:suffix: (in category 'services') -----
fileReaderServicesForFile: fileName suffix: suffix
	^({ self extension. '*' } includes: suffix)
		ifTrue: [ self services ]
		ifFalse: [#()].
!

----- Method: MczInstaller class>>initialize (in category 'services') -----
initialize
	self clearVersionInfo.
	self registerForFileList.!

----- Method: MczInstaller class>>install:stream: (in category 'installing') -----
install: fileName stream: aStream
	(self on: aStream) fileName: fileName; install!

----- Method: MczInstaller class>>installFileNamed: (in category 'installing') -----
installFileNamed: aFileName
	self install: aFileName stream: (FileStream readOnlyFileNamed: aFileName)!

----- Method: MczInstaller class>>installStream: (in category 'installing') -----
installStream: aStream
	self deprecated: 'use install: aFileName stream: aStream'.
 
	(self on: aStream) install!

----- Method: MczInstaller class>>loadVersionFile: (in category 'services') -----
loadVersionFile: fileName
	self installFileNamed: fileName
!

----- Method: MczInstaller class>>on: (in category 'instance creation') -----
on: aStream
	^ self new stream: aStream!

----- Method: MczInstaller class>>registerForFileList (in category 'services') -----
registerForFileList
	Smalltalk at: #MCReader ifAbsent: [FileList registerFileReader: self]!

----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') -----
serviceLoadVersion
	^ SimpleServiceEntry
		provider: self
		label: 'load'
		selector: #loadVersionFile:
		description: 'load a package version'!

----- Method: MczInstaller class>>services (in category 'services') -----
services
	^ Array with: self serviceLoadVersion!

----- Method: MczInstaller class>>storeVersionInfo: (in category 'versionInfo') -----
storeVersionInfo: aVersion
	Versions 
		at: aVersion package name
		put: aVersion info asDictionary!

----- Method: MczInstaller class>>unloadMonticello (in category 'versionInfo') -----
unloadMonticello
	"self unloadMonticello"
	Utilities breakDependents.
	
	Smalltalk at: #MCWorkingCopy ifPresent:
		[:wc | 
		wc allInstances do:
			[:ea | 
			Versions at: ea package name put: ea currentVersionInfo asDictionary.
			ea breakDependents.
			Smalltalk at: #SystemChangeNotifier ifPresent: [:scn | scn uniqueInstance noMoreNotificationsFor: ea]]
	displayingProgress: 'Saving version info...'].
	
	"keep things simple and don't unload any class extensions"
	(ChangeSet superclassOrder: ((PackageInfo named: 'Monticello') classes)) reverseDo:
		[:ea | 
		ea removeFromSystem].
	
	self registerForFileList.!

----- Method: MczInstaller class>>versionInfo (in category 'versionInfo') -----
versionInfo
	^ Versions!

----- Method: MczInstaller>>associate: (in category 'utilities') -----
associate: tokens
	| result |
	result _ Dictionary new.
	tokens pairsDo: [:key :value | 
					value isString ifFalse: [value _ value collect: [:ea | self associate: ea]].
					value = 'nil' ifTrue: [value _ ''].
					result at: key put: value].
	^ result!

----- Method: MczInstaller>>checkDependencies (in category 'utilities') -----
checkDependencies
	| dependencies unmet |
	dependencies _ (zip membersMatching: 'dependencies/*') 
			collect: [:member | self extractInfoFrom: (self parseMember: member)].
	unmet _ dependencies reject: [:dep |
		self versions: Versions anySatisfy: (dep at: #id)].
	^ unmet isEmpty or: [
		self confirm: (String streamContents: [:s|
			s nextPutAll: 'The following dependencies seem to be missing:'; cr.
			unmet do: [:each | s nextPutAll: (each at: #name); cr].
			s nextPutAll: 'Do you still want to install this package?'])]!

----- Method: MczInstaller>>extractInfoFrom: (in category 'utilities') -----
extractInfoFrom: dict
	dict at: #id put: (UUID fromString: (dict at: #id)).
	dict at: #date ifPresent: [:d | d isEmpty ifFalse: [dict at: #date put: (Date fromString: d)]].
	dict at: #time ifPresent: [:t | t isEmpty ifFalse: [dict at: #time put: (Time readFrom: t readStream)]].
	dict at: #ancestors ifPresent: [:a | dict at: #ancestors put: (a collect: [:ea | self extractInfoFrom: ea])].
	^ dict!

----- Method: MczInstaller>>extractPackageName (in category 'accessing') -----
extractPackageName
	^ (self parseMember: 'package') at: #name.
	!

----- Method: MczInstaller>>extractVersionInfo (in category 'accessing') -----
extractVersionInfo
	^ self extractInfoFrom: (self parseMember: 'version')!

----- Method: MczInstaller>>fileName: (in category 'accessing') -----
fileName: aFileName
	fileName := aFileName!

----- Method: MczInstaller>>install (in category 'installation') -----
install
	| sources |
	
	self unregisterPackage.
	
	zip _ ZipArchive new.
	zip readFrom: stream.
	self checkDependencies ifFalse: [^false].
	self recordVersionInfo.
	sources _ (zip membersMatching: 'snapshot/*') 
				asSortedCollection: [:a :b | a fileName < b fileName].
	sources do: [:src | self installMember: src].!

----- Method: MczInstaller>>installMember: (in category 'installation') -----
installMember: member
	 | str |
	self useNewChangeSetDuring:
		[str _ member contentStream text.
		str setConverterForCode.
		str fileInAnnouncing: 'booting ', (fileName ifNil: [ member fileName ])]!

----- Method: MczInstaller>>packageName (in category 'installation') -----
packageName
	
	^ fileName copyUpToLast: $-.
!

----- Method: MczInstaller>>parseMember: (in category 'utilities') -----
parseMember: fileName
	| tokens |
	tokens _ (self scanner scanTokens: (zip contentsOf: fileName)) first.
	^ self associate: tokens!

----- Method: MczInstaller>>recordVersionInfo (in category 'accessing') -----
recordVersionInfo
	Versions 
		at: self extractPackageName 
		put: self extractVersionInfo!

----- Method: MczInstaller>>scanner (in category 'accessing') -----
scanner
	^ Scanner new!

----- Method: MczInstaller>>stream: (in category 'accessing') -----
stream: aStream
	stream _ aStream!

----- Method: MczInstaller>>unregisterPackage (in category 'installation') -----
unregisterPackage
	
	| pkg |
	pkg := self packageName.
	
	((Smalltalk at: #MCWorkingCopy ifAbsent: [ ^ nil ])
		allManagers select:  [:each | each packageName = pkg ] ) do: [ :ea | ea unregister ].

!

----- Method: MczInstaller>>useNewChangeSetDuring: (in category 'utilities') -----
useNewChangeSetDuring: aBlock
	| changeHolder oldChanges newChanges |
	changeHolder _ (ChangeSet respondsTo: #newChanges:)
						ifTrue: [ChangeSet]
						ifFalse: [Smalltalk].
	oldChanges _ (ChangeSet respondsTo: #current)
						ifTrue: [ChangeSet current]
						ifFalse: [Smalltalk changes].

	newChanges _ ChangeSet new name: (ChangeSet uniqueNameLike: self extractPackageName).
	changeHolder newChanges: newChanges.
	[aBlock value] ensure: [changeHolder newChanges: oldChanges].!

----- Method: MczInstaller>>versions:anySatisfy: (in category 'utilities') -----
versions: aVersionList anySatisfy: aDependencyID
	^ aVersionList anySatisfy: [:version | 
			aDependencyID = (version at: #id)
				or: [self versions: (version at: #ancestors) anySatisfy: aDependencyID]]!



More information about the Packages mailing list