The Trunk: System-ar.290.mcz

Andreas Raab uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ar.290.mcz

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

Name: System-ar.290
Author: ar
Time: 9 March 2010, 5:08:27.538 pm
UUID: b2190a8f-c870-1540-a154-c3824af9ac71
Ancestors: System-ar.285, System-laza.289

Three changes:
- put Smalltalk>>at:ifAbsentPut: back (merge ar.285)
- fix for SystemDictionary>>bindingOf:
- a bit of refactoring for saveAs allowing a bit more flexibility for image packaging purposes

=============== Diff against System-ar.285 ===============

Item was changed:
+ ----- Method: SmalltalkImage>>platformSubtype (in category 'os') -----
- ----- Method: SmalltalkImage>>platformSubtype (in category 'system attributes') -----
  platformSubtype
+ "Return the subType of the platform we're running on."
- "Return the subType of the platform we're running on"
 
+ "Smalltalk os platformSubtype"
+
  ^self getSystemAttribute: 1003!

Item was changed:
+ ----- Method: SmalltalkImage>>windowSystemName (in category 'os') -----
- ----- Method: SmalltalkImage>>windowSystemName (in category 'system attributes') -----
  windowSystemName
  "Return the name of the window system currently being used for display."
+
+ "Smalltalk os windowSystemName"
- "SmalltalkImage current windowSystemName"
 
  ^self getSystemAttribute: 1005!

Item was added:
+ ----- Method: SmalltalkImage>>commandLine (in category 'command line') -----
+ commandLine
+ "Answer the object to query about command line."
+
+ ^self!

Item was changed:
  ----- Method: SmalltalkImage>>saveAs (in category 'sources, changes log') -----
  saveAs
  "Put up the 'saveAs' prompt, obtain a name, and save the image  under that new name."
+ ^self saveAs: self getFileNameFromUser.
+ !
-
- | newName |
- newName := self getFileNameFromUser.
- newName isNil ifTrue: [^ self].
- (SourceFiles at: 2) ifNotNil:
- [self closeSourceFiles; "so copying the changes file will always work"
- saveChangesInFileNamed: (self fullNameForChangesNamed: newName)].
- self saveImageInFileNamed: (self fullNameForImageNamed: newName)!

Item was added:
+ ----- Method: SmalltalkImage>>os (in category 'os') -----
+ os
+ "Answer the object to query about os."
+
+ ^self!

Item was changed:
+ ----- Method: SmalltalkImage>>vmPath (in category 'command line') -----
- ----- Method: SmalltalkImage>>vmPath (in category 'image, changes names') -----
  vmPath
  "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented."
+ "Smalltalk vmPath"
- "SmalltalkImage current vmPath"
 
  ^ (FilePath pathName: (self primVmPath) isEncoded: true) asSqueakPathName.
  !

Item was added:
+ ----- Method: SmalltalkImage>>extractParameters (in category 'command line') -----
+ extractParameters
+ "This method is used by Seaside 2.8.3"
+
+ | pName value index paramNameValueDictionary |
+ paramNameValueDictionary := Dictionary new.
+ index := 3. "Muss bei 3 starten, da 2 documentName ist"
+ [pName := self  getSystemAttribute: index.
+ pName isEmptyOrNil] whileFalse:[
+ index := index + 1.
+ value := self getSystemAttribute: index.
+ value ifNil: [value := ''].
+   paramNameValueDictionary at: pName asUppercase put: value.
+ index := index + 1].
+ ^paramNameValueDictionary!

Item was added:
+ ----- Method: SmalltalkImage>>buildDate (in category 'system attribute') -----
+ buildDate
+ "Return a String reflecting the build date of the VM"
+ "Smalltalk buildDate"
+
+ ^self getSystemAttribute: 1006!

Item was changed:
+ ----- Method: SmalltalkImage>>platformName (in category 'os') -----
- ----- Method: SmalltalkImage>>platformName (in category 'system attributes') -----
  platformName
+ "Return the name of the platform we're running on."
+
+ "Smalltalk os platformName"
- "Return the name of the platform we're running on"
 
  ^self getSystemAttribute: 1001!

Item was added:
+ ----- Method: SmalltalkImage>>options (in category 'command line') -----
+ options
+ "Answer an array with all the command line options."
+
+ "Smalltalk commandLine options"
+
+ ^Array streamContents: [:str |
+ | arg i |
+ i := 1.
+ [i > 1000 or: [(arg := self optionAt: i) == nil]]
+ whileFalse:
+ [str nextPut: arg.
+ i := i + 1]].!

