Smalltalk › Squeak › Squeak - Dev

The Trunk: GetText-Richo.14.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

The Trunk: GetText-Richo.14.mcz

Edgar J. De Cleene uploaded a new version of GetText to project The Trunk:
http://source.squeak.org/trunk/GetText-Richo.14.mcz

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

Name: GetText-Richo.14
Author: Richo
Time: 18 April 2011, 1:35:48 pm
UUID: fe80068b-c439-cb4e-b5bb-a659673f623b
Ancestors: GetText-Richo.13

* Exporting a GetTextTranslator was giving a DNU because GetTextExporter>>translationFor:in: was asking "translator translations".
* TextDomainManager class>>allKnownDomains was ignoring the special domain "Etoys-Tiles"

==================== Snapshot ====================

SystemOrganization addCategory: #'GetText-Editor'!
SystemOrganization addCategory: #'GetText-Localization'!

Object subclass: #GetTextExporter
instanceVariableNames: 'stream'
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Editor'!

!GetTextExporter commentStamp: '<historical>' prior: 0!
Export translations to gettext format divided into categories.

"Export gettext template files"
GetTextExporter new exportTemplate.

"Export translation files for current locale"
GetTextExporter new exportTranslator: (InternalTranslator newLocaleID: LocaleID current).

"Export all gettext template and po files."
GetTextExporter exportAll.

!

----- Method: GetTextExporter class>>coverageStatus (in category 'utilities') -----
coverageStatus
"self coverageStatus"
| keys diff |
keys := self keys.
diff := InternalTranslator allKnownPhrases keys difference: keys.
Transcript cr; show: 'Detected keywords by GetTextExporter2: ' , keys size printString.
Transcript cr; show: 'All known phrases in InternalTranslator: ' , InternalTranslator allKnownPhrases size printString.
Transcript cr; show: 'Coverage: ' , (keys size / InternalTranslator allKnownPhrases size * 100.0) printString , '%'.
diff inspect!

----- Method: GetTextExporter class>>exportAll (in category 'utilities') -----
exportAll
"GetTextExporter2 exportAll"
self new exportTemplate.
InternalTranslator availableLanguageLocaleIDs
do: [:each | self new exportTranslator: each translator]!

----- Method: GetTextExporter class>>exportTemplate (in category 'utilities') -----
exportTemplate
"GetTextExporter2 exportTemplate"
self new exportTemplate.!

----- Method: GetTextExporter class>>keys (in category 'utilities') -----
keys
| categories |
categories := Dictionary new.
self new appendTranslations: categories.
^ categories values
inject: Set new
into: [:set :next | set addAll: next keys;
yourself]!

----- Method: GetTextExporter class>>listAllHelp (in category 'utilities') -----
listAllHelp
"self listAllHelp"
| spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp |
oCatalog := Dictionary new.
Morph withAllSubclasses
do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin)
ifTrue: [spec := aClass descriptionForPartsBin.
oCatalog at: spec formalName put: spec documentation]].
Morph withAllSubclasses
do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions)
ifTrue: [specs := aClass supplementaryPartsDescriptions.
specs
do: [:each | oCatalog at: each formalName put: each documentation]]].
flap := Dictionary new.
flapSelectors := #(#defaultsQuadsDefiningPlugInSuppliesFlap #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap #defaultsQuadsDefiningScriptingFlap ).
flapSelectors
do: [:selector |
specs := Flaps perform: selector.
specs
do: [:each | flap at: each third put: each fourth]].
allKeys := oCatalog keys intersection: flap keys.
allKeys asArray sort
do: [:each |
oCatalogHelp := oCatalog
at: each
ifAbsent: [''].
flapHelp := flap
at: each
ifAbsent: [''].
oCatalogHelp = flapHelp
ifFalse: [Transcript cr; show: 'Name: ' , each.
Transcript cr; show: 'O: ' , oCatalogHelp.
Transcript cr; show: 'F: ' , flapHelp.
Transcript cr.

]]!

