!FillInTheBlankMorph methodsFor: 'invoking' stamp: 'ka 12/2/2003 17:21'! getUserResponse "Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels." "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." | w | w _ self world. w ifNil: [response isOctetString ifTrue: [^ response asOctetString] ifFalse: [^ response]]. done _ false. w activeHand newKeyboardFocus: textPane. [done] whileFalse: [w doOneCycle]. self delete. w doOneCycle. response ifNil: [^ response]. ^ response isOctetString ifTrue: [response asOctetString] ifFalse: [response]. ! ! !MacRomanClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'ka 12/2/2003 17:10'! toSystemClipboard: aString | result | aString isOctetString ifTrue: [^ aString asOctetString isoToSqueak]. result _ WriteStream on: (String new: aString size). aString do: [:each | each asciiValue < 256 ifTrue: [result nextPut: each isoToSqueak]]. ^ result contents. ! ! !Preferences class methodsFor: 'themes' stamp: 'yo 12/19/2003 01:21'! takanawa self setPreferencesFrom: #( (alternativeScrollbarLook true) (alternativeWindowLook true) (classicNavigatorEnabled true) (eToyFriendly true) (haloTransitions true) (honorDesktopCmdKeys false) (includeSoundControlInNavigator true) (magicHalos true) (menuKeyboardControl false) (mouseOverHalos true) (preserveTrash true) (projectViewsInWindows false) (propertySheetFromHalo true) (showDirectionHandles true) (soundStopWhenDone true) (unlimitedPaintArea true) (uniqueNamesInHalos true) (uniTilesClassic false) (canRecordWhilePlaying true) (soundQuickStart true) )! ! !ProjectViewMorph methodsFor: 'events' stamp: 'sumim 11/21/2003 13:43'! deletingProject: aProject "My project is being deleted. Delete me as well." self flag: #bob. "zapping projects" project == aProject ifTrue: [ self owner isSystemWindow ifTrue: [self owner model: nil; delete]. self delete].! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 12/18/2003 23:30'! bonk: glyphForm with: bonkForm "Bonking means to run through the glyphs clearing out black pixels between characters to prevent them from straying into an adjacent character as a result of, eg, bolding or italicizing" "Uses the bonkForm to erase at every character boundary in glyphs." | bb offset x | offset _ bonkForm offset x. bb _ BitBlt current toForm: glyphForm. bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox; combinationRule: Form erase; destY: 0. x _ self xTable. (x isMemberOf: SparseLargeTable) ifTrue: [ x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ] ifFalse: [ 1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ]. ! ! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 19 December 2003 at 9:23:30 pm'! Object subclass: #FilePath instanceVariableNames: 'squeakPathName systemPathName converter ' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-BaseClasses'! !LanguageEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 18:45'! defaultFileNameConverter ^ self defaultSystemConverter. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:06'! coverter: aTextConverter converter class ~= aTextConverter class ifTrue: [ converter _ aTextConverter. systemPathName _ squeakPathName convertToWithConverter: converter ]. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:07'! pathName: p isEncoded: isEncoded converter _ Smalltalk systemLanguage defaultFileNameConverter. isEncoded ifTrue: [ squeakPathName _ p convertFromWithConverter: converter. systemPathName _ p. ] ifFalse: [ squeakPathName _ p isOctetString ifTrue: [p asOctetString] ifFalse: [p]. systemPathName _ squeakPathName convertToWithConverter: converter. ]. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:07'! pathName ^ squeakPathName. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:07'! printOn: aStream aStream nextPutAll: 'FilePath('''. aStream nextPutAll: squeakPathName. aStream nextPutAll: ''')'. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:10'! asSystemPathName ^ systemPathName. ! ! !FilePath methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 21:10'! asSqueakPathName ^ self pathName. ! ! !FilePath class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 16:30'! pathName: pathName isEncoded: aBoolean ^ (self new) pathName: pathName isEncoded: aBoolean; yourself. ! ! !FilePath class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 16:30'! pathName: pathName ^ self pathName: pathName isEncoded: false. ! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! createDirectory: localFileName "Create a directory with the given name in this directory. Fail if the name is bad or if a file or directory with that name already exists." self primCreateDirectory: (self fullNameFor: localFileName) asSystemPathName ! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! deleteDirectory: localDirName "Delete the directory with the given name in this directory. Fail if the path is bad or if a directory by that name does not exist." self primDeleteDirectory: (self fullNameFor: localDirName) asSystemPathName. ! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! deleteFileNamed: localFileName ifAbsent: failBlock "Delete the file of the given name if it exists, else evaluate failBlock. If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53" | fullName | fullName _ self fullNameFor: localFileName. (StandardFileStream retryWithGC:[self primDeleteFileNamed: (self fullNameFor: localFileName) asSystemPathName] until:[:result| result notNil] forFileNamed: fullName) == nil ifTrue: [^failBlock value]. ! ! !FileDirectory methodsFor: 'private' stamp: 'yo 12/19/2003 21:13'! directoryContentsFor: fullPath "Return a collection of directory entries for the files and directories in the directory with the given path. See primLookupEntryIn:index: for further details." "FileDirectory default directoryContentsFor: ''" | entries index done entryArray f | entries _ OrderedCollection new: 200. index _ 1. done _ false. f _ fullPath asSystemPathName. [done] whileFalse: [ entryArray _ self primLookupEntryIn: f index: index. #badDirectoryPath = entryArray ifTrue: [ ^(InvalidDirectoryError pathName: pathName asSqueakPathName) signal]. entryArray == nil ifTrue: [done _ true] ifFalse: [entries addLast: (DirectoryEntry fromArray: entryArray)]. index _ index + 1]. ^ entries asArray ! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! getMacFileTypeAndCreator: fileName | results typeString creatorString | "get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)." "FileDirectory default getMacFileNamed: 'foo'" typeString _ ByteArray new: 4 withAll: ($? asInteger). creatorString _ ByteArray new: 4 withAll: ($? asInteger). [self primGetMacFileNamed: (self fullNameFor: fileName) asSystemPathName type: typeString creator: creatorString.] ensure: [typeString _ typeString asString. creatorString _ creatorString asString]. results _ Array with: typeString convertFromSystemString with: creatorString convertFromSystemString. ^results ! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! rename: oldFileName toBe: newFileName | selection oldName newName | "Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name." "Modified for retry after GC ar 3/21/98 18:09" oldName _ self fullNameFor: oldFileName. newName _ self fullNameFor: newFileName. (StandardFileStream retryWithGC:[self primRename: oldName asSystemPathName to: newName asSystemPathName] until:[:result| result notNil] forFileNamed: oldName) ~~ nil ifTrue:[^self]. (self fileExists: oldFileName) ifFalse:[ ^self error:'Attempt to rename a non-existent file'. ]. (self fileExists: newFileName) ifTrue:[ selection _ (PopUpMenu labels: 'delete old version cancel') startUpWithCaption: 'Trying to rename a file to be ', newFileName , ' and it already exists.'. selection = 1 ifTrue: [self deleteFileNamed: newFileName. ^ self rename: oldFileName toBe: newFileName]]. ^self error:'Failed to rename file'.! ! !FileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:13'! setMacFileNamed: fileName type: typeString creator: creatorString "Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)." "FileDirectory default setMacFileNamed: 'foo' type: 'TEXT' creator: 'ttxt'" self primSetMacFileNamed: (self fullNameFor: fileName) asSystemPathName type: typeString convertToSystemString creator: creatorString convertToSystemString. ! ! !StandardFileStream methodsFor: 'open/close' stamp: 'yo 12/19/2003 21:13'! open: fileName forWrite: writeMode "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode." "Changed to do a GC and retry before failing ar 3/21/98 17:25" | f | f _ fileName asSystemPathName. fileID _ StandardFileStream retryWithGC:[self primOpen: f writable: writeMode] until:[:id| id notNil] forFileNamed: fileName. fileID ifNil: [^ nil]. "allows sender to detect failure" self register. name _ fileName. rwmode _ writeMode. buffer1 _ String new: 1. ! ! !ZipArchiveMember methodsFor: 'accessing' stamp: 'yo 12/19/2003 21:13'! centralDirectoryHeaderSize | systemFileName systemFileComment systemCdExtraField | systemFileName _ fileName asSystemPathName. systemFileComment _ fileComment convertToSystemString. systemCdExtraField _ cdExtraField. ^ 46 + systemFileName size + systemCdExtraField size + systemFileComment size ! ! !ZipArchiveMember methodsFor: 'private-writing' stamp: 'yo 12/19/2003 21:13'! refreshLocalFileHeaderTo: aStream "Re-writes my local header to the given stream. To be called after writing the data stream. Assumes that fileName and localExtraField sizes didn't change since last written." | here systemFileName | here _ aStream position. systemFileName _ fileName asSystemPathName. aStream position: writeLocalHeaderRelativeOffset. aStream nextPutAll: LocalFileHeaderSignature. aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. aStream nextLittleEndianNumber: 2 put: bitFlag. aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. aStream nextLittleEndianNumber: 4 put: crc32. aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). aStream nextLittleEndianNumber: 4 put: uncompressedSize. aStream nextLittleEndianNumber: 2 put: systemFileName size. aStream nextLittleEndianNumber: 2 put: localExtraField size. aStream position: here. ! ! !ZipArchiveMember methodsFor: 'private-writing' stamp: 'yo 12/19/2003 21:13'! writeCentralDirectoryFileHeaderTo: aStream "C2 v3 V4 v5 V2" | systemFileName systemFileComment systemCdExtraField | systemFileName _ fileName asSystemPathName. systemFileComment _ fileComment convertToSystemString. systemCdExtraField _ cdExtraField. aStream nextPutAll: CentralDirectoryFileHeaderSignature. aStream nextLittleEndianNumber: 1 put: versionMadeBy. aStream nextLittleEndianNumber: 1 put: fileAttributeFormat. aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. aStream nextLittleEndianNumber: 2 put: bitFlag. aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. "These next 3 should have been updated during the write of the data" aStream nextLittleEndianNumber: 4 put: crc32. aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). aStream nextLittleEndianNumber: 4 put: uncompressedSize. aStream nextLittleEndianNumber: 2 put: systemFileName size. aStream nextLittleEndianNumber: 2 put: systemCdExtraField size. aStream nextLittleEndianNumber: 2 put: systemFileComment size. aStream nextLittleEndianNumber: 2 put: 0. "diskNumberStart" aStream nextLittleEndianNumber: 2 put: internalFileAttributes. aStream nextLittleEndianNumber: 4 put: externalFileAttributes. aStream nextLittleEndianNumber: 4 put: writeLocalHeaderRelativeOffset. aStream nextPutAll: systemFileName asByteArray. aStream nextPutAll: systemCdExtraField asByteArray. aStream nextPutAll: systemFileComment asByteArray.! ! !ZipArchiveMember methodsFor: 'private-writing' stamp: 'yo 12/19/2003 21:13'! writeLocalFileHeaderTo: aStream "Write my local header to a file handle. Stores the offset to the start of the header in my writeLocalHeaderRelativeOffset member." | systemFileName | systemFileName _ fileName asSystemPathName. aStream nextPutAll: LocalFileHeaderSignature. aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. aStream nextLittleEndianNumber: 2 put: bitFlag. aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. aStream nextLittleEndianNumber: 4 put: crc32. aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). aStream nextLittleEndianNumber: 4 put: uncompressedSize. aStream nextLittleEndianNumber: 2 put: systemFileName size. aStream nextLittleEndianNumber: 2 put: localExtraField size. aStream nextPutAll: systemFileName asByteArray. aStream nextPutAll: localExtraField asByteArray. ! ! !AcornFileDirectory methodsFor: 'file name utilities' stamp: 'yo 12/19/2003 21:14'! fullPathFor: path path isEmpty ifTrue:[^pathName asSqueakPathName]. ((path includes: $$ ) or:[path includes: $:]) ifTrue:[^path]. ^pathName asSqueakPathName, self slash, path! ! !DirectoryEntry methodsFor: 'multilingual system' stamp: 'yo 12/20/2003 01:56'! convertFromSystemName name _ (FilePath pathName: name isEncoded: true) asSqueakPathName! ! !DosFileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:14'! driveName "return a possible drive letter and colon at the start of a Path name, empty string otherwise" | firstTwoChars | ( pathName asSqueakPathName size >= 2 ) ifTrue: [ firstTwoChars _ (pathName asSqueakPathName copyFrom: 1 to: 2). (self class isDrive: firstTwoChars) ifTrue: [^firstTwoChars] ]. ^''! ! !DosFileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:15'! fullPathFor: path "Return the fully-qualified path name for the given file." path isEmpty ifTrue:[^pathName asSqueakPathName]. (path at: 1) = $\ ifTrue:[ (path size >= 2 and:[(path at: 2) = $\]) ifTrue:[^path]. "e.g., \\pipe\" ^self driveName , path "e.g., \windows\"]. (path size >= 2 and:[(path at: 2) = $: and:[path first isLetter]]) ifTrue:[^path]. "e.g., c:" ^pathName asSqueakPathName, self slash, path! ! !DosFileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:15'! relativeNameFor: path "Return the full name for path, assuming that path is a name relative to me." path isEmpty ifTrue:[^pathName asSqueakPathName]. (path at: 1) = $\ ifTrue:[ (path size >= 2 and:[(path at: 2) = $\]) ifTrue:[^super relativeNameFor: path allButFirst ]. "e.g., \\pipe\" ^super relativeNameFor: path "e.g., \windows\"]. (path size >= 2 and:[(path at: 2) = $: and:[path first isLetter]]) ifTrue:[^super relativeNameFor: (path copyFrom: 3 to: path size) ]. "e.g., c:" ^pathName asSqueakPathName, self slash, path! ! !FileDirectory methodsFor: 'enumeration' stamp: 'yo 12/19/2003 21:15'! containingDirectory "Return the directory containing this directory." ^ FileDirectory on: (FileDirectory dirPathFor: pathName asSqueakPathName) ! ! !FileDirectory methodsFor: 'private' stamp: 'yo 12/20/2003 01:54'! directoryContentsFor: fullPath "Return a collection of directory entries for the files and directories in the directory with the given path. See primLookupEntryIn:index: for further details." "FileDirectory default directoryContentsFor: ''" | entries index done entryArray f | entries _ OrderedCollection new: 200. index _ 1. done _ false. f _ fullPath asSystemPathName. [done] whileFalse: [ entryArray _ self primLookupEntryIn: f index: index. #badDirectoryPath = entryArray ifTrue: [ ^(InvalidDirectoryError pathName: pathName asSqueakPathName) signal]. entryArray == nil ifTrue: [done _ true] ifFalse: [entries addLast: (DirectoryEntry fromArray: entryArray)]. index _ index + 1]. ^ entries asArray collect: [:s | s convertFromSystemName]. ! ! !FileDirectory methodsFor: 'testing' stamp: 'yo 12/19/2003 21:15'! exists "Answer whether the directory exists" | result | result _ self primLookupEntryIn: pathName asSqueakPathName index: 1. ^ result ~= #badDirectoryPath! ! !FileDirectory methodsFor: 'enumeration' stamp: 'jm 12/5/97 12:23'! entries "Return a collection of directory entries for the files and directories in this directory. Each entry is a five-element array: (). See primLookupEntryIn:index: for further details." "FileDirectory default entries" ^ self directoryContentsFor: pathName ! ! !FileDirectory methodsFor: 'enumeration' stamp: 'yo 12/19/2003 21:15'! fullName "Return the full name of this directory." ^pathName asSqueakPathName ! ! !FileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:15'! fullPathFor: path ^path isEmpty ifTrue:[pathName asSqueakPathName] ifFalse:[path]! ! !FileDirectory methodsFor: 'enumeration' stamp: 'yo 12/19/2003 21:15'! localName "Return the local name of this directory." ^FileDirectory localNameFor: pathName asSqueakPathName! ! !FileDirectory methodsFor: 'private' stamp: 'yo 12/19/2003 18:30'! setPathName: pathString pathName _ FilePath pathName: pathString. ! ! !FileDirectory methodsFor: 'school support' stamp: 'yo 12/19/2003 19:09'! eToyUserName: aString "Set the default directory from the given user name" | dirName | dirName _ self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'" dirName ifNil:[^self]. dirName _ dirName copyReplaceAll:'*' with: aString. " dirName last = self class pathNameDelimiter ifFalse:[dirName _ dirName, self slash]. FileDirectory setDefaultDirectoryFrom: dirName. dirName _ dirName copyFrom: 1 to: dirName size - 1. " pathName _ FilePath pathName: dirName! ! !FileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:15'! pathName "Return the path from the root of the file system to this directory." ^ pathName asSqueakPathName. ! ! !FileDirectory methodsFor: 'path access' stamp: 'yo 12/19/2003 21:15'! pathParts "Return the path from the root of the file system to this directory as an array of directory names." ^ pathName asSqueakPathName findTokens: self pathNameDelimiter asString! ! !FileDirectory methodsFor: 'printing' stamp: 'yo 12/19/2003 21:15'! printOn: aStream "Refer to the comment in Object|printOn:." aStream nextPutAll: self class name. aStream nextPutAll: ' on '. pathName asSqueakPathName printOn: aStream. ! ! !FileDirectory methodsFor: 'file name utilities' stamp: 'yo 12/19/2003 21:15'! relativeNameFor: aFileName "Return the full name for aFileName, assuming that aFileName is a name relative to me." aFileName isEmpty ifTrue: [ ^pathName asSqueakPathName]. ^aFileName first = self pathNameDelimiter ifTrue: [ pathName asSqueakPathName, aFileName ] ifFalse: [ pathName asSqueakPathName, self slash, aFileName ] ! ! !FileDirectory methodsFor: 'enumeration' stamp: 'wod 6/16/1998 15:07'! statsForDirectoryTree: rootedPathName "Return the size statistics for the entire directory tree starting at the given root. The result is a three element array of the form: (). This method also serves as an example of how recursively enumerate a directory tree." "wod 6/16/1998: add Cursor wait, and use 'self pathNameDelimiter asString' rather than hardwired ':' " "FileDirectory default statsForDirectoryTree: '\smalltalk'" | dirs files bytes todo p entries | Cursor wait showWhile: [ dirs _ files _ bytes _ 0. todo _ OrderedCollection with: rootedPathName. [todo isEmpty] whileFalse: [ p _ todo removeFirst. entries _ self directoryContentsFor: p. entries do: [:entry | (entry at: 4) ifTrue: [ todo addLast: (p, self pathNameDelimiter asString, (entry at: 1)). dirs _ dirs + 1] ifFalse: [ files _ files + 1. bytes _ bytes + (entry at: 5)]]]]. ^ Array with: dirs with: files with: bytes ! ! !MacFileDirectory methodsFor: 'file operations' stamp: 'yo 12/19/2003 21:15'! fullPathFor: path "Return the fully-qualified path name for the given file." path isEmptyOrNil ifTrue: [^ pathName asSqueakPathName]. (self class isAbsolute: path) ifTrue: [^ path]. pathName asSqueakPathName = '' "Root dir?" ifTrue: [ ^path]. ^(path first = $:) ifTrue: [ pathName asSqueakPathName, path ] ifFalse: [pathName asSqueakPathName, ':' , path]! ! !UnixFileDirectory methodsFor: 'private' stamp: 'yo 12/19/2003 18:32'! setPathName: pathString "Unix path names start with a leading delimiter character." (pathString isEmpty or: [pathString first ~= self pathNameDelimiter]) ifTrue: [pathName _ FilePath pathName: (self pathNameDelimiter asString, pathString)] ifFalse: [pathName _ FilePath pathName: pathString]. ! ! !UnixFileDirectory methodsFor: 'file names' stamp: 'yo 12/19/2003 21:15'! fullPathFor: path "Return the fully-qualified path name for the given file." path isEmpty ifTrue: [^ pathName asSqueakPathName]. path first = $/ ifTrue: [^ path]. ^ pathName asSqueakPathName = '/' "Only root dir ends with a slash" ifTrue: ['/' , path] ifFalse: [pathName asSqueakPathName , '/' , path]! ! !ZipFileMember methodsFor: 'private-reading' stamp: 'yo 12/19/2003 21:15'! readCentralDirectoryFileHeaderFrom: aStream "Assumes aStream positioned after signature" | fileNameLength extraFieldLength fileCommentLength | versionMadeBy _ aStream nextLittleEndianNumber: 1. fileAttributeFormat _ aStream nextLittleEndianNumber: 1. versionNeededToExtract _ aStream nextLittleEndianNumber: 2. bitFlag _ aStream nextLittleEndianNumber: 2. compressionMethod _ aStream nextLittleEndianNumber: 2. lastModFileDateTime _ aStream nextLittleEndianNumber: 4. crc32 _ aStream nextLittleEndianNumber: 4. compressedSize _ aStream nextLittleEndianNumber: 4. uncompressedSize _ aStream nextLittleEndianNumber: 4. fileNameLength _ aStream nextLittleEndianNumber: 2. extraFieldLength _ aStream nextLittleEndianNumber: 2. fileCommentLength _ aStream nextLittleEndianNumber: 2. aStream nextLittleEndianNumber: 2. "disk number start" internalFileAttributes _ aStream nextLittleEndianNumber: 2. externalFileAttributes _ aStream nextLittleEndianNumber: 4. localHeaderRelativeOffset _ aStream nextLittleEndianNumber: 4. fileName _ (aStream next: fileNameLength) asString asSqueakPathName. cdExtraField _ (aStream next: extraFieldLength) asByteArray asString. fileComment _ (aStream next: fileCommentLength) asString convertFromSystemString. self desiredCompressionMethod: compressionMethod! ! !ZipFileMember methodsFor: 'private-reading' stamp: 'yo 12/19/2003 21:16'! readLocalDirectoryFileHeaderFrom: aStream "Positions stream as necessary. Will return stream to its original position" | fileNameLength extraFieldLength xcrc32 xcompressedSize xuncompressedSize sig oldPos | oldPos _ aStream position. aStream position: localHeaderRelativeOffset. sig _ aStream next: 4. sig = LocalFileHeaderSignature asByteArray ifFalse: [ aStream position: oldPos. ^self error: 'bad LH signature at ', localHeaderRelativeOffset hex ]. versionNeededToExtract _ aStream nextLittleEndianNumber: 2. bitFlag _ aStream nextLittleEndianNumber: 2. compressionMethod _ aStream nextLittleEndianNumber: 2. lastModFileDateTime _ aStream nextLittleEndianNumber: 4. xcrc32 _ aStream nextLittleEndianNumber: 4. xcompressedSize _ aStream nextLittleEndianNumber: 4. xuncompressedSize _ aStream nextLittleEndianNumber: 4. fileNameLength _ aStream nextLittleEndianNumber: 2. extraFieldLength _ aStream nextLittleEndianNumber: 2. fileName _ (aStream next: fileNameLength) asString asSqueakPathName. localExtraField _ (aStream next: extraFieldLength) asByteArray. dataOffset _ aStream position. "Don't trash these fields if we already got them from the central directory" self hasDataDescriptor ifFalse: [ crc32 _ xcrc32. compressedSize _ xcompressedSize. uncompressedSize _ xuncompressedSize. ]. aStream position: oldPos.! ! !AbstractString methodsFor: 'converting' stamp: 'yo 12/19/2003 21:16'! asSystemPathName ^ (FilePath pathName: self) asSystemPathName. ! ! !AbstractString methodsFor: 'converting' stamp: 'yo 12/19/2003 21:16'! asSqueakPathName ^ self. ! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'yo 12/20/2003 02:12' prior: 37967739! cacheResource: urlString stream: aStream | fd localName file buf | HTTPClient shouldUsePluginAPI ifTrue:[^self]. "use browser cache" (self resourceCache at: urlString ifAbsent:[#()]) size > 0 ifTrue:[^self]. "don't waste space" fd _ Project squeakletDirectory. localName _ fd nextNameFor: 'resource' extension:'cache'. file _ fd forceNewFileNamed: localName. buf _ ByteArray new: 10000. aStream binary. file binary. [aStream atEnd] whileFalse:[ buf _ aStream next: buf size into: buf. file nextPutAll: buf. ]. file close. "update cache" file _ [fd oldFileNamed: self resourceCacheName] on: FileDoesNotExistException do:[:ex| fd forceNewFileNamed: self resourceCacheName]. file setToEnd. file nextPutAll: urlString; cr. file nextPutAll: localName; cr. file close. self addCacheLocation: localName for: urlString. aStream position: 0. ! ! ClipboardInterpreter subclass: #UnixJPClipboardInterpreter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! KeyboardInputInterpreter subclass: #UnixUTF8JPInputInterpreter instanceVariableNames: 'converter ' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! Object subclass: #X11Encoding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-ImmPlugin'! !EUCJPTextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 22:00'! encodingNames ^ #('euc-jp' 'eucjp') copy ! ! !EUCKRTextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 22:00'! encodingNames ^ #('ks-c-5601-1987' 'euc-kr' 'euckr') copy ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 16:07'! defaultEncodingName | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ 'utf-8' copy]. (#('Win32' 'Mac OS' 'ZaurusOS') includes: platformName) ifTrue: [^ 'shift-jis' copy]. (platformName = 'unix') ifTrue: [ encoding _ X11Encoding encoding. encoding ifNil: [ ^ 'euc-jp' copy]. ^ encoding.]. ^ nil! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 16:07'! defaultInputInterpreter | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ NoInputInterpreter new]. platformName = 'Win32' ifTrue: [^ WinShiftJISInputInterpreter new]. platformName = 'Mac OS' ifTrue: [('10*' match: Smalltalk osVersion) ifTrue: [^ MacUnicodeInputInterpreter new] ifFalse: [^ MacShiftJISInputInterpreter new]]. platformName = 'unix' ifTrue: [ encoding _ X11Encoding encoding. (EUCJPTextConverter encodingNames includes: encoding) ifTrue: [^ UnixEUCJPInputInterpreter new]. (UTF8TextConverter encodingNames includes: encoding) ifTrue: [^ UnixUTF8JPInputInterpreter new]. (ShiftJISTextConverter encodingNames includes: encoding) ifTrue: [^ MacShiftJISInputInterpreter new]]. ^ NoInputInterpreter new. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 16:07'! setClipboardInterpreterClass | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [clipboardInterpreter _ NoConversionClipboardInterpreter. ^ self]. platformName = 'Win32' ifTrue: [clipboardInterpreter _ WinShiftJISClipboardInterpreter. ^ self]. platformName = 'Mac OS' ifTrue: [clipboardInterpreter _ MacShiftJISClipboardInterpreter. ^ self]. platformName = 'unix' ifTrue: [ (ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [clipboardInterpreter _ MacShiftJISClipboardInterpreter] ifFalse: [clipboardInterpreter _ UnixJPClipboardInterpreter]. ^ self]. clipboardInterpreter _ NoConversionClipboardInterpreter. ! ! !ShiftJISTextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 22:01'! encodingNames ^ #('shift-jis' 'shift_jis') copy ! ! !UTF8TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/19/2003 22:01'! encodingNames ^ #('utf-8' 'utf8') copy. ! ! !UnixJPClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 11/25/2003 17:54'! fromSystemClipboard: aString ^ aString convertFromSystemString! ! !UnixJPClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 11/25/2003 17:54'! toSystemClipboard: text | string | "self halt." string _ text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString . ! ! !UnixUTF8JPInputInterpreter methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 11/25/2003 18:36'! initialize converter _ UTF8TextConverter new.! ! !UnixUTF8JPInputInterpreter methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 11/25/2003 19:40'! nextCharFrom: sensor firstEvt: evtBuf | firstChar aCollection bytes peekEvent keyValue type stream multiChar | keyValue _ evtBuf third. evtBuf fourth = EventKeyChar ifTrue: [type _ #keystroke]. peekEvent _ sensor peekEvent. (peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [ sensor nextEvent. peekEvent _ sensor peekEvent]. (type == #keystroke and: [peekEvent notNil and: [peekEvent first = EventTypeKeyboard and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [ firstChar _ keyValue asCharacter. aCollection _ OrderedCollection new. aCollection add: firstChar. bytes _ (keyValue <= 127) ifTrue: [ 0 ] ifFalse: [ (keyValue bitAnd: 16rE0) = 192 ifTrue: [ 1 ] ifFalse: [ (keyValue bitAnd: 16rF0) = 224 ifTrue: [ 2 ] ifFalse: [ 3 ] ] ]. bytes timesRepeat: [ aCollection add: sensor nextEvent third asCharacter ]. "aCollection do: [ :each | Transcript show: (each asciiValue hex , ' ')]. Transcript show: Character cr." stream _ ReadStream on: (String withAll: aCollection). multiChar _ converter nextFromStream: stream. multiChar isOctetCharacter ifFalse: [ sensor nextEvent ]. ^ multiChar]. ^ keyValue asCharacter! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:09'! encoding | enc | enc _ self getEncoding. enc ifNil: [ ^ nil ]. ^ enc asLowercase.! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:09'! getEncoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! getLocaleEncoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! getPathEnc ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! getTextEnc ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! getXWinEnc ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! requestUTF8 ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! requestUTF8: bool ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setEncoding: encoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setEncodingToLocale ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setPathEnc: encoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setPathEncToLocale ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setTextEnc: encoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setTextEncToLocale ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setXWinEnc: encoding ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! setXWinEncToLocale ^ nil ! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! useEncoding: encoding self setEncoding: encoding. Smalltalk systemLanguage startUp. ^ self encoding.! ! !X11Encoding class methodsFor: 'as yet unclassified' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'! useLocaleEncoding self setEncodingToLocale. Smalltalk systemLanguage startUp. ^ self encoding.! ! UTF8TextConverter class removeSelector: #example1! UTF8TextConverter class removeSelector: #example2! ShiftJISTextConverter class removeSelector: #example1! ShiftJISTextConverter class removeSelector: #example2! EUCKRTextConverter class removeSelector: #example1! EUCKRTextConverter class removeSelector: #example2! SymbolListTile subclass: #ScriptNameTile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting Tiles'! !ScriptNameTile commentStamp: '' prior: 0! A tile which refers to a script name. The choices available to the user, via the arrows and via the pop-up she gets when she clicks on the current script-name, are the names of all the user scripts in any Players in the active World.! !ParameterTile methodsFor: 'code generation' stamp: 'yo 12/20/2003 02:49'! storeCodeOn: aStream indent: tabCount "Store code on the stream" | myTypeString | myTypeString _ self resultType. (self scriptEditor hasParameter and: [self scriptEditor typeForParameter = myTypeString]) ifTrue: [aStream nextPutAll: 'parameter'] ifFalse: ["This script no longer bears a parameter, yet there's an orphaned Parameter tile in it" aStream nextPutAll: '(self defaultValueOfType: #', myTypeString, ')']! ! !ScriptNameType methodsFor: 'tiles' stamp: 'yo 12/21/2003 21:43'! defaultArgumentTile "Answer a tile to represent the type" | aTile | aTile _ ScriptNameTile new dataType: self vocabularyName. aTile addArrows. aTile setLiteral: #emptyScript. ^ aTile! ! !SymbolListTile methodsFor: 'user interface' stamp: 'yo 12/21/2003 21:25'! arrowAction: delta "Do what is appropriate when an arrow on the tile is pressed; delta will be +1 or -1" | index key | owner ifNil: [^ self]. key _ Vocabulary eToyVocabulary translationKeyFor: literal. key isNil ifTrue: [key _ literal]. literal ifNotNil: [(index _ (choices _ self choices) indexOf: key) > 0 ifTrue: [self literal: (choices atWrap: index + delta). self adjustHelpMessage. self acceptNewLiteral. self labelMorph informTarget]]! ! !SymbolListTile methodsFor: 'user interface' stamp: 'yo 12/21/2003 21:42'! offerAllChoicesInAPopUp "Offer all choices in a pop-up menu" | aMenu s | owner ifNil: [^ self]. aMenu _ MenuMorph new defaultTarget: self. self choices do: [:aSym | s _ aSym = #emptyScript ifTrue: [aSym asTranslatedWording] ifFalse: [aSym]. aMenu add: s target: self selector: #acceptNewLiteral: argument: aSym]. aMenu popUpInWorld: ActiveWorld! ! ProjectViewMorph allInstancesDo: [:m | (m hasProperty: #deleteWorldsOfSqueak) ifTrue: [Project deletingProject: m project. m delete]]. Project rebuildAllProjects. ScriptingSystem spaceReclaimed! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 25 December 2003 at 9:38:31 pm'! !Object methodsFor: 'scripting' stamp: 'yo 12/25/2003 16:43'! methodInterfacesForCategory: aCategorySymbol inVocabulary: aVocabulary limitClass: aLimitClass "Return a list of methodInterfaces for the receiver in the given category, given a vocabulary. aCategorySymbol is the inherent category symbol, not necessarily the wording as expressed in the vocabulary." | categorySymbol | categorySymbol _ aCategorySymbol asSymbol. (categorySymbol == ScriptingSystem nameForInstanceVariablesCategory) ifTrue: [ "user-defined instance variables" ^ self methodInterfacesForInstanceVariablesCategoryIn: aVocabulary]. (categorySymbol == ScriptingSystem nameForScriptsCategory) ifTrue: [ "user-defined scripts" ^ self methodInterfacesForScriptsCategoryIn: aVocabulary]. "all others" ^ self usableMethodInterfacesIn: (aVocabulary methodInterfacesInCategory: categorySymbol forInstance: self ofClass: self class limitClass: aLimitClass) ! ! !ImmX11 methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 21:29'! keyboardFocusForAMorph: aMorph | left bottom pos | aMorph ifNil: [^ self]. [ pos _ aMorph prefereredKeyboardPosition. left _ (pos x min: Display width max: 0) asInteger. bottom _ (pos y min: Display height max: 0) asInteger + (aMorph paragraph characterBlockForIndex: aMorph editor selectionInterval first) height. self setCompositionWindowPositionX: left y: bottom ] on: Error do: [:ex |]. ! ! !MultiByteBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:05'! nextDelimited: terminator | out ch pos | out _ WriteStream on: (String new: 1000). self atEnd ifTrue: [^ '']. pos _ self position. self next = terminator ifFalse: [ "absorb initial terminator" self position: pos. ]. [(ch _ self next) == nil] whileFalse: [ (ch = terminator) ifTrue: [ self peek = terminator ifTrue: [ self next. "skip doubled terminator" ] ifFalse: [ ^ out contents "terminator is not doubled; we're done!!" ]. ]. out nextPut: ch. ]. ^ out contents. ! ! !MultiByteBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:04'! peek "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " | next pos | self atEnd ifTrue: [^ nil]. pos _ self position. next _ self next. self position: pos. ^ next. ! ! !MultiByteBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:04'! skipSeparatorsAndPeekNext "A special function to make nextChunk fast" | peek pos | [self atEnd] whileFalse: [ pos _ self position. (peek _ self next) isSeparator ifFalse: [ self position: pos. ^ peek. ]. ]. ! ! !MultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:03'! nextDelimited: terminator | out ch pos | out _ WriteStream on: (String new: 1000). self atEnd ifTrue: [^ '']. pos _ self position. self next = terminator ifFalse: [ "absorb initial terminator" self position: pos. ]. [(ch _ self next) == nil] whileFalse: [ (ch = terminator) ifTrue: [ self peek = terminator ifTrue: [ self next. "skip doubled terminator" ] ifFalse: [ ^ out contents "terminator is not doubled; we're done!!" ]. ]. out nextPut: ch. ]. ^ out contents. ! ! !MultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:03'! peek "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " | next pos | self atEnd ifTrue: [^ nil]. pos _ self position. next _ self next. self position: pos. ^ next. ! ! !MultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 16:03'! skipSeparatorsAndPeekNext "A special function to make nextChunk fast" | peek pos | [self atEnd] whileFalse: [ pos _ self position. (peek _ self next) isSeparator ifFalse: [ self position: pos. ^ peek. ]. ]. ! ! !ShiftJISTextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/25/2003 21:33'! encodingNames ^ #('shift-jis' 'shift_jis' 'sjis') copy ! ! !SystemDictionary methodsFor: 'accessing' stamp: 'tetha 12/22/2003 20:42'! primaryLanguage: aSymbol PrimaryLanguage _ self at: aSymbol ifAbsent: [nil]. PrimaryLanguage startUp. ! ! !Vocabulary methodsFor: 'translation' stamp: 'ka 12/23/2003 02:48'! translatedWordingFor: aSymbol "If I have a translated wording for aSymbol, return it, else return aSymbol. Caveat: at present, this mechanism is only germane for *assignment-operator wordings*" | translation wording | translationTable ifNil: [^ aSymbol]. translation _ translationTable elementAt: aSymbol asSymbol. translation ifNil: [^ aSymbol]. wording _ translation wording. wording ifNil: [^ aSymbol]. ^ wording ! ! Smalltalk removeClassNamed: #UnixEUCJPClipboardInterpreter! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 28 December 2003 at 1:18:31 am'! TextConverter subclass: #Latin1TextConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! !AbstractString methodsFor: 'internet' stamp: 'yo 12/28/2003 01:17'! decodeMimeHeader "See RFC 2047, MIME Part Three: Message Header Extension for Non-ASCII Text. Text containing non-ASCII characters is encoded by the sequence =?character-set?encoding?encoded-text?= Encoding is Q (quoted printable) or B (Base64), handled by Base64MimeConverter / RFC2047MimeConverter. Thanks to Yokokawa-san, it works in m17n package. Try the following: '=?ISO-2022-JP?B?U1dJS0lQT1AvGyRCPUJDKyVpJXMlQRsoQi8=?= =?ISO-2022-JP?B?GyRCJVElRiUjJSobKEIoUGF0aW8p?=' decodeMimeHeader. " | input output temp charset decoder encodedStream encoding pos | input _ ReadStream on: self. output _ WriteStream on: String new. [output nextPutAll: (input upTo: $=). "ASCII Text" input atEnd] whileFalse: [(temp _ input next) = $? ifTrue: [charset _ input upTo: $?. encoding _ (input upTo: $?) asUppercase. temp _ input upTo: $?. input next. "Skip final =" (charset isNil or: [charset size = 0]) ifTrue: [charset _ 'LATIN-1']. encodedStream _ MultiByteBinaryOrTextStream on: String new encoding: charset. decoder _ encoding = 'B' ifTrue: [Base64MimeConverter new] ifFalse: [RFC2047MimeConverter new]. decoder mimeStream: (ReadStream on: temp); dataStream: encodedStream; mimeDecode. output nextPutAll: encodedStream reset contents. pos _ input position. input skipSeparators. "Delete spaces if followed by =" input peek = $= ifFalse: [input position: pos]] ifFalse: [output nextPut: $=; nextPut: temp]]. ^ output contents! ! !Latin1TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2003 01:14'! currentCharSize ^ 1. ! ! !Latin1TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2003 01:14'! nextFromStream: aStream ^ aStream basicNext. ! ! !Latin1TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2003 01:14'! nextPut: aCharacter toStream: aStream aStream basicNextPut: (Character value: aCharacter). ! ! !MultiString methodsFor: 'converting' stamp: 'mmo 12/22/2003 23:47'! substrings "Answer an array of the substrings that compose the receiver." ^self findBetweenSubStrs: (Character separators). ! ! !String methodsFor: 'converting' stamp: 'mmo 12/26/2003 01:12'! asTranslatedWording | vocabulary wording | vocabulary _ Vocabulary eToyVocabulary. wording _ vocabulary translatedWordingFor: self asSymbol. (wording isNil or: [wording = 'none' or: [wording = self asSymbol]]) ifTrue: [^ self]. ^ wording ! ! !TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2003 00:54'! default ^ UTF8TextConverter new. ! ! !Latin1TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2003 01:15'! encodingNames ^ #('latin-1' 'latin1') copy. ! ! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 29 December 2003 at 1:19:40 am'! !Clipboard class methodsFor: 'class initialization' stamp: 'yo 12/29/2003 01:03'! startUp self clearInterpreters. ! ! !LanguageEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 12/29/2003 01:03'! startUp clipboardInterpreter _ nil. inputInterpreter _ nil. defaultSystemConverter _ nil. Clipboard startUp. HandMorph startUp. ! ! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 2 March 2004 at 1:44:27 am'! "Change Set: Nihongo6.1beta1 Date: March 1 2004 Author: Yoshiki Ohshima Minimum changes to the Nihongo6 version to allow better compatibility with Nihongo4. " ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 23:21'! readOneCharacter | str a encoding bbx form bits hi low pos | ((str _ self getLine) beginsWith: 'ENDFONT') ifTrue: [^ {nil. nil. nil}]. (str beginsWith: 'STARTCHAR') ifFalse: [self errorFileFormat]. ((str _ self getLine) beginsWith: 'ENCODING') ifFalse: [self errorFileFormat]. encoding _ Integer readFromString: str substrings second. (self getLine beginsWith: 'SWIDTH') ifFalse: [self errorFileFormat]. (self getLine beginsWith: 'DWIDTH') ifFalse: [self errorFileFormat]. ((str _ self getLine) beginsWith: 'BBX') ifFalse: [self errorFileFormat]. a _ str substrings. bbx _ (2 to: 5) collect: [:i | Integer readFromString: (a at: i)]. ((str _ self getLine) beginsWith: 'ATTRIBUTES') ifTrue: [str _ self getLine]. (str beginsWith: 'BITMAP') ifFalse: [self errorFileFormat]. form _ Form extent: (bbx at: 1)@(bbx at: 2). bits _ form bits. pos _ 0. 1 to: (bbx at: 2) do: [:t | 1 to: (((bbx at: 1) - 1) // 8 + 1) do: [:i | hi _ (('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1) bitShift: 4. low _ ('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1. bits byteAt: (pos+i) put: (hi+low). ]. self next ~= Character cr ifTrue: [self errorFileFormat]. pos _ pos + ((((bbx at: 1) // 32) + 1) * 4). ]. (self getLine beginsWith: 'ENDCHAR') ifFalse: [self errorFileFormat]. encoding < 0 ifTrue: [^{nil. nil. nil}]. ^{form. encoding. bbx}. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 23:12'! rangesForJapanese | basics etc | basics _ { Array with: 16r5C with: 16r5C. Array with: 16rA2 with: 16rA3. Array with: 16rA7 with: 16rA8. Array with: 16rAC with: 16rAC. Array with: 16rB0 with: 16rB1. Array with: 16rB4 with: 16rB4. Array with: 16rB6 with: 16rB6. Array with: 16rD7 with: 16rD7. Array with: 16rF7 with: 16rF7 }. etc _ { Array with: 16r370 with: 16r3FF. "greek" Array with: 16r400 with: 16r52F. "cyrillic" Array with: 16r1D00 with: 16r1D7F. "phonetic" Array with: 16r1E00 with: 16r1EFF. "latin extended additional" Array with: 16r2000 with: 16r206F. "general punctuation" Array with: 16r20A0 with: 16r20CF. "currency symbols" Array with: 16r2100 with: 16r214F. "letterlike" Array with: 16r2150 with: 16r218F. "number form" Array with: 16r2190 with: 16r21FF. "arrows" Array with: 16r2200 with: 16r22FF. "math operators" Array with: 16r2300 with: 16r23FF. "misc tech" Array with: 16r2460 with: 16r24FF. "enclosed alnum" Array with: 16r2500 with: 16r257F. "box drawing" Array with: 16r2580 with: 16r259F. "box elem" Array with: 16r25A0 with: 16r25FF. "geometric shapes" Array with: 16r2600 with: 16r26FF. "misc symbols" Array with: 16r2700 with: 16r27BF. "dingbats" Array with: 16r27C0 with: 16r27EF. "misc math A" Array with: 16r27F0 with: 16r27FF. "supplimental arrow A" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2980 with: 16r29FF. "misc math B" Array with: 16r2A00 with: 16r2AFF. "supplimental math op" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2E80 with: 16r2EFF. "cjk radicals suppliment" Array with: 16r2F00 with: 16r2FDF. "kangxi radicals" Array with: 16r3000 with: 16r303F. "cjk symbols" Array with: 16r3040 with: 16r309F. "hiragana" Array with: 16r30A0 with: 16r30FF. "katakana" Array with: 16r3190 with: 16r319F. "kanbun" Array with: 16r31F0 with: 16r31FF. "katakana extension" Array with: 16r3200 with: 16r32FF. "enclosed CJK" Array with: 16r3300 with: 16r33FF. "CJK compatibility" Array with: 16r3400 with: 16r4DBF. "CJK unified extension A" Array with: 16r4E00 with: 16r9FAF. "CJK ideograph" Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph" Array with: 16rFE30 with: 16rFE4F. "CJK compatiblity forms" Array with: 16rFF00 with: 16rFFEF. "half and full" Array with: 16rFFFF with: 16rFFFF. "sentinel" }. ^ basics, etc. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 23:20'! readCharactersInRanges: ranges storeInto: chars | array form code rangeStream currentRange | rangeStream _ ReadStream on: ranges. currentRange _ rangeStream next. [true] whileTrue: [ array _ self readOneCharacter. array second ifNil: [^ self]. code _ array at: 2. code > currentRange last ifTrue: [ [rangeStream atEnd not and: [currentRange _ rangeStream next. currentRange last < code]] whileTrue. rangeStream atEnd ifTrue: [^ self]. ]. (code between: currentRange first and: currentRange last) ifTrue: [ form _ array at: 1. form ifNotNil: [ chars add: array. ]. ]. ]. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 23:13'! readRanges: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end | form _ encoding _ bbx _ nil. self initialize. self readAttributes. height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. (properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [ pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. ] ifFalse: [ pointSize _ (ascent + descent) * 72 // 96. ]. maxWidth _ 0. minAscii _ 16r200000. strikeWidth _ 0. maxAscii _ 0. charsNum _ Integer readFromString: (properties at: #CHARS) first. chars _ Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars _ self override: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange. chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)]. charsNum _ chars size. "undefined encodings make this different" chars do: [:array | encoding _ array at: 2. bbx _ array at: 3.. width _ bbx at: 1. maxWidth _ maxWidth max: width. minAscii _ minAscii min: encoding. maxAscii _ maxAscii max: encoding. strikeWidth _ strikeWidth + width. ]. glyphs _ Form extent: strikeWidth@height. blt _ BitBlt toForm: glyphs. start _ ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min. end _ ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3. "xRange _ Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))." "xTable _ XTableForUnicodeFont new ranges: xRange." xTable _ SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. lastAscii _ start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form _ (chars at: i) first. encoding _ (chars at: i) second. bbx _ (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue _ xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii _ encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret _ Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! ! !ImageSegment methodsFor: 'fileIn/Out' stamp: 'yo 3/2/2004 00:58'! comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal ccFixups receiverClasses rootsToUnhiberhate myProject m existing | self flag: #bobconv. RecentlyRenamedClasses _ nil. "in case old data hanging around" mapFakeClassesToReal _ smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." ccFixups _ self remapCompactClasses: mapFakeClassesToReal refStrm: smartRefStream. ccFixups ifFalse: [^ self error: 'A class in the file is not compatible']. endMarker _ segment nextObject. "for enumeration of objects" endMarker == 0 ifTrue: [endMarker _ 'End' clone]. arrayOfRoots _ self loadSegmentFrom: segment outPointers: outPointers. "Can't use install. Not ready for rehashSets" mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. arrayOfRoots do: [:importedObject | (importedObject isKindOf: MultiString) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = MultiSymbol ifTrue: [ "self halt." MultiSymbol hasInternedALoadedSymbol: importedObject ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ multiSymbol becomeForward: importedObject. ]. ]. ]. ]. (importedObject isKindOf: TTCFontSet) ifTrue: [ existing _ TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. existing ifNil: [existing _ TextStyle defaultFont]. importedObject becomeForward: existing ]. ]. Smalltalk garbageCollect. MultiSymbol rehash. receiverClasses _ self restoreEndianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [self declare: importedObject]]. arrayOfRoots do: [:importedObject | (importedObject isKindOf: CompiledMethod) ifTrue: [ importedObject sourcePointer > 0 ifTrue: [importedObject zapSourcePointer]]. (importedObject isKindOf: Project) ifTrue: [ myProject _ importedObject. importedObject ensureChangeSetNameUnique. Project addingProject: importedObject. importedObject restoreReferences. self dependentsRestore: importedObject. ScriptEditorMorph writingUniversalTiles: ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. rootsToUnhiberhate _ arrayOfRoots select: [:importedObject | importedObject respondsTo: #unhibernate "ScriptEditors and ViewerFlapTabs" ]. myProject ifNotNil: [ myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keys do: [:aFake | aFake indexIfCompact > 0 ifTrue: [aFake becomeUncompact]. aFake removeFromSystemUnlogged]. SystemOrganization removeEmptyCategories]. "^ self" MultiSymbol allInstances do: [:each | m _ MultiSymbol intern: each asString. each == m ifFalse: [ "For a project from older m17n image, this is necessary." "self halt." m becomeForward: each. ]. ]. ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'yo 1/11/2004 23:20'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList proj trusted localDir projStream archive mgr projectsToBeDeleted baseChangeSet | (preStream isNil or: [preStream size = 0]) ifTrue: [ ProgressNotification signal: '9999 about to enter project'. "the hard part is over" ^self inform: 'It looks like a problem occurred while getting this project. It may be temporary, so you may want to try again,' ]. ProgressNotification signal: '2:fileSizeDetermined ',preStream size printString. preStream isZipArchive ifTrue:[ archive _ ZipArchive new readFrom: preStream. projStream _ self projectStreamFromArchive: archive] ifFalse:[projStream _ preStream]. trusted _ SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ (preStream respondsTo: #close) ifTrue:[preStream close]. ^self]]. localDir _ Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream contents; close. ]. ]. morphOrList _ projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ProgressNotification signal: '3:unzipped'. ResourceCollector current: ResourceCollector new. baseChangeSet _ ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" [morphOrList _ morphOrList fileInObjectAndCode] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr _ ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. (preStream respondsTo: #close) ifTrue:[preStream close]. ResourceCollector current: nil. ProgressNotification signal: '4:filedIn'. ProgressNotification signal: '9999 about to enter project'. "the hard part is over" (morphOrList isKindOf: ImageSegment) ifTrue: [ proj _ morphOrList arrayOfRoots detect: [:mm | mm class == Project] ifNone: [^self inform: 'No project found in this file']. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. CurrentProjectRefactoring currentBeParentTo: proj. projectsToBeDeleted _ OrderedCollection new. existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSorter allChangeSets add: proj changeSet. ProjectView openAndEnter: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ChangeSorter allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. proj world ifNotNil: [(proj world valueOfProperty: #soundAdditions) ifNotNilDo: [:additions | SampledSound assimilateSoundsFrom: additions]]. ^ ProjectEntryNotification signal: proj ]. (morphOrList isKindOf: SqueakPage) ifTrue: [ morphOrList _ morphOrList contentsMorph ]. (morphOrList isKindOf: PasteUpMorph) ifFalse: [ ^ self inform: 'This is not a PasteUpMorph or exported Project.' ]. (Project newMorphicOn: morphOrList) enter ! ! !ResourceManager methodsFor: 'loading' stamp: 'yo 1/12/2004 22:46'! preLoadFromArchive: aZipArchive cacheName: aFileName "Load the resources from the given zip archive" | orig nameMap resMap loc stream | self class reloadCachedResources. resMap _ Dictionary new. nameMap _ Dictionary new. unloaded do:[:locator| locator localFileName: nil. nameMap at: locator urlString put: locator. resMap at: locator urlString put: (resourceMap at: locator)]. aZipArchive members do:[:entry| stream _ nil. orig _ resMap at: (entry fileName convertFromSystemString) ifAbsent:[nil]. loc _ nameMap at: (entry fileName convertFromSystemString) ifAbsent:[nil]. "note: orig and loc may be nil for non-resource members" (orig notNil and:[loc notNil]) ifTrue:[ stream _ entry contentStream. self installResource: orig from: stream locator: loc. stream reset. aFileName ifNil:[self class cacheResource: loc urlString stream: stream] ifNotNil:[self class cacheResource: loc urlString inArchive: aFileName]]. ].! ! !ResourceManager methodsFor: 'private' stamp: 'yo 1/12/2004 22:54'! fixJISX0208Resource | keys value url | keys _ resourceMap keys. keys do: [:key | value _ resourceMap at: key. url _ key urlString copy. url isOctetString not ifTrue: [url mutateJISX0208StringToUnicode]. resourceMap removeKey: key. key urlString: url. resourceMap at: key put: value. ]. ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 21:50'! katakanaValue: code ^ MultiCharacter leadingChar: UnicodeJapanese leadingChar code: (#( 16rFFFD 16rFF61 16rFF62 16rFF63 16rFF64 16rFF65 16rFF66 16rFF67 16rFF68 16rFF69 16rFF6A 16rFF6B 16rFF6C 16rFF6D 16rFF6E 16rFF6F 16rFF70 16rFF71 16rFF72 16rFF73 16rFF74 16rFF75 16rFF76 16rFF77 16rFF78 16rFF79 16rFF7A 16rFF7B 16rFF7C 16rFF7D 16rFF7E 16rFF7F 16rFF80 16rFF81 16rFF82 16rFF83 16rFF84 16rFF85 16rFF86 16rFF87 16rFF88 16rFF89 16rFF8A 16rFF8B 16rFF8C 16rFF8D 16rFF8E 16rFF8F 16rFF90 16rFF91 16rFF92 16rFF93 16rFF94 16rFF95 16rFF96 16rFF97 16rFF98 16rFF99 16rFF9A 16rFF9B 16rFF9C 16rFF9D 16rFF9E 16rFF9F ) at: (code - 16r9F)). ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 21:49'! nextFromStream: aStream | character1 character2 value1 value2 char1Value result | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. char1Value _ character1 asciiValue. (char1Value < 16r81) ifTrue: [^ character1]. (char1Value > 16rA0 and: [char1Value < 16rE0]) ifTrue: [^ self katakanaValue: char1Value]. character2 _ aStream basicNext. character2 = nil ifTrue: [self errorMalformedInput]. value1 _ character1 asciiValue. character1 asciiValue >= 224 ifTrue: [value1 _ value1 - 64]. value1 _ value1 - 129 bitShift: 1. value2 _ character2 asciiValue. character2 asciiValue >= 128 ifTrue: [value2 _ value2 - 1]. character2 asciiValue >= 158 ifTrue: [ value1 _ value1 + 1. value2 _ value2 - 158 ] ifFalse: [value2 _ value2 - 64]. result _ MultiCharacter leadingChar: self leadingChar code: value1 * 94 + value2. ^ self toUnicode: result ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 22:38'! nextPut: aCharacter toStream: aStream | value leadingChar aChar | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ aStream basicNextPut: aCharacter. ^ aStream. ]. aCharacter class == MultiCharacter ifTrue: [ aStream nextInt32Put: aCharacter value. ^ aStream. ]. ]. aCharacter isUnicode ifFalse: [ aChar _ aCharacter. value _ aCharacter charCode. ] ifTrue: [ value _ aCharacter charCode. (16rFF61 <= value and: [value <= 16rFF9F]) ifTrue: [ aStream basicNextPut: (self sjisKatakanaFor: value). ^ aStream ]. aChar _ JISX0208 charFromUnicode: value. aChar ifNil: [^ aStream]. value _ aChar charCode. ]. leadingChar _ aChar leadingChar. leadingChar = 0 ifTrue: [ aStream basicNextPut: (Character value: value). ^ aStream. ]. leadingChar == self leadingChar ifTrue: [ | upper lower | upper _ value // 94 + 33. lower _ value \\ 94 + 33. upper \\ 2 == 1 ifTrue: [ upper _ upper + 1 / 2 + 112. lower _ lower + 31 ] ifFalse: [ upper _ upper / 2 + 112. lower _ lower + 125 ]. upper >= 160 ifTrue: [upper _ upper + 64]. lower >= 127 ifTrue: [lower _ lower + 1]. aStream basicNextPut: (Character value: upper). aStream basicNextPut: (Character value: lower). ^ aStream ]. ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 22:05'! sjisKatakanaFor: value ^ Character value: (#( 16rA0 16rA1 16rA2 16rA3 16rA4 16rA5 16rA6 16rA7 16rA8 16rA9 16rAA 16rAB 16rAC 16rAD 16rAE 16rAF 16rB0 16rB1 16rB2 16rB3 16rB4 16rB5 16rB6 16rB7 16rB8 16rB9 16rBA 16rBB 16rBC 16rBD 16rBE 16rBF 16rC0 16rC1 16rC2 16rC3 16rC4 16rC5 16rC6 16rC7 16rC8 16rC9 16rCA 16rCB 16rCC 16rCD 16rCE 16rCF 16rD0 16rD1 16rD2 16rD3 16rD4 16rD5 16rD6 16rD7 16rD8 16rD9 16rDA 16rDB 16rDC 16rDD 16rDE 16rDF ) at: value - 16rFF5F). ! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'yo 3/2/2004 01:02'! nihongoVersion ^ 'Nihongo6.1beta' copy ! ! !TTCFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/2/2004 00:57'! familyName: n pointSize: s "(self familyName: 'MultiMSGothic' pointSize: 14) pointSize" | t ret index | t _ self allInstances select: [:e | e familyName = n]. t _ t select: [:e | e fontArray size > 2]. t isEmpty ifTrue: [t _ (TextConstants at: #DefaultTextStyle) fontArray]. ret _ t first. ret pointSize >= s ifTrue: [^ ret]. index _ 2. [index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [ ret _ t at: index. index _ index + 1. ]. ^ ret! ! !TTCFontDescription class methodsFor: 'as yet unclassified' stamp: 'yo 3/2/2004 00:36'! descriptionNamed: descriptionName at: index | array | array _ self descriptionNamed: descriptionName. ^ array at: index. ! ! !Utilities class methodsFor: 'tailoring system' stamp: 'yo 3/2/2004 01:08'! makeNihongoImage Utilities emptyScrapsBook. Smalltalk garbageCollect. Display setExtent: 960@720 depth: 16. World color: (Color r: 0.935 g: 0.935 b: 0.935). Preferences setPreference: #magicHalos toValue: false. Preferences setPreference: #magicHalos toValue: true. Preferences setPreference: #mouseOverHalos toValue: false. Preferences setPreference: #mouseOverHalos toValue: true. Preferences takanawa. " TTCFontSet discardDefault. TTCFontDescription clearDefault" Player abandonUnnecessaryUniclasses. Player freeUnreferencedSubclasses. Player removeUninstantiatedSubclassesSilently. PartsBin initialize. Flaps disableGlobalFlaps: false. Flaps addAndEnableEToyFlaps. ActiveWorld addGlobalFlaps. Flaps sharedFlapsAlongBottom. Vocabulary initializeLanguageTable. Project current setNaturalLanguageTo: #English. Project current setNaturalLanguageTo: #'Japanese(children)'. Preferences setPreference: #showProjectNavigator toValue: false. Preferences setPreference: #projectViewsInWindows toValue: true. Preferences setPreference: #canRecordWhilePlaying toValue: false. Smalltalk primaryLanguage: #Japanese. Smalltalk systemLanguage: #Japanese. Preferences restoreDefaultFontsForJapanese. ! ! !WinShiftJISInputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 3/1/2004 22:13'! nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value _ (Character value: keyValue) squeakToIso asciiValue. (char1Value < 16r81) ifTrue: [^ keyValue asCharacter]. (char1Value > 16rA0 and: [char1Value < 16rE0]) ifTrue: [^ ShiftJISTextConverter basicNew katakanaValue: char1Value]. peekEvent _ sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent _ sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter _ char1Value asCharacter. secondCharacter _ (peekEvent at: 3) asCharacter squeakToIso. stream _ ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter _ converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! ! TTCFontSet removeSelector: #comeFullyUpOnReload:! 'From Squeak3.4alpha of ''11 November 2002'' [latest update: #5109] on 18 November 2002 at 1:39:30 pm'! StrikeFont subclass: #HostFont instanceVariableNames: 'fullWidth kernPairs ' classVariableNames: 'IsoToSqueakMap ' poolDictionaries: 'TextConstants ' category: 'Graphics-Text'! !HostFont methodsFor: 'accessing' stamp: 'ar 2/2/2002 18:49'! baseKern ^0! ! !HostFont methodsFor: 'accessing' stamp: 'ar 2/2/2002 18:49'! descentKern ^0! ! !HostFont methodsFor: 'accessing' stamp: 'ar 2/18/2001 20:01'! getFontData | fontHandle bufSize buffer | fontHandle _ self primitiveCreateFont: name size: pointSize emphasis: emphasis. fontHandle ifNil:[^nil]. bufSize _ self primitiveFontDataSize: fontHandle. buffer _ ByteArray new: bufSize. self primitiveFont: fontHandle getData: buffer. ^buffer! ! !HostFont methodsFor: 'accessing' stamp: 'ar 2/18/2001 20:04'! testEmbeddingFlags "HostFont basicNew testEmbeddingFlags" | list fontHandle | list _ self class listFontNames. list do:[:fName| fontHandle _ self primitiveCreateFont: fName size: 12 emphasis: 0. fontHandle ifNotNil:[ type _ self primitiveFontEmbeddingFlags: fontHandle. Transcript cr; show: fName,': ', type printString. self primitiveDestroyFont: fontHandle. ]. ].! ! !HostFont methodsFor: 'emphasis' stamp: 'ar 8/29/2000 21:18'! emphasized: code | derivative addedEmphasis base safeCode | code = 0 ifTrue: [^ self]. derivativeFonts == nil ifTrue:[derivativeFonts _ Array new: 32]. derivative _ derivativeFonts at: (safeCode _ code min: derivativeFonts size). derivative == nil ifFalse: [^ derivative]. "Already have this style" "Dont have it -- derive from another with one with less emphasis" addedEmphasis _ 1 bitShift: safeCode highBit - 1. base _ self emphasized: safeCode - addedEmphasis. "Order is Bold, Ital, Under, Narrow" addedEmphasis = 1 ifTrue: "Compute synthetic bold version of the font" [derivative _ (base copy name: base name) makeBoldGlyphs]. addedEmphasis = 2 ifTrue: "Compute synthetic italic version of the font" [ derivative _ (base copy name: base name) makeItalicGlyphs]. addedEmphasis = 4 ifTrue: "Compute underlined version of the font" [derivative _ (base copy name: base name) makeUnderlinedGlyphs]. addedEmphasis = 8 ifTrue: "Compute narrow version of the font" [derivative _ (base copy name: base name) makeCondensedGlyphs]. addedEmphasis = 16 ifTrue: "Compute struck-out version of the font" [derivative _ (base copy name: base name) makeStruckOutGlyphs]. derivative emphasis: safeCode. derivativeFonts at: safeCode put: derivative. ^ derivative! ! !HostFont methodsFor: 'emphasis' stamp: 'ar 8/29/2000 21:20'! makeBoldGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeBoldGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 1)) ifNil:[^super makeBoldGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'ar 6/4/2000 23:22'! makeItalicGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeItalicGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 2)) ifNil:[^super makeItalicGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'ar 6/4/2000 23:22'! makeStruckOutGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeStruckOutGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 8)) ifNil:[^super makeStruckOutGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'ar 6/5/2000 00:12'! makeUnderlinedGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeUnderlinedGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 4)) ifNil:[^super makeUnderlinedGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'private-creation' stamp: 'ar 2/5/2002 16:57'! fontName: fontName size: ptSize emphasis: emphasisCode " ^HostFont fontName: (HostFont fontNameFromUser) size: 12 emphasis: 0. " | fontHandle xStart w glyphForm fontHeight fw enc | fontHandle _ self primitiveCreateFont: fontName size: ptSize emphasis: emphasisCode. fontHandle ifNil:[^nil]. pointSize _ ptSize. name _ fontName. emphasis _ emphasisCode. minAscii _ 0. maxAscii _ 255. ascent _ self primitiveFontAscent: fontHandle. descent _ self primitiveFontDescent: fontHandle. kernPairs _ Array new: (self primitiveFontNumKernPairs: fontHandle). 1 to: kernPairs size do:[:i| kernPairs at: i put: (self primitiveFont: fontHandle getKernPair: i)]. fontHeight _ ascent + descent. xTable _ Array new: 258. fullWidth _ Array new: 256. xStart _ maxWidth _ 0. 0 to: 255 do:[:i| xTable at: i+1 put: xStart. fw _ self primitiveFont: fontHandle fullWidthOfChar: i. (#( 1 "anchored morph" 9 "tab" 10 "LF" 13 "CR" ) includes: i) ifTrue:[fw := {0. 0. 0}]. fullWidth at: i+1 put: fw. w _ fw at: 2. (fw at: 1) > 0 ifTrue:[w _ w + (fw at: 1)]. (fw at: 3) > 0 ifTrue:[w _ w + (fw at: 3)]. w > maxWidth ifTrue:[maxWidth _ w]. xStart _ xStart + w]. xStart = 0 ifTrue:[^nil]. strikeLength _ xStart. xTable at: 256 put: xStart. xTable at: 257 put: xStart. xTable at: 258 put: xStart. glyphs _ Form extent: xTable last @ fontHeight depth: 1. glyphForm _ Form extent: maxWidth @ fontHeight depth: 1. 0 to: 255 do:[:i| glyphForm fillWhite. self primitiveFont: fontHandle glyphOfChar: i into: glyphForm. xStart _ xTable at: i+1. glyphForm displayOn: glyphs at: xStart@0. "glyphForm displayOn: Display at: xStart@0." ]. enc := self primitiveFontEncoding: fontHandle. enc = 1 ifTrue:[characterToGlyphMap := self isoToSqueakMap]. self primitiveDestroyFont: fontHandle. ^self! ! !HostFont methodsFor: 'private-creation' stamp: 'ar 1/27/2002 19:55'! isoToSqueakMap IsoToSqueakMap ifNotNil:[^IsoToSqueakMap]. IsoToSqueakMap := Array new: 256. 0 to: 255 do:[:i| IsoToSqueakMap at: i+1 put: (Character value: i) squeakToIso asciiValue. ]. ^IsoToSqueakMap! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:11'! primitiveCreateFont: fontName size: fontSize emphasis: fontFlags ^nil! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:01'! primitiveDestroyFont: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 8/28/2000 16:04'! primitiveFont: fontHandle fullWidthOfChar: charIndex ^Array with: 0 with: (self primitiveFont: fontHandle widthOfChar: charIndex) with: 0! ! !HostFont methodsFor: 'primitives' stamp: 'ar 2/18/2001 19:46'! primitiveFont: fontHandle getData: buffer ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 8/28/2000 16:05'! primitiveFont: fontHandle getKernPair: kernIndex ^0! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:01'! primitiveFont: fontHandle glyphOfChar: charIndex into: glyphForm ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:01'! primitiveFont: fontHandle widthOfChar: charIndex ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:01'! primitiveFontAscent: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 2/18/2001 19:45'! primitiveFontDataSize: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:01'! primitiveFontDescent: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 2/18/2001 20:00'! primitiveFontEmbeddingFlags: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:02'! primitiveFontEncoding: fontHandle ^self primitiveFailed! ! !HostFont methodsFor: 'primitives' stamp: 'ar 8/28/2000 16:04'! primitiveFontNumKernPairs: fontHandle ^0! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'ar 2/3/2002 23:06'! familyName: aName pointSize: aSize emphasized: emphasisCode "Create the font with this emphasis" ^ (self familyName: aName pointSize: aSize) emphasized: emphasisCode! ! !StrikeFont class methodsFor: 'accessing' stamp: 'ar 2/3/2002 23:04'! familyName: aName pointSize: aSize "Answer a font (or the default font if the name is unknown) in the specified size." ^ ((TextStyle named: aName asSymbol) ifNil: [TextStyle default]) fontOfPointSize: aSize! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 22:27'! fromHostFont: fontName size: fontSize flags: fontFlags weight: fontWeight " ^StrikeFont fromHostFont: (StrikeFont hostFontFromUser) size: 12 flags: 0 weight: 4. " | fontHandle glyphs xTable xStart maxWidth w glyphForm ascent descent fontHeight | fontHandle _ self primitiveCreateFont: fontName size: fontSize flags: fontFlags weight: fontWeight. ascent _ self primitiveFontAscent: fontHandle. descent _ self primitiveFontDescent: fontHandle. fontHeight _ ascent + descent. xTable _ Array new: 258. xStart _ maxWidth _ 0. 0 to: 255 do:[:i| xTable at: i+1 put: xStart. w _ self primitiveFont: fontHandle widthOfChar: i. w > maxWidth ifTrue:[maxWidth _ w]. xStart _ xStart + w]. xTable at: 256 put: xStart. xTable at: 257 put: xStart. xTable at: 258 put: xStart. glyphs _ Form extent: xTable last @ fontHeight depth: 1. glyphForm _ Form extent: maxWidth @ fontHeight depth: 1. 0 to: 255 do:[:i| glyphForm fillWhite. self primitiveFont: fontHandle glyphOfChar: i into: glyphForm. xStart _ xTable at: i+1. glyphForm displayOn: glyphs at: xStart@0. glyphForm displayOn: Display at: xStart@0. ]. self primitiveDestroyFont: fontHandle. ^Array with: glyphs with: xTable! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:25'! hostFontFromUser "StrikeFont hostFontFromUser" | fontNames index labels | fontNames _ self listFontNames asSortedCollection. labels _ WriteStream on: (String new: 100). fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr]. index _ (PopUpMenu labels: labels contents) startUpWithCaption:'Choose your font'. index = 0 ifTrue:[^nil]. ^fontNames at: index! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:12'! listFont: index ^nil! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:12'! listFontNames "StrikeFont listFontNames" "List all the OS font names" | font fontNames index | fontNames _ WriteStream on: Array new. index _ 0. [font _ self listFont: index. font == nil] whileFalse:[ fontNames nextPut: font. index _ index + 1]. ^fontNames contents! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:13'! primitiveCreateFont: fontName size: fontSize flags: fontFlags weight: fontWeight ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:13'! primitiveDestroyFont: fontHandle ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:14'! primitiveFont: fontHandle glyphOfChar: charIndex into: glyphForm ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:15'! primitiveFont: fontHandle widthOfChar: charIndex ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 22:25'! primitiveFontAscent: fontHandle ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 22:25'! primitiveFontDescent: fontHandle ^self primitiveFailed! ! !StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:14'! primitiveFontEncoding: fontHandle ^self primitiveFailed! ! !HostFont class methodsFor: 'instance creation' stamp: 'ar 6/4/2000 23:13'! fontName: fontName size: ptSize emphasis: emphasisCode " ^HostFont fontName: (HostFont fontNameFromUser) size: 12 emphasis: 0. " ^self new fontName: fontName size: ptSize emphasis: emphasisCode! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 6/4/2000 23:03'! fontNameFromUser "HostFont fontNameFromUser" | fontNames index labels | fontNames _ self listFontNames asSortedCollection. labels _ WriteStream on: (String new: 100). fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr]. index _ (PopUpMenu labels: labels contents) startUpWithCaption:'Choose your font'. index = 0 ifTrue:[^nil]. ^fontNames at: index! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 6/4/2000 23:18'! listFontName: index ^nil! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 6/4/2000 23:18'! listFontNames "HostFont listFontNames" "List all the OS font names" | font fontNames index | fontNames _ WriteStream on: Array new. index _ 0. [font _ self listFontName: index. font == nil] whileFalse:[ fontNames nextPut: font. index _ index + 1]. ^fontNames contents! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 1/27/2002 19:37'! textStyleFrom: fontName "HostFont textStyleFromUser" | styleName fonts | styleName _ fontName asSymbol. "(TextConstants includesKey: styleName) ifTrue:[(self confirm: styleName , ' is already defined in TextConstants. Do you want to replace that definition?') ifFalse: [^ self]]." fonts _ #(10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90). ('Rendering ', styleName) displayProgressAt: Sensor cursorPoint from: 1 to: fonts size during:[:bar| fonts _ fonts collect:[:ptSize| bar value: (fonts indexOf: ptSize). self fontName: styleName size: ptSize emphasis: 0] thenSelect:[:font| font notNil]]. "reject those that failed" fonts size = 0 ifTrue:[^self error:'Could not create font style', styleName]. TextConstants at: styleName put: (TextStyle fontArray: fonts).! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 1/27/2002 20:12'! textStyleFrom: fontName sizes: ptSizes | styleName fonts | styleName _ fontName asSymbol. (TextConstants includesKey: styleName) ifTrue:[(self confirm: styleName , ' is already defined in TextConstants. Do you want to replace that definition?') ifFalse: [^ self]]. ('Rendering ', styleName) displayProgressAt: Sensor cursorPoint from: 1 to: ptSizes size during:[:bar| fonts _ ptSizes collect:[:ptSize| bar value: (ptSizes indexOf: ptSize). self fontName: styleName size: ptSize emphasis: 0] thenSelect:[:font| font notNil]]. "reject those that failed" fonts size = 0 ifTrue:[^self error:'Could not create font style', styleName]. TextConstants at: styleName put: (TextStyle fontArray: fonts).! ! !HostFont class methodsFor: 'accessing' stamp: 'ar 8/28/2000 17:27'! textStyleFromUser "HostFont textStyleFromUser" | styleName fonts | styleName _ self fontNameFromUser ifNil:[^self]. styleName _ styleName asSymbol. (TextConstants includesKey: styleName) ifTrue:[(self confirm: styleName , ' is already defined in TextConstants. Do you want to replace that definition?') ifFalse: [^ self]]. fonts _ #(10 12 14 16 18 20 22 24 26 28 30 36 48 60 72 90). ('Rendering ', styleName) displayProgressAt: Sensor cursorPoint from: 1 to: fonts size during:[:bar| fonts _ fonts collect:[:ptSize| bar value: (fonts indexOf: ptSize). self fontName: styleName size: ptSize emphasis: 0] thenSelect:[:font| font notNil]]. "reject those that failed" fonts size = 0 ifTrue:[^self error:'Could not create font style', styleName]. TextConstants at: styleName put: (TextStyle fontArray: fonts).! ! !HostFont class methodsFor: 'system defaults'! initWin32 "HostFont initWin32" #( "Basic fonts" ('Arial' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Times New Roman' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Courier New' "menu/text fixed" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Wingdings' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Symbol' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) "Nice fonts" ('Verdana' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Tahoma' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Garamond' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Georgia' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Comic Sans MS' "eToy" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) "Optional fonts" ('Impact' "flaps" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Webdings' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('System' "12pt only" (12)) ('Fixedsys' "12pt only" (12)) ) do:[:spec| HostFont textStyleFrom: spec first sizes: spec last]. TextConstants removeKey: #Atlanta ifAbsent: []. TextConstants removeKey: #ComicPlain ifAbsent: []. TextConstants removeKey: #ComicBold ifAbsent: []. TextConstants removeKey: #Courier ifAbsent: []. TextConstants removeKey: #NewYork ifAbsent: []. TextConstants removeKey: #Palatino ifAbsent: []. TextConstants at: #DefaultFixedTextStyle put: (TextConstants at: #'Courier New'). TextConstants at: #Helvetica put: (TextConstants at: #'Arial'). TextStyle setDefault: (TextConstants at: #'Times New Roman'). Preferences setSystemFontTo: (self familyName: 'Verdana' pointSize: 12). Preferences setListFontTo: (self familyName: 'Verdana' pointSize: 12). Preferences setFlapsFontTo: (self familyName: 'Impact' pointSize: 16). Preferences setMenuFontTo: (self familyName: 'Verdana' pointSize: 11). Preferences setWindowTitleFontTo: (self familyName: 'System' pointSize: 12). BalloonMorph setBalloonFontTo: (self familyName: 'Arial' pointSize: 10). Preferences setButtonFontTo: (self familyName:'Comic Sans MS' pointSize: 12 emphasized: 1). ! ! !TextStyle methodsFor: 'fonts and font indexes' stamp: 'ar 2/3/2002 23:05'! fontIndexOfPointSize: desiredHeight "Returns an index in fontArray of the font with height <= desiredHeight" "Leading is not inluded in the comparison" | bestMatch bestIndex d | bestMatch _ 9999. bestIndex _ 1. 1 to: fontArray size do: [:i | d _ desiredHeight - (fontArray at: i) pointSize. d = 0 ifTrue: [^ i]. (d > 0 and: [d < bestMatch]) ifTrue: [bestIndex _ i. bestMatch _ d]]. ^ bestIndex! ! !TextStyle methodsFor: 'fonts and font indexes' stamp: 'di 10/11/97 09:23'! fontIndexOfSize: desiredHeight "Returns an index in fontArray of the font with height <= desiredHeight" "Leading is not inluded in the comparison" | bestMatch bestIndex d | bestMatch _ 9999. bestIndex _ 1. 1 to: fontArray size do: [:i | d _ desiredHeight - (fontArray at: i) height. d = 0 ifTrue: [^ i]. (d > 0 and: [d < bestMatch]) ifTrue: [bestIndex _ i. bestMatch _ d]]. ^ bestIndex! ! !TextStyle methodsFor: 'fonts and font indexes' stamp: 'ar 2/3/2002 23:05'! fontOfPointSize: aHeight "See fontIndexOfSize. Returns the actual font. Leading not considered." ^ fontArray at: (self fontIndexOfPointSize: aHeight)! ! !TextStyle class methodsFor: 'constants' stamp: 'ar 1/27/2002 20:36'! setDefault: aTextStyle "Answer the system default text style." DefaultTextStyle := aTextStyle.! ! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 5 March 2004 at 8:16:44 am'! !MultiByteBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'yo 3/5/2004 07:59'! fileIn self converter: self guessConverter. super fileIn. ! ! !MultiByteBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'yo 3/5/2004 07:59'! guessConverter (self originalContents includesSubString: (String with: (Character value: 16r1B) with: (Character value: 16r24))) ifTrue: [ ^ CompoundTextConverter new. ] ifFalse: [ ^ UTF8TextConverter new. ]. ! ! !SystemDictionary methodsFor: 'accessing' stamp: 'yo 3/5/2004 08:05'! primaryLanguage: aSymbol PrimaryLanguage _ self at: aSymbol ifAbsent: [English]. PrimaryLanguage startUp. ! ! 'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 15 March 2004 at 9:15:48 pm'! Object subclass: #LanguageEnvironment instanceVariableNames: '' classVariableNames: 'ClipboardInterpreterClass FileNameConverterClass InputInterpreterClass SystemConverterClass ' poolDictionaries: '' category: 'Multilingual-Languages'! LanguageEnvironment class instanceVariableNames: 'inputInterpreter clipboardInterpreter defaultSystemConverter '! !Clipboard methodsFor: 'accessing' stamp: 'yo 3/15/2004 17:21'! setInterpreter interpreter _ Smalltalk systemLanguage defaultClipboardInterpreter. interpreter ifNil: [ "Should never be reached, but just in case." interpreter _ NoConversionClipboardInterpreter new]. ! ! !LanguageEnvironment class methodsFor: 'class initialization' stamp: 'yo 3/15/2004 21:15'! clearDefault ClipboardInterpreterClass _ nil. InputInterpreterClass _ nil. SystemConverterClass _ nil. FileNameConverterClass _ nil. ! ! !LanguageEnvironment class methodsFor: 'class initialization' stamp: 'yo 3/15/2004 21:15'! startUp self clearDefault. Clipboard startUp. HandMorph startUp. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/15/2004 15:14'! clipboardInterpreterClass ^ NoConversionClipboardInterpreter. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/15/2004 18:10'! fileNameConverterClass ^ Latin1TextConverter ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/15/2004 15:43'! inputInterpreterClass ^ MacRomanInputInterpreter. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/15/2004 15:15'! systemConverterClass ^ Latin1TextConverter. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/15/2004 18:16'! defaultClipboardInterpreter ClipboardInterpreter ifNil: [ClipboardInterpreter _ self clipboardInterpreterClass]. ^ ClipboardInterpreter new. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/15/2004 15:50'! defaultEncodingName ^ 'mac-roman'. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/15/2004 18:16'! defaultFileNameConverter FileNameConverterClass ifNil: [FileNameConverterClass _ self fileNameConverterClass]. ^ FileNameConverterClass new. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/15/2004 18:16'! defaultInputInterpreter InputInterpreterClass ifNil: [InputInterpreterClass _ self inputInterpreterClass]. ^ InputInterpreterClass new. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/15/2004 18:15'! defaultSystemConverter SystemConverterClass ifNil: [SystemConverterClass _ self systemConverterClass]. ^ SystemConverterClass new. ! ! !English class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:17'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! !German class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:17'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:31'! clipboardInterpreterClass | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^ WinShiftJISClipboardInterpreter.]. platformName = 'Mac OS' ifTrue: [ ('10*' match: Smalltalk osVersion) ifTrue: [^ NoConversionClipboardInterpreter] ifFalse: [^ MacShiftJISClipboardInterpreter]. ]. platformName = 'unix' ifTrue: [ (ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [^ MacShiftJISClipboardInterpreter] ifFalse: [^ UnixJPClipboardInterpreter]. ]. ^ NoConversionClipboardInterpreter. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 20:51'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ 'utf-8' copy]. (#('Win32' 'ZaurusOS') includes: platformName) ifTrue: [^ 'shift-jis' copy]. platformName = 'Mac OS' ifTrue: [('10*' match: Smalltalk osVersion) ifTrue: [^ 'utf-8' copy] ifFalse: [^ 'shift-jis' copy]]. (#('unix') includes: platformName) ifTrue: [^ 'euc-jp' copy]. ^ 'mac-roman'. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 18:18'! fileNameConverterClass ^ self systemConverterClass. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 17:33'! inputInterpreterClass | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^ WinShiftJISInputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: Smalltalk 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: 'yo 3/15/2004 19:59'! systemConverterClass | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ UTF8TextConverter]. (#('Win32' 'ZaurusOS') includes: platformName) ifTrue: [^ ShiftJISTextConverter ]. (platformName = 'Mac OS') ifTrue: [ ('10*' match: Smalltalk osVersion) ifTrue: [^ UTF8TextConverter] ifFalse: [^ ShiftJISTextConverter]. ]. (platformName = 'unix') ifTrue: [ encoding _ X11Encoding encoding. encoding ifNil: [ ^ EUCJPTextConverter]. ^ encoding.]. ^ MacRomanTextConverter. ! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:16'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! !MacShiftJISClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'tetha 3/15/2004 08:38'! fromSystemClipboard: aString ^ aString convertFromWithConverter: ShiftJISTextConverter new! ! !MacShiftJISClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'tetha 3/15/2004 08:37'! toSystemClipboard: text | string | "self halt." string _ text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToWithConverter: ShiftJISTextConverter new . ! ! !MacUnicodeInputInterpreter methodsFor: 'as yet unclassified' stamp: 'tetha 2/27/2004 21:44'! nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. keyValue < 256 ifTrue: [^ (Character value: keyValue) squeakToIso]. ^ Smalltalk systemLanguage charsetClass charFromUnicode: keyValue. ! ! !ResourceManager methodsFor: 'loading' stamp: 'tetha 3/6/2004 15:46'! preLoadFromArchive: aZipArchive cacheName: aFileName "Load the resources from the given zip archive" | orig nameMap resMap loc stream | self class reloadCachedResources. resMap _ Dictionary new. nameMap _ Dictionary new. unloaded do:[:locator| locator localFileName: nil. nameMap at: locator urlString put: locator. resMap at: locator urlString put: (resourceMap at: locator)]. aZipArchive members do:[:entry| stream _ nil. orig _ resMap at: (self convertMapNameForBackwardcompatibilityFrom: entry fileName ) ifAbsent:[nil]. loc _ nameMap at: (self convertMapNameForBackwardcompatibilityFrom: entry fileName ) ifAbsent:[nil]. "note: orig and loc may be nil for non-resource members" (orig notNil and:[loc notNil]) ifTrue:[ stream _ entry contentStream. self installResource: orig from: stream locator: loc. stream reset. aFileName ifNil:[self class cacheResource: loc urlString stream: stream] ifNotNil:[self class cacheResource: loc urlString inArchive: aFileName]]. ].! ! !ResourceManager methodsFor: 'backward-compatibility' stamp: 'tetha 3/6/2004 22:13'! convertMapNameForBackwardcompatibilityFrom: aString (Smalltalk platformName = 'Mac OS' and: ['10*' match: Smalltalk osVersion]) ifTrue: [^ aString convertFromWithConverter: ShiftJISTextConverter new]. ^ aString convertFromSystemString! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:17'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! !Spanish class methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2004 19:17'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! JapaneseEnvironment class removeSelector: #defaultInputInterpreter! JapaneseEnvironment class removeSelector: #inputInterpreter! JapaneseEnvironment class removeSelector: #setClipboardInterpreterClass! JapaneseEnvironment class removeSelector: #setInputInterpreterClass! LanguageEnvironment class removeSelector: #fileNameInterpreterClass! LanguageEnvironment class removeSelector: #setClipboardInterpreterClass! LanguageEnvironment class removeSelector: #setDefaultSystemConverterClass! LanguageEnvironment class removeSelector: #setFileNameConverterClass! LanguageEnvironment class removeSelector: #setInputInterpreterClass! LanguageEnvironment class removeSelector: #setSystemConverterClass! LanguageEnvironment class instanceVariableNames: ''! !LanguageEnvironment class reorganize! ('language methods' beCurrentNaturalLanguage flapTabTextFor: flapTabTextFor:in:) ('class initialization' clearDefault initialize startUp) ('subclass responsibilities' charsetClass clipboardInterpreterClass fileNameConverterClass inputInterpreterClass systemConverterClass) ('public query' defaultClipboardInterpreter defaultEncodingName defaultFileNameConverter defaultInputInterpreter defaultSystemConverter) ! 'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 16 March 2004 at 1:47:36 pm'! !Class methodsFor: 'class variables' stamp: 'yo 3/16/2004 12:42'! addClassVarName: aString "Add the argument, aString, as a class variable of the receiver. Signal an error if the first character of aString is not capitalized, or if it is already a variable named in the class." | symbol oldState | oldState _ self copy. aString first canBeGlobalVarInitial ifFalse: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.']. symbol _ aString asSymbol. self withAllSubclasses do: [:subclass | (subclass bindingOf: symbol) ifNotNil:[ ^ self error: aString , ' is already used as a variable name in class ' , subclass name]]. classPool == nil ifTrue: [classPool _ Dictionary new]. (classPool includesKey: symbol) ifFalse: ["Pick up any refs in Undeclared" classPool declare: symbol from: Undeclared. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self] ! ! !CompiledMethod methodsFor: 'printing' stamp: 'yo 3/16/2004 12:29'! timeStamp "Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available." "(CompiledMethod compiledMethodAt: #timeStamp) timeStamp" | file preamble stamp tokens tokenCount | self fileIndex == 0 ifTrue: [^ String new]. "no source pointer for this method" file _ SourceFiles at: self fileIndex. file ifNil: [^ String new]. "sources file not available" "file does not exist happens in secure mode" file _ [file readOnlyCopy] on: FileDoesNotExistException do:[:ex| nil]. file ifNil: [^ String new]. preamble _ self getPreambleFrom: file at: (0 max: self filePosition - 3). stamp _ String new. tokens _ (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [Scanner new scanTokens: preamble] ifFalse: [Array new "ie cant be back ref"]. (((tokenCount _ tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) = #methodsFor:]) ifTrue: [(tokens at: tokenCount - 3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokenCount - 2]]. ((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) = #methodsFor:]) ifTrue: [(tokens at: tokenCount - 1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokenCount]]. file close. ^ stamp ! ! !CompiledMethod methodsFor: 'source code management' stamp: 'yo 3/16/2004 12:23'! getPreambleFrom: aFileStream at: position | writeStream | writeStream _ String new writeStream. position to: 0 by: -1 do: [:p | | c | aFileStream position: p. c _ aFileStream basicNext. c == $!! ifTrue: [^ writeStream contents reverse] ifFalse: [writeStream nextPut: c]]! ! !CompiledMethod methodsFor: 'source code management' stamp: 'yo 3/16/2004 12:48'! qCompress: string firstTry: firstTry "A very simple text compression routine designed for method temp names. Most common 12 chars get values 0-11 packed in one 4-bit nibble; others get values 12-15 (2 bits) * 16 plus next nibble. Last char of str must be a space so it may be dropped without consequence if output ends on odd nibble. Normal call is with firstTry == true." | charTable odd ix oddNibble names shorterStr maybe str temps | str _ string isOctetString ifTrue: [string] ifFalse: [temps _ string findTokens: ' '. String streamContents: [:stream | 1 to: temps size do: [:index | stream nextPut: $t. stream nextPutAll: index asString. stream space]]]. charTable _ "Character encoding table must match qDecompress:" ' eatrnoislcm bdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'. ^ ByteArray streamContents: [:strm | odd _ true. "Flag for odd or even nibble out" oddNibble _ nil. str do: [:char | ix _ (charTable indexOf: char) - 1. (ix <= 12 ifTrue: [Array with: ix] ifFalse: [Array with: ix//16+12 with: ix\\16]) do: [:nibble | (odd _ odd not) ifTrue: [strm nextPut: oddNibble*16 + nibble] ifFalse: [oddNibble _ nibble]]]. strm position > 251 ifTrue: ["Only values 1...251 are available for the flag byte that signals compressed temps. See the logic in endPC." "Before giving up completely, we attempt to encode most of the temps, but with the last few shortened to tNN-style names." firstTry ifFalse: [^ nil "already tried --give up now"]. names _ str findTokens: ' '. names size < 8 ifTrue: [^ nil "weird case -- give up now"]. 4 to: names size//2 by: 4 do: [:i | shorterStr _ String streamContents: [:s | 1 to: names size - i do: [:j | s nextPutAll: (names at: j); space]. 1 to: i do: [:j | s nextPutAll: 't' , j printString; space]]. (maybe _ self qCompress: shorterStr firstTry: false) ifNotNil: [^ maybe]]. ^ nil]. strm nextPut: strm position] " | m s | m _ CompiledMethod new. s _ 'charTable odd ix oddNibble '. ^ Array with: s size with: (m qCompress: s) size with: (m qDecompress: (m qCompress: s)) " ! ! !FileList methodsFor: 'file list menu' stamp: 'yo 3/16/2004 12:53'! fileContentsMenu: aMenu shifted: shifted "Construct aMenu to have items appropriate for the file browser's code pane, given the shift state provided" | shiftMenu services maybeLine extraLines | shifted ifTrue: [shiftMenu _ ParagraphEditor shiftedYellowButtonMenu. ^ aMenu labels: shiftMenu labelString lines: shiftMenu lineArray selections: shiftMenu selections]. fileName ifNotNil: [services _ OrderedCollection new. (#(briefHex briefFile needToGetBriefHex needToGetBrief) includes: brevityState) ifTrue: [services add: self serviceGet]. (#(fullHex briefHex needToGetFullHex needToGetBriefHex) includes: brevityState) ifFalse: [services add: self serviceGetHex]. (#(needToGetShiftJIS needToGetEUCJP needToGetCNGB needToGetEUCKR needToGetUTF8) includes: brevityState) ifFalse: [services add: self serviceGetEncodedText]. maybeLine _ services size. (#('st' 'cs') includes: self suffixOfSelectedFile) ifTrue: [services addAll: (self servicesFromSelectorSpecs: #(fileIntoNewChangeSet: fileIn: browseChangesFile: browseFile:))]. extraLines _ OrderedCollection new. maybeLine > 0 ifTrue: [extraLines add: maybeLine]. services size > maybeLine ifTrue: [extraLines add: services size]. aMenu addServices: services for: self fullName extraLines: extraLines]. aMenu addList: { {'find...(f)' translated. #find}. {'find again (g)' translated. #findAgain}. {'set search string (h)' translated. #setSearchString}. #-. {'do again (j)' translated. #again}. {'undo (z)' translated. #undo}. #-. {'copy (c)' translated. #copySelection}. {'cut (x)' translated. #cut}. {'paste (v)' translated. #paste}. {'paste...' translated. #pasteRecent}. #-. {'do it (d)' translated. #doIt}. {'print it (p)' translated. #printIt}. {'inspect it (i)' translated. #inspectIt}. {'fileIn selection (G)' translated. #fileItIn}. #-. {'accept (s)' translated. #accept}. {'cancel (l)' translated. #cancel}. #-. {'more...' translated. #shiftedYellowButtonActivity}}. ^ aMenu ! ! !FileList methodsFor: 'private' stamp: 'yo 3/16/2004 12:55'! readContentsHex: brevity "retrieve the contents from the external file unless it is too long. Don't create a file here. Check if exists." | f size data hexData s | f := directory oldFileOrNoneNamed: self fullName. f == nil ifTrue: [^ 'For some reason, this file cannot be read' translated]. f binary. ((size := f size)) > 5000 & brevity ifTrue: [data := f next: 10000. f close. brevityState := #briefHex] ifFalse: [data := f contentsOfEntireFile. brevityState := #fullHex]. s := WriteStream on: (String new: data size*4). 0 to: data size-1 by: 16 do: [:loc | s nextPutAll: loc hex; space; nextPut: $(; print: loc; nextPut: $); space; tab. loc+1 to: (loc+16 min: data size) do: [:i | s nextPutAll: (data at: i) hex; space]. s cr]. hexData := s contents. ^ contents := ((size > 5000) & brevity ifTrue: ['File ''{1}'' is {2} bytes long. You may use the ''get'' command to read the entire file. Here are the first 5000 characters... ------------------------------------------ {3} ------------------------------------------ ... end of the first 5000 characters.' translated format: {fileName. size. hexData}] ifFalse: [hexData]). ! ! !ParagraphEditor methodsFor: 'typing support' stamp: 'yo 3/16/2004 13:05'! backTo: startIndex "During typing, backspace to startIndex. Deleted characters fall into three clusters, from left to right in the text: (1) preexisting characters that were backed over; (2) newly typed characters that were backed over (excluding typeahead, which never even appears); (3) preexisting characters that were highlighted before typing began. If typing has not yet been opened, open it and watch for the first and third cluster. If typing has been opened, watch for the first and second cluster. Save characters from the first and third cluster in UndoSelection. Tally characters from the first cluster in UndoMessage's parameter. Delete all the clusters. Do not alter Undoer or UndoInterval (except via openTypeIn). The code is shorter than the comment." | saveLimit newBackovers | saveLimit _ beginTypeInBlock == nil ifTrue: [self openTypeIn. UndoSelection _ self nullText. self stopIndex] ifFalse: [self startOfTyping]. self setMark: startIndex. startIndex < saveLimit ifTrue: [newBackovers _ self startOfTyping - startIndex. beginTypeInBlock _ self startIndex. UndoSelection replaceFrom: 1 to: 0 with: (paragraph text copyFrom: startIndex to: saveLimit - 1). UndoMessage argument: (UndoMessage argument ifNil: [1]) + newBackovers]. self zapSelectionWith: self nullText. self unselect! ! !Project methodsFor: 'language' stamp: 'yo 3/16/2004 13:14'! setNaturalLanguageTo: aLanguageSymbol "Set the project's natural language as indicated" | className | Vocabulary assureTranslationsAvailableFor: aLanguageSymbol. aLanguageSymbol = self naturalLanguage ifFalse: [ self projectParameterAt: #naturalLanguage put: aLanguageSymbol. ActiveWorld allTileScriptingElements do: [:viewerOrScriptor | viewerOrScriptor setNaturalLanguageTo: aLanguageSymbol. Language applyTranslations]]. className _ Vocabulary languageClassNameForLanguageSymbol: aLanguageSymbol. (Smalltalk at: className ifAbsent: [EnglishEnvironment]) beCurrentNaturalLanguage. Smalltalk primaryLanguage: className. Smalltalk systemLanguage: className. #(PartsBin ParagraphEditor BitEditor FormEditor StandardSystemController) do: [ :key | Smalltalk at: key ifPresent: [ :class | class initialize ]]. self setFlaps. self setPaletteFor: aLanguageSymbol. ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 13:17'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList proj trusted localDir projStream archive mgr projectsToBeDeleted baseChangeSet enterRestricted | (preStream isNil or: [preStream size = 0]) ifTrue: [ ProgressNotification signal: '9999 about to enter project'. "the hard part is over" ^self inform: 'It looks like a problem occurred while getting this project. It may be temporary, so you may want to try again,' translated ]. ProgressNotification signal: '2:fileSizeDetermined ',preStream size printString. preStream isZipArchive ifTrue:[ archive _ ZipArchive new readFrom: preStream. projStream _ self projectStreamFromArchive: archive] ifFalse:[projStream _ preStream]. trusted _ SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or: [aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ self]]]. localDir _ Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream contents; close. ]. ]. morphOrList _ projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ProgressNotification signal: '3:unzipped'. ResourceCollector current: ResourceCollector new. baseChangeSet _ ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" [morphOrList _ morphOrList fileInObjectAndCode] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr _ ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. (preStream respondsTo: #close) ifTrue:[preStream close]. ResourceCollector current: nil. ProgressNotification signal: '4:filedIn'. ProgressNotification signal: '9999 about to enter project'. "the hard part is over" (morphOrList isKindOf: ImageSegment) ifTrue: [ proj _ morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^self inform: 'No project found in this file']. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. CurrentProjectRefactoring currentBeParentTo: proj. projectsToBeDeleted _ OrderedCollection new. existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSorter allChangeSets add: proj changeSet. ProjectView openAndEnter: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ChangeSorter allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. proj world ifNotNil: [(proj world valueOfProperty: #soundAdditions) ifNotNilDo: [:additions | SampledSound assimilateSoundsFrom: additions]]. ^ ProjectEntryNotification signal: proj ]. (morphOrList isKindOf: SqueakPage) ifTrue: [ morphOrList _ morphOrList contentsMorph ]. (morphOrList isKindOf: PasteUpMorph) ifFalse: [^ self inform: 'This is not a PasteUpMorph or exported Project.' translated]. (Project newMorphicOn: morphOrList) enter ! ! !Scanner methodsFor: 'expression types' stamp: 'yo 3/16/2004 13:24'! scanLitVec | s | s _ WriteStream on: (Array new: 16). [tokenType = #rightParenthesis or: [tokenType = #doIt]] whileFalse: [tokenType = #leftParenthesis ifTrue: [self scanToken; scanLitVec] ifFalse: [tokenType = #word | (tokenType = #keyword) | (tokenType = #colon) ifTrue: [self scanLitWord. token = #true ifTrue: [token _ true]. token = #false ifTrue: [token _ false]. token = #nil ifTrue: [token _ nil]] ifFalse: [(token == #- and: [((typeTable at: hereChar charCode ifAbsent: [#xLetter])) = #xDigit]) ifTrue: [self scanToken. token _ token negated]]]. s nextPut: token. self scanToken]. token _ s contents! ! !Parser methodsFor: 'error correction' stamp: 'yo 3/16/2004 13:13'! correctVariable: proposedVariable interval: spot "Correct the proposedVariable to a known variable, or declare it as a new variable if such action is requested. We support declaring lowercase variables as temps or inst-vars, and uppercase variables as Globals or ClassVars, depending on whether the context is nil (class=UndefinedObject). Spot is the interval within the test stream of the variable." "inst-Var support has been disabled for now. See the comment in Parser>>declareInstVar:" | tempIvar labels actions lines alternatives binding userSelection choice action | "Check if this is an i-var, that has been corrected already (ugly)" (encoder classEncoding instVarNames includes: proposedVariable) ifTrue: [ ^LiteralVariableNode new name: proposedVariable index: (encoder classEncoding instVarNames indexOf: proposedVariable) - 1 type: 1; yourself ]. "If we can't ask the user for correction, make it undeclared" self interactive ifFalse: [ ^encoder undeclared: proposedVariable ]. "First check to see if the requestor knows anything about the variable" tempIvar _ proposedVariable first canBeNonGlobalVarInitial. (tempIvar and: [ (binding _ requestor bindingOf: proposedVariable) notNil ]) ifTrue: [ ^encoder global: binding name: proposedVariable ]. userSelection _ requestor selectionInterval. requestor selectFrom: spot first to: spot last. requestor select. "Build the menu with alternatives" labels _ OrderedCollection new. actions _ OrderedCollection new. lines _ OrderedCollection new. alternatives _ encoder possibleVariablesFor: proposedVariable. tempIvar ifTrue: [ labels add: 'declare temp'. actions add: [ self declareTempAndPaste: proposedVariable ]. "labels add: 'declare instance'. actions add: [ self declareInstVar: proposedVariable ]" ] ifFalse: [ labels add: 'declare global'. actions add: [ self declareGlobal: proposedVariable ]. encoder classEncoding == UndefinedObject ifFalse: [ labels add: 'declare class variable'. actions add: [ self declareClassVar: proposedVariable ] ] ]. lines add: labels size. alternatives do: [ :each | labels add: each. actions add: [ self substituteWord: each wordInterval: spot offset: 0. encoder encodeVariable: each ] fixTemps ]. lines add: labels size. labels add: 'cancel'. "Display the pop-up menu" choice _ (PopUpMenu labelArray: labels asArray lines: lines asArray) startUpWithCaption: 'Unknown variable: ', proposedVariable, ' please correct, or cancel:'. action _ actions at: choice ifAbsent: [ ^self fail ]. "Execute the selected action" requestor deselect. requestor selectInvisiblyFrom: userSelection first to: userSelection last. ^action value! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'yo 3/16/2004 13:35'! 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: [^ self 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.! ! !VersionsBrowser methodsFor: 'init & update' stamp: 'yo 3/16/2004 13:46'! scanVersionsOf: method class: class meta: meta category: category selector: selector | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp | selectorOfMethod _ selector. currentCompiledMethod _ method. classOfMethod _ meta ifTrue: [class class] ifFalse: [class]. changeList _ OrderedCollection new. list _ OrderedCollection new. listIndex _ 0. position _ method filePosition. sourceFilesCopy _ SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. method fileIndex == 0 ifTrue: [^ nil]. file _ sourceFilesCopy at: method fileIndex. [position notNil & file notNil] whileTrue: [ preamble _ method getPreambleFrom: file at: (0 max: position - 3). "Preamble is likely a linked method preamble, if we're in a changes file (not the sources file). Try to parse it for prior source position and file index" prevPos _ nil. stamp _ ''. (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [tokens _ Scanner new scanTokens: preamble] ifFalse: [tokens _ Array new "ie cant be back ref"]. ((tokens size between: 7 and: 8) and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue: [(tokens at: tokens size-3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size-2. prevPos _ tokens last. prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos] ifFalse: ["Old format gives no stamp; prior pointer in two parts" prevPos _ tokens at: tokens size-2. prevFileIndex _ tokens last]. (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]]. ((tokens size between: 5 and: 6) and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue: [(tokens at: tokens size-1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size]]. self addItem: (ChangeRecord new file: file position: position type: #method class: class name category: category meta: meta stamp: stamp) text: stamp , ' ' , class name , (meta ifTrue: [' class '] ifFalse: [' ']) , selector. position _ prevPos. prevPos notNil ifTrue: [file _ sourceFilesCopy at: prevFileIndex]]. sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]. listSelections _ Array new: list size withAll: false! ! 'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 16 March 2004 at 4:53:15 pm'! Object subclass: #IdentityGlyphMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! MultiCharacterScanner subclass: #MultiCompositionScanner instanceVariableNames: 'spaceX lineHeight baseline breakableIndex lineHeightAtBreak baselineAtBreak breakAtSpace lastWidth ' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Scanning'! StrikeFont subclass: #HostFont instanceVariableNames: 'fullWidth kernPairs ranges' classVariableNames: 'IsoToSqueakMap' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! Object subclass: #SystemEndiannes instanceVariableNames: '' classVariableNames: 'Cache' poolDictionaries: '' category: 'System-Support'! AbstractFont subclass: #TTCFont instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives ' classVariableNames: 'NamesToIndexes Scale ' poolDictionaries: '' category: 'Multilingual-Display'! TTFontReader subclass: #TTCFontReader instanceVariableNames: 'fonts ' classVariableNames: 'EncodingTag ' poolDictionaries: '' category: 'Multilingual-Display'! TextConverter subclass: #CP1253TextConverter instanceVariableNames: '' classVariableNames: 'FromTable' poolDictionaries: '' category: 'Multilingual-TextConversion'! TextConverter subclass: #ISO88597TextConverter instanceVariableNames: '' classVariableNames: 'FromTable' poolDictionaries: '' category: 'Multilingual-TextConversion'! TextConverter subclass: #UTF16TextConverter instanceVariableNames: 'useLittleEndian useByteOrderMark byteOrderMarkDone' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! ClipboardInterpreter subclass: #WinGB2312ClipboardInterpreter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! KeyboardInputInterpreter subclass: #WinGB2312InputInterpreter instanceVariableNames: 'converter' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! ClipboardInterpreter subclass: #WinKSX1001ClipboardInterpreter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! KeyboardInputInterpreter subclass: #WinKSX1001InputInterpreter instanceVariableNames: 'converter' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! StandardFileStream subclass: #MultiByteFileStream instanceVariableNames: 'converter wantsLineEndConversion lineEndConvention ' classVariableNames: 'LookAheadCount LineEndDefault Cr CrLf LineEndStrings Lf ' poolDictionaries: '' category: 'Multilingual-TextConversion'! !BMPReadWriter methodsFor: 'writing' stamp: 'yo 2/18/2004 17:57'! nextPutImage: aForm | bhSize rowBytes rgb data colorValues depth image ppw scanLineLen | depth := aForm depth. [#(1 4 8 32) includes: depth] whileFalse:[depth := depth + 1 asLargerPowerOfTwo]. image := aForm asFormOfDepth: depth. image unhibernate. bhSize _ 14. "# bytes in file header" biSize _ 40. "info header size in bytes" biWidth := image width. biHeight := image height. biClrUsed _ depth = 32 ifTrue: [0] ifFalse:[1 << depth]. "No. color table entries" bfOffBits _ biSize + bhSize + (4*biClrUsed). rowBytes _ ((depth min: 24) * biWidth + 31 // 32) * 4. biSizeImage _ biHeight * rowBytes. "Write the file header" stream position: 0. stream nextLittleEndianNumber: 2 put: 19778. "bfType = BM" stream nextLittleEndianNumber: 4 put: bfOffBits + biSizeImage. "Entire file size in bytes" stream nextLittleEndianNumber: 4 put: 0. "bfReserved" stream nextLittleEndianNumber: 4 put: bfOffBits. "Offset of bitmap data from start of hdr (and file)" "Write the bitmap info header" stream position: bhSize. stream nextLittleEndianNumber: 4 put: biSize. "info header size in bytes" stream nextLittleEndianNumber: 4 put: image width. "biWidth" stream nextLittleEndianNumber: 4 put: image height. "biHeight" stream nextLittleEndianNumber: 2 put: 1. "biPlanes" stream nextLittleEndianNumber: 2 put: (depth min: 24). "biBitCount" stream nextLittleEndianNumber: 4 put: 0. "biCompression" stream nextLittleEndianNumber: 4 put: biSizeImage. "size of image section in bytes" stream nextLittleEndianNumber: 4 put: 2800. "biXPelsPerMeter" stream nextLittleEndianNumber: 4 put: 2800. "biYPelsPerMeter" stream nextLittleEndianNumber: 4 put: biClrUsed. stream nextLittleEndianNumber: 4 put: 0. "biClrImportant" biClrUsed > 0 ifTrue: [ "write color map; this works for ColorForms, too" colorValues _ image colormapIfNeededForDepth: 32. 1 to: biClrUsed do: [:i | rgb _ colorValues at: i. 0 to: 24 by: 8 do: [:j | stream nextPut: (rgb >> j bitAnd: 16rFF)]]]. depth < 32 ifTrue: [ "depth = 1, 4 or 8." data _ image bits asByteArray. ppw _ 32 // depth. scanLineLen _ biWidth + ppw - 1 // ppw * 4. "# of bytes in line" 1 to: biHeight do: [:i | stream next: scanLineLen putAll: data startingAt: (biHeight-i)*scanLineLen+1. ]. ] ifFalse: [ 1 to: biHeight do:[:i | data _ (image copy: (0@(biHeight-i) extent: biWidth@1)) bits. 1 to: data size do: [:j | stream nextLittleEndianNumber: 3 put: (data at: j)]. 1 to: (data size*3)+3//4*4-(data size*3) do: [:j | stream nextPut: 0 "pad to 32-bits"] ]. ]. stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure']. stream close.! ! !Bitmap methodsFor: 'as yet unclassified' stamp: 'yo 2/18/2004 17:58'! asByteArray "Faster way to make a byte array from me. copyFromByteArray: makes equal Bitmap." | f bytes hack | f _ Form extent: 4@self size depth: 8 bits: self. bytes _ ByteArray new: self size * 4. hack _ Form new hackBits: bytes. SystemEndiannes isLittleEndian ifTrue:[hack swapEndianness]. hack copyBits: f boundingBox from: f at: (0@0) clippingBox: hack boundingBox rule: Form over fillColor: nil map: nil. "f displayOn: hack." ^ bytes. ! ! !CombinedChar methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 07:08'! add: char | dict elem | codes ifNil: [codes _ Array with: char. combined _ char. ^ true]. dict _ Compositions at: combined charCode ifAbsent: [^ false]. elem _ dict at: combined charCode ifAbsent: [^ false]. codes _ codes copyWith: char. combined _ elem. ^ true. ! ! !CombinedChar methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 07:08'! base ^ codes first. ! ! !CombinedChar methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 07:08'! combined ^ combined. ! ! !IdentityGlyphMap methodsFor: 'as yet unclassified' stamp: 'yo 2/13/2004 04:07'! at: index ^ index - 1. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/16/2004 14:49'! defaultClipboardInterpreter ClipboardInterpreter ifNil: [ClipboardInterpreter _ self clipboardInterpreterClass]. ^ NoConversionClipboardInterpreter new. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:49'! traditionalCharsetClass ^ JISX0208. ! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:53'! beCurrentNaturalLanguage super beCurrentNaturalLanguage. Preferences restoreDefaultFontsForJapanese. ! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:51'! clipboardInterpreterClass | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^ WinKSX1001ClipboardInterpreter.]. platformName = 'Mac OS' ifTrue: [ ('10*' match: Smalltalk 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: 'yo 3/16/2004 14:52'! inputInterpreterClass | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^ WinKSX1001InputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: Smalltalk 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. ! ! !KoreanEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:50'! traditionalCharsetClass ^ KSX1001. ! ! !MultiCharacterScanner methodsFor: 'scanner methods' stamp: 'yo 2/13/2004 04:58'! scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta | ascii encoding f nextDestX maxAscii startEncoding | lastIndex _ startIndex. lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun]. startEncoding _ (sourceString at: startIndex) leadingChar. font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1]. ((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [ [f _ font fontArray at: startEncoding + 1] on: Exception do: [:ex | f _ font fontArray at: 1]. f ifNil: [ f _ font fontArray at: 1]. maxAscii _ f maxAscii. "xTable _ f xTable. maxAscii _ xTable size - 2." spaceWidth _ f widthOf: Space. ] ifFalse: [ (font isMemberOf: HostFont) ifTrue: [ f _ font. maxAscii _ f maxAscii. spaceWidth _ f widthOf: Space. ] ifFalse: [ maxAscii _ font maxAscii. ]. ]. [lastIndex <= stopIndex] whileTrue: [ "self halt." encoding _ (sourceString at: lastIndex) leadingChar. encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun]. ascii _ (sourceString at: lastIndex) charCode. ascii > maxAscii ifTrue: [ascii _ maxAscii]. (encoding = 0 and: [(stopConditions at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1]. (self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [ self registerBreakableIndex. ]. nextDestX _ destX + (font widthOf: (sourceString at: lastIndex)). nextDestX > rightX ifTrue: [^ stops at: CrossedX]. destX _ nextDestX + kernDelta. lastIndex _ lastIndex + 1. ]. lastIndex _ stopIndex. ^ stops at: EndOfRun! ! !MultiCharacterScanner methodsFor: 'scanner methods' stamp: 'yo 2/10/2004 23:00'! scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta | charCode encoding f maxAscii startEncoding combining combined combiningIndex c | lastIndex _ startIndex. lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun]. startEncoding _ (sourceString at: startIndex) leadingChar. font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1]. ((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [ [f _ font fontArray at: startEncoding + 1] on: Exception do: [:ex | f _ font fontArray at: 1]. f ifNil: [ f _ font fontArray at: 1]. maxAscii _ f maxAscii. spaceWidth _ font widthOf: Space. ] ifFalse: [ maxAscii _ font maxAscii. spaceWidth _ font widthOf: Space. ]. combining _ nil. [lastIndex <= stopIndex] whileTrue: [ charCode _ (sourceString at: lastIndex) charCode. c _ (sourceString at: lastIndex). combining ifNil: [ combining _ CombinedChar new. combining add: c. combiningIndex _ lastIndex. lastIndex _ lastIndex + 1. ] ifNotNil: [ (combining add: c) ifFalse: [ self addCharToPresentation: (combined _ combining combined). combining _ CombinedChar new. combining add: c. charCode _ combined charCode. encoding _ combined leadingChar. encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. (encoding = 0 and: [(stopConditions at: charCode + 1) ~~ nil]) ifTrue: [ ^ stops at: charCode + 1 ] ifFalse: [ ^ stops at: EndOfRun ]. ]. charCode > maxAscii ifTrue: [charCode _ maxAscii]. "" (encoding = 0 and: [(stopConditions at: charCode + 1) ~~ nil]) ifTrue: [ combining ifNotNil: [ self addCharToPresentation: (combining combined). ]. ^ stops at: charCode + 1 ]. (self isBreakableAt: lastIndex in: sourceString in: Latin1) ifTrue: [ self registerBreakableIndex. ]. destX > rightX ifTrue: [ lastIndex _ combiningIndex. self removeLastCharFromPresentation. ^ stops at: CrossedX]. combiningIndex _ lastIndex. lastIndex _ lastIndex + 1. ] ifTrue: [ lastIndex _ lastIndex + 1. numOfComposition _ numOfComposition + 1. ]. ]. ]. lastIndex _ stopIndex. combining ifNotNil: [ combined _ combining combined. self addCharToPresentation: combined. "assuming that there is always enough space for at least one character". destX _ destX + (self widthOf: combined inFont: font). ]. ^ stops at: EndOfRun! ! !MultiCompositionScanner methodsFor: 'multilingual scanning' stamp: 'yo 2/10/2004 23:00'! addCharToPresentation: char presentation nextPut: char. lastWidth _ self widthOf: char inFont: font. destX _ destX + lastWidth. ! ! !MultiCompositionScanner methodsFor: 'multilingual scanning' stamp: 'yo 2/10/2004 22:59'! removeLastCharFromPresentation presentation ifNotNil: [ presentation position: presentation position - 1. ]. destX _ destX - lastWidth. ! ! !MultiCompositionScanner methodsFor: 'stop conditions' stamp: 'yo 2/10/2004 23:03'! endOfRun "Answer true if scanning has reached the end of the paragraph. Otherwise step conditions (mostly install potential new font) and answer false." | runLength | lastIndex = text size ifTrue: [line stop: lastIndex. presentationLine stop: lastIndex - numOfComposition. spaceX _ destX. line paddingWidth: rightMargin - destX. presentationLine paddingWidth: rightMargin - destX. ^true] ifFalse: [ "(text at: lastIndex) charCode = 32 ifTrue: [destX _ destX + spaceWidth]." runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)). runStopIndex _ lastIndex + (runLength - 1). self setStopConditions. ^false] ! ! !MultiString methodsFor: 'testing' stamp: 'yo 1/15/2004 14:56'! isUnicodeStringWithCJK self do: [:c | (c isUnicode and: [Unicode isUnifiedKanji: c charCode]) ifTrue: [ ^ true ]. ]. ^ false. ! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:53'! beCurrentNaturalLanguage super beCurrentNaturalLanguage. Preferences restoreDefaultFontsForJapanese. ! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:54'! charsetClass ^ UnicodeSimplifiedChinese ! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:55'! clipboardInterpreterClass | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^ WinGB2312ClipboardInterpreter.]. platformName = 'Mac OS' ifTrue: [ ('10*' match: Smalltalk 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: 'yo 3/16/2004 14:55'! inputInterpreterClass | platformName osVersion encoding | platformName _ Smalltalk platformName. osVersion _ Smalltalk getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^ MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^ WinGB2312InputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: Smalltalk 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. ! ! !SimplifiedChineseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:55'! traditionalCharsetClass ^ GB2312 ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 2/13/2004 05:00'! widthOf: aCharacter "Answer the width of the argument as a character in the receiver." | ascii | ascii _ aCharacter charCode. (ascii >= minAscii and:[ascii <= maxAscii]) ifFalse: [ascii _ maxAscii + 1]. ^ (xTable at: ascii + 2) - (xTable at: ascii + 1) ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 2/13/2004 04:12'! characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm "Simple, slow, primitive method for displaying a line of characters. No wrap-around is provided." ^ self characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: 0. ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 2/13/2004 04:44'! characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta "Simple, slow, primitive method for displaying a line of characters. No wrap-around is provided." | ascii destPoint bb leftX rightX sourceRect | destPoint _ aPoint. bb _ BitBlt current toForm: Display. anInterval do: [:i | ascii _ (sourceString at: i) charCode. (ascii < minAscii or: [ascii > maxAscii]) ifTrue: [ascii _ maxAscii]. leftX _ xTable at: ascii + 1. rightX _ xTable at: ascii + 2. sourceRect _ leftX@0 extent: (rightX-leftX) @ self height. bb copyFrom: sourceRect in: glyphs to: destPoint. destPoint _ destPoint + ((rightX-leftX+kernDelta)@0). "destPoint printString displayAt: 0@(i*20)"]. ^ destPoint! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 2/17/2004 16:20'! widthOfString: aString from: firstIndex to: lastIndex "Measure the length of the given string between start and stop index" DefaultStringScanner ifNil:[DefaultStringScanner _ MultiCharacterScanner new initializeStringMeasurer]. ^DefaultStringScanner measureString: aString inFont: self from: firstIndex to: lastIndex ! ! !StrikeFont methodsFor: 'file in/out' stamp: 'yo 2/9/2004 18:56'! readEFontBDFForGreekFromFile: fileName name: aString | fontReader stream | fontReader _ EFontBDFFontReaderForRanges readOnlyFileNamed: fileName. stream _ ReadStream on: (fontReader readRanges: fontReader rangesForGreek). xTable _ stream next. glyphs _ stream next. minAscii _ stream next. maxAscii _ stream next. maxWidth _ stream next. ascent _ stream next. descent _ stream next. pointSize _ stream next. name _ aString. type _ 0. "no one see this" superscript _ ascent - descent // 3. subscript _ descent - ascent // 3. emphasis _ 0. self reset. ! ! !StrikeFont methodsFor: 'file in/out' stamp: 'yo 1/15/2004 16:48'! readEFontBDFForKoreanFromFile: fileName name: aString overrideWith: otherFileName | fontReader stream | fontReader _ EFontBDFFontReaderForRanges readOnlyFileNamed: fileName. stream _ ReadStream on: (fontReader readRanges: fontReader rangesForKorean overrideWith: otherFileName otherRanges: {Array with: 8481 with: 12320} additionalOverrideRange: fontReader additionalRangesForKorean). xTable _ stream next. glyphs _ stream next. minAscii _ stream next. maxAscii _ stream next. maxWidth _ stream next. ascent _ stream next. descent _ stream next. pointSize _ stream next. name _ aString. type _ 0. "no one see this" superscript _ ascent - descent // 3. subscript _ descent - ascent // 3. emphasis _ 0. self reset. ! ! !StrikeFont methodsFor: 'private' stamp: 'yo 9/23/2002 20:17'! createCharacterToGlyphMap "Private. Create the character to glyph mapping for a font that didn't have any before. This is basically equivalent to what the former setStopCondition did, only based on indexes." | map | maxAscii > 258 ifTrue: [^ GlyphMapForFixedFont new]. map _ Array new: 256. 0 to: minAscii - 1 do:[:i| map at: i + 1 put: maxAscii + 1]. minAscii to: maxAscii do:[:i| map at: i + 1 put: i]. maxAscii + 1 to: 255 do:[:i| map at: i + 1 put: maxAscii + 1]. ^map! ! !HostFont methodsFor: 'accessing' stamp: 'yo 2/13/2004 04:06'! createCharacterToGlyphMap ^ IdentityGlyphMap new. ! ! !HostFont methodsFor: 'accessing' stamp: 'yo 2/13/2004 04:49'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint ascii leftX rightX | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | ascii _ (aString at: charIndex) charCode. ((ascii between: self minAscii and: self maxAscii) not) ifTrue: [ ascii _ self maxAscii]. xTable _ self xTable. leftX _ xTable at: ascii + 1. leftX < 0 ifTrue: [ leftX _ xTable at: self maxAscii + 2. rightX _ xTable at: self maxAscii + 3 ] ifFalse: [ rightX _ xTable at: ascii + 2. ]. aBitBlt sourceForm: self glyphs. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ! ! !HostFont methodsFor: 'accessing' stamp: 'yo 2/17/2004 16:23'! widthOfString: aString from: firstIndex to: lastIndex ^ (aString copyFrom: firstIndex to: lastIndex) inject: 0 into: [:s :t | s _ s + (self widthOf: t)].! ! !HostFont methodsFor: 'emphasis' stamp: 'yo 2/14/2004 01:38'! makeBoldGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeBoldGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 1) rangesArray: ranges) ifNil:[^super makeBoldGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'yo 2/14/2004 01:39'! makeItalicGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeItalicGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 2) rangesArray: ranges) ifNil:[^super makeItalicGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'yo 2/14/2004 01:39'! makeStruckOutGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeStruckOutGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 8) rangesArray: ranges) ifNil:[^super makeStruckOutGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'emphasis' stamp: 'yo 2/14/2004 01:40'! makeUnderlinedGlyphs "First check if we can use some OS support for this" (self class listFontNames includes: name) ifFalse:[^super makeUnderlinedGlyphs]. "Now attempt a direct creation through the appropriate primitives" (self fontName: name size: pointSize emphasis: (emphasis bitOr: 4) rangesArray: ranges) ifNil:[^super makeUnderlinedGlyphs]. "nil means we failed"! ! !HostFont methodsFor: 'private-creation' stamp: 'yo 2/14/2004 01:38'! fontName: fontName size: ptSize emphasis: emphasisCode ^ self fontName: fontName size: ptSize emphasis: emphasisCode rangesArray: (Array with: (Array with: 0 with: 255)). ! ! !HostFont methodsFor: 'private-creation' stamp: 'yo 2/14/2004 01:41'! fontName: fontName size: ptSize emphasis: emphasisCode rangesArray: rangesArray " ^HostFont fontName: ('MS UI Gothic') size: 12 emphasis: 0 rangesArray: EFontBDFFontReaderForRanges basicNew rangesForJapanese. " | fontHandle xStart w glyphForm fontHeight fw enc rangesStream currentRange | fontHandle _ self primitiveCreateFont: fontName size: ptSize emphasis: emphasisCode. fontHandle ifNil:[^nil]. ranges _ rangesArray. ranges ifNil: [ranges _ Array with: (Array with: 0 with: 255)]. pointSize _ ptSize. name _ fontName. emphasis _ emphasisCode. minAscii _ 0. maxAscii _ ranges last last. ascent _ self primitiveFontAscent: fontHandle. descent _ self primitiveFontDescent: fontHandle. kernPairs _ Array new: (self primitiveFontNumKernPairs: fontHandle). 1 to: kernPairs size do:[:i| kernPairs at: i put: (self primitiveFont: fontHandle getKernPair: i)]. fontHeight _ ascent + descent. xTable _ Array new: maxAscii + 3. fullWidth _ Array new: maxAscii + 1. xStart _ maxWidth _ 0. rangesStream _ ReadStream on: (ranges collect: [:e | (e first to: e second)]). currentRange _ rangesStream next. 0 to: maxAscii do:[:i| xTable at: i+1 put: xStart. i > currentRange last ifTrue: [ [rangesStream atEnd not and: [currentRange _ rangesStream next. currentRange last < i]] whileTrue. rangesStream atEnd ifTrue: []. ]. (currentRange includes: i) ifTrue: [ xTable at: i+1 put: xStart. fw _ self primitiveFont: fontHandle fullWidthOfChar: i. (#( 1 "anchored morph" 9 "tab" 10 "LF" 13 "CR" ) includes: i) ifTrue:[fw := {0. 0. 0}]. fullWidth at: i+1 put: fw. w _ fw at: 2. (fw at: 1) > 0 ifTrue:[w _ w + (fw at: 1)]. (fw at: 3) > 0 ifTrue:[w _ w + (fw at: 3)]. w > maxWidth ifTrue:[maxWidth _ w]. xStart _ xStart + w]. ]. xStart = 0 ifTrue:[^nil]. strikeLength _ xStart. xTable at: maxAscii+1 put: xStart. xTable at: maxAscii+2 put: xStart. xTable at: maxAscii+3 put: xStart. glyphs _ Form extent: xTable last @ fontHeight depth: 1. glyphForm _ Form extent: maxWidth @ fontHeight depth: 1. 0 to: maxAscii do:[:i| glyphForm fillWhite. self primitiveFont: fontHandle glyphOfChar: i into: glyphForm. xStart _ xTable at: i+1. glyphForm displayOn: glyphs at: xStart@0. "glyphForm displayOn: Display at: xStart@0." ]. enc := self primitiveFontEncoding: fontHandle. enc = 1 ifTrue:[characterToGlyphMap := self isoToSqueakMap]. self primitiveDestroyFont: fontHandle. ^self! ! !HostFont methodsFor: 'private-creation' stamp: 'yo 2/13/2004 02:53'! isoToSqueakMap ^nil ! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'yo 2/9/2004 18:57'! newForGreekFromEFontBDFFile: fileName name: aString | n | n _ self new. n readEFontBDFForGreekFromFile: fileName name: aString. ^ n. ! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'yo 1/15/2004 16:48'! newForKoreanFromEFontBDFFile: fileName name: aString overrideWith: otherFileName | n | n _ self new. n readEFontBDFForKoreanFromFile: fileName name: aString overrideWith: otherFileName. ^ n. ! ! !HostFont class methodsFor: 'instance creation' stamp: 'yo 2/14/2004 01:17'! fontName: fontName size: ptSize emphasis: emphasisCode rangesArray: ranges " ^HostFont fontName: (HostFont fontNameFromUser) size: 12 emphasis: 0. " ^self new fontName: fontName size: ptSize emphasis: emphasisCode rangesArray: ranges! ! !HostFont class methodsFor: 'accessing' stamp: 'yo 2/14/2004 01:50'! defaultRanges ^ Array with: (Array with: 0 with: 16r2AFF). ! ! !HostFont class methodsFor: 'accessing' stamp: 'yo 2/14/2004 01:57'! rangesForJapanese | basics etc | basics _ { Array with: 0 with: 255 }. etc _ { Array with: 16r370 with: 16r3FF. "greek" Array with: 16r400 with: 16r52F. "cyrillic" Array with: 16r1D00 with: 16r1D7F. "phonetic" Array with: 16r1E00 with: 16r1EFF. "latin extended additional" Array with: 16r2000 with: 16r206F. "general punctuation" Array with: 16r20A0 with: 16r20CF. "currency symbols" Array with: 16r2100 with: 16r214F. "letterlike" Array with: 16r2150 with: 16r218F. "number form" Array with: 16r2190 with: 16r21FF. "arrows" Array with: 16r2200 with: 16r22FF. "math operators" Array with: 16r2300 with: 16r23FF. "misc tech" Array with: 16r2460 with: 16r24FF. "enclosed alnum" Array with: 16r2500 with: 16r257F. "box drawing" Array with: 16r2580 with: 16r259F. "box elem" Array with: 16r25A0 with: 16r25FF. "geometric shapes" Array with: 16r2600 with: 16r26FF. "misc symbols" Array with: 16r2700 with: 16r27BF. "dingbats" Array with: 16r27C0 with: 16r27EF. "misc math A" Array with: 16r27F0 with: 16r27FF. "supplimental arrow A" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2980 with: 16r29FF. "misc math B" Array with: 16r2A00 with: 16r2AFF. "supplimental math op" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2E80 with: 16r2EFF. "cjk radicals suppliment" Array with: 16r2F00 with: 16r2FDF. "kangxi radicals" Array with: 16r3000 with: 16r303F. "cjk symbols" Array with: 16r3040 with: 16r309F. "hiragana" Array with: 16r30A0 with: 16r30FF. "katakana" Array with: 16r3190 with: 16r319F. "kanbun" Array with: 16r31F0 with: 16r31FF. "katakana extension" Array with: 16r3200 with: 16r32FF. "enclosed CJK" Array with: 16r3300 with: 16r33FF. "CJK compatibility" Array with: 16r3400 with: 16r4DBF. "CJK unified extension A" Array with: 16r4E00 with: 16r9FAF. "CJK ideograph" Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph" Array with: 16rFE30 with: 16rFE4F. "CJK compatiblity forms" Array with: 16rFF00 with: 16rFFEF. "half and full" }. ^ basics, etc. ! ! !HostFont class methodsFor: 'accessing' stamp: 'yo 2/14/2004 01:26'! textStyleFrom: fontName sizes: ptSizes ranges: ranges | styleName fonts | styleName _ fontName asSymbol. (TextConstants includesKey: styleName) ifTrue:[(self confirm: styleName , ' is already defined in TextConstants. Do you want to replace that definition?') ifFalse: [^ self]]. ('Rendering ', styleName) displayProgressAt: Sensor cursorPoint from: 1 to: ptSizes size during:[:bar| fonts _ ptSizes collect:[:ptSize| bar value: (ptSizes indexOf: ptSize). self fontName: styleName size: ptSize emphasis: 0 rangesArray: ranges ] thenSelect:[:font| font notNil]]. "reject those that failed" fonts size = 0 ifTrue:[^self error:'Could not create font style', styleName]. TextConstants at: styleName put: (TextStyle fontArray: fonts).! ! !HostFont class methodsFor: 'system defaults' stamp: 'yo 2/17/2004 19:15'! initForSubtitles " HostFont initForSubtitles " HostFont textStyleFrom: 'Verdana' sizes: #(18 20 22 24 26 28) ranges: HostFont defaultRanges. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. TTCFontReader encodingTag: UnicodeSimplifiedChinese leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\simhei.TTF'. TTCFontReader encodingTag: UnicodeJapanese leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC'. TTCFontReader encodingTag: UnicodeKorean leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\gulim.TTC'. ! ! !HostFont class methodsFor: 'system defaults' stamp: 'yo 2/13/2004 23:25'! initWin32 "HostFont initWin32" #( "Basic fonts" ('Arial' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Times New Roman' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Courier New' "menu/text fixed" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Wingdings' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Symbol' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) "Nice fonts" ('Verdana' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Tahoma' "menu/text serifless" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Garamond' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Georgia' "menu/text serifs" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Comic Sans MS' "eToy" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) "Optional fonts" ('Impact' "flaps" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('Webdings' "deco" (10 11 12 13 14 16 18 20 22 24 26 28 30 36 48 60 72 90)) ('System' "12pt only" (12)) ('Fixedsys' "12pt only" (12)) ) do:[:spec| HostFont textStyleFrom: spec first sizes: spec last]. TextConstants removeKey: #Atlanta ifAbsent: []. TextConstants removeKey: #ComicPlain ifAbsent: []. TextConstants removeKey: #ComicBold ifAbsent: []. TextConstants removeKey: #Courier ifAbsent: []. TextConstants removeKey: #Palatino ifAbsent: []. TextConstants at: #DefaultFixedTextStyle put: (TextConstants at: #'Courier New'). TextConstants at: #Helvetica put: (TextConstants at: #'Arial'). ! ! !HostFont class methodsFor: 'system defaults' stamp: 'yo 2/21/2004 02:40'! unloadAsianTT " self unloadAsianTT " TTCFontSet removeStyleName: 'SimHei'. TTCFontSet removeStyleName: 'MSGothic'. TTCFontSet removeStyleName: 'Gulim'. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 2/9/2004 18:58'! createExternalFontFileForGreek: fileName " StrikeFontSet createExternalFontFileForGreek: 'greekFont.out'. " | file array f installDirectory | file _ FileStream newFileNamed: fileName. installDirectory _ Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory _ installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array _ Array with: (StrikeFont newForGreekFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'EFontGreek10') with: (StrikeFont newForGreekFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'EFontGreek12') with: (StrikeFont newForGreekFromEFontBDFFile: installDirectory , 'b16.bdf' name: 'EFontGreek14') with: (StrikeFont newForGreekFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'EFonGreek20'). TextConstants at: #forceFontWriting put: true. f _ ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 16:58'! createExternalFontFileForUnicodeKorean: fileName " Smalltalk garbageCollect. StrikeFontSet createExternalFontFileForUnicodeKorean: 'uKoreanFont.out'. " | file array f installDirectory | file _ FileStream newFileNamed: fileName. installDirectory _ Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory _ installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array _ Array with: (StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'Japanese10' overrideWith: 'shnmk12.bdf') with: ((StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'Japanese12' overrideWith: 'shnmk14.bdf') "fixAscent: 14 andDescent: 1 head: 1") with: ((StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b16.bdf' name: 'Japanese14' overrideWith: 'hanglg16.bdf') fixAscent: 16 andDescent: 4 head: 4) with: (StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'Japanese18' overrideWith: 'hanglm24.bdf'). TextConstants at: #forceFontWriting put: true. f _ ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 17:08'! installExternalFontFileName: fileName encoding: encoding encodingName: aString textStyleName: styleName ^ self installExternalFontFileName: fileName inDir: FileDirectory default encoding: encoding encodingName: aString textStyleName: styleName. " StrikeFontSet createExternalFontFileForCyrillic: 'cyrillicFont.out'. StrikeFontSet installExternalFontFileName: 'chineseFont.out' encoding: 2 encodingName: #Gb2312 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'japaneseFont.out' encoding: 1 encodingName: #JisX0208 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'defaultFont.out' encoding: 0 encodingName: #Latin1 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'cyrillicFont.out' encoding: UnicodeCyrillic leadingChar encodingName: #Cyrillic textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'extendedLatinFont.out' encoding: UnicodeLatinExtendedAB leadingChar encodingName: #ExtendedLatin textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'ipaExtensionsFont.out' encoding: UnicodeIPA leadingChar encodingName: #IPAExtensions textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'armenianFont.out' encoding: UnicodeArmenian leadingChar encodingName: #Armenian textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'arrowFont.out' encoding: UnicodeArrows leadingChar encodingName: #Arrow textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uJapaneseFont.out' encoding: UnicodeJapanese leadingChar encodingName: #Japanese textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uKoreanFont.out' encoding: UnicodeKorean leadingChar encodingName: #Korean textStyleName: #DefaultMultiStyle. StrikeFontSet removeFontsForEncoding: 2 encodingName: #Gb2312. self halt. StrikeFontSet removeFontsForEncoding: 3 encodingName: #KsX1001. " ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 16:06'! installNewFontAtIndex: newIndex fromOld: oldIndex | fontArray newArray | self allInstances do: [:set | fontArray _ set fontArray. newIndex + 1 > fontArray size ifTrue: [ newArray _ Array new: newIndex + 1. newArray replaceFrom: 1 to: fontArray size with: fontArray startingAt: 1. newArray at: newIndex + 1 put: (fontArray at: oldIndex + 1). set initializeWithFontArray: newArray. ] ifFalse: [ fontArray at: newIndex + 1 put: (fontArray at: oldIndex + 1). ]. ]. " StrikeFontSet installNewFontAtIndex: UnicodeSimplifiedChinese leadingChar fromOld: UnicodeJapanese leadingChar StrikeFontSet installNewFontAtIndex: UnicodeKorean leadingChar fromOld: UnicodeJapanese leadingChar " ! ! !SystemEndiannes class methodsFor: 'as yet unclassified' stamp: 'yo 2/18/2004 15:35'! 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" 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'.! ! !TTCFont class methodsFor: 'other' stamp: 'yo 2/17/2004 14:40'! scale: anObject Scale _ anObject. ! ! TTCFont scale: 1.0@1.0! !TTCFont methodsFor: 'accessing' stamp: 'yo 3/11/2004 11:38'! ascent ^ (ttcDescription ascender * self pixelSize // (ttcDescription ascender - ttcDescription descender)) * Scale y. ! ! !TTCFont methodsFor: 'accessing' stamp: 'yo 3/11/2004 11:38'! descent "One is added to make sure the gap between lines is filled. If we don't add, multi line selection in a text pane look ugly." ^ (ttcDescription descender * self pixelSize // (ttcDescription descender - ttcDescription ascender)) * Scale y + 1. ! ! !TTCFont methodsFor: 'accessing' stamp: 'yo 3/11/2004 11:38'! height "Answer my height in pixels. This will answer a Float." ^ self pixelSize * Scale y! ! !TTCFont methodsFor: 'private' stamp: 'yo 12/30/2003 17:16'! computeForm: char | ttGlyph scale | scale _ self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender). Scale ifNotNil: [scale _ Scale * scale]. ttGlyph _ ttcDescription at: char. ^ ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth. ! ! !MultiTTCFont methodsFor: 'as yet unclassified' stamp: 'yo 12/29/2003 15:01'! isTTCFont ^true! ! !TTCFontReader methodsFor: 'as yet unclassified' stamp: 'yo 2/17/2004 19:45'! processCharMap: assoc "Process the given character map" | glyph cmap encode0 encode1 char value null | cmap _ assoc value. null _ (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. null contours: #(). encode0 _ Array new: 256 withAll: glyphs first. encode1 _ Array new: 65536 withAll: glyphs first. 0 to: 255 do: [:i | char _ Character value: i. glyph _ glyphs at: (cmap at: char asUnicode + 1) + 1. encode0 at: i+1 put: glyph. ]. Character separators do: [:c | encode0 at: (c asciiValue + 1) put: null. ]. 0 to: 65536 - 1 do: [:i | value _ cmap at: i+1. value = 65535 ifFalse: [ "???" encode1 at: i+1 put: (glyphs at: value+1). ] ]. ^ {encode0. encode1}. ! ! !TTCFontReader methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 18:37'! readFrom: aStream "Read the raw font byte data" | fontData | (aStream respondsTo: #binary) ifTrue:[aStream binary]. fontData _ aStream contents asByteArray. fonts _ self parseTTCHeaderFrom: fontData. ^ ((Array with: fonts first) collect: [:offset | fontDescription _ TTCFontDescription new. self readFrom: fontData fromOffset: offset at: EncodingTag. ]) at: 1. ! ! !TTCFontReader methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 18:35'! readFrom: fontData fromOffset: offset at: encodingTag | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry glyphOffset cmap numHMetrics indexToLocFormat fontDescription0 fontDescription1 array result | "Search the tables required to build the font" (headerEntry _ self getTableDirEntry: 'head' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a header table']. (maxProfileEntry _ self getTableDirEntry: 'maxp' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a maximum profile table']. (nameEntry _ self getTableDirEntry: 'name' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a name table']. (indexLocEntry _ self getTableDirEntry: 'loca' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a relocation table']. (charMapEntry _ self getTableDirEntry: 'cmap' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a character map table']. (glyphEntry _ self getTableDirEntry: 'glyf' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a glyph table']. (horzHeaderEntry _ self getTableDirEntry: 'hhea' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a horizontal header table']. (horzMetricsEntry _ self getTableDirEntry: 'hmtx' from: fontData offset: offset) == nil ifTrue:[ ^self error:'This font does not have a horizontal metrics table']. (kerningEntry _ self getTableDirEntry: 'kern' from: fontData offset: offset) == nil ifTrue:[ Transcript cr; show:'This font does not have a kerning table';endEntry]. "Process the data" indexToLocFormat _ self processFontHeaderTable: headerEntry. self processMaximumProfileTable: maxProfileEntry. self processNamingTable: nameEntry. glyphOffset _ self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. cmap _ self processCharacterMappingTable: charMapEntry. (cmap == nil or:[cmap value == nil]) ifTrue:[^self error:'This font has no suitable character mappings']. self processGlyphDataTable: glyphEntry offsets: glyphOffset. numHMetrics _ self processHorizontalHeaderTable: horzHeaderEntry. self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. kerningEntry isNil ifTrue:[kernPairs _ #()] ifFalse:[self processKerningTable: kerningEntry]. array _ self processCharMap: cmap. fontDescription0 _ fontDescription clone. fontDescription1 _ fontDescription clone. fontDescription0 setGlyphs: (array at: 1) mapping: nil. fontDescription1 setGlyphs: (array at: 2) mapping: nil. "fontDescription setKernPairs: kernPairs." result _ OrderedCollection new. result add: fontDescription0. encodingTag -1 timesRepeat: [result add: nil]. result add: fontDescription1. ^ result asArray. ! ! !TTCFontReader methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 18:43'! readTTFFrom: aStream "Read the raw font byte data" | fontData | (aStream respondsTo: #binary) ifTrue:[aStream binary]. fontData _ aStream contents asByteArray. fontDescription _ TTCFontDescription new. ^ self readFrom: fontData fromOffset: 0 at: EncodingTag. ! ! !TTCFontSet methodsFor: 'as yet unclassified' stamp: 'yo 12/29/2003 15:02'! isTTCFont ^true! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 2/21/2004 02:36'! removeDescriptionNamed: descriptionName | tt | Descriptions ifNil: [^ self]. [(tt _ Descriptions detect: [:f | f name = descriptionName] ifNone: [nil]) notNil] whileTrue:[ Descriptions remove: tt ]. ! ! !TTCFontDescription class methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 23:03'! addFromTTFile: fileName " Execute the following only if you know what you are doing. self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC' " | tt old | (fileName asLowercase endsWith: 'ttf') ifTrue: [ tt _ TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). ] ifFalse: [ tt _ TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). ]. old _ TTCDescriptions detect: [:f | f first name = tt first name] ifNone: [nil]. old ifNotNil: [TTCDescriptions remove: old]. TTCDescriptions add: tt. ^ tt. ! ! !TTCFontDescription class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:39'! removeDescriptionNamed: descriptionName | tt | TTCDescriptions ifNil: [^ self]. [(tt _ TTCDescriptions detect: [:f | f first name = descriptionName] ifNone: [nil]) notNil] whileTrue:[ TTCDescriptions remove: tt ]. ! ! !TTFontReader class methodsFor: 'instance creation' stamp: 'yo 2/15/2004 18:40'! readTTFFrom: aStream ^self new readTTFFrom: aStream! ! !TTCFontReader class methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 18:45'! encodingTag: aNumber " TTCFontReader encodingTag: 6 " EncodingTag _ aNumber. ! ! !TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 03:26'! restoreStateOf: aStream with: aConverterState aStream position: aConverterState. ! ! !TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 03:59'! saveStateOf: aStream ^ aStream position. ! ! !TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:15'! unicodeClass ^ Unicode. ! ! !CP1253TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/19/2004 10:12'! nextFromStream: aStream | character1 | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. ^ self toSqueak: character1. ! ! !CP1253TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/19/2004 10:18'! toSqueak: char | value | value _ char charCode. value < 128 ifTrue: [^ char]. value > 255 ifTrue: [^ char]. ^ MultiCharacter leadingChar: UnicodeGreek leadingChar code: (#( 16r20AC 16rFFFD 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 16rFFFD 16r2030 16rFFFD 16r2039 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 16rFFFD 16r2122 16rFFFD 16r203A 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16r00A0 16r0385 16r0386 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 16r00A8 16r00A9 16rFFFD 16r00AB 16r00AC 16r00AD 16r00AE 16r2015 16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r00B5 16r00B6 16r00B7 16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 16r03A0 16r03A1 16rFFFD 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE 16rFFFD ) at: (value - 128 + 1)). ! ! !CP1253TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:15'! unicodeClass ^ UnicodeGreek. ! ! !CompoundTextConverter methodsFor: 'conversion' stamp: 'yo 1/15/2004 15:39'! nextFromStream: aStream | character character2 size leadingChar offset result | aStream isBinary ifTrue: [^ aStream basicNext]. character _ aStream basicNext. character ifNil: [^ nil]. character == Character escape ifTrue: [ self parseShiftSeqFromStream: aStream. character _ aStream basicNext. character ifNil: [^ nil]]. character asciiValue < 128 ifTrue: [ size _ state g0Size. leadingChar _ state g0Leading. offset _ 16r21. ] ifFalse: [ size _state g1Size. leadingChar _ state g1Leading. offset _ 16rA1. ]. size = 1 ifTrue: [ leadingChar = 0 ifTrue: [^ character] ifFalse: [^ MultiCharacter leadingChar: leadingChar code: character asciiValue] ]. size = 2 ifTrue: [ character2 _ aStream basicNext. character2 ifNil: [^ nil. "self errorMalformedInput"]. character _ character asciiValue - offset. character2 _ character2 asciiValue - offset. result _ MultiCharacter leadingChar: leadingChar code: character * 94 + character2. ^ self toUnicode: result ]. self error: 'unsupported encoding'. ! ! !CompoundTextConverter methodsFor: 'conversion' stamp: 'yo 1/15/2004 15:57'! nextPut: aCharacter toStream: aStream | ascii leadingChar class | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ ^ aStream basicNextPut: aCharacter. ]. aCharacter class == MultiCharacter ifTrue: [ "this shouldn't happen?" ^ aStream nextInt32Put: aCharacter value. ]. ]. aCharacter isUnicode ifTrue: [ class _ Unicode defaultKanjiClass traditionalCharsetClass. ascii _ (class charFromUnicode: aCharacter asUnicode) charCode. leadingChar _ class leadingChar. ] ifFalse: [ ascii _ aCharacter charCode. leadingChar _ aCharacter leadingChar. ]. self nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForLeadingChar: leadingChar. ! ! !CompoundTextConverter methodsFor: 'private' stamp: 'yo 12/10/2003 15:46'! parseShiftSeqFromStream: aStream | c set target id | c _ aStream basicNext. c = $$ ifTrue: [ set _ #multibyte. c _ aStream basicNext. c = $( ifTrue: [target _ 1]. c = $) ifTrue: [target _ 2]. target ifNil: [target _ 1. id _ c] ifNotNil: [id _ aStream basicNext]. ] ifFalse: [ c = $( ifTrue: [target _ 1. set _ #nintyfour]. c = $) ifTrue: [target _ 2. set _ #nintyfour]. c = $- ifTrue: [target _ 2. set _ #nintysix]. "target = nil ifTrue: [self errorMalformedInput]." id _ aStream basicNext. ]. (set = #multibyte and: [id = $B]) ifTrue: [ state charSize: 2. target = 1 ifTrue: [ state g0Size: 2. state g0Leading: 1. ] ifFalse: [ state g1Size: 2. state g1Leading: 1. ]. ^ self ]. (set = #multibyte and: [id = $A]) ifTrue: [ state charSize: 2. target = 1 ifTrue: [ state g0Size: 2. state g0Leading: 2. ] ifFalse: [ state g1Size: 2. state g1Leading: 2. ]. ^ self ]. (set = #nintyfour and: [id = $B or: [id = $J]]) ifTrue: [ state charSize: 1. state g0Size: 1. state g0Leading: 0. ^ self ]. (set = #nintysix and: [id = $A]) ifTrue: [ state charSize: 1. state g1Size: 1. state g1Leading: 0. ^ self ]. "self errorUnsupported." ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 22:58'! nextFromStream: aStream | character1 character2 offset value1 value2 nonUnicodeChar | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character1 asciiValue <= 127 ifTrue: [^ character1]. character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. offset _ 16rA1. (character1 asciiValue < offset or: [character2 asciiValue < offset]) ifTrue: [^ nil]. value1 _ character1 asciiValue - offset. value2 _ character2 asciiValue - offset. nonUnicodeChar _ MultiCharacter leadingChar: self leadingChar code: value1 * 94 + value2. ^ MultiCharacter leadingChar: self unicodeClass leadingChar code: nonUnicodeChar asUnicode. ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/18/2004 15:10'! restoreStateOf: aStream with: aConverterState aStream position: aConverterState. ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/18/2004 15:10'! saveStateOf: aStream ^ aStream position. ! ! !CNGBTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/15/2004 18:49'! unicodeClass ^ UnicodeSimplifiedChinese. ! ! !ISO88597TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/9/2004 17:37'! fromSqueak: char ^ Character value: (FromTable at: char charCode ifAbsent: [0])! ! !ISO88597TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 06:28'! nextFromStream: aStream | character1 | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. ^ self toSqueak: character1. ! ! !ISO88597TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/19/2004 10:17'! toSqueak: char | value | value _ char charCode. value < 160 ifTrue: [^ char]. value > 255 ifTrue: [^ char]. ^ MultiCharacter leadingChar: UnicodeGreek leadingChar code: (#( 16r00A0 16r2018 16r2019 16r00A3 16r20AC 16r20AF 16r00A6 16r00A7 16r00A8 16r00A9 16r037A 16r00AB 16r00AC 16r00AD 16rFFFD 16r2015 16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r0385 16r0386 16r00B7 16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 16r03A0 16r03A1 16rFFFD 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE 16rFFFD ) at: (value - 160 + 1)). ! ! !ISO88597TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:15'! unicodeClass ^ UnicodeGreek. ! ! !Latin1TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:16'! unicodeClass ^ Latin1. ! ! !MacRomanTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:17'! unicodeClass ^ Latin1. ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 14:53'! nextFromStream: aStream | character1 character2 value1 value2 char1Value result | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. char1Value _ character1 asciiValue. (char1Value < 16r81) ifTrue: [^ character1]. (char1Value > 16rA0 and: [char1Value < 16rE0]) ifTrue: [^ self katakanaValue: char1Value]. character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. value1 _ character1 asciiValue. character1 asciiValue >= 224 ifTrue: [value1 _ value1 - 64]. value1 _ value1 - 129 bitShift: 1. value2 _ character2 asciiValue. character2 asciiValue >= 128 ifTrue: [value2 _ value2 - 1]. character2 asciiValue >= 158 ifTrue: [ value1 _ value1 + 1. value2 _ value2 - 158 ] ifFalse: [value2 _ value2 - 64]. result _ MultiCharacter leadingChar: self leadingChar code: value1 * 94 + value2. ^ self toUnicode: result ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:14'! unicodeClass ^ UnicodeJapanese. ! ! !TextConverter class methodsFor: 'instance creation' stamp: 'yo 2/21/2004 04:56'! newForEncoding: aString | class encoding | aString ifNil: [^ Latin1TextConverter new]. encoding _ aString asLowercase. class _ self allSubclasses detect: [:each | each encodingNames includes: encoding] ifNone: []. class isNil ifTrue: [^ nil]. ^ class new! ! !CP1253TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 2/19/2004 10:11'! encodingNames ^ #('cp-1253') copy ! ! !EUCKRTextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 2/17/2004 18:45'! encodingNames ^ #('euc-kr' 'ks-c-5601-1987' 'euckr') copy ! ! !ISO88597TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 06:32'! encodingNames ^ #('iso-8859-7' 'greek-iso-8859-8bit') copy ! ! !ISO88597TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 2/9/2004 17:36'! initialize " self initialize " FromTable _ Dictionary new. FromTable at: 16r00A0 put: 16rA0. FromTable at: 16r2018 put: 16rA1. FromTable at: 16r2019 put: 16rA2. FromTable at: 16r00A3 put: 16rA3. FromTable at: 16r20AC put: 16rA4. FromTable at: 16r20AF put: 16rA5. FromTable at: 16r00A6 put: 16rA6. FromTable at: 16r00A7 put: 16rA7. FromTable at: 16r00A8 put: 16rA8. FromTable at: 16r00A9 put: 16rA9. FromTable at: 16r037A put: 16rAA. FromTable at: 16r00AB put: 16rAB. FromTable at: 16r00AC put: 16rAC. FromTable at: 16r00AD put: 16rAD. FromTable at: 16r2015 put: 16rAF. FromTable at: 16r00B0 put: 16rB0. FromTable at: 16r00B1 put: 16rB1. FromTable at: 16r00B2 put: 16rB2. FromTable at: 16r00B3 put: 16rB3. FromTable at: 16r0384 put: 16rB4. FromTable at: 16r0385 put: 16rB5. FromTable at: 16r0386 put: 16rB6. FromTable at: 16r00B7 put: 16rB7. FromTable at: 16r0388 put: 16rB8. FromTable at: 16r0389 put: 16rB9. FromTable at: 16r038A put: 16rBA. FromTable at: 16r00BB put: 16rBB. FromTable at: 16r038C put: 16rBC. FromTable at: 16r00BD put: 16rBD. FromTable at: 16r038E put: 16rBE. FromTable at: 16r038F put: 16rBF. FromTable at: 16r0390 put: 16rC0. FromTable at: 16r0391 put: 16rC1. FromTable at: 16r0392 put: 16rC2. FromTable at: 16r0393 put: 16rC3. FromTable at: 16r0394 put: 16rC4. FromTable at: 16r0395 put: 16rC5. FromTable at: 16r0396 put: 16rC6. FromTable at: 16r0397 put: 16rC7. FromTable at: 16r0398 put: 16rC8. FromTable at: 16r0399 put: 16rC9. FromTable at: 16r039A put: 16rCA. FromTable at: 16r039B put: 16rCB. FromTable at: 16r039C put: 16rCC. FromTable at: 16r039D put: 16rCD. FromTable at: 16r039E put: 16rCE. FromTable at: 16r039F put: 16rCF. FromTable at: 16r03A0 put: 16rD0. FromTable at: 16r03A1 put: 16rD1. FromTable at: 16r03A3 put: 16rD3. FromTable at: 16r03A4 put: 16rD4. FromTable at: 16r03A5 put: 16rD5. FromTable at: 16r03A6 put: 16rD6. FromTable at: 16r03A7 put: 16rD7. FromTable at: 16r03A8 put: 16rD8. FromTable at: 16r03A9 put: 16rD9. FromTable at: 16r03AA put: 16rDA. FromTable at: 16r03AB put: 16rDB. FromTable at: 16r03AC put: 16rDC. FromTable at: 16r03AD put: 16rDD. FromTable at: 16r03AE put: 16rDE. FromTable at: 16r03AF put: 16rDF. FromTable at: 16r03B0 put: 16rE0. FromTable at: 16r03B1 put: 16rE1. FromTable at: 16r03B2 put: 16rE2. FromTable at: 16r03B3 put: 16rE3. FromTable at: 16r03B4 put: 16rE4. FromTable at: 16r03B5 put: 16rE5. FromTable at: 16r03B6 put: 16rE6. FromTable at: 16r03B7 put: 16rE7. FromTable at: 16r03B8 put: 16rE8. FromTable at: 16r03B9 put: 16rE9. FromTable at: 16r03BA put: 16rEA. FromTable at: 16r03BB put: 16rEB. FromTable at: 16r03BC put: 16rEC. FromTable at: 16r03BD put: 16rED. FromTable at: 16r03BE put: 16rEE. FromTable at: 16r03BF put: 16rEF. FromTable at: 16r03C0 put: 16rF0. FromTable at: 16r03C1 put: 16rF1. FromTable at: 16r03C2 put: 16rF2. FromTable at: 16r03C3 put: 16rF3. FromTable at: 16r03C4 put: 16rF4. FromTable at: 16r03C5 put: 16rF5. FromTable at: 16r03C6 put: 16rF6. FromTable at: 16r03C7 put: 16rF7. FromTable at: 16r03C8 put: 16rF8. FromTable at: 16r03C9 put: 16rF9. FromTable at: 16r03CA put: 16rFA. FromTable at: 16r03CB put: 16rFB. FromTable at: 16r03CC put: 16rFC. FromTable at: 16r03CD put: 16rFD. FromTable at: 16r03CE put: 16rFE. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 17:07'! charFromStream: aStream withFirst: firstValue | character1 character2 tmp n secondValue | (16rD800 <= firstValue and: [firstValue <= 16rDBFF]) ifTrue: [ character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character2 _ aStream basicNext. character2 isNil ifTrue: [^ nil]. self useLittleEndian ifTrue: [ tmp _ character1. character1 _ character2. character2 _ tmp ]. secondValue _ (character1 charCode << 8) + (character2 charCode). n _ (firstValue - 16rD800) * 16r400 + (secondValue - 16rDC00) + 16r10000. ^ Unicode value: n ]. ^ Unicode value: firstValue ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/13/2004 12:59'! next16BitValue: value toStream: aStream | v1 v2 | v1 _ (value >> 8) bitAnd: 16rFF. v2 _ value bitAnd: 16rFF. self useLittleEndian ifTrue: [ aStream basicNextPut: (Character value: v2). aStream basicNextPut: (Character value: v1). ] ifFalse: [ aStream basicNextPut: (Character value: v1). aStream basicNextPut: (Character value: v2). ]. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 17:06'! nextFromStream: aStream | character1 character2 readBOM charValue | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character2 _ aStream basicNext. character2 isNil ifTrue: [^ nil]. readBOM _ false. (character1 asciiValue = 16rFF and: [character2 asciiValue = 16rFE]) ifTrue: [ self useByteOrderMark: true. self useLittleEndian: true. readBOM _ true. ]. (character1 asciiValue = 16rFE and: [character2 asciiValue = 16rFF]) ifTrue: [ self useByteOrderMark: true. self useLittleEndian: false. readBOM _ true. ]. readBOM ifTrue: [ character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character2 _ aStream basicNext. character2 isNil ifTrue: [^ nil]. ]. self useLittleEndian ifTrue: [ charValue _ character2 charCode << 8 + character1 charCode. ] ifFalse: [ charValue _ character1 charCode << 8 + character2 charCode. ]. ^ self charFromStream: aStream withFirst: charValue. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/13/2004 12:56'! nextPut: aCharacter toStream: aStream | v low high | (self useByteOrderMark and: [byteOrderMarkDone isNil]) ifTrue: [ self next16BitValue: (16rFEFF) toStream: aStream. byteOrderMarkDone _ true. ]. v _ aCharacter charCode. v > 16rFFFF ifFalse: [ self next16BitValue: v toStream: aStream. ^ self. ] ifTrue: [ v _ v - 16r10000. low _ (v \\ 16r400) + 16rDC00. high _ (v // 16r400) + 16rD800. self next16BitValue: high toStream: aStream. self next16BitValue: low toStream: aStream. ]! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:17'! unicodeClass ^ Unicode. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 17:00'! useByteOrderMark ^ useByteOrderMark ifNil: [^ false]. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 13:54'! useByteOrderMark: aBoolean useByteOrderMark _ aBoolean. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 17:00'! useLittleEndian ^ useLittleEndian ifNil: [false]. ! ! !UTF16TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 1/12/2004 14:02'! useLittleEndian: aBoolean useLittleEndian _ aBoolean. ! ! !UTF16TextConverter class methodsFor: 'as yet unclassified' stamp: 'yo 2/10/2004 05:23'! encodingNames ^ #('utf-16' 'utf16' 'utf-16-le' 'utf-16-be') copy. ! ! !UTF8TextConverter methodsFor: 'conversion' stamp: 'yo 1/15/2004 17:30'! nextFromStream: aStream | character1 value1 character2 value2 unicode character3 value3 character4 value4 | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. value1 _ character1 asciiValue. value1 <= 127 ifTrue: [ "1-byte character" currentCharSize _ 1. ^ character1 ]. (value1 bitAnd: 16rE0) = 192 ifTrue: [ "2-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. value2 _ character2 asciiValue. currentCharSize _ 2. ^ Unicode value: ((value1 bitAnd: 31) bitShift: 6) + (value2 bitAnd: 63). ]. (value1 bitAnd: 16rF0) = 224 ifTrue: [ "3-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. value2 _ character2 asciiValue. character3 _ aStream basicNext. character3 = nil ifTrue: [^ nil "self errorMalformedInput"]. value3 _ character3 asciiValue. unicode _ ((value1 bitAnd: 15) bitShift: 12) + ((value2 bitAnd: 63) bitShift: 6) + (value3 bitAnd: 63). currentCharSize _ 3. ]. (value1 bitAnd: 16rF8) = 240 ifTrue: [ "4-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil " self errorMalformedInput"]. value2 _ character2 asciiValue. character3 _ aStream basicNext. character3 = nil ifTrue: [^ nil "self errorMalformedInput"]. value3 _ character3 asciiValue. character4 _ aStream basicNext. character4 = nil ifTrue: [^ nil "self errorMalformedInput"]. value4 _ character4 asciiValue. currentCharSize _ 4. unicode _ ((value1 bitAnd: 16r7) bitShift: 18) + ((value2 bitAnd: 63) bitShift: 12) + ((value3 bitAnd: 63) bitShift: 6) + (value4 bitAnd: 63). ]. unicode isNil ifTrue: [^ $?]. ^ Unicode value: unicode. ! ! !UTF8TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 2/20/2004 17:17'! unicodeClass ^ Unicode. ! ! !Unicode class methodsFor: 'subencodings' stamp: 'yo 1/12/2004 18:11'! isJapanese: code ^ code > 255 and: [(JISX0208 charFromUnicode: code) notNil]. ! ! !Unicode class methodsFor: 'subencodings' stamp: 'yo 1/12/2004 18:11'! isKorean: code ^ code > 255 and: [(KSX1001 charFromUnicode: code) notNil] ! ! !Unicode class methodsFor: 'subencodings' stamp: 'yo 1/12/2004 18:11'! isSimplifiedChinese: code ^ code > 255 and: [(GB2312 charFromUnicode: code) notNil] ! ! !Unicode class methodsFor: 'subencodings' stamp: 'yo 1/12/2004 18:00'! isTraditionalChinese: code ^ false. ! ! !Unicode class methodsFor: 'subencodings' stamp: 'yo 1/12/2004 17:55'! isUnifiedKanji: code ^ ((((16r2E80 <= code and: [code <= 16rA4CF]) or: [16rF900 <= code and: [code <= 16rFAFF]]) or: [16rFE30 <= code and: [code <= 16rFE4F]]) or: [16rFF00 <= code and: [code <= 16rFFEF]]) or: [16r20000 <= code and: [code <= 16r2FA1F]]. ! ! !Unicode class methodsFor: 'class methods' stamp: 'yo 1/12/2004 18:20'! value: code (self isUnifiedKanji: code) ifTrue: [ ^ MultiCharacter leadingChar: (self leadingCharFor: code kanjiClass: self defaultKanjiClass) code: code ]. (self isJapanese: code) ifTrue: [ ^ MultiCharacter leadingChar: UnicodeJapanese leadingChar code: code ]. (self isKorean: code) ifTrue: [ ^ MultiCharacter leadingChar: UnicodeKorean leadingChar code: code ]. (self isSimplifiedChinese: code) ifTrue: [ ^ MultiCharacter leadingChar: UnicodeSimplifiedChinese leadingChar code: code ]. ^ MultiCharacter leadingChar: (self leadingCharFor: code kanjiClass: nil) code: code ! ! !Unicode class methodsFor: 'accessing - encoding' stamp: 'yo 2/20/2004 14:12'! generalCategory ^ GeneralCategory. ! ! !UnicodeSimplifiedChinese class methodsFor: 'accessing - encoding' stamp: 'yo 2/15/2004 19:05'! isBreakableAt: index in: sourceString ^ Latin1 isBreakableAt: index in: sourceString! ! !UnicodeSimplifiedChinese class methodsFor: 'accessing - encoding' stamp: 'yo 2/15/2004 19:04'! scanSelector ^ #scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: ! ! !WinGB2312ClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:46'! fromSystemClipboard: aString ^ aString isoToSqueak convertFromSystemString. ! ! !WinGB2312ClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:47'! toSystemClipboard: text | string | "self halt." string _ text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString isoToSqueak. ! ! !WinGB2312InputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 12/10/2003 18:53'! initialize converter _ CNGBTextConverter new. ! ! !WinGB2312InputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 12/10/2003 18:54'! nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value _ (Character value: keyValue) squeakToIso asciiValue. ((char1Value > 127 and: [char1Value < 160]) or: [char1Value > 223 and: [char1Value < 253]]) ifFalse: [ ^ keyValue asCharacter. ]. peekEvent _ sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent _ sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter _ char1Value asCharacter. secondCharacter _ (peekEvent at: 3) asCharacter squeakToIso. stream _ ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter _ converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! ! !WinKSX1001ClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:48'! fromSystemClipboard: aString ^ aString isoToSqueak convertFromSystemString. ! ! !WinKSX1001ClipboardInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:48'! toSystemClipboard: text | string | "self halt." string _ text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString isoToSqueak. ! ! !WinKSX1001InputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:47'! initialize converter _ EUCKRTextConverter new. ! ! !WinKSX1001InputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 15:47'! nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value _ (Character value: keyValue) squeakToIso asciiValue. ((char1Value > 127 and: [char1Value < 160]) or: [char1Value > 223 and: [char1Value < 253]]) ifFalse: [ ^ keyValue asCharacter. ]. peekEvent _ sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent _ sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter _ char1Value asCharacter. secondCharacter _ (peekEvent at: 3) asCharacter squeakToIso. stream _ ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter _ converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! ! !WriteStream methodsFor: 'accessing' stamp: 'yo 2/18/2004 14:41'! next: anInteger putAll: aCollection startingAt: startIndex "Store the next anInteger elements from the given collection." | newEnd numPut | collection class == aCollection class ifFalse: [^ super next: anInteger putAll: aCollection startingAt: startIndex ]. numPut _ anInteger min: (aCollection size - startIndex + 1). newEnd _ position + numPut. newEnd > writeLimit ifTrue: [^ super next: anInteger putAll: aCollection startingAt: startIndex "Trigger normal pastEndPut: logic"]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: startIndex. position _ newEnd. ! ! !CrLfFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 04:46'! new ^ (MultiByteFileStream new) wantsLineEndConversion: true; yourself. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 16:46'! additionalRangesForKorean | basics | basics _ { Array with: 16rA1 with: 16rFFE6C. Array with: 16r3000 with: 16rFFFD. }. ^ basics ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 2/14/2004 02:46'! rangesForGreek ^ { Array with: 16r1 with: 16rFF. Array with: 16r370 with: 16r3FF. Array with: 16r1F00 with: 16r1FFF. Array with: 16r2000 with: 16r206F. Array with: 16r20A0 with: 16r20AF }. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 16:53'! rangesForKorean | basics etc | basics _ { Array with: 16rA1 with: 16rFF }. etc _ { Array with: 16r100 with: 16r17F. "extended latin" Array with: 16r370 with: 16r3FF. "greek" Array with: 16r400 with: 16r52F. "cyrillic" Array with: 16r2000 with: 16r206F. "general punctuation" Array with: 16r2100 with: 16r214F. "letterlike" Array with: 16r2150 with: 16r218F. "number form" Array with: 16r2190 with: 16r21FF. "arrows" Array with: 16r2200 with: 16r22FF. "math operators" Array with: 16r2300 with: 16r23FF. "misc tech" Array with: 16r2460 with: 16r24FF. "enclosed alnum" Array with: 16r2500 with: 16r257F. "box drawing" Array with: 16r2580 with: 16r259F. "box elem" Array with: 16r25A0 with: 16r25FF. "geometric shapes" Array with: 16r2600 with: 16r26FF. "misc symbols" Array with: 16r3000 with: 16r303F. "cjk symbols" Array with: 16r3040 with: 16r309F. "hiragana" Array with: 16r30A0 with: 16r30FF. "katakana" Array with: 16r3190 with: 16r319F. "kanbun" Array with: 16r31F0 with: 16r31FF. "katakana extension" Array with: 16r3200 with: 16r32FF. "enclosed CJK" Array with: 16r3300 with: 16r33FF. "CJK compatibility" Array with: 16r4E00 with: 16r9FAF. "CJK ideograph" Array with: 16rAC00 with: 16rD7AF. "Hangul Syllables" Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph" Array with: 16rFF00 with: 16rFFEF. "half and full" }. ^ basics, etc. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 2/9/2004 18:56'! readRanges: ranges | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end | form _ encoding _ bbx _ nil. self initialize. self readAttributes. height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. (properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [ pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. ] ifFalse: [ pointSize _ (ascent + descent) * 72 // 96. ]. maxWidth _ 0. minAscii _ 16r200000. strikeWidth _ 0. maxAscii _ 0. charsNum _ Integer readFromString: (properties at: #CHARS) first. chars _ Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)]. charsNum _ chars size. "undefined encodings make this different" chars do: [:array | encoding _ array at: 2. bbx _ array at: 3.. width _ bbx at: 1. maxWidth _ maxWidth max: width. minAscii _ minAscii min: encoding. maxAscii _ maxAscii max: encoding. strikeWidth _ strikeWidth + width. ]. glyphs _ Form extent: strikeWidth@height. blt _ BitBlt toForm: glyphs. start _ (ranges collect: [:r | r first]) min. end _ (ranges collect: [:r | r second]) max + 3. xTable _ SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. lastAscii _ start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form _ (chars at: i) first. encoding _ (chars at: i) second. bbx _ (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue _ xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii _ encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret _ Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 1/15/2004 16:58'! readRanges: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end | form _ encoding _ bbx _ nil. self initialize. self readAttributes. height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. (properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [ pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. ] ifFalse: [ pointSize _ (ascent + descent) * 72 // 96. ]. maxWidth _ 0. minAscii _ 16r200000. strikeWidth _ 0. maxAscii _ 0. charsNum _ Integer readFromString: (properties at: #CHARS) first. chars _ Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars _ self override: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable ksx1001Table) additionalRange: additionalRange. chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)]. charsNum _ chars size. "undefined encodings make this different" chars do: [:array | encoding _ array at: 2. bbx _ array at: 3.. width _ bbx at: 1. maxWidth _ maxWidth max: width. minAscii _ minAscii min: encoding. maxAscii _ maxAscii max: encoding. strikeWidth _ strikeWidth + width. ]. glyphs _ Form extent: strikeWidth@height. blt _ BitBlt toForm: glyphs. start _ ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min. end _ ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3. "xRange _ Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))." "xTable _ XTableForUnicodeFont new ranges: xRange." xTable _ SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. lastAscii _ start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form _ (chars at: i) first. encoding _ (chars at: i) second. bbx _ (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue _ xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii _ encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret _ Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:56'! doConversion ^ lineEndConvention notNil! ! !MultiByteFileStream methodsFor: 'access' stamp: 'yo 2/21/2004 02:57'! ascii super ascii. self detectLineEndConvention. ! ! !MultiByteFileStream methodsFor: 'access' stamp: 'yo 2/21/2004 02:57'! binary super binary. lineEndConvention _ nil. ! ! !MultiByteFileStream methodsFor: 'access' stamp: 'yo 2/21/2004 02:59'! lineEndConvention: aSymbol lineEndConvention _ aSymbol. ! ! !MultiByteFileStream methodsFor: 'access' stamp: 'yo 2/21/2004 04:24'! wantsLineEndConversion: aBoolean wantsLineEndConversion _ aBoolean. self detectLineEndConvention.! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/24/2004 13:49'! next | char secondChar state | char _ self converter nextFromStream: self. self doConversion ifTrue: [ char == Cr ifTrue: [ state _ converter saveStateOf: self. secondChar _ self bareNext. secondChar ifNotNil: [secondChar == Lf ifFalse: [converter restoreStateOf: self with: state]]. ^Cr]. char == Lf ifTrue: [^Cr]. ]. ^ char. ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 04:50'! next: anInteger | multiString | self isBinary ifTrue: [^ super next: anInteger]. multiString _ MultiString new: anInteger. 1 to: anInteger do: [:index | | character | (character _ self next) ifNotNil: [ multiString at: index put: character ] ifNil: [ multiString _ multiString copyFrom: 1 to: index - 1. self doConversion ifFalse: [ ^ multiString ]. ^ self next: anInteger innerFor: multiString. ] ]. self doConversion ifFalse: [ ^ multiString ]. multiString _ self next: anInteger innerFor: multiString. (multiString size = anInteger or: [self atEnd]) ifTrue: [ ^ multiString]. ^ multiString, (self next: anInteger - multiString size). ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 03:26'! nextDelimited: terminator | out ch save | out _ WriteStream on: (String new: 1000). self atEnd ifTrue: [^ '']. save _ converter saveStateOf: self. self next = terminator ifFalse: [ "absorb initial terminator" converter restoreStateOf: self with: save. ]. [(ch _ self next) == nil] whileFalse: [ (ch = terminator) ifTrue: [ self peek = terminator ifTrue: [ self next. "skip doubled terminator" ] ifFalse: [ ^ out contents "terminator is not doubled; we're done!!" ]. ]. out nextPut: ch. ]. ^ out contents. ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 03:42'! nextPut: aCharacter aCharacter isInteger ifTrue: [^ super nextPut: aCharacter]. self doConversion ifTrue: [ aCharacter = Cr ifTrue: [ (LineEndStrings at: lineEndConvention) do: [:e | converter nextPut: e toStream: self]. ] ifFalse: [ converter nextPut: aCharacter toStream: self ]. ^ aCharacter ]. ^ self converter nextPut: aCharacter toStream: self ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 04:00'! peek "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " | next save | self atEnd ifTrue: [^ nil]. save _ converter saveStateOf: self. next _ self next. converter restoreStateOf: self with: save. ^ next. ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/24/2004 13:35'! skipSeparators | state | [self atEnd] whileFalse: [ state _ converter saveStateOf: self. self next isSeparator ifFalse: [ ^ converter restoreStateOf: self with: state]] " [self atEnd] whileFalse: [ self next isSeparator ifFalse: [ ^ self position: self position - converter currentCharSize. ]. ]. " ! ! !MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 04:01'! skipSeparatorsAndPeekNext "A special function to make nextChunk fast" | peek save | [self atEnd] whileFalse: [ save _ converter saveStateOf: self. (peek _ self next) isSeparator ifFalse: [ converter restoreStateOf: self with: save. ^ peek. ]. ]. ! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:38'! bareNext ^ self converter nextFromStream: self. ! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/21/2004 02:56'! convertStringFromCr: aString | inStream outStream | lineEndConvention ifNil: [^ aString]. lineEndConvention == #cr ifTrue: [^ aString]. lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Cr with: Lf]. "lineEndConvention == #crlf" inStream _ ReadStream on: aString. outStream _ WriteStream on: (String new: aString size). [inStream atEnd] whileFalse: [outStream nextPutAll: (inStream upTo: Cr). (inStream atEnd not or: [aString last = Cr]) ifTrue: [outStream nextPutAll: CrLf]]. ^ outStream contents! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/21/2004 02:56'! convertStringToCr: aString | inStream outStream | lineEndConvention ifNil: [^ aString]. lineEndConvention == #cr ifTrue: [^ aString]. lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Lf with: Cr]. "lineEndConvention == #crlf" inStream _ ReadStream on: aString. outStream _ WriteStream on: (String new: aString size). [inStream atEnd] whileFalse: [outStream nextPutAll: (inStream upTo: Cr). (inStream atEnd not or: [aString last = Cr]) ifTrue: [outStream nextPut: Cr. inStream peek = Lf ifTrue: [inStream next]]]. ^ outStream contents! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:56'! detectLineEndConvention "Detect the line end convention used in this stream. The result may be either #cr, #lf or #crlf." | char numRead state | self isBinary ifTrue: [^ self error: 'Line end conventions are not used on binary streams']. self wantsLineEndConversion ifFalse: [^ lineEndConvention _ nil.]. lineEndConvention _ LineEndDefault. self closed ifTrue: [^ self]. "Default if nothing else found" numRead _ 0. state _ converter saveStateOf: self. lineEndConvention _ nil. [super atEnd not and: [numRead < LookAheadCount]] whileTrue: [char _ self next. char = Lf ifTrue: [converter restoreStateOf: self with: state. ^ lineEndConvention _ #lf]. char = Cr ifTrue: [self peek = Lf ifTrue: [lineEndConvention _ #crlf] ifFalse: [lineEndConvention _ #cr]. converter restoreStateOf: self with: state. ^ lineEndConvention]. numRead _ numRead + 1]. converter restoreStateOf: self with: state. ^ lineEndConvention ! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:44'! next: n innerFor: aString | peekChar state | "if we just read a CR, and the next character is an LF, then skip the LF" aString size = 0 ifTrue: [^ aString]. (aString last = Character cr) ifTrue: [ state _ converter saveStateOf: self. peekChar _ self bareNext. "super peek doesn't work because it relies on #next" (peekChar notNil and: [peekChar ~= Character lf]) ifTrue: [ converter restoreStateOf: self with: state. ]. ]. ^ aString withSqueakLineEndings. ! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/21/2004 03:51'! wantsLineEndConversion ^ wantsLineEndConversion ifNil: [false]. ! ! !MultiByteFileStream methodsFor: 'open/close' stamp: 'yo 2/21/2004 03:48'! open: fileName forWrite: writeMode | result | result _ super open: fileName forWrite: writeMode. result ifNotNil: [ converter ifNil: [ self localName = (FileDirectory localNameFor: Smalltalk sourcesName) ifTrue: [ converter _ MacRomanTextConverter new ] ifFalse: [ converter _ UTF8TextConverter new. ]. ]. self detectLineEndConvention. ]. ^result. ! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:45'! defaultToCR "MultiByteFileStream defaultToCR" LineEndDefault := #cr. ! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:45'! defaultToCRLF "MultiByteFileStream defaultToCRLF" LineEndDefault := #crlf.! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:46'! defaultToLF "MultiByteFileStream defaultToLF" LineEndDefault := #lf. ! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:44'! guessDefaultLineEndConvention "Lets try to guess the line end convention from what we know about the path name delimiter from FileDirectory." FileDirectory pathNameDelimiter = $: ifTrue:[^self defaultToCR]. FileDirectory pathNameDelimiter = $/ ifTrue:[^self defaultToLF]. FileDirectory pathNameDelimiter = $\ ifTrue:[^self defaultToCRLF]. "in case we don't know" ^self defaultToCR. ! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:44'! initialize "MultiByteFileStream initialize" Cr := Character cr. Lf := Character lf. CrLf := String with: Cr with: Lf. LineEndStrings := Dictionary new. LineEndStrings at: #cr put: (String with: Character cr). LineEndStrings at: #lf put: (String with: Character lf). LineEndStrings at: #crlf put: (String with: Character cr with: Character lf). LookAheadCount := 2048. Smalltalk addToStartUpList: self. self startUp. ! ! !MultiByteFileStream class methodsFor: 'as yet unclassified' stamp: 'yo 2/21/2004 02:44'! startUp self guessDefaultLineEndConvention. ! ! MultiByteFileStream initialize! StandardFileStream subclass: #MultiByteFileStream instanceVariableNames: 'converter lineEndConvention wantsLineEndConversion' classVariableNames: 'Cr CrLf Lf LineEndDefault LineEndStrings LookAheadCount' poolDictionaries: '' category: 'Multilingual-TextConversion'! !MultiByteFileStream reorganize! ('access' accepts: ascii binary converter converter: fileInEncodingName: lineEndConvention: wantsLineEndConversion:) ('public' next next: nextDelimited: nextMatchAll: nextPut: nextPutAll: peek peekFor: skipSeparators skipSeparatorsAndPeekNext upTo: upToEnd) ('crlf private' bareNext convertStringFromCr: convertStringToCr: detectLineEndConvention doConversion next:innerFor: wantsLineEndConversion) ('private basic' basicNext basicNext: basicNext:into: basicNextInto: basicNextPut: basicNextPutAll: basicPeek basicPosition basicPosition: basicReadInto:startingAt:count: basicSetToEnd basicSkip: basicUpTo: basicVerbatim:) ('open/close' open:forWrite: reset) ('remnant' filterFor:) ! Unicode class removeSelector: #isCJK:! Unicode class removeSelector: #newForCode:kanjiClass:! Unicode class removeSelector: #value:kanjiClass:! UTF8TextConverter removeSelector: #restoreStateOf:with:! UTF8TextConverter removeSelector: #saveStateOf:! ISO88597TextConverter initialize! MacRomanTextConverter removeSelector: #restoreStateOf:with:! MacRomanTextConverter removeSelector: #saveStateOf:! TTCFontReader removeSelector: #readFrom:fromOffset:! TTFontReader subclass: #TTCFontReader instanceVariableNames: 'fonts' classVariableNames: 'EncodingTag' poolDictionaries: '' category: 'Multilingual-Display'! AbstractFont subclass: #TTCFont instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives' classVariableNames: 'NamesToIndexes Scale' poolDictionaries: '' category: 'Multilingual-Display'! MultiCharacterScanner subclass: #MultiCompositionScanner instanceVariableNames: 'spaceX lineHeight baseline breakableIndex lineHeightAtBreak baselineAtBreak breakAtSpace lastWidth' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Scanning'! Character removeSelector: #isUnicodeCJK! 'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 17 March 2004 at 2:20:54 pm'! LanguageEnvironment subclass: #GreekEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Languages'! !EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 3/17/2004 00:38'! initialize " self initialize " self allSubclassesDo: [:each | each initialize]. EncodedCharSets _ Array new: 256. EncodedCharSets at: 1 put: Latin1. EncodedCharSets at: 2 put: JISX0208. EncodedCharSets at: 3 put: GB2312. EncodedCharSets at: 4 put: KSX1001. EncodedCharSets at: 5 put: JISX0208. EncodedCharSets at: 6 put: JapaneseEnvironment. EncodedCharSets at: 7 put: SimplifiedChineseEnvironment. EncodedCharSets at: 8 put: KoreanEnvironment. EncodedCharSets at: 9 put: GB2312. "EncodedCharSets at: 10 put: UnicodeTraditionalChinese." "EncodedCharSets at: 11 put: UnicodeVietnamese." EncodedCharSets at: 13 put: KSX1001. EncodedCharSets at: 14 put: GreekEnvironment. EncodedCharSets at: 256 put: Unicode. ! ! !GB2312 class methodsFor: 'class methods' stamp: 'yo 3/17/2004 22:13'! languageClass ^ SimplifiedChineseEnvironment. ! ! !HostFont class methodsFor: 'system defaults' stamp: 'yo 3/17/2004 00:39'! initForSubtitles " HostFont initForSubtitles " HostFont textStyleFrom: 'Verdana' sizes: #(18 20 22 24 26 28) ranges: HostFont defaultRanges. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: GreekEnvironment leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. TTCFontReader encodingTag: SimplifiedChineseEnvironment leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\simhei.TTF'. TTCFontReader encodingTag: JapaneseEnvironment leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC'. TTCFontReader encodingTag: KoreanEnvironment leadingChar. TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\gulim.TTC'. ! ! !JISX0208 class methodsFor: 'class methods' stamp: 'yo 3/17/2004 22:13'! languageClass ^ JapaneseEnvironment. ! ! !KSX1001 class methodsFor: 'class methods' stamp: 'yo 3/17/2004 22:13'! languageClass ^ KoreanEnvironment. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 22:01'! leadingChar ^ 0. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/17/2004 22:01'! charFromUnicode: uniCode ^ MultiCharacter leadingChar: self leadingChar code: uniCode ! ! !LanguageEnvironment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 21:54'! isBreakableAt: index in: text | char | char _ text at: index. char = Character space ifTrue: [^ true]. char = Character cr ifTrue: [^ true]. ^ false. ! ! !GreekEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:38'! leadingChar ^ 13. ! ! !JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 22:00'! fromJISX0208String: aString ^ aString collect: [:each | MultiCharacter leadingChar: JapaneseEnvironment leadingChar code: (each asUnicode)]. ! ! !JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 21:55'! isBreakableAt: index in: text | char | char _ text at: index. char = Character space ifTrue: [^ true]. char = Character cr ifTrue: [^ true]. ^ false. ! ! !JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 21:55'! leadingChar ^ 5. ! ! !JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 21:54'! scanSelector ^ #scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: ! ! !MacUnicodeInputInterpreter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 22:12'! nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. keyValue < 256 ifTrue: [^ (Character value: keyValue) squeakToIso]. "Smalltalk systemLanguage charsetClass charFromUnicode: keyValue." ^ Unicode value: keyValue. ! ! !MultiCharacter methodsFor: 'converting' stamp: 'yo 3/17/2004 22:16'! asUnicodeChar | table charset v | charset _ EncodedCharSet charsetAt: self leadingChar. (charset isKindOf: Unicode class) ifTrue: [^ self]. table _ charset ucsTable. table isNil ifTrue: [^ Character value: 16rFFFD]. v _ table at: self charCode + 1. v = -1 ifTrue: [^ Character value: 16rFFFD]. ^ MultiCharacter leadingChar: charset leadingChar code: v. ! ! !MultiString methodsFor: 'private' stamp: 'yo 3/17/2004 21:59'! mutateJISX0208StringToUnicode | c | 1 to: self size do: [:i | c _ self at: i. (c leadingChar = JISX0208 leadingChar or: [ c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [ self basicAt: i put: (MultiCharacter leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue. ] ]. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 14:20'! installExternalFontFileName6: fileName encoding: encoding encodingName: aString textStyleName: styleName ^ self installExternalFontFileName6: fileName inDir: FileDirectory default encoding: encoding encodingName: aString textStyleName: styleName. " StrikeFontSet createExternalFontFileForCyrillic: 'cyrillicFont.out'. StrikeFontSet installExternalFontFileName: 'chineseFont.out' encoding: 2 encodingName: #Gb2312 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'japaneseFont.out' encoding: 1 encodingName: #JisX0208 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'defaultFont.out' encoding: 0 encodingName: #Latin1 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'cyrillicFont.out' encoding: UnicodeCyrillic leadingChar encodingName: #Cyrillic textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'extendedLatinFont.out' encoding: UnicodeLatinExtendedAB leadingChar encodingName: #ExtendedLatin textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'ipaExtensionsFont.out' encoding: UnicodeIPA leadingChar encodingName: #IPAExtensions textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'armenianFont.out' encoding: UnicodeArmenian leadingChar encodingName: #Armenian textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'arrowFont.out' encoding: UnicodeArrows leadingChar encodingName: #Arrow textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName6: 'uJapaneseFont.out' encoding: JapaneseEnvironment leadingChar encodingName: #Japanese textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uKoreanFont.out' encoding: UnicodeKorean leadingChar encodingName: #Korean textStyleName: #DefaultMultiStyle. StrikeFontSet removeFontsForEncoding: 2 encodingName: #Gb2312. self halt. StrikeFontSet removeFontsForEncoding: 3 encodingName: #KsX1001. " ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 14:18'! installExternalFontFileName6: fileName inDir: dir encoding: encoding encodingName: aString textStyleName: styleName | array arraySix oldStyle arrayOfFS fs fonts newFonts | array _ (ReferenceStream on: (dir readOnlyFileNamed: fileName)) next. arraySix _ Array new: 6 withAll: array last. arraySix at: 1 put: array first. arraySix replaceFrom: 2 to: array size + 1 with: array startingAt: 1. TextConstants at: aString asSymbol put: arraySix. oldStyle _ TextConstants at: styleName asSymbol. arrayOfFS _ oldStyle fontArray. arrayOfFS _ (1 to: 6) collect: [:i | fs _ arrayOfFS at: i. fonts _ fs fontArray. encoding + 1 > fonts size ifTrue: [ newFonts _ Array new: encoding + 1. newFonts replaceFrom: 1 to: fonts size with: fonts startingAt: 1. newFonts at: encoding + 1 put: (arraySix at: i). fs initializeWithFontArray: newFonts. ] ifFalse: [ fonts at: encoding + 1 put: (arraySix at: i). ]. fs. ]. TextConstants at: styleName asSymbol put: (TextStyle fontArray: arrayOfFS). oldStyle becomeForward: (TextConstants at: styleName asSymbol). ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 10:32'! installExternalFontFileName: fileName encoding: encoding encodingName: aString textStyleName: styleName ^ self installExternalFontFileName: fileName inDir: FileDirectory default encoding: encoding encodingName: aString textStyleName: styleName. " StrikeFontSet createExternalFontFileForCyrillic: 'cyrillicFont.out'. StrikeFontSet installExternalFontFileName: 'chineseFont.out' encoding: 2 encodingName: #Gb2312 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'japaneseFont.out' encoding: 1 encodingName: #JisX0208 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'defaultFont.out' encoding: 0 encodingName: #Latin1 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'cyrillicFont.out' encoding: UnicodeCyrillic leadingChar encodingName: #Cyrillic textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'extendedLatinFont.out' encoding: UnicodeLatinExtendedAB leadingChar encodingName: #ExtendedLatin textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'ipaExtensionsFont.out' encoding: UnicodeIPA leadingChar encodingName: #IPAExtensions textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'armenianFont.out' encoding: UnicodeArmenian leadingChar encodingName: #Armenian textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'arrowFont.out' encoding: UnicodeArrows leadingChar encodingName: #Arrow textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uJapaneseFont.out' indir: FileDirectory default encoding: JapaneseEnvironment leadingChar encodingName: #Japanese textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uKoreanFont.out' encoding: UnicodeKorean leadingChar encodingName: #Korean textStyleName: #DefaultMultiStyle. StrikeFontSet removeFontsForEncoding: 2 encodingName: #Gb2312. self halt. StrikeFontSet removeFontsForEncoding: 3 encodingName: #KsX1001. " ! ! !CP1253TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:39'! toSqueak: char | value | value _ char charCode. value < 128 ifTrue: [^ char]. value > 255 ifTrue: [^ char]. ^ MultiCharacter leadingChar: GreekEnvironment leadingChar code: (#( 16r20AC 16rFFFD 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 16rFFFD 16r2030 16rFFFD 16r2039 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 16rFFFD 16r2122 16rFFFD 16r203A 16rFFFD 16rFFFD 16rFFFD 16rFFFD 16r00A0 16r0385 16r0386 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 16r00A8 16r00A9 16rFFFD 16r00AB 16r00AC 16r00AD 16r00AE 16r2015 16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r00B5 16r00B6 16r00B7 16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 16r03A0 16r03A1 16rFFFD 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE 16rFFFD ) at: (value - 128 + 1)). ! ! !CompoundTextConverter methodsFor: 'conversion' stamp: 'yo 3/17/2004 22:17'! nextFromStream: aStream | character character2 size leadingChar offset result | aStream isBinary ifTrue: [^ aStream basicNext]. character _ aStream basicNext. character ifNil: [^ nil]. character == Character escape ifTrue: [ self parseShiftSeqFromStream: aStream. character _ aStream basicNext. character ifNil: [^ nil]]. character asciiValue < 128 ifTrue: [ size _ state g0Size. leadingChar _ state g0Leading. offset _ 16r21. ] ifFalse: [ size _state g1Size. leadingChar _ state g1Leading. offset _ 16rA1. ]. size = 1 ifTrue: [ leadingChar = 0 ifTrue: [^ character] ifFalse: [^ MultiCharacter leadingChar: leadingChar code: character asciiValue] ]. size = 2 ifTrue: [ character2 _ aStream basicNext. character2 ifNil: [^ nil. "self errorMalformedInput"]. character _ character asciiValue - offset. character2 _ character2 asciiValue - offset. result _ MultiCharacter leadingChar: leadingChar code: character * 94 + character2. ^ result asUnicodeChar. "^ self toUnicode: result" ]. self error: 'unsupported encoding'. ! ! !CompoundTextConverter methodsFor: 'conversion' stamp: 'yo 3/16/2004 22:26'! nextPut: aCharacter toStream: aStream | ascii leadingChar class | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ ^ aStream basicNextPut: aCharacter. ]. aCharacter class == MultiCharacter ifTrue: [ "this shouldn't happen?" ^ aStream nextInt32Put: aCharacter value. ]. ]. aCharacter isUnicode ifTrue: [ class _ (EncodedCharSet at: aCharacter leadingChar) traditionalCharsetClass. ascii _ (class charFromUnicode: aCharacter asUnicode) charCode. leadingChar _ class leadingChar. ] ifFalse: [ ascii _ aCharacter charCode. leadingChar _ aCharacter leadingChar. ]. self nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForLeadingChar: leadingChar. ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:40'! languageEnvironment self subclassResponsibility ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:42'! nextFromStream: aStream | character1 character2 offset value1 value2 nonUnicodeChar | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character1 asciiValue <= 127 ifTrue: [^ character1]. character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. offset _ 16rA1. (character1 asciiValue < offset or: [character2 asciiValue < offset]) ifTrue: [^ nil]. value1 _ character1 asciiValue - offset. value2 _ character2 asciiValue - offset. nonUnicodeChar _ MultiCharacter leadingChar: self leadingChar code: value1 * 94 + value2. ^ MultiCharacter leadingChar: self languageEnvironment leadingChar code: nonUnicodeChar asUnicode. ! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/16/2004 22:46'! nextPut: aCharacter toStream: aStream | value leadingChar nonUnicodeChar value1 value2 | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ aStream basicNextPut: aCharacter. ^ aStream ]. aCharacter class == MultiCharacter ifTrue: [ aStream nextInt32Put: aCharacter value. ^ aStream ] ]. value _ aCharacter charCode. leadingChar _ aCharacter leadingChar. (leadingChar = 0 and: [value < 128]) ifTrue: [ aStream basicNextPut: (Character value: value). ^ aStream ]. (128 <= value and: [value < 256]) ifTrue: [^ aStream]. aCharacter isUnicode ifTrue: [ nonUnicodeChar _ self nonUnicodeClass charFromUnicode: value. ] ifFalse: [ nonUnicodeChar _ value ]. nonUnicodeChar ifNotNil: [ value _ nonUnicodeChar charCode. value1 _ value // 94 + 161. value2 _ value \\ 94 + 161. aStream basicNextPut: (Character value: value1). aStream basicNextPut: (Character value: value2). ^ aStream ] ! ! !CNGBTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:41'! languageEnvironment ^ SimplifiedChineseEnvironment. ! ! !EUCJPTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:41'! languageEnvironment ^ JapaneseEnvironment. ! ! !EUCKRTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:41'! languageEnvironment ^ KoreanEnvironment. ! ! !ISO88597TextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 00:39'! toSqueak: char | value | value _ char charCode. value < 160 ifTrue: [^ char]. value > 255 ifTrue: [^ char]. ^ MultiCharacter leadingChar: GreekEnvironment leadingChar code: (#( 16r00A0 16r2018 16r2019 16r00A3 16r20AC 16r20AF 16r00A6 16r00A7 16r00A8 16r00A9 16r037A 16r00AB 16r00AC 16r00AD 16rFFFD 16r2015 16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r0385 16r0386 16r00B7 16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 16r03A0 16r03A1 16rFFFD 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE 16rFFFD ) at: (value - 160 + 1)). ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 21:59'! katakanaValue: code ^ MultiCharacter leadingChar: JapaneseEnvironment leadingChar code: (#( 16rFFFD 16rFF61 16rFF62 16rFF63 16rFF64 16rFF65 16rFF66 16rFF67 16rFF68 16rFF69 16rFF6A 16rFF6B 16rFF6C 16rFF6D 16rFF6E 16rFF6F 16rFF70 16rFF71 16rFF72 16rFF73 16rFF74 16rFF75 16rFF76 16rFF77 16rFF78 16rFF79 16rFF7A 16rFF7B 16rFF7C 16rFF7D 16rFF7E 16rFF7F 16rFF80 16rFF81 16rFF82 16rFF83 16rFF84 16rFF85 16rFF86 16rFF87 16rFF88 16rFF89 16rFF8A 16rFF8B 16rFF8C 16rFF8D 16rFF8E 16rFF8F 16rFF90 16rFF91 16rFF92 16rFF93 16rFF94 16rFF95 16rFF96 16rFF97 16rFF98 16rFF99 16rFF9A 16rFF9B 16rFF9C 16rFF9D 16rFF9E 16rFF9F ) at: (code - 16r9F)). ! ! !ShiftJISTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 21:59'! toUnicode: aChar ^ MultiCharacter leadingChar: JapaneseEnvironment leadingChar code: aChar asUnicode. ! ! !Unicode class methodsFor: 'class methods' stamp: 'yo 3/16/2004 22:29'! value: code | l | code < 256 ifTrue: [^ Character value: code]. l _ Smalltalk systemLanguage leadingChar. l = 0 ifTrue: [l _ 255]. MultiCharacter leadingChar: l code: code. ! ! !Unicode class methodsFor: 'sub encodings' stamp: 'yo 3/17/2004 23:38'! blocks320Comment2 "# Blocks-3.2.0.txt # Correlated with Unicode 3.2 # Start Code..End Code; Block Name 0000..007F; Basic Latin 0080..00FF; Latin-1 Supplement => Latin 1 0100..017F; Latin Extended-A 0180..024F; Latin Extended-B 0250..02AF; IPA Extensions => LatinExtended1 02B0..02FF; Spacing Modifier Letters 0300..036F; Combining Diacritical Marks => Modifiers 0370..03FF; Greek and Coptic 0400..04FF; Cyrillic 0500..052F; Cyrillic Supplementary 0530..058F; Armenian => EuropeanAlphabetic1 0590..05FF; Hebrew 0600..06FF; Arabic 0700..074F; Syriac 0780..07BF; Thaana => MiddleEastern 0900..097F; Devanagari 0980..09FF; Bengali 0A00..0A7F; Gurmukhi 0A80..0AFF; Gujarati 0B00..0B7F; Oriya 0B80..0BFF; Tamil 0C00..0C7F; Telugu 0C80..0CFF; Kannada 0D00..0D7F; Malayalam 0D80..0DFF; Sinhala => South Asian1 0E00..0E7F; Thai 0E80..0EFF; Lao => Southeastern 1 0F00..0FFF; Tibetan => South Asian1 1000..109F; Myanmar => Southeastern 1 10A0..10FF; Georgian => European Alphabetic 2 1100..11FF; Hangul Jamo => Korean 1200..137F; Ethiopic 13A0..13FF; Cherokee 1400..167F; Unified Canadian Aboriginal Syllabics => Additional1 1680..169F; Ogham 16A0..16FF; Runic => European Alphabetic 3 1700..171F; Tagalog 1720..173F; Hanunoo 1740..175F; Buhid 1760..177F; Tagbanwa 1780..17FF; Khmer => Southeastern2 1800..18AF; Mongolian => Additional2 1E00..1EFF; Latin Extended Additional 1F00..1FFF; Greek Extended => EuropeanAlphabetic4 2000..206F; General Punctuation 2070..209F; Superscripts and Subscripts 20A0..20CF; Currency Symbols 20D0..20FF; Combining Diacritical Marks for Symbols 2100..214F; Letterlike Symbols 2150..218F; Number Forms 2190..21FF; Arrows 2200..22FF; Mathematical Operators 2300..23FF; Miscellaneous Technical 2400..243F; Control Pictures 2440..245F; Optical Character Recognition 2460..24FF; Enclosed Alphanumerics 2500..257F; Box Drawing 2580..259F; Block Elements 25A0..25FF; Geometric Shapes 2600..26FF; Miscellaneous Symbols 2700..27BF; Dingbats 27C0..27EF; Miscellaneous Mathematical Symbols-A 27F0..27FF; Supplemental Arrows-A 2800..28FF; Braille Patterns 2900..297F; Supplemental Arrows-B 2980..29FF; Miscellaneous Mathematical Symbols-B 2A00..2AFF; Supplemental Mathematical Operators => Symbols2 2E80..2EFF; CJK Radicals Supplement 2F00..2FDF; Kangxi Radicals 2FF0..2FFF; Ideographic Description Characters 3000..303F; CJK Symbols and Punctuation 3040..309F; Hiragana 30A0..30FF; Katakana 3100..312F; Bopomofo 3130..318F; Hangul Compatibility Jamo 3190..319F; Kanbun 31A0..31BF; Bopomofo Extended 31F0..31FF; Katakana Phonetic Extensions 3200..32FF; Enclosed CJK Letters and Months 3300..33FF; CJK Compatibility 3400..4DBF; CJK Unified Ideographs Extension A 4E00..9FFF; CJK Unified Ideographs A000..A48F; Yi Syllables A490..A4CF; Yi Radicals => CJK AC00..D7AF; Hangul Syllables => Korean D800..DB7F; High Surrogates DB80..DBFF; High Private Use Surrogates DC00..DFFF; Low Surrogates E000..F8FF; Private Use Area F900..FAFF; CJK Compatibility Ideographs => CJK FB00..FB4F; Alphabetic Presentation Forms FB50..FDFF; Arabic Presentation Forms-A => Middle Eastern 2 FE00..FE0F; Variation Selectors FE20..FE2F; Combining Half Marks FE30..FE4F; CJK Compatibility Forms => CJK FE50..FE6F; Small Form Variants => Symbol3 FE70..FEFF; Arabic Presentation Forms-B => Middle Eastern 3 FF00..FFEF; Halfwidth and Fullwidth Forms FFF0..FFFF; Specials => Specials 10300..1032F; Old Italic 10330..1034F; Gothic 10400..1044F; Deseret => European 1D000..1D0FF; Byzantine Musical Symbols 1D100..1D1FF; Musical Symbols 1D400..1D7FF; Mathematical Alphanumeric Symbols => Symbols 20000..2A6DF; CJK Unified Ideographs Extension B 2F800..2FA1F; CJK Compatibility Ideographs Supplement => CJK E0000..E007F; Tags F0000..FFFFF; Supplementary Private Use Area-A 100000..10FFFF; Supplementary Private Use Area-B => Special "! ! Unicode class removeSelector: #addLeadingCharMethods! Unicode class removeSelector: #defaultKanjiClass! Unicode class removeSelector: #leadingCharFor0:! Unicode class removeSelector: #leadingCharFor10:! Unicode class removeSelector: #leadingCharFor13:! Unicode class removeSelector: #leadingCharFor15:! Unicode class removeSelector: #leadingCharFor1:! Unicode class removeSelector: #leadingCharFor2:! Unicode class removeSelector: #leadingCharFor:kanjiClass:! Unicode class removeSelector: #leadingCharForKanjiClass:! Unicode class removeSelector: #restOfleadingCharFor0:! UTF8TextConverter removeSelector: #unicodeClass! UTF16TextConverter removeSelector: #unicodeClass! ShiftJISTextConverter removeSelector: #unicodeClass! MacRomanTextConverter removeSelector: #unicodeClass! Latin1TextConverter removeSelector: #unicodeClass! ISO88597TextConverter removeSelector: #unicodeClass! EUCKRTextConverter removeSelector: #unicodeClass! EUCJPTextConverter removeSelector: #unicodeClass! CNGBTextConverter removeSelector: #unicodeClass! EUCTextConverter removeSelector: #unicodeClass! CompoundTextConverter removeSelector: #toUnicode:! CP1253TextConverter removeSelector: #unicodeClass! TextConverter removeSelector: #unicodeClass! SpanishEnvironment class removeSelector: #charsetClass! SimplifiedChineseEnvironment class removeSelector: #charsetClass! KoreanEnvironment class removeSelector: #charsetClass! JapaneseEnvironment class removeSelector: #charsetClass! GermanEnvironment class removeSelector: #charsetClass! LanguageEnvironment class removeSelector: #charsetClass! !LanguageEnvironment class reorganize! ('language methods' beCurrentNaturalLanguage flapTabTextFor: flapTabTextFor:in:) ('class initialization' clearDefault initialize startUp) ('subclass responsibilities' clipboardInterpreterClass fileNameConverterClass inputInterpreterClass leadingChar systemConverterClass) ('public query' charFromUnicode: defaultClipboardInterpreter defaultEncodingName defaultFileNameConverter defaultInputInterpreter defaultSystemConverter) ('rendering support' isBreakableAt:in:) ! KSX1001 class removeSelector: #scanSelector! JISX0208 class removeSelector: #scanSelector! GB2312 class removeSelector: #scanSelector! EncodedCharSet initialize! Smalltalk removeClassNamed: #UnicodeAlphabeticPresentations! Smalltalk removeClassNamed: #UnicodeArabic! Smalltalk removeClassNamed: #UnicodeArabicPresentationsA! Smalltalk removeClassNamed: #UnicodeArabicPresentationsB! Smalltalk removeClassNamed: #UnicodeArmenian! Smalltalk removeClassNamed: #UnicodeArrows! Smalltalk removeClassNamed: #UnicodeBengali! Smalltalk removeClassNamed: #UnicodeBlockElements! Smalltalk removeClassNamed: #UnicodeBoxDrawing! Smalltalk removeClassNamed: #UnicodeBraille! Smalltalk removeClassNamed: #UnicodeBuhid! Smalltalk removeClassNamed: #UnicodeByzantineMusicals! Smalltalk removeClassNamed: #UnicodeCanadianAboriginal! Smalltalk removeClassNamed: #UnicodeCherokee! Smalltalk removeClassNamed: #UnicodeCombiningDiacritical! Smalltalk removeClassNamed: #UnicodeCombiningDiacriticalForSymbols! Smalltalk removeClassNamed: #UnicodeCombiningHalfMarks! Smalltalk removeClassNamed: #UnicodeControlPictures! Smalltalk removeClassNamed: #UnicodeCurrencySymbols! Smalltalk removeClassNamed: #UnicodeCyrillic! Smalltalk removeClassNamed: #UnicodeDeseret! Smalltalk removeClassNamed: #UnicodeDevanagari! Smalltalk removeClassNamed: #UnicodeDingbats! Smalltalk removeClassNamed: #UnicodeEnclosedAlnums! Smalltalk removeClassNamed: #UnicodeEthiopic! Smalltalk removeClassNamed: #UnicodeGeneralPunctuation! Smalltalk removeClassNamed: #UnicodeGeometricShapes! Smalltalk removeClassNamed: #UnicodeGeorgian! Smalltalk removeClassNamed: #UnicodeGothic! Smalltalk removeClassNamed: #UnicodeGreekExtended! Smalltalk removeClassNamed: #UnicodeGujarati! Smalltalk removeClassNamed: #UnicodeGurmukhi! Smalltalk removeClassNamed: #UnicodeHanunoo! Smalltalk removeClassNamed: #UnicodeHebrew! Smalltalk removeClassNamed: #UnicodeIPA! Smalltalk removeClassNamed: #UnicodeJapanese! Smalltalk removeClassNamed: #UnicodeKannada! Smalltalk removeClassNamed: #UnicodeKhmer! Smalltalk removeClassNamed: #UnicodeKorean! Smalltalk removeClassNamed: #UnicodeLao! Smalltalk removeClassNamed: #UnicodeLatinExtendedAB! Smalltalk removeClassNamed: #UnicodeLatinExtendedAdditional! Smalltalk removeClassNamed: #UnicodeLetterlikeSymbols! Smalltalk removeClassNamed: #UnicodeMalayalam! Smalltalk removeClassNamed: #UnicodeMathAlnumSymbols! Smalltalk removeClassNamed: #UnicodeMathOperators! Smalltalk removeClassNamed: #UnicodeMiscMathSymbolsA! Smalltalk removeClassNamed: #UnicodeMiscMathSymbolsB! Smalltalk removeClassNamed: #UnicodeMiscSymbols! Smalltalk removeClassNamed: #UnicodeMiscTechnical! Smalltalk removeClassNamed: #UnicodeMongolian! Smalltalk removeClassNamed: #UnicodeMusicalSymbols! Smalltalk removeClassNamed: #UnicodeMyanmar! Smalltalk removeClassNamed: #UnicodeNumberForms! Smalltalk removeClassNamed: #UnicodeOCRs! Smalltalk removeClassNamed: #UnicodeOgham! Smalltalk removeClassNamed: #UnicodeOldItalic! Smalltalk removeClassNamed: #UnicodeOriya! Smalltalk removeClassNamed: #UnicodeRunic! Smalltalk removeClassNamed: #UnicodeSimplifiedChinese! Smalltalk removeClassNamed: #UnicodeSinhala! Smalltalk removeClassNamed: #UnicodeSpacingModifiers! Smalltalk removeClassNamed: #UnicodeSuperAndSubscript! Smalltalk removeClassNamed: #UnicodeSupplementalArrowsA! Smalltalk removeClassNamed: #UnicodeSupplementalArrowsB! Smalltalk removeClassNamed: #UnicodeSupplementalMathOperators! Smalltalk removeClassNamed: #UnicodeSyriac! Smalltalk removeClassNamed: #UnicodeTagalog! Smalltalk removeClassNamed: #UnicodeTagbanwa! Smalltalk removeClassNamed: #UnicodeTags! Smalltalk removeClassNamed: #UnicodeTamil! Smalltalk removeClassNamed: #UnicodeTelugu! Smalltalk removeClassNamed: #UnicodeThaana! Smalltalk removeClassNamed: #UnicodeThai! Smalltalk removeClassNamed: #UnicodeTibetan! Smalltalk removeClassNamed: #UnicodeTraditionalChinese! Smalltalk removeClassNamed: #UnicodeVietnamese! Smalltalk removeClassNamed: #UnicodeYiRadicals! Smalltalk removeClassNamed: #UnicodeYiSyllables! 'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 17 March 2004 at 6:36:41 pm'! LanguageEnvironment subclass: #Latin1Environment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Languages'! Latin1Environment subclass: #EnglishEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Languages'! Latin1Environment subclass: #GermanEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Languages'! Latin1Environment subclass: #SpanishEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Languages'! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 16:23'! nextPut: aCharacter toStream: aStream | value leadingChar nonUnicodeChar value1 value2 | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ aStream basicNextPut: aCharacter. ^ aStream ]. aCharacter class == MultiCharacter ifTrue: [ aStream nextInt32Put: aCharacter value. ^ aStream ] ]. value _ aCharacter charCode. leadingChar _ aCharacter leadingChar. (leadingChar = 0 and: [value < 128]) ifTrue: [ aStream basicNextPut: (Character value: value). ^ aStream ]. (128 <= value and: [value < 256]) ifTrue: [^ aStream]. aCharacter isUnicode ifTrue: [ nonUnicodeChar _ self nonUnicodeClass charFromUnicode: value. ] ifFalse: [ nonUnicodeChar _(Character value: value) ]. nonUnicodeChar ifNotNil: [ value _ nonUnicodeChar charCode. value1 _ value // 94 + 161. value2 _ value \\ 94 + 161. aStream basicNextPut: (Character value: value1). aStream basicNextPut: (Character value: value2). ^ aStream ] ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:10'! clipboardInterpreterClass self subclassResponsibility. ^ NoConversionClipboardInterpreter. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:10'! fileNameConverterClass self subclassResponsibility. ^ Latin1TextConverter. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:10'! inputInterpreterClass self subclassResponsibility. ^ MacRomanInputInterpreter. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:11'! leadingChar self subclassResponsibility. ^ 0. ! ! !LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:10'! systemConverterClass self subclassResponsibility. ^ Latin1TextConverter. ! ! !LanguageEnvironment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 15:08'! flapTabTextFor: aString self subclassResponsibility. ! ! !LanguageEnvironment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 15:08'! flapTabTextFor: aString in: aFlapTab self subclassResponsibility. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'! canBeGlobalVarInitial: char ^ Unicode canBeGlobalVarInitial: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'! canBeNonGlobalVarInitial: char ^ Unicode canBeNonGlobalVarInitial: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'! digitValue: char ^ Unicode digitValue: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'! isDigit: char ^ Unicode isDigit: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'! isLetter: char ^ Unicode isLetter: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'! isLowercase: char ^ Unicode isLowercase: char. ! ! !LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'! isUppercase: char ^ Unicode isUppercase: char. ! ! !Latin1Environment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 15:07'! beCurrentNaturalLanguage ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'! clipboardInterpreterClass ^ NoConversionClipboardInterpreter. ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:14'! defaultEncodingName | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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'. ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'! fileNameConverterClass ^ Latin1TextConverter ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'! inputInterpreterClass ^ MacRomanInputInterpreter. ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'! leadingChar ^ 0. ! ! !Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'! systemConverterClass ^ Latin1TextConverter. ! ! !Latin1Environment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 15:08'! flapTabTextFor: aString ^ aString. ! ! !Latin1Environment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 15:08'! flapTabTextFor: aString in: aFlapTab ^ aString. ! ! !Latin1Environment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 15:07'! isBreakableAt: index in: text | char | char _ text at: index. char = Character space ifTrue: [^ true]. char = Character cr ifTrue: [^ true]. ^ false. ! ! !MultiCharacter methodsFor: 'converting' stamp: 'yo 3/17/2004 15:39'! asUnicode | table charset v | charset _ EncodedCharSet charsetAt: self leadingChar. (charset isKindOf: EncodedCharSet class) ifFalse: [^ self charCode]. table _ charset ucsTable. table isNil ifTrue: [^ 16rFFFD]. v _ table at: self charCode + 1. v = -1 ifTrue: [^ 16rFFFD]. ^ v. ! ! !MultiCharacter methodsFor: 'testing' stamp: 'yo 3/17/2004 16:25'! isUnicode ^ ((EncodedCharSet charsetAt: self leadingChar) isKindOf: LanguageEnvironment class).! ! !MultiString methodsFor: 'private' stamp: 'yo 3/17/2004 15:47'! mutateJISX0208StringToUnicode | c | 1 to: self size do: [:i | c _ self at: i. (c leadingChar = JISX0208 leadingChar or: [ c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [ self basicAt: i put: (MultiCharacter leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue. ] ]. ! ! !SystemDictionary methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:54'! primaryLanguage: aSymbol PrimaryLanguage _ self at: aSymbol ifAbsent: [EnglishEnvironment]. LanguageEnvironment startUp. ! ! !SystemDictionary methodsFor: 'accessing' stamp: 'yo 3/17/2004 14:37'! systemLanguage: aSymbol SystemLanguage _ self at: aSymbol ifAbsent: [EnglishEnvironment]. LanguageEnvironment startUp. ! ! !UTF8TextConverter methodsFor: 'aaa' stamp: 'yo 3/17/2004 15:35'! nextPut: aCharacter toStream: aStream | leadingChar nBytes mask shift ucs2code | aStream isBinary ifTrue: [ aCharacter class == Character ifTrue: [ aStream basicNextPut: aCharacter. ^ aStream. ]. aCharacter class = MultiCharacter ifTrue: [ aStream nextInt32Put: aCharacter value. ^ aStream. ]. ]. leadingChar _ aCharacter leadingChar. (leadingChar = 0 and: [aCharacter asciiValue < 128]) ifTrue: [ aStream basicNextPut: aCharacter. ^ aStream. ]. "leadingChar > 3 ifTrue: [^ aStream]." ucs2code _ aCharacter asUnicode. ucs2code ifNil: [^ aStream]. nBytes _ ucs2code highBit + 3 // 5. mask _ #(128 192 224 240 248 252 254 255) at: nBytes. shift _ nBytes - 1 * -6. aStream basicNextPut: (Character value: (ucs2code bitShift: shift) + mask). 2 to: nBytes do: [:i | shift _ shift + 6. aStream basicNextPut: (Character value: ((ucs2code bitShift: shift) bitAnd: 63) + 128). ]. ^ aStream. ! ! !Unicode class methodsFor: 'class methods' stamp: 'yo 3/17/2004 15:43'! value: code | l | code < 256 ifTrue: [^ Character value: code]. l _ Smalltalk systemLanguage leadingChar. l = 0 ifTrue: [l _ 255]. ^ MultiCharacter leadingChar: l code: code. ! ! !LanguageEnvironment class methodsFor: 'public query' stamp: 'yo 3/18/2004 00:53'! defaultClipboardInterpreter ClipboardInterpreterClass ifNil: [ClipboardInterpreterClass _ self clipboardInterpreterClass]. ^ ClipboardInterpreterClass new. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 14:20'! installExternalFontFileName6: fileName encoding: encoding encodingName: aString textStyleName: styleName ^ self installExternalFontFileName6: fileName inDir: FileDirectory default encoding: encoding encodingName: aString textStyleName: styleName. " StrikeFontSet createExternalFontFileForCyrillic: 'cyrillicFont.out'. StrikeFontSet installExternalFontFileName: 'chineseFont.out' encoding: 2 encodingName: #Gb2312 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'japaneseFont.out' encoding: 1 encodingName: #JisX0208 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'defaultFont.out' encoding: 0 encodingName: #Latin1 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'cyrillicFont.out' encoding: UnicodeCyrillic leadingChar encodingName: #Cyrillic textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'extendedLatinFont.out' encoding: UnicodeLatinExtendedAB leadingChar encodingName: #ExtendedLatin textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'ipaExtensionsFont.out' encoding: UnicodeIPA leadingChar encodingName: #IPAExtensions textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'armenianFont.out' encoding: UnicodeArmenian leadingChar encodingName: #Armenian textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'arrowFont.out' encoding: UnicodeArrows leadingChar encodingName: #Arrow textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName6: 'uJapaneseFont.out' encoding: JapaneseEnvironment leadingChar encodingName: #Japanese textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uKoreanFont.out' encoding: UnicodeKorean leadingChar encodingName: #Korean textStyleName: #DefaultMultiStyle. StrikeFontSet removeFontsForEncoding: 2 encodingName: #Gb2312. self halt. StrikeFontSet removeFontsForEncoding: 3 encodingName: #KsX1001. " ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 14:18'! installExternalFontFileName6: fileName inDir: dir encoding: encoding encodingName: aString textStyleName: styleName | array arraySix oldStyle arrayOfFS fs fonts newFonts | array _ (ReferenceStream on: (dir readOnlyFileNamed: fileName)) next. arraySix _ Array new: 6 withAll: array last. arraySix at: 1 put: array first. arraySix replaceFrom: 2 to: array size + 1 with: array startingAt: 1. TextConstants at: aString asSymbol put: arraySix. oldStyle _ TextConstants at: styleName asSymbol. arrayOfFS _ oldStyle fontArray. arrayOfFS _ (1 to: 6) collect: [:i | fs _ arrayOfFS at: i. fonts _ fs fontArray. encoding + 1 > fonts size ifTrue: [ newFonts _ Array new: encoding + 1. newFonts replaceFrom: 1 to: fonts size with: fonts startingAt: 1. newFonts at: encoding + 1 put: (arraySix at: i). fs initializeWithFontArray: newFonts. ] ifFalse: [ fonts at: encoding + 1 put: (arraySix at: i). ]. fs. ]. TextConstants at: styleName asSymbol put: (TextStyle fontArray: arrayOfFS). oldStyle becomeForward: (TextConstants at: styleName asSymbol). ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 3/17/2004 10:32'! installExternalFontFileName: fileName encoding: encoding encodingName: aString textStyleName: styleName ^ self installExternalFontFileName: fileName inDir: FileDirectory default encoding: encoding encodingName: aString textStyleName: styleName. " StrikeFontSet createExternalFontFileForCyrillic: 'cyrillicFont.out'. StrikeFontSet installExternalFontFileName: 'chineseFont.out' encoding: 2 encodingName: #Gb2312 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'japaneseFont.out' encoding: 1 encodingName: #JisX0208 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'defaultFont.out' encoding: 0 encodingName: #Latin1 textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'cyrillicFont.out' encoding: UnicodeCyrillic leadingChar encodingName: #Cyrillic textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'extendedLatinFont.out' encoding: UnicodeLatinExtendedAB leadingChar encodingName: #ExtendedLatin textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'ipaExtensionsFont.out' encoding: UnicodeIPA leadingChar encodingName: #IPAExtensions textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'armenianFont.out' encoding: UnicodeArmenian leadingChar encodingName: #Armenian textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: UnicodeGreek leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'arrowFont.out' encoding: UnicodeArrows leadingChar encodingName: #Arrow textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uJapaneseFont.out' indir: FileDirectory default encoding: JapaneseEnvironment leadingChar encodingName: #Japanese textStyleName: #DefaultMultiStyle. StrikeFontSet installExternalFontFileName: 'uKoreanFont.out' encoding: UnicodeKorean leadingChar encodingName: #Korean textStyleName: #DefaultMultiStyle. StrikeFontSet removeFontsForEncoding: 2 encodingName: #Gb2312. self halt. StrikeFontSet removeFontsForEncoding: 3 encodingName: #KsX1001. " ! ! SpanishEnvironment class removeSelector: #defaultEncodingName! GermanEnvironment class removeSelector: #defaultEncodingName! EnglishEnvironment class removeSelector: #defaultEncodingName! Latin1Environment class removeSelector: #charFromUnicode:! !Latin1Environment class reorganize! ('language methods' beCurrentNaturalLanguage) ('subclass responsibilities' clipboardInterpreterClass defaultEncodingName fileNameConverterClass inputInterpreterClass leadingChar systemConverterClass) ('public query') ('rendering support' flapTabTextFor: flapTabTextFor:in: isBreakableAt:in:) ('accessing') ! LanguageEnvironment class removeSelector: #charFromUnicode:! !LanguageEnvironment class reorganize! ('language methods' beCurrentNaturalLanguage) ('class initialization' clearDefault initialize startUp) ('subclass responsibilities' clipboardInterpreterClass fileNameConverterClass inputInterpreterClass leadingChar systemConverterClass) ('public query' defaultClipboardInterpreter defaultEncodingName defaultFileNameConverter defaultInputInterpreter defaultSystemConverter) ('rendering support' flapTabTextFor: flapTabTextFor:in: isBreakableAt:in:) ('accessing' canBeGlobalVarInitial: canBeNonGlobalVarInitial: digitValue: isDigit: isLetter: isLowercase: isUppercase:) ! KSX1001 class removeSelector: #languageClass! JISX0208 class removeSelector: #languageClass! GB2312 class removeSelector: #languageClass! EncodedCharSet class removeSelector: #encodedCharSets! EncodedCharSet class removeSelector: #languageClass! EncodedCharSet class removeSelector: #scanSelector! Smalltalk removeClassNamed: #UnicodeGreek! 'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 30 March 2004 at 1:31:18 pm'! !Object methodsFor: 'objects from disk' stamp: 'yo 3/25/2004 19:24'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. Does not file out the class of the object. tk 6/26/97 13:48" | aFileName fileStream | aFileName _ self class name asFileName. "do better?" aFileName _ FillInTheBlank request: 'File name?' initialAnswer: aFileName. aFileName size == 0 ifTrue: [^ self beep]. fileStream _ FileStream newFileNamed: aFileName asFileName. fileStream fileOutClass: nil andObject: self.! ! !AbstractString methodsFor: 'converting' stamp: 'yo 3/25/2004 19:26'! asFileName "Answer a String made up from the receiver that is an acceptable file name." | string checkedString | string _ (FilePath pathName: self) asSystemPathName. checkedString _ FileDirectory checkName: string fixErrors: true. ^ (FilePath pathName: checkedString isEncoded: true) asSqueakPathName. ! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'yo 3/25/2004 19:25'! fileOut "File out the receiver, to a file whose name is a function of the change-set name and either of the date & time or chosen to have a unique numeric tag, depending on the preference 'changeSetVersionNumbers'" | file slips nameToUse | self flag: #yoFileName. self checkForConversionMethods. nameToUse _ Preferences changeSetVersionNumbers ifTrue: [FileDirectory default nextNameFor: self name extension: 'cs'] ifFalse: [(self name, FileDirectory dot, Utilities dateTimeSuffix, FileDirectory dot, 'cs')]. (Preferences warningForMacOSFileNameLength and: [nameToUse size > 31]) ifTrue: [ nameToUse _ FillInTheBlank request: (nameToUse , '\has ' , nameToUse size asString , ' letters - too long for Mac OS.\Suggested replacement is:') withCRs initialAnswer: (nameToUse asFileName contractTo:30). nameToUse = '' ifTrue:[^self]]. Cursor write showWhile: [[file _ FileStream newFileNamed: nameToUse asFileName. file header; timeStamp. self fileOutPreambleOn: file. self fileOutOn: file. self fileOutPostscriptOn: file. file trailer] ensure: [file close]]. Preferences checkForSlips ifFalse: [^ self]. slips _ self checkForSlips. (slips size > 0 and: [(PopUpMenu withCaption: 'Methods in this fileOut have halts or references to the Transcript or other ''slips'' in them. Would you like to browse them?' chooseFrom: 'Ignore\Browse slips') = 2]) ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ', name]! ! !EUCTextConverter methodsFor: 'as yet unclassified' stamp: 'yo 3/18/2004 20:34'! nextFromStream: aStream | character1 character2 offset value1 value2 nonUnicodeChar | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. character1 asciiValue <= 127 ifTrue: [^ character1]. character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil]. offset _ 16rA1. value1 _ character1 asciiValue - offset. value2 _ character2 asciiValue - offset. (value1 < 0 or: [value1 > 93]) ifTrue: [^ nil]. (value2 < 0 or: [value2 > 93]) ifTrue: [^ nil]. nonUnicodeChar _ MultiCharacter leadingChar: self leadingChar code: value1 * 94 + value2. ^ MultiCharacter leadingChar: self unicodeClass leadingChar code: nonUnicodeChar asUnicode. ! ! !FileDirectory methodsFor: 'testing' stamp: 'yo 3/24/2004 17:57'! exists "Answer whether the directory exists" | result | result _ self primLookupEntryIn: pathName asSystemPathName index: 1. ^ result ~= #badDirectoryPath ! ! !FileDirectory methodsFor: 'file directory' stamp: 'tetha 3/28/2004 19:38'! assureExistenceOfPath: lPath "Make sure the local directory exists. If necessary, create all parts in between" | localPath | localPath _ lPath. localPath isEmpty ifTrue: [ ^self ]. "Assumed to exist" (self directoryExists: localPath) ifTrue: [^ self]. "exists" "otherwise check parent first and then create local dir" self containingDirectory assureExistenceOfPath: self localName. self createDirectory: localPath! ! !FileDirectory class methodsFor: 'system start up' stamp: 'yo 3/22/2004 15:01'! setDefaultDirectory: directoryName "Initialize the default directory to the directory supplied. This method is called when the image starts up." | dirName | DirectoryClass _ self activeDirectoryClass. dirName _ (FilePath pathName: directoryName isEncoded: true) asSqueakPathName. [dirName endsWith: self slash] whileTrue:[ dirName _ dirName copyFrom: 1 to: dirName size - self slash size. ]. DefaultDirectory _ self on: dirName.! ! !FileDirectory class methodsFor: 'system start up' stamp: 'yo 3/22/2004 15:01'! setDefaultDirectoryFrom: imageName "Initialize the default directory to the directory containing the Squeak image file. This method is called when the image starts up." DirectoryClass _ self activeDirectoryClass. DefaultDirectory _ self on: (FilePath pathName: (self dirPathFor: imageName) isEncoded: true) asSqueakPathName. ! ! !FileList methodsFor: 'private' stamp: 'yo 3/18/2004 19:55'! readContentsAsEncoding: encodingName | f writeStream converter c | f _ directory oldFileOrNoneNamed: self fullName. f ifNil: [^ 'For some reason, this file cannot be read']. writeStream _ WriteStream on: String new. converter _ TextConverter defaultConverterClassForEncoding: encodingName. converter ifNil: [^ 'This encoding is not supported']. f converter: converter new. [f atEnd or: [(c _ f next) isNil]] whileFalse: [writeStream nextPut: c]. f close. ^ writeStream contents! ! !LanguageEnvironment class methodsFor: 'class initialization' stamp: 'yo 3/29/2004 00:16'! initialize " self initialize " Smalltalk addToStartUpList: LanguageEnvironment after: FileDirectory. Smalltalk addToStartUpList: FileDirectory after: LanguageEnvironment. ! ! !JapaneseEnvironment class methodsFor: 'as yet unclassified' stamp: 'yo 3/30/2004 13:06'! clipboardInterpreterClass | platformName osVersion | platformName _ Smalltalk platformName. osVersion _ Smalltalk 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]]. ^ NoConversionClipboardInterpreter! ! !Morph methodsFor: 'menus' stamp: 'yo 3/25/2004 19:23'! printPSToFileNamed: aString "Ask the user for a filename and print this morph as postscript." | fileName rotateFlag | fileName := aString asFileName. fileName := FillInTheBlank request: 'File name? (".eps" will be added to end)' initialAnswer: fileName. fileName isEmpty ifTrue: [^self beep]. (fileName endsWith: '.eps') ifFalse: [fileName := fileName , '.eps']. rotateFlag := ((PopUpMenu labels: 'portrait (tall) landscape (wide)') startUpWithCaption: 'Choose orientation...') = 2. (FileStream newFileNamed: fileName asFileName) nextPutAll: (PostscriptCanvas defaultCanvasType morphAsPostscript: self rotated: rotateFlag); close! ! !Morph methodsFor: 'objects from disk' stamp: 'yo 3/25/2004 19:24'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream ok | aFileName := ('my ' , self class name) asFileName. "do better?" aFileName := FillInTheBlank request: 'File name? (".morph" will be added to end)' initialAnswer: aFileName. aFileName isEmpty ifTrue: [^self beep]. self allMorphsDo: [:m | m prepareToBeSaved]. ok := aFileName endsWith: '.morph'. "don't double them" ok := ok | (aFileName endsWith: '.sp'). ok ifFalse: [aFileName := aFileName , '.morph']. fileStream := FileStream newFileNamed: aFileName asFileName. fileStream fileOutClass: nil andObject: self "Puts UniClass definitions out anyway"! ! !BookMorph methodsFor: 'menus' stamp: 'yo 3/25/2004 19:18'! printPSToFile "Ask the user for a filename and print this morph as postscript." | fileName rotateFlag | fileName := 'MyBook'. fileName := FillInTheBlank request: 'File name? (".ps" will be added to end)' initialAnswer: fileName. fileName isEmpty ifTrue: [^self beep]. (fileName endsWith: '.ps') ifFalse: [fileName := fileName , '.ps']. rotateFlag := ((PopUpMenu labels: 'portrait (tall) landscape (wide)') startUpWithCaption: 'Choose orientation...') = 2. (FileStream newFileNamed: fileName asFileName) nextPutAll: (DSCPostscriptCanvas morphAsPostscript: self rotated: rotateFlag); close! ! !MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:56'! doConversion ^ lineEndConvention notNil! ! !PasteUpMorph methodsFor: 'objects from disk' stamp: 'yo 3/25/2004 19:24'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream ok | self flag: #bob0302. self isWorldMorph ifTrue: [^self project saveAs]. aFileName := ('my ' , self class name) asFileName. "do better?" aFileName := FillInTheBlank request: 'File name? (".project" will be added to end)' asTranslatedWording initialAnswer: aFileName. aFileName isEmpty ifTrue: [^self beep]. self allMorphsDo: [:m | m prepareToBeSaved]. ok := aFileName endsWith: '.project'. "don't double them" ok := ok | (aFileName endsWith: '.sp'). ok ifFalse: [aFileName := aFileName , '.project']. fileStream := FileStream newFileNamed: aFileName asFileName. fileStream fileOutClass: nil andObject: self "Puts UniClass definitions out anyway"! ! !Project methodsFor: 'file in/out' stamp: 'yo 3/25/2004 23:32'! writeFileNamed: localFileName fromDirectory: localDirectory toServer: primaryServerDirectory | local resp gifFileName f | local _ localDirectory oldFileNamed: localFileName. resp _ primaryServerDirectory upLoadProject: local named: localFileName resourceUrl: self resourceUrl retry: false. local close. resp == true ifFalse: [ "abandon resources that would've been stored with the project" self resourceManager abandonResourcesThat: [:loc| loc urlString beginsWith: self resourceUrl]. self inform: 'the primary server of this project seems to be down (', resp printString,')'. ^ self ]. gifFileName _ self name,'.gif'. localDirectory deleteFileNamed: gifFileName ifAbsent: []. local _ localDirectory fileNamed: gifFileName. thumbnail ifNil: [ (thumbnail _ Form extent: 100@80) fillColor: Color orange ] ifNotNil: [ thumbnail unhibernate. ]. f _ thumbnail colorReduced. "minimize depth" f depth > 8 ifTrue: [ f _ thumbnail asFormOfDepth: 8 ]. GIFReadWriter putForm: f onStream: local. local close. [local _ StandardFileStream readOnlyFileNamed: (localDirectory fullNameFor: gifFileName). (primaryServerDirectory isKindOf: FileDirectory) ifTrue: [primaryServerDirectory deleteFileNamed: gifFileName ifAbsent: []]. resp _ primaryServerDirectory putFile: local named: gifFileName retry: false. ] on: Error do: [:ex |]. local close. primaryServerDirectory updateProjectInfoFor: self. primaryServerDirectory sleep. "if ftp, close the connection" ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:39'! changeImageNameTo: aString self imageName: aString asSqueakPathName. LastImageName _ self imageName! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:38'! imageName "Answer the full path name for the current image." "Smalltalk imageName" | str | str _ self primImageName. ^ (FilePath pathName: str isEncoded: true) asSqueakPathName. ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:38'! imageName: newName "Set the the full path name for the current image. All further snapshots will use this." | encoded | encoded _ (FilePath pathName: newName isEncoded: false) asSystemPathName. self primImageName: encoded. ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:36'! primImageName "Answer the full path name for the current image." "Smalltalk imageName" self primitiveFailed! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:36'! primImageName: newName "Set the the full path name for the current image. All further snapshots will use this." ^ self primitiveFailed! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:36'! primVmPath "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." "Smalltalk vmPath" ^ ''! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'yo 3/29/2004 09:43'! vmPath "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." "Smalltalk vmPath" ^ (FilePath pathName: (self primVmPath) isEncoded: true) asSqueakPathName. ! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'yo 3/29/2004 09:27'! m17nVersion ^ 'M17n 4.1beta7' copy ! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'yo 3/29/2004 09:27'! nihongoVersion ^ 'Nihongo6.1beta7' copy ! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'yo 3/29/2004 09:41'! saveAsEmbeddedImage "Save the current state of the system as an embedded image" | dir newName newImageName newImageSegDir oldImageSegDir haveSegs | dir _ FileDirectory default. newName _ FillInTheBlank request: 'Select existing VM file' initialAnswer: (FileDirectory localNameFor: ''). newName = '' ifTrue: [^ self]. newName _ FileDirectory baseNameFor: newName asFileName. newImageName _ newName. (dir includesKey: newImageName) ifFalse: [^ self inform: 'Unable to find name ', newName, ' Please choose another name.']. haveSegs _ false. Smalltalk at: #ImageSegment ifPresent: [:theClass | (haveSegs _ theClass instanceCount ~= 0) ifTrue: [oldImageSegDir _ theClass segmentDirectory]]. self logChange: '----SAVEAS (EMBEDDED) ', newName, '----', Date dateAndTimeNow printString. self imageName: (dir fullNameFor: newImageName) asSqueakPathName. LastImageName _ self imageName. self closeSourceFiles. haveSegs ifTrue: [Smalltalk at: #ImageSegment ifPresent: [:theClass | newImageSegDir _ theClass segmentDirectory. "create the folder" oldImageSegDir fileNames do: [:theName | "copy all segment files" newImageSegDir copyFileNamed: oldImageSegDir pathName, FileDirectory slash, theName toFileNamed: theName]]]. self snapshot: true andQuit: true embedded: true ! ! !VersionsBrowser methodsFor: 'init & update' stamp: 'yo 3/16/2004 12:28'! scanVersionsOf: method class: class meta: meta category: category selector: selector | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp | selectorOfMethod _ selector. currentCompiledMethod _ method. classOfMethod _ meta ifTrue: [class class] ifFalse: [class]. changeList _ OrderedCollection new. list _ OrderedCollection new. listIndex _ 0. position _ method filePosition. sourceFilesCopy _ SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. method fileIndex == 0 ifTrue: [^ nil]. file _ sourceFilesCopy at: method fileIndex. [position notNil & file notNil] whileTrue: [file position: (0 max: position-150). "Skip back to before the preamble" preamble _ method getPreambleFrom: file at: (0 max: position - 3). "Preamble is likely a linked method preamble, if we're in a changes file (not the sources file). Try to parse it for prior source position and file index" prevPos _ nil. stamp _ ''. (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [tokens _ Scanner new scanTokens: preamble] ifFalse: [tokens _ Array new "ie cant be back ref"]. ((tokens size between: 7 and: 8) and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue: [(tokens at: tokens size-3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size-2. prevPos _ tokens last. prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos] ifFalse: ["Old format gives no stamp; prior pointer in two parts" prevPos _ tokens at: tokens size-2. prevFileIndex _ tokens last]. (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]]. ((tokens size between: 5 and: 6) and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue: [(tokens at: tokens size-1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size]]. self addItem: (ChangeRecord new file: file position: position type: #method class: class name category: category meta: meta stamp: stamp) text: stamp , ' ' , class name , (meta ifTrue: [' class '] ifFalse: [' ']) , selector. position _ prevPos. prevPos notNil ifTrue: [file _ sourceFilesCopy at: prevFileIndex]]. sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]. listSelections _ Array new: list size withAll: false! ! 'From Squeak3.7beta of ''1 April 2004'' [latest update: #5905] on 25 May 2004 at 11:13:10 am'! AbstractFont subclass: #StrikeFont instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont ' classVariableNames: 'DefaultStringScanner ' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! AbstractFont subclass: #StrikeFontSet instanceVariableNames: 'fontArray emphasis derivativeFonts name' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Display'! AbstractFont subclass: #TTCFont instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont ' classVariableNames: 'NamesToIndexes Scale ' poolDictionaries: '' category: 'Multilingual-Display'! !BDFFontReader class methodsFor: 'file creation' stamp: 'yo 5/25/2004 10:52'! new ^ self basicNew. ! ! !BitBlt methodsFor: 'copying' stamp: 'yo 5/20/2004 14:30'! displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta destY _ aPoint y. destX _ aPoint x. "the following are not really needed, but theBitBlt primitive will fail if not set" sourceX ifNil: [sourceX _ 100]. width ifNil: [width _ 100]. self primDisplayString: aString from: startIndex to: stopIndex map: font characterToGlyphMap xTable: font xTable kern: kernDelta. ^ destX@destY. ! ! !BlockNode class methodsFor: 'instance creation' stamp: 'yo 5/17/2004 23:03'! withJust: aNode ^ self statements: (OrderedCollection with: aNode) returns: false! ! !MultiCompositionScanner methodsFor: 'scanning' stamp: 'yo 5/25/2004 00:39'! setActualFont: aFont "Keep track of max height and ascent for auto lineheight" | descent char | super setActualFont: aFont. char _ text at: lastIndex. "' ', lastIndex printString, ' ' displayAt: (lastIndex * 15)@0." lineHeight == nil ifTrue: [descent _ font descentOf: char. baseline _ font ascentOf: char. lineHeight _ baseline + descent] ifFalse: [descent _ lineHeight - baseline max: (font descentOf: char). baseline _ baseline max: (font ascentOf: char). lineHeight _ lineHeight max: baseline + descent]! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/25/2004 00:01'! ascentOf: aCharacter (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont ascentOf: aCharacter. ]. ]. ^ self ascent. ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/25/2004 00:01'! descentOf: aCharacter (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont descentOf: aCharacter. ]. ]. ^ self descent. ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/20/2004 11:01'! fallbackFont: aFontSetOrNil fallbackFont _ aFontSetOrNil. ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/23/2004 18:48'! glyphInfoOf: aCharacter "Answer the width of the argument as a character in the receiver." | code | (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont glyphInfoOf: aCharacter. ]. code _ 0. ] ifTrue: [ code _ aCharacter charCode. ]. ^ Array with: glyphs with: (xTable at: code + 1) with: (xTable at: code + 2). ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/23/2004 18:39'! glyphOf: aCharacter "Answer the width of the argument as a character in the receiver." | code | (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont glyphOf: aCharacter. ]. ^ (Form extent: 1@self height) fillColor: Color white ]. code _ aCharacter charCode. ^ glyphs copy: (((xTable at: code + 1)@0) corner: (xTable at: code +2)@self height). ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/24/2004 23:51'! heightOf: aCharacter (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont heightOf: aCharacter. ]. ]. ^ self height. ! ! !StrikeFont methodsFor: 'accessing' stamp: 'yo 5/23/2004 18:38'! widthOf: aCharacter "Answer the width of the argument as a character in the receiver." | code | (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont widthOf: aCharacter. ]. ^ 1 ]. code _ aCharacter charCode. ^ (xTable at: code + 2) - (xTable at: code + 1) ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/19/2004 11:34'! characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta on: aBitBlt "Simple, slow, primitive method for displaying a line of characters. No wrap-around is provided." | ascii destPoint leftX rightX sourceRect | destPoint _ aPoint. anInterval do: [:i | self flag: #yoDisplay. "if the char is not supported, fall back to the specified fontset." ascii _ (sourceString at: i) charCode. (ascii < minAscii or: [ascii > maxAscii]) ifTrue: [ascii _ maxAscii]. leftX _ xTable at: ascii + 1. rightX _ xTable at: ascii + 2. sourceRect _ leftX@0 extent: (rightX-leftX) @ self height. aBitBlt copyFrom: sourceRect in: glyphs to: destPoint. destPoint _ destPoint + ((rightX-leftX+kernDelta)@0). "destPoint printString displayAt: 0@(i*20)"]. ^ destPoint! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/19/2004 11:36'! displayLine: aString at: aPoint "Display the characters in aString, starting at position aPoint." self characters: (1 to: aString size) in: aString displayAt: aPoint clippedBy: Display boundingBox rule: Form over fillColor: nil kernDelta: 0 on: (BitBlt current toForm: Display). ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/23/2004 19:00'! displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | glyphInfo _ self glyphInfoOf: (aString at: charIndex). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ^ destPoint. ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/20/2004 14:30'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta "Draw the given string from startIndex to stopIndex at aPoint on the (already prepared) BitBlt." (aString class == MultiString) ifTrue: [^ self displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta.]. ^ aBitBlt displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: self kern: kernDelta.! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 5/24/2004 17:54'! makeBoldGlyphs "Make a bold set of glyphs with same widths by ORing 1 bit to the right (requires at least 1 pixel of intercharacter space)" | g bonkForm | g _ glyphs deepCopy. bonkForm _ (Form extent: 1@16) fillBlack offset: -1@0. self bonk: g with: bonkForm. g copyBits: g boundingBox from: g at: (1@0) clippingBox: g boundingBox rule: Form under fillColor: nil. glyphs _ g. fallbackFont ifNotNil: [ fallbackFont _ fallbackFont emphasized: 1 ]. ! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 5/24/2004 17:51'! makeCondensedGlyphs "Make a condensed set of glyphs with same widths. NOTE: this has been superceded by kerning -- should not get called" | g newXTable x x1 w | g _ glyphs deepCopy. newXTable _ Array new: xTable size. newXTable at: 1 put: (x _ xTable at: 1). 1 to: xTable size-1 do: [:i | x1 _ xTable at: i. w _ (xTable at: i+1) - x1. w > 1 ifTrue: [w _ w-1]. "Shrink every character wider than 1" g copy: (x@0 extent: w@g height) from: x1@0 in: glyphs rule: Form over. newXTable at: i+1 put: (x _ x + w)]. xTable _ newXTable. glyphs _ g. fallbackFont ifNotNil: [ fallbackFont emphasized: 8 ]. " (TextStyle default fontAt: 1) copy makeCondensedGlyphs displayLine: 'The quick brown fox jumps over the lazy dog' at: Sensor cursorPoint "! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 5/24/2004 17:54'! makeItalicGlyphs "Make an italic set of glyphs with same widths by skewing left and right. In the process, characters would overlap, so we widen them all first. " | extraWidth newGlyphs newXTable x newX w extraOnLeft | extraOnLeft _ (self height-1-self ascent+4)//4 max: 0. extraWidth _ ((self ascent-5+4)//4 max: 0) + extraOnLeft. newGlyphs _ Form extent: (glyphs width + (maxAscii + 1 - minAscii*extraWidth)) @ glyphs height. newXTable _ xTable copy. "Copy glyphs into newGlyphs with room on left and right for overlap." minAscii to: maxAscii+1 do: [:ascii | x _ xTable at: ascii+1. w _ (xTable at: ascii+2) - x. newX _ newXTable at: ascii+1. newGlyphs copy: ((newX + extraOnLeft) @ 0 extent: w @ glyphs height) from: x @ 0 in: glyphs rule: Form over. newXTable at: ascii+2 put: newX + w + extraWidth]. glyphs _ newGlyphs. xTable _ newXTable. "Slide the bitmaps left and right for synthetic italic effect." 4 to: self ascent-1 by: 4 do: [:y | "Slide ascenders right..." glyphs copy: (1@0 extent: glyphs width @ (self ascent - y)) from: 0@0 in: glyphs rule: Form over]. self ascent to: self height-1 by: 4 do: [:y | "Slide descenders left..." glyphs copy: (0@y extent: glyphs width @ glyphs height) from: 1@y in: glyphs rule: Form over]. fallbackFont ifNotNil: [ fallbackFont _ fallbackFont emphasized: 2 ]. ! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 5/24/2004 17:54'! makeStruckOutGlyphs "Make a struck-out set of glyphs with same widths" | g | g _ glyphs deepCopy. g fillBlack: (0 @ (self ascent - (self ascent//3)) extent: g width @ 1). glyphs _ g. fallbackFont ifNotNil: [ fallbackFont _ fallbackFont emphasized: 16 ]. ! ! !StrikeFont methodsFor: 'emphasis' stamp: 'yo 5/24/2004 17:54'! makeUnderlinedGlyphs "Make an underlined set of glyphs with same widths" | g | g _ glyphs deepCopy. g fillBlack: (0 @ (self ascent+1) extent: g width @ 1). glyphs _ g. fallbackFont ifNotNil: [ fallbackFont _ fallbackFont emphasized: 4 ]. ! ! !StrikeFont methodsFor: 'private' stamp: 'yo 5/20/2004 10:51'! leftAndRighOrNilFor: char | code leftX | code _ char charCode. ((code between: self minAscii and: self maxAscii) not) ifTrue: [ code _ $? charCode. ]. leftX _ xTable at: code + 1. leftX < 0 ifTrue: [ code _ $? charCode. leftX _ xTable at: code + 1. ]. ^ Array with: leftX with: (xTable at: code + 2). ! ! !StrikeFont methodsFor: 'multibyte character methods' stamp: 'yo 5/23/2004 18:31'! hasGlyphFor: aCharacter | code | code _ aCharacter charCode. ((code between: self minAscii and: self maxAscii) not) ifTrue: [ ^ false. ]. (xTable at: code + 1) < 0 ifTrue: [ ^ false. ]. ^ true. ! ! !StrikeFont methodsFor: 'multibyte character methods' stamp: 'yo 5/24/2004 23:11'! setupDefaultFallbackFont | fonts f | fonts _ TextStyle default fontArray. f _ fonts first. 1 to: fonts size do: [:i | self height > (fonts at: i) height ifTrue: [f _ fonts at: i]. ]. self fallbackFont: f. self reset. ! ! !HostFont methodsFor: 'accessing' stamp: 'yo 5/20/2004 14:33'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint ascii leftX rightX | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | ascii _ (aString at: charIndex) charCode. ((ascii between: self minAscii and: self maxAscii) not) ifTrue: [ ascii _ self maxAscii]. xTable _ self xTable. leftX _ xTable at: ascii + 1. leftX < 0 ifTrue: [ leftX _ xTable at: self maxAscii + 2. rightX _ xTable at: self maxAscii + 3 ] ifFalse: [ rightX _ xTable at: ascii + 2. ]. aBitBlt sourceForm: self glyphs. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ^ destPoint. ! ! !StrikeFont class methodsFor: 'accessing' stamp: 'yo 5/24/2004 23:02'! setupDefaultFallbackFont " StrikeFont setupDefaultFallbackFont " (#(#Accuat #Accujen #Accula #Accumon #Accusf #Accushi #Accuve #Atlanta) collect: [:e | TextStyle named: e]) do: [:style | style fontArray do: [:e | e reset. e setupDefaultFallbackFont. ]. ]. ! ! !StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 5/19/2004 11:36'! displayLine: aString at: aPoint "Display the characters in aString, starting at position aPoint." self characters: (1 to: aString size) in: aString displayAt: aPoint clippedBy: Display boundingBox rule: Form over fillColor: nil kernDelta: 0 on: (BitBlt current toForm: Display). ! ! !StrikeFontSet methodsFor: 'accessing' stamp: 'yo 5/25/2004 00:02'! ascentOf: aCharacter | encoding f | ((aCharacter isMemberOf: Character) or: [aCharacter leadingChar = 0]) ifTrue: [ ^ (fontArray at: 1) ascent. ]. encoding _ aCharacter leadingChar + 1. [f _ fontArray at: encoding] on: Exception do: [:ex | f _ fontArray at: 1]. f ifNil: [f _ fontArray at: 1]. ^ f ascent. ! ! !StrikeFontSet methodsFor: 'accessing' stamp: 'yo 5/25/2004 00:02'! descentOf: aCharacter | encoding f | ((aCharacter isMemberOf: Character) or: [aCharacter leadingChar = 0]) ifTrue: [ ^ (fontArray at: 1) descent. ]. encoding _ aCharacter leadingChar + 1. [f _ fontArray at: encoding] on: Exception do: [:ex | f _ fontArray at: 1]. f ifNil: [f _ fontArray at: 1]. ^ f descent. ! ! !StrikeFontSet methodsFor: 'accessing' stamp: 'yo 5/24/2004 23:57'! heightOf: aCharacter | encoding f | ((aCharacter isMemberOf: Character) or: [aCharacter leadingChar = 0]) ifTrue: [ ^ (fontArray at: 1) height ]. encoding _ aCharacter leadingChar + 1. [f _ fontArray at: encoding] on: Exception do: [:ex | f _ fontArray at: 1]. f ifNil: [f _ fontArray at: 1]. ^ f height. ! ! !StrikeFontSet methodsFor: 'accessing' stamp: 'yo 5/24/2004 23:57'! widthOf: aCharacter "Answer the width of the argument as a character in the receiver." | encoding f left right charCode | ((aCharacter isMemberOf: Character) or: [aCharacter leadingChar = 0]) ifTrue: [ f _ (fontArray at: 1). charCode _ (aCharacter asciiValue min: f maxAscii) max: f minAscii. ^ (f xTable at: charCode + 2) - (f xTable at: charCode + 1). ]. encoding _ aCharacter leadingChar + 1. charCode _ aCharacter charCode. [f _ fontArray at: encoding] on: Exception do: [:ex | f _ fontArray at: 1]. f ifNil: [f _ fontArray at: 1]. charCode _ (charCode min: f maxAscii) max: f minAscii. left _ (f xTable at: charCode + 1). right _ (f xTable at: charCode + 2). (left < 0 or: [right < 0]) ifTrue: [^ 10] ifFalse: [^ right - left]. ! ! !StrikeFontSet methodsFor: 'displaying' stamp: 'yo 5/19/2004 11:35'! characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta on: aBitBlt "Simple, slow, primitive method for displaying a line of characters. No wrap-around is provided." | ascii encoding destPoint leftX rightX sourceRect xTable noFont f | destPoint _ aPoint. anInterval do: [:i | encoding _ (sourceString at: i) leadingChar + 1. noFont _ false. [f _ fontArray at: encoding] on: Exception do: [:ex | noFont _ true. f _ fontArray at: 1]. f ifNil: [noFont _ true. f _ fontArray at: 1]. ascii _ noFont ifTrue: [$?] ifFalse: [(sourceString at: i) charCode]. (ascii < f minAscii or: [ascii > f maxAscii]) ifTrue: [ascii _ f maxAscii]. xTable _ f xTable. leftX _ xTable at: ascii + 1. rightX _ xTable at: ascii + 2. sourceRect _ leftX@0 extent: (rightX-leftX) @ self height. aBitBlt copyFrom: sourceRect in: f glyphs to: destPoint. destPoint _ destPoint + ((rightX-leftX+kernDelta)@0). "destPoint printString displayAt: 0@(i*20)." ]. ^ destPoint. ! ! !StrikeFontSet methodsFor: 'displaying' stamp: 'yo 5/23/2004 18:54'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo g | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | glyphInfo _ self glyphInfoOf: (aString at: charIndex). g _ glyphInfo first. leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: g. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ^ destPoint. ! ! !StrikeFontSet methodsFor: 'private' stamp: 'yo 5/23/2004 18:53'! glyphInfoOf: aCharacter | index f code leftX | index _ aCharacter leadingChar + 1. fontArray size < index ifTrue: [^ self questionGlyphInfo]. (f _ fontArray at: index) ifNil: [^ self questionGlyphInfo]. code _ aCharacter charCode. ((code between: f minAscii and: f maxAscii) not) ifTrue: [ ^ self questionGlyphInfo. ]. leftX _ f xTable at: code + 1. leftX < 0 ifTrue: [ ^ self questionGlyphInfo. ]. ^ Array with: f glyphs with: leftX with: (f xTable at: code + 2). ! ! !StrikeFontSet methodsFor: 'private' stamp: 'yo 5/23/2004 18:53'! questionGlyphInfo | f ascii | f _ fontArray at: 1. ascii _ $? asciiValue. ^ Array with: f glyphs with: (f xTable at: ascii + 1) with: (f xTable at: ascii + 2). ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 5/25/2004 11:05'! createExternalFontFileForUnicodeJapanese: fileName " StrikeFontSet createExternalFontFileForUnicodeJapanese: 'uJapaneseFont.out'. " | file array f installDirectory | file _ FileStream newFileNamed: fileName. installDirectory _ Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory _ installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array _ Array with: (StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'Japanese10' overrideWith: 'shnmk12.bdf') with: ((StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'Japanese12' overrideWith: 'shnmk14.bdf') "fixAscent: 14 andDescent: 1 head: 1") with: ((StrikeFont newForJapaneseFromEFontBDFFile: 'b16.bdf' name: 'Japanese14' overrideWith: 'shnmk16.bdf') "fixAscent: 16 andDescent: 4 head: 4") with: (StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'Japanese18' overrideWith: 'kanji24.bdf'). TextConstants at: #forceFontWriting put: true. f _ ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! ! !TTCFont methodsFor: 'accessing' stamp: 'yo 5/24/2004 20:16'! fallbackFont: aFontSetOrNil fallbackFont _ aFontSetOrNil. ! ! !TTCFont methodsFor: 'public' stamp: 'yo 5/24/2004 20:19'! widthOf: aCharacter "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." | f assoc | aCharacter charCode > 255 ifTrue: [ fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter]. ^ 1 ]. assoc _ self cache at: (aCharacter charCode + 1). assoc ifNotNil: [ ^ assoc value width ]. f _ self computeForm: aCharacter. self at: aCharacter put: f. ^ f width. ! ! !TTCFont methodsFor: 'friend' stamp: 'yo 5/20/2004 14:33'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint ascii form | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | ascii _ (aString at: charIndex) asciiValue bitAnd: 16rFFFFFF. ((ascii between: self minAscii and: self maxAscii) not) ifTrue: [ ascii _ self maxAscii]. form _ self formOf: (aString at: charIndex). aBitBlt sourceForm: form. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: 0 @ 0. aBitBlt width: form width. aBitBlt height: form height. aBitBlt copyBits. destPoint _ destPoint + (form width + kernDelta @ 0). ]. ^ destPoint. ! ! !TTCFont methodsFor: 'private' stamp: 'yo 5/24/2004 20:48'! formOf: char | f assoc code | char charCode > 255 ifTrue: [ fallbackFont ifNotNil: [ ^ fallbackFont formOf: char ]. code _ $? charCode ] ifFalse: [ code _ char charCode ]. assoc _ self cache at: (code + 1). assoc ifNotNil: [ (assoc key = foregroundColor) ifTrue: [ ^ assoc value. ]. ]. f _ self computeForm: char. self at: char put: f. ^ f. ! ! !TTCFontSet methodsFor: 'as yet unclassified' stamp: 'yo 5/20/2004 14:33'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint font form encoding ascii | destPoint _ aPoint. startIndex to: stopIndex do: [:charIndex | encoding _ (aString at: charIndex) leadingChar + 1. ascii _ (aString at: charIndex) charCode. font _ fontArray at: encoding. ((ascii between: font minAscii and: font maxAscii) not) ifTrue: [ ascii _ font maxAscii]. form _ font formOf: (aString at: charIndex). aBitBlt sourceForm: form. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: 0 @ 0. aBitBlt width: form width. aBitBlt height: form height. aBitBlt copyBits. destPoint _ destPoint + (form width + kernDelta @ 0). ]. ^ destPoint. ! ! !TextStyle methodsFor: 'accessing' stamp: 'yo 5/24/2004 22:52'! printOn: aStream super printOn: aStream. (fontArray first isMemberOf: StrikeFontSet) ifTrue: [ aStream space; nextPutAll: self defaultFont familySizeFace first; nextPutAll: '(FontSet)' ] ifFalse: [ aStream space; nextPutAll: self defaultFont familySizeFace first ] ! ! AbstractFont subclass: #TTCFont instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont' classVariableNames: 'NamesToIndexes Scale' poolDictionaries: '' category: 'Multilingual-Display'! StrikeFontSet removeSelector: #characters:in:displayAt:clippedBy:rule:fillColor:! StrikeFontSet removeSelector: #characters:in:displayAt:clippedBy:rule:fillColor:kernDelta:! StrikeFontSet removeSelector: #checkCharacter:! StrikeFontSet removeSelector: #fontLeftAndRightFor:! StrikeFontSet removeSelector: #isValid:! StrikeFontSet removeSelector: #leftAndRighOrNilFor:! StrikeFontSet removeSelector: #questionData! StrikeFont class removeSelector: #setupfallbackFont! StrikeFont removeSelector: #characters:in:displayAt:clippedBy:rule:fillColor:! StrikeFont removeSelector: #characters:in:displayAt:clippedBy:rule:fillColor:kernDelta:! StrikeFont removeSelector: #defaultFontSet:! AbstractFont subclass: #StrikeFont instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont' classVariableNames: 'DefaultStringScanner' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! 'From Squeak3.7beta of ''1 April 2004'' [latest update: #5905] on 26 May 2004 at 11:26:20 pm'! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 5/26/2004 23:26'! override: chars with: otherFileName ranges: pairArray transcodingTable: table additionalRange: additionalRange | other rangeStream currentRange newChars code form u newArray j | other _ BDFFontReader readOnlyFileNamed: otherFileName. rangeStream _ ReadStream on: pairArray. currentRange _ rangeStream next. newChars _ PluggableSet new. newChars hashBlock: [:elem | (elem at: 2) hash]. newChars equalBlock: [:a :b | (a at: 2) = (b at: 2)]. other readChars do: [:array | code _ array at: 2. code hex printString displayAt: 0@0. code > currentRange last ifTrue: [ [rangeStream atEnd not and: [currentRange _ rangeStream next. currentRange last < code]] whileTrue. rangeStream atEnd ifTrue: [ newChars addAll: chars. ^ newChars. ]. ]. (code between: currentRange first and: currentRange last) ifTrue: [ form _ array at: 1. form ifNotNil: [ j _ array at: 2. u _ table at: (((j // 256) - 33 * 94 + ((j \\ 256) - 33)) + 1). u ~= -1 ifTrue: [ array at: 2 put: u. newChars add: array. additionalRange do: [:e | e first = (array at: 2) ifTrue: [ newArray _ array clone. newArray at: 2 put: e second. newChars add: newArray ]. ] ]. ]. ]. ]. self error: 'should not reach here'. ! ! !EFontBDFFontReaderForRanges methodsFor: 'as yet unclassified' stamp: 'yo 5/26/2004 14:43'! readRanges: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end | form _ encoding _ bbx _ nil. self initialize. self readAttributes. height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. (properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [ pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. ] ifFalse: [ pointSize _ (ascent + descent) * 72 // 96. ]. maxWidth _ 0. minAscii _ 16r200000. strikeWidth _ 0. maxAscii _ 0. charsNum _ Integer readFromString: (properties at: #CHARS) first. chars _ Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars _ self override: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange. chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)]. charsNum _ chars size. "undefined encodings make this different" chars do: [:array | encoding _ array at: 2. bbx _ array at: 3.. width _ bbx at: 1. maxWidth _ maxWidth max: width. minAscii _ minAscii min: encoding. maxAscii _ maxAscii max: encoding. strikeWidth _ strikeWidth + width. ]. glyphs _ Form extent: strikeWidth@height. blt _ BitBlt toForm: glyphs. start _ ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min. end _ ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3. "xRange _ Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))." "xTable _ XTableForUnicodeFont new ranges: xRange." xTable _ SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. lastAscii _ start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form _ (chars at: i) first. encoding _ (chars at: i) second. bbx _ (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue _ xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii _ encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret _ Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 5/25/2004 14:32'! findMaximumLessThan: f in: array array size to: 1 by: -1 do: [:i | f height >= (array at: i) height ifTrue: [^ array at: i]. ]. ^ array first. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 5/25/2004 15:10'! installExternalFontFileName6: fileName inDir: dir encoding: encoding encodingName: aString textStyleName: styleName | array oldStyle arrayOfFS fs fonts newFonts | array _ (ReferenceStream on: (dir readOnlyFileNamed: fileName)) next. TextConstants at: aString asSymbol put: array. oldStyle _ TextConstants at: styleName asSymbol. arrayOfFS _ oldStyle fontArray. arrayOfFS _ (1 to: arrayOfFS size) collect: [:i | fs _ arrayOfFS at: i. fonts _ fs fontArray. encoding + 1 > fonts size ifTrue: [ newFonts _ Array new: encoding + 1. newFonts replaceFrom: 1 to: fonts size with: fonts startingAt: 1. newFonts at: encoding + 1 put: (self findMaximumLessThan: newFonts first in: array). fs initializeWithFontArray: newFonts. ] ifFalse: [ fonts at: encoding + 1 put: (self findMaximumLessThan: fonts first in: array). ]. fs. ]. TextConstants at: styleName asSymbol put: (TextStyle fontArray: arrayOfFS). oldStyle becomeForward: (TextConstants at: styleName asSymbol). ! ! !UTF8TextConverter methodsFor: 'conversion' stamp: 'yo 6/29/2004 16:13'! nextFromStream: aStream | character1 value1 character2 value2 unicode character3 value3 character4 value4 | aStream isBinary ifTrue: [^ aStream basicNext]. character1 _ aStream basicNext. character1 isNil ifTrue: [^ nil]. value1 _ character1 asciiValue. value1 <= 127 ifTrue: [ "1-byte character" currentCharSize _ 1. ^ character1 ]. (value1 bitAnd: 16rE0) = 192 ifTrue: [ "2-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. value2 _ character2 asciiValue. currentCharSize _ 2. ^ Unicode value: ((value1 bitAnd: 31) bitShift: 6) + (value2 bitAnd: 63). ]. (value1 bitAnd: 16rF0) = 224 ifTrue: [ "3-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil "self errorMalformedInput"]. value2 _ character2 asciiValue. character3 _ aStream basicNext. character3 = nil ifTrue: [^ nil "self errorMalformedInput"]. value3 _ character3 asciiValue. unicode _ ((value1 bitAnd: 15) bitShift: 12) + ((value2 bitAnd: 63) bitShift: 6) + (value3 bitAnd: 63). currentCharSize _ 3. ]. (value1 bitAnd: 16rF8) = 240 ifTrue: [ "4-byte character" character2 _ aStream basicNext. character2 = nil ifTrue: [^ nil " self errorMalformedInput"]. value2 _ character2 asciiValue. character3 _ aStream basicNext. character3 = nil ifTrue: [^ nil "self errorMalformedInput"]. value3 _ character3 asciiValue. character4 _ aStream basicNext. character4 = nil ifTrue: [^ nil "self errorMalformedInput"]. value4 _ character4 asciiValue. currentCharSize _ 4. unicode _ ((value1 bitAnd: 16r7) bitShift: 18) + ((value2 bitAnd: 63) bitShift: 12) + ((value3 bitAnd: 63) bitShift: 6) + (value4 bitAnd: 63). ]. unicode isNil ifTrue: [^ nil]. unicode > 16r10FFFD ifTrue: [^ nil]. unicode = 16rFEFF ifTrue: [^ self nextFromStream: aStream]. ^ Unicode value: unicode. ! ! !UTF8TextConverter reorganize! ('conversion' nextFromStream: nextPut:toStream:) ('as yet unclassified' leadingChar) ('accessing' currentCharSize forceToEncodingTag forceToEncodingTag:) ! 'From Squeak3.7beta of ''1 April 2004'' [latest update: #5923] on 28 May 2004 at 12:05:59 pm'! !HostFont methodsFor: 'accessing' stamp: 'yo 5/28/2004 11:59'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX char hasGlyph displayInfo glyphInfo charIndex | destPoint _ aPoint. charIndex _ startIndex. [charIndex <= stopIndex] whileTrue: [ char _ aString at: charIndex. ((hasGlyph _ self hasGlyphFor: char) not and: [fallbackFont notNil]) ifTrue: [ displayInfo _ fallbackFont displayString: aString on: aBitBlt from: charIndex to: stopIndex at: destPoint kern: kernDelta from: self. charIndex _ displayInfo first. destPoint _ displayInfo second. ] ifFalse: [ glyphInfo _ self glyphInfoOf: (hasGlyph ifTrue: [char] ifFalse: [$?]). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ]. ^ Array with: charIndex with: destPoint. ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/28/2004 11:56'! displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo char displayInfo hasGlyph charIndex | destPoint _ aPoint. charIndex _ startIndex. [charIndex <= stopIndex] whileTrue: [ char _ aString at: charIndex. ((hasGlyph _ self hasGlyphFor: char) not and: [fallbackFont notNil]) ifTrue: [ displayInfo _ fallbackFont displayString: aString on: aBitBlt from: charIndex to: stopIndex at: destPoint kern: kernDelta from: self. charIndex _ displayInfo first. destPoint _ displayInfo second. ] ifFalse: [ glyphInfo _ self glyphInfoOf: (hasGlyph ifTrue: [char] ifFalse: [$?]). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). charIndex _ charIndex + 1. ]. ]. ^ Array with: charIndex with: destPoint. ! ! AbstractFont subclass: #StrikeFont instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont charIndex ' classVariableNames: 'DefaultStringScanner ' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! AbstractFont subclass: #StrikeFontSet instanceVariableNames: 'fontArray emphasis derivativeFonts name rIndex ' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Display'! !ParagraphEditor methodsFor: 'parenblinking' stamp: 'yo 5/28/2004 10:17'! dispatchOnCharacter: char with: typeAheadStream "Carry out the action associated with this character, if any. Type-ahead is passed so some routines can flush or use it." | honorCommandKeys | self clearParens. char asciiValue = 13 ifTrue: [ ^ sensor controlKeyPressed ifTrue: [self crWithIndent: typeAheadStream] ifFalse: [self normalCharacter: typeAheadStream]]. ((honorCommandKeys _ Preferences cmdKeysInText) and: [char = Character enter]) ifTrue: [^ self dispatchOnEnterWith: typeAheadStream]. "Special keys overwrite crtl+key combinations - at least on Windows. To resolve this conflict, assume that keys other than cursor keys aren't used together with Crtl." ((self class specialShiftCmdKeys includes: char asciiValue) and: [char asciiValue < 27]) ifTrue: [^ sensor controlKeyPressed ifTrue: [self perform: (ShiftCmdActions at: char asciiValue + 1) with: typeAheadStream] ifFalse: [self perform: (CmdActions at: char asciiValue + 1) with: typeAheadStream]]. "backspace, and escape keys (ascii 8 and 27) are command keys" ((honorCommandKeys and: [sensor commandKeyPressed]) or: [self class specialShiftCmdKeys includes: char asciiValue]) ifTrue: [^ sensor leftShiftDown ifTrue: [self perform: (ShiftCmdActions at: char asciiValue + 1) with: typeAheadStream] ifFalse: [self perform: (CmdActions at: char asciiValue + 1) with: typeAheadStream]]. "the control key can be used to invoke shift-cmd shortcuts" (honorCommandKeys and: [sensor controlKeyPressed]) ifTrue: [^ self perform: (ShiftCmdActions at: char asciiValue + 1) with: typeAheadStream]. (')]}' includes: char) ifTrue: [self blinkPrevParen]. ^ self perform: #normalCharacter: with: typeAheadStream! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/28/2004 11:09'! displayMultiString0: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo | destPoint _ aPoint. startIndex to: stopIndex do: [:cIndex | glyphInfo _ self glyphInfoOf: (aString at: cIndex). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ^ destPoint. ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/28/2004 10:50'! displayMultiString2: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo char displayInfo hasGlyph | destPoint _ aPoint. charIndex _ startIndex. [charIndex <= stopIndex] whileTrue: [ char _ aString at: charIndex. ((hasGlyph _ self hasGlyphFor: char) not and: [fallbackFont notNil]) ifTrue: [ displayInfo _ fallbackFont displayString: aString on: aBitBlt from: charIndex to: stopIndex at: destPoint kern: kernDelta from: self. charIndex _ displayInfo first. destPoint _ displayInfo second. ] ifFalse: [ glyphInfo _ self glyphInfoOf: (hasGlyph ifTrue: [char] ifFalse: [$?]). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). charIndex _ charIndex + 1. ]. ]. ^ Array with: charIndex with: destPoint. ! ! !StrikeFont methodsFor: 'displaying' stamp: 'yo 5/28/2004 11:56'! displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX glyphInfo char displayInfo hasGlyph | destPoint _ aPoint. charIndex _ startIndex. [charIndex <= stopIndex] whileTrue: [ char _ aString at: charIndex. ((hasGlyph _ self hasGlyphFor: char) not and: [fallbackFont notNil]) ifTrue: [ displayInfo _ fallbackFont displayString: aString on: aBitBlt from: charIndex to: stopIndex at: destPoint kern: kernDelta from: self. charIndex _ displayInfo first. destPoint _ displayInfo second. ] ifFalse: [ glyphInfo _ self glyphInfoOf: (hasGlyph ifTrue: [char] ifFalse: [$?]). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). charIndex _ charIndex + 1. ]. ]. ^ Array with: charIndex with: destPoint. ! ! !StrikeFontSet methodsFor: 'displaying' stamp: 'yo 5/28/2004 11:26'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont | destPoint leftX rightX glyphInfo g tag char | destPoint _ aPoint. rIndex _ startIndex. tag _ (aString at: rIndex) leadingChar. "aPoint printString displayAt: 0@0." [rIndex <= stopIndex] whileTrue: [ char _ aString at: rIndex. ((fromFont hasGlyphFor: char) or: [char leadingChar ~= tag]) ifTrue: [^ Array with: rIndex with: destPoint]. glyphInfo _ self glyphInfoOf: char. g _ glyphInfo first. leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: g. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). rIndex _ rIndex + 1. ]. ^ Array with: rIndex with: destPoint. ! ! !HostFont methodsFor: 'accessing' stamp: 'yo 5/28/2004 11:59'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta | destPoint leftX rightX char hasGlyph displayInfo glyphInfo | destPoint _ aPoint. charIndex _ startIndex. [charIndex <= stopIndex] whileTrue: [ char _ aString at: charIndex. ((hasGlyph _ self hasGlyphFor: char) not and: [fallbackFont notNil]) ifTrue: [ displayInfo _ fallbackFont displayString: aString on: aBitBlt from: charIndex to: stopIndex at: destPoint kern: kernDelta from: self. charIndex _ displayInfo first. destPoint _ displayInfo second. ] ifFalse: [ glyphInfo _ self glyphInfoOf: (hasGlyph ifTrue: [char] ifFalse: [$?]). leftX _ glyphInfo second. rightX _ glyphInfo third. aBitBlt sourceForm: glyphInfo first. aBitBlt destX: destPoint x. aBitBlt destY: destPoint y. aBitBlt sourceOrigin: leftX @ 0. aBitBlt width: rightX - leftX. aBitBlt height: self height. aBitBlt copyBits. destPoint _ destPoint + (rightX - leftX + kernDelta @ 0). ]. ]. ^ Array with: charIndex with: destPoint. ! ! AbstractFont subclass: #StrikeFontSet instanceVariableNames: 'fontArray emphasis derivativeFonts name rIndex' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Display'! AbstractFont subclass: #StrikeFont instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont charIndex' classVariableNames: 'DefaultStringScanner' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." LanguageEnvironment initialize. TTCFont scale: 1.0@1.0. StrikeFont setupDefaultFallbackFont. !