* support setting translations per unit

  * store unitname as the first entry in the resourcestring table

git-svn-id: trunk@2987 -

compiler/cresstr.pas

@@ -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:

fcl/inc/gettext.pp

@@ -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.

rtl/objpas/objpas.pp

@@ -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;