[squeak-dev] The Inbox: System-fbs.530.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 12 15:17:37 UTC 2013


Frank Shearar uploaded a new version of System to project The Inbox:
http://source.squeak.org/inbox/System-fbs.530.mcz

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

Name: System-fbs.530
Author: fbs
Time: 12 May 2013, 4:16:05.2 pm
UUID: 0c39b9de-0ac3-49cb-95a9-33b0754b780d
Ancestors: System-fbs.527

Move localization classes/methods to System-Localization.

=============== Diff against System-fbs.527 ===============

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]
+ !



More information about the Squeak-dev mailing list