----- Method: GetTextExporter class>>verifyExport (in category 'utilities') -----
verifyExport
"Same as #verifyMsgID: but it writes / reads .po files actually"
"GetTextExporter2 verifyExport"
"InternalTranslator removeLocaleID: (LocaleID isoString: 'test-US')"
| src dst localeID |
localeID := LocaleID isoString: 'test-US'.
self verifyMsgID: localeID.
src := localeID translator.
self new exportTranslator: src.
InternalTranslator removeLocaleID: localeID.
dst := localeID translator.
GetTextImporter import: dst allDirectory: FileDirectory default!

----- Method: GetTextExporter class>>verifyMsgID: (in category 'utilities') -----
verifyMsgID: localeID
"GetTextExporter2 verifyMsgID: (LocaleID isoString: 'test-US')"
"InternalTranslator removeLocaleID: (LocaleID isoString: 'test-US')"
"Test gettext keyword extract function without file I/O.
A language named <langName> will be made. And
all possible translated words are shown with extra X charactor like
'XwordX' in the language."
| src |
InternalTranslator removeLocaleID: localeID.
src := localeID translator.
self keys
do: [:key | src generics at: key put: 'X' , key , 'X']!

----- Method: GetTextExporter>>appendStringReceivers:into: (in category 'private') -----
appendStringReceivers: aSymbol into: domains
| literals references domainName methodReference keywords found |

found := TranslatedReceiverFinder new stringReceiversWithContext: aSymbol.
found do: [ :assoc |
methodReference := assoc key.
keywords := assoc value.
domainName := (PackageOrganizer default packageOfMethod: methodReference ifNone: [nil]).
domainName := domainName isNil ifTrue: [TextDomainManager defaultDomain] ifFalse: [domainName name].
literals _ domains at: domainName ifAbsentPut: [Dictionary new].
keywords do: [ :literal |
references _ literals at: literal ifAbsentPut: [OrderedCollection new].
references add: methodReference.
].
].

!

----- Method: GetTextExporter>>appendTranslations: (in category 'exporting') -----
appendTranslations: domains
self appendStringReceivers: #translated into: domains.
self appendStringReceivers: #translatedNoop into: domains.
self appendVocabularies: domains.
!

----- Method: GetTextExporter>>appendVocabularies: (in category 'private') -----
appendVocabularies: domains
| literalsForDomain references domainName methodReference |

EToyVocabulary allPhrasesWithContextToTranslate do: [ :r |
methodReference := (MethodReference new setStandardClass: (r second) methodSymbol: (r third)).
"domainName _ self getTextDomainForPackage: (PackageOrganizer default packageOfMethod: methodReference)".
domainName := 'Etoys-Tiles'.
literalsForDomain _ domains at: domainName ifAbsentPut: [Dictionary new].
r fourth do: [ :literal |
references _ literalsForDomain at: literal ifAbsentPut: [OrderedCollection new].
references add: methodReference.
].
].
!

----- Method: GetTextExporter>>createExtraInformation (in category 'private') -----
createExtraInformation
| extras |
extras := OrderedCollection new.
#(
'Language name as you''d like it to appear in the Languages menu' 'Language-Name'
'Directionality of language' 'Language-Direction'
) pairsDo: [:first :second |
extras add: (Array with: '' with: first with: second).
].
^ extras!

----- Method: GetTextExporter>>createHeaders (in category 'private') -----
createHeaders
| headers |
headers := OrderedCollection new.
headers add: 'Project-Id-Version' -> 'eToys'.
headers add: 'POT-Creation-Date' -> self currentDateAndTime.
headers add: 'PO-Revision-Date' -> self currentDateAndTime.
headers add: 'Last-Translator' -> ''.
headers add: 'Language-Team' -> ''.
headers add: 'MIME-Version' -> '1.0'.
headers add: 'Content-Type' -> ('text/plain; charset=', stream converter class encodingNames first).
headers add: 'Content-Transfer-Encoding' -> '8bit'.
headers add: 'X-Etoys-SystemVersion' -> (SystemVersion current asString).
^ headers!

----- Method: GetTextExporter>>currentDateAndTime (in category 'private') -----
currentDateAndTime
^ String
streamContents: [:aStream |
aStream nextPutAll: Date today yyyymmdd;
space.
Time now
print24: true
showSeconds: false
on: aStream.
aStream nextPutAll: '-0000']!

