The Trunk: SMBase-gk.109.mcz

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!