Squeak-dev July 2013

squeak-dev@lists.squeakfoundation.org

50 participants
342 discussions

Re: [squeak-dev] The Trunk: Network-fbs.142.mcz
by Frank Shearar 25 Jul '13

25 Jul '13

On 25 July 2013 08:46, <commits(a)source.squeak.org> wrote: > 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]]]! Checking for strings is... not the best thing you could do. I'd _much_ rather see something like "Smalltalk platform isMacOS" or similar. frank

3 2

[OT] Need new email client
by Casey Ransberger 25 Jul '13

25 Jul '13

Gmail has gone off the deep end. All of the commit messages are being automatically hidden behind a "Promotions" tab which I can't fathom wanting in the first place. That's what the Spam folder is for, and commit messages don't go there. It's also made interacting on the list more work in other ways. I'm ready to fire Gmail. Anything which reduces my productivity while I'm pontificating aimlessly on a mailing list and isn't allowed to tell me how often it's breached my interests except by increments of 0...999 has got to go. I've looked at maybe using Celeste, but the dependency on the orphaned Scamper kind of has me doubtful that the experience isn't going to be painful. Any recommendations? Like maybe a client that still defaults, or has an option, to bottom-post? IMAP support is a plus. I'm running OS X 10.7.5, and Raspbian Wheezy. In the meantime, I will continue to sacrifice my privacy in order to protect yours by using M-x spook in Emacs to generate fun things to paste into emails like Watergate 9705 Samford Road computer terrorism JFK Becker world domination SDI UOP sniper Mantis bemd industrial intelligence Hugo Chavez LABLINK rs9512c. Thanks in advance folks! -- Casey Ransberger

7 7

[ANN] Cuis 4.2 is released
by Juan Vuletich (mail lists) 25 Jul '13

25 Jul '13

Hi Folks, I've just pushed Cuis 4.2 to the new repos: https://github.com/Cuis-Smalltalk/Stable and to https://github.com/Cuis-Smalltalk/Development . Biggest news is package dependency support by Ken Dickey and me. Several packages were extracted from the image, and are included in the repo. Now, the base image is below 500 classes and below 100kLOC. I also added a new package "SignalProcessing". Enjoy! Cheers, Juan Vuletich

1 0

SmalltalkImage semi-self-references
by Frank Shearar 25 Jul '13

25 Jul '13

Look at method sources containing "SmalltalkImage current". Filter the list to only show methods for the SmalltalkImage class. There are 23-odd methods in SmalltalkImage, on the instance side, that send "SmalltalkImage current". Why? Why not just replace all these sends with "self"? Under what circumstances might we even have SmalltalkImage current ~= self? (Never mind that "Smalltalk current" is hardcoded to return Smalltalk, anyway.) I suggest we just use "self" in these messages. Thoughts? Comments? frank

10 23

Re: [squeak-dev] The Trunk: TrueType-fbs.25.mcz
by H. Hirzel 25 Jul '13

25 Jul '13

On Thu, 25 Jul 2013 08:02:40.868 0000, commits(a)source.squeak.org <commits(a)source.squeak.org> wrote: > Frank Shearar uploaded a new version of TrueType to project The Trunk: > http://source.squeak.org/trunk/TrueType-fbs.25.mcz > > ==================== Summary ==================== > > Name: TrueType-fbs.25 > Author: fbs > Time: 25 July 2013, 9:02:47.403 am > UUID: 36e831df-1fcc-674c-8dc0-82246dc0028f > Ancestors: TrueType-fbs.24 > > SmalltalkImage current -> Smalltalk. Thank you for this change! --Hannes

1 0

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

25 Jul '13

