The Trunk: System-nice.202.mcz

Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.202.mcz

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

Name: System-nice.202
Author: nice
Time: 27 December 2009, 12:40:51 pm
UUID: dbf10b15-232b-4907-ab64-07b285aa4bab
Ancestors: System-nice.201

Cosmetic: puch a few temps inside closures

=============== Diff against System-nice.201 ===============

Item was changed:
  ----- Method: PseudoClass>>fileOutMethods:on: (in category 'fileIn/fileOut') -----
  fileOutMethods: aCollection on: aStream
  "FileOut all methods with selectors taken from aCollection"
+ | categories |
- | cat categories |
  categories := Dictionary new.
  aCollection do:[:sel|
+ | cat |
  cat := self organization categoryOfElement: sel.
  cat = self removedCategoryName ifFalse:[
  (categories includesKey: cat)
  ifFalse:[categories at: cat put: Set new].
  (categories at: cat) add: sel].
  ].
  categories associationsDo:[:assoc|
- cat := assoc key.
  assoc value do:[:sel|
  aStream cr.
  (self sourceCode at: sel) fileOutOn: aStream.
  ].
  ].!

Item was changed:
  ----- Method: ResourceManager>>makeAllProjectResourcesLocalTo: (in category 'accessing') -----
  makeAllProjectResourcesLocalTo: resourceUrl
  "Change the urls in the resource locators so project specific resources are stored and referenced locally. Project specific resources are all those that are kept locally in any of the project's versions."
 
+ | locators projectBase |
- | locators locUrl locBase lastSlash projectBase localResource isExternal |
    "Construct the version neutral project base"
  resourceUrl isEmptyOrNil ifTrue: [^self].
  projectBase := resourceUrl copyFrom: 1 to: (resourceUrl lastIndexOf: $.) - 1.
  locators := OrderedCollection new.
  self resourceMap
  keysAndValuesDo:[:loc :res | res ifNotNil: [locators add: loc]].
  locators do: [:locator |
+ | locUrl |
  locUrl := locator urlString.
  locUrl ifNotNil: [
+ | lastSlash |
  lastSlash := locUrl lastIndexOf: $/.
  lastSlash > 0
  ifTrue: [
+ | locBase localResource isExternal |
  locBase := locUrl copyFrom: 1 to: lastSlash - 1.
  locBase := locBase copyFrom: 1 to: (((locBase lastIndexOf: $.) - 1) max: 0).
  isExternal := projectBase ~= locBase.
  (isExternal not
  or: [self localizeAllExternalResources])
  ifTrue: [
  localResource := locUrl copyFrom: lastSlash+1 to: locUrl size.
  "Update the cache entry to point to the new resource location"
  ResourceManager renameCachedResource: locUrl to: (resourceUrl , localResource) external: isExternal.
  locator urlString: localResource]]]].
  self resourceMap rehash
  !

Item was changed:
  ----- Method: CodeLoader>>loadSourceFiles: (in category 'loading') -----
  loadSourceFiles: anArray
  "Load all the source files in the given array."
+ | loader |
- | loader request |
  loader := HTTPLoader default.
+ sourceFiles := anArray collect: [:name |
+ self createRequestFor: name in: loader]!
- sourceFiles := anArray collect:[:name|
- request := self createRequestFor: name in: loader.
- request].
- !

Item was changed:
  ----- Method: DeepCopier>>fixDependents (in category 'like fullCopy') -----
  fixDependents
  "They are not used much, but need to be right"
 
- | newDep newModel |
  DependentsFields associationsDo: [:pair |
  pair value do: [:dep |
+ | newDep newModel |
  newDep := references at: dep ifAbsent: [nil].
  newDep ifNotNil: [
  newModel := references at: pair key ifAbsent: [pair key].
  newModel addDependent: newDep]]].
  !

