Packages July 2013

packages@lists.squeakfoundation.org

1 participants
522 discussions

The Trunk: System-fbs.577.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

Frank Shearar uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-fbs.577.mcz ==================== Summary ==================== Name: System-fbs.577 Author: fbs Time: 25 July 2013, 8:53:24.156 am UUID: 70bbc861-0488-be4d-9735-46511275adb2 Ancestors: System-fbs.576 SmalltalkImage current -> Smalltalk. =============== Diff against System-fbs.576 =============== Item was changed: ----- Method: AutoStart class>>checkForPluginUpdate (in category 'updating') ----- checkForPluginUpdate | pluginVersion updateURL | World ifNotNil: [ World install. ActiveHand position: 100@100]. HTTPClient isRunningInBrowser ifFalse: [^false]. pluginVersion := AbstractLauncher extractParameters + at: (Smalltalk platformName copyWithout: Character space) asUppercase - at: (SmalltalkImage current platformName copyWithout: Character space) asUppercase ifAbsent: [^false]. updateURL := AbstractLauncher extractParameters at: 'UPDATE_URL' ifAbsent: [^false]. ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! Item was changed: ----- Method: ChangeSet class>>getRecentLocatorWithPrompt: (in category 'scanning') ----- getRecentLocatorWithPrompt: aPrompt "Prompt with a menu of how far back to go. Return nil if user backs out. Otherwise return the number of characters back from the end of the .changes file the user wishes to include" "ChangeList getRecentPosition" | end changesFile banners positions pos chunk i | changesFile := (SourceFiles at: 2) readOnlyCopy. banners := OrderedCollection new. positions := OrderedCollection new. end := changesFile size. + pos := Smalltalk lastQuitLogPosition. - pos := SmalltalkImage current lastQuitLogPosition. [pos = 0 or: [banners size > 20]] whileFalse: [changesFile position: pos. chunk := changesFile nextChunk. i := chunk indexOfSubCollection: 'priorSource: ' startingAt: 1. i > 0 ifTrue: [positions addLast: pos. banners addLast: (chunk copyFrom: 5 to: i-2). pos := Number readFrom: (chunk copyFrom: i+13 to: chunk size)] ifFalse: [pos := 0]]. changesFile close. pos := UIManager default chooseFrom: banners values: positions title: aPrompt. pos == nil ifTrue: [^ nil]. ^ end - pos! Item was changed: ----- Method: DigitalSignatureAlgorithm>>initRandomNonInteractively (in category 'initialization') ----- initRandomNonInteractively [self initRandom: (SoundService default randomBitsFromSoundInput: 512)] ifError: [self initRandomFromString: Time millisecondClockValue printString, Date today printString, + Smalltalk platformName printString].! - SmalltalkImage current platformName printString].! Item was changed: ----- Method: ExternalSettings class>>preferenceDirectory (in category 'accessing') ----- preferenceDirectory | prefDirName path | prefDirName := self preferenceDirectoryName. + path := Smalltalk vmPath. - path := SmalltalkImage current vmPath. ^(FileDirectory default directoryExists: prefDirName) ifTrue: [FileDirectory default directoryNamed: prefDirName] ifFalse: [ ((FileDirectory on: path) directoryExists: prefDirName) ifTrue: [(FileDirectory on: path) directoryNamed: prefDirName] ifFalse: [nil]] ! Item was changed: ----- Method: FileDirectory class>>openSources:andChanges:forImage: (in category '*System-Files') ----- openSources: sourcesName andChanges: changesName forImage: imageName "Open the changes and sources files and install them in SourceFiles. Inform the user of problems regarding write permissions or CR/CRLF mixups." "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.'. 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: [Smalltalk platformName = 'Mac OS' - ifTrue: [SmalltalkImage current platformName = 'Mac OS' ifTrue: [msg := msg , ' Make sure the sources file is not an Alias.']. self inform: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName)]. (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! Item was changed: ----- Method: FileDirectory class>>openSources:forImage: (in category '*System-Files') ----- openSources: fullSourcesName forImage: imageName "We first do a check to see if a compressed version ofthe sources file is present. Open the .sources file read-only after searching in: a) the directory where the VM lives b) the directory where the image came from c) the DefaultDirectory (which is likely the same as b unless the SecurityManager has changed it). " | sources fd sourcesName | (fullSourcesName endsWith: 'sources') ifTrue: ["Look first for a sources file in compressed format." sources := self openSources: (fullSourcesName allButLast: 7) , 'stc' forImage: imageName. sources ifNotNil: [^ CompressedSourceStream on: sources]]. sourcesName := FileDirectory localNameFor: fullSourcesName. "look for the sources file or an alias to it in the VM's directory" + fd := FileDirectory on: Smalltalk vmPath. - fd := FileDirectory on: SmalltalkImage current vmPath. (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. sources ifNotNil: [^ sources]. "look for the sources file or an alias to it in the image directory" fd := FileDirectory on: (FileDirectory dirPathFor: imageName). (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. sources ifNotNil: [^ sources]. "look for the sources in the current directory" fd := DefaultDirectory. (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. "sources may still be nil here" ^sources ! Item was changed: ----- Method: GetTextTranslator class>>setupLocaleDirs (in category 'translation data layout') ----- setupLocaleDirs | dirs sepa localesDirName | sepa := FileDirectory slash. SystemDefaultLocaleDirs := nil. dirs := self systemDefaultLocaleDirs. localesDirName := 'locale'. + dirs add: (Smalltalk imagePath) , sepa , localesDirName. + dirs add: (Smalltalk vmPath) , sepa , localesDirName. - dirs add: (SmalltalkImage current imagePath) , sepa , localesDirName. - dirs add: (SmalltalkImage current vmPath) , sepa , localesDirName. ^dirs! Item was changed: ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') ----- shouldUsePluginAPI "HTTPClient shouldUsePluginAPI" self isRunningInBrowser ifFalse: [^false]. self browserSupportsAPI ifFalse: [^false]. "The Mac plugin calls do not work in full screen mode" + ^((Smalltalk platformName = 'Mac OS') - ^((SmalltalkImage current platformName = 'Mac OS') and: [Project current lastScreenModeSelected]) not! Item was changed: ----- Method: ImageSegment class>>folder (in category 'fileIn/Out') ----- folder | im | "Full path name of segments folder. Be sure to duplicate and rename the folder when you duplicate and rename an image. Is $_ legal in all file systems?" + im := Smalltalk imageName. - im := SmalltalkImage current imageName. ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'! Item was changed: ----- Method: ImageSegment class>>startUp (in category 'fileIn/Out') ----- startUp | choice | "Minimal thing to assure that a .segs folder is present" (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ (FileDirectory default includesKey: (FileDirectory localNameFor: self folder)) ifFalse: [ choice := UIManager default chooseFrom: #('Create folder' 'Quit without saving') title: 'The folder with segments for this image is missing.\' withCRs, self folder, '\If you have moved or renamed the image file,\' withCRs, 'please Quit and rename the segments folder in the same way'. choice = 1 ifTrue: [FileDirectory default createDirectory: self folder]. + choice = 2 ifTrue: [Smalltalk snapshot: false andQuit: true]]] - choice = 2 ifTrue: [SmalltalkImage current snapshot: false andQuit: true]]] ! Item was changed: ----- Method: Locale class>>defaultEncodingName: (in category 'platform specific') ----- defaultEncodingName: languageSymbol | encodings platformName osVersion | + platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. - platformName := SmalltalkImage current platformName. - osVersion := SmalltalkImage current getSystemAttribute: 1002. encodings := self platformEncodings at: languageSymbol ifAbsent: [self platformEncodings at: #default]. encodings at: platformName ifPresent: [:encoding | ^encoding]. encodings at: platformName , ' ' , osVersion ifPresent: [:encoding | ^encoding]. ^encodings at: #default! Item was changed: ----- Method: Locale class>>defaultInputInterpreter (in category 'platform specific') ----- defaultInputInterpreter | platformName osVersion | + platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. - platformName := SmalltalkImage current platformName. - osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoInputInterpreter new]. platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new]. ^NoInputInterpreter new! Item was changed: ----- Method: MessageTally>>computeGCStats (in category 'private') ----- computeGCStats "Compute the deltas in the GC stats. Serves for reporting, hibernating and unhibernating." + Smalltalk getVMParameters keysAndValuesDo: - SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcVal isNumber ifTrue: [gcStats at: idx put: (gcVal - (gcStats at: idx))]]! Item was changed: ----- Method: MessageTally>>spyAllEvery:on: (in category 'initialize-release') ----- spyAllEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy all the system processes" | myDelay | aBlock isBlock ifFalse: [ self error: 'spy needs a block here' ]. self class: aBlock receiver class method: aBlock method. "set up the probe" myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. Timer := [ [true] whileTrue: [ | observedProcess | startTime := Time millisecondClockValue. myDelay wait. observedProcess := Processor preemptedProcess. self tally: observedProcess suspendedContext in: observedProcess "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "cancel the probe and return the value" "Could have already been terminated. See #terminateTimerProcess" self class terminateTimerProcess. self computeGCStats. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- spyEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy only on the active process (in which aBlock is run)" | myDelay observedProcess | aBlock isBlock ifFalse: [ self error: 'spy needs a block here' ]. self class: aBlock receiver class method: aBlock method. "set up the probe" observedProcess := Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. time0 := Time millisecondClockValue. Timer := [ [ true ] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. self tally: Processor preemptedProcess suspendedContext in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "cancel the probe and return the value" "Could have already been terminated. See #terminateTimerProcess" self class terminateTimerProcess. self computeGCStats. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>spyEvery:onProcess:forMilliseconds: (in category 'initialize-release') ----- spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration "Create a spy and spy on the given process at the specified rate." | myDelay observedProcess sem | (aProcess isKindOf: Process) ifFalse: [self error: 'spy needs a Process here']. self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method. "set up the probe" observedProcess := aProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. endTime := time0 + msecDuration. sem := Semaphore new. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. Timer := [ [ startTime := Time millisecondClockValue. myDelay wait. self tally: Processor preemptedProcess suspendedContext in: (observedProcess == Processor preemptedProcess ifTrue: [ observedProcess ] ifFalse: [ nil ]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs. startTime < endTime ] whileTrue. sem signal. ] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. "activate the probe and wait for it to finish" sem wait. self computeGCStats. time := Time millisecondClockValue - time0! Item was changed: ----- Method: PowerManagement class>>itsyVoltage (in category 'computing') ----- 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 := Smalltalk getSystemAttribute: 1200. - n := SmalltalkImage current getSystemAttribute: 1200. n ifNil: [^ 'no voltage attribute']. ^ (n asNumber / 150.0 roundTo: 0.01) asString , ' volts'! Item was changed: ----- Method: Preferences class>>disableProgrammerFacilities (in category 'personalization') ----- disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities. You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!! This is a drastic step!! Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileHardCodedPref: #cmdGesturesEnabled enable: false. "No halos, etc." self compileHardCodedPref: #cmdKeysInText enable: false. "No user commands invokable via cmd-key combos in text editor" self enable: #noviceMode. "No control-menu" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. + Smalltalk saveAs! - SmalltalkImage current saveAs! Item was changed: ----- Method: Preferences class>>personalizeUserMenu: (in category 'personalization') ----- personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: Utilities action: #updateFromServer. + aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem. - aMenu add: 'about this system...' translated target: SmalltalkImage current action: #aboutThisSystem. aMenu addLine. aMenu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. aMenu balloonTextForLastItem: 'Whether prevailing flaps should be shown in the project right now or not.' translated! Item was changed: ----- Method: Project>>storeToMakeRoom (in category 'file in/out') ----- storeToMakeRoom "Write out enough projects to fulfill the space goals. Include the size of the project about to come in." | params memoryEnd goalFree cnt gain proj skip tried | GoalFreePercent ifNil: [GoalFreePercent := 33]. GoalNotMoreThan ifNil: [GoalNotMoreThan := 20000000]. + params := Smalltalk getVMParameters. - params := SmalltalkImage current getVMParameters. memoryEnd := params at: 3. " youngSpaceEnd := params at: 2. free := memoryEnd - youngSpaceEnd. " goalFree := GoalFreePercent asFloat / 100.0 * memoryEnd. goalFree := goalFree min: GoalNotMoreThan. world isInMemory ifFalse: ["enough room to bring it in" goalFree := goalFree + (self projectParameters at: #segmentSize ifAbsent: [0])]. cnt := 30. gain := Smalltalk garbageCollectMost. "skip a random number of projects that are in memory" proj := self. skip := 6 atRandom. [proj := proj nextInstance ifNil: [Project someInstance]. proj world isInMemory ifTrue: [skip := skip - 1]. skip > 0] whileTrue. cnt := 0. tried := 0. [gain > goalFree] whileFalse: [ proj := proj nextInstance ifNil: [Project someInstance]. proj storeSegment ifTrue: ["Yes, did send its morphs to the disk" gain := gain + (proj projectParameters at: #segmentSize ifAbsent: [20000]). "a guess" Beeper beep. (cnt := cnt + 1) > 5 ifTrue: [^ self]]. "put out 5 at most" (tried := tried + 1) > 23 ifTrue: [^ self]]. "don't get stuck in a loop"! Item was changed: ----- Method: ResourceManager>>convertMapNameForBackwardcompatibilityFrom: (in category 'backward-compatibility') ----- convertMapNameForBackwardcompatibilityFrom: aString + (Smalltalk platformName = 'Mac OS' + and: ['10*' match: Smalltalk osVersion]) - (SmalltalkImage current platformName = 'Mac OS' - and: ['10*' match: SmalltalkImage current osVersion]) ifTrue: [^aString convertFromWithConverter: ShiftJISTextConverter new]. ^aString convertFromSystemString! Item was changed: ----- Method: SecurityManager>>generateLocalKeyPair (in category 'private') ----- generateLocalKeyPair "SecurityManager default generateLocalKeyPair" "Generate a key set on the local machine." | dsa | dsa := DigitalSignatureAlgorithm new. dsa initRandomFromString: Time millisecondClockValue printString, Date today printString, + Smalltalk platformName printString. - SmalltalkImage current platformName printString. privateKeyPair := dsa generateKeySet. self storeSecurityKeys.! Item was changed: ----- Method: SmalltalkImage>>calcEndianness (in category 'system attributes') ----- calcEndianness | bytes word blt | "What endian-ness is the current hardware? The String '1234' will be stored into a machine word. On BigEndian machines (the Mac), $1 will be the high byte if the word. On LittleEndian machines (the PC), $4 will be the high byte." + "Smalltalk endianness" - "SmalltalkImage current endianness" bytes := ByteArray withAll: #(0 0 0 0). "(1 2 3 4) or (4 3 2 1)" word := WordArray with: 16r01020304. blt := (BitBlt toForm: (Form new hackBits: bytes)) sourceForm: (Form new hackBits: word). blt combinationRule: Form over. "store" blt sourceY: 0; destY: 0; height: 1; width: 4. blt sourceX: 0; destX: 0. blt copyBits. "paste the word into the bytes" bytes first = 1 ifTrue: [^ #big]. bytes first = 4 ifTrue: [^ #little]. self error: 'Ted is confused'.! Item was changed: ----- Method: SmalltalkImage>>currentChangeSetString (in category 'image, changes names') ----- currentChangeSetString + "Smalltalk currentChangeSetString" - "SmalltalkImage current currentChangeSetString" ^ 'Current Change Set: ' translated, ChangeSet current name! Item was changed: ----- Method: SmalltalkImage>>fixObsoleteReferences (in category 'housekeeping') ----- fixObsoleteReferences + "Smalltalk fixObsoleteReferences" - "SmalltalkImage current fixObsoleteReferences" Smalltalk garbageCollect; garbageCollect. Preference allInstances do: [:each | | informee | 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: SmalltalkImage>>getVMParameters (in category 'vm parameters') ----- 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:.)" + "Smalltalk getVMParameters" - "SmalltalkImage current getVMParameters" <primitive: 254> self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>imageName (in category 'image, changes names') ----- imageName "Answer the full path name for the current image." + "Smalltalk imageName" - "SmalltalkImage current imageName" | str | str := self primImageName. ^ (FilePath pathName: str isEncoded: true) asSqueakPathName. ! Item was changed: ----- Method: SmalltalkImage>>imagePath (in category 'image, changes names') ----- imagePath "Answer the path for the directory containing the image file." + "Smalltalk imagePath" - "SmalltalkImage current imagePath" ^ FileDirectory dirPathFor: self imageName ! Item was changed: ----- Method: SmalltalkImage>>lastUpdateString (in category 'sources, changes log') ----- lastUpdateString + "Smalltalk lastUpdateString" - "SmalltalkImage current lastUpdateString" ^'latest update: #' translated, SystemVersion current highestUpdate printString! Item was changed: ----- Method: SmalltalkImage>>listBuiltinModules (in category 'modules') ----- listBuiltinModules + "Smalltalk listBuiltinModules" - "SmalltalkImage current listBuiltinModules" "Return a list of all builtin modules (e.g., plugins). Builtin plugins are those that are compiled with the VM directly, as opposed to plugins residing in an external shared library. The list will include all builtin plugins regardless of whether they are currently loaded or not. Note that the list returned is not sorted!!" | modules index name | modules := WriteStream on: (Array new: 20). index := 1. [ name := self listBuiltinModule: index. name ifNil:[^modules contents]. modules nextPut: name. index := index + 1 ] repeat! Item was changed: ----- Method: SmalltalkImage>>listLoadedModules (in category 'modules') ----- listLoadedModules + "Smalltalk listLoadedModules" - "SmalltalkImage current listLoadedModules" "Return a list of all currently loaded modules (e.g., plugins). Loaded modules are those that currently in use (e.g., active). The list returned will contain all currently active modules regardless of whether they're builtin (that is compiled with the VM) or external (e.g., residing in some external shared library). Note that the returned list is not sorted!!" | modules index name | modules := WriteStream on: (Array new: 20). index := 1. [ name := self listLoadedModule: index. name ifNil:[^modules contents]. modules nextPut: name. index := index + 1 ] repeat! Item was changed: ----- Method: SmalltalkImage>>primImageName (in category 'image, changes names') ----- primImageName "Answer the full path name for the current image." + "Smalltalk imageName" - "SmalltalkImage current imageName" <primitive: 121> self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>primVmPath (in category 'image, changes names') ----- primVmPath "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" <primitive: 142> ^ ''! Item was changed: ----- Method: SmalltalkImage>>saveAsNewVersion (in category 'sources, changes log') ----- saveAsNewVersion "Save the image/changes using the next available version number." + "Smalltalk saveAsNewVersion" - "SmalltalkImage current saveAsNewVersion" | newName changesName aName anIndex | aName := FileDirectory baseNameFor: (FileDirectory default localNameFor: self imageName). anIndex := aName lastIndexOf: FileDirectory dot asCharacter ifAbsent: [nil]. (anIndex notNil and: [(aName copyFrom: anIndex + 1 to: aName size) isAllDigits]) ifTrue: [aName := aName copyFrom: 1 to: anIndex - 1]. newName := FileDirectory default nextNameFor: aName extension: FileDirectory imageSuffix. changesName := self fullNameForChangesNamed: newName. "Check to see if there is a .changes file that would cause a problem if we saved a new .image file with the new version number" (FileDirectory default fileOrDirectoryExists: changesName) ifTrue: [^ self inform: 'There is already .changes file of the desired name, ', newName, ' curiously already present, even though there is no corresponding .image file. Please remedy manually and then repeat your request.']. (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>>vmStatisticsReportString (in category 'vm statistics') ----- vmStatisticsReportString "StringHolderView open: (StringHolder new contents: + Smalltalk vmStatisticsReportString) label: 'VM Statistics'" - SmalltalkImage current vmStatisticsReportString) label: 'VM Statistics'" | params oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount upTime upTime2 fullGCs2 fullGCTime2 incrGCs2 incrGCTime2 tenureCount2 str | params := self getVMParameters. oldSpaceEnd := params at: 1. youngSpaceEnd := params at: 2. memoryEnd := params at: 3. fullGCs := params at: 7. fullGCTime := params at: 8. incrGCs := params at: 9. incrGCTime := params at: 10. tenureCount := params at: 11. upTime := Time millisecondClockValue. str := WriteStream on: (String new: 1000). str nextPutAll: 'uptime '; print: (upTime / 1000 / 60 // 60); nextPut: $h; print: (upTime / 1000 / 60 \\ 60) asInteger; nextPut: $m; print: (upTime / 1000 \\ 60) asInteger; nextPut: $s; cr. str nextPutAll: 'memory '; nextPutAll: memoryEnd asStringWithCommas; nextPutAll: ' bytes'; cr. str nextPutAll: ' old '; nextPutAll: oldSpaceEnd asStringWithCommas; nextPutAll: ' bytes ('; print: (oldSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' young '; nextPutAll: (youngSpaceEnd - oldSpaceEnd) asStringWithCommas; nextPutAll: ' bytes ('; print: (youngSpaceEnd - oldSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' used '; nextPutAll: youngSpaceEnd asStringWithCommas; nextPutAll: ' bytes ('; print: (youngSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' free '; nextPutAll: (memoryEnd - youngSpaceEnd) asStringWithCommas; nextPutAll: ' bytes ('; print: (memoryEnd - youngSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: 'GCs '; nextPutAll: (fullGCs + incrGCs) asStringWithCommas. fullGCs + incrGCs > 0 ifTrue: [ str nextPutAll: ' ('; print: (upTime / (fullGCs + incrGCs)) maxDecimalPlaces: 1; nextPutAll: ' ms between GCs)' ]. str cr. str nextPutAll: ' full '; nextPutAll: fullGCs asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: fullGCTime asStringWithCommas; nextPutAll: ' ms ('; print: (fullGCTime / upTime * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime)'. fullGCs = 0 ifFalse: [str nextPutAll: ', avg '; print: (fullGCTime / fullGCs) maxDecimalPlaces: 1; nextPutAll: ' ms']. str cr. str nextPutAll: ' incr '; nextPutAll: incrGCs asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: ' ms ('; print: (incrGCTime / upTime * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime), avg '; print: (incrGCTime / incrGCs) maxDecimalPlaces: 1; nextPutAll: ' ms'; cr. str nextPutAll: ' tenures '; nextPutAll: tenureCount asStringWithCommas. tenureCount = 0 ifFalse: [str nextPutAll: ' (avg '; print: incrGCs // tenureCount; nextPutAll: ' GCs/tenure)']. str cr. LastStats ifNil: [LastStats := Array new: 6] ifNotNil: [ upTime2 := upTime - (LastStats at: 1). fullGCs2 := fullGCs - (LastStats at: 2). fullGCTime2 := fullGCTime - (LastStats at: 3). incrGCs2 := incrGCs - (LastStats at: 4). incrGCTime2 := incrGCTime - (LastStats at: 5). tenureCount2 := tenureCount - (LastStats at: 6). str nextPutAll: self textMarkerForShortReport ; nextPutAll: (fullGCs2 + incrGCs2) asStringWithCommas. fullGCs2 + incrGCs2 > 0 ifTrue: [ str nextPutAll: ' ('; print: upTime2 // (fullGCs2 + incrGCs2); nextPutAll: ' ms between GCs)'. ]. str cr. str nextPutAll: ' uptime '; print: (upTime2 / 1000.0) maxDecimalPlaces: 1; nextPutAll: ' s'; cr. str nextPutAll: ' full '; nextPutAll: fullGCs2 asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: fullGCTime2 asStringWithCommas; nextPutAll: ' ms ('; print: (fullGCTime2 / upTime2 * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime)'. fullGCs2 = 0 ifFalse: [str nextPutAll: ', avg '; print: (fullGCTime2 / fullGCs2) maxDecimalPlaces: 1; nextPutAll: ' ms']. str cr. str nextPutAll: ' incr '; nextPutAll: incrGCs2 asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: incrGCTime2 asStringWithCommas; nextPutAll: ' ms ('; print: (incrGCTime2 / upTime2 * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime), avg '. incrGCs2 > 0 ifTrue: [ str print: (incrGCTime2 / incrGCs2) maxDecimalPlaces: 1; nextPutAll: ' ms' ]. str cr. str nextPutAll: ' tenures '; nextPutAll: tenureCount2 asStringWithCommas. tenureCount2 = 0 ifFalse: [str nextPutAll: ' (avg '; print: incrGCs2 // tenureCount2; nextPutAll: ' GCs/tenure)']. str cr. ]. LastStats at: 1 put: upTime. LastStats at: 2 put: fullGCs. LastStats at: 3 put: fullGCTime. LastStats at: 4 put: incrGCs. LastStats at: 5 put: incrGCTime. LastStats at: 6 put: tenureCount. ^ str contents ! Item was changed: ----- Method: SmalltalkImage>>vmStatisticsShortString (in category 'vm statistics') ----- vmStatisticsShortString "Convenience item for access to recent statistics only" + "StringHolderView open: (StringHolder new contents: Smalltalk vmStatisticsShortString) - "StringHolderView open: (StringHolder new contents: SmalltalkImage current vmStatisticsShortString) label: 'VM Recent Statistics'" ^ (ReadStream on: self vmStatisticsReportString) upToAll: 'Since'; nextLine; upToEnd ! Item was changed: ----- Method: SmalltalkImage>>vmVersion (in category 'system attributes') ----- vmVersion "Return a string identifying the interpreter version" + "Smalltalk vmVersion" - "SmalltalkImage current vmVersion" ^self getSystemAttribute: 1004! Item was changed: ----- Method: SmartRefStream>>writeConversionMethodIn:fromInstVars:to:renamedFrom: (in category 'class changed shape') ----- writeConversionMethodIn: newClass fromInstVars: oldList to: newList renamedFrom: oldName "The method convertToCurrentVersion:refStream: was not found in newClass. Write a default conversion method for the author to modify. If method exists, append new info into the end." | code newOthers oldOthers copied newCode | newOthers := newList asOrderedCollection "copy". oldOthers := oldList asOrderedCollection "copy". copied := OrderedCollection new. newList do: [:instVar | (oldList includes: instVar) ifTrue: [ instVar isInteger ifFalse: [copied add: instVar]. newOthers remove: instVar. oldOthers remove: instVar]]. code := WriteStream on: (String new: 500). + code cr; cr; tab; nextPutAll: '"From ', SystemVersion current version, ' [', Smalltalk lastUpdateString; - code cr; cr; tab; nextPutAll: '"From ', SystemVersion current version, ' [', SmalltalkImage current lastUpdateString; nextPutAll: '] on ', Date today printString, '"'; cr. code tab; nextPutAll: '"These variables are automatically stored into the new instance: '. code nextPutAll: copied asArray printString; nextPut: $.; cr. code tab; nextPutAll: 'Test for this particular conversion.'; nextPutAll: ' Get values using expressions like (varDict at: ''foo'')."'; cr; cr. (newOthers size = 0) & (oldOthers size = 0) & (oldName == nil) ifTrue: [^ self]. "Instance variables are the same. Only the order changed. No conversion needed." (newOthers size > 0) ifTrue: [ code tab; nextPutAll: '"New variables: ', newOthers asArray printString, '. If a non-nil value is needed, please assign it."'; cr]. (oldOthers size > 0) ifTrue: [ code tab; nextPutAll: '"These are going away ', oldOthers asArray printString, '. Possibly store their info in some other variable?"'; cr]. oldName ifNotNil: [ code tab; nextPutAll: '"Test for instances of class ', oldName, '.'; cr. code tab; nextPutAll: 'Instance vars with the same name have been moved here."'; cr. ]. code tab; nextPutAll: '"Move your code above the ^ super... Delete extra comments."'; cr. (newClass includesSelector: #convertToCurrentVersion:refStream:) ifTrue: ["append to old methods" newCode := (newClass sourceCodeAt: #convertToCurrentVersion:refStream:), code contents] ifFalse: ["new method" newCode := 'convertToCurrentVersion: varDict refStream: smartRefStrm', code contents, ' ^ super convertToCurrentVersion: varDict refStream: smartRefStrm']. newClass compile: newCode classified: 'object fileIn'. "If you write a conversion method beware that the class may need a version number change. This only happens when two conversion methods in the same class have the same selector name. (A) The inst var lists of the new and old versions intials as some older set of new and old inst var lists. or (B) Twice in a row, the class needs a conversion method, but the inst vars stay the same the whole time. (For an internal format change.) If either is the case, fileouts already written with the old (wrong) version number, say 2. Your method must be able to read files that say version 2 but are really 3, until you expunge the erroneous version 2 files from the universe." ! Item was changed: ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category 'updating') ----- 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 , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html' - requestURL: updateURL , (SmalltalkImage current platformName copyWithout: Character space) asLowercase , '.html' target: '_top'. ^false! Item was changed: ----- Method: SystemVersion class>>checkAndApplyUpdates: (in category 'updating') ----- checkAndApplyUpdates: availableUpdate "SystemVersion checkAndApplyUpdates: nil" ^(availableUpdate isNil or: [availableUpdate > SystemVersion current highestUpdate]) ifTrue: [ (self confirm: 'There are updates available. Do you want to install them now?') ifFalse: [^false]. Utilities readServerUpdatesThrough: availableUpdate saveLocally: false updateImage: true. + Smalltalk snapshot: true andQuit: false. - SmalltalkImage current snapshot: true andQuit: false. true] ifFalse: [false]! Item was changed: ----- Method: SystemVersion class>>currentPluginVersion (in category 'updating') ----- currentPluginVersion + ^Smalltalk vmVersion! - ^SmalltalkImage current vmVersion!

1 0

The Trunk: System-fbs.577.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

The Trunk: Sound-fbs.36.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

Frank Shearar uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-fbs.36.mcz ==================== Summary ==================== Name: Sound-fbs.36 Author: fbs Time: 25 July 2013, 8:50:56.412 am UUID: 762fd943-db8f-4042-a39e-503409126b52 Ancestors: Sound-fbs.35 SmalltalkImage current -> Smalltalk. =============== Diff against Sound-fbs.35 =============== Item was changed: ----- Method: AbstractSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file." | bufSize stereoBuffer reverseBytes | self reset. bufSize := (2 * self samplingRate rounded) min: samplesToStore. "two second buffer" stereoBuffer := SoundBuffer newStereoSampleCount: bufSize. + reverseBytes := bigEndianFlag ~= (Smalltalk isBigEndian). - reverseBytes := bigEndianFlag ~= (SmalltalkImage current isBigEndian). 'Storing audio...' displayProgressFrom: 0 to: samplesToStore during: [:bar | | remaining out | remaining := samplesToStore. [remaining > 0] whileTrue: [ bar value: samplesToStore - remaining. stereoBuffer primFill: 0. "clear the buffer" self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1. out := self isStereo ifTrue: [stereoBuffer] ifFalse: [stereoBuffer extractLeftChannel]. reverseBytes ifTrue: [out reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (out size // 2) putAll: out startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]]. remaining := remaining - bufSize]]. ! Item was changed: ----- Method: LoopedSampledSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." | reverseBytes | (self isStereo or: [self samplingRate ~= originalSamplingRate]) ifTrue: [ ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. "optimization: if I'm not stereo and sampling rates match, just store my buffer" + reverseBytes := bigEndianFlag ~= Smalltalk isBigEndian. - reverseBytes := bigEndianFlag ~= SmalltalkImage current isBigEndian. reverseBytes ifTrue: [leftSamples reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (leftSamples size // 2) putAll: leftSamples startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: leftSamples monoSampleCount do: [:i | aBinaryStream int16: (leftSamples at: i)]]. reverseBytes ifTrue: [leftSamples reverseEndianness]. "restore to original endianness" ! Item was changed: ----- Method: SampledSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." | reverseBytes | self samplingRate ~= originalSamplingRate ifTrue: [ ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. "optimization: if sampling rates match, just store my buffer" + reverseBytes := bigEndianFlag ~= Smalltalk isBigEndian. - reverseBytes := bigEndianFlag ~= SmalltalkImage current isBigEndian. reverseBytes ifTrue: [samples reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (samples size // 2) putAll: samples startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: samples monoSampleCount do: [:i | aBinaryStream int16: (samples at: i)]]. reverseBytes ifTrue: [samples reverseEndianness]. "restore to original endianness" ! Item was changed: ----- Method: SoundBuffer class>>startUpFrom: (in category 'objects from disk') ----- startUpFrom: anImageSegment "In this case, do we need to swap word halves when reading this segment?" + ^Smalltalk endianness ~~ anImageSegment endianness - ^SmalltalkImage current endianness ~~ anImageSegment endianness ifTrue: [Message selector: #swapHalves "will be run on each instance"] ifFalse: [nil]! Item was changed: ----- Method: SoundBuffer>>restoreEndianness (in category 'objects from disk') ----- restoreEndianness "This word object was just read in from a stream. It was stored in Big Endian (Mac) format. Swap each pair of bytes (16-bit word), if the current machine is Little Endian. Why is this the right thing to do? We are using memory as a byteStream. High and low bytes are reversed in each 16-bit word, but the stream of words ascends through memory. Different from a Bitmap." | hack blt | + Smalltalk isLittleEndian ifTrue: [ - SmalltalkImage current isLittleEndian ifTrue: [ "The implementation is a hack, but fast for large ranges" hack := Form new hackBits: self. blt := (BitBlt toForm: hack) sourceForm: hack. blt combinationRule: Form reverse. "XOR" blt sourceY: 0; destY: 0; height: self size; width: 1. blt sourceX: 0; destX: 1; copyBits. "Exchange bytes 0 and 1" blt sourceX: 1; destX: 0; copyBits. blt sourceX: 0; destX: 1; copyBits. blt sourceX: 2; destX: 3; copyBits. "Exchange bytes 2 and 3" blt sourceX: 3; destX: 2; copyBits. blt sourceX: 2; destX: 3; copyBits]. ! Item was changed: ----- Method: SoundBuffer>>saveAsAIFFFileSamplingRate:on: (in category 'utilities') ----- saveAsAIFFFileSamplingRate: rate on: aBinaryStream "Store this mono sound buffer in AIFF file format with the given sampling rate on the given stream." | sampleCount s swapBytes | sampleCount := self monoSampleCount. aBinaryStream nextPutAll: 'FORM' asByteArray. aBinaryStream nextInt32Put: (2 * sampleCount) + ((7 * 4) + 18). aBinaryStream nextPutAll: 'AIFF' asByteArray. aBinaryStream nextPutAll: 'COMM' asByteArray. aBinaryStream nextInt32Put: 18. aBinaryStream nextNumber: 2 put: 1. "channels" aBinaryStream nextInt32Put: sampleCount. aBinaryStream nextNumber: 2 put: 16. "bits/sample" self storeExtendedFloat: rate on: aBinaryStream. aBinaryStream nextPutAll: 'SSND' asByteArray. aBinaryStream nextInt32Put: (2 * sampleCount) + 8. aBinaryStream nextInt32Put: 0. aBinaryStream nextInt32Put: 0. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization: write sound buffer directly to file" + swapBytes := Smalltalk isLittleEndian. - swapBytes := SmalltalkImage current isLittleEndian. swapBytes ifTrue: [self reverseEndianness]. "make big endian" aBinaryStream next: (self size // 2) putAll: self startingAt: 1. "size in words" swapBytes ifTrue: [self reverseEndianness]. "revert to little endian" ^ self]. 1 to: sampleCount do: [:i | s := self at: i. aBinaryStream nextPut: ((s bitShift: -8) bitAnd: 16rFF). aBinaryStream nextPut: (s bitAnd: 16rFF)]. ! Item was changed: ----- Method: SunAudioFileWriter>>appendSamples: (in category 'other') ----- appendSamples: aSoundBuffer "Append the given SoundBuffer to my stream." | swapBytes s | (stream isKindOf: StandardFileStream) ifTrue: [ "optimization: write sound buffer directly to file" + swapBytes := Smalltalk isLittleEndian. - swapBytes := SmalltalkImage current isLittleEndian. swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "make big endian" stream next: (aSoundBuffer size // 2) putAll: aSoundBuffer startingAt: 1. "size in words" swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "revert to little endian" ^ self]. "for non-file streams:" s := WriteStream on: (ByteArray new: 2 * aSoundBuffer monoSampleCount). 1 to: aSoundBuffer monoSampleCount do: [:i | s int16: (aSoundBuffer at: i)]. self appendBytes: s contents. !

1 0

The Trunk: Sound-fbs.36.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

The Trunk: Sound-fbs.36.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

The Trunk: Protocols-fbs.42.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

Frank Shearar uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-fbs.42.mcz ==================== Summary ==================== Name: Protocols-fbs.42 Author: fbs Time: 25 July 2013, 8:48:37.551 am UUID: f4e1858f-9c99-c848-bd9b-10e1a5518142 Ancestors: Protocols-fbs.41 SmalltalkImage current -> Smalltalk. =============== Diff against Protocols-fbs.41 =============== Item was changed: ----- Method: Vocabulary class>>newSystemVocabulary (in category 'eToy vocabularies') ----- newSystemVocabulary "Answer a Vocabulary object representing significant requests one can make to the Smalltalk object" | aVocabulary | aVocabulary := self new. aVocabulary vocabularyName: #System. aVocabulary documentation: 'Useful messages you might want to send to the current Smalltalk image'. aVocabulary initializeFromTable: #( (aboutThisSystem none () none (basic queries) 'put up a message describing the system' unused) (saveAsNewVersion none () none (services) 'advance to the next available image-version number and save the image under that new name' unused znak) (datedVersion none () String (queries) 'the version of the Squeak system') (endianness none () String (queries) 'big or little - the byte-ordering of the hardware Squeak is currently running on') (exitToDebugger none () none (dangerous) 'exits to the host debugger. Do not use this -- I guarantee you will be sorry.') (bytesLeft none () Number (basic services) 'perform a garbage collection and answer the number of bytes of free space remaining in the system') "(browseAllCallsOn: none ((aSelector String)) none (#'queries') 'browse all calls on a selector') (browseAllImplementorsOf: none ((aSelector String)) none (#'queries') 'browse all implementors of a selector')" "(allMethodsWithSourceString:matchCase: none ((aString String) (caseSensitive Boolean)) none (queries) 'browse all methods that have the given source string, making the search case-sensitive or not depending on the argument provided.') (browseMethodsWithString:matchCase: none ((aString String) (caseSensitive Boolean)) none (queries) 'browse all methods that contain the given string in any string literal, making the search case-sensitive or not depending on the argument provided.') (browseAllImplementorsOf:localTo: none ((aSelector String) (aClass Class)) none (#'queries') 'browse all implementors of a selector that are local to a class')" ). "(isKindOf: none ((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass')" ^ aVocabulary "Vocabulary initialize" "Vocabulary addStandardVocabulary: Vocabulary newSystemVocabulary" + "Smalltalk basicInspect" + "Smalltalk beViewed" - "SmalltalkImage current basicInspect" - "SmalltalkImage current beViewed" !

1 0

The Trunk: Protocols-fbs.42.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

The Trunk: Protocols-fbs.42.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

The Trunk: Network-fbs.142.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

Frank Shearar uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-fbs.142.mcz ==================== Summary ==================== Name: Network-fbs.142 Author: fbs Time: 25 July 2013, 8:46:43.161 am UUID: 6e2a56e3-7200-e843-976b-70b6a274d722 Ancestors: Network-fbs.141 SmalltalkImage current -> Smalltalk. =============== Diff against Network-fbs.141 =============== Item was changed: ----- Method: InternetConfiguration class>>shutDown (in category 'system startup') ----- shutDown + (Smalltalk platformName = 'Mac OS') ifTrue: [ - (SmalltalkImage current platformName = 'Mac OS') ifTrue: [ HTTPSocket stopUsingProxyServer] ! Item was changed: ----- Method: InternetConfiguration class>>startUp (in category 'system startup') ----- startUp + (Smalltalk platformName = 'Mac OS') ifTrue: [ - (SmalltalkImage current platformName = 'Mac OS') ifTrue: [ self useHTTPProxy ifTrue: [ (self getHTTPProxyHost findTokens: ':') ifNotEmpty: [:p | HTTPSocket useProxyServerNamed: p first port: p second asInteger]]]! Item was changed: ----- Method: NetNameResolver class>>testIPv6 (in category 'tests') ----- testIPv6 "NetNameResolver testIPv6" | infos addr sock size host serverSocket listeningSocket clientSocket | World findATranscript: World currentEvent. Transcript clear. + "Transcript show: Smalltalk listLoadedModules; cr." - "Transcript show: SmalltalkImage current listLoadedModules; cr." self initializeNetwork. Transcript show: '---- host name ----'; cr. size := NetNameResolver primHostNameSize. host := String new: size. NetNameResolver primHostNameResult: host. Transcript show: host; cr. Transcript show: '---- address information ----'; cr. Transcript show: (infos := SocketAddressInformation forHost: 'localhost' service: 'echo' flags: 0 addressFamily: 0 socketType: 0 protocol: 0) printString; cr. Transcript show: '---- port manipulation ----'; cr. addr := infos first socketAddress. Transcript show: addr port printString; cr. addr port: 1234. Transcript show: addr port printString; cr. Transcript show: addr printString; cr. Transcript show: '---- client socket ----'; cr. Transcript show: (infos := SocketAddressInformation forHost: 'localhost' service: 'echo' flags: 0 addressFamily: 0 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP) printString; cr. infos do: [:info | Transcript show: 'Trying ', info printString, '... '. (sock := info connect) notNil ifTrue: [sock sendData: 'hello' count: 5. Transcript show: sock receiveData printString. sock close; destroy]. Transcript cr]. Transcript show: '---- localhost defaults: loopback and wildcard addresses ----'; cr. Transcript show: (SocketAddress loopbacks) printString; cr. Transcript show: (SocketAddress wildcards) printString; cr. Transcript show: (SocketAddress loopback4) printString; cr. Transcript show: (SocketAddress wildcard4) printString; cr. Transcript show: '---- impossible constraints ----'; cr. Transcript show: (SocketAddressInformation forHost: 'localhost' service: 'echo' flags: 0 addressFamily: 0 socketType: SocketAddressInformation socketTypeDGram protocol: SocketAddressInformation protocolTCP) printString; cr. Transcript show: '---- INET4 client-server ----'; cr. Transcript show: (infos := SocketAddressInformation forHost: '' service: '4242' flags: SocketAddressInformation passiveFlag addressFamily: SocketAddressInformation addressFamilyINET4 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP) printString; cr. listeningSocket := infos first listenWithBacklog: 5. Transcript show: (infos := SocketAddressInformation forHost: 'localhost' service: '4242' flags: 0 addressFamily: SocketAddressInformation addressFamilyINET4 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP) printString; cr. clientSocket := infos first connect. serverSocket := listeningSocket accept. serverSocket sendData: 'Hi there!!' count: 9. Transcript show: clientSocket receiveData; cr. Transcript nextPutAll: 'client side local/remote: '; print: clientSocket localSocketAddress; space; print: clientSocket remoteSocketAddress; cr. Transcript nextPutAll: 'server side local/remote: '; print: serverSocket localSocketAddress; space; print: serverSocket remoteSocketAddress; cr; endEntry. clientSocket close; destroy. serverSocket close; destroy. listeningSocket close; destroy. Transcript show: '---- INET6 client-server ----'; cr. Transcript show: (infos := SocketAddressInformation forHost: '' service: '4242' flags: SocketAddressInformation passiveFlag addressFamily: SocketAddressInformation addressFamilyINET6 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP) printString; cr. infos isEmpty ifTrue: [Transcript show: 'FAIL -- CANNOT CREATE INET6 SERVER'; cr] ifFalse: [listeningSocket := infos first listenWithBacklog: 5. Transcript show: (infos := SocketAddressInformation forHost: 'localhost' service: '4242' flags: 0 addressFamily: SocketAddressInformation addressFamilyINET6 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP) printString; cr. clientSocket := infos first connect. serverSocket := listeningSocket accept. serverSocket sendData: 'Hi there!!' count: 9. Transcript show: clientSocket receiveData; cr. Transcript nextPutAll: 'client side local/remote: '; print: clientSocket localSocketAddress; space; print: clientSocket remoteSocketAddress; cr. Transcript nextPutAll: 'server side local/remote: '; print: serverSocket localSocketAddress; space; print: serverSocket remoteSocketAddress; cr; endEntry. clientSocket close; destroy. serverSocket close; destroy. listeningSocket close; destroy]. Transcript show: '---- trivial tests done ---'; cr.! Item was changed: ----- Method: PRServerDirectory>>putSmalltalkInfoInto: (in category 'private') ----- putSmalltalkInfoInto: args "private - fills args with information from Smalltalk" self flag: #todo. " lastest small-land changeset / small-land version " #(#datedVersion #osVersion #platformName #platformSubtype #vmPath #vmVersion #imageName #changesName #sourcesName #listBuiltinModules #listLoadedModules #getVMParameters ) do: [:each | | value | + value := Smalltalk perform: each. - value := SmalltalkImage current perform: each. args at: 'extra-' , each asString put: {value asString isoToSqueak}]! Item was changed: ----- Method: ServerDirectory class>>determineLocalServerDirectory: (in category 'server prefs') ----- 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. + (Smalltalk platformName = 'Mac OS' - (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!

1 0

The Trunk: Network-fbs.142.mcz
by commits＠source.squeak.org 25 Jul '13

25 Jul '13

1 0

← Newer
1
2
3
4
5
6
7
8
...
53
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages July 2013