paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-31 05:02:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* support setting translations per unit

Browse Source 
* store unitname as the first entry in the resourcestring table

git-svn-id: trunk@2987 -
This commit is contained in:
peter 2006-03-20 12:07:29 +00:00
parent 9381c9360e
commit 096113d370
3 changed files with 117 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
compiler/cresstr.pas
View File

@ -126,20 +126,45 @@ uses
procedure Tresourcestrings.CreateResourceStringData;
function WriteValueString(p:pchar;len:longint):TasmLabel;
var
s : pchar;
begin
current_asmdata.getdatalabel(result);
current_asmdata.asmlists[al_const].concat(tai_align.create(const_align(sizeof(aint))));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(-1));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(len));
current_asmdata.asmlists[al_const].concat(tai_label.create(result));
getmem(s,len+1);
move(p^,s^,len);
s[len]:=#0;
current_asmdata.asmlists[al_const].concat(tai_string.create_pchar(s,len));
current_asmdata.asmlists[al_const].concat(tai_const.create_8bit(0));
end;
Var
namelab,
valuelab : tasmlabel;
resstrlab : tasmsymbol;
s : pchar;
l : longint;
R : TResourceStringItem;
begin
{ This is only smartlinkable using section smartlinking. Using objects there is
no garantuee that }
current_asmdata.asmlists[al_resourcestrings].concat(Tai_cutobject.Create_begin);
new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,'resstridx_'+current_module.localsymtable.name^+'_start',sizeof(aint));
current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.createname_global(
make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
{ Write unitname entry }
namelab:=WriteValueString(@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^));
current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab));
current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
{$ifdef cpu64bit}
current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
{$endif cpu64bit}
{ Add entries }
R:=TResourceStringItem(List.First);
while assigned(R) do
begin
@ -147,32 +172,11 @@ uses
new_section(current_asmdata.asmlists[al_const],sec_rodata,'resstrdata_'+R.name,sizeof(aint));
{ Write default value }
if assigned(R.value) and (R.len<>0) then
begin
current_asmdata.getdatalabel(valuelab);
current_asmdata.asmlists[al_const].concat(tai_align.Create(const_align(sizeof(aint))));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(-1));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(R.len));
current_asmdata.asmlists[al_const].concat(tai_label.create(valuelab));
getmem(s,R.len+1);
move(R.value^,s^,R.len);
s[R.len]:=#0;
current_asmdata.asmlists[al_const].concat(tai_string.create_pchar(s,R.len));
current_asmdata.asmlists[al_const].concat(tai_const.create_8bit(0));
end
valuelab:=WriteValueString(R.Value,R.Len)
else
valuelab:=nil;
{ Append the name as a ansistring. }
current_asmdata.getdatalabel(namelab);
l:=length(R.name);
current_asmdata.asmlists[al_const].concat(tai_align.create(const_align(sizeof(aint))));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(-1));
current_asmdata.asmlists[al_const].concat(tai_const.create_aint(l));
current_asmdata.asmlists[al_const].concat(tai_label.create(namelab));
getmem(s,l+1);
move(R.Name[1],s^,l);
s[l]:=#0;
current_asmdata.asmlists[al_const].concat(tai_string.create_pchar(s,l));
current_asmdata.asmlists[al_const].concat(tai_const.create_8bit(0));
namelab:=WriteValueString(@R.Name[1],length(R.name));
{
Resourcestring index:

48
fcl/inc/gettext.pp
View File

@ -72,22 +72,20 @@ type
procedure GetLanguageIDs(var Lang, FallbackLang: string);
procedure TranslateResourceStrings(AFile: TMOFile);
procedure TranslateUnitResourceStrings(const AUnitName:string; AFile: TMOFile);
procedure TranslateResourceStrings(const AFilename: String);
procedure TranslateUnitResourceStrings(const AUnitName:string; const AFilename: String);
implementation
uses {$ifdef win32} windows, {$endif}dos;
var
GettextUsed: Boolean;
constructor TMOFile.Create(AStream: TStream);
var
header: TMOFileHeader;
i: Integer;
s: String;
begin
inherited Create;
@ -183,7 +181,7 @@ begin
Result := '';
exit;
end;
if (OrigTable^[nstr - 1].length = ALen) and
if (OrigTable^[nstr - 1].length = LongWord(ALen)) and
(StrComp(OrigStrings^[nstr - 1], AOrig) = 0) then
begin
Result := TranslStrings^[nstr - 1];
@ -224,6 +222,12 @@ begin
end;
procedure TranslateUnitResourceStrings(const AUnitName:string; AFile: TMOFile);
begin
SetUnitResourceStrings(AUnitName,@Translate,AFile);
end;
{$ifdef win32}
procedure GetLanguageIDs(var Lang, FallbackLang: string);
var
@ -297,7 +301,35 @@ begin
end;
end;
finalization
if GettextUsed then
ResetResourceTables;
procedure TranslateUnitResourceStrings(const AUnitName:string; const AFilename: String);
var
mo: TMOFile;
lang, FallbackLang: String;
begin
GetLanguageIDs(Lang, FallbackLang);
try
mo := TMOFile.Create(Format(AFilename, [FallbackLang]));
try
TranslateUnitResourceStrings(AUnitName,mo);
finally
mo.Free;
end;
except
on e: Exception do;
end;
lang := Copy(lang, 1, 5);
try
mo := TMOFile.Create(Format(AFilename, [lang]));
try
TranslateUnitResourceStrings(AUnitName,mo);
finally
mo.Free;
end;
except
on e: Exception do;
end;
end;
end.

47
rtl/objpas/objpas.pp
View File

@ -76,6 +76,7 @@ unit objpas;
Function Hash(S : AnsiString) : LongWord;
Procedure ResetResourceTables;
Procedure SetResourceStrings (SetFunction : TResourceIterator;arg:pointer);
Procedure SetUnitResourceStrings (const UnitName:string;SetFunction : TResourceIterator;arg:pointer);
{$ifndef RESSTRSECTIONS}
Function ResourceStringTableCount : Longint;
Function ResourceStringCount(TableIndex : longint) : longint;
@ -260,15 +261,49 @@ Procedure SetResourceStrings (SetFunction : TResourceIterator;arg:pointer);
Var
ResStr : PResourceStringRecord;
i : Longint;
s : AnsiString;
begin
With ResourceStringTable do
begin
For i:=0 to Count-1 do
begin
ResStr:=Tables[I].TableStart;
{ Skip first entry (name of the Unit) }
inc(ResStr);
while ResStr<Tables[I].TableEnd do
begin
ResStr^.CurrentValue:=SetFunction(ResStr^.Name,ResStr^.DefaultValue,ResStr^.HashValue,arg);
s:=SetFunction(ResStr^.Name,ResStr^.DefaultValue,ResStr^.HashValue,arg);
if s<>'' then
ResStr^.CurrentValue:=s;
inc(ResStr);
end;
end;
end;
end;
Procedure SetUnitResourceStrings (const UnitName:string;SetFunction : TResourceIterator;arg:pointer);
Var
ResStr : PResourceStringRecord;
i : Longint;
s,
UpUnitName : AnsiString;
begin
With ResourceStringTable do
begin
UpUnitName:=UpCase(UnitName);
For i:=0 to Count-1 do
begin
ResStr:=Tables[I].TableStart;
{ Check name of the Unit }
if ResStr^.Name<>UpUnitName then
continue;
inc(ResStr);
while ResStr<Tables[I].TableEnd do
begin
s:=SetFunction(ResStr^.Name,ResStr^.DefaultValue,ResStr^.HashValue,arg);
if s<>'' then
ResStr^.CurrentValue:=s;
inc(ResStr);
end;
end;
@ -286,6 +321,8 @@ begin
For i:=0 to Count-1 do
begin
ResStr:=Tables[I].TableStart;
{ Skip first entry (name of the Unit) }
inc(ResStr);
while ResStr<Tables[I].TableEnd do
begin
ResStr^.CurrentValue:=ResStr^.DefaultValue;
@ -306,6 +343,8 @@ begin
For i:=0 to Count-1 do
begin
ResStr:=Tables[I].TableStart;
{ Skip first entry (name of the Unit) }
inc(ResStr);
while ResStr<Tables[I].TableEnd do
begin
ResStr^.CurrentValue:='';
@ -363,6 +402,12 @@ begin
end;
Procedure SetUnitResourceStrings (const UnitName:string;SetFunction : TResourceIterator;arg:pointer);
begin
SetResourceStrings (SetFunction,arg);
end;
Procedure ResetResourceTables;
Var I,J : longint;