Item was changed:
  ----- Method: PseudoClass>>fileInMethods: (in category 'fileIn/fileOut') -----
  fileInMethods: aCollection
  "FileIn all methods with selectors taken from aCollection"
+ | theClass |
- | theClass cat |
  self exists ifFalse:[^self classNotDefined].
  theClass := self realClass.
  aCollection do:[:sel|
+ | cat |
  cat := self organization categoryOfElement: sel.
  cat = self removedCategoryName ifFalse:[
  theClass
  compile: (self sourceCodeAt: sel)
  classified: cat
  withStamp: (self stampAt: sel)
  notifying: nil.
  ].
  ].!

Item was changed:
  ----- Method: DigitalSignatureAlgorithm class>>timeDecode: (in category 'examples') -----
  timeDecode: count
  "Example of signing a message and verifying its signature."
  "Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
  "DigitalSignatureAlgorithm timeDecode: 20"
 
+ | dsa |
- | msg keys sig s dsa |
-
  dsa := DigitalSignatureAlgorithm new.
  dsa initRandomFromUser.
 
  #(1 10 100 1000 10000 100000) do: [ :extraLen |
+ | msg keys sig s |
  s := String new: extraLen.
  1 to: s size do: [ :i | s at: i put: (Character value: 200 atRandom)].
  msg := 'This is a test...',s.
  keys := self testKeySet.
  sig := self sign: msg privateKey: keys first dsa: dsa.
  "self inform: 'Signature created'."
  self timeDirect: [
  count timesRepeat: [
  (self verify: sig isSignatureOf: msg publicKey: keys last)
  ifFalse: [self error: 'ERROR!! Signature verification failed'].
  ].
  ] as: 'verify msgLen = ',msg size printString count: count
  ].
  !

Item was changed:
  ----- Method: CodeLoader class>>exportCategories:to: (in category 'utilities') -----
  exportCategories: catList to: aFileName
  "CodeLoader exportCategories: #( 'Game-Animation' 'Game-Framework' ) to: 'Game-Framework'"
 
+ | classList |
- | list classList |
  classList := OrderedCollection new.
  catList do: [:catName |
+ | list |
  list := SystemOrganization listAtCategoryNamed: catName asSymbol.
  list do: [:nm | classList add: (Smalltalk at: nm); add: (Smalltalk at: nm) class]].
  self exportCodeSegment: aFileName classes: classList keepSource: true!

Item was changed:
  ----- Method: DigitalSignatureAlgorithm class>>testExamplesFromDisk (in category 'examples') -----
  testExamplesFromDisk
  "verify messages from file on disk"
  "Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
  "DigitalSignatureAlgorithm testExamplesFromDisk"
 
+ | file |
- | msg  sig file publicKey |
-
  file := FileStream readOnlyFileNamed: 'dsa.test.out'.
  [
+ | msg  sig publicKey |
  [file atEnd] whileFalse: [
  sig := file nextChunk.
  msg := file nextChunk.
  publicKey := Compiler evaluate: file nextChunk.
  (self verify: sig isSignatureOf: msg publicKey: publicKey) ifTrue: [
  Transcript show: 'SUCCESS: ',msg; cr.
  ] ifFalse: [
  self error: 'ERROR!! Signature verification failed'
  ].
  ].
  ] ensure: [file close]
  !

Item was changed:
  ----- Method: ResourceManager>>preLoadFromArchive:cacheName: (in category 'loading') -----
  preLoadFromArchive: aZipArchive cacheName: aFileName
  "Load the resources from the given zip archive"