----- Method: GetTextExporter>>dirNameCategory:translator: (in category 'exporting') -----
dirNameCategory: category translator: translator
"Answer a file name for the category. Make one if it is not exist yet.
Make template file name if translator is nil"
"self new dirNameCategory: 'Morphic-Scripting Support' translator:
NaturalLanguageTranslator current"
"self new dirNameCategory: 'Morphic-Scripting Support' translator: nil"
| safeCategory fileName dirName pathName |
safeCategory := category copyReplaceAll: ' ' with: '_'.
fileName := translator
ifNil: [safeCategory , '.pot']
ifNotNil: [translator localeID posixName , '.po'].
dirName := (safeCategory findTokens: '-')
inject: 'po'
into: [:aString :next | aString , FileDirectory slash , next].
pathName := dirName , FileDirectory slash , fileName.
(FileDirectory default directoryNamed: dirName) assureExistence.
^ pathName!

----- Method: GetTextExporter>>dirNameDomain:translator: (in category 'exporting') -----
dirNameDomain: domain translator: translator
"Answer a file name for the domain. Make one if it is not exist yet.
Make template file name if translator is nil"
"self new dirNameDomain: 'etoys' translator:
NaturalLanguageTranslator current"
"self new dirNameDomain: 'etoys' translator: nil"
| fileName dirName pathName |
"safeCategory := category copyReplaceAll: ' ' with: '_'."
fileName := domain,
(translator
ifNil: ['.pot']
ifNotNil: ['.po']).
dirName := 'po', FileDirectory slash,
(translator
ifNil: ['templates']
ifNotNil: [translator localeID posixName]).
pathName := dirName , FileDirectory slash , fileName.
(FileDirectory default directoryNamed: dirName) assureExistence.
^ pathName!

----- Method: GetTextExporter>>export:translator:domain: (in category 'private') -----
export: literals translator: translator domain: domainName
| fileName |
"Export a gettext file in a category. literals is a dictionary of keyword -> #(MethodReference...) in the textDomain."
fileName := self dirNameDomain: domainName translator: translator.
[stream := FileStream forceNewFileNamed: fileName.
stream lineEndConvention: #lf.
stream converter: UTF8TextConverter new.
self exportHeader: domainName.
domainName = TextDomainManager defaultDomain
ifTrue: [self exportInformation: self createExtraInformation].
self exportBody: literals translator: translator]
ensure: [stream close]!

----- Method: GetTextExporter>>exportBody:translator: (in category 'file out') -----
exportBody: literals translator: translator
"Export a gettext file body. literals is a dictionary of keyword ->
#(MethodReference...) in the textDomain."
"Build {sortKey. comment. msgid } to optimize sorting (getting category is
too slow).
If there are two or more methods for a mgsid, only first method
(alphabetical) is used for sorting."
| sorted msgid sortedMethods category sortKey comment triplets commentUnderLined |
triplets := literals associations
collect: [:assoc |
msgid := assoc key.
sortedMethods := assoc value asArray sort.
category := (Smalltalk at: sortedMethods first classSymbol) category asString.
sortKey := category , ',' , sortedMethods first printString , ',' , msgid.
comment := (sortedMethods
collect: [:each | each actualClass asString , '>>' , each methodSymbol asString])
inject: category
into: [:result :methodName | result , ',' , methodName].
"Replace white spaces to _ because gettext tool might
replace a space to a new line some times, and it makes
difficult to take a diff."
commentUnderLined := comment copyReplaceAll: ' ' with: '_'.
Array
with: sortKey
with: commentUnderLined
with: msgid].
"Sort and output the words"
sorted := triplets
sort: [:a :b | a first <= b first].
sorted
do: [:triplet |
comment := triplet second.
msgid := triplet third.
self exportRecordHeader: comment.
self
exportPhrase: msgid
translation: (self translationFor: msgid in: translator)]!

----- Method: GetTextExporter>>exportHeader: (in category 'private') -----
exportHeader: domainName
| headers |
self exportTag: 'msgid' msg: ''.
self exportTag: 'msgstr' msg: ''.
headers := self createHeaders.
headers add: 'X-Etoys-Domain' -> domainName.
headers do: [:each | self exportHeaderLineKey: each key value: each value].
stream cr; cr!

