← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/inc/gettext.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/inc/gettext.pp
1
1
{
2
 
    $Id: gettext.pp,v 1.9 2005/03/15 16:27:04 peter Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 1999-2001 by the Free Pascal development team
5
4
 
71
70
  EMOFileError = class(Exception);
72
71
 
73
72
 
 
73
  procedure GetLanguageIDs(var Lang, FallbackLang: string);
74
74
  procedure TranslateResourceStrings(AFile: TMOFile);
75
75
  procedure TranslateResourceStrings(const AFilename: String);
76
76
 
77
77
 
78
78
implementation
79
79
 
80
 
uses dos;
 
80
uses {$ifdef win32} windows, {$endif}dos;
81
81
 
82
82
var
83
83
  GettextUsed: Boolean;
211
211
//   Resourcestring translation procedures
212
212
// -------------------------------------------------------
213
213
 
214
 
{
215
 
  Define USEITERATOR if you want to translate the strings using
216
 
  the SetResourceStrings call. This is not recommended for this
217
 
  particular iplementation, since we must pass through a global
218
 
  variable TheFile : TMOFile. However that works too.
219
 
}
220
 
 
221
 
{$ifdef USEITERATOR}
222
 
var
223
 
  Thefile : TMOFile;
224
 
 
225
 
function Translate (Name,Value : AnsiString; Hash : Longint) : AnsiString;
226
 
 
 
214
 
 
215
function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
227
216
begin
228
 
  Result:=TheFile.Translate(Value,Hash);
 
217
  Result:=TMOFile(arg).Translate(Value,Hash);
229
218
end;
230
219
 
 
220
 
231
221
procedure TranslateResourceStrings(AFile: TMOFile);
 
222
begin
 
223
  SetResourceStrings(@Translate,AFile);
 
224
end;
 
225
 
 
226
 
 
227
{$ifdef win32}
 
228
procedure GetLanguageIDs(var Lang, FallbackLang: string);
232
229
var
233
 
  i,j : Integer;
234
 
  s : String;
 
230
  Buffer: array[1..4] of char;
 
231
  Country: string;
 
232
  UserLCID: LCID;
235
233
begin
236
 
  TheFile:=AFile;
237
 
  SetResourceStrings(@Translate);
 
234
  //defaults
 
235
  Lang := '';
 
236
  FallbackLang:='';
 
237
  UserLCID := GetUserDefaultLCID;
 
238
  if GetLocaleInfo(UserLCID, LOCALE_SABBREVLANGNAME, @Buffer, 4)<>0 then
 
239
    FallbackLang := lowercase(copy(Buffer,1,2));
 
240
  if GetLocaleInfo(UserLCID, LOCALE_SABBREVCTRYNAME, @Buffer, 4)<>0 then begin
 
241
    Country := copy(Buffer,1,2);
 
242
 
 
243
    // some 2 letter codes are not the first two letters of the 3 letter code
 
244
    // there are probably more, but first let us see if there are translations
 
245
    if (Buffer='PRT') then Country:='PT';
 
246
 
 
247
    Lang := FallbackLang+'_'+Country;
 
248
  end;
238
249
end;
 
250
 
239
251
{$else}
240
252
 
241
 
procedure TranslateResourceStrings(AFile: TMOFile);
242
 
var
243
 
  i, j, count: Integer;
244
 
  s: String;
245
 
begin
246
 
  for i:=0 to ResourceStringTableCount - 1 do
247
 
  begin
248
 
    count := ResourceStringCount(I);
249
 
    for j := 0 to count - 1 do
250
 
    begin
251
 
      s := AFile.Translate(GetResourceStringDefaultValue(i, j),
252
 
        GetResourceStringHash(i, j));
253
 
      if Length(s) > 0 then
254
 
      begin
255
 
        SetResourceStringValue(i, j, s);
256
 
        GettextUsed := True;
257
 
      end;
258
 
    end;
259
 
  end;
260
 
end;
261
 
{$endif}
262
 
 
263
 
procedure TranslateResourceStrings(const AFilename: String);
264
 
var
265
 
  mo: TMOFile;
266
 
  lang, FallbackLanguage: String;
 
253
procedure GetLanguageIDs(var Lang, FallbackLang: string);
267
254
begin
268
255
  lang := GetEnv('LC_ALL');
269
256
  if Length(lang) = 0 then
276
263
        exit;   // no language defined via environment variables
277
264
    end;
278
265
  end;
 
266
  FallbackLang := Copy(lang, 1, 2);
 
267
end;
 
268
{$endif}
279
269
 
280
 
  FallbackLanguage := Copy(lang, 1, 2);
 
270
procedure TranslateResourceStrings(const AFilename: String);
 
271
var
 
272
  mo: TMOFile;
 
273
  lang, FallbackLang: String;
 
274
begin
 
275
  GetLanguageIDs(Lang, FallbackLang);
281
276
  try
282
 
    mo := TMOFile.Create(Format(AFilename, [FallbackLanguage]));
 
277
    mo := TMOFile.Create(Format(AFilename, [FallbackLang]));
283
278
    try
284
279
      TranslateResourceStrings(mo);
285
280
    finally
306
301
  if GettextUsed then
307
302
    ResetResourceTables;
308
303
end.
309
 
 
310
 
 
311
 
{
312
 
  $Log: gettext.pp,v $
313
 
  Revision 1.9  2005/03/15 16:27:04  peter
314
 
    * use dispose instead of freemem to also release the initialize types
315
 
 
316
 
  Revision 1.8  2005/02/14 17:13:15  peter
317
 
    * truncate log
318
 
 
319
 
}