'From etoys2.1 of 26 July 2007 [Xlatest update: #X1510] on 26 July 2007 at 11:20:57 am'!
"Change Set:		gettextNoopSupport-tak
Date:			24 July 2007
Author:			Takashi Yamamiya

Detect receiver of #translatedNoop to use keywords.
#translatedNoop is same as gettext_noop() in gettext
http://www.gnu.org/software/gettext/manual/html_node/Special-cases.html#Special-cases

GetTextExporter2 new exportTemplate.

You can verify how the gettext exporter works well with:
GetTextExporter2 verifyExport.
After evaluate this expression, change the language to 'dst'
"!

Object subclass: #GetTextExporter2
	instanceVariableNames: 'stream category '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Multilingual-Editor'!

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

GetTextExporter2 new exportTemplate.
GetTextExporter2 new exportTranslator: (NaturalLanguageTranslator availableForLocaleID: LocaleID current).
!


!GetTextExporter2 methodsFor: 'exporting' stamp: 'tak 7/26/2007 11:11'!
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 appendStringReceivers: #translated into: categories.
	self appendStringReceivers: #translatedNoop into: categories.
	self appendVocabularies: categories.
	extention := translator
				ifNil: ['.pot']
				ifNotNil: ['.po'].
	categories
		keysAndValuesDo: [:categoryName :value | 
			self
				export: value
				translator: translator
				fileNamed: categoryName asString , extention]! !

!GetTextExporter2 methodsFor: 'private' stamp: 'tak 7/24/2007 15:05'!
appendStringReceivers: aSymbol into: categories
	| literals references aCategory methodReference keywords found |
	
	found := TranslatedReceiverFinder new stringReceiversWithContext: aSymbol.
	found do: [ :assoc |
		methodReference := assoc key.
		keywords := assoc value.
		aCategory _ self getTextCategoryForClassCategory:
			(Smalltalk at: methodReference classSymbol) category.
		literals _ categories at: aCategory ifAbsentPut: [Dictionary new].
		keywords do: [ :literal |
			references _ literals at: literal ifAbsentPut: [OrderedCollection new].
			references add: methodReference.
		].
	]. 
! !

!GetTextExporter2 methodsFor: 'private' stamp: 'tak 7/24/2007 11:32'!
appendVocabulary: aVocabulary categories: categories
	| aCategory literalsForCategory literals references |
	literals _ aVocabulary allUntranslatedWordings.
	literals addAll: aVocabulary allUntranslatedDocumentations.
	aCategory _ self getTextCategoryForClassCategory: aVocabulary class category.
	literalsForCategory _ categories at: aCategory ifAbsentPut: Dictionary new.
	literals do: [ :literal |
		references _ literalsForCategory at: literal ifAbsentPut: [OrderedCollection new].
		references add: (MethodReference new setStandardClass: aVocabulary class methodSymbol: #initialize)
	].
	! !

!GetTextExporter2 methodsFor: 'private' stamp: 'tak 7/24/2007 11:30'!
export: literals translator: translator fileNamed: fileName 
	[stream := FileStream forceNewFileNamed: fileName.
	stream wantsLineEndConversion: true.
	stream lineEndConvention: #lf.
	stream converter: UTF8TextConverter new.
	self exportHeader.
	literals
		keysAndValuesDo: [:literal :occurs | 
			"(occurs size > 2) ifTrue: [Transcript show: literal; show: '=';
			show: occurs size; cr]."
			occurs
				do: [:occur | self exportRecordHeader: occur classSymbol asString , '>>' , occur methodSymbol asString].
			self
				exportPhrase: literal
				translation: (translator
						ifNil: ['']
						ifNotNil: [translator translations at: literal ifAbsent: ''])]]
		ensure: [stream close]! !


!GetTextExporter2 class methodsFor: 'utilities' stamp: 'tak 7/25/2007 00:13'!
coverageStatus
	"self coverageStatus"
	| categories keys diff |
	categories := Dictionary new.
	GetTextExporter2 new appendStringReceivers: #translated into: categories.
	GetTextExporter2 new appendStringReceivers: #translatedNoop into: categories.
	GetTextExporter2 new appendVocabularies: categories.
	keys := categories values
				inject: Set new
				into: [:set :next | set addAll: next keys;
						 yourself].
	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/25/2007 13:57'!
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.

]]! !

!GetTextExporter2 class methodsFor: 'utilities' stamp: 'tak 7/26/2007 11:18'!
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 |
	src := (LocaleID isoString: 'src') translator.
	dst := (LocaleID isoString: 'dst') translator.
	src class allKnownPhrases keys
		do: [:key | src generics at: key put: 'X' , key , 'X'].
	GetTextExporter2 new exportTranslator: src.
	GetTextImporter import: dst allDirectory: FileDirectory default! !


!String methodsFor: 'translating' stamp: 'tak 7/25/2007 00:01'!
translatedNoop
	"This is correspondence gettext_noop() in gettext."
	^ self! !


!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'tak 7/24/2007 14:52'!
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]]! !

!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'tak 7/24/2007 14:53'!
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! !

!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'tak 7/24/2007 15:52'!
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.
		self search: aSymbol messageNode: next decompile addTo: messages.
		keywords := messages select: [:aMessageNode |
				aMessageNode receiver isMemberOf: LiteralNode]
			thenCollect: [:aMessageNode |
				aMessageNode receiver key].
		keywords
			ifNotEmpty: [list add: next -> keywords].
		list]
! !

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

TranslatedReceiverFinder removeSelector: #searchMessageNode:addTo:!
TranslatedReceiverFinder removeSelector: #stringReceiversByCategory!
Object subclass: #GetTextExporter2
	instanceVariableNames: 'stream'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Multilingual-Editor'!