The Trunk: System-fbs.531.mcz

Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.531.mcz

==================== Summary ====================

Name: System-fbs.531
Author: fbs
Time: 18 May 2013, 10:15:41.138 pm
UUID: e58759fd-931d-4b85-92ca-de07260eb39d
Ancestors: System-fbs.530, System-fbs.530

Move localization classes/methods to System-Localization.

=============== Diff against System-fbs.530 ===============

Item was added:
+ NaturalLanguageTranslator subclass: #GetTextTranslator
+ instanceVariableNames: 'moFiles'
+ classVariableNames: 'LocaleDirsForDomain SystemDefaultLocaleDirs UserDefaultLocaleDirs'
+ poolDictionaries: ''
+ category: 'System-Localization'!
+
+ !GetTextTranslator commentStamp: '<historical>' prior: 0!
+ emulation of gettext runtime
+ Known limitation:  
+      currently doesn't support plural forms.
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>addSystemDefaultLocaleDir: (in category 'translation data layout') -----
+ addSystemDefaultLocaleDir: dir
+ "new dir will be put as first"
+   self systemDefaultLocaleDirs addFirst: dir!

Item was added:
+ ----- Method: GetTextTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
+ availableLanguageLocaleIDs
+ "GetTextTranslator availableLanguageLocaleIDs"
+ | ids dirs localeDirForLang directoryNames |
+ ids := Set new.
+ dirs := Set new.
+ dirs addAll: LocaleDirsForDomain values.
+ dirs addAll: self defaultLocaleDirs.
+ dirs do: [:dir |
+ | localesDir |
+ localesDir := FileDirectory on: dir.
+ directoryNames := [localesDir directoryNames] on: InvalidDirectoryError do: [:e | #()].
+ directoryNames
+ do: [:langDirName |
+ | localeID  |
+ localeID := LocaleID posixName: langDirName.
+ localeDirForLang := localesDir directoryNamed: (self langDirNameForLocaleID: localeID).
+ localeDirForLang ifNotNil: [
+ (localeDirForLang fileNamesMatching: '*.mo') ifNotEmpty: [ids add: localeID]
+ ]
+ ].
+ ].
+ ^ids!

Item was added:
+ ----- Method: GetTextTranslator class>>defaultLocaleDirs (in category 'translation data layout') -----
+ defaultLocaleDirs
+ | dirs |
+ dirs := OrderedCollection new.
+ UserDefaultLocaleDirs ifNotNil: [dirs addAll: UserDefaultLocaleDirs].
+ dirs addAll: self systemDefaultLocaleDirs.
+ ^dirs
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>findMOForLocaleID:domain: (in category 'private') -----
+ findMOForLocaleID: id domain: aDomainName
+ | sepa langSubDir path |
+ sepa := FileDirectory slash.
+ langSubDir := self langDirNameForLocaleID: id.
+ (self localeDirsForDomain: aDomainName)
+ do: [:each |
+ path := each , sepa , langSubDir, sepa , (self moNameForDomain: aDomainName).
+ [(FileDirectory default fileExists: path)
+ ifTrue: [^path]] on: InvalidDirectoryError do: [:e | ^nil]].
+ ^nil.!

Item was added:
+ ----- Method: GetTextTranslator class>>initialize (in category 'class initialization') -----
+ initialize
+ SystemDefaultLocaleDirs := OrderedCollection new.
+ UserDefaultLocaleDirs := OrderedCollection new.
+ LocaleDirsForDomain := Dictionary new.!

Item was added:
+ ----- Method: GetTextTranslator class>>langDirNameForLocaleID: (in category 'private') -----
+ langDirNameForLocaleID: id
+ "returns relative path from locale directory to actual directory containing MOs"
+ ^(id posixName) , (FileDirectory slash)  , 'LC_MESSAGES'!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirForDomain: (in category 'translation data layout') -----
+ localeDirForDomain: aDomainName
+ "returns registered localeDirectory for the textdomain. returns nil if not registered"
+ ^LocaleDirsForDomain at: aDomainName ifAbsent: [nil]!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain (in category 'private') -----
+ localeDirsForDomain
+ ^LocaleDirsForDomain ifNil: [LocaleDirsForDomain := Dictionary new]!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain: (in category 'translation data layout') -----
+ localeDirsForDomain: aDomainName
+ "returns collection of locale directories for text domain.  
+ This includes user defined one for the domain, user defaults and system defaults"
+ | dirs dir |
+ dirs := OrderedCollection new.
+ dir := self localeDirForDomain: aDomainName.
+ dir ifNotNil: [dirs add: dir].
+ dirs addAll:  self defaultLocaleDirs.
+ ^dirs!

Item was added:
+ ----- Method: GetTextTranslator class>>moNameForDomain: (in category 'private') -----
+ moNameForDomain: domainName
+ ^domainName , '.mo'!

Item was added:
+ ----- Method: GetTextTranslator class>>newForLocaleID: (in category 'instance creation') -----
+ newForLocaleID: id
+ ^self new localeID: id!

Item was added:
+ ----- Method: GetTextTranslator class>>privateStartUp (in category 'class initialization') -----
+ privateStartUp
+ self setupLocaleDirs.
+ self availableLanguageLocaleIDs do: [ :localeID |
+ NaturalLanguageTranslator translators
+ at: localeID
+ put: (self newForLocaleID: localeID).
+ ]!

Item was added:
+ ----- Method: GetTextTranslator class>>setLocaleDir:forDoamin: (in category 'translation data layout') -----
+ setLocaleDir: path forDoamin: aDomainName
+ self LocaleDirsForDomain
+ at: aDomainName
+ put: path.!

Item was added:
+ ----- Method: GetTextTranslator class>>setupLocaleDirs (in category 'translation data layout') -----
+ setupLocaleDirs
+ | dirs sepa localesDirName |
+ sepa := FileDirectory slash.
+ SystemDefaultLocaleDirs := nil.
+ dirs := self systemDefaultLocaleDirs.
+ localesDirName := 'locale'.
+ dirs add:  (SmalltalkImage current imagePath) , sepa , localesDirName.
+ dirs add:  (SmalltalkImage current vmPath) , sepa , localesDirName.
+ ^dirs!

Item was added:
+ ----- Method: GetTextTranslator class>>systemDefaultLocaleDirs (in category 'translation data layout') -----
+ systemDefaultLocaleDirs
+ ^SystemDefaultLocaleDirs ifNil: [SystemDefaultLocaleDirs := OrderedCollection new]
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>userDefaultLocaleDirs (in category 'translation data layout') -----
+ userDefaultLocaleDirs
+ ^UserDefaultLocaleDirs ifNil: [UserDefaultLocaleDirs := OrderedCollection new]
+ !

Item was added:
+ ----- Method: GetTextTranslator>>atRandom (in category 'accessing') -----
+ atRandom
+
+ | v |
+ moFiles ifEmpty: [^ ''].
+ (v := moFiles atRandom value) ifNil: [^ ''].
+ ^ v atRandom.
+ !

Item was added:
+ ----- Method: GetTextTranslator>>domainRegistered: (in category 'accessing') -----
+ domainRegistered: aDomainName
+ "only current translator actually load the MO, to minimize loading time.
+ other translator will load anyway when it goes current"
+ (self class current == self)
+ ifTrue: [self moFileForDomain: aDomainName].
+ !

Item was added:
+ ----- Method: GetTextTranslator>>domainUnregistered: (in category 'accessing') -----
+ domainUnregistered: aDomainName
+ moFiles removeKey: aDomainName ifAbsent: [^self]
+ !

Item was added:
+ ----- Method: GetTextTranslator>>initialize (in category 'initialize-release') -----
+ initialize
+ moFiles := Dictionary new.!

Item was added:
+ ----- Method: GetTextTranslator>>isDomainLoaded: (in category 'accessing') -----
+ isDomainLoaded: aDomainName
+ | mo |
+ mo := moFiles at: aDomainName ifAbsent: [nil].
+ ^mo isNil not.
+ !

Item was added:
+ ----- Method: GetTextTranslator>>loadMOFileForDomain: (in category 'private') -----
+ loadMOFileForDomain: aDomainName
+ | moName |
+ moName := self class findMOForLocaleID: self localeID
+ domain: aDomainName.
+ moName notNil
+ ifTrue: [^MOFile new load: moName
+ localeID: self localeID]
+ ifFalse: [^nil]
+ !

Item was added:
+ ----- Method: GetTextTranslator>>loadMOFiles (in category 'accessing') -----
+ loadMOFiles
+ TextDomainManager allKnownDomains
+ do: [:domainName |
+ self moFileForDomain: domainName
+ ].!

Item was added:
+ ----- Method: GetTextTranslator>>moFileForDomain: (in category 'private') -----
+ moFileForDomain: domainName
+ ^moFiles at: domainName ifAbsentPut: [self loadMOFileForDomain: domainName]!

Item was added:
+ ----- Method: GetTextTranslator>>reloadMOFiles (in category 'accessing') -----
+ reloadMOFiles
+ moFiles := Dictionary new.
+ self loadMOFiles.!

Item was added:
+ ----- Method: GetTextTranslator>>setCurrent (in category 'language switching') -----
+ setCurrent
+ "ensure actual contents of MOs is loaded on switching language"
+ self loadMOFiles!

Item was added:
+ ----- Method: GetTextTranslator>>translate:inDomain: (in category 'translation') -----
+ translate: aString inDomain: aDomainName
+ | mo |
+ mo := self moFileForDomain: aDomainName.
+ ^mo isNil
+ ifTrue: [aString]
+ ifFalse: [mo translationFor: aString]
+ !

Item was added:
+ Object subclass: #MOFile
+ instanceVariableNames: 'localeID fileName isLittleEndian magic revision nStrings originalTableOffset translatedTableOffset hashTableSize hashTableOffset hashTable originalStrings translatedStrings translations'
+ classVariableNames: 'Cr Lf'
+ poolDictionaries: ''
+ category: 'System-Localization'!
+
+ !MOFile commentStamp: '<historical>' prior: 0!
+ Wrapper for MO file of gettext.
+ Known limitation:  
+ currently don't support prural form.
+ translation strings have to be encoded in utf-8.
+
+ Implementation notes:
+ Testing on XO showed emulation of hash search without plugin + on demand loading is slow.
+ The test also showed conversion of utf8 string to Squeak's String is really slow (especially for non-latin language).
+ so in this version, all of original/translated strings are loaded on initiaization,
+ but "translated strings" is left as ByteString on loading time, to reduce loading time.
+ After that the translated string is converted on demand.
+ !

Item was added:
+ ----- Method: MOFile class>>fileName:localeID: (in category 'instance creation') -----
+ fileName: path localeID: id
+ ^self new
+ load:path localeID: id!

Item was added:
+ ----- Method: MOFile class>>initialize (in category 'class initialization') -----
+ initialize
+ Cr := Character cr.
+ Lf := Character lf.
+ !

Item was added:
+ ----- Method: MOFile>>atRandom (in category 'public') -----
+ atRandom
+
+ ^ self translatedString:nStrings atRandom.
+ !

Item was added:
+ ----- Method: MOFile>>fileName (in category 'public') -----
+ fileName
+ ^fileName!

Item was added:
+ ----- Method: MOFile>>fileName: (in category 'public') -----
+ fileName: path
+ fileName := path!

Item was added:
+ ----- Method: MOFile>>hashPjw: (in category 'experimental') -----
+ hashPjw: aString
+ "So called `hashpjw' function by P.J. Weinberger
+     [see Aho/Sethi/Ullman, COMPILERS: Principles, Techniques and Tools,
+     1986, 1987 Bell Telephone Laboratories, Inc.] "
+ | stringSize hash g |
+ stringSize := aString size.
+ hash := 0.
+ 1 to: stringSize do: [:pos |
+ hash := hash bitShift: 4.
+ hash := hash + ((aString at: pos) asInteger).
+ g := hash bitAnd: 16rF0000000.
+ g = 0 ifFalse: [
+ hash := hash  bitXor: (g bitShift: -24).
+ hash := hash bitXor: g.
+ ]
+ ].
+ ^hash.
+ !

Item was added:
+ ----- Method: MOFile>>load1:localeID: (in category 'experimental') -----
+ load1: aFileName localeID: id
+ "CASE1:
+ all of strings are loaded.
+ translation strings are converted to Squeak format on load time.
+ original-string/index pairs are registerd to Dictionary on load time.
+ hash search can't be used"
+ | strm originalTable translatedTable |
+ localeID := id.
+ strm := FileStream readOnlyFileNamed: aFileName.
+ fileName := aFileName.
+ [
+ self loadHeader: strm.
+ originalTable := self loadStringPointers: strm
+ offset: originalTableOffset.
+
+ originalStrings := self loadStrings: strm
+ pointers: originalTable.
+
+ translatedTable := self loadStringPointers: strm
+ offset: translatedTableOffset.
+
+ translatedStrings := self loadStrings: strm
+ pointers: translatedTable
+ encoding: 'utf8'
+ languageEnvironment: (Locale localeID: localeID) languageEnvironment .
+
+ translations := Dictionary new.
+ 1 to: nStrings do: [:index |
+ | key |
+ key := originalStrings at: index.
+ translations at: key put: index.
+ ].
+ originalTable := nil.
+ ] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>load4:localeID: (in category 'experimental') -----
+ load4: aFileName localeID: id
+ "CASE4:
+ all of strings are loaded.
+ loading and conversion of translation strings to Squeak format is executed on initialization time.
+ only hash search can be used"
+ | strm originalTable translatedTable |
+ localeID := id.
+ strm := FileStream readOnlyFileNamed: aFileName.
+ fileName := aFileName.
+ [
+ self loadHeader: strm.
+ self loadHashTable: strm.
+ originalTable := self loadStringPointers: strm
+ offset: originalTableOffset.
+
+ originalStrings := self loadStrings: strm
+ pointers: originalTable.
+
+ translatedTable := self loadStringPointers: strm
+ offset: translatedTableOffset.
+
+ translatedStrings := self loadStrings: strm
+ pointers: translatedTable
+ encoding: 'utf-8'
+ languageEnvironment: (Locale localeID: localeID) languageEnvironment .
+ ] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>load:localeID: (in category 'public') -----
+ load: aFileName localeID: id
+ "all of original/translated strings are loaded.
+ but conversion of translation string (in utf-8 bytestring) to Squeak format will be defered.
+ original-string/index pairs are registerd to Dictionary on load time.
+ hash search can't be used"
+ | strm originalTable translatedTable |
+ localeID := id.
+ strm := FileStream readOnlyFileNamed: aFileName.
+ fileName := aFileName.
+ [
+ self loadHeader: strm.
+ originalTable := self loadStringPointers: strm
+ offset: originalTableOffset.
+
+ originalStrings := self loadStrings: strm
+ pointers: originalTable.
+
+ translatedTable := self loadStringPointers: strm
+ offset: translatedTableOffset.
+
+ translatedStrings := self loadStrings: strm
+ pointers: translatedTable.
+
+ translations := Dictionary new: nStrings * 2.  "make too enough room to avoid #grow"
+ 1 to: nStrings do: [:index |
+ | key |
+ key := originalStrings at: index.
+ translations at: key put: index.
+ ].
+ originalStrings := nil.
+ ] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>loadHashTable: (in category 'experimental') -----
+ loadHashTable: strm
+ | entry |
+ hashTable := IntegerArray  ofSize: hashTableSize.
+ strm binary.
+ strm position: hashTableOffset.
+ 1 to: hashTableSize do: [:index |
+ entry := self nextInt32From: strm.
+ hashTable at:  index put: entry.
+ ]!

Item was added:
+ ----- Method: MOFile>>loadHeader: (in category 'private') -----
+ loadHeader: strm
+ strm binary.
+ magic :=  strm uint32.
+ magic = 16rDE120495
+ ifTrue: [isLittleEndian := true]
+ ifFalse: [
+ magic = 16r950412DE
+ ifTrue: [isLittleEndian := false]
+ ifFalse: [ self error: 'invalid MO']
+ ].
+ revision := self nextInt32From: strm.
+ nStrings := self nextInt32From: strm.
+ originalTableOffset := self nextInt32From: strm.
+ translatedTableOffset := self nextInt32From: strm.
+ hashTableSize := self nextInt32From: strm.
+ hashTableOffset := self nextInt32From: strm.
+ !

Item was added:
+ ----- Method: MOFile>>loadString:pointer:length: (in category 'private') -----
+ loadString: strm pointer: top  length: len
+ | str |
+ str := ByteString new: len.
+ strm position:  top.
+ strm nextInto: str.
+ ^str replaceAll: Lf with: Cr.
+ !

Item was added:
+ ----- Method: MOFile>>loadStringPointers:offset: (in category 'private') -----
+ loadStringPointers: strm offset: tableOffset
+ "returns tupple {arrayOfOffsetToString  arrayOfLengthOfString}"
+ | offsetTable lenTable len offset tupple |
+ offsetTable := IntegerArray new: nStrings.
+ lenTable := IntegerArray new: nStrings.
+ strm binary.
+ strm position: tableOffset.
+ 1 to: nStrings do: [:index |
+ len := self nextInt32From: strm.
+ offset := self nextInt32From: strm.
+ offsetTable at: index put: offset.
+ lenTable at: index put: len.
+ ].
+ tupple := Array new: 2.
+ tupple at: 1 put: offsetTable.
+ tupple at: 2 put:  lenTable.
+ ^tupple
+ !

Item was added:
+ ----- Method: MOFile>>loadStrings:pointers: (in category 'private') -----
+ loadStrings: strm pointers: table
+ ^self loadStrings: strm pointers: table encoding: nil languageEnvironment: nil
+ !

Item was added:
+ ----- Method: MOFile>>loadStrings:pointers:encoding:languageEnvironment: (in category 'private') -----
+ loadStrings: strm pointers: tupple encoding: encodingName languageEnvironment: env
+ | strings rawStr str offsetTable lenTable |
+ offsetTable :=  tupple first.
+ lenTable := tupple second.
+ strings := Array new: nStrings.
+ 1 to: nStrings do: [:index |
+ rawStr := self loadString: strm
+ pointer:  (offsetTable at: index)
+ length: (lenTable at: index).
+ str := encodingName isNil ifTrue: [rawStr]
+ ifFalse: [ encodingName = 'utf8'
+ ifTrue: [rawStr utf8ToSqueak applyLanguageInfomation: env]
+ ifFalse: [self error: 'this encoding isn''t supported']
+ ].
+ strings at: index put: str.
+ ].
+ ^strings.!

Item was added:
+ ----- Method: MOFile>>nextInt32From: (in category 'private') -----
+ nextInt32From: strm
+ ^isLittleEndian
+ ifTrue: [^strm nextLittleEndianNumber: 4]
+ ifFalse: [^strm nextInt32]!

Item was added:
+ ----- Method: MOFile>>originalString: (in category 'private') -----
+ originalString: index
+ ^originalStrings at: index.
+ !

Item was added:
+ ----- Method: MOFile>>searchByDictionary: (in category 'public') -----
+ searchByDictionary: aString
+ | index |
+ index := translations at: aString ifAbsent: [^nil].
+ ^self translatedString: index
+
+ !

Item was added:
+ ----- Method: MOFile>>searchByHash: (in category 'experimental') -----
+ searchByHash: aString
+ | hashValue nstr index incr key |
+ hashValue :=  self hashPjw: aString.
+ incr := 1 + (hashValue \\ (hashTableSize -2)).
+ index := (hashValue \\ hashTableSize) .
+ [ nstr := (hashTable at: index +1 ).
+ nstr = 0 ifTrue: [^nil].
+ key := self originalString: nstr.
+ key = aString ifTrue: [^self translatedString: nstr].
+ index >= (hashTableSize - incr)
+ ifTrue: [index := index - (hashTableSize - incr)  ]
+ ifFalse:[index := index + incr].
+ ] doWhileTrue: true.!

Item was added:
+ ----- Method: MOFile>>testSearchByDictionary (in category 'experimental') -----
+ testSearchByDictionary
+ InternalTranslator allKnownPhrases
+ do: [:each |
+ self searchByDictionary: each
+ ].
+ !

Item was added:
+ ----- Method: MOFile>>testSearchByHash (in category 'experimental') -----
+ testSearchByHash
+ InternalTranslator allKnownPhrases
+ do: [:each |
+ self searchByHash: each
+ ].
+ !

Item was added:
+ ----- Method: MOFile>>translateByHash: (in category 'experimental') -----
+ translateByHash: aString
+ | trans |
+ trans := self searchByHash: aString.
+ trans isNil ifTrue: [^aString]
+ ifFalse: [^trans].
+ !

Item was added:
+ ----- Method: MOFile>>translatedString: (in category 'private') -----
+ translatedString: index
+ "KNOWN PROBLEM: conversion is executed everytimes this method called"
+ | str |
+ str := translatedStrings at: index.
+
+ ^str utf8ToSqueak applyLanguageInfomation: (Locale localeID: localeID) languageEnvironment.
+ !

Item was added:
+ ----- Method: MOFile>>translationFor: (in category 'public') -----
+ translationFor: aString
+ | |
+ aString size = 0 ifTrue: [^ '']. "Gettext header"
+ ^ (self searchByDictionary: aString) ifNil: [aString]
+ !

Item was added:
+ ----- Method: String>>literalStringsDo: (in category '*System-Localization') -----
+ literalStringsDo: aBlock
+ "Assuming the receiver receiver is a literal, evaluate aBlock with all Strings (but not Symbols) within it."
+ aBlock value: self!

Item was added:
+ ----- Method: String>>translated (in category '*System-Localization') -----
+ translated
+ "answer the receiver translated to the default language"
+ | translation |
+ translation := self
+ translatedTo: LocaleID current
+ inDomain: (TextDomainManager domainOfMethod: thisContext sender method).
+ self == translation ifTrue: [^self translatedInAllDomains].
+ ^translation!

Item was added:
+ ----- Method: String>>translatedIfCorresponds (in category '*System-Localization') -----
+ translatedIfCorresponds
+ "answer the receiver translated to the default language only if
+ the receiver begins and ends with an underscore (_)"
+ ^ ('_*_' match: self)
+ ifTrue: [(self copyFrom: 2 to: self size - 1) translated]
+ ifFalse: [self]!

Item was added:
+ ----- Method: String>>translatedInAllDomains (in category '*System-Localization') -----
+ translatedInAllDomains
+ | translation |
+ "Transcript show: self printString, ' translatedInAllDomains'; cr."
+ TextDomainManager allKnownDomains do: [:domain |
+ translation := self translatedTo: LocaleID current inDomain: domain.
+ self = translation ifFalse: [^translation]
+ ].
+ ^self!

Item was added:
+ ----- Method: String>>translatedInAnyDomain (in category '*System-Localization') -----
+ translatedInAnyDomain
+ | translation |
+ Transcript show: self printString, ' translatedInAnyDomain'; cr.
+ TextDomainManager allKnownDomains do: [:domain |
+ translation := self translatedInDomain: domain.
+ self = translation ifFalse: [^translation]].
+ ^self!

Item was added:
+ ----- Method: String>>translatedInDomain: (in category '*System-Localization') -----
+ translatedInDomain: aDomainName
+ | translation |
+ translation := self translatedTo: LocaleID current inDomain: aDomainName.
+ self == translation ifTrue: [^self translatedInAllDomains].
+ ^translation
+ !

Item was added:
+ ----- Method: String>>translatedInDomain:or: (in category '*System-Localization') -----
+ translatedInDomain: aDomainName or: anotherDomainName
+ | translation |
+ translation := self translatedTo: LocaleID current inDomain: aDomainName.
+ self == translation ifTrue: [^self translatedInDomain: anotherDomainName].
+ ^translation
+ !

Item was added:
+ ----- Method: String>>translatedNoop (in category '*System-Localization') -----
+ translatedNoop
+ "This is correspondence gettext_noop() in gettext."
+ ^ self!

Item was added:
+ ----- Method: String>>translatedTo: (in category '*System-Localization') -----
+ translatedTo: localeID
+ "answer the receiver translated to the given locale id"
+ ^ self translatedTo: localeID inDomain: (TextDomainManager domainOfMethod: thisContext sender method).!

Item was added:
+ ----- Method: String>>translatedTo:inDomain: (in category '*System-Localization') -----
+ translatedTo: localeID inDomain: aDomainName
+ "answer the receiver translated to the given locale id in the textdomain"
+
+ ^ NaturalLanguageTranslator translate: self
+ toLocaleID: localeID
+ inDomain:  aDomainName!

Item was added:
+ Object subclass: #TextDomainManager
+ instanceVariableNames: ''
+ classVariableNames: 'ClassCategories Classes DefaultDomain DomainInfos LoneClasses Packages'
+ poolDictionaries: ''
+ category: 'System-Localization'!
+ TextDomainManager class
+ instanceVariableNames: 'defaultDomain'!
+
+ !TextDomainManager commentStamp: 'fbs 5/12/2013 13:04' prior: 0!
+ I manage mapping from class category to textdomain.
+
+ Class variables:
+  ClassCategories IdentityDictionary -- classCategory -> domainName
+  Classes IdentityDictionary -- class name (a Symbol) -> domainName   (a cache only!!)
+  DefaultDomain String -- the default domain name
+  DomainInfos Dictionary -- domainName -> a TextDomainInfo
+  LoneClasses IdentityDictionary -- class name (a Symbol) -> domainName.  For classes whose entire category are not all in the same domain (BookMorph and QuickGuideMorph)
+
+ TextDomainManager registerCategoryPrefix: 'DrGeoII' domain: 'DrGeoII'.
+ TextDomainManager unregisterDomain: 'DrGeoII'.
+
+ TextDomainManager registerClass: #QuickGuideMorph domain: 'quickguides'.
+ TextDomainManager registerClass: #QuickGuideHolderMorph  domain: 'quickguides'.
+ !
+ TextDomainManager class
+ instanceVariableNames: 'defaultDomain'!

Item was added:
+ ----- Method: TextDomainManager class>>allKnownDomains (in category 'accessing') -----
+ allKnownDomains
+ "Every package has its own text domain now so it's not necessary to keep a registry of all domains, we can simply return all the packages in the image.
+ PROBLEM: If a package doesn't contain translations, it won't have a mo file but the GetTextTranslator will try to load it anyway. This happens when we switch languages. So far I tested it briefly and it seems to work..."
+ ^PackageOrganizer default packageNames , {'Etoys-Tiles'}!

Item was added:
+ ----- Method: TextDomainManager class>>allMethodsWithTranslations (in category 'accessing') -----
+ allMethodsWithTranslations
+ "Look for #translated calls"
+ | methodsWithTranslations |
+ methodsWithTranslations := TranslatedReceiverFinder new stringReceiversWithContext: #translated.
+ methodsWithTranslations := methodsWithTranslations ,
+ (TranslatedReceiverFinder new stringReceiversWithContext: #translatedNoop).
+
+ methodsWithTranslations := methodsWithTranslations collect: [:each | each key compiledMethod].
+
+ "Look for Etoys tiles and vocabularies"
+ methodsWithTranslations := methodsWithTranslations , (EToyVocabulary allPhrasesWithContextToTranslate collect: [:r |
+ (MethodReference new setStandardClass: r second methodSymbol: r third) compiledMethod]).
+
+ ^methodsWithTranslations!

Item was added:
+ ----- Method: TextDomainManager class>>cleanUp: (in category 'private') -----
+ cleanUp: aggressive
+ aggressive ifTrue: [self clearAllDomains].!

Item was added:
+ ----- Method: TextDomainManager class>>clearAllDomains (in category 'private') -----
+ clearAllDomains
+ "TextDomainManager clearAllDomains"
+ self systemNavigation allBehaviorsDo:
+ [:b|
+ b selectorsAndMethodsDo:
+ [:s :m |
+ m removeProperty: self textDomainProperty ifAbsent: []]]!

Item was added:
+ ----- Method: TextDomainManager class>>defaultDomain (in category 'accessing') -----
+ defaultDomain
+ "I'm not sure we still need a default domain. AFAIK the default domain will only be used when no domain is found. In that case, wouldn't it be better to just look for a translation in all domains?"
+ ^defaultDomain!

Item was added:
+ ----- Method: TextDomainManager class>>defaultDomain: (in category 'accessing') -----
+ defaultDomain: aDomainName
+ defaultDomain := aDomainName!

Item was added:
+ ----- Method: TextDomainManager class>>domainForClass: (in category 'accessing') -----
+ domainForClass: aClass
+ ^'etoys'!

Item was added:
+ ----- Method: TextDomainManager class>>domainForPackage: (in category 'accessing') -----
+ domainForPackage: aPackageInfo
+ "Package names and text domains are synonyms now"
+ ^aPackageInfo name!

Item was added:
+ ----- Method: TextDomainManager class>>domainOfMethod: (in category 'accessing') -----
+ domainOfMethod: aCompiledMethod
+ ^ aCompiledMethod
+ propertyValueAt: self textDomainProperty
+ ifAbsent: [self updateDomainOfMethod: aCompiledMethod] !

Item was added:
+ ----- Method: TextDomainManager class>>initialize (in category 'class initialization') -----
+ initialize
+ " TextDomainManager initialize "
+ self defaultDomain: 'Etoys'!

Item was added:
+ ----- Method: TextDomainManager class>>textDomainProperty (in category 'private') -----
+ textDomainProperty
+ ^#textDomain!

Item was added:
+ ----- Method: TextDomainManager class>>updateDomainOfAllMethodsWithTranslations (in category 'private') -----
+ updateDomainOfAllMethodsWithTranslations
+ self allMethodsWithTranslations do: [:each |
+ self updateDomainOfMethod: each]!

Item was added:
+ ----- Method: TextDomainManager class>>updateDomainOfMethod: (in category 'private') -----
+ updateDomainOfMethod: aCompiledMethod
+ "First it looks for the package of the method reference (using
+ the PackageOrganizer: deadly slow). If the method doesn't
+ belong to any package it uses the default domain. Finally it
+ stores the text domain of the method using a method
+ property, this way we gain performance the next time we
+ translate the same method because we avoid the use of
+ PackageOrganizer. Have I mentioned it is really slow? :)"
+ | package |
+ package := PackageOrganizer default
+ packageOfMethod: aCompiledMethod methodReference
+ ifNone: [].
+ ^ aCompiledMethod
+ propertyValueAt: self textDomainProperty
+ put: (package isNil
+ ifTrue: [TextDomainManager defaultDomain]
+ ifFalse: [package name])!

