LazUtils: Add GetLanguageID function to Translations unit. It returns a record with language code (in ISO 639-1 or ISO 639-2) and country code (in ISO 3166) for current system locale.

Implementation is based on GetLanguageIDs procedure from GetText unit, but is rewritten to have the following properties:
1. Language and country codes are returned in ISO formats on Windows.
2. Unix locale identifier is properly parsed and language/country codes are properly extracted.
3. Don't assume that language code is always two-letter (ISO 639-1), it can have bigger length (e. g. three letters, like in ISO 639-2).
4. Return locale ID in a record type. This will allow to return additional fields in backwards-compatible manner. Currently it contains language ID, language code and country code.
This commit is contained in:
Maxim Ganetsky 2023-06-12 03:05:32 +03:00
parent 04381be2cc
commit bb19283344

View File

@ -24,23 +24,21 @@
end;
Example 2: Load the current language file using the GetLanguageIDs function
of the gettext unit in the project lpr file:
Example 2: Load the current language file using the GetLanguageID function:
uses
...
Translations, LCLProc;
Translations;
procedure TranslateLCL;
var
PODirectory, Lang, FallbackLang: String;
PODirectory: String;
LangID: TLanguageID;
begin
PODirectory:='/path/to/lazarus/lcl/languages/';
Lang:='';
FallbackLang:='';
LCLGetLanguageIDs(Lang,FallbackLang); // in unit LCLProc
LangID := GetLanguageID;
Translations.TranslateUnitResourceStrings('LCLStrConsts',
PODirectory+'lclstrconsts.%s.po',Lang,FallbackLang);
PODirectory+'lclstrconsts.%s.po',LangID.LanguageID,LangID.LanguageCode);
end;
begin
@ -49,11 +47,6 @@
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Note for Mac OS X:
The supported language IDs should be added into the application
bundle property list to CFBundleLocalizations key, see
lazarus.app/Contents/Info.plist for example.
}
unit Translations;
@ -69,6 +62,12 @@ uses
AvgLvlTree, StringHashList;
type
TLanguageID = record
LanguageID: string; //Language ID is combined of LanguageCode and CountryCode (example: 'en_US')
LanguageCode: string; //ISO 639-1 or 639-2 language code (example: 'en' or 'eng')
CountryCode: string; //ISO 3166 country code (example: 'US' or 'USA')
end;
TStringsType = (
stLrj, // Lazarus resource string table in JSON format
stRst, // FPC resource string table (before FPC 2.7.1)
@ -189,6 +188,8 @@ var
// if you don't use UTF-8, install a proper widestring manager and set this
// to false.
function GetLanguageID: TLanguageID;
function GetPOFilenameParts(const Filename: string; out AUnitName, Language: string): boolean;
function FindAllTranslatedPoFiles(const Filename: string): TStringList;
@ -218,6 +219,11 @@ const
implementation
{$IFDEF Windows}
uses
Windows;
{$ENDIF}
function IsKey(Txt, Key: PChar): boolean;
begin
if Txt=nil then exit(false);
@ -434,6 +440,99 @@ begin
end;
end;
function GetLanguageID: TLanguageID;
{$IFDEF Windows}
procedure GetLanguage;
var
UserLCID: LCID;
function RetrieveLocaleInfo(InfoType: LCTYPE; var Info: string): longint;
var
Buffer: {$IFDEF Wince}WideString{$ELSE}AnsiString{$ENDIF};
begin
Info := '';
Result := GetLocaleInfo(UserLCID, InfoType, nil, 0);
if Result <> 0 then
begin
Buffer := '';
SetLength(Buffer, Result);
Result := GetLocaleInfo(UserLCID, InfoType, @Buffer[1], Result);
if Result <> 0 then
Info := Copy(Buffer, 1, Length(Buffer) - 1); //the last char is #0, omit it
end;
end;
begin
UserLCID := GetUserDefaultLCID;
RetrieveLocaleInfo(LOCALE_SISO639LANGNAME, Result.LanguageCode);
RetrieveLocaleInfo(LOCALE_SISO3166CTRYNAME, Result.CountryCode);
end;
{$ELSE}
procedure GetLanguage;
var
i, CurItemStart, CurItemLength: SizeInt;
FinishedParsing, IsDelimiter: boolean;
CurItemType, EnvVarContents: string;
begin
EnvVarContents := GetEnvironmentVariable('LC_ALL');
if Length(EnvVarContents) = 0 then
begin
EnvVarContents := GetEnvironmentVariable('LC_MESSAGES');
if Length(EnvVarContents) = 0 then
begin
EnvVarContents := GetEnvironmentVariable('LANG');
if Length(EnvVarContents) = 0 then
exit; // no language defined via environment variables
end;
end;
//Parse locale identifier. For reference its full syntax:
//Current: `language[_territory[.codeset]][@modifier]`
//Possible in future: `language[_territory][.codeset][@modifier]`
i := 1;
CurItemStart := 1;
CurItemType := 'L'; // Language is the first item in locale identifier
FinishedParsing := false;
while (i <= Length(EnvVarContents)) and (not FinishedParsing) do
begin
IsDelimiter := EnvVarContents[i] in ['_', '.', '@'];
if IsDelimiter or (i = Length(EnvVarContents)) then
begin
CurItemLength := i - CurItemStart;
// If the last string char is not delimiter, it belongs to current item, so adjust its length
if not IsDelimiter then
inc(CurItemLength);
case CurItemType of
'L': Result.LanguageCode := Copy(EnvVarContents, CurItemStart, CurItemLength);
'_': Result.CountryCode := Copy(EnvVarContents, CurItemStart, CurItemLength);
'.': ; // We don't need codeset currently
end;
CurItemType := EnvVarContents[i];
// We don't use modifier currently, but know that it is the last in locale identifier
if CurItemType = '@' then
FinishedParsing := true;
CurItemStart := i + 1;
end;
inc(i);
end;
end;
{$ENDIF}
begin
Result := Default(TLanguageID);
GetLanguage;
if Result.LanguageCode = '' then
begin
Result.LanguageCode := 'en';
Result.CountryCode := 'US';
end;
Result.LanguageID := Result.LanguageCode;
if Result.CountryCode <> '' then
Result.LanguageID := Result.LanguageID + '_' + Result.CountryCode;
end;
function GetPOFilenameParts(const Filename: string; out AUnitName, Language: string): boolean;
var
NameWithoutExt, Ext: string;