+ | nameMap resMap |
- | orig nameMap resMap loc stream |
  self class reloadCachedResources.
  resMap := Dictionary new.
  nameMap := Dictionary new.
  unloaded do:[:locator|
  locator localFileName: nil.
  nameMap at: locator urlString put: locator.
  resMap at: locator urlString put: (resourceMap at: locator)].
 
  aZipArchive members do:[:entry|
+ | stream orig loc |
  stream := nil.
  orig := resMap at: (self convertMapNameForBackwardcompatibilityFrom: entry fileName ) ifAbsent:[nil].
  loc := nameMap at: (self convertMapNameForBackwardcompatibilityFrom: entry fileName ) ifAbsent:[nil].
  "note: orig and loc may be nil for non-resource members"
  (orig notNil and:[loc notNil]) ifTrue:[
  stream := entry contentStream.
  self installResource: orig from: stream locator: loc.
  stream reset.
  aFileName
  ifNil:[self class cacheResource: loc urlString stream: stream]
  ifNotNil:[self class cacheResource: loc urlString inArchive: aFileName]].
  ].!

Item was changed:
  ----- Method: ResourceManager>>initializeFrom: (in category 'initialize') -----
  initializeFrom: aCollector
  "Initialize the receiver from the given resource collector. None of the resources have been loaded yet, so make register all resources as unloaded."
- | newLoc |
  aCollector stubMap keysAndValuesDo:[:stub :res|
+ | newLoc |
  newLoc := stub locator.
  resourceMap at: newLoc put: res.
  "unloaded add: newLoc."
  ].!

Item was changed:
  ----- Method: CodeLoader>>loadSegments: (in category 'loading') -----
  loadSegments: anArray
  "Load all the source files in the given array."
+ | loader request |
- | loader request reqName |
  loader := HTTPLoader default.
  segments := anArray collect:[:name |
+ | reqName |
  reqName := (FileDirectory extensionFor: name) isEmpty
  ifTrue: [FileDirectory fileName: name extension: ImageSegment compressedFileExtension]
  ifFalse: [name].
  request := self createRequestFor: reqName in: loader.
  name->request].
  !

Item was changed:
  ----- Method: DeepCopier>>checkVariables (in category 'like fullCopy') -----
  checkVariables
  "Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
  DeepCopier new checkVariables "
 