Frank Shearar uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-fbs.25.mcz ==================== Summary ==================== Name: TrueType-fbs.25 Author: fbs Time: 25 July 2013, 9:02:47.403 am UUID: 36e831df-1fcc-674c-8dc0-82246dc0028f Ancestors: TrueType-fbs.24 SmalltalkImage current -> Smalltalk. =============== Diff against TrueType-fbs.24 =============== Item was changed: ----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') ----- fontPathsDo: aBlock "Evaluate aBlock with all of the font paths that should be searched on the current platform" "Start with the current directory" aBlock value: FileDirectory default pathName. "Then subdirectory 'fonts'" aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName. "Platform specific directories" + Smalltalk platformName caseOf:{ - SmalltalkImage current platformName caseOf:{ ['Win32'] -> [ "Standard Windows fonts directory" aBlock value: 'C:\Windows\Fonts'. ]. ['Mac OS'] -> [ "Standard system fonts directory" aBlock value: '/Library/Fonts'. ]. ['unix'] -> [ | base | "Standard fonts are in /usr/share/fonts/*" base := '/usr/share/fonts'. (FileDirectory on: base) directoryNames do:[:dn| aBlock value: base, '/', dn]. ]. } otherwise:[]. !

1 0

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

25 Jul '13

Frank Shearar uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-fbs.489.mcz ==================== Summary ==================== Name: Tools-fbs.489 Author: fbs Time: 25 July 2013, 8:59:51.9 am UUID: 91b8789c-87f2-d941-9ed5-432aec4a1aca Ancestors: Tools-fbs.488 SmalltalkImage current -> Smalltalk. =============== Diff against Tools-fbs.488 =============== Item was changed: ----- Method: ChangeList class>>browseRecentLog (in category 'public access') ----- browseRecentLog "ChangeList browseRecentLog" "Prompt with a menu of how far back to go to browse the current image's changes log file" ^ self browseRecentLogOn: (SourceFiles at: 2) + startingFrom: Smalltalk lastQuitLogPosition! - startingFrom: SmalltalkImage current lastQuitLogPosition! Item was changed: ----- Method: ChangeList class>>getRecentLocatorWithPrompt: (in category 'public access') ----- 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: CodeHolder>>informPossiblyCorruptSource (in category 'misc') ----- informPossiblyCorruptSource | sourcesName | + sourcesName := FileDirectory localNameFor: Smalltalk sourcesName. - sourcesName := FileDirectory localNameFor: SmalltalkImage current sourcesName. self inform: 'There may be a problem with your sources file!! The source code for every method should (usually) start with the method selector but this is not the case with this method!! You may proceed with caution but it is recommended that you get a new source file. This can happen if you download the "' , sourcesName , '" file, or the ".changes" file you use, as TEXT. It must be transfered in BINARY mode, even if it looks like a text file, to preserve the CR line ends. Mac users: This may have been caused by Stuffit Expander. To prevent the files above to be converted to Mac line ends when they are expanded, do this: Start the program, then from Preferences... in the File menu, choose the Cross Platform panel, then select "Never" and press OK. Then expand the compressed archive again. (Occasionally, the source code for a method may legitimately start with a non-alphabetic character -- for example, Behavior method #formalHeaderPartsFor:. In such rare cases, you can happily disregard this warning.)'!

1 0

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

25 Jul '13