Item was added:
+ ----- Method: SmalltalkImage>>argumentAt: (in category 'command line') -----
+ argumentAt: i
+ "Answer the i-th argument of the command line, or nil if not so many argument."
+
+ ^self getSystemAttribute: 2 + i!

Item was changed:
  IdentityDictionary subclass: #SystemDictionary
  instanceVariableNames: 'cachedClassNames'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'System-Support'!
 
+ !SystemDictionary commentStamp: 'nice 3/6/2010 21:56' prior: 0!
+ I represent a special dictionary used as global namespace for class names :
+
+ Smalltalk globals classNames.
+
+ and for traits too:
+
+ Smalltalk globals traitNames.
+
+ and a few other globals:
+
+ (Smalltalk globals keys reject: [:k | (Smalltalk globals at: k) isBehavior])
+ collect: [:k | k -> (Smalltalk globals at: k) class].
+
+ As the above example let you guess, the global namespace of Smalltalk system is accessed through:
+
+ Smalltalk globals.!
- !SystemDictionary commentStamp: '<historical>' prior: 0!
- I represent a special dictionary that supports protocol for asking questions about the structure of the system. Other than class names, I contain (print this)...
- Smalltalk keys select: [:k | ((Smalltalk at: k) isKindOf: Class) not]
- thenCollect: [:k | k -> (Smalltalk at: k) class]
- !

Item was added:
+ ----- Method: SmalltalkImage>>getFileNameFromUserSuggesting: (in category 'snapshot and quit') -----
+ getFileNameFromUserSuggesting: aName
+ "Ask the user for a new image name"
+ | newName |
+ newName := UIManager default
+ request: 'New File Name?' translated
+ initialAnswer: aName.
+ newName isEmpty ifTrue: [^nil].
+ ((FileDirectory default fileOrDirectoryExists: (self fullNameForImageNamed: newName)) or:
+ [FileDirectory default fileOrDirectoryExists: (self fullNameForChangesNamed: newName)]) ifTrue: [
+ (self confirm: ('{1} already exists. Overwrite?' translated format: {newName})) ifFalse: [^nil]].
+ ^newName
+ !

Item was changed:
  ----- Method: ProjectLauncher>>startUpAfterLogin (in category 'running') -----
  startUpAfterLogin
  | scriptName loader isUrl |
  self setupFlaps.
  Preferences readDocumentAtStartup ifTrue: [
  HTTPClient isRunningInBrowser ifTrue:[
  self setupFromParameters.
  scriptName := self parameterAt: 'src'.
  CodeLoader defaultBaseURL: (self parameterAt: 'Base').
  ] ifFalse:[
+ scriptName := (Smalltalk documentPath) ifNil:[''].
- scriptName := (SmalltalkImage current getSystemAttribute: 2) ifNil:[''].
  scriptName := scriptName convertFromSystemString.
  scriptName isEmpty ifFalse:[
  "figure out if script name is a URL by itself"
  isUrl := (scriptName asLowercase beginsWith:'http://') or:[
  (scriptName asLowercase beginsWith:'file://') or:[
  (scriptName asLowercase beginsWith:'ftp://')]].
  isUrl ifFalse:[scriptName := 'file:',scriptName]].
  ]. ]
  ifFalse: [ scriptName := '' ].
 
  scriptName isEmptyOrNil
  ifTrue:[^Preferences eToyFriendly ifTrue: [self currentWorld addGlobalFlaps]].
  loader := CodeLoader new.
  loader loadSourceFiles: (Array with: scriptName).
  (scriptName asLowercase endsWith: '.pr')
  ifTrue:[self installProjectFrom: loader]
  ifFalse:[loader installSourceFiles].
  !

Item was added:
+ ----- Method: SmalltalkImage>>saveAsSuggesting: (in category 'snapshot and quit') -----
+ saveAsSuggesting: aName
+ "Put up the 'saveAs' prompt, obtain a name, and save the image  under that new name."
+ ^self saveAs: (self getFileNameFromUserSuggesting: aName)!

Item was added:
+ ----- Method: SmalltalkImage>>optionAt: (in category 'command line') -----
+ optionAt: i
+ "Answer the i-th option of the command line, or nil if not so many options."
+
+ ^self getSystemAttribute: i negated!