Item was added:
+ Object subclass: #TranslatedReceiverFinder
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'System-Localization'!

Item was added:
+ ----- Method: TranslatedReceiverFinder class>>browseNonLiteralReceivers (in category 'utilities') -----
+ browseNonLiteralReceivers
+ "TranslatedReceiverFinder browseNonLiteralReceivers"
+ SystemNavigation default
+ browseMessageList: self new nonLiteralReceivers  asSortedCollection
+ name: 'Non literal receivers of #translated'
+ autoSelect: 'translated'!

Item was added:
+ ----- Method: TranslatedReceiverFinder class>>makeJapaneseTranslationFile (in category 'as yet unclassified') -----
+ makeJapaneseTranslationFile
+ | t n |
+ NaturalLanguageTranslator initializeKnownPhrases.
+ t := TranslatedReceiverFinder new senders.
+ n := NaturalLanguageTranslator
+ localeID: (LocaleID isoLanguage: 'ja').
+ t
+ do: [:w |
+ NaturalLanguageTranslator registerPhrase: w.
+ self
+ at: w
+ ifPresent: [:k | n phrase: w translation: k]].
+ n saveToFileNamed: 'ja.translation'!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>arraySearch:fromArray:addTo: (in category 'private') -----
+ arraySearch: aSymbol fromArray: anArray addTo: aCollection
+ "Find literals ahead of aSymbol from arrays in the method."
+ "BUG: it can handle just one occurrence"
+ "self new arraySearch: #hello fromArray: #(ignore (ignore detected
+ hello ignore)) addTo: Set new"
+ | index |
+ (index := anArray identityIndexOf: aSymbol) > 1
+ ifTrue: [aCollection add: (anArray at: index - 1) asString].
+ (anArray
+ select: [:each | each isMemberOf: Array])
+ do: [:each | self
+ arraySearch: aSymbol
+ fromArray: each
+ addTo: aCollection].
+ ^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>arraySearch:messageNode:addTo: (in category 'private') -----
+ arraySearch: aSymbol messageNode: aParseNode addTo: aCollection
+ "Find literals ahead of aSymbol from arrays in the method."
+ "self new arraySearch: #hello messageNode: (self
+ decompile: #arraySearch:messageNode:addTo:) addTo: Set new"
+ self flag: #(#ignore #detected #hello ).
+ ((aParseNode isMemberOf: LiteralNode)
+ and: [aParseNode key isMemberOf: Array])
+ ifTrue: [self
+ arraySearch: aSymbol
+ fromArray: aParseNode key
+ addTo: aCollection].
+ (aParseNode notNil
+ and: [aParseNode isLeaf not])
+ ifTrue: [aParseNode getAllChildren
+ do: [:child | self
+ arraySearch: aSymbol
+ messageNode: child
+ addTo: aCollection]].
+ ^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>findWordsWith:in: (in category 'accessing') -----
+ findWordsWith: aSymbol in: aMethodReference
+ "Find words for translation with the symbol in a method. See
+ LanguageEditorTest >>testFindTranslatedWords"
+ "| message |
+ message := MethodReference new setStandardClass: Morph class
+ methodSymbol: #supplementaryPartsDescriptions.
+ self new findWordsWIth: #translatedNoop in: message"
+ | messages keywords aParseNode |
+ aParseNode := aMethodReference decompile.
+ "Find from string literal"
+ messages := Set new.
+ self
+ search: aSymbol
+ messageNode: aParseNode
+ addTo: messages.
+ keywords := OrderedCollection new.
+ messages
+ select: [:aMessageNode | aMessageNode receiver isMemberOf: LiteralNode]
+ thenDo: [:aMessageNode | aMessageNode receiver key
+ literalStringsDo: [:literal | keywords add: literal]].
+ "Find from array literal"
+ self
+ arraySearch: aSymbol
+ messageNode: aParseNode
+ addTo: keywords.
+ ^ keywords!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>nonLiteralReceivers (in category 'accessing') -----
+ nonLiteralReceivers
+ "self new nonLiteralReceivers"
+ | receivers |
+ "Answer method references of non literal senders of #translated"
+ ^ (SystemNavigation default allCallsOn: #translated)
+ select: [:message |
+ receivers := OrderedCollection new.
+ self search: #translated messageNode: message decompile addTo: receivers.
+ receivers
+ anySatisfy: [:each | (each receiver isMemberOf: LiteralNode) not]]!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>search:messageNode:addTo: (in category 'private') -----
+ search: aSymbol messageNode: aParseNode addTo: aCollection
+ "self new search: #translated messageNode: (Project decompile: #updateLocaleDependentsWithPreviousSupplies:gently:) addTo: OrderedCollection new"
+
+ ((aParseNode isMemberOf: MessageNode)
+ and: [(aParseNode selector isMemberOf: SelectorNode)
+ and: [aParseNode selector key = aSymbol]])
+ ifTrue: [aCollection add: aParseNode].
+ (aParseNode notNil
+ and: [aParseNode isLeaf not])
+ ifTrue: [aParseNode getAllChildren
+ do: [:child | self
+ search: aSymbol
+ messageNode: child
+ addTo: aCollection]].
+ ^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchBlockNode:addTo: (in category 'as yet unclassified') -----
+ searchBlockNode: aBlockNode addTo: aCollection
+
+ aBlockNode statements do: [:e |
+ (e isMemberOf: MessageNode) ifTrue: [self searchMessageNode: e addTo: aCollection].
+ (e isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: e addTo: aCollection].
+ ].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchMessageNode:addTo: (in category 'as yet unclassified') -----
+ searchMessageNode: aMessageNode addTo: aCollection
+
+ ((aMessageNode receiver isMemberOf: LiteralNode) and: [(aMessageNode selector isMemberOf: SelectorNode) and: [aMessageNode selector key = #translated]]) ifTrue: [
+ aCollection add: aMessageNode receiver key.
+ ].
+
+ (aMessageNode receiver isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMessageNode receiver addTo: aCollection].
+ (aMessageNode receiver isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMessageNode receiver addTo: aCollection].
+ (aMessageNode receiver isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMessageNode receiver addTo: aCollection].
+
+ aMessageNode arguments do: [:a |
+ (a isMemberOf: BlockNode) ifTrue: [self searchBlockNode: a addTo: aCollection].
+ (a isMemberOf: MessageNode) ifTrue: [self searchMessageNode: a addTo: aCollection].
+ (a isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: a addTo: aCollection].
+ ].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchMethodNode:addTo: (in category 'as yet unclassified') -----
+ searchMethodNode: aMethodNode addTo: aCollection
+
+ (aMethodNode block isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMethodNode block addTo: aCollection].
+ (aMethodNode block isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMethodNode block addTo: aCollection].
+ (aMethodNode block isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMethodNode block addTo: aCollection].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchReturnNode:addTo: (in category 'as yet unclassified') -----
+ searchReturnNode: aReturnNode addTo: aCollection
+
+ (aReturnNode expr isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aReturnNode expr addTo: aCollection].
+ (aReturnNode expr isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aReturnNode expr addTo: aCollection].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>senders (in category 'as yet unclassified') -----
+ senders
+
+ | m o |
+ m := SystemNavigation default allCallsOn: #translated.
+ m := m collect: [:e |
+ e classIsMeta ifTrue: [
+ (Smalltalk at: e classSymbol) class decompile: e methodSymbol.
+ ] ifFalse: [
+ (Smalltalk at: e classSymbol) decompile: e methodSymbol.
+ ]
+ ].
+
+ o := OrderedCollection new.
+ m do: [:e | self searchMethodNode: e addTo: o].
+ ^ o sort
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceivers (in category 'accessing') -----
+ stringReceivers
+ "TranslatedReceiverFinder new stringReceivers"
+ | stringReceivers messages |
+ messages := Set new.
+ (SystemNavigation default allCallsOn: #translated)
+ do: [:message | self search: #translated messageNode: message decompile addTo: messages].
+ stringReceivers := messages
+ select: [:each | each receiver isMemberOf: LiteralNode]
+ thenCollect: [:each | each receiver key].
+ ^ stringReceivers asArray sort!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceiversWithContext (in category 'accessing') -----
+ stringReceiversWithContext
+ | mrs results rr cls mn t o |
+ mrs := SystemNavigation default allCallsOn: #translated.
+ results := OrderedCollection new.
+ mrs do: [:mr |
+ rr := OrderedCollection new.
+ cls := Smalltalk at: mr classSymbol.
+ rr add: cls category.
+ rr add: mr classSymbol.
+ rr add: mr methodSymbol.
+ mr classIsMeta ifTrue: [
+ mn :=  cls class decompile: mr methodSymbol.
+ ] ifFalse: [
+ mn := cls decompile: mr methodSymbol.
+ ].
+ o := OrderedCollection new.
+ t := Set new.
+ self searchMessageNode: mn addTo: t.
+ t do: [ :te |
+ (te receiver isMemberOf: LiteralNode) ifTrue: [
+    o add: te receiver key.
+ ].
+ ].
+ o ifNotEmpty: [
+ rr add: o.
+ results add: rr.
+ ].
+ ].
+ ^ results.
+
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceiversWithContext: (in category 'accessing') -----
+ stringReceiversWithContext: aSymbol
+ "Find string receivers for a symbol.
+ Answer a collection of aMethodReference -> {keyword. keyword...}"
+ "self new stringReceiversWithContext: #translated"
+ | keywords methodReferences |
+ methodReferences := SystemNavigation default allCallsOn: aSymbol.
+ ^ methodReferences inject: OrderedCollection new into: [:list :next |
+ keywords := self findWordsWith: aSymbol in: next.
+ keywords
+ ifNotEmpty: [list add: next -> keywords].
+ list]
+ !