'From Squeak3.6beta of ''4 July 2003'' [latest update: #5352] on 22 July 2003 at 7:35:04 am'! "Change Set: SARInstallerFor36-nk Date: 21 July 2003 Author: Ned Konz 22 July fixed postscript 21 July (v16) Packaged as a separate package (identical to the v16 version of the SARInstaller for 3.4) with only SARInstaller methods. Added SqueakMap magic in postscript. Fixed a bug in the DVS file-in. 5 July: Adds 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. Changes 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. "! Model subclass: #SARInstaller instanceVariableNames: 'zip directory fileName installed ' classVariableNames: '' poolDictionaries: '' category: 'SARInstaller'! !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.! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! directory ^directory! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! directory: anObject directory := anObject! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! fileName ^fileName! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! fileName: anObject fileName := anObject! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 7/5/2003 23:01'! installedMemberNames "Answer the names of the zip members that have been installed already." ^self installedMembers collect: [ :ea | ea fileName ]! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 7/10/2003 16:53'! installedMembers "Answer the zip members that have been installed already." ^installed ifNil: [ installed _ OrderedCollection new ]! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 7/5/2003 21:57'! memberNames ^self zip memberNames! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 7/5/2003 23:00'! uninstalledMemberNames "Answer the names of the zip members that have not yet been installed." ^self uninstalledMembers collect: [ :ea | ea fileName ]! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 7/10/2003 16:55'! uninstalledMembers "Answer the zip members that haven't been installed or extracted yet." ^zip members copyWithoutAll: self installedMembers! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! zip ^zip! ! !SARInstaller methodsFor: 'accessing' stamp: 'nk 10/25/2002 12:16'! zip: anObject ^zip := anObject! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:25'! extractMember: aMemberOrName "Extract aMemberOrName to a file using its filename" (self zip extractMember: aMemberOrName) ifNil: [ self errorNoSuchMember: aMemberOrName ] ifNotNil: [ self installed: aMemberOrName ].! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:25'! extractMember: aMemberOrName toFileNamed: aFileName "Extract aMemberOrName to a specified filename" (self zip extractMember: aMemberOrName toFileNamed: aFileName) ifNil: [ self errorNoSuchMember: aMemberOrName ] ifNotNil: [ self installed: aMemberOrName ].! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:40'! extractMemberWithoutPath: aMemberOrName "Extract aMemberOrName to its own filename, but ignore any directory paths, using my directory instead." self extractMemberWithoutPath: aMemberOrName inDirectory: self directory. ! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:40'! 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.! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:26'! 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 ! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/10/2003 16:52'! 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 ascii. self installed: cs. ! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/21/2003 12:36'! fileInMonticelloPackageNamed: memberName "This is to be used from preamble/postscript code to file in zip members as Monticello packages." | member file revision mcPackageRevision mcFilePackageManager mcPackagePanel | mcPackagePanel _ Smalltalk at: #MCPackagePanel ifAbsent: [ ]. mcPackageRevision _ Smalltalk at: #MCPackageRevision ifAbsent: [ ]. mcFilePackageManager _ Smalltalk at: #MCFilePackageManager ifAbsent: [ ]. (mcPackagePanel isNil or: [ mcPackageRevision isNil or: [ mcFilePackageManager isNil ]]) ifTrue: [ self error: 'Monticello not installed' ]. "don't know how to recursively load" member _ self memberNamed: memberName. member ifNil: [ ^self errorNoSuchMember: memberName ]. self extractMember: memberName. file := FileStream readOnlyFileNamed: member localFileName. mcPackagePanel useTemporaryChangeSetNamedLike: file localName while: [ revision _ mcPackageRevision fromStream: file. revision load. (mcFilePackageManager named: revision info packageName) directory: file directory. file close. ]. mcPackagePanel allSubInstancesDo: [ :ea | ea refresh ]. World doOneCycleNow. self installed: member. ! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:27'! 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 ! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/21/2003 12:37'! 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 | 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: []. (packageInfo isNil or: [imagePackageLoader isNil or: [streamPackageLoader isNil]]) ifTrue: [^ self fileInMemberNamed: memberName]. baseName _ memberName copyReplaceAll: '.st' with: '' asTokens: false. current _ imagePackageLoader new package: (packageInfo named: baseName). new _ streamPackageLoader new stream: member contentStream ascii. (new changesFromBase: current) fileIn. self installed: member.! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:28'! 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 member: 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! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 10:02'! 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 ].! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 21:40'! memberNamed: aString ^zip member: aString! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 10/27/2002 10:34'! membersMatching: aString ^self zip membersMatching: aString! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:28'! openGraphicsFile: memberOrName | member morph | member _ self memberNamed: memberOrName. member ifNil: [ ^self errorNoSuchMember: memberOrName ]. morph _ (SketchMorph fromStream: member contentStream binary). morph ifNotNil: [ morph openInWorld ]. self installed: member.! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 7/5/2003 22:28'! 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.! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 10/27/2002 10:36'! prependedDataSize ^self zip prependedDataSize! ! !SARInstaller methodsFor: 'client services' stamp: 'nk 10/27/2002 10:35'! zipFileComment ^self zip zipFileComment! ! !SARInstaller methodsFor: 'fileIn' stamp: 'nk 7/5/2003 22:56'! fileIn "File in to a change set named like my file" | stream | stream := directory readOnlyFileNamed: fileName. self class withCurrentChangeSetNamed: fileName sansPeriodSuffix do: [:cs | self fileInFrom: stream]! ! !SARInstaller methodsFor: 'fileIn' stamp: 'nk 7/5/2003 22:49'! 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 ascii fileInFor: self announcing: 'Preamble'. self class currentChangeSet preambleString: preamble contents. ]. postscript _ zip memberNamed: 'install/postscript'. postscript ifNotNil: [ postscript contentStream ascii 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 ]. ! ! !SARInstaller methodsFor: 'fileIn' stamp: 'nk 7/5/2003 22:29'! installAllMembers "Try to install all the members, in order, based on their filenames and/or contents." | uninstalled | uninstalled _ OrderedCollection new. zip members do: [ :member | | extension isGraphic stream | extension _ (FileDirectory extensionFor: member fileName) asLowercase. extension caseOf: { [ Project projectExtension ] -> [ self fileInProjectNamed: member createView: true ]. [ CRDictionary fileNameSuffix ] -> [ self fileInGenieDictionaryNamed: member ]. [ 'st' ] -> [ self fileInPackageNamed: member ]. [ 'cs' ] -> [ self fileInMemberNamed: member ]. [ 'mc' ] -> [ self fileInMonticelloPackageNamed: member ]. [ 'morph' ] -> [ self fileInMorphsNamed: member addToWorld: true ]. } otherwise: [ ('t*xt' match: extension) ifTrue: [ self openTextFile: member ]. stream _ member contentStream. isGraphic _ ImageReadWriter understandsImageFormat: stream. stream reset. isGraphic ifTrue: [ self openGraphicsFile: member ] ifFalse: [ "now what?" ] ] ]. uninstalled _ self uninstalledMembers. uninstalled isEmpty ifTrue: [ ^self ]. uninstalled inspect.! ! !SARInstaller methodsFor: 'private' stamp: 'nk 7/5/2003 21:44'! errorNoSuchMember: aMemberName self error: 'no member named ', aMemberName! ! !SARInstaller methodsFor: 'private' stamp: 'nk 7/10/2003 16:55'! installed: aMemberOrName self installedMembers add: (self zip member: aMemberOrName)! ! !SARInstaller methodsFor: 'initialization' stamp: 'nk 7/5/2003 22:24'! initialize installed _ OrderedCollection new.! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 11/13/2002 07:33'! fileReaderServicesForFile: fullName suffix: suffix ^(suffix = 'sar') | (suffix = '*') ifTrue: [Array with: self serviceFileInSAR] ifFalse: [#()] ! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 7/5/2003 22:22'! initialize "SARInstaller initialize" (FileList respondsTo: #registerFileReader:) ifTrue: [ FileList registerFileReader: self ]! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 7/5/2003 21:05'! installSAR: relativeOrFullName FileDirectory splitName: (FileDirectory default fullNameFor: relativeOrFullName) to: [ :dir :fileName | (self directory: (FileDirectory on: dir) fileName: fileName) fileIn ]! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 11/13/2002 07:35'! 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'! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 11/21/2002 09:46'! services ^Array with: self serviceFileInSAR ! ! !SARInstaller class methodsFor: 'class initialization' stamp: 'nk 7/5/2003 22:22'! unload (FileList respondsTo: #unregisterFileReader:) ifTrue: [ FileList unregisterFileReader: self ]! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 10/27/2002 12:44'! basicNewChangeSet: newName Smalltalk at: #ChangeSorter ifPresentAndInMemory: [ :cs | ^cs basicNewChangeSet: newName ]. (self changeSetNamed: newName) ifNotNil: [ self inform: 'Sorry that name is already used'. ^nil ]. ^ChangeSet basicNewNamed: newName.! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 10/27/2002 12:44'! changeSetNamed: newName Smalltalk at: #ChangeSorter ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ]. ^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 7/5/2003 22:49'! 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 ]! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 7/5/2003 22:58'! 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 fileInAnnouncing: 'Loading ' , newName , ' into change set ''' , newName, ''''. stream close]! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 7/5/2003 22:51'! 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) ]! ! !SARInstaller class methodsFor: 'change set utilities' stamp: 'nk 7/5/2003 22:56'! 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 := FillInTheBlank 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! ! !SARInstaller class methodsFor: 'instance creation' stamp: 'nk 10/27/2002 10:29'! directory: dir fileName: fn ^(self new) directory: dir; fileName: fn; yourself.! ! !SARInstaller class methodsFor: 'instance creation' stamp: 'nk 7/5/2003 22:23'! new ^(super new) initialize; yourself! ! !SARInstaller class methodsFor: 'SqueakMap' stamp: 'nk 7/21/2003 17:21'! 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 ! ! !SARInstaller class methodsFor: 'SqueakMap' stamp: 'nk 7/21/2003 17:17'! 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 ' maintainer:'Ned Konz ' registrator:'Ned Konz ' 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.'! ! !SARInstaller class methodsFor: 'SqueakMap' stamp: 'nk 7/21/2003 17:16'! squeakMapPackageID ^'75c970ab-dca7-48ee-af42-5a013912c880'! ! !SARInstaller class methodsFor: 'SqueakMap' stamp: 'nk 7/21/2003 17:18'! squeakMapPackageVersion ^'16'! ! SARInstaller initialize! SARInstaller removeSelector: #fileIntoChangeSetNamed:fromStream:! SARInstaller removeSelector: #withCurrentChangeSetNamed:do:! "Postscript:" "If SqueakMap is present, unregister package 'SARInstaller for 3.4' and register package 'SARInstaller for 3.6'" Smalltalk at: #SMSqueakMap ifPresent: [ :smSqueakMap | | map mapDict old new | map _ smSqueakMap default. "forget about the installed 3.4 version if we can" old _ map cardWithId: '16dff307-ff49-4996-a216-957989e92d48'. old ifNotNil: [ mapDict _ (map respondsTo: #installedPackagesDictionary) ifTrue: [ map installedPackagesDictionary ] ifFalse: [ (smSqueakMap allInstVarNames includes: 'installedPackages') ifTrue: [ map installedPackages. map instVarNamed: 'installedPackages' ]]. mapDict ifNotNil: [ mapDict removeKey: old id ifAbsent: [] ]. ]. "And install 3.6 one" SMSqueakMap default noteInstalledPackage: '75c970ab-dca7-48ee-af42-5a013912c880' version: '16'. ]. !