source: tools/Lazarus translator/UItemListForm.pas

unit UItemListForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ComCtrls, UItemTranslationForm, UTextFileStream, StdCtrls;

const
  LazarusRepository: string = '../../../../Lazarus/';
  TranslationFolder: string = '../../trunk/';
  TranslationMergeFolder: string = '../../tags/0.9.26/';
  LocaleName: string = 'cz';

  LanguageFiles: array[0..27] of string = (
    'languages/lazaruside.po',
    'languages/installerstrconsts.po',
    'ideintf/languages/objinspstrconsts.po',
    'lcl/languages/lclstrconsts.po',
    'components/cgi/languages/cgimodules.po',
    'components/codetools/languages/codetoolsstrconsts.po',
    'components/h2pas/languages/h2passtrconsts.po',
    'components/lazreport/samples/editor/languages/calleditorwithpkg.po',
    'components/lazreport/source/languages/lr_const.po',
    'components/memds/languages/frmselectdataset.po',
    'components/messagecomposer/languages/messagecomposer.po',
    'components/prettyformat/languages/pfidesource.po',
    'components/printers/design/languages/ideprinting.po',
    'components/projecttemplates/languages/frmtemplatevariables.po',
    'components/projecttemplates/languages/idetemplateproject.po',
    'components/projecttemplates/languages/projecttemplates.po',
    'components/sqldb/languages/registersqldb.po',
    'components/sqldb/languages/sqlstringspropertyeditordlg.po',
    'components/synedit/languages/synedit.po',
    'components/synedit/languages/synhighlighterunixshellscript.po',
    'components/synedit/languages/synmacrorecorder.po',
    'components/synunihighlighter/languages/synunidesigner.po',
    'components/synunihighlighter/languages/synunireg.po',
    'components/tdbf/languages/registerdbf.po',
    'components/turbopower_ipro/languages/ipconst.po',
    'components/turbopower_ipro/languages/iputils.po',
    'examples/codepageconverter/languages/lazconverter.po',
    'examples/codepageconverter/languages/mainunit.po'
  );

type
  TTranslationItem = class
    Identification: string;
    OriginalText: string;
    TranslatedText: string;
  end;

  { TMainForm }

  { TItemListForm }

  TItemListForm = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
  private
  public
    TranslationFile: string;
    LastSortedColumn: Integer;
    StringList: TList; // TList<TText>
    procedure FillList;
    procedure LoadListFromFile;
    procedure SaveListToFile;
    procedure MergeListFromFile;
    function RenameToLocale(POFileName: string): string;
  end;

  function FileCopy(source,dest: String): Boolean;

var
  ItemListForm: TItemListForm;
  Ascending: Boolean;

implementation

function FileCopy(source,dest: String): Boolean;
var
 fSrc,fDst,len: Integer;
 ct,units,size: Longint;
 buffer: packed array [0..2047] of Byte;
begin
 ct:=0;
 Result := False; { Assume that it WONT work }
 if source <> dest then begin
   fSrc := FileOpen(source,fmOpenRead);
   if fSrc >= 0 then begin
     size := FileSeek(fSrc,0,2);
     units:=size div 2048;
     FileSeek(fSrc,0,0);
     fDst := FileCreate(dest);
     if fDst >= 0 then begin
       while size > 0 do begin
         len := FileRead(fSrc,buffer,sizeof(buffer));
         FileWrite(fDst,buffer,len);
         size := size - len;
         if units > 0 then
         ct:=ct+1;
       end;
       FileSetDate(fDst,FileGetDate(fSrc));
       FileClose(fDst);
       FileSetAttr(dest,FileGetAttr(source));
       Result := True;
     end;
     FileClose(fSrc);
   end;
 end;
end;

function SortByColumn(Item1, Item2: TListItem; Data: integer): Integer; stdcall;
begin
  if Data = 0 then
    Result := AnsiCompareText(Item1.Caption, Item2.Caption)
  else
    Result := AnsiCompareText(Item1.SubItems[Data - 1],
      Item2.SubItems[Data - 1]);
  if not Ascending then Result := -Result;
end;

procedure TItemListForm.FillList;
var
  I: Integer;
  NewItem: TListItem;
  CompletedCount: Integer;
begin
  CompletedCount := 0;
  with ListView1, Items do begin
    BeginUpdate;
    Clear;
    for I := 0 to StringList.Count - 1 do
    with TTranslationItem(StringList[I]) do begin
      NewItem := Add;
      NewItem.Data := StringList[I];
      NewItem.Caption := OriginalText;
      with NewItem.SubItems do begin
        Add(TranslatedText);
        Add(Identification);
        if TranslatedText <> '' then Inc(CompletedCount);
      end;
    end;
    EndUpdate;
  end;
  ProgressBar1.Max := StringList.Count;
  ProgressBar1.Position := CompletedCount;
end;

procedure TItemListForm.FormCreate(Sender: TObject);
begin
  StringList := TList.Create;
  LastSortedColumn := -1;
  Ascending := True;
end;

procedure TItemListForm.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
    Compare := AnsiCompareText(Item1.SubItems[0],
      Item2.SubItems[0]);
  if not Ascending then Compare := -Compare;
end;

procedure TItemListForm.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to StringList.Count - 1 do
    TTranslationItem(StringList[I]).Free;
  StringList.Free;
end;

procedure TItemListForm.FormShow(Sender: TObject);
begin
  LoadListFromFile;
  //MergeListFromFile;
  FillList;
end;

procedure TItemListForm.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TItemListForm.ComboBox1Change(Sender: TObject);
begin
  SaveListToFile;
  LoadListFromFile;
  FillList;
