'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5497] on 26 October 2003 at 1:21:15 pm'! "Change Set: KCP-0105-SystemAttributes Date: 22 October 2003 Author: stephane ducasse Extract from SystemDictionary the fonctionality to get the parameters passed on the command line and related. v3: SmalltalkImage current v4: fixed some conflicts and comments -- md"! !AbstractLauncher class methodsFor: 'private' stamp: 'sd 9/30/2003 13:55'! extractParameters ^ SmalltalkImage current extractParameters! ! !AutoStart class methodsFor: 'updating' stamp: 'sd 9/30/2003 13:55'! checkForPluginUpdate | pluginVersion updateURL | World ifNotNil: [ World install. ActiveHand position: 100@100]. HTTPClient determineIfRunningInBrowser. HTTPClient isRunningInBrowser ifFalse: [^false]. pluginVersion _ AbstractLauncher extractParameters at: (SmalltalkImage current platformName copyWithout: Character space) asUppercase ifAbsent: [^false]. updateURL _ AbstractLauncher extractParameters at: 'UPDATE_URL' ifAbsent: [^false]. ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! ! !FileDirectory class methodsFor: 'system start up' stamp: 'md 10/26/2003 13:17'! openSources: sourcesName andChanges: changesName forImage: imageName "Initialize the default directory to the image directory and open the sources and changes files, if possible. Look for the changes file in image directory. Look for the system sources (or an alias to it) first in the VM directory, then in the image directory. Open the changes and sources files and install them in SourceFiles." "Note: SourcesName and imageName are full paths; changesName is a local name." | sources changes msg wmsg | msg _ 'Squeak cannot locate &fileRef. Please check that the file is named properly and is in the same directory as this image. Further explanation can found in the startup window, ''How Squeak Finds Source Code''.'. wmsg _ 'Squeak cannot write to &fileRef. Please check that you have write permission for this file. You won''t be able to save this image correctly until you fix this.'. sources _ self openSources: sourcesName forImage: imageName. changes _ self openChanges: changesName forImage: imageName. ((sources == nil or: [sources atEnd]) and: [Preferences valueOfFlag: #warnIfNoSourcesFile]) ifTrue: [self inform: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName). SmalltalkImage current platformName = 'Mac OS' ifTrue: [self inform: 'Make sure the sources file is not an Alias.']]. (changes == nil and: [Preferences valueOfFlag: #warnIfNoChangesFile]) ifTrue: [self inform: (msg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)]. ((Preferences valueOfFlag: #warnIfNoChangesFile) and:[changes notNil]) ifTrue: [changes isReadOnly ifTrue: [self inform: (wmsg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)]. ((changes next: 200) includesSubString: String crlf) ifTrue: [self inform: 'The changes file named ' , changesName, ' has been injured by an unpacking utility. Crs were changed to CrLfs. Please set the preferences in your decompressing program to "do not convert text files" and unpack the system again.']]. SourceFiles _ Array with: sources with: changes! ! !AcornFileDirectory class methodsFor: 'platform specific' stamp: 'md 10/26/2003 13:16'! isActiveDirectoryClass "Does this class claim to be that properly active subclass of FileDirectory for the current platform? On Acorn, the test is whether platformName is 'RiscOS' (on newer VMs) or if the primPathNameDelimiter is $. (on older ones), which is what we would like to use for a dirsep if only it would work out. See pathNameDelimiter for more woeful details - then just get on and enjoy Squeak" ^ SmalltalkImage current platformName = 'RiscOS' or: [self primPathNameDelimiter = $.]! ! !HTTPClient class methodsFor: 'testing' stamp: 'sd 9/30/2003 13:56'! shouldUsePluginAPI "HTTPClient shouldUsePluginAPI" self isRunningInBrowser ifFalse: [^false]. self browserSupportsAPI ifFalse: [^false]. "The Mac plugin calls do not work in full screen mode" ^((SmalltalkImage current platformName = 'Mac OS') and: [ScreenController lastScreenModeSelected]) not! ! !MacFileDirectory class methodsFor: 'platform specific' stamp: 'md 10/26/2003 13:06'! isActiveDirectoryClass ^ super isActiveDirectoryClass and: [(SmalltalkImage current getSystemAttribute: 1201) isNil or: [(SmalltalkImage current getSystemAttribute: 1201) asNumber <= 31]]! ! !MacHFSPlusFileDirectory class methodsFor: 'platform specific' stamp: 'md 10/26/2003 13:06'! isActiveDirectoryClass "Ok, lets see if we support HFS Plus file names, the long ones" ^ (self pathNameDelimiter = self primPathNameDelimiter) and: [(SmalltalkImage current getSystemAttribute: 1201) notNil and: [(SmalltalkImage current getSystemAttribute: 1201) asNumber > 31]]! ! !MoviePlayerMorph methodsFor: 'private' stamp: 'md 10/26/2003 13:07'! pvtOpenFileNamed: fName "Private - open on the movie file iof the given name" | f w h d n m | self stopRunning. fName = movieFileName ifTrue: [^ self]. "No reopen necessary on same file" movieFileName _ fName. "Read movie file parameters from 128-byte header... (records follow as {N=int32, N words}*)" f _ (FileStream oldFileNamed: movieFileName) binary. f nextInt32. w _ f nextInt32. h _ f nextInt32. d _ f nextInt32. n _ f nextInt32. m _ f nextInt32. f close. pageSize _ frameSize _ w@h. frameDepth _ d. frameCount _ n. frameNumber _ 1. playDirection _ 0. msAtLastSync _ 0. msPerFrame _ m/1000.0. self makeMyPage. (SmalltalkImage current platformName = 'Mac OS') ifTrue:[ (SmalltalkImage current extraVMMemory < self fileByteCountPerFrame) ifTrue: [^ self inform: 'Playing movies in Squeak requires that extra memory be allocated for asynchronous file IO. This particular movie requires a buffer of ' , (self fileByteCountPerFrame printString) , ' bytes, but you only have ' , (SmalltalkImage current extraVMMemory printString) , ' allocated. You can evaluate ''SmalltalkImage current extraVMMemory'' to check your allocation, and ''SmalltalkImage current extraVMMemory: 485000'' or the like to increase your allocation. Note that raising your allocation in this way only marks your image as needing this much, so you must then save, quit, and start over again before you can run this movie. Good luck.']]. ! ! !PowerManagement class methodsFor: 'computing' stamp: 'md 10/26/2003 13:07'! itsyVoltage "On the Itsy, answer the approximate Vcc voltage. The Itsy will shut itself down when this value reaches 2.0 volts. This method allows one to build a readout of the current battery condition." | n | n _ SmalltalkImage current getSystemAttribute: 1200. n ifNil: [^ 'no voltage attribute']. ^ (n asNumber / 150.0 roundTo: 0.01) asString , ' volts'! ! !ProjectLauncher methodsFor: 'running' stamp: 'sd 9/30/2003 13:58'! 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 _ (SmalltalkImage current getSystemAttribute: 2) ifNil:['']. 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]. ! ! !SecurityManager methodsFor: 'private' stamp: 'sd 9/30/2003 13:58'! generateLocalKeyPair "SecurityManager default generateLocalKeyPair" "Generate a key set on the local machine." | dsa | dsa _ DigitalSignatureAlgorithm new. dsa initRandomFromString: Time millisecondClockValue printString, Date today printString, SmalltalkImage current platformName printString. privateKeyPair _ dsa generateKeySet. self storeSecurityKeys.! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'sd 9/30/2003 13:58'! determineLocalServerDirectory: directoryName "This is part of a workaround for Mac file name oddities regarding relative file names. The real fix should be in fullNameFor: but that seems to break other parts of the system." | dirName | dirName _ directoryName. (SmalltalkImage current platformName = 'Mac OS' and: [directoryName beginsWith: ':']) ifTrue: [ dirName _ (FileDirectory default pathName endsWith: directoryName) ifTrue: [FileDirectory default pathName] ifFalse: [(FileDirectory default pathName , directoryName) replaceAll: '::' with: ':']]. ^FileDirectory default directoryNamed: dirName! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'sd 9/24/2003 11:40'! extractParameters | pName value index globals | globals := 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 _ '']. globals at: pName asUppercase put: value. index := index + 1]. ^globals! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'md 10/26/2003 13:08'! 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" ^ nil! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'sd 6/27/2003 23:38'! osVersion "Return the version number string of the platform we're running on" ^(self getSystemAttribute: 1002) asString! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'sd 6/27/2003 23:38'! platformName "Return the name of the platform we're running on" ^self getSystemAttribute: 1001! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'sd 6/27/2003 23:43'! platformSubtype "Return the subType of the platform we're running on" ^self getSystemAttribute: 1003! ! !SmalltalkImage methodsFor: 'system attribute' stamp: 'sd 7/2/2003 22:09'! vmVersion "Return a string identifying the interpreter version" "VM uniqueInstance version" ^self getSystemAttribute: 1004! ! !SmalltalkImage methodsFor: 'preferences' stamp: 'sd 6/28/2003 17:33'! setPlatformPreferences "Set some platform specific preferences on system startup" | platform specs | Preferences automaticPlatformSettings ifFalse:[^self]. platform _ self platformName. specs _ #( (soundStopWhenDone false) (soundQuickStart false) ). platform = 'Win32' ifTrue:[ specs _ #( (soundStopWhenDone true) (soundQuickStart false) )]. platform = 'Mac OS' ifTrue:[ specs _ #( (soundStopWhenDone false) (soundQuickStart true) )]. specs do:[:tuple| Preferences setPreference: tuple first toValue: (tuple last == #true). ]. ! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'md 10/26/2003 13:09'! 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" self deprecated: [self getSystemAttributeDeprecatedPrimitive: attributeID] explanation: 'Use SmalltalkImage current getSystemAttribute: attributeID '. ^ nil! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'md 10/26/2003 13:09'! getSystemAttributeDeprecatedPrimitive: 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" ^ nil! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 7/3/2003 21:57'! getVMParameters "Smalltalk getVMParameters" "Answer an Array containing the current values of the VM's internal parameter/metric registers. Each value is stored in the array at the index corresponding to its VM register. (See #vmParameterAt: and #vmParameterAt:put:.)" self deprecated: [self getVMParametersDeprecatedPrimitive] explanation: 'Use SmalltalkImage current getVMParameters'. self primitiveFailed! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 7/3/2003 21:56'! getVMParametersDeprecatedPrimitive "Smalltalk getVMParameters" "Answer an Array containing the current values of the VM's internal parameter/metric registers. Each value is stored in the array at the index corresponding to its VM register. (See #vmParameterAt: and #vmParameterAt:put:.)" self primitiveFailed! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 7/2/2003 22:05'! osVersion "Return the version number string of the platform we're running on" self deprecatedExplanation: 'Use SmalltalkImage current osVersion'. ^(self getSystemAttribute: 1002) asString! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 7/2/2003 22:06'! platformName "Return the name of the platform we're running on" self deprecatedExplanation: 'Use SmalltalkImage current platformName'. ^self getSystemAttribute: 1001! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 7/2/2003 22:06'! platformSubtype "Return the subType of the platform we're running on" self deprecatedExplanation: 'Use SmalltalkImage current platformSubtype'. ^self getSystemAttribute: 1003! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 9/24/2003 12:19'! vmVersion "Smalltalk vmVersion nil" "Return a string identifying the interpreter version" self deprecatedExplanation: 'Use SmalltalkImage current vmVersion'. ^self getSystemAttribute: 1004! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'md 10/22/2003 21:56'! snapshot: save andQuit: quit embedded: embeddedFlag "Mark the changes file and close all files. If save is true, save the current state of this Smalltalk in the image file. If quit is true, then exit to the outer shell. The latter part of this method runs when resuming a previously saved image. The resume logic checks for a document file to process when starting up." | resuming msg | Object flushDependents. Object flushEvents. (SourceFiles at: 2) ifNotNil:[ msg _ String streamContents: [ :s | s nextPutAll: '----'; nextPutAll: (save ifTrue: [ quit ifTrue: [ 'QUIT' ] ifFalse: [ 'SNAPSHOT' ] ] ifFalse: [quit ifTrue: [ 'QUIT/NOSAVE' ] ifFalse: [ 'NOP' ]]); nextPutAll: '----'; print: Date dateAndTimeNow; space; nextPutAll: (FileDirectory default localNameFor: self imageName); nextPutAll: ' priorSource: '; print: LastQuitLogPosition ]. self assureStartupStampLogged. save ifTrue: [ LastQuitLogPosition _ (SourceFiles at: 2) setToEnd; position ]. self logChange: msg. Transcript cr; show: msg ]. self processShutDownList: quit. Cursor write show. save ifTrue: [resuming _ embeddedFlag ifTrue: [self snapshotEmbeddedPrimitive] ifFalse: [self snapshotPrimitive]. "<-- PC frozen here on image file" resuming == false "guard against failure" ifTrue: ["Time to reclaim segment files is immediately after a save" Smalltalk at: #ImageSegment ifPresent: [:theClass | theClass reclaimObsoleteSegmentFiles]]] ifFalse: [resuming _ false]. quit & (resuming == false) ifTrue: [self quitPrimitive]. Cursor normal show. self setGCParameters. resuming == true ifTrue: [self clearExternalObjects]. self processStartUpList: resuming == true. resuming == true ifTrue:[ SmalltalkImage current setPlatformPreferences. self readDocumentFile]. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup]. "Now it's time to raise an error" resuming == nil ifTrue: [self error:'Failed to write image file (disk full?)']. ^ resuming! ! !SystemVersion class methodsFor: 'updating' stamp: 'sd 9/30/2003 13:58'! check: pluginVersion andRequestPluginUpdate: updateURL "SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' " "We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac." (self pluginVersion: pluginVersion newerThan: self currentPluginVersion) ifFalse: [^true]. (self confirm: 'There is a newer plugin version available. Do you want to install it now?') ifFalse: [^false]. HTTPClient requestURL: updateURL , (SmalltalkImage current platformName copyWithout: Character space) asLowercase , '.html' target: '_top'. ^false! ! !SystemVersion class methodsFor: 'updating' stamp: 'sd 9/30/2003 13:58'! currentPluginVersion ^SmalltalkImage current vmVersion! !