'From Squeak3.6beta of ''4 July 2003'' [latest update: #5387] on 10 October 2003 at 4:25:16 am'! "Change Set: Babel-dgd Date: 4 October 2003 Author: Diego Gomez Deck The simplest way to make translatable any code is sending #translated to every visible-string. This message will answer the translation to the current selected language. You can force a language using #translatedTo: languageNameSymbol. For compound strings you can use #format: message. Example: 'Your name is {1} and you are {2} years old.' format: {'Diego'. 30}. For a complete translatable-compound string you can combine both type of messages: 'Your name is {1} and you are {2} years old.' translated format:{'Diego'. 30}. To create another language just create a subclass of Language class naming it with the language wording in English (example: Spanish) and implement the method #name answering a symbol with the name of the language in the language wording (example: #Espa–ol). For more up-to-date information visit: http://swiki.agro.uba.ar/small_land/191 You can find more languages and a tool for the translation works in SqueakMap. All these packages will be named Babel, example: - Babel translator's tool. - Babel Spanish/Espa–ol translation. - Babel French/FranŤais translation. 'Enjoy it' translated. NOTE: Seven languages are included. English is the default and it has to be included, the other six languages are the already-included languages in eToys vocabulary. We can remove them only when the eToys refactoring got made. "! Model subclass: #Language instanceVariableNames: 'translations untranslated debug ' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #Dutch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #English instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #German instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #Kiswahili instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language class instanceVariableNames: 'instance '! Language subclass: #Norwegian instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #Spanish instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! Language subclass: #Swedish instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Babel-Kernel'! !Language methodsFor: 'accessing' stamp: 'dgd 8/27/2003 17:31'! debug "answer the receiver's debug flag" ^ debug! ! !Language methodsFor: 'accessing' stamp: 'dgd 8/27/2003 17:31'! debug: aBoolean "set the receiver's debug flag" debug := aBoolean! ! !Language methodsFor: 'accessing' stamp: 'dgd 8/24/2003 17:56'! name "answer the receiver's name" self subclassResponsibility! ! !Language methodsFor: 'accessing' stamp: 'dgd 8/27/2003 17:30'! switchDebug "switch the receiver's debug flag" self debug: self debug not! ! !Language methodsFor: 'accessing' stamp: 'dgd 8/24/2003 19:11'! translations "answer the receiver's collection of translations" ^ translations! ! !Language methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:10'! untranslated "answer the receiver's collection of untranslated phrases" ^untranslated! ! !Language methodsFor: 'accessing - phrases' stamp: 'dgd 8/25/2003 20:07'! phrase: phraseString translation: translationString "set the receiver's translation for phraseString" | oldUntranslatedSize | translations at: phraseString put: translationString. self changed: #translations. oldUntranslatedSize := untranslated size. untranslated remove: phraseString ifAbsent: []. oldUntranslatedSize = untranslated size ifFalse: [self changed: #untranslated]! ! !Language methodsFor: 'accessing - phrases' stamp: 'dgd 8/27/2003 17:04'! rawTranslationFor: phraseString "answer the receiver's translation for phraseString ignoring the debug flag" ^ translations at: phraseString ifAbsent: [| oldUntranslatedSize | oldUntranslatedSize := untranslated size. untranslated add: phraseString. oldUntranslatedSize = untranslated size ifFalse: [self changed: #untranslated]. phraseString]! ! !Language methodsFor: 'accessing - phrases' stamp: 'dgd 8/26/2003 11:32'! removeTranslationFor: phraseString "answer the receiver's translation for phraseString" translations removeKey: phraseString ifAbsent: []. self changed: #translations.! ! !Language methodsFor: 'accessing - phrases' stamp: 'jm 9/2/2003 12:01'! removeUntranslated: phraseString "remove phraseString from unstranslated set" | oldUntranslatedSize | oldUntranslatedSize := untranslated size. untranslated remove: phraseString ifAbsent:[^self]. oldUntranslatedSize = untranslated size ifFalse: [self changed: #untranslated]! ! !Language methodsFor: 'accessing - phrases' stamp: 'dgd 8/27/2003 16:31'! translationFor: phraseString "answer the receiver's translation for phraseString" | oldUntranslatedSize | translations at: phraseString ifPresent: [:translation | ^ debug ifTrue: [translation , ' (' , phraseString , ')'] ifFalse: [translation]]. oldUntranslatedSize := untranslated size. untranslated add: phraseString. oldUntranslatedSize = untranslated size ifFalse: [self changed: #untranslated]. ^ phraseString! ! !Language methodsFor: 'checking' stamp: 'dgd 9/28/2003 16:47'! check "check the translations and answer a collection with the results" | results counter phrasesCount | results := OrderedCollection new. phrasesCount := translations size + untranslated size. counter := 0. translations keysAndValuesDo: [:phrase :translation | | result | result := self checkPhrase: phrase translation: 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]]. 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! ! !Language methodsFor: 'checking' stamp: 'dgd 9/28/2003 16:57'! checkPhrase: phraseString translation: translationString "check the translation an aswer a string with a comment or a nil meaning no-comments" ((phraseString beginsWith: ' ') and: [(translationString beginsWith: ' ') not]) ifTrue: [^ 'The original phrase begins with a blank and the translation don''t.' translated]. ((phraseString endsWith: ' ') and: [(translationString endsWith: ' ') not]) ifTrue: [^ 'The original phrase ends with a blank and the translation don''t.' translated]. (phraseString onlyLetters notEmpty and: [phraseString onlyLetters first isUppercase] and: [translationString onlyLetters notEmpty] and: [translationString onlyLetters first isUppercase not]) ifTrue: [^ 'The original phrase begins with uppercase and the translation don''t.' translated]. (phraseString onlyLetters notEmpty and: [phraseString onlyLetters first isLowercase] and: [translationString onlyLetters notEmpty] and: [translationString onlyLetters first isLowercase not]) ifTrue: [^ 'The original phrase begins with lowercase and the translation don''t.' translated]. phraseString = translationString ifTrue: [^ 'original and translation are the same']. " (self isPhraseUsed: phraseString) ifFalse: [^ 'The original phrase seems to be unused.' translated]." ^ nil! ! !Language methodsFor: 'checking' stamp: 'dgd 9/28/2003 16:54'! checkUntranslatedPhrase: phraseString "check the phrase an aswer a string with a comment or a nil meaning no-comments" (translations includes: phraseString) ifTrue: [^ 'possible double-translation' translated]. ^ nil! ! !Language methodsFor: 'checking' stamp: 'dgd 9/6/2003 19:12'! isPhraseUsed: phraseString "answer whatever the phraseString is used on any method" " | methods | methods := Smalltalk allSelectNoDoits: [:method | method hasLiteralSuchThat: [:lit | lit class == String and: [lit includesSubstring: phraseString caseSensitive: true]]]. ^ methods notEmpty " Smalltalk allBehaviorsDo: [:class | class selectorsDo: [:selector | selector ~~ #DoIt ifTrue: [ ((class compiledMethodAt: selector) hasLiteralSuchThat: [:literal | literal class == String and: [literal = phraseString ]]) ifTrue: [^ true]]]]. ^ false! ! !Language methodsFor: 'file operations' stamp: 'dgd 8/31/2003 20:28'! loadFromFileNamed: fileNameString "save the receiver's translations to a file named fileNameString" | stream loadedDictionary | stream := ReferenceStream fileNamed: fileNameString. loadedDictionary := stream next. stream close. self initializeTranslations. self initializeUntranslated. self processExternalObject: loadedDictionary! ! !Language methodsFor: 'file operations' stamp: 'dgd 8/31/2003 20:24'! mergeFromFileNamed: fileNameString "save the receiver's translations to a file named fileNameString" | stream loadedDictionary | stream := ReferenceStream fileNamed: fileNameString. loadedDictionary := stream next. stream close. self processExternalObject: loadedDictionary.! ! !Language methodsFor: 'file operations' stamp: 'dgd 8/31/2003 20:25'! mergeFromStream: aStream "save the receiver's translations to a file named aStream" | stream loadedDictionary | stream := ReferenceStream on: aStream. loadedDictionary := stream next. stream close. self processExternalObject: loadedDictionary ! ! !Language methodsFor: 'file operations' stamp: 'dgd 8/31/2003 20:41'! processExternalObject: aDictionaryOrArray "pivate - process the external object" | loadedDictionary loadedSet | (aDictionaryOrArray isKindOf: Dictionary) ifTrue: ["old format without untranslated collection" loadedDictionary := aDictionaryOrArray. loadedSet := Set new] ifFalse: ["new format -> {translations. untranslated}" loadedDictionary := aDictionaryOrArray first. loadedSet := aDictionaryOrArray second]. loadedSet do: [:each | self rawTranslationFor: each]. loadedDictionary keysAndValuesDo: [:key :value | self phrase: key translation: value]! ! !Language methodsFor: 'file operations' stamp: 'dgd 8/31/2003 20:28'! saveToFileNamed: fileNameString "save the receiver's translations to a file named fileNameString" | stream | stream := ReferenceStream fileNamed: fileNameString. stream nextPut: {translations. untranslated}. stream close! ! !Language methodsFor: 'initialization' stamp: 'dgd 8/28/2003 09:44'! initialize "initialize the receiver" debug := false. self initializeTranslations. self initializeUntranslated! ! !Language methodsFor: 'initialization' stamp: 'dgd 8/24/2003 18:15'! initializeTranslations "initialize the receiver's translations dictionary" translations := Dictionary new! ! !Language methodsFor: 'initialization' stamp: 'dgd 8/24/2003 18:16'! initializeUntranslated "initialize the receiver's untranslated collection" untranslated := Set new! ! !Language methodsFor: 'printing' stamp: 'dgd 8/24/2003 18:06'! printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." aStream nextPutAll: 'Language: '; nextPutAll: self name! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/16/2003 21:52'! asHtml: aString | stream | stream := String new writeStream. aString do: [:each | each caseOf: { [Character cr] -> [stream nextPutAll: '
']. [$&] -> [stream nextPutAll: '&']. [$<] -> [stream nextPutAll: '<']. [$>] -> [stream nextPutAll: '>']. [$*] -> [stream nextPutAll: '☆']. [$@] -> [stream nextPutAll: '&at;']} otherwise: [stream nextPut: each]]. ^ stream contents! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/19/2003 13:50'! printHeaderReportOn: aStream "append to aStream a header report of the receiver with swiki format" aStream nextPutAll: '!!!!'; nextPutAll: ('Language: {1}' translated format: {self name}); cr. aStream nextPutAll: '- '; nextPutAll: ('{1} translated phrases' translated format: {translations size}); cr. aStream nextPutAll: '- '; nextPutAll: ('{1} untranslated phrases' translated format: {untranslated size}); cr. aStream cr; cr! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/19/2003 13:47'! printReportOn: aStream "append to aStream a report of the receiver with swiki format" self printHeaderReportOn: aStream. self printUntranslatedReportOn: aStream. self printTranslationsReportOn: aStream! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/19/2003 13:50'! printTranslationsReportOn: aStream "append to aStream a report of the receiver's translations" | originalPhrases | aStream nextPutAll: '!!'; nextPutAll: 'translations' translated; cr. originalPhrases := translations keys asSortedCollection. originalPhrases do: [:each | aStream nextPutAll: ('|{1}|{2}|' format: {self asHtml: each. self asHtml: (translations at: each)}); cr]. aStream cr; cr! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/19/2003 13:50'! printUntranslatedReportOn: aStream "append to aStream a report of the receiver's translations" aStream nextPutAll: '!!'; nextPutAll: 'not translated' translated; cr. untranslated asSortedCollection do: [:each | aStream nextPutAll: ('|{1}|' format: {self asHtml: each}); cr]. aStream cr; cr! ! !Language methodsFor: 'reporting' stamp: 'dgd 9/16/2003 20:30'! reportString "answer a string with a report of the receiver" | stream | stream := String new writeStream. self printReportOn: stream. ^ stream contents! ! !Language methodsFor: 'user interface' stamp: 'dgd 8/24/2003 19:16'! defaultBackgroundColor "answer the receiver's defaultBackgroundColor for views" ^ Color cyan! ! !Dutch methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Nederlands'! ! !English methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'English'! ! !German methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Deutsch'! ! !Kiswahili methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Kiswahili'! ! !Language class methodsFor: 'accessing - instances' stamp: 'dgd 8/24/2003 18:00'! clearAllInstances "clear the receiver instance and the subclasses ones" self withAllSubclasses do: [:each | each clearInstance]! ! !Language class methodsFor: 'accessing - instances' stamp: 'dgd 8/24/2003 18:00'! clearInstance "clear the receiver instance" instance := nil! ! !Language class methodsFor: 'accessing - instances' stamp: 'dgd 8/24/2003 18:23'! instance "answer an instance of the receiver" ^ instance ifNil: [instance := self newInstance]! ! !Language class methodsFor: 'accessing - instances' stamp: 'dgd 8/24/2003 17:54'! newInstance "private - answer a new instance of the receiver" ^ super new initialize! ! !Language class methodsFor: 'accessing - languages' stamp: 'dgd 9/24/2003 18:31'! availableLanguageSymbols "answer a collection of available languages in the image" ^ (self availableLanguages collect: [:each | each name]) asSortedCollection! ! !Language class methodsFor: 'accessing - languages' stamp: 'dgd 9/24/2003 18:07'! availableLanguages "answer a collection of available languages in the image" ^ self allSubclasses select: [:each | each includesSelector: #name] thenCollect: [:each | each instance]! ! !Language class methodsFor: 'accessing - languages' stamp: 'dgd 8/24/2003 18:32'! defaultLanguage "answer the default language" ^ Language languageNamed: Project current naturalLanguage ifNone: [English instance]! ! !Language class methodsFor: 'accessing - languages' stamp: 'dgd 8/24/2003 18:04'! languageNamed: aString "answer the instance of the language named aString" ^ Language availableLanguages detect:[:each | each name = aString]! ! !Language class methodsFor: 'accessing - languages' stamp: 'dgd 8/24/2003 18:32'! languageNamed: aString ifNone: aBlock "answer the instance of the language named aString" ^ Language availableLanguages detect: [:each | each name = aString] ifNone: aBlock! ! !Language class methodsFor: 'instance creation' stamp: 'dgd 8/24/2003 17:54'! new "answer an instance of the receiver" ^ self error: 'use #instance to get the default instance of the receiver'! ! !Language class methodsFor: 'merging' stamp: 'dgd 8/29/2003 21:07'! mergeFromStream: aStream named: fileNameString "merge the translation in aStream named fileNameString" | targetLanguage | targetLanguage := self availableLanguages detect: [:each | each class name = fileNameString or: [each name = fileNameString]] ifNone: [ Transcript show: ('invalid language: {1}' translated format: {fileNameString}); cr. ^ self]. targetLanguage mergeFromStream: aStream ! ! !Language class methodsFor: 'applying' stamp: 'dgd 9/24/2003 18:51'! applyTranslations "private - try to apply the translations as much as possible all over the image" Cursor wait showWhile: [ self recreateFlaps. ParagraphEditor initializeTextEditorMenus. Utilities emptyScrapsBook]! ! !Language class methodsFor: 'applying' stamp: 'dgd 9/24/2003 18:51'! recreateFlaps Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps. (Project current isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]! ! !Norwegian methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Norsk'! ! !Project methodsFor: 'language' stamp: 'dgd 9/24/2003 18:30'! chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem. "Vocabulary languageSymbols" Language availableLanguageSymbols do: [:langSymbol | aMenu addUpdating: #stringForLanguageNameIs: target: self selector: #setNaturalLanguageTo: argumentList: {langSymbol}]. aMenu popUpInWorld "Project current chooseNaturalLanguage"! ! !Project methodsFor: 'language' stamp: 'dgd 9/24/2003 18:53'! setNaturalLanguageTo: aLanguageSymbol "Set the project's natural language as indicated" Vocabulary assureTranslationsAvailableFor: aLanguageSymbol. aLanguageSymbol = self naturalLanguage ifFalse: [self projectParameterAt: #naturalLanguage put: aLanguageSymbol. ActiveWorld allTileScriptingElements do: [:viewerOrScriptor | viewerOrScriptor setNaturalLanguageTo: aLanguageSymbol]. Language applyTranslations]! ! !Spanish methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Espa–ol'! ! !Spanish methodsFor: 'checking' stamp: 'dgd 9/6/2003 18:54'! checkPhrase: phraseString translation: translationString "check the translation an aswer a string with a comment or a nil meaning no-comments" | superResult | superResult := super checkPhrase: phraseString translation: translationString. superResult isNil ifFalse: [^ superResult]. ((translationString withBlanksTrimmed includes: $?) and: [(translationString withBlanksTrimmed includes: $Ŕ) not]) ifTrue: [^ 'ŔOlvid— el signo de pregunta?']. ((translationString withBlanksTrimmed includes: $!!) and: [(translationString withBlanksTrimmed includes: $Á) not]) ifTrue: [^ 'ŔOlvid— el signo de admiraci—n?']. ^ nil! ! !String methodsFor: 'converting' stamp: 'dgd 9/6/2003 18:48'! onlyLetters "answer the receiver with only letters" ^ self select:[:each | each isLetter]! ! !String methodsFor: 'private' stamp: 'dgd 8/27/2003 19:42'! evaluateExpression: aString parameters: aCollection "private - evaluate the expression aString with aCollection as the parameters and answer the evaluation result as an string" | index | index := ('0' , aString) asNumber. index isZero ifTrue: [^ '[invalid subscript: {1}]' format: {aString}]. index > aCollection size ifTrue: [^ '[subscript is out of bounds: {1}]' format: {aString}]. ^ (aCollection at: index) asString! ! !String methodsFor: 'private' stamp: 'dgd 8/27/2003 19:41'! getEnclosedExpressionFrom: aStream "private - get the expression enclosed between '{' and '}' and remove all the characters from the stream" | result currentChar | result := String new writeStream. [aStream atEnd or: [(currentChar := aStream next) == $}]] whileFalse: [result nextPut: currentChar]. ^ result contents withBlanksTrimmed! ! !String methodsFor: 'translating' stamp: 'dgd 8/24/2003 18:36'! translated "answer the receiver translated to the default language" ^ Language defaultLanguage translationFor: self! ! !String methodsFor: 'translating' stamp: 'dgd 8/24/2003 18:36'! translatedTo: languageNameSymbol "answer the receiver translated to the language named languageNameSymbol " ^ (Language languageNamed: languageNameSymbol) translationFor: self! ! !String methodsFor: 'formatting' stamp: 'dgd 8/27/2003 19:49'! format: aCollection "format the receiver with aCollection simplest example: 'foo {1} bar' format: {Date today}. complete example: '\{ \} \\ foo {1} bar {2}' format: {12. 'string'}. " | result stream | result := String new writeStream. stream := self readStream. [stream atEnd] whileFalse: [| currentChar | currentChar := stream next. currentChar == ${ ifTrue: [| expression | expression := self getEnclosedExpressionFrom: stream. result nextPutAll: (self evaluateExpression: expression parameters: aCollection)] ifFalse: [ currentChar == $\ ifTrue: [stream atEnd ifFalse: [result nextPut: stream next]] ifFalse: [result nextPut: currentChar]]]. ^ result contents! ! !Swedish methodsFor: 'accessing' stamp: 'dgd 8/24/2003 18:27'! name "answer the receiver's name" ^ #'Svenska'! !