----- Method: GetTextExporter>>exportHeaderLineKey:value: (in category 'private') -----
exportHeaderLineKey: keyString value: valueString
stream nextPut: $";
nextPutAll: keyString;
nextPut: $:;
space;
nextPutAll: valueString;
nextPutAll: '\n';
nextPut: $";
cr.!

----- Method: GetTextExporter>>exportInformation: (in category 'private') -----
exportInformation: anOrderedCollection
anOrderedCollection do: [:each |
self exportRecordHeader: each second.
self exportPhrase: each third translation: ''].
stream cr.!

----- Method: GetTextExporter>>exportPhrase:translation: (in category 'private') -----
exportPhrase: phraseString translation: translationString
| normalizedTrans tmp transStartsWithCR transEndsWithCR|
phraseString isEmpty
ifTrue: [^ self].
self exportTag: 'msgid' msg: phraseString.
translationString size = 0 ifTrue: [
normalizedTrans _ ''
] ifFalse: [
transEndsWithCR _ translationString last = (Character cr).
phraseString last = (Character cr) ifTrue: [
transEndsWithCR ifTrue: [
normalizedTrans _ translationString
] ifFalse: [
normalizedTrans _ translationString , String cr
]
] ifFalse: [
transEndsWithCR ifTrue: [
normalizedTrans _ translationString allButLast
] ifFalse: [
normalizedTrans _ translationString
]
].
transStartsWithCR _ normalizedTrans first = (Character cr).
phraseString first = (Character cr) ifTrue: [
transStartsWithCR ifFalse: [
tmp _ (Character cr asString) , normalizedTrans.
normalizedTrans _ tmp.
]
] ifFalse: [
transStartsWithCR ifTrue: [
normalizedTrans _ normalizedTrans allButFirst
]
]
].
self exportTag: 'msgstr' msg: normalizedTrans.
stream cr!

----- Method: GetTextExporter>>exportRecordHeader: (in category 'private') -----
exportRecordHeader: context
stream
nextPutAll: '#: ';
nextPutAll: context;
cr.!

----- Method: GetTextExporter>>exportTag:msg: (in category 'private') -----
exportTag: tag msg: aString
| pos end line |
(aString indexOf: Character cr)
= 0
ifTrue: [self exportTag: tag singleLine: aString]
ifFalse: [self exportTag: tag singleLine: ''.
pos := 1.
end := 0.
[end < aString size]
whileTrue: [end := aString indexOf: Character cr startingAt: pos.
end = 0
ifTrue: [end := aString size].
line := aString copyFrom: pos to: end.
stream nextPut: $";

nextPutAll: (self formatString: line);
nextPut: $";
cr.
pos := end + 1]]!

----- Method: GetTextExporter>>exportTag:singleLine: (in category 'private') -----
exportTag: tag singleLine: aString
stream nextPutAll: tag.
stream space.
stream nextPut: $".
stream
nextPutAll: (self formatString: aString).
stream nextPut: $".
stream cr!

----- Method: GetTextExporter>>exportTemplate (in category 'exporting') -----
exportTemplate
"GetTextExporter2 new exportTemplate"
self exportTranslator: nil!

----- Method: GetTextExporter>>exportTranslator: (in category 'exporting') -----
exportTranslator: translator
"Export translation files. the file extention is 'po', or 'pot' if translator is nil "
"GetTextExporter2 new exportTranslator: NaturalLanguageTranslator current "
| domains |
domains := Dictionary new.
self appendTranslations: domains.
domains
keysAndValuesDo: [:domainName :value |
self
export: value
translator: translator
domain: domainName]!

----- Method: GetTextExporter>>formatReplacements (in category 'private') -----
formatReplacements
| replacements |
replacements := OrderedCollection new.
replacements add: '\' -> '\\'.
replacements add: String cr -> '\n'.
replacements add: String tab -> '\t'.
replacements add: '"' -> '\"'.
^ replacements!

----- Method: GetTextExporter>>formatString: (in category 'private') -----
formatString: aString
| result |
result := aString.
self formatReplacements
do: [:each | result := result copyReplaceAll: each key with: each value].
^ result!

----- Method: GetTextExporter>>getTextDomainForPackage: (in category 'as yet unclassified') -----
getTextDomainForPackage: aPackageInfo
^TextDomainManager domainForPackage: aPackageInfo!

