* Created a console application that auto generates the language include files used in CoreLib. It still needs some testing before it's ready.

3 files changed, 550 insertions, 2 deletions

diff --git a/src/readme.txt b/src/readme.txt
index a691cdcc..39c18d24 100644
--- a/src/readme.txt
+++ b/src/readme.txt
@@ -73,7 +73,7 @@ so doesn't read the standard fpc.cfg file.
  * Navigate the menus to: Options|Directories and select the 'Units'
    tab.
  * Now enter the following directories replacing the relevant parts with
-   you actual paths. The example below is valid on my system only.
+   your actual paths. The example below is valid on my system only.
    I was using FPC 2.2.0 under Linux and the X11 corelib backend.
   
     /opt/fpc_2.2.0/lib/fpc/2.2.0/units/i386-linux/*
diff --git a/tools/build_tools.bat b/tools/build_tools.bat
index 30d83028..b9d1510d 100755
--- a/tools/build_tools.bat
+++ b/tools/build_tools.bat
@@ -1,4 +1,4 @@
 
 fpc -O2 -Xs -XX -Sh -FUunits -oupdatepofiles.exe updatepofiles.pas
-
+fpc -O2 -Xs -XX -Sh -FUunits -ogenerateincfiles.exe generateincfiles.pas
 
diff --git a/tools/generateincfiles.pas b/tools/generateincfiles.pas
new file mode 100644
index 00000000..d7ae1792
--- /dev/null
+++ b/tools/generateincfiles.pas
@@ -0,0 +1,548 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author:
+      Graeme Geldenhuys
+
+  Name:
+      generateincfiles - generates include files from po files.
+
+  Synopsis:
+      generateincfiles fpgui_base_dir
+
+  Description:
+      generateincfiles will generate the lang_<langID>.inc files in the
+      src/corelib/ directory. The include files are used when changing the
+      default language of fpGUI.
+
+}
+
+program GenarateIncFiles;
+
+{$mode objfpc}{$H+}
+
+{$ifdef Windows}
+  {$define CaseInsensitiveFilenames}
+{$endif}
+
+
+uses
+  Classes, SysUtils, AvL_Tree, contnrs;
+  
+const
+  UTF8FileHeader = #$ef#$bb#$bf;
+  
+type
+  TMsgItem = record
+    Comment: string;
+    ID: string;
+    Str: string;
+  end;
+  PMsgItem = ^TMsgItem;
+  
+  TMsgItemClass = class(TObject)
+  private
+    function GetIdentifier: string;
+    function GetValue: string;
+  public
+    Comment: string;
+    ID: string;
+    Str: string;
+    property Identifier: string read GetIdentifier;
+    property Value: string read GetValue;
+  end;
+
+{ TMsgItemClass }
+
+function TMsgItemClass.GetIdentifier: string;
+var
+  s: string;
+  p: integer;
+begin
+  if Comment = '' then
+    Result := ''
+  else
+  begin
+    p := Pos(':', Comment);
+    if p = 0 then
+    begin
+      Result := '';
+      Exit;
+    end
+    else
+    begin
+      s := Copy(Comment, p+1, Length(Comment)-p);
+      p := Pos(':', s);
+      Result := Copy(s, p+1, Length(s)-p);
+    end;
+  end;
+end;
+
+function TMsgItemClass.GetValue: string;
+begin
+  if Str <> '' then
+    Result := Str
+  else
+    Result := ID;
+end;
+  
+function CompareMsgItems(Data1, Data2: pointer): integer;
+var
+  MsgItem1: PMsgItem;
+  MsgItem2: PMsgItem;
+begin
+  MsgItem1:=PMsgItem(Data1);
+  MsgItem2:=PMsgItem(Data2);
+  Result:=CompareStr(MsgItem1^.ID,MsgItem2^.ID);
+end;
+
+procedure DisposeMsgTree(var Tree: TAVLTree);
+var
+  Node: TAVLTreeNode;
+  MsgItem: PMsgItem;
+begin
+  Node:=Tree.FindLowest;
+  while Node<>nil do begin
+    MsgItem:=PMsgItem(Node.Data);
+    Dispose(MsgItem);
+    Node:=Tree.FindSuccessor(Node);
+  end;
+  Tree.Free;
+  Tree:=nil;
+end;
+
+function GetAllFilesMask: string;
+begin
+  {$IFDEF WINDOWS}
+  Result:='*.*';
+  {$ELSE}
+  Result:='*';
+  {$ENDIF}
+end;
+
+function CompareFilenames(const Filename1, Filename2: string): integer;
+begin
+  {$IFDEF CaseInsensitiveFilenames}
+  Result:=AnsiCompareText(Filename1, Filename2);
+  {$ELSE}
+  Result:=CompareStr(Filename1, Filename2);
+  {$ENDIF}
+end;
+
+
+type
+  TPoFile = class
+  public
+    Tree: TAVLTree;
+    Header: TStringList;
+    Items: TObjectList;
+    UTF8Header: string;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+{ TPoFile }
+
+constructor TPoFile.Create;
+begin
+  Tree:=TAVLTree.Create(@CompareMsgItems);
+  Header:=TStringList.Create;
+  Items := TObjectList.Create;
+end;
+
+destructor TPoFile.Destroy;
+begin
+  DisposeMsgTree(Tree);
+  Header.Free;
+  Items.Free;
+  inherited Destroy;
+end;
+
+//==============================================================================
+var
+  Files: TStringList;
+  Prefix: string;
+  BaseDir: string;
+  
+const
+  cLang = PathDelim + 'languages' + PathDelim;
+  cCorelib = PathDelim + 'src' + PathDelim + 'corelib' + PathDelim;
+
+procedure IncPrefix;
+begin
+  Prefix:=Prefix+'  ';
+end;
+
+procedure DecPrefix;
+begin
+  Prefix:=LeftStr(Prefix,length(Prefix)-2);
+end;
+
+function ParamsValid: boolean;
+var
+  i: Integer;
+  Filename: String;
+  Ext: String;
+  Name: string;
+begin
+  Result := false;
+  if ParamCount < 1 then
+    Exit; //==>
+  BaseDir := ParamStr(1);
+  if not DirectoryExists(BaseDir) then
+  begin
+    writeln('ERROR: fpGUI base directory <'+BaseDir+'> does not exist.');
+    Exit; //==>
+  end;
+  // Does it look like the fpGUI base directory? We do three simple tests.
+  if not FileExists(BaseDir + PathDelim + 'AUTHORS.txt') then
+  begin
+    writeln('ERROR: <'+BaseDir+'> directory does not look like the fpGUI base directory.');
+    Exit; //==>
+  end;
+  if not DirectoryExists(BaseDir + cLang) then
+  begin
+    writeln('ERROR: <'+BaseDir+'> directory does not look like the fpGUI base directory.');
+    writeln('       The ' + cLang + ' directory is missing.');
+    Exit; //==>
+  end;
+  if not DirectoryExists(BaseDir + cCoreLib) then
+  begin
+    writeln('ERROR: <'+BaseDir+'> directory does not look like the fpGUI base directory.');
+    writeln('       The ' + cCoreLib + ' directory is missing.');
+    Exit; //==>
+  end;
+  Result := true;
+end;
+
+function ReadMessageItem(SrcFile: TStringList; var Line: integer): PMsgItem;
+var
+  s: string;
+begin
+  New(Result);
+  while Line<SrcFile.Count do begin
+    s:=SrcFile[Line];
+    if (s<>'') and (s[1]='#') then begin
+      Result^.Comment:=Result^.Comment+copy(s,2,length(s));
+    end
+    else if (LeftStr(s,7)='msgid "') then begin
+      // read ID
+      Result^.ID:=copy(s,8,length(s)-8);
+      inc(Line);
+      while Line<SrcFile.Count do begin
+        s:=SrcFile[Line];
+        if (s<>'') and (s[1]='"') then begin
+          Result^.ID:=Result^.ID+#10+copy(s,2,length(s)-2);
+          inc(Line);
+        end else
+          break;
+      end;
+      // read Str
+      if Line<SrcFile.Count then begin
+        s:=SrcFile[Line];
+        if LeftStr(s,8)='msgstr "' then begin
+          Result^.Str:=copy(s,9,length(s)-9);
+          inc(Line);
+          while Line<SrcFile.Count do begin
+            s:=SrcFile[Line];
+            if (s<>'') and (s[1]='"') then begin
+              Result^.Str:=Result^.Str+#10+copy(s,2,length(s)-2);
+              inc(Line);
+            end else
+              break;
+          end;
+        end;
+      end;
+      exit;
+    end;
+    inc(Line);
+  end;
+end;
+
+function CreateMsgItemClass(MsgItem: PMsgItem): TMsgItemClass;
+begin
+  Result := nil;
+  if MsgItem^.Comment[1] <> ':' then
+    exit;
+  Result := TMsgItemClass.Create;
+  Result.Comment := MsgItem^.Comment;
+//  writeln(Prefix, ' Comment: ', Result.Comment);
+  Result.ID := MsgItem^.ID;
+  Result.Str := MsgItem^.Str;
+end;
+
+procedure WriteMessageItem(MsgItem: PMsgItem; DestFile: TStringList);
+
+  procedure WriteItem(const Prefix: string; Str: string);
+  var
+    s: String;
+    p: Integer;
+  begin
+    s:=Prefix+' "';
+    p:=1;
+    while (p<=length(Str)) do begin
+      if Str[p]=#10 then begin
+        // a new line
+        s:=s+copy(Str,1,p-1)+'"';
+        DestFile.Add(s);
+        Str:=copy(Str,p+1,length(Str));
+        p:=1;
+        // start new line
+        s:='"';
+      end else
+        inc(p);
+    end;
+    if (Str<>'') or (s<>'"') then begin
+      s:=s+Str+'"';
+      DestFile.Add(s);
+    end;
+  end;
+
+begin
+  if MsgItem^.Comment<>'' then
+    DestFile.Add('#'+MsgItem^.Comment);
+  WriteItem('msgid',MsgItem^.ID);
+  WriteItem('msgstr',MsgItem^.Str);
+  DestFile.Add('');
+end;
+
+function ReadPoFile(const Filename: string): TPoFile;
+var
+  SrcFile: TStringList;
+  MsgItem: PMsgItem;
+  Line: Integer;
+  oMsgItem: TMsgItemClass;
+begin
+  Result:=TPoFile.Create;
+
+  // read source .po file
+  //writeln(Prefix,'Loading ',Filename,' ...');
+  SrcFile:=TStringList.Create;
+  SrcFile.LoadFromFile(Filename);
+  
+  if (SrcFile.Count>0) and (copy(SrcFile[0],1,3)=UTF8FileHeader) then begin
+    Result.UTF8Header:=copy(SrcFile[0],1,3);
+    SrcFile[0]:=copy(SrcFile[0],4,length(SrcFile[0]));
+  end;
+  
+  Line:=0;
+  while Line<SrcFile.Count do begin
+    if (SrcFile[Line]='') then begin
+      // empty line
+      inc(Line);
+    end
+    else begin
+      // message
+      MsgItem:=ReadMessageItem(SrcFile,Line);
+      // ignore doubles
+      if (Result.Tree.FindKey(MsgItem,@CompareMsgItems)<>nil) then begin
+        Dispose(MsgItem);
+        continue;
+      end;
+      // message class
+      oMsgItem := CreateMsgItemClass(MsgItem);
+      // add message
+      Result.Tree.Add(MsgItem);
+      if oMsgItem <> nil then
+        Result.Items.Add(oMsgItem);
+    end;
+  end;
+
+  SrcFile.Free;
+end;
+
+procedure WritePoFile(PoFile: TPoFile; const Filename: string);
+var
+  DestFile: TStringList;
+  Node: TAVLTreeNode;
+  MsgItem: PMsgItem;
+  Save: Boolean;
+  OldDestFile: TStringList;
+begin
+  //writeln(Prefix,'Saving ',Filename,' ...');
+  DestFile:=TStringList.Create;
+  if (PoFile.Header.Count>0) then begin
+    DestFile.Add('msgid ""');
+    DestFile.Add('msgstr ""');
+    DestFile.AddStrings(PoFile.Header);
+    DestFile.Add('');
+  end;
+  Node:=PoFile.Tree.FindLowest;
+  while Node<>nil do begin
+    MsgItem:=PMsgItem(Node.Data);
+    WriteMessageItem(MsgItem,DestFile);
+    Node:=PoFile.Tree.FindSuccessor(Node);
+  end;
+  if (PoFile.UTF8Header<>'') and (DestFile.Count>0) then
+    DestFile[0]:=PoFile.UTF8Header+DestFile[0];
+  Save:=true;
+  if FileExists(Filename) then begin
+    OldDestFile:=TStringList.Create;
+    OldDestFile.LoadFromFile(Filename);
+    if OldDestFile.Text=DestFile.Text then Save:=false;
+    OldDestFile.Free;
+  end;
+  if Save then
+    DestFile.SaveToFile(Filename);
+  DestFile.Free;
+end;
+
+procedure WriteIncludeFile(PoFile: TPoFile; const Filename: string);
+var
+  DestFile: TStringList;
+  OldDestFile: TStringList;
+  Save: Boolean;
+  i: integer;
+  oMsg: TMsgItemClass;
+begin
+  DestFile := TStringList.Create;
+{
+  Save:=true;
+  if FileExists(Filename) then begin
+    OldDestFile:=TStringList.Create;
+    OldDestFile.LoadFromFile(Filename);
+    if OldDestFile.Text=DestFile.Text then Save:=false;
+    OldDestFile.Free;
+  end;
+  if Save then
+    DestFile.SaveToFile(Filename);
+}
+  for i := 0 to PoFile.Items.Count - 1 do
+  begin
+    oMsg := TMsgItemClass(PoFile.Items[i]);
+    DestFile.Add(Format('%s  =  ''%s'';', [oMsg.Identifier, oMsg.Value]));
+  end;
+  DestFile.SaveToFile(Filename);
+  DestFile.Free;
+end;
+
+function FindAllTranslatedPoFiles(const ALangDir: string): TStringList;
+var
+  Path: String;
+  NameOnly: String;
+  FileInfo: TSearchRec;
+  CurExt: String;
+begin
+  Result := TStringList.Create;
+  Path := ALangDir;
+  NameOnly := 'fpgui';
+  if SysUtils.FindFirst(Path+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin
+    repeat
+      if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
+      or (CompareFilenames(FileInfo.Name, 'fpgui.po')=0) then continue;
+      CurExt:=ExtractFileExt(FileInfo.Name);
+      if (CompareFilenames(CurExt,'.po')<>0)
+      or (CompareFilenames(LeftStr(FileInfo.Name,length(NameOnly)),NameOnly)<>0)
+      then
+        continue;
+      Result.Add(Path+FileInfo.Name);
+    until SysUtils.FindNext(FileInfo)<>0;
+  end;
+  SysUtils.FindClose(FileInfo);
+end;
+
+procedure MergePoTrees(SrcTree, DestTree: TAVLTree);
+var
+  SrcNode, DestNode: TAVLTreeNode;
+  SrcMsgItem, DestMsgItem: PMsgItem;
+  OldNode: TAVLTreeNode;
+begin
+  // add all message items from SrcTree into DestTree
+  SrcNode:=SrcTree.FindLowest;
+  while SrcNode<>nil do begin
+    SrcMsgItem:=PMsgItem(SrcNode.Data);
+    DestNode:=DestTree.FindKey(SrcMsgItem,@CompareMsgItems);
+    if DestNode<>nil then begin
+      // ID already exists -> update comment
+      DestMsgItem:=PMsgItem(DestNode.Data);
+      DestMsgItem^.Comment:=SrcMsgItem^.Comment;
+    end else begin
+      // new ID -> add new message item to DestTree
+      New(DestMsgItem);
+      DestMsgItem^.Comment:=SrcMsgItem^.Comment;
+      DestMsgItem^.ID:=SrcMsgItem^.ID;
+      DestMsgItem^.Str:=SrcMsgItem^.Str;
+      DestTree.Add(DestMsgItem);
+    end;
+    SrcNode:=SrcTree.FindSuccessor(SrcNode);
+  end;
+  // remove all old messages in DestTree
+  DestNode:=DestTree.FindLowest;
+  while DestNode<>nil do begin
+    DestMsgItem:=PMsgItem(DestNode.Data);
+    OldNode:=DestNode;
+    DestNode:=DestTree.FindSuccessor(DestNode);
+    if (DestMsgItem^.ID<>'')
+    and (SrcTree.FindKey(DestMsgItem,@CompareMsgItems)=nil) then begin
+      // unused message -> delete it
+      writeln('Deleting unused message "',DestMsgItem^.ID,'"');
+      Dispose(DestMsgItem);
+      DestTree.Delete(OldNode);
+    end;
+  end;
+end;
+
+procedure ProcessPoFile(const Filename: string);
+var
+  SrcFile: TPoFile;
+
+  function Newfile: string;
+  var
+    s: string;
+    p: integer;
+  begin
+    s := ExtractFileName(Filename);
+    p := Pos('.', s);
+    s := Copy(s, p+1, Length(s));
+    s := StringReplace(s, '.po', '.inc', [rfIgnoreCase]);
+    Result := 'lang_' + s;
+  end;
+  
+begin
+  writeln('Loading ',Filename,' ...');
+  SrcFile := ReadPoFile(Filename);
+  WriteIncludeFile(SrcFile, Newfile);
+  SrcFile.Free;
+end;
+
+procedure ProcessAllPoFiles;
+var
+  i: Integer;
+begin
+  Files := FindAllTranslatedPoFiles(BaseDir + cLang);
+  for i := 0 to Files.Count-1 do
+    ProcessPoFile(Files[i]);
+end;
+
+begin
+  Prefix:='';
+  Files:=nil;
+  if not ParamsValid then
+  begin
+    writeln('Usage: ',ExtractFileName(ParamStr(0)), ' fpgui_base_dir');
+    Exit;
+  end
+  else
+  begin
+    ProcessAllPoFiles;
+  end;
+  Files.Free;
+end.
+