- | meth |
  self checkBasicClasses.
 
  "Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
  (self systemNavigation allClassesImplementing: #veryDeepInner:) do:
  [:aClass |
  ((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize)
  ifFalse:
  [aClass instSize > 0
  ifTrue: [self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
  (self systemNavigation allClassesImplementing: #veryDeepCopyWith:) do:
  [:aClass |
+ | meth |
  meth := aClass compiledMethodAt: #veryDeepCopyWith:.
  meth size > 20 & (meth literals includes: #veryDeepCopyWith:) not
  ifTrue:
  [(meth writesField: aClass instSize)
  ifFalse: [self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]]!

Item was changed:
  ----- Method: ReferenceStream>>objectAt: (in category 'reading') -----
  objectAt: anInteger
      "PRIVATE -- Read & return the object at a given stream position.
       If we already read it, just get it from the objects dictionary.
       (Reading it again wouldn't work with cycles or sharing.)
       If not, go read it and put it in the objects dictionary.
       NOTE: This resolves a cross-reference in the ReferenceStream:
         1. A backward reference to an object already read (the normal case).
         2. A forward reference which is a sated weak reference (we record where
            the object ends so when we get to it normally we can fetch it from
            'objects' and skip over it).
         3. A backward reference to a 'non-reference type' per the long NOTE in
            nextPut: (we compensate here--seek back to re-read it and add the object
            to 'objects' to avoid seeking back to read it any more times).
         4. While reading a foward weak reference (case 2), we may recursively hit an
            ordinary backward reference to an object that we haven't yet read because
            we temporarily skipped ahead. Such a reference is forward in time so we
            treat it much like case 2.
       11/16-24/92 jhm: Handle forward refs. Cf. class comment and above NOTE.
  08:57 tk   anInteger is a relative position"
+    
-     | savedPosn refPosn anObject |
-
      ^ objects at: anInteger "relative position.  case 1: It's in 'objects'"
          ifAbsent:   "do like super objectAt:, but remember the fwd-ref-end position"
+             [| savedPosn refPosn anObject |
+ savedPosn := byteStream position. "absolute"
-             [savedPosn := byteStream position. "absolute"
              refPosn := self getCurrentReference. "relative position"
 
              byteStream position: anInteger + basePos. "was relative"
              anObject := self next.
 
              (self isAReferenceType: (self typeIDFor: anObject))
                  ifTrue:  [fwdRefEnds at: anInteger put: byteStream position - basePos] "cases 2, 4"
                  ifFalse: [objects at: anInteger put: anObject]. "case 3"
 
              self setCurrentReference: refPosn. "relative position"
              byteStream position: savedPosn. "absolute"
              anObject]!

Item was changed:
  ----- Method: ResourceManager>>adjustToRename:from: (in category 'accessing') -----
  adjustToRename: newName from: oldName
  "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server."
+ | urlMap |
- | urlMap oldUrl |
  newName isEmptyOrNil ifTrue: [^self].
  urlMap := Dictionary new.
  self resourceMap
  keysDo: [:locator |
+ | oldUrl |
  oldUrl := locator urlString.
  locator adjustToRename: newName from: oldName.
  urlMap at: oldUrl put: locator urlString].
  self resourceMap rehash.
  unloaded rehash.
  urlMap keysAndValuesDo: [:old :new |
  ResourceManager renameCachedResource: old to: new]!

Item was changed:
  ----- Method: ResourceManager>>loaderProcess (in category 'loading') -----
  loaderProcess
+ | loader requests |
- | loader requests req locator resource stream |
  loader := HTTPLoader default.
  requests := Dictionary new.
  self prioritizedUnloadedResources do:[:loc|
+ | req |
  req := HTTPLoader httpRequestClass for: (self hackURL: loc urlString) in: loader.
  loader addRequest: req.
  requests at: req put: loc].
  [stopFlag or:[requests isEmpty]] whileFalse:[
  stopSemaphore waitTimeoutMSecs: 500.
  requests keys "need a copy" do:[:r|
  r isSemaphoreSignaled ifTrue:[
+ | locator resource stream |
  locator := requests at: r.
  requests removeKey: r.
  stream := r contentStream.
  resource := resourceMap at: locator ifAbsent:[nil].
  self class cacheResource: locator urlString stream: stream.
  self installResource: resource
  from: stream
  locator: locator.
  (resource isForm) ifTrue:[
  WorldState addDeferredUIMessage: self formChangedReminder]
  ifFalse: [self halt].
  ].
  ].
  ].
  "Either done downloading or terminating process"
  stopFlag ifTrue:[loader abort].
  loaderProcess := nil.
  stopSemaphore := nil.!

Item was changed:
  ----- Method: ResourceManager>>loadCachedResources (in category 'loading') -----
  loadCachedResources
  "Load all the resources that we have cached locally"
- | resource |
  self class reloadCachedResources.
  self prioritizedUnloadedResources do:[:loc|
  self class lookupCachedResource: loc urlString ifPresentDo:[:stream|
+ | resource |
  resource := resourceMap at: loc ifAbsent:[nil].
  self installResource: resource
  from: stream
  locator: loc.
  (resource isForm) ifTrue:[
  self formChangedReminder value.
  World displayWorldSafely].
  ].
  ].!

Item was changed:
  ----- Method: ProjectLoading class>>openFromDirectory:andFileName: (in category 'loading') -----
  openFromDirectory: aDirectory andFileName: aFileName
 
- | fileAndDir |
  Project current
+ do: [| fileAndDir |
+ ProgressNotification signal: '1:foundMostRecent'.
- do: [ProgressNotification signal: '1:foundMostRecent'.
  fileAndDir := self bestAccessToFileName: aFileName andDirectory: aDirectory.
  self
  openName: aFileName
  stream: fileAndDir first
  fromDirectory: fileAndDir second
  withProjectView: nil]
  withProgressInfoOn: nil
  label: 'project loading'
  !

Item was changed:
  ----- Method: ResourceManager>>adjustToNewServer:from: (in category 'accessing') -----
  adjustToNewServer: newResourceUrl from: oldResourceUrl
  "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server."
+ | urlMap |
- | urlMap oldUrl newUrl |
  newResourceUrl isEmptyOrNil ifTrue: [^self].
  urlMap := Dictionary new.
  self resourceMap
  keysDo: [:locator |
  "Local file refs are not handled well, so work around here"
+ | oldUrl newUrl |
  oldUrl := ResourceLocator make: locator urlString relativeTo: oldResourceUrl.
  newUrl := ResourceLocator make: locator urlString relativeTo: newResourceUrl.
  oldUrl ~= newUrl
  ifTrue: [urlMap at: oldUrl asString unescapePercents put: newUrl asString unescapePercents]].
  self resourceMap rehash.
  unloaded rehash.
  urlMap keysAndValuesDo: [:old :new |
  ResourceManager renameCachedResource: old to: new]!

Item was changed:
  ----- Method: SmalltalkImage>>fixObsoleteReferences (in category 'image cleanup') -----
  fixObsoleteReferences
  "SmalltalkImage current fixObsoleteReferences"
+ | informee |
- | informee obsoleteBindings obsName realName realClass |
 
  Smalltalk garbageCollect; garbageCollect.
 
  Preference allInstances do: [:each |
  informee := each instVarNamed: #changeInformee.
  ((informee isKindOf: Behavior)
  and: [informee isObsolete])
  ifTrue: [
  Transcript show: 'Preference: '; show: each name; cr.
  each instVarNamed: #changeInformee put: (Smalltalk at: (informee name copyReplaceAll: 'AnObsolete' with: '') asSymbol)]].
   
  CompiledMethod allInstances do: [:method |
+ | obsoleteBindings |
  obsoleteBindings := method literals select: [:literal |
  literal isVariableBinding
  and: [literal value isBehavior]
  and: [literal value isObsolete]].
  obsoleteBindings do: [:binding |
+ | obsName realName realClass |
  obsName := binding value name.
  Transcript show: 'Binding: '; show: obsName; cr.
  realName := obsName copyReplaceAll: 'AnObsolete' with: ''.
  realClass := Smalltalk at: realName asSymbol ifAbsent: [UndefinedObject].
  binding isSpecialWriteBinding
  ifTrue: [binding privateSetKey: binding key value: realClass]
  ifFalse: [binding key: binding key value: realClass]]].
 
 
  Behavior flushObsoleteSubclasses.
  Smalltalk garbageCollect; garbageCollect.
  SystemNavigation default obsoleteBehaviors size > 0
  ifTrue: [
  SystemNavigation default obsoleteBehaviors inspect.
  self error:'Still have obsolete behaviors. See inspector'].
 
  !

Item was changed:
  ----- Method: ClassDiffBuilder>>printPatchSequence:on: (in category 'printing') -----
  printPatchSequence: ps on: aStream
- | type line |
  ps do: [:assoc |
+ | type line |
  type := assoc key.
  line := assoc value.
  aStream
  withAttributes: (self attributesOf: type)
  do: [aStream nextPutAll: line]]!

Item was changed:
  ----- Method: ProjectLoading class>>thumbnailFromUrl: (in category 'accessing') -----
  thumbnailFromUrl: urlString
-
- | fileName fileAndDir |
-
  "Load the project, and make a thumbnail to it in the current project.
  ProjectLoading thumbnailFromUrl: 'http://www.squeak.org/Squeak2.0/2.7segments/SqueakEasy.extSeg'.
  "
 
  Project canWeLoadAProjectNow ifFalse: [^ self].
  Project current
+ do: [| fileName fileAndDir |
+ ProgressNotification signal: '1:foundMostRecent'.
- do: [ProgressNotification signal: '1:foundMostRecent'.
  fileName := (urlString findTokens: '/') last.
  fileAndDir := self bestAccessToFileName: fileName andDirectory: urlString.
  self
  openName: fileName
  stream: fileAndDir first
  fromDirectory: fileAndDir second
  withProjectView: nil]
  withProgressInfoOn: nil
  label: 'project loading'
  !

Item was changed:
  ----- Method: ProjectHistory>>cleanUp (in category 'project lifetime') -----
  cleanUp
-
- | proj |
-
  mostRecent := mostRecent reject: [ :each |
+ | proj |
  proj := each fourth first.
  proj isNil or: [proj world isNil]
  ].
  self changed.
  !

Item was changed:
  ----- Method: DeepCopier>>checkDeep (in category 'like fullCopy') -----
  checkDeep
  "Write exceptions in the Transcript.  Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  This check is only run by hand once in a while to make sure nothing was forgotten.  
  (Please do not remove this method.)
  DeepCopier new checkDeep "
 
- | mm |
  Transcript
  cr;
  show: 'Instance variables shared with the original object when it is copied'.
  (self systemNavigation allClassesImplementing: #veryDeepInner:) do:
  [:aClass |
+ | mm |
  (mm := aClass instVarNames size) > 0
  ifTrue:
  [aClass instSize - mm + 1 to: aClass instSize
  do:
  [:index |
  ((aClass compiledMethodAt: #veryDeepInner:) writesField: index)
  ifFalse:
  [Transcript
  cr;
  show: aClass name;
  space;
  show: (aClass allInstVarNames at: index)]]]]!

Item was changed:
  ----- Method: ResourceManager class>>lookupCachedResource:in:ifPresentDo: (in category 'resource caching') -----
  lookupCachedResource: urlString in: candidates ifPresentDo: streamBlock
  "See if we have cached the resource described by the given url and if so, evaluate streamBlock with the cached resource."
+ | sortedCandidates dir |
- | sortedCandidates dir file |
  (candidates isNil or:[candidates size = 0])
  ifTrue:[^false].
  "First, try non-zip members (faster since no decompression is involved)"
  sortedCandidates := (candidates reject:[:each| each beginsWith: 'zip://']),
  (candidates select:[:each| each beginsWith: 'zip://']).
  dir := Project squeakletDirectory.
  sortedCandidates do:[:fileName|
+ | file |
  file := self loadResource: urlString fromCacheFileNamed: fileName in: dir.
  file ifNotNil:[
  [streamBlock value: file] ensure:[file close].
  ^true]].
  ^false!

Item was changed:
  ----- Method: DigitalSignatureAlgorithm class>>writeExamplesToDisk (in category 'examples') -----
  writeExamplesToDisk
  "Example of signing a message and verifying its signature. Used to create samples from one implementation that could later be tested with a different implementation"
  "Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
  "DigitalSignatureAlgorithm writeExamplesToDisk"
 
+ | file keyList dsa msgList |
- | sig file keyList dsa msgList |
 
  dsa := DigitalSignatureAlgorithm new.
  dsa initRandomFromUser.
  self inform: 'About to generate 5 key sets. Will take a while'.
  keyList := {self testKeySet},((1 to: 5) collect: [ :ignore | self generateKeySet]).
  msgList := {'This is a test...'. 'This is the second test period.'. 'And finally, a third message'}.
  file := FileStream newFileNamed: 'dsa.test.out'.
  [
  msgList do: [ :msg |
  keyList do: [ :keys |
+ | sig |
  sig := self sign: msg privateKey: keys first dsa: dsa.
  (self verify: sig isSignatureOf: msg publicKey: keys last) ifTrue: [
  file
  nextChunkPut: sig;
  nextChunkPut: msg;
  nextChunkPut: keys last storeString.
  ] ifFalse: [
  self error: 'ERROR!! Signature verification failed'
  ].
  ].
  ].
  ] ensure: [file close]
  !