[squeak-dev] The Trunk: SMBase-gk.109.mczcommits at source.squeak.org commits at source.squeak.orgSun Apr 11 21:02:42 UTC 2010
Göran Krampe uploaded a new version of SMBase to project The Trunk: http://source.squeak.org/trunk/SMBase-gk.109.mcz ==================== Summary ==================== Name: SMBase-gk.109 Author: gk Time: 11 April 2010, 11:01:20 pm UUID: f2deba90-73b7-422a-a783-547c1353571d Ancestors: SMBase-gk.108, SMBase-gk.90 - Added #oldReload to be able to load an old map using ImageSegments. Only to be used when switching on the server. And a bunch of fixes from a long time back: 2006, Doug Way: - A bunch of additions and cleanups for the SMPackage and SMPackageRelease full descriptions which appear in the package loader. 2008, Göran Krampe: - Fix in default installer for text file converter. 2009, Göran Krampe: -Added #isPurged and fix in synchWithDisk to avoid problems with a purged map when there is no map on disk (fresh install) - Fix included from http://bugs.squeak.org/view.php?id=7201 =============== Diff against SMBase-gk.108 =============== Item was changed: ----- Method: SMSqueakMap>>synchWithDisk (in category 'private') ----- synchWithDisk "Synchronize myself with the checkpoints on disk. If there is a newer checkpoint than I know of, load it. If there is no checkpoint or if I have a higher checkpoint number, create a new checkpoint from me. The end result is that I am in synch with the disk and we are both as updated as possible." | checkpointNumberOnDisk | "If there is no checkpoint, save one from me." + (self isCheckpointAvailable) ifFalse: [ + "If I am purged - don't checkpoint, no point" + self isPurged ifTrue: [^self]. + ^self createCheckpointNumber: checkpointNumber]. - (self isCheckpointAvailable) ifFalse: [^self createCheckpointNumber: checkpointNumber]. "If the one on disk is newer, load it" checkpointNumberOnDisk := self lastCheckpointNumberOnDisk. (checkpointNumber < checkpointNumberOnDisk) ifTrue: [^self reload]. "If I am newer, recreate me on disk" (checkpointNumberOnDisk < checkpointNumber) ifTrue: [^self createCheckpointNumber: checkpointNumber]! Item was changed: ----- Method: SMDefaultInstaller>>fileIn (in category 'private') ----- fileIn "Installing in the standard installer is simply filing in. Both .st and .cs files will file into a ChangeSet of their own. We let the user confirm filing into an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists." | fileStream | (self class nonMultiSuffixes anySatisfy: [:each | unpackedFileName endsWith: (FileDirectory dot, each)]) ifTrue:[ fileStream := dir readOnlyFileNamed: unpackedFileName. + (fileStream respondsTo: #setConverterForCode) ifTrue: [fileStream setConverterForCode]. - (fileStream respondsTo: #setConverterCode) ifTrue: [fileStream setConverterForCode]. self fileIntoChangeSetNamed: (fileStream localName sansPeriodSuffix) fromStream: fileStream. ^self]. (self class multiSuffixes anySatisfy: [:each | unpackedFileName endsWith: (FileDirectory dot, each)]) ifTrue:[ fileStream := dir readOnlyFileNamed: unpackedFileName. "Only images with converters should have multi suffixes" fileStream converter: (Smalltalk at: #UTF8TextConverter) new. self fileIntoChangeSetNamed: (fileStream localName sansPeriodSuffix) fromStream: fileStream. ^self]. self error: 'Filename should end with a proper extension'. ! Item was changed: ----- Method: SMDependencyAnalysis>>removeOlderReleasesIn: (in category 'private') ----- removeOlderReleasesIn: collectionOfReleases "Remove older multiple releases of the same package. 2 scans to retain order." + | newestReleases rel | - | newestReleases | newestReleases := Dictionary new. collectionOfReleases do: [:r | + rel := newestReleases at: r package ifAbsentPut: [r]. - | rel | - rel := newestReleases at: r package ifAbsent: [newestReleases at: r package put: r]. (r newerThan: rel) ifTrue: [newestReleases at: r package put: r]]. ^collectionOfReleases select: [:r | (newestReleases at: r package) == r]! Item was added: + ----- Method: SMSqueakMap>>oldReload (in category 'private') ----- + oldReload + "Reload the map from the latest checkpoint on disk. + The opposite of #purge." + + | fname stream map | + fname := self directory lastNameFor: self filename extension: 'sgz'. + fname ifNil: [self error: 'No ImageSegment checkpoint available!!']. + stream := (StandardFileStream oldFileNamed: (self directory fullNameFor: fname)) asUnZippedStream. + stream ifNil: [self error: 'Couldn''t open stream on checkpoint file!!']. + [map := (stream fileInObjectAndCode) install arrayOfRoots first] ensure: [stream close]. + self copyFrom: map! Item was changed: ----- Method: SMSqueakMap>>categories (in category 'accessing') ----- categories "Lazily maintain a cache of all known category objects." categories ifNotNil: [^categories]. + objects isNil ifTrue: [ ^ #() ]. categories := objects select: [:o | o isCategory]. ^categories! Item was changed: ----- Method: SMInstaller classSide>>changeSetNamed: (in category 'changeset utilities') ----- changeSetNamed: newName "This method copied here to ensure SqueakMap is independent of ChangesOrganizer." + Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ]. - Smalltalk at: #ChangesOrganizer ifPresent: [ :cs | ^cs changeSetNamed: newName ]. ^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].! Item was changed: ----- Method: SMPackageRelease>>fullDescription (in category 'printing') ----- fullDescription "Return a full textual description of the package release." | s | s := TextStream on: (Text new: 400). + self describe: self package name withBoldLabel: 'Package Name: ' on: s. + name isEmptyOrNil ifFalse: + [self describe: self name withBoldLabel: 'Release Name: ' on: s]. + summary isEmptyOrNil ifFalse: + [self describe: self summary withBoldLabel: 'Release Summary: ' on: s]. - self describe: self package name withBoldLabel: 'Package name: ' on: s. self describe: self version + withBoldLabel: 'Version: ' - withBoldLabel: 'version: ' on: s. categories isEmptyOrNil ifFalse: [s cr; withAttribute: TextEmphasis bold do: [s nextPutAll: 'Categories: ']; cr. + (self categories asSortedCollection: [:a :b | a path < b path]) + do: [:c | - self categoriesDo: - [:c | s tab; withAttribute: TextEmphasis italic do: [c parentsDo: [:p | s nextPutAll: p name; nextPutAll: '/']. s nextPutAll: c name]; nextPutAll: ' - ' , c summary; cr]. s cr]. + created ifNotNil: [ + s + withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Created: ' ]; + print: self created; + cr]. + updated ifNotNil: [ + s + withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Modified: ' ]; + print: self updated; + cr]. + publisher ifNotNil: [ + s + withAttribute: TextEmphasis bold + do: [s nextPutAll: 'Publisher: ']. + s + withAttribute: (PluggableTextAttribute + evalBlock: [self userInterface + sendMailTo: self publisher email + regardingPackageRelease: self]) + do: [s nextPutAll: self publisher nameAndEmail]; + cr]. + self note isEmptyOrNil ifFalse: [s cr; withAttribute: TextEmphasis bold do: [s nextPutAll: 'Version Comment:']. s cr. + s withAttribute: (TextIndent tabs: 1) do: [s nextPutAll: self note withSqueakLineEndings]. - s withAttribute: (TextIndent tabs: 1) do: [s nextPutAll: self note]. s cr; cr]. url isEmptyOrNil ifFalse: [s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Homepage:']; tab; withAttribute: (TextURL new url: url) do: [s nextPutAll: url]; cr]. self downloadUrl isEmptyOrNil ifFalse: [s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Download:']; tab; withAttribute: (TextURL new url: self downloadUrl) do: [s nextPutAll: self downloadUrl]; cr]. ^s contents. ! Item was changed: ----- Method: SMInstaller classSide>>basicNewChangeSet: (in category 'changeset utilities') ----- basicNewChangeSet: newName "This method copied here to ensure SqueakMap is independent of ChangesOrganizer. " Smalltalk at: #ChangesOrganizer + ifPresentAndInMemory: [:cs | ^ cs basicNewChangeSet: newName]. - ifPresent: [:cs | ^ cs basicNewChangeSet: newName]. (self changeSetNamed: newName) ifNotNil: [self error: 'The name ' , newName , ' is already used']. ^ ChangeSet basicNewNamed: newName! Item was changed: ----- Method: SMInstallationProposal>>collectConflictsIn: (in category 'initialize-release') ----- collectConflictsIn: collectionOfReleases "Collect all conflicts where there are either - multiple releases of the same package and/or - another release of the same package already installed Return the conflicts as an IdentityDictionary with the package as key and the value being a Set of releases." + | conflicts set | - | conflicts | conflicts := IdentityDictionary new. + collectionOfReleases do: [:r | + set := conflicts at: r package ifAbsentPut: [OrderedCollection new]. - collectionOfReleases do: [:r | | set | - set := conflicts at: r package ifAbsent: [ - conflicts at: r package put: OrderedCollection new]. set add: r]. "Add the installed releases too" conflicts keysAndValuesDo: [:key :value | key isInstalled ifTrue: [value add: key installedRelease]]. "Prune release sets with only one member" ^conflicts select: [:releaseSet | releaseSet size > 1]! Item was changed: ----- Method: SMInstallationRegistry>>markInstalled:version:time:counter: (in category 'private') ----- markInstalled: uuid version: version time: time counter: num "Private. Mark the installation. SM2 uses an Association to distinguish the automatic version from old versions." | installs | installedPackages ifNil: [installedPackages := Dictionary new]. + installs := installedPackages at: uuid ifAbsentPut: [OrderedCollection new]. - installs := installedPackages at: uuid - ifAbsent: [installedPackages at: uuid put: OrderedCollection new]. installs add: (Array with: 2->version with: time with: num)! Item was changed: ----- Method: SMPackage>>fullDescription (in category 'accessing') ----- fullDescription "Return a full textual description of the package. Most of the description is taken from the last release." + | s publishedRelease sqDescription | - | s publishedRelease | s := TextStream on: (Text new: 400). self describe: name withBoldLabel: 'Name: ' on: s. summary isEmptyOrNil ifFalse: [self describe: summary withBoldLabel: 'Summary: ' on: s ]. author isEmptyOrNil ifFalse: [s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Author:']; tab; tab. s withAttribute: (PluggableTextAttribute evalBlock: [self userInterface sendMailTo: (SMUtilities stripEmailFrom: author) regardingPackageRelease: self lastRelease]) do: [s nextPutAll: author]; cr]. self owner ifNotNil: [s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Owner:']; tab; tab. s withAttribute: (PluggableTextAttribute evalBlock: [self userInterface sendMailTo: self owner email regardingPackageRelease: self lastRelease]) do: [s nextPutAll: self owner nameAndEmail]; cr]. self maintainers isEmpty ifFalse: [ + s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Co-Maintainers:']; tab. - s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Co-maintainers:']; tab. self maintainers do: [:com | com = self maintainers first ifFalse: [s nextPutAll: ', ']. s withAttribute: (PluggableTextAttribute evalBlock: [self userInterface sendMailTo: com email regardingPackageRelease: self lastRelease]) do: [s nextPutAll: com nameAndEmail]]. s cr]. description isEmptyOrNil + ifFalse: [sqDescription := description withSqueakLineEndings. + s cr. - ifFalse: [s cr. s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Description:']. s cr. s withAttribute: (TextIndent tabs: 1) + do: [s next: (sqDescription findLast: [ :c | c isSeparator not ]) putAll: sqDescription]. - do: [s next: (description findLast: [ :c | c isSeparator not ]) putAll: description]. s cr ]. self describeCategoriesOn: s indent: 1. s cr. publishedRelease := self lastPublishedRelease. self describe: (self publishedVersion ifNil: ['<not published>']) + withBoldLabel: 'Published Version: ' - withBoldLabel: 'Published version: ' on: s. self isPublished ifTrue: [ s withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Created: ' ]; print: publishedRelease created; cr. self note isEmptyOrNil ifFalse: [s withAttribute: TextEmphasis bold + do: [s nextPutAll: 'Release Note:']. - do: [s nextPutAll: 'Release note:']. s cr. s withAttribute: (TextIndent tabs: 1) + do: [s nextPutAll: publishedRelease note withSqueakLineEndings]. - do: [s nextPutAll: publishedRelease note]. s cr ]]. url isEmptyOrNil ifFalse: [s cr; withAttribute: TextEmphasis bold + do: [s nextPutAll: 'Homepage: ']; - do: [s nextPutAll: 'Homepage:']; - tab; withAttribute: (TextURL new url: url) do: [s nextPutAll: url]; cr]. + packageInfoName isEmptyOrNil + ifFalse: [self + describe: packageInfoName + withBoldLabel: 'Package Info: ' + on: s ]. ^ s contents! Item was added: + ----- Method: SMSqueakMap>>isPurged (in category 'public') ----- + isPurged + "Is this instance purged (empty)?" + + ^checkpointNumber isZero!
More information about the Squeak-dev mailing list |