----- Method: GetTextExporter>>stream (in category 'accessing') -----
stream
^ stream!

----- Method: GetTextExporter>>stream: (in category 'accessing') -----
stream: aStream
stream := aStream!

----- Method: GetTextExporter>>translationFor:in: (in category 'private') -----
translationFor: aKey in: translator
| translation |
translator ifNil: [^ ''].
TextDomainManager allKnownDomains do: [:domain |
translation := translator translate: aKey inDomain: domain.
aKey = translation ifFalse: [^translation]
].
^ aKey!

Object subclass: #GetTextInterchange
instanceVariableNames: 'language stream'
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Editor'!

GetTextInterchange subclass: #GetTextImporter
instanceVariableNames: 'msgId msgStr state'
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Editor'!

!GetTextImporter commentStamp: 'tak 10/24/2007 11:23' prior: 0!
GetTextImporter load gettext po file into a InternalTranslator.

GetTextImporter new importID: (LocaleID isoString: 'lang-name') fileNamed: 'lang.po'
!

----- Method: GetTextImporter class>>cleanUpUnnecessaryPhrases (in category 'utilities') -----
cleanUpUnnecessaryPhrases
| keys refuse replaceBlock reader writer char result |
"GetTextImporter cleanUpUnnecessaryPhrases"
""
"Collect wrong phrases"
keys := InternalTranslator allKnownPhrases copy keys.
refuse := Set new.
"replaceBlock value: 'te\\nst'."
replaceBlock := [:aString |
reader := aString readStream.
writer := '' writeStream.
[reader atEnd]
whileFalse: [char := reader next.
(char = $\
and: [reader peek = $\])
ifFalse: [writer nextPut: char]].
writer contents].
keys
do: [:each |
result := replaceBlock value: each.
(result ~= each
and: [keys includes: result])
ifTrue: [refuse add: each].
result := GetTextImporter new formatString: each.
(result ~= each
and: [keys includes: result])
ifTrue: [refuse add: each]].
""
"Remove from translated"
InternalTranslator cachedTranslations
do: [:each | refuse
do: [:key | each translations
removeKey: key
ifAbsent: []]].
""
"Remove from untranslated"
refuse
do: [:key | InternalTranslator allKnownPhrases
removeKey: key
ifAbsent: []]!

----- Method: GetTextImporter class>>import:allDirectory: (in category 'utilities') -----
import: translator allDirectory: aFileDirectory
"self import: NaturalLanguageTranslator current allDirectory:
FileDirectory default"
| fileName targetFile |
fileName := translator localeID posixName , '.po'.
(FileDirectory default directoryNamed: 'po')
withAllSubdirectoriesCollect: [:each | (each fileExists: fileName)
ifTrue: [targetFile := each fullNameFor: fileName.
self new import: translator fileNamed: targetFile]]!

----- Method: GetTextImporter class>>importAll (in category 'utilities') -----
importAll
"GetTextImporter importAll"
"Import all gettext files on po/. Only registered language is imported"
InternalTranslator cachedTranslations
do: [:translator | self import: translator allDirectory: FileDirectory default]!

----- Method: GetTextImporter>>appendId: (in category 'parsing') -----
appendId: aString
msgId := msgId , aString!

----- Method: GetTextImporter>>appendStr: (in category 'parsing') -----
appendStr: aString
msgStr := msgStr , aString!

----- Method: GetTextImporter>>formatString: (in category 'private') -----
formatString: aString
"
self assert: (GetTextImporter new formatString: 'test') = 'test'.
self assert: (GetTextImporter new formatString: 'te\nst') = ('te', String cr, 'st').
self assert: (GetTextImporter new formatString: 'te\\nst') = ('te\nst').
self assert: (GetTextImporter new formatString: 'te\\st') = ('te\st').
self assert: (GetTextImporter new formatString: 'te\st') = ('te\st').
"
| reader writer char |
reader := aString readStream.
writer := '' writeStream.
[reader atEnd]
whileFalse: [char := reader next.
(char = $\
and: [reader atEnd not])
ifTrue: [char := reader next.
char caseOf: {
[$n] -> [writer nextPut: Character cr].
[$t] -> [writer nextPut: Character tab].
[$"] -> [writer nextPut: $"].
[$\] -> [writer nextPut: $\]}
otherwise: [writer nextPutAll: {$\. char}]]
ifFalse: [writer nextPut: char]].
^ writer contents!