Item was changed:
+ ----- Method: SmalltalkImage>>getSystemAttribute: (in category 'private') -----
- ----- Method: SmalltalkImage>>getSystemAttribute: (in category 'system attributes') -----
  getSystemAttribute: attributeID
  "Optional. Answer the string for the system attribute with the given
  integer ID. Answer nil if the given attribute is not defined on this
  platform. On platforms that support invoking programs from command
  lines (e.g., Unix), this mechanism can be used to pass command line
  arguments to programs written in Squeak.
 
  By convention, the first command line argument that is not a VM
  configuration option is considered a 'document' to be filed in. Such a
  document can add methods and classes, can contain a serialized object,
  can include code to be executed, or any combination of these.
 
  Currently defined attributes include:
  -1000...-1 - command line arguments that specify VM options
  0 - the full path name for currently executing VM
  (or, on some platforms, just the path name of the VM's directory)
  1 - full path name of this image
  2 - a Squeak document to open, if any
  3...1000 - command line arguments for Squeak programs
  1001 - this platform's operating system
  1002 - operating system version
  1003 - this platform's processor type
  1004 - vm version"
 
  <primitive: 149>
  ^ nil!

Item was changed:
  ----- Method: LRUCache>>printOn: (in category 'printing') -----
  printOn: aStream
+ "Append to the argument, aStream, a sequence of characters
- "Append to the argument, aStream, a sequence of characters  
  that identifies the receiver."
  aStream nextPutAll: self class name;
  nextPutAll: ' size:';
  nextPutAll: size asString;
  nextPutAll: ', calls:';
  nextPutAll: calls asString;
  nextPutAll: ', hits:';
  nextPutAll: hits asString;
  nextPutAll: ', ratio:';
+ nextPutAll: ((hits isNumber and: [calls isNumber and: [calls ~= 0]])
+ ifTrue: [hits / calls]
+ ifFalse: [0]) asFloat asString!
- nextPutAll:
- (hits / calls) asFloat asString!

Item was added:
+ ----- Method: SmalltalkImage>>documentPath (in category 'command line') -----
+ documentPath
+ "Answer the absolute path of the document passed to the vm or nil if none."
+
+ "Smalltalk commandLine documentPath"
+
+ ^self getSystemAttribute: 2!

Item was added:
+ ----- Method: SmalltalkImage>>saveAs: (in category 'sources, changes log') -----
+ saveAs: newName
+ "Save the image  under that new name."
+ newName ifNil:[^ self].
+ (SourceFiles at: 2) ifNotNil:
+ [self closeSourceFiles; "so copying the changes file will always work"
+ saveChangesInFileNamed: (self fullNameForChangesNamed: newName)].
+ self saveImageInFileNamed: (self fullNameForImageNamed: newName)!

Item was changed:
+ ----- Method: SmalltalkImage>>osVersion (in category 'os') -----
- ----- Method: SmalltalkImage>>osVersion (in category 'system attributes') -----
  osVersion
  "Return the version number string of the platform we're running on"
+
+ "Smalltalk osVersion"
- "SmalltalkImage current osVersion"
 
  ^(self getSystemAttribute: 1002) asString!

Item was added:
+ ----- Method: SystemDictionary>>bindingOf: (in category 'accessing') -----
+ bindingOf: varName
+ "SystemDictionary includes Symbols only"
+ ^super bindingOf: varName asSymbol!

Item was changed:
  ----- Method: SmalltalkImage>>getFileNameFromUser (in category 'snapshot and quit') -----
  getFileNameFromUser
+ "Ask the user for a new image name"
+ ^self getFileNameFromUserSuggesting: (FileDirectory localNameFor: self imageName)!
-
- | newName |
- newName := UIManager default
- request: 'New File Name?' translated
- initialAnswer: (FileDirectory localNameFor: self imageName).
- newName isEmpty ifTrue: [^nil].
- ((FileDirectory default fileOrDirectoryExists: (self fullNameForImageNamed: newName)) or:
- [FileDirectory default fileOrDirectoryExists: (self fullNameForChangesNamed: newName)]) ifTrue: [
- (self confirm: ('{1} already exists. Overwrite?' translated format: {newName})) ifFalse: [^nil]].
- ^newName
- !

Item was added:
+ ----- Method: SmalltalkImage>>arguments (in category 'command line') -----
+ arguments
+ "Answer an array with all the command line arguments.
+ This does not include imagePath, documentPath nor any option."
+
+ "Smalltalk commandLine arguments"
+
+ ^Array streamContents: [:str |
+ | arg i |
+ i := 1.
+ [i > 998 or: [(arg := self argumentAt: i) == nil]]
+ whileFalse:
+ [str nextPut: arg.
+ i := i + 1]].!