~drgeo-developers/drgeo/trunk

« back to all changes in this revision

Viewing changes to src/Gettext.pck.st

  • Committer: Hilaire Fernandes
  • Date: 2022-08-07 09:38:52 UTC
  • Revision ID: hilaire.fernandes@gmail.com-20220807093852-kbalk8ybjj3hqv90
Move in necessary packages

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
'From Cuis 6.0 [latest update: #5347] on 3 July 2022 at 12:39:35 pm'!
 
2
'Description '!
 
3
!provides: 'Gettext' 1 19!
 
4
!requires: 'System-Locales' 1 4 nil!
 
5
SystemOrganization addCategory: 'Gettext'!
 
6
 
 
7
 
 
8
!classDefinition: #GetTextExporter category: 'Gettext'!
 
9
Object subclass: #GetTextExporter
 
10
        instanceVariableNames: 'stream'
 
11
        classVariableNames: ''
 
12
        poolDictionaries: 'nil'
 
13
        category: 'Gettext'!
 
14
!classDefinition: 'GetTextExporter class' category: 'Gettext'!
 
15
GetTextExporter class
 
16
        instanceVariableNames: ''!
 
17
 
 
18
!classDefinition: #MOFile category: 'Gettext'!
 
19
Object subclass: #MOFile
 
20
        instanceVariableNames: 'localeID isLittleEndian magic revision nStrings originalTableOffset translatedTableOffset hashTableSize hashTableOffset hashTable originalStrings translatedStrings translations'
 
21
        classVariableNames: 'Cr Lf'
 
22
        poolDictionaries: 'nil'
 
23
        category: 'Gettext'!
 
24
!classDefinition: 'MOFile class' category: 'Gettext'!
 
25
MOFile class
 
26
        instanceVariableNames: ''!
 
27
 
 
28
!classDefinition: #NaturalLanguageTranslator category: 'Gettext'!
 
29
Object subclass: #NaturalLanguageTranslator
 
30
        instanceVariableNames: 'id'
 
31
        classVariableNames: 'Translators'
 
32
        poolDictionaries: 'nil'
 
33
        category: 'Gettext'!
 
34
!classDefinition: 'NaturalLanguageTranslator class' category: 'Gettext'!
 
35
NaturalLanguageTranslator class
 
36
        instanceVariableNames: ''!
 
37
 
 
38
!classDefinition: #GetTextTranslator category: 'Gettext'!
 
39
NaturalLanguageTranslator subclass: #GetTextTranslator
 
40
        instanceVariableNames: 'moFiles'
 
41
        classVariableNames: 'LocaleDirsForDomain SystemDefaultLocaleDirs UserDefaultLocaleDirs'
 
42
        poolDictionaries: 'nil'
 
43
        category: 'Gettext'!
 
44
!classDefinition: 'GetTextTranslator class' category: 'Gettext'!
 
45
GetTextTranslator class
 
46
        instanceVariableNames: ''!
 
47
 
 
48
!classDefinition: #TextDomainInfo category: 'Gettext'!
 
49
Object subclass: #TextDomainInfo
 
50
        instanceVariableNames: 'categoryPrefixes categories'
 
51
        classVariableNames: ''
 
52
        poolDictionaries: 'nil'
 
53
        category: 'Gettext'!
 
54
!classDefinition: 'TextDomainInfo class' category: 'Gettext'!
 
55
TextDomainInfo class
 
56
        instanceVariableNames: ''!
 
57
 
 
58
!classDefinition: #TextDomainManager category: 'Gettext'!
 
59
Object subclass: #TextDomainManager
 
60
        instanceVariableNames: ''
 
61
        classVariableNames: 'ClassCategories Classes DefaultDomain DomainInfos LoneClasses'
 
62
        poolDictionaries: 'nil'
 
63
        category: 'Gettext'!
 
64
!classDefinition: 'TextDomainManager class' category: 'Gettext'!
 
65
TextDomainManager class
 
66
        instanceVariableNames: ''!
 
67
 
 
68
!classDefinition: #TranslatedReceiverFinder category: 'Gettext'!
 
69
Object subclass: #TranslatedReceiverFinder
 
70
        instanceVariableNames: ''
 
71
        classVariableNames: ''
 
72
        poolDictionaries: 'nil'
 
73
        category: 'Gettext'!
 
74
!classDefinition: 'TranslatedReceiverFinder class' category: 'Gettext'!
 
75
TranslatedReceiverFinder class
 
76
        instanceVariableNames: ''!
 
77
 
 
78
 
 
79
!GetTextExporter commentStamp: '' prior: 0!
 
80
Export translations to gettext format divided into categories.
 
81
 
 
82
"Export gettext template files"
 
83
GetTextExporter new exportTemplate.
 
84
 
 
85
"Export translation files for current locale"
 
86
GetTextExporter new exportTranslator: (InternalTranslator newLocaleID: LocaleID current).
 
87
 
 
88
"Export all gettext template and po files."
 
89
GetTextExporter exportAll.
 
90
 
 
91
"To register a class category as a new domain"
 
92
TextDomainManager registerClassCategory: 'Morphic-Books' domain: 'Book'.
 
93
"Remove a class category"
 
94
TextDomainManager unregisterClassCategory: 'Morphic-Books'.!
 
95
 
 
96
!MOFile commentStamp: '' prior: 0!
 
97
Wrapper for MO file of gettext.
 
98
Known limitation:  
 
99
        currently don't support prural form.
 
100
        translation strings have to be encoded in utf-8.
 
101
 
 
102
Implementation notes:
 
103
        Testing on XO showed emulation of hash search without plugin + on demand loading is slow.
 
104
        The test also showed conversion of utf8 string to Squeak's String is really slow (especially for non-latin language).
 
105
        so in this version, all of original/translated strings are loaded on initiaization,
 
106
        but "translated strings" is left as ByteString on loading time, to reduce loading time.
 
107
        After that the translated string is converted on demand. 
 
108
!
 
109
 
 
110
!NaturalLanguageTranslator commentStamp: '<historical>' prior: 0!
 
111
abstract class of natural language translator.
 
112
Class side manages and holds loaded instances of concrete classes.
 
113
 
 
114
To refresh translators:
 
115
NaturalLanguageTranslator privateStartUp!
 
116
 
 
117
!GetTextTranslator commentStamp: '' prior: 0!
 
118
emulation of gettext runtime
 
119
Known limitation:  
 
120
     currently don't support prural form.
 
121
!
 
122
 
 
123
!TextDomainInfo commentStamp: '' prior: 0!
 
124
I hold criteria for deciding wheter a systemCategory belongs to domain. 
 
125
- categoryPrefixes is collection of prefix of class category.
 
126
- categories is for specifying fine grained criterion.
 
127
!
 
128
 
 
129
!TextDomainManager commentStamp: '<historical>' prior: 0!
 
130
I manages mapping from class category to textdomain (.mo files).
 
131
 
 
132
Usage:
 
133
        TextDomainManager registerCategoryPrefix: 'DrGeo' domain: 'drgeo'.
 