----- Method: GetTextImporter>>import: (in category 'importing') -----
import: aLanguage
^ self import: aLanguage fileNamed: aLanguage localeID posixName , '.po'!

----- Method: GetTextImporter>>import:fileNamed: (in category 'importing') -----
import: aLanguage fileNamed: fileName
self importID: aLanguage localeID fileNamed: fileName!

----- Method: GetTextImporter>>importID:fileNamed: (in category 'importing') -----
importID: localeID fileNamed: fileName
| currentPlatform |
language := InternalTranslator newLocaleID: localeID.
currentPlatform := Locale currentPlatform.
[Locale
currentPlatform: (Locale localeID: localeID).
[stream := FileStream readOnlyFileNamed: fileName.
stream text.
self parse]
ensure: [stream notNil
ifTrue: [stream close]]]
ensure: [Locale currentPlatform: currentPlatform].
NaturalLanguageTranslator privateStartUp "Actually it is not private no more...".!

----- Method: GetTextImporter>>initialize (in category 'initialize-release') -----
initialize
msgId := ''.
msgStr := ''.
state := nil!

----- Method: GetTextImporter>>parse (in category 'parsing') -----
parse
| size |
size := (stream isKindOf: FileStream)
ifTrue: [stream size]
ifFalse: [1].
ProgressInitiationException
display: 'Importing phrases from a gettext file.'
during: [:bar | [stream atEnd]
whileFalse: [| line |
line := stream upTo: Character linefeed.
self
parseLine: ((line endsWith: String cr)
ifTrue: [line allButLast]
ifFalse: [line]).
bar value: stream position / size]].
self storeTranslation!

----- Method: GetTextImporter>>parseLine: (in category 'parsing') -----
parseLine: lineString
(lineString beginsWith: '"Content-Type:')
ifTrue: [self setContentType: lineString.
^ self].
(lineString beginsWith: '#')
ifTrue: ["do nothing"
^ self].
lineString = ''
ifTrue: [^ self storeTranslation].
(lineString beginsWith: 'msgid')
ifTrue: [state := #appendId:.
self parseMsg: lineString.
^ self].
(lineString beginsWith: 'msgstr')
ifTrue: [state := #appendStr:.
self parseMsg: lineString.
^ self].
self parseMsg: lineString!

----- Method: GetTextImporter>>parseMsg: (in category 'parsing') -----
parseMsg: lineString
| begin end msg |
begin := lineString indexOf: $".
end := lineString lastIndexOf: $".
msg := begin + 1 <= (end - 1)
ifTrue: [lineString copyFrom: begin + 1 to: end - 1]
ifFalse: [''].
state
ifNotNil: [self perform: state with: msg].
^ msg!

----- Method: GetTextImporter>>setContentType: (in category 'parsing') -----
setContentType: lineString
"self new setContentType: 'Content-Type: text/plain; charset=utf-8'"
| reader charSet |
reader := lineString readStream.
reader upTo: $=.
charSet := reader upTo: $\.
stream
converter: (TextConverter newForEncoding: charSet)!

----- Method: GetTextImporter>>storeTranslation (in category 'parsing') -----
storeTranslation
| key |
key := self formatString: msgId.
msgId isEmpty
ifFalse: [InternalTranslator registerPhrase: key.
msgStr isEmpty
ifFalse: [language
rawPhrase: key
translation: (self formatString: msgStr)]].
self initialize!

----- Method: GetTextInterchange>>defaultFileName (in category 'private') -----
defaultFileName
^ language localeID posixName , '.po'!

----- Method: GetTextInterchange>>language: (in category 'accessing') -----
language: translator
language _ translator!

----- Method: GetTextInterchange>>stream (in category 'accessing') -----
stream
^ stream!

----- Method: GetTextInterchange>>stream: (in category 'accessing') -----
stream: aStream
stream _ aStream!