end;

procedure TItemListForm.FormClose(Sender: TObject; var CloseAction: TCloseAction
  );
begin
  SaveListToFile;
end;

procedure TItemListForm.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if Column.Index = LastSortedColumn then
    Ascending := not Ascending
  else
    LastSortedColumn := Column.Index;
  //TListView(Sender).CustomSort(@SortByColumn, Column.Index);
end;

procedure TItemListForm.ListView1DblClick(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then
  with ItemTranslationForm, TTranslationItem(ListView1.Selected.Data) do begin
    Memo1.Text := OriginalText;
    Memo2.Text := TranslatedText;
    ItemTranslationForm.ShowModal;
    //OriginalText := Memo1.Text;
    TranslatedText := Copy(Memo2.Text, 1, Length(Memo2.Text) - 2);

    ListView1.Selected.SubItems[0] := TranslatedText;
    SaveListToFile;
  end;
end;

procedure TItemListForm.ListView1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then ListView1DblClick(Self);
end;

procedure TItemListForm.LoadListFromFile;
var
  Source: TTextFileStream;
  Row: string;
  NewItem: TTranslationItem;
  I: Integer;
begin
  StringList.Clear;
  NewItem := nil;
  Source := TTextFileStream.Create(TranslationFile, fmOpenRead);
  try
    for I := 0 to 2 do Row := Source.ReadLn;  // Skip leading info lines

    while not Source.Eof do begin
      Row := Source.ReadLn;
      if Copy(Row, 1, 2) = '#:' then begin
        NewItem := TTranslationItem.Create;
        NewItem.Identification := Copy(Row, 4, 255);
        NewItem.Identification := StringReplace(NewItem.Identification, ':', '.', [rfReplaceAll]);
      end else
      if Copy(Row, 1, Pos(' ', Row) - 1) = 'msgid' then begin
        if Assigned(NewItem) then
          NewItem.OriginalText := Copy(Row, 8, Length(Row) - 8)
      end else
      if Copy(Row, 1, Pos(' ', Row) - 1) = 'msgstr' then begin
        if Assigned(NewItem) then begin
          NewItem.TranslatedText := Copy(Row, 9, Length(Row) - 9);
          StringList.Add(NewItem);
        end;
      end;
    end;
  finally
    Source.Free;
  end;
end;

procedure TItemListForm.SaveListToFile;
var
  Source: TTextFileStream;
  I: Integer;
begin
  Source := TTextFileStream.Create(TranslationFile, fmOpenWrite);
  with Source do
  try
    WriteLn('msgid ""');
    WriteLn('msgstr ""');
    WriteLn('"Project-Id-Version: \n"');
    WriteLn('"POT-Creation-Date: \n"');
    WriteLn('"PO-Revision-Date: 2009-01-07 19:03+0100\n"');
    WriteLn('"Last-Translator: Chronos <robie@centrum.cz>\n"');
    WriteLn('"Translation-Source: http://tv.zdechov.net/svn/lazarus_czech/\n"');
    WriteLn('"Language-Team: \n"');
    WriteLn('"MIME-Version: 1.0\n"');
    WriteLn('"Content-Type: text/plain; charset=UTF-8\n"');
    WriteLn('"Content-Transfer-Encoding: 8bit\n"');
    WriteLn('');
    for I := 0 to StringList.Count - 1 do
    with TTranslationItem(StringList[I]) do begin
      WriteLn('#: ' + Identification);
      WriteLn('msgid "' + OriginalText + '"');
      WriteLn('msgstr "' + TranslatedText + '"');
      WriteLn('');
    end;
  finally
    Source.Free;
  end;
end;

function TItemListForm.RenameToLocale(POFileName: string): string;
begin
  Result := StringReplace(POFileName, '.po', '.' + LocaleName + '.po', [rfReplaceAll]);
end;

procedure TItemListForm.MergeListFromFile;
var
  Source: TTextFileStream;
  Row: string;
  NewItem: TTranslationItem;
  I: Integer;
begin
  NewItem := nil;
  Source := TTextFileStream.Create(TranslationFile, fmOpenRead);
  try
    for I := 0 to 2 do Row := Source.ReadLn;  // Skip lines

    while not Source.Eof do begin
      Row := Source.ReadLn;
      if Copy(Row, 1, 2) = '#:' then begin
        NewItem := TTranslationItem.Create;
        NewItem.Identification := Copy(Row, 4, 255);
        NewItem.Identification := StringReplace(NewItem.Identification, ':', '.', [rfReplaceAll]);
      end else
      if Copy(Row, 1, Pos(' ', Row) - 1) = 'msgid' then begin
        if Assigned(NewItem) then
          NewItem.OriginalText := Copy(Row, 8, Length(Row) - 8)
      end else
      if Copy(Row, 1, Pos(' ', Row) - 1) = 'msgstr' then begin
        if Assigned(NewItem) then begin
          NewItem.TranslatedText := Copy(Row, 9, Length(Row) - 9);
          I := 0;
          while (I < StringList.Count) and ((TTranslationItem(StringList[I]).OriginalText <> NewItem.OriginalText) or
          (TTranslationItem(StringList[I]).Identification <> NewItem.Identification)) do Inc(I);
          if I < StringList.Count then
            TTranslationItem(StringList[I]).TranslatedText := NewItem.TranslatedText;
          NewItem.Free;
        end;
      end;
    end;
  finally
    Source.Free;
  end;
end;


initialization
  {$I UItemListForm.lrs}

end.