134
        TextDomainManager unregisterDomain: 'DrGeo'.
 
135
 
 
136
        TextDomainManager registerClass: #TerseGuideHelp domain: 'guides'.
 
137
 
 
138
The domain name map to a .mo file in {image|vm}Path/locale/{lang}/LC_MESSAGES/domain.mo
 
139
For example locale/fr/LC_MESSAGES/drgeo.mo
 
140
{lang} is the host language locale resolved by the System-Locales package.
 
141
 
 
142
Class variables:
 
143
 ClassCategories                                IdentityDictionary -- classCategory -> domainName 
 
144
 Classes                                IdentityDictionary -- class name (a Symbol) -> domainName   (a cache only!!)
 
145
 DefaultDomain                          String -- the default domain name
 
146
 DomainInfos                            Dictionary -- domainName -> a TextDomainInfo
 
147
 LoneClasses                            IdentityDictionary -- class name (a Symbol) -> domainName.  For classes whose entire category are not all in the same domain (BookMorph and QuickGuideMorph)
 
148
 
 
149
!
 
150
 
 
151
!TranslatedReceiverFinder commentStamp: '' prior: 0!
 
152
I am a utility class of Gettext. Most uses are internal to Gettext.
 
153
 
 
154
You can use me to browse all methods sending translation messages to non-string receivers:
 
155
 
 
156
        TranslatedReceiverFinder browseNonLiteralReceivers!
 
157
 
 
158
!GetTextExporter methodsFor: 'exporting'!
 
159
appendTranslations: domains 
 
160
 
 
161
        self 
 
162
                appendTranslations: domains 
 
163
                for: self class defaultSelectors ! !
 
164
 
 
165
!GetTextExporter methodsFor: 'exporting'!
 
166
appendTranslations: domains for: someSelectors
 
167
        "Append translations in the given domains.
 
168
        Will be done by searching for strings receiving the given selectors"
 
169
 
 
170
        someSelectors do:[ :selector |
 
171
                self appendStringReceivers: selector into: domains]
 
172
! !
 
173
 
 
174
!GetTextExporter methodsFor: 'exporting' stamp: 'hlsf 3/5/2022 14:32:37'!
 
175
dirNameDomain: domain
 
176
"Answer a file name for the domain."
 
177
        ^ 'po' asDirectoryEntry / domain // (domain , '.pot')
 
178
! !
 
179
 
 
180
!GetTextExporter methodsFor: 'exporting' stamp: 'hlsf 3/5/2022 14:49:45'!
 
181
exportFor: someSelectors
 
182
"Export translation files. the file extention is 'pot'"
 
183
        | domains |
 
184
        domains _ Dictionary new.
 
185
        self appendTranslations: domains for: someSelectors.
 
186
        domains         keysAndValuesDo: [:domainName :value |  
 
187
                self export: value      domain: domainName]! !
 
188
 
 
189
!GetTextExporter methodsFor: 'exporting' stamp: 'hlsf 3/5/2022 14:48:19'!
 
190
exportTemplate
 
191
        "GetTextExporter new exportTemplate"
 
192
        self exportFor: self class defaultSelectors ! !
 
193
 
 
194
!GetTextExporter methodsFor: 'file out' stamp: 'hlsf 3/5/2022 14:41:32'!
 
195
exportBody: literals
 
196
        "Export a gettext file body. literals is a dictionary of keyword ->
 
197
        #(MethodReference...) in the textDomain."
 
198
        "Build {sortKey. comment. msgid } to optimize sorting (getting category is
 
199
        too slow).
 
200
        If there are two or more methods for a mgsid, only first method
 
201
        (alphabetical) is used for sorting."
 
202
        | sorted msgid sortedMethods category sortKey comment triplets commentUnderLined |
 
203
        triplets _ literals associations collect: [:assoc | 
 
204
                msgid _ assoc key.
 
205
                sortedMethods _ assoc value asArray sort.
 
206
                category _ sortedMethods first actualClass category asString.
 
207
                sortKey _ category , ',' , sortedMethods first printString , ',' , msgid.
 
208
                comment _ (sortedMethods
 
209
                        collect: [:each | each actualClass asString , '>>' , each selector asString])
 
210
                        inject: category
 
211
                        into: [:result :methodName | result , ',' , methodName].
 
212
                "Replace white spaces to _ because gettext tool might replace a space to 
 
213
                a new line some times, and it makes             difficult to take a diff."
 
214
                commentUnderLined _ comment copyReplaceAll: ' ' with: '_'.
 
215
                Array   with: sortKey with: commentUnderLined with: msgid].
 
216
        
 
217
        "Sort and output the words"
 
218
        sorted _ triplets                       sort: [:a :b | a first <= b first].
 
219
        sorted  do: [:triplet | 
 
220
                comment _ triplet second.
 
221
                msgid _ triplet third.
 
222
                self exportRecordHeader: comment.
 
223
                self exportPhrase: msgid]! !
 
224
 
 
225
!GetTextExporter methodsFor: 'accessing'!
 
226
stream
 
227
        ^ stream! !
 
228
 
 
229
!GetTextExporter methodsFor: 'accessing'!
 
230
stream: aStream
 
231
        stream _ aStream! !
 
232
 
 
233
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:18:51'!
 
234
appendStringReceivers: aSymbol into: domains
 
235
        | literals references domainName methodReference keywords found |
 
236
        
 
237
        found _ TranslatedReceiverFinder new stringReceiversOf: aSymbol.
 
238
        found do: [ :assoc |
 
239
                methodReference _ assoc key.
 
240
                keywords _ assoc value.
 
241
                domainName _ self getTextDomainForClassCategory:                        methodReference methodClass category.
 
242
                literals _ domains at: domainName ifAbsentPut: [Dictionary new].
 
243
                keywords do: [ :literal |
 
244
                        references _ literals at: literal ifAbsentPut: [OrderedCollection new].
 
245
                        references add: methodReference.
 
246
                ].
 
247
        ]. 
 
248
! !
 
249
 
 
250
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:42:28'!
 
251
createHeaders
 
252
        | headers |
 
253
        headers _ OrderedCollection new.
 
254
        headers add: 'Project-Id-Version' -> 'Cuis'.
 
255
        headers add: 'POT-Creation-Date' -> self currentDateAndTime.
 
256
        headers add: 'PO-Revision-Date' -> self currentDateAndTime.
 
257
        headers add: 'Last-Translator' -> ''.
 
258
        headers add: 'Language-Team' -> ''.
 
259
        headers add: 'MIME-Version' -> '1.0'.
 
260
        headers add: 'Content-Type' -> ('text/plain; charset=ascii').
 
261
        headers add: 'Content-Transfer-Encoding' -> '8bit'.
 
262
        headers add: 'X-Cuis-SystemVersion' -> (SystemVersion current asString).
 
263
        ^ headers! !
 
264
 
 
265
!GetTextExporter methodsFor: 'private'!
 
266
currentDateAndTime
 
267
        ^ String
 
268
                streamContents: [:aStream | 
 
269
                        aStream nextPutAll: Date today yyyymmdd;
 
270
                                space.
 
271
                        Time now
 
272
                                print24: true
 
273
                                showSeconds: false
 
274
                                on: aStream.
 
275
                        aStream nextPutAll: '-0000']! !
 
276
 
 
277
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 14:43:11'!
 
278
export: literals domain: domainName 
 
279
"Export a gettext file in a category. literals is a dictionary of keyword -> #(MethodReference...) in the textDomain."
 
280
        | fileEntry |   
 
281
        fileEntry _ self dirNameDomain: domainName.
 
282
        fileEntry ensureParent.
 
283
        [stream _ fileEntry forceWriteStream.
 
284
        self exportHeader: domainName.
 
285
        self exportBody: literals]              
 
286
                ensure:         [stream close]! !
 
287
 
 
288
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:48:57'!
 
289
exportHeader: domainName
 
290
        | headers |
 
291
        self exportTag: 'msgid' msg: ''.
 
292
        self exportTag: 'msgstr' msg: ''.
 
293
        headers _ self createHeaders.
 
294
        headers add: 'X-Cuis-Domain' -> domainName.
 
295
        headers do: [:each | self exportHeaderLineKey: each key value: each value].
 
296
        stream lf! !
 
297
 
 
298
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:48:29'!
 
299
exportHeaderLineKey: keyString value: valueString 
 
300
        stream nextPut: $";
 
301
                 nextPutAll: keyString;
 
302
                 nextPut: $:;
 
303
                 space;
 
304
                 nextPutAll: valueString;
 
305
                 nextPutAll: '\n';
 
306
                 nextPut: $";
 
307
                 lf.! !
 
308
 
 
309
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 14:38:35'!
 
310
exportPhrase: phraseString
 
311
        phraseString ifEmpty: [^ self].
 
312
        self exportTag: 'msgid' msg: phraseString.
 
313
        self exportTag: 'msgstr' msg: ''.
 
314
        stream lf
 
315
! !
 
316
 
 
317
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:56:23'!
 
318
exportRecordHeader: context
 
319
        stream 
 
320
                nextPutAll: '#: ';
 
321
                nextPutAll: context;
 
322
                lf.! !
 
323
 
 
324
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:55:43'!
 
325
exportTag: tag msg: aString 
 
326
        | pos end line |
 
327
        (aString indexOf: Character cr)
 
328
                        = 0
 
329
                ifTrue: [self exportTag: tag singleLine: aString]
 
330
                ifFalse: [self exportTag: tag singleLine: ''.
 
331
                        pos _ 1.
 
332
                        end _ 0.
 
333
                        [end < aString size]
 
334
                                whileTrue: [end _ aString indexOf: Character cr startingAt: pos.
 
335
                                        end = 0
 
336
                                                ifTrue: [end _ aString size].
 
337
                                        line _ aString copyFrom: pos to: end.
 
338
                                        stream nextPut: $";
 
339
                                                
 
340
                                                nextPutAll: (self formatString: line);
 
341
                                                 nextPut: $";
 
342
                                                 lf.
 
343
                                        pos _ end + 1]]! !
 
344
 
 
345
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:54:57'!
 
346
exportTag: tag singleLine: aString 
 
347
        stream nextPutAll: tag.
 
348
        stream space.
 
349
        stream nextPut: $".
 
350
        stream
 
351
                nextPutAll: (self formatString: aString).
 
352
        stream nextPut: $".
 
353
        stream lf! !
 
354
 
 
355
!GetTextExporter methodsFor: 'private' stamp: 'hlsf 3/5/2022 12:37:08'!
 
356
formatReplacements
 
357
        | replacements |
 
358
        replacements _ OrderedCollection new.
 
359
        replacements add: '\' -> '\\'.
 
360
        replacements add: String crString -> '\r'.
 
361
        replacements add: String tab -> '\t'.
 
362
        replacements add: '"' -> '\"'.
 
363
        ^ replacements! !
 
364
 
 
365
!GetTextExporter methodsFor: 'private'!
 
366
formatString: aString 
 
367
        | result |
 
368
        result _ aString.
 
369
        self formatReplacements
 
370
                do: [:each | result _ result copyReplaceAll: each key with: each value].
 
371
        ^ result! !
 
372
 
 
373
!GetTextExporter methodsFor: 'private'!
 
374
getTextDomainForClassCategory: aClassCategory
 
375
        ^TextDomainManager domainForClassCategory:  aClassCategory
 
376
                ! !
 
377
 
 
378
!GetTextExporter class methodsFor: 'utilities'!
 
379
exportTemplate
 
380
        "GetTextExporter exportTemplate"
 
381
        self new exportTemplate! !
 
382
 
 
383
!GetTextExporter class methodsFor: 'utilities' stamp: 'hlsf 3/5/2022 14:48:45'!
 
384
exportTemplateFor: someSelectors
 
385
        "Writes files to be used as the translation template.
 
386
        It will include strings that are receivers of any of someSelectors"
 
387
        
 
388
        self new exportFor: someSelectors ! !
 
389
 
 
390
!GetTextExporter class methodsFor: 'utilities'!
 
391
exportTemplateIncluding: aSelector
 
392
        "Writes files to be used as the translation template.
 
393
        It will include strings that are receivers of aSelector"
 
394
        
 
395
        self exportTemplateFor: self defaultSelectors, {aSelector} ! !
 
396
 
 
397
!GetTextExporter class methodsFor: 'utilities'!
 
398
keys
 
399
        | categories |
 
400
        categories _ Dictionary new.
 
401
        GetTextExporter new appendTranslations: categories.
 
402
        ^ categories values
 
403
                inject: Set new
 
404
                into: [:set :next | set addAll: next keys;
 
405
                                 yourself]! !
 
406
 
 
407
!GetTextExporter class methodsFor: 'accessing'!
 
408
defaultSelectors
 
409
        "Answers the selectors that are sent to strings that should be translated"
 
410
        
 
411
        ^ #(
 
412
                #translated 
 
413
                #translatedNoop
 
414
                )! !
 
415
 
 
416
!MOFile methodsFor: 'experimental'!
 
417
hashPjw: aString
 
418
        "This is the hash function used by the (unused) hashTable. Kept in case someone wants to try and make it work"
 
419
        "So called `hashpjw' function by P.J. Weinberger
 
420
        [see Aho/Sethi/Ullman, COMPILERS: Principles, Techniques and Tools,
 
421
        1986, 1987 Bell Telephone Laboratories, Inc.] "
 
422
        | stringSize hash g |
 
423
        stringSize _ aString size.
 
424
        hash _ 0.
 
425
        1 to: stringSize do: [:pos |
 
426
                hash _ hash bitShift: 4.
 
427
                hash _ hash + ((aString at: pos) asInteger).
 
428
                g _ hash bitAnd: 16rF0000000.
 
429
                g = 0 ifFalse: [
 
430
                        hash _ hash  bitXor: (g bitShift: -24).
 
431
                        hash _ hash bitXor: g.
 
432
                ]
 
433
        ].
 
434
        ^hash.
 
435
! !
 
436
 
 
437
!MOFile methodsFor: 'public' stamp: 'hlsf 3/9/2022 18:28:42'!
 
438
load: aFileEntry localeID: id
 
439
"all of strings are loaded. 
 
440
translation strings are converted to internal string format on load time.
 
441
original-string/index pairs are registerd to Dictionary on load time."
 
442
        localeID _ id.
 
443
        aFileEntry readStreamDo: [:strm | |originalTable translatedTable|
 
444
                self loadHeader: strm.
 
445
                originalTable _ self loadStringPointers: strm offset: originalTableOffset.                                      
 
446
                translatedTable _ self loadStringPointers: strm offset: translatedTableOffset.
 
447
                originalStrings _ self loadStrings: strm pointers: originalTable.
 
448
                translatedStrings _ self loadStrings: strm pointers: translatedTable.
 
449
                translations _ Dictionary new: nStrings.  
 
450
                1 to: nStrings do: [:index | | key |
 
451
                        key _ originalStrings at: index.
 
452
                        translations at: key put: index].
 
453
                originalStrings _ nil] ! !
 
454
 
 
455
!MOFile methodsFor: 'public'!
 
456
searchFor: aString
 
457
        | index |
 
458
        index _ translations at: aString ifAbsent: [^nil].
 
459
        ^translatedStrings at: index.
 
460
        
 
461
! !
 
462
 
 
463
!MOFile methodsFor: 'public'!
 
464
translationFor: aString 
 
465
        aString size = 0 ifTrue: [^ '']. "Gettext header"
 
466
        ^ (self searchFor: aString) ifNil: [aString]
 
467
! !
 
468
 
 
469
!MOFile methodsFor: 'private' stamp: 'hlsf 3/9/2022 21:45:58'!
 
470
loadHeader: strm
 
471
        strm binary.
 
472
        magic _  strm nextUnsignedInt32BigEndian: true .
 
473
        magic = 16rDE120495 
 
474
                ifTrue: [isLittleEndian _ true]
 
475
                ifFalse: [
 
476
                        magic = 16r950412DE 
 
477
                                ifTrue: [isLittleEndian _ false]
 
478
                                ifFalse: [ self error: 'invalid MO']            ].
 
479
        revision _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
480
        nStrings _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
481
        originalTableOffset _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
482
        translatedTableOffset _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
483
        hashTableSize _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
484
        hashTableOffset _ strm nextUnsignedInt32BigEndian: isLittleEndian not! !
 
485
 
 
486
!MOFile methodsFor: 'private' stamp: 'hlsf 3/9/2022 21:46:21'!
 
487
loadStringPointers: strm offset: tableOffset
 
488
"returns tupple {arrayOfOffsetToString  arrayOfLengthOfString}"
 
489
        | offsetTable lenTable len offset tupple |
 
490
        offsetTable _ IntegerArray new: nStrings.
 
491
        lenTable _ IntegerArray new: nStrings.
 
492
        strm binary.
 
493
        strm position: tableOffset.
 
494
        1 to: nStrings do: [:index |
 
495
                len _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
496
                offset _ strm nextUnsignedInt32BigEndian: isLittleEndian not.
 
497
                offsetTable at: index put: offset.
 
498
                lenTable at: index put: len ].
 
499
        tupple _ Array new: 2.
 
500
        tupple at: 1 put: offsetTable.
 
501
        tupple at: 2 put:  lenTable.
 
502
        ^tupple! !
 
503
 
 
504
!MOFile methodsFor: 'private' stamp: 'hlsf 3/11/2022 10:31:38'!
 
505
loadStrings: strm pointers: table
 
506
"We convert string encoding at load time.
 
507
Currently, we do not take care to set the leadingChar for a languageEnvironment"
 
508
        | offsetTable lenTable strings |
 
509
        strm ascii.
 
510
        offsetTable _  table first.
 
511
        lenTable _ table second.
 
512
        strings _ Array new: nStrings.
 
513
        1 to: nStrings do: [:index | |  rawStr start byteLength endPos|
 
514
                start _ offsetTable at: index.
 
515
                byteLength _ lenTable at: index.
 
516
                endPos _ start + byteLength.
 
517
                rawStr _  (String new: byteLength) writeStream.
 
518
                strm position:  start.
 
519
                [strm position < endPos] whileTrue: [rawStr nextPut: strm next].
 
520
                strings at: index put: (String fromUtf8: rawStr contents asByteArray    )].
 
521
        ^strings.! !
 
522
 
 
523
!MOFile class methodsFor: 'class initialization'!
 
524
initialize
 
525
        Cr _ Character cr.
 
526
        Lf _ Character lf.
 
527
! !
 
528
 
 
529
!MOFile class methodsFor: 'instance creation'!
 
530
fileName: path localeID: id
 
531
        ^self new 
 
532
                        load:path localeID: id! !
 
533
 
 
534
!NaturalLanguageTranslator methodsFor: 'printing'!
 
535
printOn: aStream
 
536
        aStream nextPutAll: self class name; nextPut: $(; print: self localeID; nextPut: $)! !
 
537
 
 
538
!NaturalLanguageTranslator methodsFor: 'translation'!
 
539
translate: aString inDomain: aDomainName
 
540
        ^ aString! !
 
541
 
 
542
!NaturalLanguageTranslator methodsFor: 'accessing'!
 
543
domainRegistered: aDomainName
 
544
        "notify that new TextDomain is registered.  Concrete subclass can responds to this event if needed"! !
 
545
 
 
546
!NaturalLanguageTranslator methodsFor: 'accessing'!
 
547
domainUnregistered: aDomainName
 
548
        "notify that new TextDomain is unregistered.  Concrete subclass can responds to this event if needed"! !
 
549
 
 
550
!NaturalLanguageTranslator methodsFor: 'accessing'!
 
551
localeID
 
552
        ^id! !
 
553
 
 
554
!NaturalLanguageTranslator methodsFor: 'accessing'!
 
555
localeID: anID
 
556
        id _ anID! !
 
557
 
 
558
!NaturalLanguageTranslator methodsFor: 'language switching'!
 
559
setCurrent
 
560
        "notify locale of the translator become current"
 
561
! !
 
562
 
 
563
!NaturalLanguageTranslator class methodsFor: 'class initialization'!
 
564
initialize
 
565
        (Smalltalk classNamed: #SessionManager)
 
566
                ifNotNil: [:sessionManagerClass|
 
567
                        sessionManagerClass default
 
568
                                registerSystemClassNamed: self name
 
569
                                atPriority: 100]
 
570
                ifNil: [Smalltalk addToStartUpList: NaturalLanguageTranslator after: FileLocator].
 
571
        
 
572
        ! !
 
573
 
 
574
!NaturalLanguageTranslator class methodsFor: 'class initialization'!
 
575
privateStartUp
 
576
        self reset.
 
577
        GetTextTranslator reset.
 
578
        self localeChanged.! !
 
579
 
 
580
!NaturalLanguageTranslator class methodsFor: 'class initialization'!
 
581
startUp: resuming 
 
582
        resuming
 
583
                ifFalse: [^ self].
 
584
        self privateStartUp.! !
 
585
 
 
586
!NaturalLanguageTranslator class methodsFor: 'actions'!
 
587
reset
 
588
        "Flush the translator instances"
 
589
        
 
590
        Translators _ nil! !
 
591
 
 
592
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
593
availableForLocaleID: localeID 
 
594
        "Answer available locale ID.
 
595
        If translator is not found for correct locale ID, then isoLanguage is
 
596
        attempted for the key."
 
597
        ^ self translators
 
598
                at: localeID
 
599
                ifAbsent: [localeID hasParent
 
600
                                ifTrue: [self translators
 
601
                                                at: localeID parent
 
602
                                                ifAbsent: [self default]]
 
603
                                ifFalse: [self default]] ! !
 
604
 
 
605
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
606
availableLanguageLocaleIDs
 
607
        "Return the locale ids for the currently available languages.  
 
608
        Meaning those which either internally or externally have  
 
609
        translations available."
 
610
        "NaturalLanguageTranslator availableLanguageLocaleIDs"
 
611
        ^ self translators values collect:[:each | each localeID]! !
 
612
 
 
613
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
614
current
 
615
        ^ self availableForLocaleID: LocaleID current! !
 
616
 
 
617
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
618
default
 
619
        "Answer translator for backstop"
 
620
        "self default translate: 'test'"
 
621
        ^ self new
 
622
                localeID: (LocaleID isoLanguage: 'en')! !
 
623
 
 
624
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
625
domainRegistered: aDomainName
 
626
        "notify that new TextDomain is registered"
 
627
        self translators do: [:each | each domainRegistered: aDomainName]! !
 
628
 
 
629
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
630
domainUnregistered: aDomainName
 
631
        "notify that new TextDomain is unregistered"
 
632
        self translators do: [:each | each domainUnregistered: aDomainName]! !
 
633
 
 
634
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
635
localeChanged
 
636
        "notify some project starts to use this locale.
 
637
         this facility may use the event to load translation data dynamically" 
 
638
        self current setCurrent
 
639
! !
 
640
 
 
641
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
642
removeLocaleID: localeID 
 
643
        "self removeLocaleID: (LocaleID isoString: 'ja-kids')"
 
644
        ^ self translators
 
645
                removeKey: localeID
 
646
                ifAbsent: []! !
 
647
 
 
648
!NaturalLanguageTranslator class methodsFor: 'accessing'!
 
649
translators
 
650
        ^ Translators ifNil: [Translators _ Dictionary new]     ! !
 
651
 
 
652
!NaturalLanguageTranslator class methodsFor: 'translation'!
 
653
translate: aString
 
654
        ^ self translate: aString toLocale: LocaleID current! !
 
655
 
 
656
!NaturalLanguageTranslator class methodsFor: 'translation' stamp: 'hlsf 3/9/2022 21:42:29'!
 
657
translate: aString toLocale: localeID
 
658
        | here domain |
 
659
        here _ thisContext sender sender sender methodClass.
 
660
        domain _ TextDomainManager domainForClass: here.
 
661
        ^ self translate: aString toLocale: localeID inDomain: domain! !
 
662
 
 
663
!NaturalLanguageTranslator class methodsFor: 'translation'!
 
664
translate: aString toLocale: localeID inDomain: aDomainName
 
665
        ^ (self availableForLocaleID: localeID)
 
666
                translate: aString inDomain: aDomainName! !
 
667
 
 
668
!NaturalLanguageTranslator class methodsFor: 'cleanup'!
 
669
cleanUp
 
670
        AllKnownPhrases _ nil! !
 
671
 
 
672
!GetTextTranslator methodsFor: 'accessing'!
 
673
domainRegistered: aDomainName
 
674
        "only current translator actually load the MO, to minimize loading time.
 
675
         other translator will load anyway when it goes current"
 
676
        (self class current == self) 
 
677
                ifTrue: [self moFileForDomain: aDomainName].
 
678
        ! !
 
679
 
 
680
!GetTextTranslator methodsFor: 'accessing'!
 
681
domainUnregistered: aDomainName
 
682
        moFiles removeKey: aDomainName ifAbsent: [^self]
 
683
        ! !
 
684
 
 
685
!GetTextTranslator methodsFor: 'accessing' stamp: 'hlsf 3/11/2022 10:17:14'!
 
686
loadMOFiles
 
687
        TextDomainManager allKnownDomains 
 
688
                do: [:domainName | 
 
689
                        self moFileForDomain: domainName
 
690
                ].! !
 
691
 
 
692
!GetTextTranslator methodsFor: 'accessing'!
 
693
refresh
 
694
        "Purge the cached translations (and load on demand)"
 
695
        
 
696
        moFiles _ Dictionary new
 
697
! !
 
698
 
 
699
!GetTextTranslator methodsFor: 'language switching'!
 
700
setCurrent
 
701
        "ensure actual contents of MOs is loaded on switching language"
 
702
        self loadMOFiles! !
 
703
 
 
704
!GetTextTranslator methodsFor: 'private' stamp: 'hlsf 3/9/2022 15:58:41'!
 
705
loadMOFileForDomain: aDomainName
 
706
        | moName |
 
707
        moName _ self class 
 
708
                findMOForLocaleID: self localeID
 
709
                domain: aDomainName.
 
710
        moName notNil
 
711
                 ifTrue: [^MOFile new :: 
 
712
                        load: moName    localeID: self localeID]
 
713
                ifFalse: [^nil]
 
714
! !
 
715
 
 
716
!GetTextTranslator methodsFor: 'private' stamp: 'hlsf 3/9/2022 15:59:04'!
 
717
moFileForDomain: domainName
 
718
"Returns the cached MOFile for the given domainName (or nil).
 
719
If none is cached, it will try to load one (every time) and cache it on demand."
 
720
        | moFile |
 
721
        ^moFiles 
 
722
                at: domainName 
 
723
                ifAbsent: [
 
724
                        moFile _ self loadMOFileForDomain: domainName.
 
725
                        moFile notNil ifTrue:[                          moFiles at: domainName put: moFile].
 
726
                        moFile]! !
 
727
 
 
728
!GetTextTranslator methodsFor: 'translation'!
 
729
translate: aString inDomain: aDomainName
 
730
        | mo |
 
731
        mo _ self moFileForDomain: aDomainName.
 
732
        ^mo isNil 
 
733
                ifTrue: [aString] 
 
734
                ifFalse: [mo translationFor: aString]
 
735
! !
 
736
 
 
737
!GetTextTranslator methodsFor: 'initialize-release'!
 
738
initialize
 
739
        moFiles _ Dictionary new.! !
 
740
 
 
741
!GetTextTranslator class methodsFor: 'class initialization'!
 
742
initialize
 
743
        SystemDefaultLocaleDirs _ OrderedCollection new.
 
744
        UserDefaultLocaleDirs _ OrderedCollection new.
 
745
        LocaleDirsForDomain _ Dictionary new.! !
 
746
 
 
747
!GetTextTranslator class methodsFor: 'translation data layout'!
 
748
addSystemDefaultLocaleDir: dir
 
749
        "new dir will be put as first"
 
750
        self systemDefaultLocaleDirs addFirst: dir! !
 
751
 
 
752
!GetTextTranslator class methodsFor: 'translation data layout'!
 
753
defaultLocaleDirs
 
754
        | dirs |
 
755
        dirs _ OrderedCollection new.
 
756
        UserDefaultLocaleDirs ifNotNil: [dirs addAll: UserDefaultLocaleDirs].
 
757
        dirs addAll: self systemDefaultLocaleDirs.
 
758
        ^dirs
 
759
! !
 
760
 
 
761
!GetTextTranslator class methodsFor: 'translation data layout'!
 
762
localeDirForDomain: aDomainName
 
763
        "returns registered localeDirectory for the textdomain. returns nil if not registered"
 
764
        ^LocaleDirsForDomain at: aDomainName ifAbsent: [nil]! !
 
765
 
 
766
!GetTextTranslator class methodsFor: 'translation data layout'!
 
767
localeDirsForDomain: aDomainName
 
768
        "returns collection of locale directories for text domain.  
 
769
        This includes user defined one for the domain, user defaults and system defaults" 
 
770
        | dirs dir |
 
771
        dirs _ OrderedCollection new.
 
772
        dir _ self localeDirForDomain: aDomainName.
 
773
        dir ifNotNil: [dirs add: dir].
 
774
        dirs addAll:  self defaultLocaleDirs. 
 
775
        
 
776
        ^dirs! !
 
777
 
 
778
!GetTextTranslator class methodsFor: 'translation data layout' stamp: 'hlsf 3/9/2022 16:54:45'!
 
779
setLocaleDir: path forDoamin: aDomainName
 
780
        self localeDirsForDomain
 
781
                at: aDomainName
 
782
                put: path.! !
 
783
 
 
784
!GetTextTranslator class methodsFor: 'translation data layout' stamp: 'hlsf 3/9/2022 15:47:55'!
 
785
setupLocaleDirs
 
786
        | dirs |
 
787
        SystemDefaultLocaleDirs _ nil.
 
788
        dirs _ self systemDefaultLocaleDirs.
 
789
        dirs add:  DirectoryEntry smalltalkImageDirectory / 'locale'.
 
790
        dirs add:  DirectoryEntry vmDirectory / 'locale'.
 
791
        ^dirs! !
 
792
 
 
793
!GetTextTranslator class methodsFor: 'translation data layout'!
 
794
systemDefaultLocaleDirs
 
795
        ^SystemDefaultLocaleDirs ifNil: [SystemDefaultLocaleDirs _ OrderedCollection new]
 
796
! !
 
797
 
 
798
!GetTextTranslator class methodsFor: 'translation data layout'!
 
799
userDefaultLocaleDirs
 
800
        ^UserDefaultLocaleDirs ifNil: [UserDefaultLocaleDirs _ OrderedCollection new]
 
801
! !
 
802
 
 
803
!GetTextTranslator class methodsFor: 'private' stamp: 'hlsf 3/9/2022 17:48:52'!
 
804
availableLanguageLocaleIDs
 
805
"GetTextTranslator availableLanguageLocaleIDs"
 
806
        | ids dirs localeDirForLang directoryNames |
 
807
        ids _ Set new.
 
808
        dirs _ Set new.
 
809
        dirs addAll: LocaleDirsForDomain values.
 
810
        dirs addAll: self defaultLocaleDirs.
 
811
        dirs do: [:dir |
 
812
                | localesDir |
 
813
                localesDir _ dir assureExistence. 
 
814
                directoryNames _ [localesDir directoryNames] on: FileDoesNotExistException do: [:e | #()].
 
815
                directoryNames                  do: [:langDirName | | localeID  |
 
816
                        localeID _ LocaleID posixName: langDirName.
 
817
                        localeDirForLang _ (localesDir / localeID posixName / 'LC_MESSAGES') assureExistence.
 
818
                        localeDirForLang ifNotNil: [
 
819
                                (localeDirForLang fileMatching: '*.mo') ifNotNil: [ids add: localeID]
 
820
                        ]
 
821
                ].
 
822
        ].
 
823
        ^ids! !
 
824
 
 
825
!GetTextTranslator class methodsFor: 'private' stamp: 'hlsf 3/9/2022 17:48:45'!
 
826
createAvailableTranslators
 
827
"Load new instances of translators corresponding to the currently available translation files"
 
828
        self setupLocaleDirs.
 
829
        self availableLanguageLocaleIDs do: [ :localeID |
 
830
                NaturalLanguageTranslator translators 
 
831
                        at: localeID 
 
832
                        put: (self newForLocaleID: localeID).
 
833
        ]! !
 
834
 
 
835
!GetTextTranslator class methodsFor: 'private' stamp: 'hlsf 3/9/2022 15:57:31'!
 
836
findMOForLocaleID: id domain: aDomainName
 
837
        | moFile |
 
838
        (self localeDirsForDomain: aDomainName) do: [:each |
 
839
                moFile _ each / id posixName / 'LC_MESSAGES' // (aDomainName, '.mo').
 
840
                [moFile exists ifTrue: [^moFile] ] 
 
841
                        on: FileDoesNotExistException 
 
842
                        do: [:e | ^nil]].
 
843
        ^nil! !
 
844
 
 
845
!GetTextTranslator class methodsFor: 'private'!
 
846
localeDirsForDomain
 
847
        ^LocaleDirsForDomain ifNil: [LocaleDirsForDomain _ Dictionary new]! !
 
848
 
 
849
!GetTextTranslator class methodsFor: 'private'!
 
850
privateStartUp
 
851
 
 
852
        self createAvailableTranslators! !
 
853
 
 
854
!GetTextTranslator class methodsFor: 'instance creation'!
 
855
newForLocaleID: id
 
856
        ^self new localeID: id! !
 
857
 
 
858
!GetTextTranslator class methodsFor: 'actions'!
 
859
reset
 
860
        "Flush remembered stuff.
 
861
        Load new translators (based on the files currently found)"
 
862
        
 
863
        super reset.
 
864
        
 
865
        self createAvailableTranslators 
 
866
         
 
867
        ! !
 
868
 
 
869
!TextDomainInfo methodsFor: 'initialize-release'!
 
870
initialize
 
871
        categoryPrefixes _ Set new.
 
872
        categories _ IdentitySet new.
 
873
! !
 
874
 
 
875
!TextDomainInfo methodsFor: 'private'!
 
876
category: categoryName matches: prefix
 
877
        ^ categoryName notNil and: [categoryName = prefix or: [categoryName beginsWith: prefix, '-']]! !
 
878
 
 
879
!TextDomainInfo methodsFor: 'accessing'!
 
880
categories
 
881
        ^categories! !
 
882
 
 
883
!TextDomainInfo methodsFor: 'accessing'!
 
884
categoryPrefixes
 
885
        ^categoryPrefixes! !
 
886
 
 
887
!TextDomainInfo methodsFor: 'accessing'!
 
888
includesCategory: categorySymbol
 
889
        (categories includes: categorySymbol) ifTrue: [^true].
 
890
        categoryPrefixes do: [:each |
 
891
                (self category: categorySymbol matches: each) ifTrue: [^true]
 
892
        ].
 
893
 
 
894
        ^false.! !
 
895
 
 
896
!TextDomainInfo methodsFor: 'accessing'!
 
897
matchedSystemCategories
 
898
        ^SystemOrganization categories 
 
899
                select: [:cat | self includesCategory: cat]! !
 
900
 
 
901
!TextDomainManager class methodsFor: 'accessing'!
 
902
allKnownDomains
 
903
        | domains |
 
904
        domains _ Set new.
 
905
        domains addAll: ClassCategories values.
 
906
        domains add: self defaultDomain.
 
907
        ^domains
 
908
! !
 
909
 
 
910
!TextDomainManager class methodsFor: 'accessing'!
 
911
defaultDomain
 
912
        ^DefaultDomain! !
 
913
 
 
914
!TextDomainManager class methodsFor: 'accessing'!
 
915
defaultDomain: aDomainName
 
916
        DefaultDomain _ aDomainName! !
 
917
 
 
918
!TextDomainManager class methodsFor: 'accessing'!
 
919
domainForClass: aClass
 
920
        ^Classes at: aClass theNonMetaClass name ifAbsent: [self defaultDomain]! !
 
921
 
 
922
!TextDomainManager class methodsFor: 'accessing'!
 
923
domainForClassCategory: aCategorySymbol
 
924
        ^ClassCategories at: aCategorySymbol ifAbsent: [self defaultDomain]! !
 
925
 
 
926
!TextDomainManager class methodsFor: 'accessing'!
 
927
registerCategoryPrefix: aString domain: aDomainName
 
928
        | domInfo |
 
929
        domInfo _ self domainInfoFor: aDomainName.
 
930
        domInfo categoryPrefixes add: aString.
 
931
        self refresh.! !
 
932
 
 
933
!TextDomainManager class methodsFor: 'accessing'!
 
934
registerClass: className domain: aDomainName
 
935
        LoneClasses at: className put: aDomainName.
 
936
        self refresh.   "moves it to Classes"
 
937
! !
 
938
 
 
939
!TextDomainManager class methodsFor: 'accessing'!
 
940
registerClassCategory: categorySymbol domain: aDomainName
 
941
        | domInfo |
 
942
        domInfo _ self domainInfoFor: aDomainName.
 
943
        domInfo categories add: categorySymbol.
 
944
        self refresh.
 
945
! !
 
946
 
 
947
!TextDomainManager class methodsFor: 'accessing'!
 
948
registerDomain: domainName
 
949
        | domInfo |
 
950
        domInfo _ TextDomainInfo new.
 
951
        DomainInfos at: domainName put: domInfo.
 
952
        NaturalLanguageTranslator domainRegistered: domainName.
 
953
        ^domInfo! !
 
954
 
 
955
!TextDomainManager class methodsFor: 'accessing'!
 
956
unregisterDomain: domainName
 
957
        DomainInfos removeKey: domainName.
 
958
        self refresh.
 
959
        NaturalLanguageTranslator domainUnregistered: domainName.
 
960
! !
 
961
 
 
962
!TextDomainManager class methodsFor: 'private'!
 
963
domainInfoFor: domainName
 
964
        ^DomainInfos at: domainName ifAbsentPut: [ self registerDomain: domainName]! !
 
965
 
 
966
!TextDomainManager class methodsFor: 'private'!
 
967
domainInfos
 
968
        ^DomainInfos! !
 
969
 
 
970
!TextDomainManager class methodsFor: 'private'!
 
971
refresh
 
972
        ClassCategories _ IdentityDictionary new.
 
973
        Classes _ IdentityDictionary new.
 
974
        DomainInfos keysAndValuesDo: [:domainName :domainInfo |
 
975
                domainInfo matchedSystemCategories do: [:cat |
 
976
                        ClassCategories at: cat ifPresent: [self error: 'category ', (cat asString) , '  belongs to multiple domains'].
 
977
                        ClassCategories at: cat put: domainName.
 
978
                        (SystemOrganization listAtCategoryNamed: cat ) do: [ :cls |
 
979
                                Classes at: cls put: domainName.
 
980
                        ]
 
981
                ]
 
982
        ].
 
983
        Classes addAll: LoneClasses.! !
 
984
 
 
985
!TextDomainManager class methodsFor: 'class initialization' stamp: 'hlsf 3/5/2022 12:17:54'!
 
986
initialize
 
987
        "       TextDomainManager initialize    "
 
988
 
 
989
        ClassCategories _ IdentityDictionary new.
 
990
        Classes _ IdentityDictionary new.
 
991
        LoneClasses _ IdentityDictionary new.
 
992
        DomainInfos _ Dictionary new.
 
993
        self defaultDomain: 'cuis'.! !
 
994
 
 
995
!TranslatedReceiverFinder methodsFor: 'private'!
 
996
arraySearch: aSymbol fromArray: anArray addTo: aCollection 
 
997
        "Find literals ahead of aSymbol from arrays in the method."
 
998
        "BUG: it can handle just one occurrence"
 
999
        | index |
 
1000
        (index _ anArray identityIndexOf: aSymbol) > 1
 
1001
                ifTrue: [aCollection add: (anArray at: index - 1) asString].
 
1002
        (anArray
 
1003
                select: [:each | each isMemberOf: Array])
 
1004
                do: [:each | self
 
1005
                                arraySearch: aSymbol
 
1006
                                fromArray: each
 
1007
                                addTo: aCollection].
 
1008
        ^ aCollection! !
 
1009
 
 
1010
!TranslatedReceiverFinder methodsFor: 'private'!
 
1011
arraySearch: aSymbol messageNode: aParseNode addTo: aCollection 
 
1012
        "Find literals ahead of aSymbol from arrays in the method."
 
1013
        
 
1014
        aParseNode nodesDo: [:node |
 
1015
                node isLiteral ifTrue: [
 
1016
                        (node literalValue isMemberOf: Array) ifTrue: [
 
1017
                                self 
 
1018
                                        arraySearch: aSymbol
 
1019
                                        fromArray: node literalValue
 
1020
                                        addTo: aCollection]]].          
 
1021
        ^ aCollection! !
 
1022
 
 
1023
!TranslatedReceiverFinder methodsFor: 'private' stamp: 'hlsf 3/5/2022 11:42:28'!
 
1024
search: aSymbol messageNode: aParseNode addTo: aCollection 
 
1025
        aParseNode nodesDo: [:node | 
 
1026
                node isMessage ifTrue: [
 
1027
                        node selectorSymbol = aSymbol ifTrue: [
 
1028
                                aCollection add: node]]].
 
1029
        ^ aCollection! !
 
1030
 
 
1031
!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'hlsf 3/5/2022 11:54:04'!
 
1032
findWordsWith: aSymbol in: aMethodReference 
 
1033
        "Find words for translation with the symbol in a method. See
 
1034
        LanguageEditorTest >>testFindTranslatedWords"
 
1035
        "| message | 
 
1036
        message _ MethodReference new setStandardClass: Morph class
 
1037
        methodSymbol: #supplementaryPartsDescriptions.
 
1038
        self new findWordsWIth: #translatedNoop in: message"
 
1039
        | messages keywords methodNode |
 
1040
 
 
1041
        methodNode _ aMethodReference methodNode.
 
1042
        "Find from string literal"
 
1043
        messages _ Set new.
 
1044
        self
 
1045
                search: aSymbol
 
1046
                messageNode: methodNode
 
1047
                addTo: messages.
 
1048
        keywords _ OrderedCollection new.
 
1049
        messages
 
1050
                select: [:aMessageNode | aMessageNode receiver isLiteralNode]
 
1051
                thenDo: [:aMessageNode | keywords add: aMessageNode receiver literalValue                       ].
 
1052
        "Find from array literal"
 
1053
        self
 
1054
                arraySearch: aSymbol
 
1055
                messageNode: methodNode
 
1056
                addTo: keywords.
 
1057
        ^ keywords! !
 
1058
 
 
1059
!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'hlsf 3/5/2022 11:10:34'!
 
1060
nonLiteralReceiversOf: aSymbol
 
1061
        "self new nonLiteralReceiversOf: aSymbol"
 
1062
        | receivers |
 
1063
        "Answer method references of non literal senders of #translated"
 
1064
        ^ (Smalltalk allCallsOn: aSymbol)
 
1065
                select: [:message | 
 
1066
                        receivers _ OrderedCollection new.
 
1067
                        self search: aSymbol messageNode: message methodNode addTo: receivers.
 
1068
                        receivers
 
1069
                                anySatisfy: [:each | (each receiver isLiteralNode) not]]! !
 
1070
 
 
1071
!TranslatedReceiverFinder methodsFor: 'accessing' stamp: 'hlsf 3/5/2022 11:47:45'!
 
1072
stringReceiversOf: aSymbol
 
1073
        "Find string receivers for a symbol.
 
1074
        Answer a collection of aMethodReference -> {keyword. keyword...}"
 
1075
        "self new stringReceiversOf: #translated"
 
1076
        | keywords methodReferences |
 
1077
        methodReferences _ Smalltalk allCallsOn: aSymbol.
 
1078
        ^ methodReferences inject: OrderedCollection new into: [:list :next |
 
1079
                keywords _ self findWordsWith: aSymbol in: next.
 
1080
                keywords
 
1081
                        ifNotEmpty: [list add: next -> keywords].
 
1082
                list]
 
1083
! !
 
1084
 
 
1085
!TranslatedReceiverFinder methodsFor: 'actions'!
 
1086
searchBlockNode: aBlockNode addTo: aCollection
 
1087
 
 
1088
        aBlockNode statements do: [:e |
 
1089
                (e isMemberOf: MessageNode) ifTrue: [self searchMessageNode: e addTo: aCollection].
 
1090
                (e isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: e addTo: aCollection].
 
1091
        ].
 
1092
! !
 
1093
 
 
1094
!TranslatedReceiverFinder methodsFor: 'actions'!
 
1095
searchMessageNode: aMessageNode addTo: aCollection
 
1096
 
 
1097
        ((aMessageNode receiver isMemberOf: LiteralNode) and: [(aMessageNode selector isMemberOf: SelectorNode) and: [aMessageNode selector key = #translated]]) ifTrue: [
 
1098
                aCollection add: aMessageNode receiver key.
 
1099
        ].
 
1100
 
 
1101
        (aMessageNode receiver isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMessageNode receiver addTo: aCollection].
 
1102
        (aMessageNode receiver isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMessageNode receiver addTo: aCollection].
 
1103
        (aMessageNode receiver isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMessageNode receiver addTo: aCollection].
 
1104
 
 
1105
        aMessageNode arguments do: [:a |
 
1106
                (a isMemberOf: BlockNode) ifTrue: [self searchBlockNode: a addTo: aCollection].
 
1107
                (a isMemberOf: MessageNode) ifTrue: [self searchMessageNode: a addTo: aCollection].
 
1108
                (a isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: a addTo: aCollection].
 
1109
        ].
 
1110
! !
 
1111
 
 
1112
!TranslatedReceiverFinder methodsFor: 'actions'!
 
1113
searchMethodNode: aMethodNode addTo: aCollection
 
1114
 
 
1115
        (aMethodNode block isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMethodNode block addTo: aCollection].
 
1116
        (aMethodNode block isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMethodNode block addTo: aCollection].
 
1117
        (aMethodNode block isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMethodNode block addTo: aCollection].
 
1118
! !
 
1119
 
 
1120
!TranslatedReceiverFinder methodsFor: 'actions'!
 
1121
searchReturnNode: aReturnNode addTo: aCollection
 
1122
 
 
1123
        (aReturnNode expr isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aReturnNode expr addTo: aCollection].
 
1124
        (aReturnNode expr isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aReturnNode expr addTo: aCollection].
 
1125
! !
 
1126
 
 
1127
!TranslatedReceiverFinder methodsFor: 'actions' stamp: 'hlsf 3/5/2022 11:07:48'!
 
1128
senders
 
1129
        | m o |
 
1130
        m _ Smalltalk allCallsOn: #translated.
 
1131
        m _ m
 
1132
                collect: [ :e | 
 
1133
                        e classIsMeta
 
1134
                                ifTrue: [ (Smalltalk globals at: e classSymbol) class decompile: e methodSymbol ]
 
1135
                                ifFalse: [ (Smalltalk globals at: e classSymbol) decompile: e methodSymbol ] ].
 
1136
        o _ OrderedCollection new.
 
1137
        m do: [ :e | self searchMethodNode: e addTo: o ].
 
1138
        ^ o sort! !
 
1139
 
 
1140
!TranslatedReceiverFinder class methodsFor: 'utilities' stamp: 'hlsf 3/5/2022 11:08:25'!
 
1141
browseNonLiteralReceivers
 
1142
        "TranslatedReceiverFinder browseNonLiteralReceivers"
 
1143
        Smalltalk
 
1144
                browseMessageList: (self new nonLiteralReceiversOf: #translated)  asSortedCollection
 
1145
                name: 'Non literal receivers of #translated'
 
1146
                autoSelect: 'translated'! !
 
1147
 
 
1148
!String methodsFor: '*Gettext'!
 
1149
translated
 
1150
"answer the receiver translated to the default language"
 
1151
        ^ NaturalLanguageTranslator translate: self
 
1152
! !
 
1153
 
 
1154
!String methodsFor: '*Gettext'!
 
1155
translatedTo: localeID 
 
1156
        "answer the receiver translated to the given locale id"
 
1157
        ^ NaturalLanguageTranslator translate: self toLocale: localeID! !
 
1158
MOFile initialize!
 
1159
NaturalLanguageTranslator initialize!
 
1160
GetTextTranslator initialize!
 
1161
TextDomainManager initialize!