Object subclass: #MOFile
instanceVariableNames: 'localeID fileName isLittleEndian magic revision nStrings originalTableOffset translatedTableOffset hashTableSize hashTableOffset hashTable originalStrings translatedStrings translations'
classVariableNames: 'Cr Lf'
poolDictionaries: ''
category: 'GetText-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.
!

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

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

----- Method: MOFile>>atRandom (in category 'public') -----
atRandom

^ self translatedString:nStrings atRandom.
!

----- Method: MOFile>>fileName (in category 'public') -----
fileName
^fileName!

----- Method: MOFile>>fileName: (in category 'public') -----
fileName: path
fileName _ path!

----- 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.
!

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

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

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

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

----- 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.
!

----- 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.
!

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

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

----- 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.!

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

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

----- Method: MOFile>>searchByDictionary: (in category 'public') -----
searchByDictionary: aString
| index |
index _ translations at: aString ifAbsent: [^nil].
^self translatedString: index

!

----- 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.!

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

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

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

----- 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.
!

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

Object subclass: #TextDomainManager
instanceVariableNames: ''
classVariableNames: 'ClassCategories Classes DefaultDomain DomainInfos LoneClasses Packages'
poolDictionaries: ''
category: 'GetText-Localization'!
TextDomainManager class
instanceVariableNames: 'defaultDomain'!

!TextDomainManager commentStamp: 'tk 1/4/2008 16:08' prior: 0!
I manages 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'!

----- Method: TextDomainManager class>>allKnownDomains (in category 'accessing') -----
allKnownDomains
"Every package has it's 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'}!

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

----- Method: TextDomainManager class>>clearAllDomains (in category 'private') -----
clearAllDomains
SystemNavigation default
allCompiledMethodDo: [:each | each
removeProperty: self textDomainProperty
ifAbsent: []] !

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

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

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

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

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

----- Method: TextDomainManager class>>initialize (in category 'class initialization') -----
initialize
" TextDomainManager initialize "
self defaultDomain: 'Etoys'; clearAllDomains!

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

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

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

Object subclass: #TranslatedReceiverFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Editor'!

----- 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'!

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

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

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

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

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

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

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

!

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

NaturalLanguageTranslator subclass: #GetTextTranslator
instanceVariableNames: 'moFiles'
classVariableNames: 'LocaleDirsForDomain SystemDefaultLocaleDirs UserDefaultLocaleDirs'
poolDictionaries: ''
category: 'GetText-Localization'!

!GetTextTranslator commentStamp: '<historical>' prior: 0!
emulation of gettext runtime
Known limitation:
currently doesn't support plural forms.
!

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

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

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

----- 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.!

----- Method: GetTextTranslator class>>initialize (in category 'class initialization') -----
initialize
SystemDefaultLocaleDirs _ OrderedCollection new.
UserDefaultLocaleDirs _ OrderedCollection new.
LocaleDirsForDomain _ Dictionary new.!

----- 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'!

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

----- Method: GetTextTranslator class>>localeDirsForDomain (in category 'private') -----
localeDirsForDomain
^LocaleDirsForDomain ifNil: [LocaleDirsForDomain _ Dictionary new]!

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

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

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

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

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

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

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

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

----- Method: GetTextTranslator>>atRandom (in category 'accessing') -----
atRandom

| v |
moFiles ifEmpty: [^ ''].
(v := moFiles atRandom value) ifNil: [^ ''].
^ v atRandom.
!

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

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

----- Method: GetTextTranslator>>initialize (in category 'initialize-release') -----
initialize
moFiles _ Dictionary new.!

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

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

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

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

----- Method: GetTextTranslator>>reloadMOFiles (in category 'accessing') -----
reloadMOFiles
moFiles _ Dictionary new.
self loadMOFiles.!

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

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

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

----- Method: String>>translated (in category '*gettext') -----
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!

----- Method: String>>translatedIfCorresponds (in category '*gettext') -----
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]!

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

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

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

----- Method: String>>translatedNoop (in category '*gettext') -----
translatedNoop
"This is correspondence gettext_noop() in gettext."
^ self!

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

----- Method: String>>translatedTo:inDomain: (in category '*gettext') -----
translatedTo: localeID inDomain: aDomainName
"answer the receiver translated to the given locale id in the textdomain"

^ NaturalLanguageTranslator translate: self
toLocaleID: localeID
inDomain: aDomainName!