Frank Shearar uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-fbs.244.mcz ==================== Summary ==================== Name: Tests-fbs.244 Author: fbs Time: 25 July 2013, 8:55:25.056 am UUID: c331e496-09f7-d844-b28c-9b30fe401874 Ancestors: Tests-fbs.243 SmalltalkImage current -> Smalltalk. =============== Diff against Tests-fbs.243 =============== Item was changed: Object subclass: #PrimCallControllerAbstract instanceVariableNames: 'treatedMethods logStream changeStatusOfFailedCallsFlag' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! + !PrimCallControllerAbstract commentStamp: 'fbs 7/25/2013 07:16' prior: 0! - !PrimCallControllerAbstract commentStamp: 'nice 3/25/2010 23:02' prior: 0! A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation. External prim calls are used to access internal and external modules (plugins) as shown by + Smalltalk listLoadedModules. + Smalltalk listBuiltinModules. - SmalltalkImage current listLoadedModules. - SmalltalkImage current listBuiltinModules. Note: not loaded external modules (since they have not been called so far) are not shown by these methods. Highlight: dis/en-abling prims by a PCC works for both internal and external modules!! To help you choosing the right subclass, some properties are listed in the following table: Functionality/Property | PCCByLiterals PCCByCompilation ------------------------------------------------------------------------------------------------------ testing plugins | suited not suited permanent disabling of external prim calls | no yes ------------------------------------------------------------------------------------------------------ method changes visible in changeset | no yes enabling survives snapshot/compilation | yes yes disabling survives snapshot/compilation | no yes speed disabling | fast medium speed enabling | fast slow CompiledMethod pointer valid after en/dis-abling | yes no Important: Be careful with mixing the use of different PCCs!! PCCByLiterals does not see prims disabled by PCCByCompilation and vice versa. For playing around you should start with PCCByLiterals; use PCCByCompilation only, if you know what you are doing!! In protocols 'ui controlling', 'ui logging' and 'ui querying' (please look into this class) are the most important user interface methods. Thereafter the methods in 'ui testing' could be of interest. Useful expressions: Controlling: "Factorial example" | pcc tDisabled tEnabled tEnabled2 | pcc := PCCByLiterals new logStream: Transcript. "logStream set here for more info" pcc disableCallsIntoModule: 'LargeIntegers'. tDisabled := [1000 factorial] timeToRun. pcc enableDisabled. tEnabled := [1000 factorial] timeToRun. tEnabled2 := [1000 factorial] timeToRun. {tDisabled. tEnabled. tEnabled2} Note: You shouldn't switch off module 'LargeIntegers' for a longer time, since this slows down your system. Querying: PCCByLiterals new methodsWithCall. "all calls" PCCByLiterals new methodsWithCall: 'prim1'. "call in all modules or without module" PCCByLiterals new methodsWithCallIntoModule: nil. "all calls without module" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers'. "all calls into module 'LargeIntegers'" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers' forClass: Integer. "all calls into module 'LargeIntegers' in class Integer" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers' forClasses: Integer withAllSubclasses. "all calls into module 'LargeIntegers' in class Integer withAllSubclasses" | pcc | (pcc := PCCByLiterals new) methodsWithCall collect: [:mRef | {mRef. pcc extractCallModuleNames: mRef}]. Structure: treatedMethods Dictionary of MethodReferences->#disabled/#enabled -- contains changed methods and how they are changed last logStream WriteStream -- shows info about changed methods ifNotNil changeStatusOfFailedCalls Boolean -- if status of failed calls should be changed, default is false! Item was changed: ----- Method: SmalltalkImageTest>>testImageName (in category 'testing') ----- testImageName "Non regression test for http://bugs.squeak.org/view.php?id=7351" | shortImgName fullImgName fullChgName | shortImgName := 'Squeak3.10.2-7179-basic'. + fullImgName := Smalltalk fullNameForImageNamed: shortImgName. + fullChgName := Smalltalk fullNameForChangesNamed: shortImgName. - fullImgName := SmalltalkImage current fullNameForImageNamed: shortImgName. - fullChgName := SmalltalkImage current fullNameForChangesNamed: shortImgName. FileDirectory splitName: fullImgName to: [:path :name | + self assert: path = Smalltalk imagePath. - self assert: path = SmalltalkImage current imagePath. self assert: name = 'Squeak3.10.2-7179-basic.image'.]. FileDirectory splitName: fullChgName to: [:path :name | + self assert: path = Smalltalk imagePath. - self assert: path = SmalltalkImage current imagePath. self assert: name = 'Squeak3.10.2-7179-basic.changes'.].!

1 0

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: 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

← Newer
1
...
4
5
6
7
8
9
10
...
35
Older →

Jump to page: