Merge pull request #1370 from SeasideSt/1369-WAGettextExporter-catalo…

…g-generation-issues

Fix for issue #1369 (improvements for WAGettextExporter)

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/class/newForRBEnvironment..st

@@ -0,0 +1,3 @@
+instance creation
+newForRBEnvironment: aRBEnvironment
+	^ self new rbEnvironment: aRBEnvironment

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/createAndSortTriplets..st

@@ -1,24 +1,17 @@
 exporting
 createAndSortTriplets: translationLiterals
 
-| msgid sortedMethods category sortKey comment commentUnderLined triplets |
-triplets := translationLiterals associations
-				collect: [:assoc | 
-					msgid := assoc key.
-					sortedMethods := assoc value asArray sort.
-					category := (Smalltalk at: sortedMethods first instanceSideParentName) category asString.
-					sortKey := category , ',' , sortedMethods first printString , ',' , msgid.
-					comment := (sortedMethods
-								collect: [:each | each actualClass asString , '>>' , each selector 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].
+	| msgid sortedMethods sortKey comment commentUnderLined triplets |
+	triplets := translationLiterals associations collect: [ :assoc |
+		            msgid := assoc key.
+		            sortedMethods := assoc value asArray sort.
+		            sortKey := sortedMethods first printString , ',', msgid.
+		            comment := String streamContents:[ :str | 
+										sortedMethods 
+											do: [ :each | str nextPutAll: each actualClass asString ; nextPutAll: '>>'; nextPutAll: each selector asString ]
+			                       	separatedBy: [ str nextPut: $, ] ].
+		            "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 ].
 
-^ triplets sort: [ :a :b | a first <= b first ].
+	^ triplets sort: [ :a :b | a first <= b first ]

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/createHeaders.st

@@ -0,0 +1,14 @@
+private
+createHeaders
+	| headers |
+	headers := OrderedCollection new.
+	headers add: 'Project-Id-Version' -> 'Pharo'.
+	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=utf-8').
+	headers add: 'Content-Transfer-Encoding' -> '8bit'.
+	headers add: 'X-Pharo-SystemVersion' -> SystemVersion current asString.
+	^ headers

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/createStringMethodRefDictionary..st

@@ -8,6 +8,6 @@ createStringMethodRefDictionary: methodRefStringAssociations
 		keywords := assoc value.
 		keywords do: [ :literal |
 			| references |
-			references := literals at: literal ifAbsentPut: [ OrderedCollection new ].
+			references := literals at: literal ifAbsentPut: [ Set new ].
 			references add: methodReference ] ].
-	^literals 
+	^ literals 

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/currentDateAndTime.st

@@ -0,0 +1,11 @@
+private
+currentDateAndTime
+	^ String
+		streamContents: [ :aStream | 
+			aStream nextPutAll: Date today yyyymmdd;
+				space.
+			Time now
+				print24: true
+				showSeconds: false
+				on: aStream.
+			aStream nextPutAll: '-0000' ]

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/exportCatalog.st

@@ -1,8 +1,10 @@
 exporting
-exportCatalog 
-	"WAGetTextExporter new exportTemplate"
-	| translationLiterals | "translationLiterals is a dictionary of keyword ->#(MethodReference...)."
+exportCatalog
+
+	| translationLiterals |
 	translationLiterals := self gatherTranslations.
-	[stream := exportFile asFileReference ensureDelete; writeStream.
-	self exportLiteralsDict: translationLiterals]
-		ensure: [stream close]
+	[
+		stream := exportFile asFileReference ensureDelete; writeStream.
+		self exportHeader.
+		self exportLiteralsDict: translationLiterals 
+	] ensure: [ stream close ]

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/exportHeader.st

@@ -0,0 +1,9 @@
+exporting
+exportHeader
+
+	| headers |
+	self exportTag: 'msgid' msg: ''.
+	self exportTag: 'msgstr' msg: ''.
+	headers := self createHeaders.
+	headers do: [ :each | self exportHeaderLineKey: each key value: each value ].
+	stream lf; lf

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/exportHeaderLineKey.value..st

@@ -0,0 +1,11 @@
+exporting
+exportHeaderLineKey: keyString value: valueString
+
+	stream nextPut: $";
+		 nextPutAll: keyString;
+		 nextPut: $:;
+		 space;
+		 nextPutAll: valueString;
+		 nextPutAll: '\n';
+		 nextPut: $";
+		 lf.

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/formatString..st

@@ -1,4 +1,4 @@
-formatting
+private
 formatString: aString
 
 	| result replacements |

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/gatherTranslations.st

@@ -4,5 +4,5 @@ gatherTranslations
 	"Through WATranslatedArgumentsFinder, it finds all 'someString' seasideTranslated 
 	translations, and variations on that (e.g. seasideLazyTranslated) 
 	returns literals, which is a dictionary of 'someString' -> #(MethodReference...)"
-	found := WATranslatedArgumentsFinder new translatedArguments.
+	found := WATranslatedArgumentsFinder new translatedArgumentsIn: rbEnvironment.
 	^ self createStringMethodRefDictionary: found.

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/rbEnvironment..st

@@ -0,0 +1,3 @@
+accessing
+rbEnvironment: aRBBrowserEnvironment
+	rbEnvironment := aRBBrowserEnvironment

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/stream..st

@@ -1,3 +1,3 @@
-formatting
+accessing
 stream: aStream
 	stream := aStream

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/instance/stream.st

@@ -1,3 +1,3 @@
-formatting
+accessing
 stream
 	^ stream

repository/Seaside-Pharo-Gettext-Core.package/WAGetTextExporter.class/properties.json

@@ -7,7 +7,8 @@
 	"classvars" : [ ],
 	"instvars" : [
 		"exportFile",
-		"stream"
+		"stream",
+		"rbEnvironment"
 	],
 	"name" : "WAGetTextExporter",
 	"type" : "normal"

repository/Seaside-Pharo-Gettext-Core.package/WATranslatedArgumentsFinder.class/instance/translatedArguments..st

@@ -1,39 +1,8 @@
 accessing
 translatedArguments: classesToSelect
-	"self new translatedArguments"
-	| searcher currentClass result innerMatchHandler extractFirstArgument extractReceiver classesToSearch |
-	currentClass := WAValueHolder with: nil.
-	result := GROrderedMultiMap new.
-	innerMatchHandler := [ :node :literal |
-		| key |
-		key := (currentClass contents compiledMethodAt: node methodNode selector) asFullRingDefinition.
-		result at: key add: literal value ].
-	extractFirstArgument := [ :node :answer |
-		| firstArgument |
-		firstArgument := node arguments first.
-		firstArgument isLiteralNode ifTrue: [
-			innerMatchHandler value: node value: firstArgument ] ].
-	extractReceiver := [ :node :answer |
-		node receiver isLiteralNode ifTrue: [
-			innerMatchHandler value: node value: node receiver ] ].
-	searcher := RBParseTreeSearcher new
-		matches: '`@object translate: `#string' do: extractFirstArgument;
-		matches: '`@object translate: `#string to: `@arg' do: extractFirstArgument;
-		matches: '`#string seasideTranslated' do: extractReceiver;
-		matches: '`#string seasideLazyTranslated' do: extractReceiver;
-		matches: '`#string seasideTranslatedTo: `@arg' do: extractReceiver;
-		yourself.
-	"Note: for the reimplementation, you can most likely, probably, filter here, see the RBBrowserEnvironment class comment"
-	classesToSearch := (classesToSelect = nil 
-		ifTrue: [ (RBBrowserEnvironment new allNonMetaClasses, RBBrowserEnvironment new allMetaClasses) ]
-		ifFalse: [ (RBBrowserEnvironment new forClasses: classesToSelect) classes ]).
-	classesToSearch do:[:class |
-		class selectors do:[:selector |
-			(searcher canMatchMethod: class >> selector) ifTrue: [
-				| tree |
-				(tree := class parseTreeFor: selector) notNil ifTrue: [
-					currentClass contents: class.
-					searcher executeTree: tree ] ] ] ].
-	^ Array streamContents: [ :stream |
-		result keysDo: [ :key |
-			stream nextPut: key -> (result allAt: key) ] ]
+
+	| env |
+	env := classesToSelect
+		       ifNil: [ RBBrowserEnvironment new forClasses: RBBrowserEnvironment new allNonMetaClasses, RBBrowserEnvironment new allMetaClasses ]
+		       ifNotNil: [ RBBrowserEnvironment new forClasses: classesToSelect ].
+	^ self translatedArgumentsIn: env

repository/Seaside-Pharo-Gettext-Core.package/WATranslatedArgumentsFinder.class/instance/translatedArgumentsIn..st

@@ -0,0 +1,34 @@
+accessing
+translatedArgumentsIn: aRBBrowserEnvironment
+
+	| searcher currentClass result innerMatchHandler extractFirstArgument extractReceiver |
+	currentClass := WAValueHolder with: nil.
+	result := GROrderedMultiMap new.
+	innerMatchHandler := [ :node :literal |
+		| key |
+		key := (currentClass contents compiledMethodAt: node methodNode selector) asFullRingDefinition.
+		result at: key add: literal value ].
+	extractFirstArgument := [ :node :answer |
+		| firstArgument |
+		firstArgument := node arguments first.
+		firstArgument isLiteralNode ifTrue: [
+			innerMatchHandler value: node value: firstArgument ] ].
+	extractReceiver := [ :node :answer |
+		node receiver isLiteralNode ifTrue: [
+			innerMatchHandler value: node value: node receiver ] ].
+	searcher := RBParseTreeSearcher new
+		matches: '`@object translate: `#string' do: extractFirstArgument;
+		matches: '`@object translate: `#string to: `@arg' do: extractFirstArgument;
+		matches: '`#string seasideTranslated' do: extractReceiver;
+		matches: '`#string seasideLazyTranslated' do: extractReceiver;
+		matches: '`#string seasideTranslatedTo: `@arg' do: extractReceiver;
+		yourself.
+	aRBBrowserEnvironment methodsDo:[ :method |
+			(searcher canMatchMethod:method) ifTrue: [
+				| tree |
+				(tree := method parseTree) notNil ifTrue: [
+					currentClass contents: method methodClass.
+					searcher executeTree: tree ] ] ].
+	^ Array streamContents: [ :stream |
+		result keysDo: [ :key |
+			stream nextPut: key -> (result allAt: key) ] ]

repository/Seaside-Tests-Pharo-Gettext.package/WAGetTextExporterTest.class/instance/fileContentsOfPOTFile.st

@@ -1,14 +1,30 @@
 tests - test data
 fileContentsOfPOTFile
-	^'#: Seaside-Gettext-Examples,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate,WALocalizationContextTest>>testTranslate
+	| today now |
+	today := Date today yyyymmdd.
+	now := String streamContents: [ :str | Time now print24: true showSeconds: false on: str ].
+	^'msgid ""
+msgstr ""
+"Project-Id-Version: Pharo\n"
+"POT-Creation-Date: ',today, ' ', now,'-0000\n"
+"PO-Revision-Date: ',today, ' ', now,'-0000\n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=utf-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Pharo-SystemVersion: ',SystemVersion current asString,'\n"
+
+
+#: WAGettextExample>>renderContentOn:
 msgid "fontsize"
 msgstr ""
 
-#: Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:
+#: WAGettextExample>>renderLocaleSelectionOn:
 msgid "Select a locale below"
 msgstr ""
 
-#: Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:
+#: WAGettextExample>>renderLocaleSelectionOn:
 msgid "locale"
 msgstr ""
 

repository/Seaside-Tests-Pharo-Gettext.package/WAGetTextExporterTest.class/instance/sortedTriplets.st

@@ -1,6 +1,5 @@
 tests - test data
 sortedTriplets
 
-	^ #(#('Seaside-Gettext-Examples,WAGettextExample>>#renderContentOn:,fontsize' 'Seaside-Gettext-Examples,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:' 'fontsize')
-#('Seaside-Gettext-Examples,WAGettextExample>>#renderLocaleSelectionOn:,Select a locale below' 'Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:' 'Select a locale below')
-#('Seaside-Gettext-Examples,WAGettextExample>>#renderLocaleSelectionOn:,locale' 'Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:' 'locale'))
+	^ #(
+	#('WAGettextExample>>#renderContentOn:,fontsize' 'WAGettextExample>>renderContentOn:' 'fontsize') 	#('WAGettextExample>>#renderLocaleSelectionOn:,Select a locale below' 'WAGettextExample>>renderLocaleSelectionOn:' 'Select a locale below') 	#('WAGettextExample>>#renderLocaleSelectionOn:,locale' 'WAGettextExample>>renderLocaleSelectionOn:' 'locale'))

repository/Seaside-Tests-Pharo-Gettext.package/WAGetTextExporterTest.class/instance/sortedTripletsString.st

@@ -1,12 +1,12 @@
 tests - test data
 sortedTripletsString
 
-	^ '#: Seaside-Gettext-Examples,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:,WAGettextExample>>renderContentOn:', String lf,
+	^ '#: WAGettextExample>>renderContentOn:', String lf,
 							'msgid "fontsize"', String lf,
 							'msgstr ""', String lf, String cr,
-							'#: Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:', String lf,
+							'#: WAGettextExample>>renderLocaleSelectionOn:', String lf,
 							'msgid "Select a locale below"', String lf,
 							'msgstr ""', String lf, String cr,
-							'#: Seaside-Gettext-Examples,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:,WAGettextExample>>renderLocaleSelectionOn:', String lf,
+							'#: WAGettextExample>>renderLocaleSelectionOn:', String lf,
 							'msgid "locale"', String lf,
 							'msgstr ""', String lf, String cr.

repository/Seaside-Tests-Pharo-Gettext.package/WAGetTextExporterTest.class/instance/testExportCatalog.st

@@ -4,7 +4,10 @@ testExportCatalog
 	| exporter translationFile |
 	translationFile := FileLocator temp / 'seaside_gettext_tests.pot'.
 	self deny: translationFile exists.
-	exporter := WAGetTextExporter new exportFile: FileLocator temp / 'seaside_gettext_tests.pot'.
+	exporter := WAGetTextExporter new 
+		rbEnvironment: (RBPackageEnvironment packageName: 'Seaside-Gettext-Examples');
+		exportFile: FileLocator temp / 'seaside_gettext_tests.pot';
+		yourself.
 	[ exporter exportCatalog.
 	self assert: translationFile exists.
 	self assert: translationFile contents withInternalLineEndings equals: self fileContentsOfPOTFile. ]

repository/Seaside-Tests-Pharo-Gettext.package/WAGetTextExporterTest.class/instance/translationLiteralsArrayAsCompiledMethod.st

@@ -1,30 +1,7 @@
 tests - test data
 translationLiteralsArrayAsCompiledMethod
-	^ { 
-	'Select a locale below'->(OrderedCollection newFrom: {
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-}).
-'fontsize'->(OrderedCollection newFrom: {
-(WAGettextExample>>#renderContentOn:).
-(WAGettextExample>>#renderContentOn:).
-(WAGettextExample>>#renderContentOn:).
-(WAGettextExample>>#renderContentOn:).
-}).
-'locale'->(OrderedCollection newFrom: {
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-(WAGettextExample>>#renderLocaleSelectionOn:).
-}) 
-}.
+
+	^ {
+		  ('Select a locale below' -> (Set newFrom: { (WAGettextExample >> #renderLocaleSelectionOn:) })).
+		  ('fontsize' -> (Set newFrom: { (WAGettextExample >> #renderContentOn:) })).
+		  ('locale' -> (Set newFrom: { (WAGettextExample >> #renderLocaleSelectionOn:) })) }