[Pkg] The Trunk: GetText-Richo.14.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Mar 14 22:27:42 UTC 2012

Edgar J. De Cleene uploaded a new version of GetText to project The Trunk:

==================== 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') -----
	"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') -----
	"GetTextExporter2 exportAll"
	self new exportTemplate.
	InternalTranslator availableLanguageLocaleIDs
		do: [:each | self new exportTranslator: each translator]!

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

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

----- Method: GetTextExporter class>>listAllHelp (in category 'utilities') -----
	"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.
						do: [:each | oCatalog at: each formalName put: each documentation]]].
	flap := Dictionary new.
	flapSelectors := #(#defaultsQuadsDefiningPlugInSuppliesFlap #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap #defaultsQuadsDefiningScriptingFlap ).
		do: [:selector | 
			specs := Flaps perform: selector.
				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') -----
	"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') -----
	| 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') -----
	| 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') -----
	^ String
		streamContents: [:aStream | 
			aStream nextPutAll: Date today yyyymmdd;
			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, 
							ifNil: ['.pot']
							ifNotNil: ['.po']).
	dirName := 'po', FileDirectory slash, 
										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: '_'.
						with: sortKey
						with: commentUnderLined
						with: msgid].
	"Sort and output the words"
	sorted := triplets
				sort: [:a :b | a first <= b first].
		do: [:triplet | 
			comment := triplet second.
			msgid := triplet third.
			self exportRecordHeader: comment.
				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: $:;
		 nextPutAll: valueString;
		 nextPutAll: '\n';
		 nextPut: $";

----- 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
		nextPutAll: '#: ';
		nextPutAll: context;

----- 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: $";
					pos := end + 1]]!

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

----- Method: GetTextExporter>>exportTemplate (in category 'exporting') -----
	"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.
		keysAndValuesDo: [:domainName :value |
				export: value
				translator: translator
				domain: domainName]!

----- Method: GetTextExporter>>formatReplacements (in category 'private') -----
	| 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!

----- 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') -----
	| 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].
		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"
		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') -----
	"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.
		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') -----
	msgId := ''.
	msgStr := ''.
	state := nil!

----- Method: GetTextImporter>>parse (in category 'parsing') -----
	| size |
	size := (stream isKindOf: FileStream)
				ifTrue: [stream size]
				ifFalse: [1].
		display: 'Importing phrases from a gettext file.'
		during: [:bar | [stream atEnd]
				whileFalse: [| line | 
					line := stream upTo: Character linefeed.
						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: [''].
		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: $\.
		converter: (TextConverter newForEncoding: charSet)!

----- Method: GetTextImporter>>storeTranslation (in category 'parsing') -----
	| 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') -----
	^ language localeID posixName , '.po'!

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

----- Method: GetTextInterchange>>stream (in category 'accessing') -----
	^ 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') -----
	Cr := Character cr.
	Lf := Character lf.

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

	^ self translatedString:nStrings atRandom.

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

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

----- Method: MOFile>>load1:localeID: (in category 'experimental') -----
load1: aFileName localeID: id
		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
		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.

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

----- Method: MOFile>>nextInt32From: (in category 'private') -----
nextInt32From: strm
			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') -----
	InternalTranslator allKnownPhrases 
		do: [:each |
			self searchByDictionary: each

----- Method: MOFile>>testSearchByHash (in category 'experimental') -----
	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') -----
"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') -----
"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.


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

----- Method: TextDomainManager class>>defaultDomain (in category 'accessing') -----
"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?"

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

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

----- 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') -----
	"	TextDomainManager initialize	"
	self defaultDomain: 'Etoys'; clearAllDomains!

----- Method: TextDomainManager class>>textDomainProperty (in category 'private') -----

----- Method: TextDomainManager class>>updateDomainOfAllMethodsWithTranslations (in category 'private') -----
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') -----
	"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].
		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.
		search: aSymbol
		messageNode: aParseNode
		addTo: messages.
	keywords := OrderedCollection new.
		select: [:aMessageNode | aMessageNode receiver isMemberOf: LiteralNode]
		thenDo: [:aMessageNode | aMessageNode receiver key
				literalStringsDo: [:literal | keywords add: literal]].
	"Find from array literal"
		arraySearch: aSymbol
		messageNode: aParseNode
		addTo: keywords.
	^ keywords!

----- Method: TranslatedReceiverFinder>>nonLiteralReceivers (in category 'accessing') -----
	"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.
				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') -----
	"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') -----
	| 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.
			ifNotEmpty: [list add: next -> keywords].

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') -----
	"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 | #()].
				do: [:langDirName | 
					| localeID  |
					localeID := LocaleID posixName: langDirName.
					localeDirForLang := localesDir directoryNamed: (self langDirNameForLocaleID: localeID).
					localeDirForLang ifNotNil: [
						(localeDirForLang fileNamesMatching: '*.mo') ifNotEmpty: [ids add: localeID]

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

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

----- Method: GetTextTranslator class>>initialize (in category 'class initialization') -----
	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 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.

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

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

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

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

	| 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') -----
	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') -----
	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') -----
	moFiles _ Dictionary new.
	self loadMOFiles.!

----- Method: GetTextTranslator>>setCurrent (in category 'language switching') -----
	"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') -----
	"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].

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

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

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

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

More information about the Packages mailing list