'From Squeak3.8alpha of ''17 July 2004'' [latest update: #5976] on 2 August 2004 at 7:01:55 pm'! !ChangeList class methodsFor: 'fileIn/Out' stamp: 'nk 8/2/2004 17:57'! browseCompressedChangesFile: fullName "Browse the selected file in fileIn format." | zipped unzipped | fullName ifNil: [^Beeper beep]. zipped := GZipReadStream on: (FileStream readOnlyFileNamed: fullName). unzipped := MultiByteBinaryOrTextStream with: zipped binary contents asString. ChangeList browseStream: unzipped reset.! ! !HandMorph class methodsFor: 'accessing' stamp: 'nk 7/30/2004 21:39'! compositionWindowManager CompositionWindowManager ifNotNil: [^CompositionWindowManager]. SmalltalkImage current platformName = 'Win32' ifTrue: [^CompositionWindowManager := ImmWin32 new]. (SmalltalkImage current platformName = 'unix' and: [(SmalltalkImage current getSystemAttribute: 1005) = 'X11']) ifTrue: [^CompositionWindowManager := ImmX11 new]. ^CompositionWindowManager := ImmAbstractPlatform new! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:40'! clipboardInterpreterClass | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^WinShiftJISClipboardInterpreter]. platformName = 'Mac OS' ifTrue: [^MacShiftJISClipboardInterpreter]. ^platformName = 'unix' ifTrue: [(ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [MacShiftJISClipboardInterpreter] ifFalse: [UnixJPClipboardInterpreter]] ifFalse: [ NoConversionClipboardInterpreter ]! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:43'! defaultEncodingName | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^'utf-8']. (#('Win32' 'ZaurusOS') includes: platformName) ifTrue: [^'shift-jis']. platformName = 'Mac OS' ifTrue: [^('10*' match: SmalltalkImage current osVersion) ifTrue: ['utf-8'] ifFalse: ['shift-jis']]. ^'unix' = platformName ifTrue: ['euc-jp'] ifFalse: ['mac-roman']! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 22:37'! inputInterpreterClass | platformName osVersion encoding | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^WinShiftJISInputInterpreter]. platformName = 'Mac OS' ifTrue: [^('10*' match: SmalltalkImage current osVersion) ifTrue: [MacUnicodeInputInterpreter] ifFalse: [MacShiftJISInputInterpreter]]. platformName = 'unix' ifTrue: [encoding := X11Encoding encoding. (EUCJPTextConverter encodingNames includes: encoding) ifTrue: [^UnixEUCJPInputInterpreter]. (UTF8TextConverter encodingNames includes: encoding) ifTrue: [^UnixUTF8JPInputInterpreter]. (ShiftJISTextConverter encodingNames includes: encoding) ifTrue: [^MacShiftJISInputInterpreter]]. ^MacRomanInputInterpreter! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:44'! systemConverterClass | platformName osVersion encoding | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^UTF8TextConverter]. (#('Win32' 'ZaurusOS') includes: platformName) ifTrue: [^ShiftJISTextConverter]. platformName = 'Mac OS' ifTrue: [^('10*' match: SmalltalkImage current osVersion) ifTrue: [UTF8TextConverter] ifFalse: [ShiftJISTextConverter]]. platformName = 'unix' ifTrue: [encoding := X11Encoding encoding. encoding ifNil: [^EUCJPTextConverter]. ^encoding]. ^MacRomanTextConverter! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:45'! clipboardInterpreterClass | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^WinKSX1001ClipboardInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: SmalltalkImage current osVersion) ifTrue: [^NoConversionClipboardInterpreter] ifFalse: [^WinKSX1001ClipboardInterpreter]]. platformName = 'unix' ifTrue: [(ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [^WinKSX1001ClipboardInterpreter] ifFalse: [^NoConversionClipboardInterpreter]]. ^NoConversionClipboardInterpreter! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:45'! defaultEncodingName | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^'utf-8' copy]. (#('Win32' 'Mac OS' 'ZaurusOS') includes: platformName) ifTrue: [^'euc-kr' copy]. (#('unix') includes: platformName) ifTrue: [^'euc-kr' copy]. ^'mac-roman'! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:46'! inputInterpreterClass | platformName osVersion encoding | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^WinKSX1001InputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: SmalltalkImage current osVersion) ifTrue: [^MacUnicodeInputInterpreter] ifFalse: [^WinKSX1001InputInterpreter]]. platformName = 'unix' ifTrue: [encoding := X11Encoding encoding. (EUCJPTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (UTF8TextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (ShiftJISTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]]. ^MacRomanInputInterpreter! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'nk 7/30/2004 21:39'! defaultEncodingName | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^'utf-8' copy]. (#('Win32' 'Mac OS' 'ZaurusOS') includes: platformName) ifTrue: [^'iso8859-1' copy]. (#('unix') includes: platformName) ifTrue: [^'iso8859-1' copy]. ^'mac-roman'! ! !Locale class methodsFor: 'platform specific' stamp: 'nk 7/30/2004 21:45'! defaultEncodingName: languageSymbol | encodings platformName osVersion | 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! ! !Locale class methodsFor: 'platform specific' stamp: 'nk 7/30/2004 21:45'! defaultInputInterpreter | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoInputInterpreter new]. platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new]. ^NoInputInterpreter new! ! !MultiSymbol class methodsFor: 'as yet unclassified' stamp: 'nk 7/29/2004 10:23'! compareTiming " MultiSymbol compareTiming " | answer t selectorList implementorLists flattenedList md | answer _ WriteStream on: String new. SmalltalkImage current timeStamp: answer. answer cr; cr. answer nextPutAll: MethodDictionary instanceCount printString,' method dictionaries'; cr; cr. answer nextPutAll: ( MethodDictionary allInstances inject: 0 into: [ :sum :each | sum + each size]) printString, ' method dictionary entries'; cr; cr. md _ MethodDictionary allInstances. t _ [100 timesRepeat: [md do: [ :each | each includesKey: #majorShrink]]] timeToRun. answer nextPutAll: t printString, ' ms to check all method dictionaries for #majorShrink 1000 times'; cr; cr. selectorList _ MultiSymbol selectorsContaining: 'help'. t _ [ 3 timesRepeat: [selectorList collect: [:each | SystemNavigation default allImplementorsOf: each]] ] timeToRun. answer nextPutAll: t printString,' ms to do #allImplementorsOf: for ', selectorList size printString,' selectors like *help* 3 times'; cr; cr. t _ [ 3 timesRepeat: [ selectorList do: [:eachSel | md do: [ :eachMd | eachMd includesKey: eachSel]] ] ] timeToRun. answer nextPutAll: t printString,' ms to do #includesKey: for ', md size printString,' methodDicts for ', selectorList size printString,' selectors like *help* 3 times'; cr; cr. #('help' 'majorShrink') do: [ :substr | answer nextPutAll: (MultiSymbol selectorsContaining: substr) size printString, ' selectors containing "',substr,'"'; cr. t _ [ 3 timesRepeat: [ selectorList _ MultiSymbol selectorsContaining: substr. ]. ] timeToRun. answer nextPutAll: t printString,' ms to find MultiSymbols containing *',substr,'* 3 times'; cr. t _ [ 3 timesRepeat: [ selectorList _ MultiSymbol selectorsContaining: substr. implementorLists _ selectorList collect: [:each | Smalltalk allImplementorsOf: each]. flattenedList _ SortedCollection new. implementorLists do: [:each | flattenedList addAll: each]. ]. ] timeToRun. answer nextPutAll: t printString,' ms to find implementors of *',substr,'* 3 times'; cr; cr. ]. StringHolder new contents: answer contents; openLabel: 'timing'. ! ! !Player methodsFor: 'misc' stamp: 'nk 7/30/2004 17:54'! adoptScriptsFrom "Let the user click on another object form which the receiver should obtain scripts and code" | aMorph | Sensor waitNoButton. aMorph := ActiveWorld chooseClickTarget. aMorph ifNil: [^Beeper beep]. (((aMorph isKindOf: SketchMorph) and: [aMorph player belongsToUniClass]) and: [self belongsToUniClass not]) ifTrue: [costume acquirePlayerSimilarTo: aMorph player] ifFalse: [Beeper beep]! ! !PositionableStream methodsFor: 'fileIn/Out' stamp: 'nk 7/30/2004 17:54'! fileInSilentlyAnnouncing: announcement "This is special for reading expressions from text that has been formatted with exclamation delimitors. The expressions are read and passed to the Compiler. Answer the result of compilation. Put up a progress report with the given announcement as the title." | val chunk | [self atEnd] whileFalse: [self skipSeparators. [val := (self peekFor: $!!) ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self] ifFalse: [chunk := self nextChunk. self checkForPreamble: chunk. Compiler evaluate: chunk logged: true]] on: InMidstOfFileinNotification do: [:ex | ex resume: true]. self skipStyleChunk]. self close. "Note: The main purpose of this banner is to flush the changes file." SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'. self flag: #ThisMethodShouldNotBeThere. "sd" SystemNavigation new allBehaviorsDo: [:cl | cl removeSelectorSimply: #DoIt; removeSelectorSimply: #DoItIn:]. ^val! ! !MultiByteBinaryOrTextStream methodsFor: 'character encoding conversion' stamp: 'nk 8/2/2004 17:02'! converter converter ifNil: [converter _ self class defaultConverter]. ^ converter ! ! !MultiByteBinaryOrTextStream methodsFor: 'character encoding conversion' stamp: 'nk 8/2/2004 17:01'! guessConverter ^ (self originalContents includesSubString: (ByteArray withAll: {27. 36}) asString) ifTrue: [CompoundTextConverter new] ifFalse: [self class defaultConverter ]! ! !MultiByteBinaryOrTextStream methodsFor: 'positioning' stamp: 'nk 7/29/2004 12:02'! reset super reset. isBinary ifNil: [isBinary _ false]. collection class == ByteArray ifTrue: ["Store as String and convert as needed." collection _ collection asString. isBinary _ true]. self converter. "ensure that we have a converter."! ! !MultiByteBinaryOrTextStream class methodsFor: 'defaults' stamp: 'nk 8/2/2004 17:01'! defaultConverter ^TextConverter defaultSystemConverter! ! !MultiByteFileStream methodsFor: 'open/close' stamp: 'nk 7/30/2004 17:59'! open: fileName forWrite: writeMode | result | result := super open: fileName forWrite: writeMode. result ifNotNil: [converter ifNil: [self localName = (FileDirectory localNameFor: SmalltalkImage current sourcesName) ifTrue: [converter := MacRomanTextConverter new] ifFalse: [converter := UTF8TextConverter new]]. self detectLineEndConvention]. ^result! ! !SMSqueakMap methodsFor: 'checkpoints' stamp: 'nk 8/2/2004 13:33'! createCheckpointNumber: number "Export me using an ImageSegment. This is used for checkpointing the map on disk in a form that can be brought into an independent image. We do not overwrite older versions, since using ImageSegments is an intermediate hack anyway we don't care about the disk waste!! Sidenote: Some refactoring was needed to produce a .gz file directly so I didn't bother." | is fname stream oldMutex | fname _ self filename, '.', number asString, '.s'. (self directory fileExists: fname) ifTrue: [self error: 'Checkpoint already exists!!']. stream _ self directory newFileNamed: fname. stream binary. checkpointNumber _ number. oldMutex _ mutex. mutex _ nil. self clearCaches. [is _ ImageSegment new. is copyFromRoots: (Array with: self) sizeHint: 1000000 areUnique: true. is writeForExportOn: stream. self compressFile: (self directory oldFileNamed: fname). isDirty _ false] ensure: [mutex _ oldMutex]. ^is! ! !SMSqueakMap methodsFor: 'checkpoints' stamp: 'nk 8/2/2004 13:27'! getLastCheckpointWithFilename "Return a readstream on a fresh checkpoint gzipped imagesegment. First we check if we are dirty and must create a new checkpoint. The filename is tacked on at the end so that the checkpoint number can be used on the client side too." | directory fname | isDirty ifTrue: [self createCheckpoint]. directory _ self directory. fname _ self lastCheckpointFilename. fname ifNil: [self error: 'No checkpoint available']. ^((directory oldFileNamed: fname) converter: Latin1TextConverter new; contentsOfEntireFile), ':', fname! ! !SMSqueakMap methodsFor: 'public' stamp: 'nk 7/30/2004 07:09'! reload "Reload the map from the latest checkpoint on disk. The opposite of #purge." | fname stream map | fname _ self lastCheckpointFilename. fname ifNil: [self error: 'No checkpoint available!!']. stream _ (self directory oldFileNamed: fname) asUnZippedStream. stream ifNil: [self error: 'Couldn''t open stream on checkpoint file!!']. stream converter: Latin1TextConverter new. [map _ (stream reset fileInObjectAndCode) install arrayOfRoots first] ensure: [stream close]. self copyFrom: map! ! !SMSqueakMap methodsFor: 'logging' stamp: 'nk 8/2/2004 13:27'! openLogFile "Pick the newest logfile available and open it." | fileName | fileName _ self logFileName. fileName ifNil: [^nil]. ^(self directory oldFileNamed: fileName) converter: Latin1TextConverter new; yourself. ! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:46'! clipboardInterpreterClass | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^WinGB2312ClipboardInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: SmalltalkImage current osVersion) ifTrue: [^NoConversionClipboardInterpreter] ifFalse: [^WinGB2312ClipboardInterpreter]]. platformName = 'unix' ifTrue: [(ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [^MacShiftJISClipboardInterpreter] ifFalse: [^NoConversionClipboardInterpreter]]. ^NoConversionClipboardInterpreter! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:46'! defaultEncodingName | platformName osVersion | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^'utf-8' copy]. (#('Win32' 'Mac OS' 'ZaurusOS') includes: platformName) ifTrue: [^'gb2312' copy]. (#('unix') includes: platformName) ifTrue: [^'euc-cn' copy]. ^'mac-roman'! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'nk 7/30/2004 21:46'! inputInterpreterClass | platformName osVersion encoding | platformName := SmalltalkImage current platformName. osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^WinGB2312InputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: SmalltalkImage current osVersion) ifTrue: [^MacUnicodeInputInterpreter] ifFalse: [^WinGB2312InputInterpreter]]. platformName = 'unix' ifTrue: [encoding := X11Encoding encoding. (EUCJPTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (UTF8TextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (ShiftJISTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]]. ^MacRomanInputInterpreter! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'nk 7/30/2004 17:55'! undo: evt "revert to a previous state. " | temp poly pen | self flag: #bob. "what is undo in multihand environment?" undoBuffer ifNil: [^Beeper beep]. "nothing to go back to" (poly := self valueOfProperty: #polygon) ifNotNil: [poly delete. self setProperty: #polygon toValue: nil. ^self]. temp := paintingForm. paintingForm := undoBuffer. undoBuffer := temp. "can get back to what you had by undoing again" pen := self get: #paintingFormPen for: evt. pen ifNil: [^Beeper beep]. pen setDestForm: paintingForm. formCanvas := paintingForm getCanvas. "used for lines, ovals, etc." formCanvas := formCanvas copyOrigin: self topLeft negated clipRect: (0 @ 0 extent: bounds extent). self render: bounds! ! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'nk 7/29/2004 10:08'! aboutThisSystem "Identify software version" ^ self inform: (self systemInformationString, '\', self m17nVersion, '\', self nihongoVersion) withCRs.! ! !ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 7/29/2004 10:56'! contentStream "Answer my contents as a text stream. Default is no conversion, since we don't know what the bytes mean." | s | s _ MultiByteBinaryOrTextStream on: (String new: self uncompressedSize). s converter: Latin1TextConverter. self extractTo: s. s reset. ^ s. ! ! MultiCharacterScanner class removeSelector: #new!