[squeak-dev] The Trunk: System-cmm.602.mczcommits at source.squeak.org commits at source.squeak.orgTue Oct 15 18:46:30 UTC 2013
Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.602.mcz ==================== Summary ==================== Name: System-cmm.602 Author: cmm Time: 15 October 2013, 1:45:33.881 pm UUID: 7a452144-3c88-4726-9692-a6afa93ef46e Ancestors: System-eem.601 - Support Preferences class>>#readDocumentAtStartup: false, so that Squeak can accept arbitrary arguments without requiring the first one to be a document URL. - Convenience method for checking for any of the various headless VM options. - API consistency for accessing command-line arguments. - Remove duplicate code (#extractParameters). Bid to remove apparently-unused code. - RecentMessages simplifications, fixes and cleanups. =============== Diff against System-eem.601 =============== Item was removed: - ----- Method: AbstractLauncher class>>extractParameters (in category 'private') ----- - extractParameters - - | pName value index globals | - globals := Dictionary new. - index := 3. - [pName := Smalltalk getSystemAttribute: index. - pName isEmptyOrNil] whileFalse:[ - index := index + 1. - value := Smalltalk getSystemAttribute: index. - value ifNil: [value := '']. - globals at: pName asUppercase put: value. - index := index + 1]. - ^globals! Item was changed: ----- Method: AbstractLauncher>>numericParameterAtOneOf:ifAbsent: (in category 'private') ----- numericParameterAtOneOf: alternateParameterNames ifAbsent: aBlock "Return the parameter named using one of the alternate names or an empty string" | parameterValue | + self isThisEverCalled. parameterValue := self parameterAtOneOf: alternateParameterNames. parameterValue isEmpty ifTrue: [^aBlock value]. ^[Number readFrom: parameterValue] ifError: aBlock ! Item was changed: ----- Method: AbstractLauncher>>parameterAtOneOf: (in category 'private') ----- parameterAtOneOf: alternateParameterNames | parameterName | "Return the parameter named using one of the alternate names or an empty string" + self isThisEverCalled. - parameterName := self determineParameterNameFrom: alternateParameterNames. ^parameterName isNil ifTrue: [''] ifFalse: [self parameterAt: parameterName ifAbsent: ['']]! Item was changed: ----- Method: AbstractLauncher>>parameters (in category 'private') ----- parameters parameters == nil + ifTrue: [parameters := Smalltalk namedArguments]. - ifTrue: [parameters := self class extractParameters]. ^parameters! Item was changed: ----- Method: AutoStart class>>checkForPluginUpdate (in category 'updating') ----- checkForPluginUpdate | pluginVersion updateURL | World ifNotNil: [ World install. ActiveHand position: 100 at 100]. HTTPClient isRunningInBrowser ifFalse: [^false]. + pluginVersion := Smalltalk namedArguments - pluginVersion := AbstractLauncher extractParameters at: (Smalltalk platformName copyWithout: Character space) asUppercase ifAbsent: [^false]. + updateURL := Smalltalk namedArguments - updateURL := AbstractLauncher extractParameters at: 'UPDATE_URL' ifAbsent: [^false]. ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! Item was changed: ----- Method: AutoStart class>>checkForUpdates (in category 'updating') ----- checkForUpdates | availableUpdate updateServer | + World ifNotNil: + [ World install. + ActiveHand position: 100 @ 100 ]. + HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ]. + availableUpdate := (Smalltalk namedArguments - World - ifNotNil: [ - World install. - ActiveHand position: 100 at 100]. - HTTPClient isRunningInBrowser - ifFalse: [^self processUpdates]. - availableUpdate := (AbstractLauncher extractParameters at: 'UPDATE' + ifAbsent: [ '' ]) asInteger. + availableUpdate ifNil: [ ^ false ]. + updateServer := Smalltalk namedArguments - ifAbsent: [''] ) asInteger. - availableUpdate - ifNil: [^false]. - updateServer := AbstractLauncher extractParameters at: 'UPDATESERVER' + ifAbsent: + [ Smalltalk namedArguments + at: 'UPDATE_SERVER' + ifAbsent: [ 'Squeakland' ] ]. - ifAbsent: [AbstractLauncher extractParameters - at: 'UPDATE_SERVER' - ifAbsent: ['Squeakland']]. Utilities setUpdateServer: updateServer. + ^ SystemVersion checkAndApplyUpdates: availableUpdate! - ^SystemVersion checkAndApplyUpdates: availableUpdate! Item was changed: ----- Method: AutoStart class>>startUp: (in category 'initialization') ----- startUp: resuming "The image is either being newly started (resuming is true), or it's just been snapshotted. If this has just been a snapshot, skip all the startup stuff." | startupParameters launchers | self active ifTrue: [^self]. self active: true. resuming ifFalse: [^self]. HTTPClient determineIfRunningInBrowser. + startupParameters := Smalltalk namedArguments. - startupParameters := AbstractLauncher extractParameters. (startupParameters includesKey: 'apiSupported' asUppercase ) ifTrue: [ HTTPClient browserSupportsAPI: ((startupParameters at: 'apiSupported' asUppercase) asUppercase = 'TRUE'). HTTPClient isRunningInBrowser ifFalse: [HTTPClient isRunningInBrowser: true]]. self checkForUpdates ifTrue: [^self]. self checkForPluginUpdate. launchers := self installedLaunchers collect: [:launcher | launcher new]. launchers do: [:launcher | launcher parameters: startupParameters]. launchers do: [:launcher | Smalltalk at: #WorldState ifPresent: [ :ws | ws addDeferredUIMessage: [launcher startUp]]]! Item was added: + ----- Method: Preferences class>>readDocumentAtStartup: (in category 'standard queries') ----- + readDocumentAtStartup: aBoolean + ^ self + setPreference: #readDocumentAtStartup + toValue: aBoolean! Item was changed: ----- Method: Project class>>loaderUrl (in category 'squeaklet on server') ----- loaderUrl + "Return a url that will launch a project in a browser by composing a url like <loaderURL>?<projectURL>" + ^ Smalltalk namedArguments + at: 'LOADER_URL' + ifAbsent: [ ]! - "Return a url that will allow to launch a project in a browser by composing a url like - <loaderURL>?<projectURL>" - - ^AbstractLauncher extractParameters at: 'LOADER_URL' ifAbsent: [nil].! Item was changed: Object subclass: #RecentMessages + instanceVariableNames: 'methodReferences maximumSubmissionCount isSuspended' + classVariableNames: 'Default' - instanceVariableNames: 'methodReferences size maximumSubmissionCount isSuspended' - classVariableNames: 'Default NumberOfRecentSubmissionsToStore' poolDictionaries: '' category: 'System-Support'! Item was changed: ----- Method: RecentMessages class>>newRemembering: (in category 'instance creation') ----- + newRemembering: anInteger + ^ self new + maximumSubmissionCount: anInteger ; + yourself! - newRemembering: anInteger - ^ self basicNew initializeWithSize: anInteger.! Item was changed: ----- Method: RecentMessages class>>numberOfRecentSubmissionsToStore (in category 'preferences') ----- numberOfRecentSubmissionsToStore + <preference: 'Number of recent submissions to store' category: 'Tools' description: 'Answer how many methods back the ''recent method submissions'' history should store' type: #Number> + ^ self default maximumSubmissionCount! - <preference: 'Number of recent submissions to store' - category: 'Tools' - description: 'Answer how many methods back the ''recent method submissions'' history should store' - type: #Number> - ^NumberOfRecentSubmissionsToStore - ifNil: [NumberOfRecentSubmissionsToStore := 30].! Item was changed: ----- Method: RecentMessages class>>numberOfRecentSubmissionsToStore: (in category 'preferences') ----- numberOfRecentSubmissionsToStore: anInteger + self default maximumSubmissionCount: anInteger! - NumberOfRecentSubmissionsToStore := anInteger.! Item was changed: ----- Method: RecentMessages>>defaultSize (in category 'private') ----- defaultSize + ^ 30! - ^ 10.! Item was changed: ----- Method: RecentMessages>>initialize (in category 'initialize-release') ----- initialize + super initialize. + methodReferences := OrderedCollection new: 30! - self initializeWithSize: self defaultSize! Item was removed: - ----- Method: RecentMessages>>initializeWithSize: (in category 'initialize-release') ----- - initializeWithSize: anInteger - maximumSubmissionCount := anInteger. - methodReferences := OrderedCollection new.! Item was changed: ----- Method: RecentMessages>>leastRecent (in category 'accessing') ----- leastRecent ^ methodReferences + ifEmpty: [ nil ] + ifNotEmpty: [ methodReferences last ]! - ifEmpty: [nil] - ifNotEmpty: [methodReferences first].! Item was changed: ----- Method: RecentMessages>>maximumSubmissionCount: (in category 'accessing') ----- maximumSubmissionCount: anInteger maximumSubmissionCount := anInteger. + self trim! - [self size > self maximumSubmissionCount] - whileTrue: [methodReferences removeFirst].! Item was changed: ----- Method: RecentMessages>>methodReferences (in category 'accessing') ----- methodReferences + ^ methodReferences asArray! - "Return A COPY of all method references." - ^ Array withAll: methodReferences.! Item was changed: ----- Method: RecentMessages>>mostRecent (in category 'accessing') ----- mostRecent + ^ methodReferences first! - [methodReferences notEmpty and: [methodReferences last isValid not]] - whileTrue: [methodReferences removeLast]. - ^ methodReferences last.! Item was changed: ----- Method: RecentMessages>>recordSelector:forClass:inEnvironment: (in category 'accessing') ----- + recordSelector: aSelector forClass: aClass inEnvironment: anEnvironment - recordSelector: aSelector forClass: aClass inEnvironment: anEnvironment | ref | + (isSuspended = true or: [ aClass wantsChangeSetLogging not ]) ifTrue: [ ^ self ]. - isSuspended = true ifTrue: [ ^ self ]. ref := MethodReference + class: aClass + selector: aSelector + environment: anEnvironment. + methodReferences + remove: ref ifAbsent: [ ] ; + addFirst: ref. + self trim! - class: aClass - selector: aSelector - environment: anEnvironment. - aClass wantsChangeSetLogging ifFalse: [^ ref]. - ^ methodReferences - detect: [:mref | mref = ref] - ifNone: [methodReferences addLast: ref. - self size > self maximumSubmissionCount - ifTrue: [methodReferences removeFirst]. - ref].! Item was removed: - ----- Method: RecentMessages>>revertLast (in category 'accessing') ----- - revertLast - "If the most recent method submission was a method change, revert - that change, and if it was a submission of a brand-new method, - remove that method." - | changeRecords lastSubmission theClass theSelector | - - methodReferences ifEmpty: [^ Beeper beep]. - lastSubmission := methodReferences last. - theClass := lastSubmission actualClass ifNil: [^ Beeper beep]. - theSelector := lastSubmission methodSymbol. - changeRecords := theClass changeRecordsAt: theSelector. - changeRecords isEmptyOrNil ifTrue: [^ Beeper beep]. - changeRecords size = 1 - ifTrue: - ["method has no prior version, so reverting in this case means removing" - theClass removeSelector: theSelector] - ifFalse: - [changeRecords second fileIn].! Item was added: + ----- Method: RecentMessages>>revertMostRecent (in category 'accessing') ----- + revertMostRecent + "If the most recent method submission was a method change, revert + that change, and if it was a submission of a brand-new method, + remove that method." + | changeRecords lastSubmission theClass theSelector | + methodReferences ifEmpty: [ ^ Beeper beep ]. + lastSubmission := methodReferences last. + theClass := lastSubmission actualClass ifNil: [ ^ Beeper beep ]. + theSelector := lastSubmission methodSymbol. + changeRecords := theClass changeRecordsAt: theSelector. + changeRecords isEmptyOrNil ifTrue: [ ^ Beeper beep ]. + changeRecords size = 1 + ifTrue: [ "method has no prior version, so reverting in this case means removing" + theClass removeSelector: theSelector ] + ifFalse: [ changeRecords second fileIn ] + ! Item was added: + ----- Method: RecentMessages>>trim (in category 'private') ----- + trim + [ methodReferences size > maximumSubmissionCount ] whileTrue: [ methodReferences removeLast ]! Item was changed: ----- Method: SmalltalkImage>>argumentAt: (in category 'command line') ----- + argumentAt: argumentIndex - argumentAt: i "Answer the i-th argument of the command line, or nil if not so many argument." + ^ self getSystemAttribute: + argumentIndex + + (Preferences readDocumentAtStartup + ifTrue: [ 2 ] + ifFalse: [ 1 ])! - - ^self getSystemAttribute: 2 + i! Item was changed: ----- 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" + ^ Preferences readDocumentAtStartup ifTrue: [ self getSystemAttribute: 2 ]! - - ^self getSystemAttribute: 2! Item was changed: ----- Method: SmalltalkImage>>extractParameters (in category 'command line') ----- extractParameters + self deprecated: 'Use #namedArguments'. + ^ self namedArguments! - "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 changed: ----- Method: SmalltalkImage>>getSystemAttribute: (in category 'private') ----- 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 1000th command line argument that specify VM options ... -1 first command line argument 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 (better use primImageName instead) + 2 first command-line argument for Squeak programs. + Note: if Preferences readDocumentAtStartup is set, this first argument is treated as a URL to a Squeak document to open. + 3 second command-line argument for Squeak programs - 2 a Squeak document to open, if any - 3 first command line argument for Squeak programs ... 1000 1000th command line argument for Squeak programs 1001 this platform's operating system 'Mac OS', 'Win32', 'unix', ... 1002 operating system version 1003 this platform's processor type 1004 vm version 1005 window system name 1006 vm build id 1007 Interpreter class (Cog VM only) 1008 Cogit class (Cog VM only) 1009 Platform source version (Cog VM only?) 1201 max filename length (Mac OS only) 1202 file last error (Mac OS only) 10001 hardware details (Win32 only) 10002 operating system details (Win32 only) 10003 graphics hardware details (Win32 only) " <primitive: 149> ^ nil! Item was added: + ----- Method: SmalltalkImage>>isHeadless (in category 'vm parameters') ----- + isHeadless + "Answer whether the command-line specified to launch the VM headless." + self optionsDo: + [ : each | (#('display=none' '-headless' '-vm-display-null' ) includes: each) ifTrue: [ ^ true ] ]. + ^ false! Item was added: + ----- Method: SmalltalkImage>>namedArguments (in category 'command line') ----- + namedArguments + "Assume arguments passed to the image are key->value pairs, answer a Dictionary of the argument names and their values." + | argName value index paramNameValueDictionary | + paramNameValueDictionary := Dictionary new. + index := 1. + [ argName := self argumentAt: index. + argName isEmptyOrNil ] whileFalse: + [ index := index + 1. + value := (self argumentAt: index) ifNil: [ String empty ]. + paramNameValueDictionary + at: argName asUppercase + put: value. + index := index + 1 ]. + ^ paramNameValueDictionary! Item was changed: ----- Method: SmalltalkImage>>options (in category 'command line') ----- options "Answer an array with all the command line options." - "Smalltalk commandLine options" + ^ Array streamContents: + [ : stream | self optionsDo: + [ : each | stream nextPut: each ] ]! - - ^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>>optionsDo: (in category 'command line') ----- + optionsDo: aBlock + "Enumerate the command-line arguments passed to the vm only. This does not include arguments passed to the image." + 1 + to: 1000 + by: 1 + do: + [ : n | + (self optionAt: n) + ifNil: [ ^ self ] + ifNotNil: [ : opt | aBlock value: opt ] ]! Item was removed: - ----- Method: Utilities class>>mostRecentlySubmittedMessage (in category 'recent method submissions') ----- - mostRecentlySubmittedMessage - self deprecated: 'Use RecentMessages default mostRecent'. - ^ RecentMessages default mostRecent.!
More information about the Squeak-dev mailing list |