'From etoys2.1 of 26 July 2007 [Xlatest update: #X1524] on 30 July 2007 at 5:19:48 pm'!
"Change Set:		gettextFromArray-tak
Date:			30 July 2007
Author:			Takashi Yamamiya

Aggregate gettext keywords from array literals.

With this change set, you strings in an array can be detected by #translatedNoop keyword.
For example:

#(ignore1 (ignore2 'necessary' translatedNoop))
"!


!GetTextExporter2 methodsFor: 'exporting' stamp: 'tak 7/30/2007 13:42'!
appendTranslations: categories 
	self appendStringReceivers: #translated into: categories.
	self appendStringReceivers: #translatedNoop into: categories.
	self appendVocabularies: categories.
! !

!GetTextExporter2 methodsFor: 'exporting' stamp: 'tak 7/30/2007 13:42'!
exportTranslator: translator 
	"Export translation files. the file extention is 'po', or 'pot' if translator is nil "
	"GetTextExporter2 new exportTranslator: NaturalLanguageTranslator current"
	| categories extention |
	categories := Dictionary new.
	self appendTranslations: categories.
	extention := translator
				ifNil: ['.pot']
				ifNotNil: ['.po'].
	categories
		keysAndValuesDo: [:categoryName :value | 
			self
				export: value
				translator: translator
				fileNamed: categoryName asString , extention]! !


!GetTextExporter2 class methodsFor: 'utilities' stamp: 'tak 7/30/2007 13:50'!
coverageStatus
	"self coverageStatus"
	| keys diff |
	keys := self keys.
	diff := NaturalLanguageTranslator allKnownPhrases keys difference: keys.
	Transcript cr; show: 'Detected keywords by GetTextExporter2: ' , keys size printString.
	Transcript cr; show: 'All known phrases in NaturalLanguageTranslator: ' , NaturalLanguageTranslator allKnownPhrases size printString.
	Transcript cr; show: 'Coverage: ' , (keys size / NaturalLanguageTranslator allKnownPhrases size * 100.0) printString , '%'.
	diff inspect! !

!GetTextExporter2 class methodsFor: 'utilities' stamp: 'tak 7/30/2007 13:50'!
keys
	| categories |
	categories := Dictionary new.
	GetTextExporter2 new appendTranslations: categories.
	^ categories values
		inject: Set new
		into: [:set :next | set addAll: next keys;
				 yourself]! !

!GetTextExporter2 class methodsFor: 'utilities' stamp: 'tak 7/30/2007 13:51'!
verifyExport
	"GetTextExporter2 verifyExport"
	"Test whether if gettext exporter works well.
	If you invoke this method, a language named 'dst' will be made. And all
	possible translated words are shown with square bracket like 'XwordX'
	in the language."
	| src dst |
	NaturalLanguageTranslator removeLocaleID: (LocaleID isoString: 'src').
	NaturalLanguageTranslator removeLocaleID: (LocaleID isoString: 'dst').
	src := (LocaleID isoString: 'src') translator.
	dst := (LocaleID isoString: 'dst') translator.
	self keys
		do: [:key | src generics at: key put: 'X' , key , 'X'].
	GetTextExporter2 new exportTranslator: src.
	GetTextImporter import: dst allDirectory: FileDirectory default! !


!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'tak 7/30/2007 15:25'!
stringReceiversWithContext: aSymbol
	"Find string receivers for a symbol.
	Answer a collection of aMethodReference -> {keyword. keyword...}"
	"self new stringReceiversWithContext: #translated"
	| keywords methodReferences messages |
	methodReferences _ SystemNavigation default allCallsOn: aSymbol.
	^ methodReferences inject: OrderedCollection new into: [:list :next |
		messages _ Set new.
		"Find from string literal"
		self search: aSymbol messageNode: next decompile addTo: messages.
		keywords := messages select: [:aMessageNode |
				aMessageNode receiver isMemberOf: LiteralNode]
			thenCollect: [:aMessageNode |
				aMessageNode receiver key].
		"Find from array literal"
		self arraySearch: aSymbol messageNode: next decompile addTo: keywords.
		keywords
			ifNotEmpty: [list add: next -> keywords].
		list]
! !

!TranslatedReceiverFinder methodsFor: 'private' stamp: 'tak 7/30/2007 15:22'!
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! !

!TranslatedReceiverFinder methodsFor: 'private' stamp: 'tak 7/30/2007 15:27'!
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! !