[Pkg] The Trunk: GetText-edc.15.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Mar 14 09:48:33 UTC 2012
Edgar J. De Cleene uploaded a new version of GetText to project The Trunk:
http://source.squeak.org/trunk/GetText-edc.15.mcz
==================== Summary ====================
Name: GetText-edc.15
Author: edc
Time: 13 March 2012, 10:24:37.875 am
UUID: efeedc16-229a-475a-a5d7-c69a1d9ec575
Ancestors: GetText-edc.1, GetText-Richo.14
Merge of previous for cleaner load
==================== Snapshot ====================
SystemOrganization addCategory: #'GetText-Editor'!
SystemOrganization addCategory: #'GetText-Localization'!
----- 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>>translatedInAnyDomain (in category '*gettext') -----
translatedInAnyDomain
| translation |
Transcript show: self printString, ' translatedInAnyDomain'; cr.
TextDomainManager allKnownDomains do: [:domain |
translation := self translatedInDomain: 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!
SystemWindow subclass: #LanguageEditor
instanceVariableNames: 'translator translations untranslated selectedTranslation selectedTranslations selectedUntranslated translationsList untranslatedList translationText translationsFilter untranslatedFilter newerKeys'
classVariableNames: 'CheckMethods'
poolDictionaries: ''
category: 'GetText-Editor'!
!LanguageEditor commentStamp: 'dgd 11/16/2003 15:02' prior: 0!
Editor for Babel's languages.
Open it from
World Menu >> open... >> Language Editor (to open on default language)
World Menu >> open... >> Language Editor for... (to choose the language)
Or click:
LanguageEditor openOnDefault.
LanguageEditor open.
See http://swiki.agro.uba.ar/small_land/191 for documentation
!
----- Method: LanguageEditor class>>checkMethods (in category 'private') -----
checkMethods
^CheckMethods ifNil: [CheckMethods := self initCheckMethods]!
----- Method: LanguageEditor class>>ensureVisibilityOfWindow: (in category 'private') -----
ensureVisibilityOfWindow: aWindow
"private - activate the window"
| |
aWindow expand.
aWindow comeToFront.
""
aWindow
right: (aWindow right min: World right).
aWindow
bottom: (aWindow bottom min: World bottom).
aWindow
left: (aWindow left max: World left).
aWindow
top: (aWindow top max: World top).
""
aWindow flash; flash!
----- Method: LanguageEditor class>>initCheckMethods (in category 'initialize-release') -----
initCheckMethods
"LanguageEditor initCheckMethods"
| registry |
registry := Dictionary new.
registry
at: 'es' put: #checkSpanishPhrase:translation:;
yourself.
^registry!
----- Method: LanguageEditor class>>initialize (in category 'initialize-release') -----
initialize
"initialize the receiver"
(TheWorldMenu respondsTo: #registerOpenCommand:)
ifTrue: [""
TheWorldMenu registerOpenCommand: {'Language Editor' translated. {self. #openOnDefault}}.
TheWorldMenu registerOpenCommand: {'Language Editor for...' translated. {self. #open}}]!
----- Method: LanguageEditor class>>on: (in category 'instance creation') -----
on: localeID
"answer an instance of the receiver on aLanguage"
^ self new
initializeOn: (InternalTranslator cachedTranslations
at: localeID
ifAbsent: [self
error: ('Translator for {1} is not found' translated format: {localeID})])!
----- Method: LanguageEditor class>>open (in category 'opening') -----
open
"open the receiver on any language"
"
LanguageEditor open.
"
| menu |
menu := MenuMorph new defaultTarget: self.
menu addTitle: 'Language Editor for...' translated.
""
(InternalTranslator availableLanguageLocaleIDs
asSortedCollection: [:x :y | x asString <= y asString])
do: [:eachLanguage | ""
menu
add: eachLanguage name
target: self
selector: #openOn:
argument: eachLanguage].
""
menu popUpInWorld!
----- Method: LanguageEditor class>>openOn: (in category 'instance creation') -----
openOn: aLanguage
"open an instance on aLanguage"
World submorphs
do: [:each | ""
((each isKindOf: LanguageEditor)
and: [each translator == aLanguage])
ifTrue: [""
self ensureVisibilityOfWindow: each.
^ self]].
""
^ (self on: aLanguage) openInWorld!
----- Method: LanguageEditor class>>openOnDefault (in category 'opening') -----
openOnDefault
"open the receiver on the default language"
self openOn: LocaleID current!
----- Method: LanguageEditor class>>unload (in category 'initialize-release') -----
unload
"the receiver is being unloaded"
(TheWorldMenu respondsTo: #registerOpenCommand:)
ifTrue: [""
TheWorldMenu unregisterOpenCommand: 'Language Editor'.
TheWorldMenu unregisterOpenCommand: 'Language Editor for...'] !
----- Method: LanguageEditor>>addTranslation (in category 'gui methods') -----
addTranslation
"translate a phrase"
| phrase |
phrase := FillInTheBlank
request: 'enter the original:' translated
initialAnswer: ''.
(phrase isNil
or: [phrase = ''])
ifTrue: [""
self beep.
^ self].
""
self translatePhrase: phrase!
----- Method: LanguageEditor>>applyTranslations (in category 'gui methods') -----
applyTranslations
"private - try to apply the translations as much as possible all
over the image"
Project current updateLocaleDependents!
----- Method: LanguageEditor>>asHtml: (in category 'reporting') -----
asHtml: aString
| stream |
stream := String new writeStream.
aString
do: [:each |
each caseOf: {
[Character cr] -> [stream nextPutAll: '<br>'].
[$&] -> [stream nextPutAll: '&'].
[$<] -> [stream nextPutAll: '<'].
[$>] -> [stream nextPutAll: '>'].
[$*] -> [stream nextPutAll: '☆'].
[$@] -> [stream nextPutAll: '&at;']}
otherwise: [stream nextPut: each]].
^ stream contents!
----- Method: LanguageEditor>>browseMethodsWithTranslation (in category 'gui methods') -----
browseMethodsWithTranslation
| translation |
self selectedTranslation isZero
ifTrue: [""
self beep.
self inform: 'select the translation to look for' translated.
^ self].
""
translation := self translations at: self selectedTranslation.
self systemNavigation browseMethodsWithLiteral: translation!
----- Method: LanguageEditor>>browseMethodsWithUntranslated (in category 'gui methods') -----
browseMethodsWithUntranslated
| untrans |
self selectedUntranslated isZero
ifTrue: [""
self beep.
self inform: 'select the untrans phrase to look for' translated.
^ self].
""
untrans := self untranslated at: self selectedUntranslated.
SystemNavigation default browseMethodsWithLiteral: untrans.
!
----- Method: LanguageEditor>>check (in category 'private') -----
check
"check the translations and answer a collection with the results"
| results counter phrasesCount checkMethod |
results := OrderedCollection new.
untranslated := self untranslated.
phrasesCount := self translations size + self untranslated size.
counter := 0.
checkMethod := self class checkMethods at: self translator localeID printString ifAbsent: [^results].
self translations
keysAndValuesDo: [:phrase :translation |
| result |
result := self perform: checkMethod with: phrase with: translation.
(result notNil
and: [result notEmpty])
ifTrue: [results add: {phrase. translation. result}].
counter := counter + 1.
(counter isDivisibleBy: 50)
ifTrue: [| percent |
percent := counter / phrasesCount * 100 roundTo: 0.01.
Transcript
show: ('- checked {1} phrases of {2} ({3}%)...' translated format: {counter. phrasesCount. percent});
cr]].
self untranslated
do: [:phrase |
| result |
result := self checkUntranslatedPhrase: phrase.
(result notNil
and: [result notEmpty])
ifTrue: [results add: {phrase. nil. result}].
counter := counter + 1.
(counter isDivisibleBy: 50)
ifTrue: [| percent |
percent := counter / phrasesCount * 100 roundTo: 0.01.
Transcript
show: ('- checked {1} phrases of {2} ({3}%)...' translated format: {counter. phrasesCount. percent});
cr]].
^ results!
----- Method: LanguageEditor>>checkPhrase:translation: (in category 'private') -----
checkPhrase: phraseString translation: translationString
^nil!
----- Method: LanguageEditor>>checkSpanishPhrase:translation: (in category 'private') -----
checkSpanishPhrase: phraseString translation: translationString
"check the translation and aswer a string with a comment or a
nil meaning no-comments"
| superResult |
superResult := self checkPhrase: phraseString translation: translationString.
superResult isNil
ifFalse: [^ superResult].
"For some reason, MCInstaller couldn't read Spanish character. "
"((translationString includes: $?)
and: [(translationString includes: $¿) not])
ifTrue: [^ '¿Olvidó el signo de pregunta?'].
((translationString includes: $!!)
and: [(translationString includes: $¡) not])
ifTrue: [^ '¿Olvidó el signo de admiración?'].
"
^ nil
!
----- Method: LanguageEditor>>checkUntranslatedPhrase: (in category 'private') -----
checkUntranslatedPhrase: phraseString
"check the phrase an aswer a string with a comment or a nil
meaning no-comments"
(self translations includes: phraseString)
ifTrue: [^ 'possible double-translation' translated].
^ nil!
----- Method: LanguageEditor>>codeSelectedTranslation (in category 'gui methods') -----
codeSelectedTranslation
| keys code |
keys := selectedTranslations
collect: [:key | self translations at: key].
code := String
streamContents: [:aStream | self translator fileOutOn: aStream keys: keys withBOM: false].
(StringHolder new contents: code)
openLabel: 'exported codes' translated!
----- Method: LanguageEditor>>codeSelectedTranslationAsMimeString (in category 'gui methods') -----
codeSelectedTranslationAsMimeString
| keys code tmpStream s2 gzs cont |
keys := selectedTranslations
collect: [:key | self translations at: key].
code := String
streamContents: [:aStream | self translator fileOutOn: aStream keys: keys withBOM: false].
tmpStream _ MultiByteBinaryOrTextStream on: ''.
tmpStream converter: UTF8TextConverter new.
tmpStream nextPutAll: code.
s2 _ RWBinaryOrTextStream on: ''.
gzs := GZipWriteStream on: s2.
tmpStream reset.
gzs nextPutAll: (tmpStream binary contentsOfEntireFile asString) contents.
gzs close.
s2 reset.
cont _ String streamContents: [:strm |
strm nextPutAll: '"Gzip+Base64 encoded translation for;'; cr.
strm nextPutAll: '#('.
keys do: [:each | strm nextPutAll: '''', each, ''' '.].
strm nextPutAll: ')"'; cr; cr.
strm nextPutAll: 'NaturalLanguageTranslator loadForLocaleIsoString: '.
strm nextPut: $'.
strm nextPutAll: translator localeID isoString.
strm nextPut: $'.
strm nextPutAll: ' fromGzippedMimeLiteral: '.
strm nextPut: $'.
strm nextPutAll: (Base64MimeConverter mimeEncode: s2) contents.
strm nextPutAll: '''.'.
strm cr.
].
(StringHolder new contents: cont)
openLabel: 'exported codes in Gzip+Base64 encoding' translated!
----- Method: LanguageEditor>>createButtonLabel:action:help: (in category 'initialization - toolbar') -----
createButtonLabel: aString action: actionSelector help: helpString
"create a toolbar for the receiver"
| button |
button := SimpleButtonMorph new target: self;
label: aString translated "font: Preferences standardButtonFont";
actionSelector: actionSelector;
setBalloonText: helpString translated;
color: translator defaultBackgroundColor twiceDarker;
borderWidth: 2;
borderColor: #raised.
""
^ button!
----- Method: LanguageEditor>>createMainToolbar (in category 'initialization - toolbar') -----
createMainToolbar
"create a toolbar for the receiver"
| toolbar |
toolbar := self createRow.
""
" toolbar
addMorphBack: (self
createUpdatingButtonWording: #debugWording
action: #switchDebug
help: 'Switch the debug flag')."
toolbar addTransparentSpacerOfSize: 5 @ 0.
""
toolbar
addMorphBack: (self
createButtonLabel: 'new'
action: #newTranslations
help: 'Create translations for new language.').
toolbar
addMorphBack: (self
createButtonLabel: 'save'
action: #saveToFile
help: 'Save the translations to a file').
toolbar
addMorphBack: (self
createButtonLabel: 'load'
action: #loadFromFile
help: 'Load the translations from a file').
toolbar
addMorphBack: (self
createButtonLabel: 'merge'
action: #mergeFromFile
help: 'Merge the current translations with the translations in a file').
""
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'apply'
action: #applyTranslations
help: 'Apply the translations as much as possible.').
""
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'check translations'
action: #check
help: 'Check the translations and report the results.').
toolbar
addMorphBack: (self
createButtonLabel: 'report'
action: #report
help: 'Create a report.').
toolbar
addMorphBack: (self
createButtonLabel: 'gettext'
action: #getText
help: 'Interface with gettext.').
""
^ toolbar!
----- Method: LanguageEditor>>createRow (in category 'initialization - toolbar') -----
createRow
"create a row"
| row |
row := AlignmentMorph newRow.
row layoutInset: 3;
wrapCentering: #center;
cellPositioning: #leftCenter.
""
^ row!
----- Method: LanguageEditor>>createStatusbar (in category 'initialization - statusbar') -----
createStatusbar
"create the statusbar for the receiver"
| statusbar |
statusbar := self createRow.
statusbar addMorph: ((UpdatingStringMorph on: self selector: #status) growable: true;
useStringFormat;
hResizing: #spaceFill;
stepTime: 2000).
^ statusbar!
----- Method: LanguageEditor>>createTranslationsToolbar (in category 'initialization - toolbar') -----
createTranslationsToolbar
"create a toolbar for the receiver"
| toolbar |
toolbar := self createRow.
""
toolbar
addMorphBack: (self
createUpdatingButtonWording: #translationsFilterWording
action: #filterTranslations
help: 'Filter the translations list.').
toolbar addTransparentSpacerOfSize: 5 @ 0.
""
toolbar
addMorphBack: (self
createButtonLabel: 'search'
action: #searchTranslation
help: 'Search for a translation containing...').
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'remove'
action: #removeTranslation
help: 'Remove the selected translation. If none is selected, ask for the one to remove.').
""
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'where'
action: #browseMethodsWithTranslation
help: 'Launch a browser on all methods that contain the phrase as a substring of any literal String.').
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'r-unused'
action: #removeTranslatedButUnusedStrings
help: 'Remove all the strings that are not used by the system').
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'add '
action: #addTranslation
help: 'Add a new phrase').
^ toolbar!
----- Method: LanguageEditor>>createUntranslatedToolbar (in category 'initialization - toolbar') -----
createUntranslatedToolbar
"create a toolbar for the receiver"
| toolbar |
toolbar := self createRow.
""
toolbar
addMorphBack: (self
createUpdatingButtonWording: #untranslatedFilterWording
action: #filterUntranslated
help: 'Filter the untranslated list.').
toolbar addTransparentSpacerOfSize: 5 @ 0.
""
toolbar
addMorphBack: (self
createButtonLabel: 'search'
action: #searchUntranslated
help: 'Search for a untranslated phrase containing...').
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'remove'
action: #removeUntranslated
help: 'Remove the selected untranslated phrease. If none is selected, ask for the one to remove.').
""
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'translate'
action: #translate
help: 'Translate the selected untranslated phrase or a new phrase').
""
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'where'
action: #browseMethodsWithUntranslated
help: 'Launch a browser on all methods that contain the phrase as a substring of any literal String.').
toolbar addTransparentSpacerOfSize: 5 @ 0.
toolbar
addMorphBack: (self
createButtonLabel: 'r-unused'
action: #removeUntranslatedButUnusedStrings
help: 'Remove all the strings that are not used by the system').
^ toolbar!
----- Method: LanguageEditor>>createUpdatingButtonWording:action:help: (in category 'initialization - toolbar') -----
createUpdatingButtonWording: wordingSelector action: actionSelector help: helpString
"create a toolbar for the receiver"
| button |
button := (UpdatingSimpleButtonMorph newWithLabel: '-') target: self;
wordingSelector: wordingSelector;
actionSelector: actionSelector;
setBalloonText: helpString translated;
color: translator defaultBackgroundColor twiceDarker;
borderWidth: 1;
borderColor: #raised; cornerStyle: #square.
""
^ button!
----- Method: LanguageEditor>>delete (in category 'open/close') -----
delete
"Remove the receiver as a submorph of its owner"
self model: nil.
super delete !
----- Method: LanguageEditor>>deselectAllTranslation (in category 'gui methods') -----
deselectAllTranslation
selectedTranslations := IdentitySet new.
self changed: #allSelections!
----- Method: LanguageEditor>>filterTranslations (in category 'gui methods') -----
filterTranslations
| filter |
filter := FillInTheBlank request: 'filter with
(empty string means no-filtering)' translated initialAnswer: self translationsFilter.
""
self filterTranslations: filter!
----- Method: LanguageEditor>>filterTranslations: (in category 'gui methods') -----
filterTranslations: aString
| filter |
filter := aString ifNil:[''].
""
translationsFilter _ filter.
self refreshTranslations.
!
----- Method: LanguageEditor>>filterUntranslated (in category 'gui methods') -----
filterUntranslated
| filter |
filter := FillInTheBlank request: 'filter with
(empty string means no-filtering)' translated initialAnswer: self untranslatedFilter.
""
self filterUntranslated: filter!
----- Method: LanguageEditor>>filterUntranslated: (in category 'gui methods') -----
filterUntranslated: aString
| filter |
filter := aString
ifNil: [''].
""
untranslatedFilter := filter.
self refreshUntranslated!
----- Method: LanguageEditor>>getText (in category 'gui methods') -----
getText
| menu |
menu := MenuMorph new defaultTarget: self.
""
menu
add: 'gettext template' translated
target: self
selector: #getTextExportTemplate.
menu lastItem setBalloonText: 'exports the translations to gettext separated format.' translated.
menu
add: 'gettext export' translated
target: self
selector: #getTextExport.
menu lastItem setBalloonText: 'Exports the translations to GetText format.' translated.
""
menu
add: 'gettext import' translated
target: self
selector: #getTextImport.
menu lastItem setBalloonText: 'Imports the translations from GetText format.' translated.
""
menu popUpInWorld!
----- Method: LanguageEditor>>getTextExport (in category 'gui methods') -----
getTextExport
Cursor wait
showWhile: [GetTextExporter2 new exportTranslator: self model]!
----- Method: LanguageEditor>>getTextExportTemplate (in category 'gui methods') -----
getTextExportTemplate
Cursor wait
showWhile: [GetTextExporter2 new exportTemplate] !
----- Method: LanguageEditor>>getTextImport (in category 'gui methods') -----
getTextImport
| menu |
menu := MenuMorph new defaultTarget: self.
menu addTitle: 'Choose translation file' translated.
menu add: 'All *.po files' translated action: #getTextImportAll.
menu add: 'Choose a file' translated action: #getTextImportAFile.
menu popUpInWorld!
----- Method: LanguageEditor>>getTextImportAFile (in category 'gui methods') -----
getTextImportAFile
| result |
result := (StandardFileMenu new pattern: '*.po';
oldFileFrom: (FileDirectory default directoryNamed: 'po')) startUpWithCaption: 'Select a File:' translated.
result
ifNil: [^ self].
self
withUnboundModelDo: [:trans | Cursor wait
showWhile: [GetTextImporter new
import: trans
fileNamed: (result directory fullNameFor: result name)]]!
----- Method: LanguageEditor>>getTextImportAll (in category 'gui methods') -----
getTextImportAll
self
withUnboundModelDo: [:trans | Cursor wait
showWhile: [GetTextImporter import: trans allDirectory: FileDirectory default]].
self refreshBoth!
----- Method: LanguageEditor>>identifyUnusedStrings (in category 'stef') -----
identifyUnusedStrings
"self new identifyUnusedStrings"
translationsList getList
do: [:each |
Transcript show: each.
Transcript show: (Smalltalk
allSelect: [:method | method
hasLiteralSuchThat: [:lit | lit isString
and: [lit includesSubstring: each caseSensitive: true]]]) size printString; cr]!
----- Method: LanguageEditor>>initializeNewerKeys (in category 'initialization') -----
initializeNewerKeys
newerKeys _ Set new.
!
----- Method: LanguageEditor>>initializeOn: (in category 'initialization') -----
initializeOn: aLanguage
"initialize the receiver on aLanguage"
""
selectedTranslation := 0.
selectedUntranslated := 0.
selectedTranslations := IdentitySet new.
""
translator := aLanguage.
""
self model: aLanguage.
self setLabel: 'Language editor for: ' translated , self translator name.
""
self initializeToolbars.
self initializePanels.
self initializeStatusbar.
self initializeNewerKeys.
!
----- Method: LanguageEditor>>initializePanels (in category 'initialization') -----
initializePanels
"initialize the receiver's panels"
translationsList := PluggableListMorphOfMany
on: self
list: #translations
primarySelection: #selectedTranslation
changePrimarySelection: #selectedTranslation:
listSelection: #selectedTranslationsAt:
changeListSelection: #selectedTranslationsAt:put:
menu: #translationsMenu:
keystroke: #translationsKeystroke:.
translationsList setBalloonText: 'List of all the translated phrases.' translated.
""
untranslatedList := PluggableListMorph
on: self
list: #untranslated
selected: #selectedUntranslated
changeSelected: #selectedUntranslated:
menu: #untranslatedMenu:
keystroke: #untranslatedKeystroke:.
untranslatedList setBalloonText: 'List of all the untranslated phrases.' translated.
""
translationText := PluggableTextMorph
on: self
text: #translation
accept: #translation:
readSelection: nil
menu: nil.
translationText setBalloonText: 'Translation for the selected phrase in the upper list.' translated.
""
self
addMorph: translationsList
frame: (0 @ 0.18 corner: 0.5 @ 0.66).
self
addMorph: untranslatedList
frame: (0.5 @ 0.18 corner: 1 @ 0.93).
self
addMorph: translationText
frame: (0 @ 0.66 corner: 0.5 @ 0.93).
self hResizing: #shrinkWrap!
----- Method: LanguageEditor>>initializeStatusbar (in category 'initialization - statusbar') -----
initializeStatusbar
"initialize the receiver's statusbar"
self
addMorph: self createStatusbar
frame: (0 @ 0.93 corner: 1 @ 1)!
----- Method: LanguageEditor>>initializeToolbars (in category 'initialization - toolbar') -----
initializeToolbars
"initialize the receiver's toolbar"
self
addMorph: self createMainToolbar
frame: (0 @ 0 corner: 1 @ 0.09).
""
self
addMorph: self createTranslationsToolbar
frame: (0 @ 0.09 corner: 0.5 @ 0.18).
self
addMorph: self createUntranslatedToolbar
frame: (0.5 @ 0.09 corner: 1 @ 0.18)!
----- Method: LanguageEditor>>loadFromFile (in category 'gui methods') -----
loadFromFile
| fileName |
fileName := self selectTranslationFileName.
fileName isNil
ifTrue: [""
self beep.
^ self].
""
Cursor wait
showWhile: [
self translator loadFromFileNamed: fileName.
self refreshBoth]!
----- Method: LanguageEditor>>mergeFromFile (in category 'gui methods') -----
mergeFromFile
| fileName |
fileName := self selectTranslationFileName.
fileName isNil
ifTrue: [""
self beep.
^ self].
""
Cursor wait
showWhile: [
self translator loadFromFileNamed: fileName.
self refreshBoth]!
----- Method: LanguageEditor>>newTranslations (in category 'gui methods') -----
newTranslations
"private - try to apply the translations as much as possible all
over the image"
| result newID |
result := FillInTheBlank request: 'New locale ID string?' translated initialAnswer: Locale current determineLocaleID isoString.
result isEmpty
ifTrue: ["Do nothing"
^ self].
newID := LocaleID isoString: result.
InternalTranslator
newLocaleID: (LocaleID isoString: result).
self class openOn: newID!
----- Method: LanguageEditor>>numberOfTimesStringIsUsed: (in category 'stef') -----
numberOfTimesStringIsUsed: aString
^ (self systemNavigation allSelect: [:method | method
hasLiteralSuchThat: [:lit | lit isString
and: [lit includesSubstring: aString caseSensitive: true]]]) size!
----- Method: LanguageEditor>>okToChange (in category 'updating') -----
okToChange
"Allows a controller to ask this of any model"
self selectedTranslation isZero
ifTrue: [^ true].
""
translationText hasUnacceptedEdits
ifFalse: [^ true].
^ (CustomMenu confirm: 'Discard the changes to currently selected translated phrase?' translated)
and: [""
translationText hasUnacceptedEdits: false.
true]!
----- Method: LanguageEditor>>perform:orSendTo: (in category 'message handling') -----
perform: selector orSendTo: otherTarget
"I wish to intercept and handle selector myself"
^ self perform: selector!
----- Method: LanguageEditor>>phrase:translation: (in category 'gui methods') -----
phrase: phraseString translation: translationString
"set the models's translation for phraseString"
self translator phrase: phraseString translation: translationString.
self refreshBoth.
newerKeys add: phraseString.
!
----- Method: LanguageEditor>>phraseToTranslate (in category 'gui methods') -----
phraseToTranslate
"answer a phrase to translate. use the selected untranslated phrase or ask for a new one"
^ self selectedUntranslated isZero
ifTrue: [FillInTheBlank
multiLineRequest: 'new phrase to translate' translated
centerAt: Sensor cursorPoint
initialAnswer: ''
answerHeight: 200]
ifFalse: [self untranslated at: self selectedUntranslated]!
----- Method: LanguageEditor>>printHeaderReportOn: (in category 'reporting') -----
printHeaderReportOn: aStream
"append to aStream a header report of the receiver with swiki
format"
aStream nextPutAll: '!!!!';
nextPutAll: ('Language: {1}' translated format: {self translator localeID isoString});
cr.
aStream nextPutAll: '- ';
nextPutAll: ('{1} translated phrases' translated format: {self translator translations size});
cr.
aStream nextPutAll: '- ';
nextPutAll: ('{1} untranslated phrases' translated format: {self translator untranslated size});
cr.
aStream cr; cr!
----- Method: LanguageEditor>>printReportOn: (in category 'reporting') -----
printReportOn: aStream
"append to aStream a report of the receiver with swiki format"
self printHeaderReportOn: aStream.
self printUntranslatedReportOn: aStream.
self printTranslationsReportOn: aStream!
----- Method: LanguageEditor>>printTranslationsReportOn: (in category 'reporting') -----
printTranslationsReportOn: aStream
"append to aStream a report of the receiver's translations"
| originalPhrases |
aStream nextPutAll: '!!';
nextPutAll: 'translations' translated;
cr.
originalPhrases := self translator translations keys asSortedCollection.
originalPhrases
do: [:each |
aStream
nextPutAll: ('|{1}|{2}|' format: {self asHtml: each. self
asHtml: (self translator translate: each)});
cr].
aStream cr; cr!
----- Method: LanguageEditor>>printUntranslatedReportOn: (in category 'reporting') -----
printUntranslatedReportOn: aStream
"append to aStream a report of the receiver's translations"
aStream nextPutAll: '!!';
nextPutAll: 'not translated' translated;
cr.
self untranslated asSortedCollection
do: [:each |
aStream
nextPutAll: ('|{1}|' format: {self asHtml: each});
cr].
aStream cr; cr!
----- Method: LanguageEditor>>refreshBoth (in category 'updating') -----
refreshBoth
self refreshUntranslated
!
----- Method: LanguageEditor>>refreshTranslations (in category 'updating') -----
refreshTranslations
"refresh the translations panel"
self selectedTranslation: 0.
translations := nil.
self changed: #translations.
!
----- Method: LanguageEditor>>refreshUntranslated (in category 'updating') -----
refreshUntranslated
"refresh the untranslated panel"
self refreshTranslations.
self selectedUntranslated: 0.
untranslated := nil.
self changed: #untranslated.
!
----- Method: LanguageEditor>>removeTranslatedButUnusedStrings (in category 'stef') -----
removeTranslatedButUnusedStrings
(self confirm: 'Are you sure that you want to remove unused strings?' translated)
ifFalse: [^ self].
translationsList getList
do: [:each |
| timesUsed |
timesUsed := self numberOfTimesStringIsUsed: each.
Transcript show: each.
Transcript show: timesUsed printString;
cr.
timesUsed isZero
ifTrue: [self translator removeTranslationFor: each]]!
----- Method: LanguageEditor>>removeTranslation (in category 'gui methods') -----
removeTranslation
"remove the selected translation"
| translation |
self selectedTranslation isZero
ifTrue: [""
self beep.
self inform: 'select the translation to remove' translated.
^ self].
""
translation := self translations at: self selectedTranslation.
""
(self
confirm: ('Removing "{1}".
Are you sure you want to do this?' translated format: {translation}))
ifFalse: [^ self].
""
self translator removeTranslationFor: translation.
self refreshBoth!
----- Method: LanguageEditor>>removeUntranslated (in category 'gui methods') -----
removeUntranslated
"remove the selected untranslated phrase"
| untrans |
self selectedUntranslated isZero
ifTrue: [""
self beep.
self inform: 'select the untranslated phrase to remove' translated.
^ self].
""
untrans := self untranslated at: self selectedUntranslated.
""
(self
confirm: ('Removing "{1}".
Are you sure you want to do this?' translated format: {untrans}))
ifFalse: [^ self].
""
self translator removeUntranslated: untrans!
----- Method: LanguageEditor>>removeUntranslatedButUnusedStrings (in category 'stef') -----
removeUntranslatedButUnusedStrings
(self confirm: 'Are you sure that you want to remove unused strings?' translated)
ifFalse: [^ self].
untranslatedList getList
do: [:each |
| timesUsed |
timesUsed := self numberOfTimesStringIsUsed: each.
Transcript show: each.
Transcript show: timesUsed printString;
cr.
timesUsed isZero
ifTrue: [self translator removeUntranslated: each]].
self refreshUntranslated.
!
----- Method: LanguageEditor>>report (in category 'gui methods') -----
report
self reportString openInWorkspaceWithTitle: 'report' translated!
----- Method: LanguageEditor>>reportString (in category 'reporting') -----
reportString
"answer a string with a report of the receiver"
| stream |
stream := String new writeStream.
self printReportOn: stream.
^ stream contents!
----- Method: LanguageEditor>>resetNewerKeys (in category 'gui methods') -----
resetNewerKeys
self initializeNewerKeys.
!
----- Method: LanguageEditor>>saveToFile (in category 'gui methods') -----
saveToFile
"save the translator to a file"
| fileName |
fileName := FillInTheBlank request: 'file name' translated initialAnswer: translator localeID isoString , '.translation'.
(fileName isNil
or: [fileName isEmpty])
ifTrue: [""
self beep.
^ self].
""
Cursor wait
showWhile: [
self translator saveToFileNamed: fileName]!
----- Method: LanguageEditor>>searchTranslation (in category 'gui methods') -----
searchTranslation
| search |
search := FillInTheBlank request: 'search for' translated initialAnswer: ''.
(search isNil
or: [search isEmpty])
ifTrue: [""
self beep.
^ self].
""
self searchTranslation: search!
----- Method: LanguageEditor>>searchTranslation: (in category 'gui methods') -----
searchTranslation: aString
| results index |
results := self translations
select: [:each | ""
('*' , aString , '*' match: each)
or: ['*' , aString , '*' match: (self translator translate: each)]].
""
results isEmpty
ifTrue: [""
self inform: 'no matches for' translated , ' ''' , aString , ''''.
^ self].
""
results size = 1
ifTrue: [""
self selectTranslationPhrase: results first.
^ self].
""
index := (PopUpMenu
labelArray: (results
collect: [:each | ""
(each copy replaceAll: Character cr with: $\)
, ' -> '
, ((self translator translate: each) copy replaceAll: Character cr with: $\)]))
startUpWithCaption: 'select the translation...' translated.
""
index isZero
ifTrue: [""
self beep.
^ self].
""
self
selectTranslationPhrase: (results at: index)!
----- Method: LanguageEditor>>searchUntranslated (in category 'gui methods') -----
searchUntranslated
| search |
search := FillInTheBlank request: 'search for' translated initialAnswer: ''.
(search isNil
or: [search isEmpty])
ifTrue: [""
self beep.
^ self].
""
self searchUntranslated: search!
----- Method: LanguageEditor>>searchUntranslated: (in category 'gui methods') -----
searchUntranslated: aString
| untranslateds results index |
untranslateds := self untranslated.
results := untranslateds
select: [:each | '*' , aString , '*' match: each].
""
results isEmpty
ifTrue: [""
self inform: 'no matches for' translated , ' ''' , aString , ''''.
^ self].
""
results size = 1
ifTrue: [""
self selectUntranslatedPhrase: results first.
^ self].
""
index := (PopUpMenu
labelArray: (results
collect: [:each | each copy replaceAll: Character cr with: $\]))
startUpWithCaption: 'select the untranslated phrase...' translated.
""
index isZero
ifTrue: [""
self beep.
^ self].
""
self
selectUntranslatedPhrase: (results at: index)!
----- Method: LanguageEditor>>selectAllTranslation (in category 'gui methods') -----
selectAllTranslation
selectedTranslations := (1 to: self translations size) asIdentitySet.
self changed: #allSelections!
----- Method: LanguageEditor>>selectNewerKeys (in category 'gui methods') -----
selectNewerKeys
| index |
self deselectAllTranslation.
newerKeys do: [:k |
index _ self translations indexOf: k ifAbsent: [0].
index > 0 ifTrue: [
self selectedTranslationsAt: index put: true
].
].
!
----- Method: LanguageEditor>>selectTranslationFileName (in category 'gui methods') -----
selectTranslationFileName
"answer a file with a translation"
| file |
file := (StandardFileMenu oldFileMenu: FileDirectory default withPattern: '*.translation')
startUpWithCaption: 'Select the file...' translated.
^ file isNil
ifFalse: [file directory fullNameFor: file name]!
----- Method: LanguageEditor>>selectTranslationPhrase: (in category 'gui methods') -----
selectTranslationPhrase: phraseString
self selectedTranslation: (self translations indexOf: phraseString)!
----- Method: LanguageEditor>>selectUntranslatedPhrase: (in category 'gui methods') -----
selectUntranslatedPhrase: phraseString
self
selectedUntranslated: (self untranslated indexOf: phraseString)!
----- Method: LanguageEditor>>selectedTranslation (in category 'accessing') -----
selectedTranslation
"answer the selectedTranslation"
^ selectedTranslation!
----- Method: LanguageEditor>>selectedTranslation: (in category 'accessing') -----
selectedTranslation: anInteger
"change the receiver's selectedTranslation"
selectedTranslation := anInteger.
""
self changed: #selectedTranslation.
self changed: #translation!
----- Method: LanguageEditor>>selectedTranslationsAt: (in category 'accessing') -----
selectedTranslationsAt: index
^ selectedTranslations includes: index!
----- Method: LanguageEditor>>selectedTranslationsAt:put: (in category 'accessing') -----
selectedTranslationsAt: index put: value
value = true
ifTrue: [selectedTranslations add: index]
ifFalse: [selectedTranslations
remove: index
ifAbsent: []]!
----- Method: LanguageEditor>>selectedUntranslated (in category 'accessing') -----
selectedUntranslated
"answer the selectedUntranslated"
^ selectedUntranslated!
----- Method: LanguageEditor>>selectedUntranslated: (in category 'accessing') -----
selectedUntranslated: anInteger
"change the selectedUntranslated"
selectedUntranslated := anInteger.
""
self changed: #selectedUntranslated!
----- Method: LanguageEditor>>status (in category 'gui methods') -----
status
"answer a status string"
| translationsSize untranslatedSize |
translationsSize := self translator translations size.
untranslatedSize := self translator untranslated size.
^ '| {1} phrases | {2} translated | {3} untranslated |' translated format: {translationsSize + untranslatedSize. translationsSize. untranslatedSize}!
----- Method: LanguageEditor>>translate (in category 'gui methods') -----
translate
"translate a phrase"
| phrase |
phrase := self phraseToTranslate.
""
(phrase isNil
or: [phrase = ''])
ifTrue: [""
self beep.
^ self].
""
self translatePhrase: phrase.
self refreshBoth!
----- Method: LanguageEditor>>translatePhrase: (in category 'gui methods') -----
translatePhrase: aString
"translate aString"
| translation |
translation := FillInTheBlank
multiLineRequest: 'translation for: ' translated , '''' , aString , ''''
centerAt: Sensor cursorPoint
initialAnswer: aString
answerHeight: 200.
""
(translation isNil
or: [translation = ''])
ifTrue: [""
self beep.
^ self].
""
self phrase: aString translation: translation!
----- Method: LanguageEditor>>translation (in category 'accessing') -----
translation
"answer the translation for the selected phrase"
self selectedTranslation isZero
ifTrue: [^ '<select a phrase from the upper list>' translated].
""
^ self translator
translate: (self translations at: self selectedTranslation)!
----- Method: LanguageEditor>>translation: (in category 'accessing') -----
translation: aStringOrText
"change the translation for the selected phrase"
| phrase |
self selectedTranslation isZero
ifTrue: [^ self].
phrase _ self translations at: self selectedTranslation.
translator
phrase: phrase
translation: aStringOrText asString.
newerKeys add: phrase.
^ true!
----- Method: LanguageEditor>>translations (in category 'accessing') -----
translations
"answet the translator's translations"
| allTranslations filterString |
translations ifNotNil: [^translations].
allTranslations := self translator translations keys.
""
filterString := self translationsFilter.
""
filterString isEmpty
ifFalse: [allTranslations := allTranslations
select: [:each | ""
('*' , filterString , '*' match: each)
or: ['*' , filterString , '*'
match: (self translator translate: each)]]].
""
^ translations _ allTranslations asSortedCollection asArray!
----- Method: LanguageEditor>>translationsFilter (in category 'accessing') -----
translationsFilter
^translationsFilter ifNil:['']!
----- Method: LanguageEditor>>translationsFilterWording (in category 'gui methods') -----
translationsFilterWording
^ (self translationsFilter isEmpty
ifTrue: ['filter' translated]
ifFalse: ['filtering: {1}' translated format:{self translationsFilter}]) !
----- Method: LanguageEditor>>translationsKeystroke: (in category 'gui methods') -----
translationsKeystroke: aChar
"Respond to a Command key in the translations list."
aChar == $x
ifTrue: [^ self removeTranslation].
aChar == $E
ifTrue: [^ self browseMethodsWithTranslation]!
----- Method: LanguageEditor>>translationsMenu: (in category 'gui methods') -----
translationsMenu: aMenu
^ aMenu add: 'remove (x)' translated action: #removeTranslation;
add: 'where (E)' translated action: #browseMethodsWithTranslation;
add: 'select all' translated action: #selectAllTranslation;
add: 'deselect all' translated action: #deselectAllTranslation;
add: 'select changed keys' translated action: #selectNewerKeys;
add: 'export selection' translated action: #codeSelectedTranslation;
add: 'export selection in do-it form' translated action: #codeSelectedTranslationAsMimeString;
add: 'reset changed keys' translated action: #resetNewerKeys;
yourself!
----- Method: LanguageEditor>>translator (in category 'private') -----
translator
^translator!
----- Method: LanguageEditor>>untranslated (in category 'accessing') -----
untranslated
"answer the translator's untranslated phrases"
| all filterString |
untranslated ifNotNil: [^ untranslated].
all := self translator untranslated.
""
filterString := self untranslatedFilter.
""
filterString isEmpty
ifFalse: [all := all
select: [:each | ""
('*' , filterString , '*' match: each)
or: ['*' , filterString , '*'
match: (self translator translate: each)]]].
""
^ untranslated _ all asSortedCollection asArray!
----- Method: LanguageEditor>>untranslatedFilter (in category 'accessing') -----
untranslatedFilter
^ untranslatedFilter
ifNil: ['']!
----- Method: LanguageEditor>>untranslatedFilterWording (in category 'gui methods') -----
untranslatedFilterWording
^ self untranslatedFilter isEmpty
ifTrue: ['filter' translated]
ifFalse: ['filtering: {1}' translated format: {self untranslatedFilter}]!
----- Method: LanguageEditor>>untranslatedKeystroke: (in category 'gui methods') -----
untranslatedKeystroke: aChar
"Respond to a Command key in the translations list."
aChar == $t
ifTrue: [^ self translate].
aChar == $E
ifTrue: [^ self browseMethodsWithUntranslated]!
----- Method: LanguageEditor>>untranslatedMenu: (in category 'gui methods') -----
untranslatedMenu: aMenu
^ aMenu add: 'remove' translated action: #removeUntranslated;
add: 'translate (t)' translated action: #translate;
add: 'where (E)' translated action: #browseMethodsWithUntranslated;
yourself!
----- Method: LanguageEditor>>update: (in category 'updating') -----
update: aSymbol
"Receive a change notice from an object of whom the receiver
is a dependent."
super update: aSymbol.
""
aSymbol == #untranslated
ifTrue: [self refreshUntranslated].
aSymbol == #translations
ifTrue: [self refreshTranslations]!
----- Method: LanguageEditor>>withUnboundModelDo: (in category 'private') -----
withUnboundModelDo: aBlock
"Private - Evaluate aBlock with the receiver temporary
unbound from the model.
Useful to perform a batch of modifications to the model
without updating the view."
| formerModel |
formerModel := self model.
self model: nil.
[aBlock value: formerModel]
ensure: [self model: formerModel]!
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-headers') -----
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!
----- 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: (in category 'exporting') -----
export: aLanguage
language := aLanguage.
[stream := FileStream forceNewFileNamed: self defaultFileName.
stream lineEndConvention: #lf.
stream converter: UTF8TextConverter new.
self exportHeader.
self exportTranslations.
self exportUntranslated]
ensure: [stream close]!
----- 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-headers') -----
exportHeader
self exportTag: 'msgid' msg: ''.
self exportTag: 'msgstr' msg: ''.
self createHeaders
do: [:each | self exportHeaderLineKey: each key value: each value].
stream cr; cr!
----- 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>>exportTranslations (in category 'private-translations') -----
exportTranslations
| keys size |
keys := language translations keys asArray sort.
size := keys size.
ProgressInitiationException
display: 'Exporting translated phrases as a gettext file.'
during: [:bar | 1
to: size
do: [:index |
self
exportPhrase: (keys at: index)
translation: (language translations
at: (keys at: index)).
bar value: index / size]]!
----- 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>>exportUntranslated (in category 'private-translations') -----
exportUntranslated
| keys |
keys := language untranslated keys asArray sort.
ProgressInitiationException
display: 'Exporting untranslated phrases as a gettext file.'
at: Sensor cursorPoint
from: 1
to: keys size
during: [:bar | 1
to: keys size
do: [:index |
self
exportPhrase: (keys at: index)
translation: ''.
bar value: index]]!
----- 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: #GetTextExporter2
instanceVariableNames: 'stream'
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Editor'!
!GetTextExporter2 commentStamp: '<historical>' prior: 0!
Export translations to gettext format divided into categories.
"Export gettext template files"
GetTextExporter2 new exportTemplate.
"Export translation files for current locale"
GetTextExporter2 new exportTranslator: (InternalTranslator newLocaleID: LocaleID current).
"Export all gettext template and po files."
GetTextExporter2 exportAll.
"To register a class category as a new domain"
TextDomainManager registerClassCategory: 'Morphic-Books' domain: 'Book'.
"Remove a class category"
TextDomainManager unregisterClassCategory: 'Morphic-Books'.!
----- Method: GetTextExporter2 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: GetTextExporter2 class>>exportAll (in category 'utilities') -----
exportAll
"GetTextExporter2 exportAll"
self new exportTemplate.
InternalTranslator availableLanguageLocaleIDs
do: [:each | self new exportTranslator: each translator]!
----- Method: GetTextExporter2 class>>exportTemplate (in category 'utilities') -----
exportTemplate
"GetTextExporter2 exportTemplate"
self new exportTemplate.!
----- Method: GetTextExporter2 class>>keys (in category 'utilities') -----
keys
| categories |
categories := Dictionary new.
GetTextExporter2 new appendTranslations: categories.
^ categories values
inject: Set new
into: [:set :next | set addAll: next keys;
yourself]!
----- Method: GetTextExporter2 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: GetTextExporter2 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.
GetTextExporter2 new exportTranslator: src.
InternalTranslator removeLocaleID: localeID.
dst := localeID translator.
GetTextImporter import: dst allDirectory: FileDirectory default!
----- Method: GetTextExporter2 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: GetTextExporter2>>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 _ self getTextDomainForPackage:
(PackageOrganizer default packageOfMethod: methodReference ifNone: [TextDomainManager defaultDomain]).
literals _ domains at: domainName ifAbsentPut: [Dictionary new].
keywords do: [ :literal |
references _ literals at: literal ifAbsentPut: [OrderedCollection new].
references add: methodReference.
].
].
!
----- Method: GetTextExporter2>>appendTranslations: (in category 'exporting') -----
appendTranslations: domains
self appendStringReceivers: #translated into: domains.
self appendStringReceivers: #translatedNoop into: domains.
self appendVocabularies: domains.
!
----- Method: GetTextExporter2>>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: GetTextExporter2>>createExtraInformation (in category 'private') -----
createExtraInformation
| extras |
extras := OrderedCollection new.
#(
'Language name as you''d like it to appear in the Languages menu' 'Language-Name'
'Scale to apply to font size (2 for twice as large)' 'Font-Scale'
'Directionality of language' 'Language-Direction'
'Use this if you do not want any of the text to be bolded, for legibility' 'Suppress-Bold'
'Font to use on a Windows system' 'Win-Font'
'Font to use on a Mac system' 'Mac-Font'
'Font to use on a Linux system' 'Linux-Font') pairsDo: [:first :second |
extras add: (Array with: '' with: first with: second).
].
^ extras!
----- Method: GetTextExporter2>>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: GetTextExporter2>>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: GetTextExporter2>>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: GetTextExporter2>>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 := translator
ifNil: [domain , '.pot']
ifNotNil: [translator localeID posixName , '.po'].
dirName := 'po', FileDirectory slash, domain.
pathName := dirName , FileDirectory slash , fileName.
(FileDirectory default directoryNamed: dirName) assureExistence.
^ pathName!
----- Method: GetTextExporter2>>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.
self exportInformation: self createExtraInformation.
self exportBody: literals translator: translator]
ensure: [stream close]!
----- Method: GetTextExporter2>>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: GetTextExporter2>>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: GetTextExporter2>>exportHeaderLineKey:value: (in category 'private') -----
exportHeaderLineKey: keyString value: valueString
stream nextPut: $";
nextPutAll: keyString;
nextPut: $:;
space;
nextPutAll: valueString;
nextPutAll: '\n';
nextPut: $";
cr.!
----- Method: GetTextExporter2>>exportInformation: (in category 'private') -----
exportInformation: anOrderedCollection
anOrderedCollection do: [:each |
self exportRecordHeader: each second.
self exportPhrase: each third translation: ''].
stream cr.!
----- Method: GetTextExporter2>>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: GetTextExporter2>>exportRecordHeader: (in category 'private') -----
exportRecordHeader: context
stream
nextPutAll: '#: ';
nextPutAll: context;
cr.!
----- Method: GetTextExporter2>>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: GetTextExporter2>>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: GetTextExporter2>>exportTemplate (in category 'exporting') -----
exportTemplate
"GetTextExporter2 new exportTemplate"
self exportTranslator: nil!
----- Method: GetTextExporter2>>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: GetTextExporter2>>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: GetTextExporter2>>formatString: (in category 'private') -----
formatString: aString
| result |
result := aString.
self formatReplacements
do: [:each | result := result copyReplaceAll: each key with: each value].
^ result!
----- Method: GetTextExporter2>>getTextDomainForPackage: (in category 'as yet unclassified') -----
getTextDomainForPackage: aPackageInfo
^TextDomainManager domainForPackage: aPackageInfo!
----- Method: GetTextExporter2>>stream (in category 'accessing') -----
stream
^ stream!
----- Method: GetTextExporter2>>stream: (in category 'accessing') -----
stream: aStream
stream := aStream!
----- Method: GetTextExporter2>>translationFor:in: (in category 'private') -----
translationFor: aKey in: translator
translator ifNil: [^''].
translator translations at: aKey ifPresent: [:s | ^s].
"If we have old camelCase translations, make space-separated words"
translator translations at: aKey toCamelCase ifPresent: [:s |
(s includes: Character space) ifTrue: [^s].
^s fromCamelCase].
^''!
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: #ISOLanguageDefinition
instanceVariableNames: 'iso3 iso2 iso3Alternate language'
classVariableNames: 'ISO2Countries ISO2Table ISO3Countries ISO3Table'
poolDictionaries: ''
category: 'GetText-Localization'!
----- Method: ISOLanguageDefinition class>>buildIso3166CodesTables (in category 'private') -----
buildIso3166CodesTables
"ISOLanguageDefinition buildIso3166CodesTables"
| rawdata stream country isoa2 isoa3 unNumeric macName macCode windowsName windowsCode empty table |
rawdata := self iso3166Codes.
table := OrderedCollection new: 200.
stream := rawdata readStream.
empty := 160 asCharacter asString.
[stream atEnd] whileFalse:
[country := stream nextLine.
isoa2 := stream nextLine.
isoa3 := stream nextLine.
unNumeric := stream nextLine.
windowsName := stream nextLine.
windowsName = empty ifTrue: [windowsName := nil].
windowsCode := stream nextLine.
windowsCode = empty ifTrue: [windowsCode := nil].
macName := stream nextLine.
macName = empty ifTrue: [macName := nil].
macCode := stream nextLine.
macCode = empty ifTrue: [macCode := nil].
table add: { country. isoa2. isoa3. unNumeric. windowsName. windowsCode. macName. macCode. }].
^table!
----- Method: ISOLanguageDefinition class>>extraCountryDefinitions (in category 'private') -----
extraCountryDefinitions
^{
{'Kids'. 'KIDS'. 'KIDS'.}.
}!
----- Method: ISOLanguageDefinition class>>extraISO3Definitions (in category 'private') -----
extraISO3Definitions
^self readISOLanguagesFrom: 'jpk Japanese (Kids)
' readStream!
----- Method: ISOLanguageDefinition class>>initISO3LanguageTable (in category 'private') -----
initISO3LanguageTable
"ISOLanguageDefinition initIso3LanguageTable"
| table |
table := ISOLanguageDefinition readISOLanguagesFrom: ISOLanguageDefinition isoLanguages readStream.
table addAll: self extraISO3Definitions.
^table!
----- Method: ISOLanguageDefinition class>>initISOCountries (in category 'private') -----
initISOCountries
"ISOLanguageDefinition initISOCountries"
| iso3166Table |
iso3166Table := ISOLanguageDefinition buildIso3166CodesTables.
ISO2Countries := Dictionary new.
ISO3Countries := Dictionary new.
iso3166Table do: [:entry |
ISO2Countries at: (entry at: 2) put: (entry at: 1).
ISO3Countries at: (entry at: 3) put: (entry at: 1)].
self extraCountryDefinitions do: [:entry |
ISO2Countries at: (entry at: 2) put: (entry at: 1).
ISO3Countries at: (entry at: 3) put: (entry at: 1)]!
----- Method: ISOLanguageDefinition class>>initialize (in category 'class initialization') -----
initialize
"ISOLanguageDefinition initialize"
ISO3Table := nil.
ISO2Table := nil!
----- Method: ISOLanguageDefinition class>>iso2Countries (in category 'private') -----
iso2Countries
"ISOLanguageDefinition iso2Countries"
"ISO2Countries := nil. ISO3Countries := nil"
ISO2Countries ifNil: [self initISOCountries].
^ISO2Countries!
----- Method: ISOLanguageDefinition class>>iso2LanguageDefinition: (in category 'accessing') -----
iso2LanguageDefinition: aString
^self iso2LanguageTable at: aString!
----- Method: ISOLanguageDefinition class>>iso2LanguageTable (in category 'private') -----
iso2LanguageTable
"ISOLanguageDefinition iso2LanguageTable"
ISO2Table ifNotNil: [^ISO2Table].
ISO2Table := Dictionary new: self iso3LanguageTable basicSize.
self iso3LanguageTable do: [:entry |
ISO2Table at: entry iso2 put: entry].
^ISO2Table!
----- Method: ISOLanguageDefinition class>>iso3166Codes (in category 'private') -----
iso3166Codes
"http://www.unicode.org/onlinedat/countries.html"
^'ÅLAND ISLANDS
AX
AFGHANISTAN
AF
AFG
004
ALBANIA
AL
ALB
008
CTRY_ALBANIA
355
ALGERIA
DZ
DZA
012
CTRY_ALGERIA
213
verArabic
16
AMERICAN SAMOA
AS
ASM
016
ANDORRA
AD
AND
020
ANGOLA
AO
AGO
024
ANGUILLA
AI
AIA
660
ANTARCTICA
AQ
ATA
010
ANTIGUA AND BARBUDA
AG
ATG
028
ARGENTINA
AR
ARG
032
CTRY_ARGENTINA
54
ARMENIA
AM
ARM
051
CTRY_ARMENIA
374
verArmenian
84
ARUBA
AW
ABW
533
AUSTRALIA
AU
AUS
036
CTRY_AUSTRALIA
61
verAustralia
15
AUSTRIA
AT
AUT
040
CTRY_AUSTRIA
43
verAustria
92
AZERBAIJAN
AZ
AZE
031
CTRY_AZERBAIJAN
994
BAHAMAS
BS
BHS
044
BAHRAIN
BH
BHR
048
CTRY_BAHRAIN
973
BANGLADESH
BD
BGD
050
verBengali
60
BARBADOS
BB
BRB
052
BELARUS
BY
BLR
112
CTRY_BELARUS
375
BELGIUM
BE
BEL
056
CTRY_BELGIUM
32
verFrBelgium, verFlemish
98
BELIZE
BZ
BLZ
084
CTRY_BELIZE
501
BENIN
BJ
BEN
204
BERMUDA
BM
BMU
060
BHUTAN
BT
BTN
064
verBhutan
83
BOLIVIA
BO
BOL
068
CTRY_BOLIVIA
591
BOSNIA AND HERZEGOVINA
BA
BIH
070
BOTSWANA
BW
BWA
072
BOUVET ISLAND
BV
BVT
074
BRAZIL
BR
BRA
076
CTRY_BRAZIL
55
verBrazil
71
BRITISH INDIAN OCEAN TERRITORY
IO
IOT
086
BRUNEI DARUSSALAM
BN
BRN
096
CTRY_BRUNEI_DARUSSALAM
673
BULGARIA
BG
BGR
100
CTRY_BULGARIA
359
verBulgaria
72
BURKINA FASO
BF
BFA
854
BURUNDI
BI
BDI
108
CAMBODIA
KH
KHM
116
CAMEROON
CM
CMR
120
CANADA
CA
CAN
124
CTRY_CANADA
2
verFrCanada, verEndCanada
82
CAPE VERDE
CV
CPV
132
CAYMAN ISLANDS
KY
CYM
136
CENTRAL AFRICAN REPUBLIC
CF
CAF
140
CHAD
TD
TCD
148
CHILE
CL
CHL
152
CTRY_CHILE
56
CHINA
CN
CHN
156
CTRY_PRCHINA
86
verChina
52
CHRISTMAS ISLAND
CX
CXR
162
COCOS (KEELING) ISLANDS
CC
CCK
166
COLOMBIA
CO
COL
170
CTRY_COLOMBIA
57
COMOROS
KM
COM
174
CONGO
CG
COG
178
CONGO, THE DEMOCRATIC REPUBLIC OF THE
CD
COOK ISLANDS
CK
COK
184
COSTA RICA
CR
CRI
188
CTRY_COSTA_RICA
506
COTE D''IVOIRE
CI
CIV
384
CROATIA (local name: Hrvatska)
HR
HRV
191
CTRY_CROATIA
385
verCroatia, verYugoCroatian
68 (c), 25 (y)
CUBA
CU
CUB
192
CYPRUS
CY
CYP
196
verCyprus
23
CZECH REPUBLIC
CZ
CZE
203
CTRY_CZECH
420
verCzech
56
DENMARK
DK
DNK
208
CTRY_DENMARK
45
verDenmark(da), verFaeroeIsl(fo)
9(da), 47(fo)
DJIBOUTI
DJ
DJI
262
DOMINICA
DM
DMA
212
DOMINICAN REPUBLIC
DO
DOM
214
CTRY_DOMINICAN_REPUBLIC
1
EAST TIMOR
TL
TLS
626
ECUADOR
EC
ECU
218
CTRY_ECUADOR
593
EGYPT
EG
EGY
818
CTRY_EGYPT
20
verArabic
16
EL SALVADOR
SV
SLV
222
CTRY_EL_SALVADOR
503
EQUATORIAL GUINEA
GQ
GNQ
226
ERITREA
ER
ERI
232
ESTONIA
EE
EST
233
CTRY_ESTONIA
372
verEstonia
44
ETHIOPIA
ET
ETH
210
FALKLAND ISLANDS (MALVINAS)
FK
FLK
238
FAROE ISLANDS
FO
FRO
234
CTRY_FAEROE_ISLANDS
298
FIJI
FJ
FJI
242
FINLAND
FI
FIN
246
CTRY_FINLAND
358
verFinland
17
FRANCE
FR
FRA
250
CTRY_FRANCE
33
verFrance
1
FRANCE, METROPOLITAN
FX
FXX
249
FRENCH GUIANA
GF
GUF
254
FRENCH POLYNESIA
PF
PYF
258
FRENCH SOUTHERN TERRITORIES
TF
ATF
260
GABON
GA
GAB
266
GAMBIA
GM
GMB
270
GEORGIA
GE
GEO
268
CTRY_GEORGIA
995
verGeorgian
85
GERMANY
DE
DEU
276
CTRY_GERMANY
49
verGermany
3
GHANA
GH
GHA
288
GIBRALTAR
GI
GIB
292
GREECE
GR
GRC
300
CTRY_GREECE
30
verGreece, verGreecePoly
20, 40
GREENLAND
GL
GRL
304
verGreenland
107
GRENADA
GD
GRD
308
GUADELOUPE
GP
GLP
312
GUAM
GU
GUM
316
GUATEMALA
GT
GTM
320
CTRY_GUATEMALA
502
GUINEA
GN
GIN
324
GUINEA-BISSAU
GW
GNB
624
GUYANA
GY
GUY
328
HAITI
HT
HTI
332
HEARD ISLAND & MCDONALD ISLANDS
HM
HMD
334
HONDURAS
HN
HND
340
CTRY_HONDURAS
504
HONG KONG
HK
HKG
344
CTRY_HONG_KONG
852
HUNGARY
HU
HUN
348
CTRY_HUNGARY
36
verHungary
43
ICELAND
IS
ISL
352
CTRY_ICELAND
354
verIceland
21
INDIA
IN
IND
356
CTRY_INDIA
91
verIndiaHindi(hi)
33
INDONESIA
ID
IDN
360
CTRY_INDONESIA
62
IRAN, ISLAMIC REPUBLIC OF
IR
IRN
364
CTRY_IRAN
981
verIran
48
IRAQ
IQ
IRQ
368
CTRY_IRAQ
964
verArabic
16
IRELAND
IE
IRL
372
CTRY_IRELAND
353
verIreland
50
ISRAEL
IL
ISR
376
CTRY_ISRAEL
972
verIsrael
13
ITALY
IT
ITA
380
CTRY_ITALY
39
verItaly
4
JAMAICA
JM
JAM
388
CTRY_JAMAICA
1
JAPAN
JP
JPN
392
CTRY_JAPAN
81
verJapan
14
JORDAN
JO
JOR
400
CTRY_JORDAN
962
KAZAKHSTAN
KZ
KAZ
398
CTRY_KAZAKSTAN
7
KENYA
KE
KEN
404
CTRY_KENYA
254
KIRIBATI
KI
KIR
296
KOREA, DEMOCRATIC PEOPLE''S REPUBLIC OF
KP
PRK
408
verKorea
51
KOREA, REPUBLIC OF
KR
KOR
410
CTRY_SOUTH_KOREA
82
verKorea
KUWAIT
KW
KWT
414
CTRY_KUWAIT
965
KYRGYZSTAN
KG
KGZ
417
CTRY_KYRGYZSTAN
996
LAO PEOPLE''S DEMOCRATIC REPUBLIC
LA
LAO
418
LATVIA
LV
LVA
428
CTRY_LATVIA
371
verLatvia
45
LEBANON
LB
LBN
422
CTRY_LEBANON
961
LESOTHO
LS
LSO
426
LIBERIA
LR
LBR
430
LIBYAN ARAB JAMAHIRIYA
LY
LBY
434
CTRY_LIBYA
218
verArabic
16
LIECHTENSTEIN
LI
LIE
438
CTRY_LIECHTENSTEIN
41
LITHUANIA
LT
LTU
440
CTRY_LITHUANIA
370
verLithuania
41
LUXEMBOURG
LU
LUX
442
CTRY_LUXEMBOURG
352
verFrBelgiumLux
6
MACAU
MO
MAC
446
CTRY_MACAU
853
MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF
MK
MKD
807
CTRY_MACEDONIA
389
verMacedonian
MADAGASCAR
MG
MDG
450
MALAWI
MW
MWI
454
MALAYSIA
MY
MYS
458
CTRY_MALAYSIA
60
MALDIVES
MV
MDV
462
CTRY_MALDIVES
960
MALI
ML
MLI
466
MALTA
MT
MLT
470
verMalta
22
MARSHALL ISLANDS
MH
MHL
584
MARTINIQUE
MQ
MTQ
474
MAURITANIA
MR
MRT
478
MAURITIUS
MU
MUS
480
MAYOTTE
YT
MYT
175
MEXICO
MX
MEX
484
CTRY_MEXICO
52
MICRONESIA, FEDERATED STATES OF
FM
FSM
583
MOLDOVA, REPUBLIC OF
MD
MDA
498
MONACO
MC
MCO
492
CTRY_MONACO
33
MONGOLIA
MN
MNG
496
CTRY_MONGOLIA
976
MONTSERRAT
MS
MSR
500
MOROCCO
MA
MAR
504
CTRY_MOROCCO
212
verArabic
16
MOZAMBIQUE
MZ
MOZ
508
MYANMAR
MM
MMR
104
NAMIBIA
NA
NAM
516
NAURU
NR
NRU
520
NEPAL
NP
NPL
524
verNepal
106
NETHERLANDS
NL
NLD
528
CTRY_NETHERLANDS
31
verNetherlands
5
NETHERLANDS ANTILLES
AN
ANT
530
NEW CALEDONIA
NC
NCL
540
NEW ZEALAND
NZ
NZL
554
CTRY_NEW_ZEALAND
64
NICARAGUA
NI
NIC
558
CTRY_NICARAGUA
505
NIGER
NE
NER
562
NIGERIA
NG
NGA
566
NIUE
NU
NIU
570
NORFOLK ISLAND
NF
NFK
574
NORTHERN MARIANA ISLANDS
MP
MNP
580
NORWAY
NO
NOR
578
CTRY_NORWAY
47
verNorway
12
OMAN
OM
OMN
512
CTRY_OMAN
968
PAKISTAN
PK
PAK
586
CTRY_PAKISTAN
92
verPakistanUrdu, verPunjabi
34 (U), 95 (P)
PALAU
PW
PLW
585
PANAMA
PA
PAN
591
CTRY_PANAMA
507
PALESTINIAN TERRITORY, OCCUPIED
PS
PAPUA NEW GUINEA
PG
PNG
598
PARAGUAY
PY
PRY
600
CTRY_PARAGUAY
595
PERU
PE
PER
604
CTRY_PERU
51
PHILIPPINES
PH
PHL
608
CTRY_PHILIPPINES
63
PITCAIRN
PN
PCN
612
POLAND
PL
POL
616
CTRY_POLAND
48
verPoland
42
PORTUGAL
PT
PRT
620
CTRY_PORTUGAL
351
verPortugal
10
PUERTO RICO
PR
PRI
630
CTRY_PUERTO_RICO
1
QATAR
QA
QAT
634
CTRY_QATAR
974
REUNION
RE
REU
638
ROMANIA
RO
ROU*
642
CTRY_ROMANIA
40
verRomania
39
RUSSIAN FEDERATION
RU
RUS
643
CTRY_RUSSIA
7
verRussia
49
RWANDA
RW
RWA
646
SAINT KITTS AND NEVIS
KN
KNA
659
SAINT LUCIA
LC
LCA
662
SAINT VINCENT AND THE GRENADINES
VC
VCT
670
SAMOA
WS
WSM
882
SAN MARINO
SM
SMR
674
SAO TOME AND PRINCIPE
ST
STP
678
SAUDI ARABIA
SA
SAU
682
CTRY_SAUDI_ARABIA
966
verArabic
16
SENEGAL
SN
SEN
686
SERBIA AND MONTENEGRO
CS
CTRY_SERBIA
381
SEYCHELLES
SC
SYC
690
SIERRA LEONE
SL
SLE
694
SINGAPORE
SG
SGP
702
CTRY_SINGAPORE
65
verSingapore
100
SLOVAKIA (Slovak Republic)
SK
SVK
703
CTRY_SLOVAK
421
verSlovak
57
SLOVENIA
SI
SVN
705
CTRY_SLOVENIA
386
verSlovenian
66
SOLOMON ISLANDS
SB
SLB
90
SOMALIA
SO
SOM
706
SOUTH AFRICA
ZA
ZAF
710
CTRY_SOUTH_AFRICA
27
SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS
GS
SPAIN
ES
ESP
724
CTRY_SPAIN
34
verSpain
8
SRI LANKA
LK
LKA
144
SAINT HELENA
SH
SHN
654
SAINT PIERRE AND MIQUELON
PM
SPM
666
SUDAN
SD
SDN
736
SURINAME
SR
SUR
740
SVALBARD AND JAN MAYEN ISLANDS
SJ
SJM
744
SWAZILAND
SZ
SWZ
748
SWEDEN
SE
SWE
752
CTRY_SWEDEN
46
verSweden
7
SWITZERLAND
CH
CHE
756
CTRY_SWITZERLAND
41
verFrSwiss(fr), verGrSwiss(de)
18(fr), 19(de)
SYRIAN ARAB REPUBLIC
SY
SYR
760
CTRY_SYRIA
963
TAIWAN, PROVINCE OF CHINA
TW
TWN
158
CTRY_TAIWAN
886
verTaiwan
53
TAJIKISTAN
TJ
TJK
762
TANZANIA, UNITED REPUBLIC OF
TZ
TZA
834
TATARSTAN
CTRY_TATARSTAN
7
THAILAND
TH
THA
764
CTRY_THAILAND
66
verThailand
54
TIMOR-LESTE
TL
TOGO
TG
TGO
768
TOKELAU
TK
TKL
772
TONGA
TO
TON
776
verTonga
88
TRINIDAD AND TOBAGO
TT
TTO
780
CTRY_TRINIDAD_Y_TOBAGO
1
TUNISIA
TN
TUN
788
CTRY_TUNISIA
216
verArabic
16
TURKEY
TR
TUR
792
CTRY_TURKEY
90
verTurkey
24
TURKMENISTAN
TM
TKM
795
TURKS AND CAICOS ISLANDS
TC
TCA
796
TUVALU
TV
TUV
798
UGANDA
UG
UGA
800
UKRAINE
UA
UKR
804
CTRY_UKRAINE
380
verUkraine
62
UNITED ARAB EMIRATES
AE
ARE
784
CTRY_UAE
971
UNITED KINGDOM
GB
GBR
826
CTRY_UNITED_KINGDOM
44
verBritain
2
UNITED STATES
US
USA
840
CTRY_UNITED_STATES
1
verUS
0
UNITED STATES MINOR OUTLYING ISLANDS
UM
UMI
581
URUGUAY
UY
URY
858
CTRY_URUGUAY
598
UZBEKISTAN
UZ
UZB
860
CTRY_UZBEKISTAN
7
VANUATU
VU
VUT
548
VATICAN CITY STATE (HOLY SEE)
VA
VAT
336
VENEZUELA
VE
VEN
862
CTRY_VENEZUELA
58
VIET NAM
VN
VNM
704
CTRY_VIET_NAM
84
verVietnam
VIRGIN ISLANDS (BRITISH)
VG
VGB
92
VIRGIN ISLANDS (U.S.)
VI
VIR
850
WALLIS AND FUTUNA ISLANDS
WF
WLF
876
WESTERN SAHARA
EH
ESH
732
YEMEN
YE
YEM
887
CTRY_YEMEN
967
YUGOSLAVIA
YU
YUG
891
ZAIRE
ZR
ZAR
180
ZAMBIA
ZM
ZMB
894
ZIMBABWE
ZW
ZWE
716
CTRY_ZIMBABWE
263
'!
----- Method: ISOLanguageDefinition class>>iso3Countries (in category 'private') -----
iso3Countries
"ISOLanguageDefinition iso3Countries"
"ISO2Countries := nil. ISO3Countries := nil"
ISO3Countries ifNil: [self initISOCountries].
^ISO3Countries!
----- Method: ISOLanguageDefinition class>>iso3LanguageDefinition: (in category 'accessing') -----
iso3LanguageDefinition: aString
^self iso3LanguageTable at: aString!
----- Method: ISOLanguageDefinition class>>iso3LanguageTable (in category 'private') -----
iso3LanguageTable
"ISOLanguageDefinition iso3LanguageTable"
^ISO3Table ifNil: [ISO3Table := self initISO3LanguageTable]!
----- Method: ISOLanguageDefinition class>>isoLanguages (in category 'private') -----
isoLanguages
"ISO 639: 3-letter codes"
^'aar aa Afar
abk ab Abkhazian
ace Achinese
ach Acoli
ada Adangme
ady Adyghe; Adygei
afa Afro-Asiatic languages
afh Afrihili
afr af Afrikaans
ain Ainu
aka ak Akan
akk Akkadian
alb/sqi sq Albanian
ale Aleut
alg Algonquian languages
alt Southern Altai
amh am Amharic
ang English, Old (ca.450-1100)
anp Angika
apa Apache languages
ara ar Arabic
arc Official Aramaic (700-300 BCE); Imperial Aramaic (700-300 BCE)
arg an Aragonese
arm/hye hy Armenian
arn Mapudungun; Mapuche
arp Arapaho
art Artificial languages
arw Arawak
asm as Assamese
ast Asturian; Bable; Leonese; Asturleonese
ath Athapascan languages
aus Australian languages
ava av Avaric
ave ae Avestan
awa Awadhi
aym ay Aymara
aze az Azerbaijani
bad Banda languages
bai Bamileke languages
bak ba Bashkir
bal Baluchi
bam bm Bambara
ban Balinese
baq/eus eu Basque
bas Basa
bat Baltic languages
bej Beja; Bedawiyet
bel be Belarusian
bem Bemba
ben bn Bengali
ber Berber languages)
bho Bhojpuri
bih bh Bihari
bik Bikol
bin Bini; Edo
bis bi Bislama
bla Siksika
bnt Bantu languages
bos bs Bosnian
bra Braj
bre br Breton
btk Batak languages
bua Buriat
bug Buginese
bul bg Bulgarian
bur/mya my Burmese
byn Blin; Bilin
cad Caddo
cai Central American Indian languages
car Galibi Carib
cat ca Catalan; Valencian
cau Caucasian languages
ceb Cebuano
cel Celtic languages
cha ch Chamorro
chb Chibcha
che ce Chechen
chg Chagatai
chi/zho zh Chinese
chk Chuukese
chm Mari
chn Chinook jargon
cho Choctaw
chp Chipewyan; Dene Suline
chr Cherokee
chu cu Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic
chv cv Chuvash
chy Cheyenne
cmc Chamic languages
cop Coptic
cor kw Cornish
cos co Corsican
cpe Creoles and pidgins, English based
cpf Creoles and pidgins, French-based
cpp Creoles and pidgins, Portuguese-based
cre cr Cree
crh Crimean Tatar; Crimean Turkish
crp Creoles and pidgins
csb Kashubian
cus Cushitic languages
cze/ces cs Czech
dak Dakota
dan da Danish
dar Dargwa
day Land Dayak languages
del Delaware
den Slave (Athapascan)
dgr Dogrib
din Dinka
div dv Divehi; Dhivehi; Maldivian
doi Dogri
dra Dravidian languages
dsb Lower Sorbian
dua Duala
dum Dutch, Middle (ca.1050-1350)
dut/nld nl Dutch; Flemish
dyu Dyula
dzo dz Dzongkha
efi Efik
egy Egyptian (Ancient)
eka Ekajuk
elx Elamite
eng en English
enm English, Middle (1100-1500)
epo eo Esperanto
est et Estonian
ewe ee Ewe
ewo Ewondo
fan Fang
fao fo Faroese
fat Fanti
fij fj Fijian
fil Filipino; Pilipino
fin fi Finnish
fiu Finno-Ugrian languages)
fon Fon
fre/fra fr French
frm French, Middle (ca.1400-1600)
fro French, Old (842-ca.1400)
frr Northern Frisian
frs Eastern Frisian
fry fy Western Frisian
ful ff Fulah
fur Friulian
gaa Ga
gay Gayo
gba Gbaya
gem Germanic languages
geo/kat ka Georgian
ger/deu de German
gez Geez
gil Gilbertese
gla gd Gaelic; Scottish Gaelic
gle ga Irish
glg gl Galician
glv gv Manx
gmh German, Middle High (ca.1050-1500)
goh German, Old High (ca.750-1050)
gon Gondi
gor Gorontalo
got Gothic
grb Grebo
grc Greek, Ancient (to 1453)
gre/ell el Greek, Modern (1453-)
grn gn Guarani
gsw Swiss German; Alemannic; Alsatian
guj gu Gujarati
gwi Gwich''in
hai Haida
hat ht Haitian; Haitian Creole
hau ha Hausa
haw Hawaiian
heb he Hebrew
her hz Herero
hil Hiligaynon
him Himachali
hin hi Hindi
hit Hittite
hmn Hmong
hmo ho Hiri Motu
hrv hr Croatian
hsb Upper Sorbian
hun hu Hungarian
hup Hupa
iba Iban
ibo ig Igbo
ice/isl is Icelandic
ido io Ido
iii ii Sichuan Yi; Nuosu
ijo Ijo languages
iku iu Inuktitut
ile ie Interlingue; Occidental
ilo Iloko
ina ia Interlingua (International Auxiliary Language Association)
inc Indic languages
ind id Indonesian
ine Indo-European languages
inh Ingush
ipk ik Inupiaq
ira Iranian languages
iro Iroquoian languages
ita it Italian
jav jv Javanese
jbo Lojban
jpn ja Japanese
jpr Judeo-Persian
jrb Judeo-Arabic
kaa Kara-Kalpak
kab Kabyle
kac Kachin; Jingpho
kal kl Kalaallisut; Greenlandic
kam Kamba
kan kn Kannada
kar Karen languages
kas ks Kashmiri
kau kr Kanuri
kaw Kawi
kaz kk Kazakh
kbd Kabardian
kha Khasi
khi Khoisan languages
khm km Central Khmer
kho Khotanese; Sakan
kik ki Kikuyu; Gikuyu
kin rw Kinyarwanda
kir ky Kirghiz; Kyrgyz
kmb Kimbundu
kok Konkani
kom kv Komi
kon kg Kongo
kor ko Korean
kos Kosraean
kpe Kpelle
krc Karachay-Balkar
krl Karelian
kro Kru languages
kru Kurukh
kua kj Kuanyama; Kwanyama
kum Kumyk
kur ku Kurdish
kut Kutenai
lad Ladino
lah Lahnda
lam Lamba
lao lo Lao
lat la Latin
lav lv Latvian
lez Lezghian
lim li Limburgan; Limburger; Limburgish
lin ln Lingala
lit lt Lithuanian
lol Mongo
loz Lozi
ltz lb Luxembourgish; Letzeburgesch
lua Luba-Lulua
lub lu Luba-Katanga
lug lg Ganda
lui Luiseno
lun Lunda
luo Luo (Kenya and Tanzania)
lus Lushai
mac/mkd mk Macedonian
mad Madurese
mag Magahi
mah mh Marshallese
mai Maithili
mak Makasar
mal ml Malayalam
man Mandingo
mao/mri mi Maori
map Austronesian languages
mar mr Marathi
mas Masai
may/msa ms Malay
mdf Moksha
mdr Mandar
men Mende
mga Irish, Middle (900-1200)
mic Mi''kmaq; Micmac
min Minangkabau
mis Uncoded languages
mkh Mon-Khmer languages
mlg mg Malagasy
mlt mt Maltese
mnc Manchu
mni Manipuri
mno Manobo languages
moh Mohawk
mon mn Mongolian
mos Mossi
mul Multiple languages
mun Munda languages
mus Creek
mwl Mirandese
mwr Marwari
myn Mayan languages
myv Erzya
nah Nahuatl languages
nai North American Indian languages
nap Neapolitan
nau na Nauru
nav nv Navajo; Navaho
nbl nr Ndebele, South; South Ndebele
nde nd Ndebele, North; North Ndebele
ndo ng Ndonga
nds Low German; Low Saxon; German, Low; Saxon, Low
nep ne Nepali
new Nepal Bhasa; Newari
nia Nias
nic Niger-Kordofanian languages
niu Niuean
nno nn Norwegian Nynorsk; Nynorsk, Norwegian
nob nb Bokmal, Norwegian; Norwegian Bokmal
nog Nogai
non Norse, Old
nor no Norwegian
nqo N''Ko
nso Pedi; Sepedi; Northern Sotho
nub Nubian languages
nwc Classical Newari; Old Newari; Classical Nepal Bhasa
nya ny Chichewa; Chewa; Nyanja
nym Nyamwezi
nyn Nyankole
nyo Nyoro
nzi Nzima
oci oc Occitan (post 1500)
oji oj Ojibwa
ori or Oriya
orm om Oromo
osa Osage
oss os Ossetian; Ossetic
ota Turkish, Ottoman (1500-1928)
oto Otomian languages
paa Papuan languages
pag Pangasinan
pal Pahlavi
pam Pampanga; Kapampangan
pan pa Panjabi; Punjabi
pap Papiamento
pau Palauan
peo Persian, Old (ca.600-400 B.C.)
per/fas fa Persian
phi Philippine languages)
phn Phoenician
pli pi Pali
pol pl Polish
pon Pohnpeian
por pt Portuguese
pra Prakrit languages
pro Provencal, Old (to 1500);Occitan, Old (to 1500)
pus ps Pushto; Pashto
qaa-qtz Reserved for local use
que qu Quechua
raj Rajasthani
rap Rapanui
rar Rarotongan; Cook Islands Maori
roa Romance languages
roh rm Romansh
rom Romany
rum/ron ro Romanian; Moldavian; Moldovan
run rn Rundi
rup Aromanian; Arumanian; Macedo-Romanian
rus ru Russian
sad Sandawe
sag sg Sango
sah Yakut
sai South American Indian languages
sal Salishan languages
sam Samaritan Aramaic
san sa Sanskrit
sas Sasak
sat Santali
scn Sicilian
sco Scots
sel Selkup
sem Semitic languages
sga Irish, Old (to 900)
sgn Sign Languages
shn Shan
sid Sidamo
sin si Sinhala; Sinhalese
sio Siouan languages
sit Sino-Tibetan languages
sla Slavic languages
slo/slk sk Slovak
slv sl Slovenian
sma Southern Sami
sme se Northern Sami
smi Sami languages
smj Lule Sami
smn Inari Sami
smo sm Samoan
sms Skolt Sami
sna sn Shona
snd sd Sindhi
snk Soninke
sog Sogdian
som so Somali
son Songhai languages
sot st Sotho, Southern
spa es Spanish; Castilian
srd sc Sardinian
srn Sranan Tongo
srp sr Serbian
srr Serer
ssa Nilo-Saharan languages
ssw ss Swati
suk Sukuma
sun su Sundanese
sus Susu
sux Sumerian
swa sw Swahili
swe sv Swedish
syc Classical Syriac
syr Syriac
tah ty Tahitian
tai Tai languages
tam ta Tamil
tat tt Tatar
tel te Telugu
tem Timne
ter Tereno
tet Tetum
tgk tg Tajik
tgl tl Tagalog
tha th Thai
tib/bod bo Tibetan
tig Tigre
tir ti Tigrinya
tiv Tiv
tkl Tokelau
tlh Klingon; tlhIngan-Hol
tli Tlingit
tmh Tamashek
tog Tonga (Nyasa)
ton to Tonga (Tonga Islands)
tpi Tok Pisin
tsi Tsimshian
tsn tn Tswana
tso ts Tsonga
tuk tk Turkmen
tum Tumbuka
tup Tupi languages
tur tr Turkish
tut Altaic languages
tvl Tuvalu
twi tw Twi
tyv Tuvinian
udm Udmurt
uga Ugaritic
uig ug Uighur; Uyghur
ukr uk Ukrainian
umb Umbundu
und Undetermined
urd ur Urdu
uzb uz Uzbek
vai Vai
ven ve Venda
vie vi Vietnamese
vol vo Volapuk
vot Votic
wak Wakashan languages
wal Wolaitta; Wolaytta
war Waray
was Washo
wel/cym cy Welsh
wen Sorbian languages
wln wa Walloon
wol wo Wolof
xal Kalmyk; Oirat
xho xh Xhosa
yao Yao
yap Yapese
yid yi Yiddish
yor yo Yoruba
ypk Yupik languages
zap Zapotec
zbl Blissymbols; Blissymbolics; Bliss
zen Zenaga
zha za Zhuang; Chuang
znd Zande languages
zul zu Zulu
zun Zuni
zxx No linguistic content; Not applicable
zza Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki'!
----- Method: ISOLanguageDefinition class>>readISOLanguagesFrom: (in category 'private') -----
readISOLanguagesFrom: stream
"ISOLanguageDefinition readISOLanguagesFrom: ISOLanguageDefinition isoLanguages readStream "
| languages language code3 index line |
languages := Dictionary new.
[stream atEnd
or: [(line := stream nextLine readStream) atEnd]]
whileFalse: [
language := ISOLanguageDefinition new.
code3 := line upTo: Character tab.
(index := code3 indexOf: $/) > 0
ifTrue: [
language iso3: (code3 copyFrom: 1 to: index-1).
language iso3Alternate: (code3 copyFrom: index+1 to: code3 size)]
ifFalse: [language iso3: code3].
language
iso2: (line upTo: Character tab);
language: line upToEnd.
languages at: language iso3 put: language].
^languages!
----- Method: ISOLanguageDefinition>>iso2 (in category 'accessing') -----
iso2
^iso2 ifNil: [self iso3]!
----- Method: ISOLanguageDefinition>>iso2: (in category 'initialize') -----
iso2: aString
iso2 := aString ifEmpty: [nil] ifNotEmpty: [aString]!
----- Method: ISOLanguageDefinition>>iso3 (in category 'accessing') -----
iso3
^iso3 ifNil: ['']!
----- Method: ISOLanguageDefinition>>iso3: (in category 'initialize') -----
iso3: aString
iso3 := aString ifEmpty: [nil] ifNotEmpty: [aString]!
----- Method: ISOLanguageDefinition>>iso3Alternate (in category 'accessing') -----
iso3Alternate
^iso3Alternate ifNil: ['']!
----- Method: ISOLanguageDefinition>>iso3Alternate: (in category 'initialize') -----
iso3Alternate: aString
iso3Alternate := aString ifEmpty: [nil] ifNotEmpty: [aString]!
----- Method: ISOLanguageDefinition>>language (in category 'accessing') -----
language
^language!
----- Method: ISOLanguageDefinition>>language: (in category 'initialize') -----
language: aString
language := aString!
Object subclass: #Locale
instanceVariableNames: 'id shortDate longDate time decimalSymbol digitGrouping currencySymbol currencyNotation measurement offsetLocalToUTC offsetVMToUTC dstActive'
classVariableNames: 'Current CurrentPlatform KnownLocales LanguageSymbols LocaleChangeListeners PlatformEncodings Previous'
poolDictionaries: ''
category: 'GetText-Localization'!
!Locale commentStamp: '<historical>' prior: 0!
Main comment stating the purpose of this class and relevant relationship to other classes.
http://www.w3.org/WAI/ER/IG/ert/iso639.htm
http://www.oasis-open.org/cover/iso639a.html
See also
http://oss.software.ibm.com/cvs/icu/~checkout~/icuhtml/design/language_code_issues.html
http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.10
ISO 3166
http://mitglied.lycos.de/buran/knowhow/codes/locales/
!
----- Method: Locale class>>addLocalChangedListener: (in category 'notification') -----
addLocalChangedListener: anObjectOrClass
self localeChangedListeners add: anObjectOrClass!
----- Method: Locale class>>clipboadInterpreter (in category 'accessing') -----
clipboadInterpreter
^NoConversionClipboardInterpreter new!
----- Method: Locale class>>current (in category 'accessing') -----
current
"Current := nil"
Current ifNil: [
Current := self determineCurrentLocale.
"Transcript show: 'Current locale: ' , Current localeID asString; cr"].
^Current!
----- Method: Locale class>>currentPlatform (in category 'accessing') -----
currentPlatform
"CurrentPlatform := nil"
CurrentPlatform ifNil: [CurrentPlatform := self determineCurrentLocale].
^CurrentPlatform!
----- Method: Locale class>>currentPlatform: (in category 'accessing') -----
currentPlatform: locale
CurrentPlatform := locale.
LanguageEnvironment startUp.
!
----- Method: Locale class>>currentPlatform:during: (in category 'accessing') -----
currentPlatform: locale during: aBlock
"Alter current language platform during a block"
| backupPlatform |
backupPlatform := self currentPlatform.
[self currentPlatform: locale.
aBlock value]
ensure: [self currentPlatform: backupPlatform]!
----- Method: Locale class>>defaultEncodingName: (in category 'platform specific') -----
defaultEncodingName: languageSymbol
| encodings platformName osVersion |
platformName := SmalltalkImage current platformName.
osVersion := SmalltalkImage current getSystemAttribute: 1002.
encodings := self platformEncodings at: languageSymbol
ifAbsent: [self platformEncodings at: #default].
encodings at: platformName ifPresent: [:encoding | ^encoding].
encodings at: platformName , ' ' , osVersion
ifPresent: [:encoding | ^encoding].
^encodings at: #default!
----- Method: Locale class>>defaultInputInterpreter (in category 'platform specific') -----
defaultInputInterpreter
| platformName osVersion |
platformName := SmalltalkImage current platformName.
osVersion := SmalltalkImage current getSystemAttribute: 1002.
(platformName = 'Win32' and: [osVersion = 'CE'])
ifTrue: [^NoInputInterpreter new].
platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new].
^NoInputInterpreter new!
----- Method: Locale class>>determineCurrentLocale (in category 'private') -----
determineCurrentLocale
"For now just return the default locale.
A smarter way would be to determine the current platforms default locale."
"Locale determineCurrentLocale"
^self new determineLocale!
----- Method: Locale class>>initKnownLocales (in category 'private') -----
initKnownLocales
| locales |
locales := Dictionary new.
"Init the locales for which we have translations"
InternalTranslator availableLanguageLocaleIDs do: [:id |
locales at: id put: (Locale new localeID: id)].
^locales!
----- Method: Locale class>>initialize (in category 'class initialization') -----
initialize
"Locale initialize"
Smalltalk addToStartUpList: Locale.
Preferences addPreference: #useLocale
categories: #('general') default: false
balloonHelp: 'Use the system locale to set the system language etc at startup'.!
----- Method: Locale class>>initializePlatformEncodings (in category 'class initialization') -----
initializePlatformEncodings
"Locale initializePlatformEncodings"
| platform |
PlatformEncodings isNil ifTrue: [ PlatformEncodings := Dictionary new ].
platform := PlatformEncodings at: 'default' ifAbsentPut: Dictionary new.
platform
at: 'default' put: 'iso8859-1';
at: 'Win32 CE' put: 'utf-8';
yourself.
platform := PlatformEncodings at: 'ja' ifAbsentPut: Dictionary new.
platform
at: 'default' put: 'shift-jis';
at: 'unix' put: 'euc-jp';
at: 'Win32 CE' put: 'utf-8';
yourself.
platform := PlatformEncodings at: 'ko' ifAbsentPut: Dictionary new.
platform
at: 'default' put: 'euc-kr';
at: 'Win32 CE' put: 'utf-8';
yourself.
platform := PlatformEncodings at: 'zh' ifAbsentPut: Dictionary new.
platform
at: 'default' put: 'gb2312';
at: 'unix' put: 'euc-cn';
at: 'Win32 CE' put: 'utf-8';
yourself.
!
----- Method: Locale class>>isoLanguage: (in category 'accessing') -----
isoLanguage: isoLanguage
^self isoLanguage: isoLanguage isoCountry: nil!
----- Method: Locale class>>isoLanguage:isoCountry: (in category 'accessing') -----
isoLanguage: isoLanguage isoCountry: isoCountry
^self localeID: (LocaleID isoLanguage: isoLanguage isoCountry: isoCountry)!
----- Method: Locale class>>isoLocale: (in category 'accessing') -----
isoLocale: aString
!
----- Method: Locale class>>knownLocales (in category 'private') -----
knownLocales
"KnownLocales := nil"
^KnownLocales ifNil: [KnownLocales := self initKnownLocales]!
----- Method: Locale class>>languageSymbol: (in category 'accessing') -----
languageSymbol: languageSymbol
"Locale languageSymbol: #Deutsch"
^self isoLanguage: (LanguageSymbols at: languageSymbol)!
----- Method: Locale class>>localeChanged (in category 'notification') -----
localeChanged
#(#ParagraphEditor #BitEditor #FormEditor #StandardSystemController )
do: [:key | Smalltalk
at: key
ifPresent: [:class | class initialize]].
PartsBin localeChanged.
Project localeChanged.
PaintBoxMorph localeChanged.
ColorPickerMorph localeChanged.
Preferences localeChanged!
----- Method: Locale class>>localeChangedGently (in category 'notification') -----
localeChangedGently
#(#ParagraphEditor #BitEditor #FormEditor #StandardSystemController )
do: [:key | Smalltalk
at: key
ifPresent: [:class | class initialize]].
PartsBin localeChangedGently.
Project localeChangedGently.
PaintBoxMorph localeChangedGently.
ColorPickerMorph localeChangedGently.
Preferences localeChangedGently.
!
----- Method: Locale class>>localeChangedListeners (in category 'notification') -----
localeChangedListeners
^LocaleChangeListeners ifNil: [LocaleChangeListeners _ OrderedCollection new]!
----- Method: Locale class>>localeID: (in category 'accessing') -----
localeID: id
^self knownLocales at: id ifAbsentPut: [Locale new localeID: id]!
----- Method: Locale class>>migrateSystem (in category 'private') -----
migrateSystem
"Locale migrateSystem"
"Do all the necessary operations to switch to the new Locale environment."
LocaleChangeListeners _ nil.
self
addLocalChangedListener: HandMorph;
addLocalChangedListener: Clipboard;
addLocalChangedListener: Vocabulary;
addLocalChangedListener: PartsBin;
addLocalChangedListener: Project;
addLocalChangedListener: PaintBoxMorph;
yourself!
----- Method: Locale class>>platformEncodings (in category 'class initialization') -----
platformEncodings
PlatformEncodings isEmptyOrNil ifTrue: [ self initializePlatformEncodings ].
^PlatformEncodings
!
----- Method: Locale class>>previous (in category 'accessing') -----
previous
^ Previous
!
----- Method: Locale class>>resetKnownLocales (in category 'private') -----
resetKnownLocales
KnownLocales := nil
!
----- Method: Locale class>>startUp: (in category 'system startUp') -----
startUp: resuming
| newID |
resuming ifFalse: [^self].
(Preferences valueOfFlag: #useLocale)
ifTrue: [
DateAndTime localTimeZone: (TimeZone
offset: (Duration minutes: Locale current offsetLocalToUTC)
name: 'Local Time'
abbreviation: 'LT').
newID := self current determineLocaleID.
newID ~= LocaleID current
ifTrue: [self switchAndInstallFontToID: newID gently: true]]!
----- Method: Locale class>>stringForLanguageNameIs: (in category 'accessing') -----
stringForLanguageNameIs: localeID
"Answer a string for a menu determining whether the given
symbol is the project's natural language"
^ (self current localeID = localeID
ifTrue: ['<yes>']
ifFalse: ['<no>'])
, localeID displayName!
----- Method: Locale class>>switchAndInstallFontToID: (in category 'accessing') -----
switchAndInstallFontToID: localeID
"Locale switchAndInstallFontToID: (LocaleID isoLanguage: 'de')"
| locale |
locale := Locale localeID: localeID.
locale languageEnvironment isFontAvailable
ifFalse: [(self confirm: 'This language needs additional fonts.
Do you want to install the fonts?' translated)
ifTrue: [locale languageEnvironment installFont]
ifFalse: [^ self]].
self
switchTo: locale!
----- Method: Locale class>>switchAndInstallFontToID:gently: (in category 'accessing') -----
switchAndInstallFontToID: localeID gently: gentlyFlag
| locale result env envFound ret fontInImage menu |
"Assumption: Rainbow => can try Pango"
"Logic:
- in Sugar, we don't bother asking any questions, and we don't bother automatically loading fonts.
in Sugar, and if the font is available, use the font.
in Sugar, and if the font is not in the image, try to enable Pango.
- if the previous step fails, notify the user that you cannot switch to the language.
- not in Rainbow,
- if the font is in the image, use the font.
- if the font is not in the image,
- ask to choose:
- load font
- try to enable pango, if pango is available
- or cancel.
- if the previous step fails, notify the user that you cannot switch to the language.
Details:
- how to check non-pango font is available:
- if the language environment for the locale doesn't exist, the font is not available.
- if font loading fails, it is not available.
- how to check if the language environment doesn't exist:
- if the locales languageEnvironment is Latin1 but the locale isn't it is not available.
"
locale := Locale localeID: localeID.
env := locale languageEnvironment.
result := true.
envFound := (Latin1Environment supportedLanguages includes: locale isoLanguage) or: [(env isMemberOf: Latin1Environment) not].
fontInImage := envFound and: [env isFontAvailable].
SugarLauncher isRunningInSugar ifTrue: [
fontInImage ifFalse: [
"font is not available in the image. Even don't ask for font installation."
Cursor wait showWhile: [
Preferences setPreference: #usePangoRenderer toValue: true.
TextMorph usePango: true]].
] ifFalse: [
fontInImage ifFalse: [
menu := MenuMorph new.
menu defaultTarget: menu.
envFound ifTrue: [menu add: 'load font' translated selector: #modalSelection: argument: #loadFont].
RomePluginCanvas pangoIsAvailable ifTrue: [menu add: 'enable Pango' translated selector: #modalSelection: argument: #enablePango].
menu add: 'cancel' translated selector: #modalSelection: argument: #cancel.
menu addTitle: 'This language needs additional fonts.
Do you want to install the fonts?' translated.
ret := menu invokeModal.
ret = #loadFont ifTrue: [result := env installFont. result ifTrue: [StrikeFont setupDefaultFallbackTextStyle]].
ret = #enablePango ifTrue: [
(result := RomePluginCanvas pangoIsAvailable) ifTrue: [
Cursor wait showWhile: [
Preferences setPreference: #usePangoRenderer toValue: true.
TextMorph usePango: true]]].
(ret ~~ #loadFont and: [ret ~~ #enablePango]) ifTrue: [result := false]]].
result ifFalse: [self inform: 'Cannot load additional fonts' translated] ifTrue: [self switchTo: locale gently: gentlyFlag].
!
----- Method: Locale class>>switchTo: (in category 'accessing') -----
switchTo: locale
self switchTo: locale gently: false.
!
----- Method: Locale class>>switchTo:gently: (in category 'accessing') -----
switchTo: locale gently: gentlyFlag
"Locale switchTo: (Locale isoLanguage: 'de')"
| availableID |
availableID := (NaturalLanguageTranslator availableForLocaleID: locale localeID) localeID.
Current localeID = availableID
ifFalse: [Previous _ Current.
CurrentPlatform := Current := Locale localeID: availableID.
NaturalLanguageTranslator localeChanged.
gentlyFlag ifTrue: [self localeChangedGently] ifFalse: [self localeChanged]]!
----- Method: Locale class>>switchToID: (in category 'accessing') -----
switchToID: localeID
"Locale switchToID: (LocaleID isoLanguage: 'de') "
self switchTo: (Locale localeID: localeID)!
----- Method: Locale>>determineLocale (in category 'accessing') -----
determineLocale
self localeID: self determineLocaleID!
----- Method: Locale>>determineLocaleID (in category 'accessing') -----
determineLocaleID
"Locale current determineLocaleID"
| isoLang isoCountry |
isoLang := self fetchISO2Language
ifNil: [^ self localeID].
isoCountry := self fetchISOCountry
ifNil: [^ LocaleID isoLanguage: isoLang].
^ LocaleID isoLanguage: isoLang isoCountry: isoCountry!
----- Method: Locale>>fetchISO2Language (in category 'private') -----
fetchISO2Language
"Locale current fetchISO2Language"
| lang isoLang |
lang := self primLanguage.
lang ifNil: [^nil].
lang := lang copyUpTo: 0 asCharacter.
lang size == 2
ifTrue: [^lang].
isoLang := ISOLanguageDefinition iso3LanguageDefinition: lang.
^isoLang
ifNil: [nil]
ifNotNil: [isoLang iso2]!
----- Method: Locale>>fetchISOCountry (in category 'private') -----
fetchISOCountry
"Locale current fetchISOCountry"
| countryCode |
countryCode := self primCountry
ifNil: [^ nil].
^ countryCode copyUpTo: 0 asCharacter!
----- Method: Locale>>iconForNativeLanguage (in category 'accessing') -----
iconForNativeLanguage
^ (NaturalLanguageFormTranslator localeID: self localeID) translate: 'LanguageNameInNativeLanguage'.
!
----- Method: Locale>>isoCountry (in category 'accessing') -----
isoCountry
^self localeID isoCountry!
----- Method: Locale>>isoLanguage (in category 'accessing') -----
isoLanguage
^self localeID isoLanguage!
----- Method: Locale>>isoLocale (in category 'accessing') -----
isoLocale
"<language>-<country>"
^self isoCountry
ifNil: [self isoLanguage]
ifNotNil: [self isoLanguage , '-' , self isoCountry]!
----- Method: Locale>>languageEnvironment (in category 'accessing') -----
languageEnvironment
^LanguageEnvironment localeID: self localeID!
----- Method: Locale>>localeID (in category 'accessing') -----
localeID
^id!
----- Method: Locale>>localeID: (in category 'accessing') -----
localeID: anID
id := anID!
----- Method: Locale>>offsetLocalToUTC (in category 'accessing') -----
offsetLocalToUTC
^self primTimezone!
----- Method: Locale>>primCountry (in category 'system primitives') -----
primCountry
"Returns string with country tag according to ISO 639"
<primitive: 'primitiveCountry' module: 'LocalePlugin'>
^'US'!
----- Method: Locale>>primCurrencyNotation (in category 'system primitives') -----
primCurrencyNotation
"Returns boolean if symbol is pre- (true) or post-fix (false)"
<primitive: 'primitiveCurrencyNotation' module: 'LocalePlugin'>
^true!
----- Method: Locale>>primCurrencySymbol (in category 'system primitives') -----
primCurrencySymbol
"Returns string with currency symbol"
<primitive: 'primitiveCurrencySymbol' module:'LocalePlugin'>
^'$'!
----- Method: Locale>>primDST (in category 'system primitives') -----
primDST
"Returns boolean if DST (daylight saving time) is active or not"
<primitive:'primitiveDaylightSavings' module: 'LocalePlugin'>
^false!
----- Method: Locale>>primDecimalSymbol (in category 'system primitives') -----
primDecimalSymbol
"Returns string with e.g. '.' or ','"
<primitive:'primitiveDecimalSymbol' module: 'LocalePlugin'>
^'.'!
----- Method: Locale>>primDigitGrouping (in category 'system primitives') -----
primDigitGrouping
"Returns string with e.g. '.' or ',' (thousands etc)"
<primitive:'primitiveDigitGroupingSymbol' module: 'LocalePlugin'>
^','!
----- Method: Locale>>primLanguage (in category 'system primitives') -----
primLanguage
"returns string with language tag according to ISO 639"
<primitive:'primitiveLanguage' module: 'LocalePlugin'>
^'en'
!
----- Method: Locale>>primLongDateFormat (in category 'system primitives') -----
primLongDateFormat
"Returns the long date format
d day, m month, y year,
double symbol is null padded, single not padded (m=6, mm=06)
dddd weekday
mmmm month name"
<primitive:'primitiveLongDateFormat' module: 'LocalePlugin'>
^'dddd, mmmm d, yyyy'!
----- Method: Locale>>primMeasurement (in category 'system primitives') -----
primMeasurement
"Returns boolean denoting metric(true) or imperial(false)."
<primitive:'primitiveMeasurementMetric' module: 'LocalePlugin'>
^true
!
----- Method: Locale>>primShortDateFormat (in category 'system primitives') -----
primShortDateFormat
"Returns the short date format
d day, m month, y year,
double symbol is null padded, single not padded (m=6, mm=06)
dddd weekday
mmmm month name"
<primitive:'primitiveShortDateFormat' module: 'LocalePlugin'>
^'m/d/yy'!
----- Method: Locale>>primTimeFormat (in category 'system primitives') -----
primTimeFormat
"Returns string time format
Format is made up of
h hour (h 12, H 24), m minute, s seconds, x (am/pm String)
double symbol is null padded, single not padded (h=6, hh=06)"
<primitive:'primitiveTimeFormat' module: 'LocalePlugin'>
^'h:mmx'!
----- Method: Locale>>primTimezone (in category 'system primitives') -----
primTimezone
"The offset from UTC in minutes, with positive offsets being towards the east.
(San Francisco is in UTC -07*60 and Paris is in UTC +02*60 when daylight savings is in effect)."
<primitive:'primitiveTimezoneOffset' module: 'LocalePlugin'>
^0!
----- Method: Locale>>primVMOffsetToUTC (in category 'system primitives') -----
primVMOffsetToUTC
"Returns the offset in minutes between the VM and UTC.
If the VM does not support UTC times, this is 0.
Also gives us backward compatibility with old VMs as the primitive will fail and we then can return 0."
<primitive:'primitiveVMOffsetToUTC' module: 'LocalePlugin'>
^0!
----- Method: Locale>>printOn: (in category 'accessing') -----
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '(' , id printString , ')'!
Object subclass: #LocaleID
instanceVariableNames: 'isoLanguage isoCountry'
classVariableNames: ''
poolDictionaries: ''
category: 'GetText-Localization'!
----- Method: LocaleID class>>current (in category 'accessing') -----
current
^Locale current localeID!
----- Method: LocaleID class>>isoLanguage: (in category 'instance creation') -----
isoLanguage: langString
^self isoLanguage: langString isoCountry: nil!
----- Method: LocaleID class>>isoLanguage:isoCountry: (in category 'instance creation') -----
isoLanguage: langString isoCountry: countryStringOrNil
^self new isoLanguage: langString isoCountry: countryStringOrNil!
----- Method: LocaleID class>>isoString: (in category 'instance creation') -----
isoString: isoString
"Parse the isoString (<language>-<country>) into its components and return the matching LocaleID"
"LocaleID isoString: 'en' "
"LocaleID isoString: 'en-us' "
| parts language country |
parts := isoString findTokens: #($- ).
language := parts first.
parts size > 1
ifTrue: [country := parts second].
^self isoLanguage: language isoCountry: country!
----- Method: LocaleID class>>posixName: (in category 'instance creation') -----
posixName: aString
^ self
isoString: (aString copyReplaceAll: '_' with: '-')!
----- Method: LocaleID class>>previous (in category 'accessing') -----
previous
^Locale previous localeID!
----- Method: LocaleID>>= (in category 'comparing') -----
= anotherObject
self class == anotherObject class
ifFalse: [^false].
^self isoLanguage = anotherObject isoLanguage
and: [self isoCountry = anotherObject isoCountry]!
----- Method: LocaleID>>displayCountry (in category 'accessing') -----
displayCountry
^(ISOLanguageDefinition iso2Countries at: self isoCountry asUppercase ifAbsent: [ self isoCountry ]) !
----- Method: LocaleID>>displayLanguage (in category 'accessing') -----
displayLanguage
| language |
language := (ISOLanguageDefinition iso2LanguageTable
at: self isoLanguage
ifAbsent: [^ self isoLanguage]) language.
^ self isoCountry
ifNil: [language]
ifNotNil: [language , ' (' , self displayCountry , ')']!
----- Method: LocaleID>>displayName (in category 'accessing') -----
displayName
"Answer a proper name to represent the receiver in GUI.
The wording is provided by translations of the magic value
'<language display name>'.
'English' -> 'English'
'German' -> 'Deutsch'
"
| magicPhrase translatedMagicPhrase |
magicPhrase := '<language display name>'.
translatedMagicPhrase := NaturalLanguageTranslator translateWithoutLoading: magicPhrase toLocaleID: self.
^ translatedMagicPhrase = magicPhrase
ifTrue: [self displayLanguage]
ifFalse: [translatedMagicPhrase]!
----- Method: LocaleID>>hasParent (in category 'testing') -----
hasParent
^self isoCountry notNil!
----- Method: LocaleID>>hash (in category 'comparing') -----
hash
^self isoLanguage hash bitXor: self isoCountry hash!
----- Method: LocaleID>>isoCountry (in category 'accessing') -----
isoCountry
^isoCountry!
----- Method: LocaleID>>isoLanguage (in category 'accessing') -----
isoLanguage
^isoLanguage!
----- Method: LocaleID>>isoLanguage:isoCountry: (in category 'initialize') -----
isoLanguage: langString isoCountry: countryStringOrNil
isoLanguage := langString.
isoCountry := countryStringOrNil!
----- Method: LocaleID>>isoString (in category 'accessing') -----
isoString
^self asString!
----- Method: LocaleID>>parent (in category 'accessing') -----
parent
^self class isoLanguage: self isoLanguage!
----- Method: LocaleID>>posixName (in category 'printing') -----
posixName
"(LocaleID isoString: 'es-MX') posixName"
"(LocaleID isoString: 'es') posixName"
"language[_territory]"
^ self isoCountry
ifNil: [self isoLanguage]
ifNotNil: [self isoLanguage , '_' , self isoCountry]!
----- Method: LocaleID>>printOn: (in category 'printing') -----
printOn: stream
"<language>-<country>"
stream nextPutAll: self isoLanguage.
self isoCountry
ifNotNil: [stream nextPut: $-; nextPutAll: self isoCountry]!
----- Method: LocaleID>>storeOn: (in category 'printing') -----
storeOn: aStream
aStream nextPut: $(.
aStream nextPutAll: self class name.
aStream nextPutAll: ' isoString: '.
aStream nextPutAll: '''' , self printString , ''''.
aStream nextPut: $).
!
----- Method: LocaleID>>translator (in category 'accessing') -----
translator
^ InternalTranslator localeID: self !
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: #NaturalLanguageFormTranslator
instanceVariableNames: 'id generics'
classVariableNames: 'CachedTranslations'
poolDictionaries: ''
category: 'GetText-Localization'!
----- Method: NaturalLanguageFormTranslator class>>bitmapForJapanese (in category 'as yet unclassified') -----
bitmapForJapanese
^ (Form
extent: 54 at 17
depth: 16
fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65536 0 1 65537 65537 65537 65537 0 0 0 0 1 0 0 0 0 65537 65537 1 65537 65537 65536 1 0 0 0 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 65536 0 0 65536 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 65537 65537 65536 1 0 0 0 1 0 0 65536 0 0 1 0 0 0 1 0 1 65537 65537 65537 65537 65537 65537 0 0 0 1 65537 65537 0 0 1 0 1 0 0 0 1 0 0 0 1 0 0 0 0 65537 65536 0 0 0 65537 65537 0 65536 1 0 0 0 65536 1 0 0 0 1 65537 65537 65537 65537 0 0 0 1 1 1 0 0 0 0 0 0 65536 1 0 0 0 65536 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 0 0 65537 65537 65537 65537 65537 65537 0 0 65536 1 0 0 0 1 0 0 0 1 0 0 0 65536 1 0 65536 0 0 0 0 0 0 0 0 0 0 65536 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 65537 65537 1 65537 65537 65536 0 0 65536 1 0 0 0 1 0 0 0 1 0 0 65536 65537 65537 65537 65536 65536 0 65536 1 1 0 0 65536 0 0 65536 0 65536 0 0 1 0 0 0 1 0 1 0 0 1 0 0 1 0 65536 1 1 0 0 65536 0 1 0 0 65536 0 0 1 65537 65537 65537 65537 0 0 0 0 1 0 0 0 0 65537 65537 1 65537 65537 65536 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 65536 0 0 0 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0)
offset: 0 at 0)!
----- Method: NaturalLanguageFormTranslator class>>cachedTranslations (in category 'accessing') -----
cachedTranslations
"CachedTranslations := nil"
^CachedTranslations ifNil: [CachedTranslations := Dictionary new]!
----- Method: NaturalLanguageFormTranslator class>>cleanUp (in category 'class initialization') -----
cleanUp
"Flush caches"
CachedTranslations := nil!
----- Method: NaturalLanguageFormTranslator class>>initializeJapaneseBitmap (in category 'as yet unclassified') -----
initializeJapaneseBitmap
(self localeID: (LocaleID isoString: 'ja')) name: 'LanguageNameInNativeLanguage' form: self bitmapForJapanese.
!
----- Method: NaturalLanguageFormTranslator class>>isoLanguage: (in category 'accessing') -----
isoLanguage: isoLanguage
"Return the generic language translator as there is no information about the country code"
^self isoLanguage: isoLanguage isoCountry: nil!
----- Method: NaturalLanguageFormTranslator class>>isoLanguage:isoCountry: (in category 'accessing') -----
isoLanguage: isoLanguage isoCountry: isoCountry
^self localeID: (LocaleID isoLanguage: isoLanguage isoCountry: isoCountry)!
----- Method: NaturalLanguageFormTranslator class>>loadFormsFrom: (in category 'i/o') -----
loadFormsFrom: aStream
| rr pair inst |
rr _ ReferenceStream on: aStream.
pair _ rr next.
inst _ self localeID: (LocaleID isoString: pair first).
pair second associationsDo: [:assoc |
inst name: assoc key form: assoc value.
].
^ inst.
!
----- Method: NaturalLanguageFormTranslator class>>localeID: (in category 'accessing') -----
localeID: localeID
^ self cachedTranslations
at: localeID
ifAbsentPut: [self new localeID: localeID]!
----- Method: NaturalLanguageFormTranslator>>generics (in category 'accessing') -----
generics
^generics ifNil: [generics := Dictionary new]!
----- Method: NaturalLanguageFormTranslator>>localeID (in category 'accessing') -----
localeID
^id!
----- Method: NaturalLanguageFormTranslator>>localeID: (in category 'accessing') -----
localeID: anID
id := anID!
----- Method: NaturalLanguageFormTranslator>>name:form: (in category 'accessing') -----
name: formName form: translatedForm
self generics at: formName put: translatedForm.
!
----- Method: NaturalLanguageFormTranslator>>saveFormsOn: (in category 'i/o') -----
saveFormsOn: aStream
| rr |
rr _ ReferenceStream on: aStream.
rr nextPut: {id isoString. generics}.
rr close.
!
----- Method: NaturalLanguageFormTranslator>>translate: (in category 'utilities') -----
translate: aString
^ (self generics
at: aString ifAbsent: [nil]) deepCopy.
"Do you like to write 'form ifNotNil: [form deepCopy]'?"
!
Object subclass: #NaturalLanguageTranslator
instanceVariableNames: 'id'
classVariableNames: 'Translators'
poolDictionaries: ''
category: 'GetText-Localization'!
!NaturalLanguageTranslator commentStamp: '<historical>' prior: 0!
abstract class of natural language translator.
Class side manages and holds loaded instances of concrete classes.!
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]
!
NaturalLanguageTranslator subclass: #InternalTranslator
instanceVariableNames: 'generics'
classVariableNames: 'AllKnownPhrases CachedTranslations'
poolDictionaries: ''
category: 'GetText-Localization'!
!InternalTranslator commentStamp: 'tak 10/19/2007 11:12' prior: 0!
An InternalTranslator is used a translation dictionary in a image.
You can use it without any external translation file.
Structure:
generics Dictionary -- msgid -> msgstr
!
----- Method: InternalTranslator class>>allKnownPhrases (in category 'private') -----
allKnownPhrases
^AllKnownPhrases ifNil: [AllKnownPhrases := Dictionary new: 2051]!
----- Method: InternalTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
availableLanguageLocaleIDs
"Return locale ids for the internal translation dictionary."
"InternalTranslator availableLanguageLocaleIDs"
^ self cachedTranslations values collect:[:each | each localeID]!
----- Method: InternalTranslator class>>cachedTranslations (in category 'private') -----
cachedTranslations
"CachedTranslations := nil"
^CachedTranslations ifNil: [CachedTranslations := Dictionary new]!
----- Method: InternalTranslator class>>directoryForLanguage:country:create: (in category 'private loading') -----
directoryForLanguage: isoLanguage country: isoCountry create: createDir
"Try to locate the <prefs>/locale/<language>{/<country>} folder.
If createDir is set, create the path down to country or language, depending on wether it's specified..
Return the directory for country or language depending on specification.
If neither exists, nil"
"NaturalLanguageTranslator directoryForLanguage: 'es' country: nil create: true"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: 'DE' create: true"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: 'US' create: false"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: nil create: true"
"If this fails, there is nothing we can do about it here"
| localeDir countryDir languageDir |
localeDir := self localeDirCreate: createDir.
localeDir ifNil: [^nil].
isoCountry ifNil: [
languageDir := localeDir directoryNamed: isoLanguage.
createDir
ifTrue: [languageDir assureExistence].
^languageDir exists
ifTrue: [languageDir]
ifFalse: [nil]].
countryDir := languageDir directoryNamed: isoCountry.
createDir
ifTrue: [countryDir assureExistence].
^countryDir exists
ifTrue: [countryDir]
ifFalse: [nil]!
----- Method: InternalTranslator class>>directoryForLocaleID:create: (in category 'private loading') -----
directoryForLocaleID: localeID create: createDir
"Try to locate the <prefs>/locale/<language>{/<country>} folder.
If createDir is set, create the path down to country or language, depending on locale.
Return the directory for country or language depending on locale.
If neither exists, nil"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: nil readOnly: true"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: 'DE' readOnly: true"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: 'US' readOnly: false"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: nil readOnly: true"
^self directoryForLanguage: localeID isoLanguage country: localeID isoCountry create: createDir!
----- Method: InternalTranslator class>>discardAllTranslations (in category 'class initialization') -----
discardAllTranslations
AllKnownPhrases := nil.
self resetCaches.!
----- Method: InternalTranslator class>>fileReaderServicesForFile:suffix: (in category 'file-services') -----
fileReaderServicesForFile: fullName suffix: suffix
"Answer the file services associated with given file"
^ (suffix = self translationSuffix) | (suffix = '*')
ifTrue: [{self serviceMergeLanguageTranslations}]
ifFalse: [#()]!
----- Method: InternalTranslator class>>loadAvailableExternalLocales (in category 'private loading') -----
loadAvailableExternalLocales
"private - register locales IDs based on the content of the <prefs>/locale/ directory"
| localeDir |
localeDir := self localeDirCreate: false.
localeDir ifNil: [^ #()].
localeDir directoryNames
do: [:langDirName |
| langDir |
langDir := localeDir directoryNamed: langDirName.
(langDir fileNamesMatching: '*.' , self translationSuffix)
ifNotEmpty: [self loadTranslatorForIsoLanguage: langDirName isoCountry: nil].
langDir directoryNames
do: [:countryDirName |
| countryDir |
countryDir := langDirName directoryNamed: countryDirName.
(countryDir fileNamesMatching: '*.' , self translationSuffix)
ifNotEmpty: [self loadTranslatorForIsoLanguage: langDirName isoCountry: countryDirName]
]
].
!
----- Method: InternalTranslator class>>loadExternalTranslationsFor: (in category 'private loading') -----
loadExternalTranslationsFor: translator
"Try to load translations from external external files.
The files are located in the <prefs>/locale/<language>{/<country>} folder.
There can be more than one file for each location, so applications can install their own partial translation tables. All files in the specific folder are loaded."
| translationDir |
translationDir := self directoryForLocaleID: translator localeID create: false.
translationDir ifNil: [ ^nil ].
(translationDir fileNamesMatching: '*.' , self translationSuffix)
do: [:fileName | translator loadFromFileNamed: (translationDir fullNameFor: fileName)]!
----- Method: InternalTranslator class>>loadForLocaleIsoString:fromGzippedMimeLiteral: (in category 'file-services') -----
loadForLocaleIsoString: localeString fromGzippedMimeLiteral: mimeString
"merge the translation from the mime literal."
| stream localeID translator gs rbStream s currentPlatform |
s := Base64MimeConverter mimeDecodeToBytes: mimeString readStream.
s reset.
gs := GZipReadStream on: s.
rbStream := MultiByteBinaryOrTextStream with: gs contents asString.
rbStream converter: UTF8TextConverter new.
rbStream reset.
localeID := LocaleID isoString: localeString.
currentPlatform := Locale currentPlatform.
[Locale
currentPlatform: (Locale localeID: localeID).
stream := ReadStream on: rbStream contents]
ensure: [Locale currentPlatform: currentPlatform].
translator := self localeID: localeID.
translator loadFromStream: stream.
LanguageEnvironment resetKnownEnvironments!
----- Method: InternalTranslator class>>loadTranslatorForIsoLanguage:isoCountry: (in category 'private loading') -----
loadTranslatorForIsoLanguage: isoLanguage isoCountry: isoCountry
"private - load the translations from <prefs>/locale/ directory
the procedure is to assure the existence of a translator for the
given language/country and then load the external translations for this translator"
| translator |
translator := self newLocaleID: (LocaleID isoLanguage: isoLanguage isoCountry: isoCountry).
self loadExternalTranslationsFor: translator!
----- Method: InternalTranslator class>>localeDirCreate: (in category 'private loading') -----
localeDirCreate: createDir
"Try to locate the <prefs>/locale/ folder.
If createDir is set, try to create the path.
If it doesn't exist, return nil"
"If this fails, there is nothing we can do about it here"
| prefDir localeDir |
(createDir not
and: [ExternalSettings preferenceDirectory isNil])
ifTrue: [^ nil].
prefDir := ExternalSettings assuredPreferenceDirectory.
prefDir exists
ifFalse: [^nil].
localeDir := prefDir directoryNamed: 'locale'.
createDir
ifTrue: [localeDir assureExistence].
^localeDir exists
ifTrue: [localeDir]
ifFalse: [nil]!
----- Method: InternalTranslator class>>localeID: (in category 'accessing') -----
localeID: localeID
"For backward compatibility, see NaturalLanguageTranslator >> fileOutHeaderOn:."
^ self newLocaleID: localeID!
----- Method: InternalTranslator class>>mergeLegacyTranslators (in category 'accessing') -----
mergeLegacyTranslators
self availableLanguageLocaleIDs
do: [:localeID | (NaturalLanguageTranslator translators includesKey: localeID)
ifFalse: [NaturalLanguageTranslator translators
at: localeID
put: (self newLocaleID: localeID)]]!
----- Method: InternalTranslator class>>mergeTranslationFileNamed: (in category 'file-services') -----
mergeTranslationFileNamed: fileFullNameString
"merge the translation in the file named fileFullNameString"
| stream localeID translator |
stream := FileStream readOnlyFileNamed: fileFullNameString.
[localeID := LocaleID isoString: stream localName sansPeriodSuffix.
translator := self localeID: localeID.
translator loadFromStream: stream]
ensure: [stream close].
LanguageEnvironment resetKnownEnvironments.
!
----- Method: InternalTranslator class>>newLocaleID: (in category 'accessing') -----
newLocaleID: localeID
^ self cachedTranslations
at: localeID
ifAbsentPut: [self new localeID: localeID]!
----- Method: InternalTranslator class>>privateStartUp (in category 'class initialization') -----
privateStartUp
self loadAvailableExternalLocales.
self mergeLegacyTranslators.
!
----- Method: InternalTranslator class>>registerPhrase: (in category 'private') -----
registerPhrase: phrase
"Using a Dictionary so we can lookup existing string instead of creating needless copies when loading a translation."
self allKnownPhrases at: phrase put: phrase!
----- Method: InternalTranslator class>>registeredPhraseFor: (in category 'private') -----
registeredPhraseFor: phrase
"Using a Dictionary so we can lookup existing string instead of creating needless copies when loading a translation."
^self allKnownPhrases at: phrase ifAbsentPut: [phrase]!
----- Method: InternalTranslator class>>removeLocaleID: (in category 'accessing') -----
removeLocaleID: localeID
"self removeLocaleID: (LocaleID isoString: 'ja-kids')"
self cachedTranslations
removeKey: localeID
ifAbsent: [].
NaturalLanguageTranslator privateStartUp!
----- Method: InternalTranslator class>>resetCaches (in category 'class initialization') -----
resetCaches
CachedTranslations := nil.
!
----- Method: InternalTranslator class>>serviceMergeLanguageTranslations (in category 'file-services') -----
serviceMergeLanguageTranslations
"Answer a service for merging of translation files"
^ SimpleServiceEntry
provider: self
label: 'merge the translation file' translatedNoop
selector: #mergeTranslationFileNamed:
description: 'merge the translation file into the language named like the file' translatedNoop
buttonLabel: 'merge' translatedNoop!
----- Method: InternalTranslator class>>services (in category 'file-services') -----
services
"Answer potential file services associated with this class"
^ {self serviceMergeLanguageTranslations}!
----- Method: InternalTranslator class>>translationSuffix (in category 'private') -----
translationSuffix
^'translation'!
----- Method: InternalTranslator>>atRandom (in category 'accessing') -----
atRandom
^ generics atRandom value.
!
----- Method: InternalTranslator>>checkPhrase:translation: (in category 'translation') -----
checkPhrase: phrase translation: translation!
----- Method: InternalTranslator>>defaultBackgroundColor (in category 'user interface') -----
defaultBackgroundColor
"answer the receiver's defaultBackgroundColor for views"
^ Color cyan!
----- Method: InternalTranslator>>fileOutHeader (in category 'fileIn/fileOut') -----
fileOutHeader
^ '''Translation dictionary'''!
----- Method: InternalTranslator>>fileOutHeaderOn: (in category 'user interface') -----
fileOutHeaderOn: aStream
aStream binary.
UTF8TextConverter writeBOMOn: aStream.
aStream text.
aStream nextChunkPut: self fileOutHeader;
cr.
aStream timeStamp; cr.
aStream nextPut: $!!.
aStream nextChunkPut: '(' , self class name , ' localeID: ' , id storeString , ')'.
aStream cr!
----- Method: InternalTranslator>>fileOutHeaderOn:withBOM: (in category 'user interface') -----
fileOutHeaderOn: aStream withBOM: bomFlag
bomFlag ifTrue: [
aStream binary.
UTF8TextConverter writeBOMOn: aStream.
aStream text.
].
aStream nextChunkPut: self fileOutHeader;
cr.
aStream timeStamp; cr.
aStream nextPut: $!!.
aStream nextChunkPut: '(' , self class name , ' localeID: ' , id storeString , ')'.
aStream cr!
----- Method: InternalTranslator>>fileOutOn: (in category 'fileIn/fileOut') -----
fileOutOn: aStream
"self current fileOutOn: Transcript. Transcript endEntry"
self fileOutOn: aStream keys: nil withBOM: true.
!
----- Method: InternalTranslator>>fileOutOn:keys:withBOM: (in category 'fileIn/fileOut') -----
fileOutOn: aStream keys: keys withBOM: bomFlag
"self current fileOutOn: Transcript. Transcript endEntry"
self fileOutHeaderOn: aStream withBOM: bomFlag.
(keys
ifNil: [generics keys asSortedCollection])
do: [:key | self
nextChunkPut: (generics associationAt: key)
on: aStream].
keys
ifNil: [self untranslated
do: [:each | self nextChunkPut: each -> '' on: aStream]].
aStream nextPut: $!!;
cr!
----- Method: InternalTranslator>>generics (in category 'private') -----
generics
^generics ifNil: [generics := Dictionary new]!
----- Method: InternalTranslator>>isDomainLoaded: (in category 'accessing') -----
isDomainLoaded: aDomainName
^true
!
----- Method: InternalTranslator>>loadFromFileNamed: (in category 'private store-retrieve') -----
loadFromFileNamed: fileNameString
"Load translations from an external file"
| stream |
[stream := FileStream readOnlyFileNamed: fileNameString.
self loadFromStream: stream]
ensure: [stream close].
self changed: #translations.
self changed: #untranslated.
!
----- Method: InternalTranslator>>loadFromRefStream: (in category 'private store-retrieve') -----
loadFromRefStream: stream
"Load translations from an external file"
| loadedArray refStream |
refStream := ReferenceStream on: stream.
[loadedArray := refStream next]
ensure: [refStream close].
self processExternalObject: loadedArray !
----- Method: InternalTranslator>>loadFromStream: (in category 'private store-retrieve') -----
loadFromStream: stream
"Load translations from an external file"
| header isFileIn |
header := '''Translation dictionary'''.
isFileIn := (stream next: header size)
= header.
stream reset.
isFileIn
ifTrue: [stream fileInAnnouncing: 'Loading ' translated, stream localName]
ifFalse: [self loadFromRefStream: stream]!
----- Method: InternalTranslator>>mergeTranslations: (in category 'private store-retrieve') -----
mergeTranslations: newTranslations
"Merge a new set of translations into the exiting table.
Overwrites existing entries."
newTranslations keysAndValuesDo: [:key :value |
self rawPhrase: (self class registeredPhraseFor: key) translation: value].
self changed: #translations.
self changed: #untranslated.!
----- Method: InternalTranslator>>nextChunkPut:on: (in category 'fileIn/fileOut') -----
nextChunkPut: anObject on: aStream
| i remainder terminator |
terminator := $!!.
remainder := anObject storeString.
[(i := remainder indexOf: terminator) = 0]
whileFalse: [aStream
nextPutAll: (remainder copyFrom: 1 to: i).
aStream nextPut: terminator.
"double imbedded terminators"
remainder := remainder copyFrom: i + 1 to: remainder size].
aStream nextPutAll: remainder.
aStream nextPut: terminator; cr.!
----- Method: InternalTranslator>>phrase:translation: (in category 'translation') -----
phrase: phraseString translation: translationString
self generics at: phraseString put: translationString asString.
self changed: #translations.
self changed: #untranslated.!
----- Method: InternalTranslator>>processExternalObject: (in category 'private store-retrieve') -----
processExternalObject: anArray
"pivate - process the external object"
"new format -> {translations. untranslated}"
anArray second do: [:each | self class registerPhrase: each].
self mergeTranslations: anArray first!
----- Method: InternalTranslator>>rawPhrase:translation: (in category 'translation') -----
rawPhrase: phraseString translation: translationString
self generics at: phraseString put: translationString asString.
!
----- Method: InternalTranslator>>rawRemoveUntranslated: (in category 'translation') -----
rawRemoveUntranslated: untranslated
self class allKnownPhrases removeKey: untranslated ifAbsent: [].
self changed: #untranslated.!
----- Method: InternalTranslator>>removeTranslationFor: (in category 'translation') -----
removeTranslationFor: phraseString
self generics removeKey: phraseString ifAbsent: [].
self changed: #translations.
self changed: #untranslated.!
----- Method: InternalTranslator>>removeUntranslated: (in category 'translation') -----
removeUntranslated: untranslated
self class allKnownPhrases removeKey: untranslated ifAbsent: [].
!
----- Method: InternalTranslator>>saveToFileNamed: (in category 'private store-retrieve') -----
saveToFileNamed: fileNameString
"save the receiver's translations to a file named fileNameString"
| stream |
"Set true if you need to save as binary"
false
ifTrue: [stream := ReferenceStream fileNamed: fileNameString.
stream nextPut: {self translations. self untranslated}.
stream close.
^ self].
stream := FileStream fileNamed: fileNameString.
[self fileOutOn: stream]
ensure: [stream close]!
----- Method: InternalTranslator>>scanFrom: (in category 'fileIn/fileOut') -----
scanFrom: aStream
"Read a definition of dictionary.
Make sure current locale corresponds my locale id"
| aString newTranslations assoc currentPlatform |
newTranslations := Dictionary new.
currentPlatform := Locale currentPlatform.
[Locale
currentPlatform: (Locale localeID: id).
[aString := aStream nextChunk withSqueakLineEndings.
aString size > 0]
whileTrue: [assoc := Compiler evaluate: aString.
assoc value = ''
ifTrue: [self class registerPhrase: assoc key]
ifFalse: [newTranslations add: assoc]]]
ensure: [Locale currentPlatform: currentPlatform].
self mergeTranslations: newTranslations!
----- Method: InternalTranslator>>translate:inDomain: (in category 'translation') -----
translate: aString inDomain: aDomainName
| translator |
^ self generics
at: aString
ifAbsent: [self localeID hasParent
ifTrue: [translator := self class cachedTranslations
at: self localeID parent
ifAbsent: [^ aString].
translator translate: aString inDomain: aDomainName]
ifFalse: [aString]]!
----- Method: InternalTranslator>>translations (in category 'accessing') -----
translations
^self generics!
----- Method: InternalTranslator>>untranslated (in category 'accessing') -----
untranslated
| translations |
translations := self translations.
^self class allKnownPhrases reject: [:each | translations includesKey: each]!
----- Method: NaturalLanguageTranslator class>>allKnownPhrases (in category 'private') -----
allKnownPhrases
^AllKnownPhrases ifNil: [AllKnownPhrases := Dictionary new: 2051]!
----- Method: NaturalLanguageTranslator class>>availableForLocaleID: (in category 'accessing') -----
availableForLocaleID: localeID
"Answer available locale ID.
If translator is not found for correct locale ID, then isoLanguage is
attempted for the key."
^ self translators
at: localeID
ifAbsent: [localeID hasParent
ifTrue: [self translators
at: localeID parent
ifAbsent: [self default]]
ifFalse: [self default]]!
----- Method: NaturalLanguageTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
availableLanguageLocaleIDs
"Return the locale ids for the currently available languages.
Meaning those which either internally or externally have
translations available."
"NaturalLanguageTranslator availableLanguageLocaleIDs"
^ self translators values collect:[:each | each localeID]!
----- Method: NaturalLanguageTranslator class>>cachedTranslations (in category 'private') -----
cachedTranslations
"CachedTranslations := nil"
^CachedTranslations ifNil: [CachedTranslations := Dictionary new]!
----- Method: NaturalLanguageTranslator class>>cleanUp (in category 'class initialization') -----
cleanUp
"Flush caches"
CachedTranslations := nil.
AllKnownPhrases := nil.!
----- Method: NaturalLanguageTranslator class>>cleanUpCache (in category 'private') -----
cleanUpCache
"NaturalLanguageTranslator cleanUpCache"
self cachedTranslations keys do: [:key |
key isoLanguage size > 2 ifTrue: [self cachedTranslations removeKey: key]]!
----- Method: NaturalLanguageTranslator class>>current (in category 'accessing') -----
current
^ self availableForLocaleID: LocaleID current!
----- Method: NaturalLanguageTranslator class>>default (in category 'accessing') -----
default
"Answer translator for backstop"
"self default translate: 'test'"
^ self new
localeID: (LocaleID isoLanguage: 'en')!
----- Method: NaturalLanguageTranslator class>>directoryForLanguage:country:create: (in category 'private loading') -----
directoryForLanguage: isoLanguage country: isoCountry create: createDir
"Try to locate the <prefs>/locale/<language>{/<country>} folder.
If createDir is set, create the path down to country or language, depending on wether it's specified..
Return the directory for country or language depending on specification.
If neither exists, nil"
"NaturalLanguageTranslator directoryForLanguage: 'es' country: nil create: true"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: 'DE' create: true"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: 'US' create: false"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: nil create: true"
"If this fails, there is nothing we can do about it here"
| localeDir countryDir languageDir |
localeDir := self localeDirCreate: createDir.
localeDir ifNil: [^nil].
isoCountry ifNil: [
languageDir := localeDir directoryNamed: isoLanguage.
createDir
ifTrue: [languageDir assureExistence].
^languageDir exists
ifTrue: [languageDir]
ifFalse: [nil]].
countryDir := languageDir directoryNamed: isoCountry.
createDir
ifTrue: [countryDir assureExistence].
^countryDir exists
ifTrue: [countryDir]
ifFalse: [nil]!
----- Method: NaturalLanguageTranslator class>>directoryForLocaleID:create: (in category 'private loading') -----
directoryForLocaleID: localeID create: createDir
"Try to locate the <prefs>/locale/<language>{/<country>} folder.
If createDir is set, create the path down to country or language, depending on locale.
Return the directory for country or language depending on locale.
If neither exists, nil"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: nil readOnly: true"
"NaturalLanguageTranslator directoryForLanguage: 'de' country: 'DE' readOnly: true"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: 'US' readOnly: false"
"NaturalLanguageTranslator directoryForLanguage: 'en' country: nil readOnly: true"
^self directoryForLanguage: localeID isoLanguage country: localeID isoCountry create: createDir!
----- Method: NaturalLanguageTranslator class>>domainRegistered: (in category 'accessing') -----
domainRegistered: aDomainName
"notify that new TextDomain is registered"
self translators do: [:each | each domainRegistered: aDomainName]!
----- Method: NaturalLanguageTranslator class>>domainUnregistered: (in category 'accessing') -----
domainUnregistered: aDomainName
"notify that new TextDomain is unregistered"
self translators do: [:each | each domainUnregistered: aDomainName]!
----- Method: NaturalLanguageTranslator class>>fileReaderServicesForFile:suffix: (in category 'file-services') -----
fileReaderServicesForFile: fullName suffix: suffix
"Answer the file services associated with given file"
^ (suffix = self translationSuffix) | (suffix = '*')
ifTrue: [{self serviceMergeLanguageTranslations}]
ifFalse: [#()]!
----- Method: NaturalLanguageTranslator class>>initialize (in category 'class initialization') -----
initialize
Smalltalk addToStartUpList: NaturalLanguageTranslator after: FileDirectory.
!
----- Method: NaturalLanguageTranslator class>>isoLanguage: (in category 'accessing') -----
isoLanguage: isoLanguage
"Return the generic language translator as there is no information about the country code"
^self isoLanguage: isoLanguage isoCountry: nil!
----- Method: NaturalLanguageTranslator class>>isoLanguage:isoCountry: (in category 'accessing') -----
isoLanguage: isoLanguage isoCountry: isoCountry
^self localeID: (LocaleID isoLanguage: isoLanguage isoCountry: isoCountry)!
----- Method: NaturalLanguageTranslator class>>loadAvailableExternalLocales (in category 'private loading') -----
loadAvailableExternalLocales
"private - register locales IDs based on the content of the <prefs>/locale/ directory"
| localeDir |
localeDir := self localeDirCreate: false.
localeDir ifNil: [^ #()].
localeDir directoryNames
do: [:langDirName |
| langDir |
langDir := localeDir directoryNamed: langDirName.
(langDir fileNamesMatching: '*.' , self translationSuffix)
ifNotEmpty: [self loadTranslatorForIsoLanguage: langDirName isoCountry: nil].
langDir directoryNames
do: [:countryDirName |
| countryDir |
countryDir := langDir directoryNamed: countryDirName.
(countryDir fileNamesMatching: '*.' , self translationSuffix)
ifNotEmpty: [self loadTranslatorForIsoLanguage: langDirName isoCountry: countryDirName]
]
].
!
----- Method: NaturalLanguageTranslator class>>loadAvailableLocales (in category 'private loading') -----
loadAvailableLocales
"This loads the default locale and all external locales"
| defaultID |
defaultID := LocaleID current.
self cachedTranslations at: defaultID ifAbsent: [self localeID: defaultID].
self loadAvailableExternalLocales.!
----- Method: NaturalLanguageTranslator class>>loadExternalTranslationsFor: (in category 'private loading') -----
loadExternalTranslationsFor: translator
"Try to load translations from external external files.
The files are located in the <prefs>/locale/<language>{/<country>} folder.
There can be more than one file for each location, so applications can install their own partial translation tables. All files in the specific folder are loaded."
| translationDir |
translationDir := self directoryForLocaleID: translator localeID create: false.
translationDir ifNil: [ ^nil ].
(translationDir fileNamesMatching: '*.' , self translationSuffix)
do: [:fileName | translator loadFromFileNamed: (translationDir fullNameFor: fileName)]!
----- Method: NaturalLanguageTranslator class>>loadForLocaleIsoString:fromGzippedMimeLiteral: (in category 'file-services') -----
loadForLocaleIsoString: localeString fromGzippedMimeLiteral: mimeString
"merge the translation from the mime literal."
| stream localeID translator gs rbStream s currentPlatform |
s := Base64MimeConverter mimeDecodeToBytes: mimeString readStream.
s reset.
gs := GZipReadStream on: s.
rbStream := MultiByteBinaryOrTextStream with: gs contents asString.
rbStream converter: UTF8TextConverter new.
rbStream reset.
localeID := LocaleID isoString: localeString.
currentPlatform := Locale currentPlatform.
[Locale
currentPlatform: (Locale localeID: localeID).
stream := ReadStream on: rbStream contents]
ensure: [Locale currentPlatform: currentPlatform].
translator := self localeID: localeID.
translator loadFromStream: stream.
LanguageEnvironment resetKnownEnvironments!
----- Method: NaturalLanguageTranslator class>>loadTranslatorForIsoLanguage:isoCountry: (in category 'private loading') -----
loadTranslatorForIsoLanguage: isoLanguage isoCountry: isoCountry
"private - load the translations from <prefs>/locale/ directory
the procedure is to assure the existence of a translator for the
given language/country and then load the external translations for this translator"
| translator |
translator := self localeID: (LocaleID isoLanguage: isoLanguage isoCountry: isoCountry).
self loadExternalTranslationsFor: translator!
----- Method: NaturalLanguageTranslator class>>localeChanged (in category 'accessing') -----
localeChanged
"notify some project starts to use this locale.
this facility may use the event to load translation data dynamically"
self current setCurrent
!
----- Method: NaturalLanguageTranslator class>>localeDirCreate: (in category 'private loading') -----
localeDirCreate: createDir
"Try to locate the <prefs>/locale/ folder.
If createDir is set, try to create the path.
If it doesn't exist, return nil"
"If this fails, there is nothing we can do about it here"
| prefDir localeDir |
(createDir not
and: [ExternalSettings preferenceDirectory isNil])
ifTrue: [^ nil].
prefDir := ExternalSettings assuredPreferenceDirectory.
prefDir exists
ifFalse: [^nil].
localeDir := prefDir directoryNamed: 'locale'.
createDir
ifTrue: [localeDir assureExistence].
^localeDir exists
ifTrue: [localeDir]
ifFalse: [nil]!
----- Method: NaturalLanguageTranslator class>>localeID: (in category 'accessing') -----
localeID: localeID
^ self cachedTranslations
at: localeID
ifAbsentPut: [self new localeID: localeID]!
----- Method: NaturalLanguageTranslator class>>mergeTranslationFileNamed: (in category 'file-services') -----
mergeTranslationFileNamed: fileFullNameString
"merge the translation in the file named fileFullNameString"
FileStream readOnlyFileNamed: fileFullNameString do: [:stream |
| localeID translator |
localeID := LocaleID isoString: stream localName sansPeriodSuffix.
translator := self localeID: localeID.
translator loadFromStream: stream].
LanguageEnvironment resetKnownEnvironments.
!
----- Method: NaturalLanguageTranslator class>>privateStartUp (in category 'class initialization') -----
privateStartUp
self resetCaches.
GetTextTranslator privateStartUp.
InternalTranslator privateStartUp.
self localeChanged.!
----- Method: NaturalLanguageTranslator class>>registerPhrase: (in category 'private') -----
registerPhrase: phrase
"Using a Dictionary so we can lookup existing string instead of creating needless copies when loading a translation."
self allKnownPhrases at: phrase put: phrase!
----- Method: NaturalLanguageTranslator class>>registeredPhraseFor: (in category 'private') -----
registeredPhraseFor: phrase
"Using a Dictionary so we can lookup existing string instead of creating needless copies when loading a translation."
^self allKnownPhrases at: phrase ifAbsentPut: [phrase]!
----- Method: NaturalLanguageTranslator class>>removeLocaleID: (in category 'accessing') -----
removeLocaleID: localeID
"self removeLocaleID: (LocaleID isoString: 'ja-kids')"
^ self translators
removeKey: localeID
ifAbsent: []!
----- Method: NaturalLanguageTranslator class>>resetCaches (in category 'class initialization') -----
resetCaches
Translators := nil.!
----- Method: NaturalLanguageTranslator class>>serviceMergeLanguageTranslations (in category 'file-services') -----
serviceMergeLanguageTranslations
"Answer a service for merging of translation files"
^ SimpleServiceEntry
provider: self
label: 'merge the translation file'
selector: #mergeTranslationFileNamed:
description: 'merge the translation file into the language named like the file'
buttonLabel: 'merge'!
----- Method: NaturalLanguageTranslator class>>services (in category 'file-services') -----
services
"Answer potential file services associated with this class"
^ {self serviceMergeLanguageTranslations}!
----- Method: NaturalLanguageTranslator class>>startUp: (in category 'class initialization') -----
startUp: resuming
resuming
ifFalse: [^ self].
self privateStartUp.!
----- Method: NaturalLanguageTranslator class>>translate:toLocaleID: (in category 'translation') -----
translate: aString toLocaleID: localeID
"translate for default domain"
^ (self availableForLocaleID: localeID)
translate: aString!
----- Method: NaturalLanguageTranslator class>>translate:toLocaleID:inDomain: (in category 'translation') -----
translate: aString toLocaleID: localeID inDomain: aDomainName
^ (self availableForLocaleID: localeID)
translate: aString inDomain: aDomainName!
----- Method: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID: (in category 'translation') -----
translateWithoutLoading: aString toLocaleID: localeID
"translate for default domain"
^self translateWithoutLoading: aString toLocaleID: localeID inDomain: TextDomainManager defaultDomain.
!
----- Method: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') -----
translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName
"try to translate with small footprint:
if GetTextTranslator hasn't loaded MO, try to use InternalTranslator.
if InternalTranslator isn't available, then actually load MO and use it"
| translator |
translator _ self availableForLocaleID: localeID.
(translator isDomainLoaded: aDomainName) ifFalse: [
(InternalTranslator availableLanguageLocaleIDs includes: localeID)
ifTrue: [translator _ InternalTranslator localeID: localeID].
].
^translator translate: aString inDomain: aDomainName!
----- Method: NaturalLanguageTranslator class>>translationSuffix (in category 'private') -----
translationSuffix
^'translation'!
----- Method: NaturalLanguageTranslator class>>translators (in category 'accessing') -----
translators
^ Translators ifNil: [Translators := Dictionary new] !
----- Method: NaturalLanguageTranslator>>atRandom (in category 'accessing') -----
atRandom
self subclassResponsibility.
!
----- Method: NaturalLanguageTranslator>>checkPhrase:translation: (in category 'translation') -----
checkPhrase: phrase translation: translation!
----- Method: NaturalLanguageTranslator>>defaultBackgroundColor (in category 'user interface') -----
defaultBackgroundColor
"answer the receiver's defaultBackgroundColor for views"
^ Color cyan!
----- Method: NaturalLanguageTranslator>>displayLanguage (in category 'accessing') -----
displayLanguage
^ id displayLanguage!
----- Method: NaturalLanguageTranslator>>displayName (in category 'accessing') -----
displayName
^ id displayName!
----- Method: NaturalLanguageTranslator>>domainRegistered: (in category 'accessing') -----
domainRegistered: aDomainName
"notify that new TextDomain is registered. Concrete subclass can responds to this event if needed"!
----- Method: NaturalLanguageTranslator>>domainUnregistered: (in category 'accessing') -----
domainUnregistered: aDomainName
"notify that new TextDomain is unregistered. Concrete subclass can responds to this event if needed"!
----- Method: NaturalLanguageTranslator>>fileOutHeader (in category 'fileIn/fileOut') -----
fileOutHeader
^ '''Translation dictionary'''!
----- Method: NaturalLanguageTranslator>>fileOutHeaderOn: (in category 'fileIn/fileOut') -----
fileOutHeaderOn: aStream
aStream nextChunkPut: self fileOutHeader;
cr.
aStream timeStamp; cr.
aStream nextPut: $!!.
aStream nextChunkPut: '(' , self class name , ' localeID: ' , id storeString , ')'.
aStream cr!
----- Method: NaturalLanguageTranslator>>fileOutOn: (in category 'fileIn/fileOut') -----
fileOutOn: aStream
"self current fileOutOn: Transcript. Transcript endEntry"
self fileOutHeaderOn: aStream.
self fileOutOn: aStream keys: nil!
----- Method: NaturalLanguageTranslator>>fileOutOn:keys: (in category 'fileIn/fileOut') -----
fileOutOn: aStream keys: keys
"self current fileOutOn: Transcript. Transcript endEntry"
(keys
ifNil: [generics keys asArray sort])
do: [:key | self
nextChunkPut: (generics associationAt: key)
on: aStream].
keys
ifNil: [self untranslated
do: [:each | self nextChunkPut: each -> '' on: aStream]].
aStream nextPut: $!!;
cr!
----- Method: NaturalLanguageTranslator>>generics (in category 'private') -----
generics
^generics ifNil: [generics := Dictionary new]!
----- Method: NaturalLanguageTranslator>>isDomainLoaded: (in category 'accessing') -----
isDomainLoaded: aDomainName
"ask if translation dictionary for the domain has been loaded and available now for use"
self subclassResponsibility.!
----- Method: NaturalLanguageTranslator>>isoCountry (in category 'accessing') -----
isoCountry
^self localeID isoCountry!
----- Method: NaturalLanguageTranslator>>isoLanguage (in category 'accessing') -----
isoLanguage
^self localeID isoLanguage!
----- Method: NaturalLanguageTranslator>>loadFromFileNamed: (in category 'private store-retrieve') -----
loadFromFileNamed: fileNameString
"Load translations from an external file"
FileStream readOnlyFileNamed: fileNameString do: [ :file |
self loadFromStream: file ].
self changed: #translations.
self changed: #untranslated.
!
----- Method: NaturalLanguageTranslator>>loadFromRefStream: (in category 'private store-retrieve') -----
loadFromRefStream: stream
"Load translations from an external file"
| loadedArray refStream |
refStream := ReferenceStream on: stream.
[loadedArray := refStream next]
ensure: [refStream close].
self processExternalObject: loadedArray !
----- Method: NaturalLanguageTranslator>>loadFromStream: (in category 'private store-retrieve') -----
loadFromStream: stream
"Load translations from an external file"
| header isFileIn |
header := '''Translation dictionary'''.
isFileIn := (stream next: header size)
= header.
stream reset.
isFileIn
ifTrue: [stream fileInAnnouncing: 'Loading ' translated, stream localName]
ifFalse: [self loadFromRefStream: stream]!
----- Method: NaturalLanguageTranslator>>localeID (in category 'accessing') -----
localeID
^id!
----- Method: NaturalLanguageTranslator>>localeID: (in category 'initialize-release') -----
localeID: anID
id := anID!
----- Method: NaturalLanguageTranslator>>mergeTranslations: (in category 'private store-retrieve') -----
mergeTranslations: newTranslations
"Merge a new set of translations into the exiting table.
Overwrites existing entries."
newTranslations keysAndValuesDo: [:key :value |
self rawPhrase: (self class registeredPhraseFor: key) translation: value].
self changed: #translations.
self changed: #untranslated.!
----- Method: NaturalLanguageTranslator>>nextChunkPut:on: (in category 'fileIn/fileOut') -----
nextChunkPut: anObject on: aStream
| i remainder terminator |
terminator := $!!.
remainder := anObject storeString.
[(i := remainder indexOf: terminator) = 0]
whileFalse: [aStream
nextPutAll: (remainder copyFrom: 1 to: i).
aStream nextPut: terminator.
"double imbedded terminators"
remainder := remainder copyFrom: i + 1 to: remainder size].
aStream nextPutAll: remainder.
aStream nextPut: terminator; cr.!
----- Method: NaturalLanguageTranslator>>phrase:translation: (in category 'translation') -----
phrase: phraseString translation: translationString
self generics at: phraseString put: translationString asString.
self changed: #translations.
self changed: #untranslated.!
----- Method: NaturalLanguageTranslator>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: self class name; nextPut: $(; print: self localeID; nextPut: $)!
----- Method: NaturalLanguageTranslator>>processExternalObject: (in category 'private store-retrieve') -----
processExternalObject: anArray
"pivate - process the external object"
"new format -> {translations. untranslated}"
anArray second do: [:each | self class registerPhrase: each].
self mergeTranslations: anArray first!
----- Method: NaturalLanguageTranslator>>rawPhrase:translation: (in category 'translation') -----
rawPhrase: phraseString translation: translationString
self generics at: phraseString put: translationString asString.
!
----- Method: NaturalLanguageTranslator>>rawRemoveUntranslated: (in category 'translation') -----
rawRemoveUntranslated: untranslated
self class allKnownPhrases removeKey: untranslated ifAbsent: [].
self changed: #untranslated.!
----- Method: NaturalLanguageTranslator>>removeTranslationFor: (in category 'translation') -----
removeTranslationFor: phraseString
self generics removeKey: phraseString ifAbsent: [].
self changed: #translations.
self changed: #untranslated.!
----- Method: NaturalLanguageTranslator>>removeUntranslated: (in category 'translation') -----
removeUntranslated: untranslated
self class allKnownPhrases removeKey: untranslated ifAbsent: [].
!
----- Method: NaturalLanguageTranslator>>saveToFileNamed: (in category 'private store-retrieve') -----
saveToFileNamed: fileNameString
"save the receiver's translations to a file named fileNameString"
| stream |
"Set true if you need to save as binary"
false
ifTrue: [stream := ReferenceStream fileNamed: fileNameString.
stream nextPut: {self translations. self untranslated}.
stream close.
^ self].
stream := FileStream fileNamed: fileNameString.
[self fileOutOn: stream]
ensure: [stream close]!
----- Method: NaturalLanguageTranslator>>scanFrom: (in category 'fileIn/fileOut') -----
scanFrom: aStream
"Read a definition of dictionary.
Make sure current locale corresponds my locale id"
| newTranslations currentPlatform |
newTranslations := Dictionary new.
currentPlatform := Locale currentPlatform.
[ | aString assoc |
Locale
currentPlatform: (Locale localeID: id).
[aString := aStream nextChunk withSqueakLineEndings.
aString size > 0]
whileTrue: [assoc := Compiler evaluate: aString.
assoc value = ''
ifTrue: [self class registerPhrase: assoc key]
ifFalse: [newTranslations add: assoc]]]
ensure: [Locale currentPlatform: currentPlatform].
self mergeTranslations: newTranslations!
----- Method: NaturalLanguageTranslator>>setCurrent (in category 'language switching') -----
setCurrent
"notify locale of the translator become current"
!
----- Method: NaturalLanguageTranslator>>translate: (in category 'translation') -----
translate: aString
^self translate: aString
inDomain: TextDomainManager defaultDomain!
----- Method: NaturalLanguageTranslator>>translate:in: (in category 'translation') -----
translate: aString in: aContext!
----- Method: NaturalLanguageTranslator>>translate:inDomain: (in category 'translation') -----
translate: aString inDomain: aDomainName
^ aString!
----- Method: NaturalLanguageTranslator>>translationFor: (in category 'translation') -----
translationFor: aString
^self translate: aString!
----- Method: NaturalLanguageTranslator>>translations (in category 'accessing') -----
translations
^self generics!
----- Method: NaturalLanguageTranslator>>untranslated (in category 'accessing') -----
untranslated
| translations |
translations := self translations.
^self class allKnownPhrases reject: [:each | translations includesKey: each]!
----- Method: NaturalLanguageTranslator>>writeAsMimeString (in category 'fileIn/fileOut') -----
writeAsMimeString
| fileName fileStream tmpStream s2 gzs |
tmpStream := MultiByteBinaryOrTextStream on: ''.
tmpStream converter: UTF8TextConverter new.
self fileOutOn: tmpStream.
s2 := RWBinaryOrTextStream on: ''.
gzs := GZipWriteStream on: s2.
tmpStream reset.
gzs nextPutAll: (tmpStream binary contentsOfEntireFile asString) contents.
gzs close.
s2 reset.
fileName := id isoString, '.translation.gz.mime'.
fileStream := FileStream newFileNamed: fileName.
fileStream nextPutAll: (Base64MimeConverter mimeEncode: s2) contents.
fileStream close.
!
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'!
----- 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 class>>makeJapaneseTranslationFile (in category 'as yet unclassified') -----
makeJapaneseTranslationFile
| t n |
NaturalLanguageTranslator initializeKnownPhrases.
t := TranslatedReceiverFinder new senders.
n := NaturalLanguageTranslator
localeID: (LocaleID isoLanguage: 'ja').
t
do: [:w |
NaturalLanguageTranslator registerPhrase: w.
self
at: w
ifPresent: [:k | n phrase: w translation: k]].
n saveToFileNamed: 'ja.translation'!
----- 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>>searchBlockNode:addTo: (in category 'as yet unclassified') -----
searchBlockNode: aBlockNode addTo: aCollection
aBlockNode statements do: [:e |
(e isMemberOf: MessageNode) ifTrue: [self searchMessageNode: e addTo: aCollection].
(e isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: e addTo: aCollection].
].
!
----- Method: TranslatedReceiverFinder>>searchMessageNode:addTo: (in category 'as yet unclassified') -----
searchMessageNode: aMessageNode addTo: aCollection
((aMessageNode receiver isMemberOf: LiteralNode) and: [(aMessageNode selector isMemberOf: SelectorNode) and: [aMessageNode selector key = #translated]]) ifTrue: [
aCollection add: aMessageNode receiver key.
].
(aMessageNode receiver isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMessageNode receiver addTo: aCollection].
(aMessageNode receiver isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMessageNode receiver addTo: aCollection].
(aMessageNode receiver isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMessageNode receiver addTo: aCollection].
aMessageNode arguments do: [:a |
(a isMemberOf: BlockNode) ifTrue: [self searchBlockNode: a addTo: aCollection].
(a isMemberOf: MessageNode) ifTrue: [self searchMessageNode: a addTo: aCollection].
(a isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: a addTo: aCollection].
].
!
----- Method: TranslatedReceiverFinder>>searchMethodNode:addTo: (in category 'as yet unclassified') -----
searchMethodNode: aMethodNode addTo: aCollection
(aMethodNode block isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMethodNode block addTo: aCollection].
(aMethodNode block isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMethodNode block addTo: aCollection].
(aMethodNode block isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMethodNode block addTo: aCollection].
!
----- Method: TranslatedReceiverFinder>>searchReturnNode:addTo: (in category 'as yet unclassified') -----
searchReturnNode: aReturnNode addTo: aCollection
(aReturnNode expr isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aReturnNode expr addTo: aCollection].
(aReturnNode expr isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aReturnNode expr addTo: aCollection].
!
----- Method: TranslatedReceiverFinder>>senders (in category 'as yet unclassified') -----
senders
| m o |
m := SystemNavigation default allCallsOn: #translated.
m := m collect: [:e |
e classIsMeta ifTrue: [
(Smalltalk at: e classSymbol) class decompile: e methodSymbol.
] ifFalse: [
(Smalltalk at: e classSymbol) decompile: e methodSymbol.
]
].
o := OrderedCollection new.
m do: [:e | self searchMethodNode: e addTo: o].
^ o sort
!
----- 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]
!
More information about the Packages
mailing list