paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 00:39:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

Add tool to maintain po files. Move entries between files. Find duplicates.

Browse Source
This commit is contained in:
Martin 2023-02-20 12:28:03 +01:00
parent 658d14c8a7
commit b31586fc9c
7 changed files with 1583 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/lazarus.lpi
View File

@ -1277,6 +1277,7 @@
<Unit>
<Filename Value="idetranslations.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="IDETranslations"/>
</Unit>
<Unit>
<Filename Value="useunitdlg.pas"/>
@ -1419,6 +1420,7 @@
<Unit>
<Filename Value="findinfileswnd.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
<UnitName Value="FindInFilesWnd"/>
</Unit>
<Unit>

4
tools/pofilemaintenance/README.txt Normal file
View File

@ -0,0 +1,4 @@
This tool allows to move translations between .po files.
It can also find potentiol duplicate entries.
All Sources are licensed under LGPL v2 with linking exception (same as LCL).

123
tools/pofilemaintenance/pofilemaintenance.lpi Normal file
View File

@ -0,0 +1,123 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="pofilemaintenance"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Debug" Default="True"/>
<Item Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="pofilemaintenance"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="B:\lazarus_main\tools\pofilemaintenance"/>
<CompressFinally Value="False"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="pofilemaintenance.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PoFileMaintenance"/>
</Unit>
<Unit>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit>
<Unit>
<Filename Value="potfile.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PotFile"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="pofilemaintenance"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</CONFIG>

25
tools/pofilemaintenance/pofilemaintenance.lpr Normal file
View File

@ -0,0 +1,25 @@
program PoFileMaintenance;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, PotFile
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

734
tools/pofilemaintenance/potfile.pas Normal file
View File

@ -0,0 +1,734 @@
unit PotFile;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fgl, LazFileUtils, FileUtil, Contnrs;
type
{ TTranslationSection }
TTranslationSection = class(TStringList)
private
FOwner: TObject;
FVarName, FMsgId, FMsgStr: String;
function GetVarName: String;
function GetMsgId: String;
function GetMsgStr: String;
function GetMsgIdContent: String;
function GetMsgIdCleanContent: String;
function GetMsgStrContent: String;
function GetMsgStrCleanContent: String;
function GetVarNameContent: String;
function GetVarNameIdent: String;
function GetVarNameUnit: String;
function FindLine(AName: String): String;
function CleanLineContent(AText: String): String;
protected
procedure SetTextStr(const Value: string); override;
function CreateCopy: TTranslationSection;
property Owner: TObject read FOwner;
public
procedure ReplaceUnitPrefix(NewPrefix: String);
procedure DeleteMsgCtxt;
function IsEmpty: boolean;
property VarName: String read GetVarName;
property VarNameContent: String read GetVarNameContent;
property VarNameIdent: String read GetVarNameIdent;
property VarNameUnit: String read GetVarNameUnit;
property MsgId: String read GetMsgId;
property MsgIdContent: String read GetMsgIdContent;
property MsgIdCleanContent: String read GetMsgIdCleanContent;
property MsgStr: String read GetMsgStr;
property MsgStrContent: String read GetMsgStrContent;
property MsgStrCleanContent: String read GetMsgStrCleanContent;
end;
TTranslationSectionClass = class of TTranslationSection;
{ TTranslationList }
generic TTranslationList<TBase: TTranslationSection> = class(specialize TFPGObjectList<TBase>)
private
FFileName: String;
FModified: Boolean;
FName: String;
protected
function CreateEntry: TTranslationSection; virtual; abstract;
public
constructor Create(AFileName: String; ACreateEmpty: boolean = False);
function Add(const Item: TBase): Integer; inline;
procedure Load; virtual;
procedure Save; virtual;
procedure SetModified; virtual;
function IndexOfVar(AVarName: String): integer;
function IndexOfVarContent(AVarName: String): integer;
function IsEmpty: boolean; // all MsgStr = ''
function NoneEmptyCount: Integer; // all MsgStr = ''
property FileName: String read FFileName;
property Name: String read FName;
property Modified: Boolean read FModified;
end;
{ TPoSection }
TPoSection = class(TTranslationSection)
public
function CreateCopy: TPoSection;
end;
{ TPoFile }
TPoFile = class(specialize TTranslationList<TPoSection>)
private
FLangName: String;
protected
function CreateEntry: TTranslationSection; override;
public
constructor Create(AFileName: String; ACreateEmpty: boolean = False);
property LangName: String read FLangName;
end;
TPotFile = class;
{ TPoFileList }
TPoFileList = class(specialize TFPGObjectList<TPoFile>)
private
FOwner: TPotFile;
public
constructor Create(AOwner: TPotFile);
procedure Clear;
function PoFileForLang(ALang: String; ACreate: Boolean = False): TPoFile;
end;
{ TPotSection }
TPotSection = class(TTranslationSection)
private
function GetOwner: TPotFile; reintroduce;
public
function CreateCopy: TPotSection;
function TranslationCount: integer;
function TranslationNoneEmptyCount: integer;
procedure GetTranslationyCount(out TotalCnt, NoneEmptyCnt: integer);
property Owner: TPotFile read GetOwner;
end;
{ TPotFile }
TPotFile = class(specialize TTranslationList<TPotSection>)
private
FPoFiles: TPoFileList;
protected
function CreateEntry: TTranslationSection; override;
procedure LoadPoFiles;
procedure SavePoFiles;
public
constructor Create(AFileName: String; ACreateEmpty: boolean = False);
destructor Destroy; override;
procedure Clear;
procedure Load; override;
procedure Save; override;
property PoFiles: TPoFileList read FPoFiles;
end;
TFindDupFlag = (fdIgnoreCase, fdIgnoreSpaceDiff);
TFindDupFlags = set of TFindDupFlag;
{ TPotFileList }
TPotFileList = class(specialize TFPGObjectList<TPotFile>)
public
procedure FindDuplicateMsgId(ARes: TPotFile; AFlags: TFindDupFlags = []);
end;
implementation
{ TPoSection }
function TPoSection.CreateCopy: TPoSection;
begin
Result := TPoSection(inherited CreateCopy);
end;
{ TPotSection }
function TPotSection.GetOwner: TPotFile;
begin
Result := TPotFile(inherited Owner);
end;
function TPotSection.CreateCopy: TPotSection;
begin
Result := TPotSection(inherited CreateCopy);
end;
function TPotSection.TranslationCount: integer;
var
po: TPoFile;
i: Integer;
begin
Result := 0;
if Owner = nil then
exit;
for i := 0 to Owner.PoFiles.Count - 1 do begin
po := Owner.PoFiles[i];
if po.IndexOfVar(VarName) >= 0 then
inc(Result);
end;
end;
function TPotSection.TranslationNoneEmptyCount: integer;
var
po: TPoFile;
i, e: Integer;
begin
Result := 0;
if Owner = nil then
exit;
for i := 0 to Owner.PoFiles.Count - 1 do begin
po := Owner.PoFiles[i];
e := po.IndexOfVar(VarName);
if (e >= 0) and (not po[e].IsEmpty) then
inc(Result);
end;
end;
procedure TPotSection.GetTranslationyCount(out TotalCnt, NoneEmptyCnt: integer);
var
po: TPoFile;
i, e: Integer;
begin
TotalCnt := 0;
NoneEmptyCnt := 0;
if Owner = nil then
exit;
for i := 0 to Owner.PoFiles.Count - 1 do begin
po := Owner.PoFiles[i];
e := po.IndexOfVar(VarName);
if (e >= 0) then begin
inc(TotalCnt);
if (not po[e].IsEmpty) then
inc(NoneEmptyCnt);
end;
end;
end;
{ TTranslationSection }
function TTranslationSection.GetVarName: String;
begin
if FVarName = '' then
FVarName := FindLine('#: ');
Result := FVarName;
end;
function TTranslationSection.GetMsgStrContent: String;
begin
Result := MsgStrCleanContent;
system.Delete(Result, 1, 7);
end;
function TTranslationSection.GetMsgId: String;
begin
if FMsgId = '' then
FMsgId := FindLine('msgid ');
Result := FMsgId;
end;
function TTranslationSection.GetMsgStr: String;
begin
if FMsgStr = '' then
FMsgStr := FindLine('msgstr ');
Result := FMsgStr;
end;
function TTranslationSection.GetMsgIdContent: String;
begin
Result := MsgId;
system.Delete(Result, 1, 6);
end;
function TTranslationSection.GetMsgIdCleanContent: String;
begin
Result := CleanLineContent(MsgId);
end;
function TTranslationSection.GetMsgStrCleanContent: String;
begin
Result := CleanLineContent(MsgStr);
end;
function TTranslationSection.GetVarNameContent: String;
begin
Result := VarName;
system.Delete(Result, 1, 3);
end;
function TTranslationSection.GetVarNameIdent: String;
var
i: SizeInt;
begin
Result := VarName;
i := Length(Result);
while (i > 0) and (Result[i] <> '.') do
dec(i);
if i > 0 then
system.Delete(Result, 1, i);
end;
function TTranslationSection.GetVarNameUnit: String;
var
i: SizeInt;
begin
Result := VarNameContent;
i := Length(Result);
while (i > 0) and (Result[i] <> '.') do
dec(i);
if i > 0 then
system.Delete(Result, i, Length(Result));
end;
function TTranslationSection.FindLine(AName: String): String;
var
i: Integer;
begin
Result := '';
i := Count - 1;
while i >= 0 do begin
if strlcomp(PChar(AName), PChar(Strings[i]), Length(AName)) = 0 then begin
Result := Strings[i];
exit;
end;
dec(i);
end;
end;
function TTranslationSection.CleanLineContent(AText: String): String;
var
i: SizeInt;
begin
Result := AText;
i := pos(' "', Result);
if i > 0 then
system.Delete(Result, 1, i+1);
if (Result <> '') and (Result[Length(Result)] = '"') then
system.Delete(Result, Length(Result), 1);
Result := StringReplace(Result, '\"', '"', [rfReplaceAll]);
end;
procedure TTranslationSection.SetTextStr(const Value: string);
begin
inherited SetTextStr(Value);
FVarName := '';
FMsgId := '';
FMsgStr := '';
end;
function TTranslationSection.CreateCopy: TTranslationSection;
begin
Result := TTranslationSectionClass(ClassType).Create;
Result.Text := Text;
end;
procedure TTranslationSection.ReplaceUnitPrefix(NewPrefix: String);
var
Old: String;
i: SizeInt;
begin
Old := VarNameContent;
i := Length(Old);
while (i > 0) and (Old[i] <> '.') do
dec(i);
if i < 1 then
exit;
system.Delete(Old, i+1, Length(old)); // keep the dot
for i := 0 to Count - 1 do begin
if (Strings[i] <> '') and
( (Strings[i][1] = '#') or
(strlcomp(pchar('msgctxt '), pchar(Strings[i]), 8) = 0)
)
then
Strings[i] := StringReplace(Strings[i], Old, NewPrefix+'.', [rfReplaceAll]);
end;
end;
procedure TTranslationSection.DeleteMsgCtxt;
var
i: Integer;
begin
i := Count - 1;
while (i >= 0) and (strlcomp(pchar('msgctxt '), pchar(Strings[i]), 8) <> 0) do
dec(i);
if i >= 0 then
Delete(i);
end;
function TTranslationSection.IsEmpty: boolean;
begin
Result := MsgStrCleanContent = '';
end;
{ TTranslationList }
constructor TTranslationList.Create(AFileName: String; ACreateEmpty: boolean);
begin
inherited Create(True);
FFileName := AFileName;
FName := ExtractFileNameOnly(AFileName);
if not ACreateEmpty then
Load;
end;
function TTranslationList.Add(const Item: TBase): Integer;
begin
Item.FOwner := Self;
Result := inherited Add(Item);
end;
procedure TTranslationList.Load;
var
AFile: TStringList;
i, c: Integer;
j: LongInt;
e: TTranslationSection;
begin
Clear;
AFile := TStringList.Create;
AFile.LoadFromFile(FFileName);
i := 0;
c := AFile.Count;
while i < c do begin
if AFile[i] = '' then begin
inc(i);
Continue;
end;
j := i;
while (i < c) and (AFile[i] <> '') do
inc(i);
if i > j then begin
e := CreateEntry;
while j < i do begin
e.Add(AFile[j]);
inc(j);
end;
Add(TBase(e));
end;
end;
AFile.Free;
end;
procedure TTranslationList.Save;
var
AFile: TStringList;
s: String;
i: Integer;
begin
AFile := TStringList.Create;
s := '';
for i := 0 to Count - 1 do begin
s := s + Items[i].Text + LineEnding;
end;
AFile.Text := s;
AFile.SaveToFile(FFileName);
AFile.Free;
FModified := False;
end;
procedure TTranslationList.SetModified;
begin
FModified := True;
end;
function TTranslationList.IndexOfVar(AVarName: String): integer;
begin
Result := Count - 1;
while Result >= 0 do begin
if Items[Result].VarName = AVarName then
exit;
dec(Result);
end;
end;
function TTranslationList.IndexOfVarContent(AVarName: String): integer;
begin
Result := Count - 1;
while Result >= 0 do begin
if Items[Result].VarNameContent = AVarName then
exit;
dec(Result);
end;
end;
function TTranslationList.IsEmpty: boolean;
var
i: Integer;
begin
result := False;
for i := 1 to Count - 1 do
if not Items[i].IsEmpty then
exit;
result := True;
end;
function TTranslationList.NoneEmptyCount: Integer;
var
i: Integer;
begin
Result := 0;
for i := 1 to Count - 1 do
if not Items[i].IsEmpty then
inc(Result);
end;
{ TPoFile }
function TPoFile.CreateEntry: TTranslationSection;
begin
Result := TPoSection.Create;
end;
constructor TPoFile.Create(AFileName: String; ACreateEmpty: boolean);
var
i: SizeInt;
begin
inherited Create(AFileName, ACreateEmpty);
FLangName := Name;
i := Length(FLangName);
while (i > 0) and (FLangName[i] <> '.') do
dec(i);
if i > 0 then
system.Delete(FLangName, 1, i);
end;
{ TPoFileList }
constructor TPoFileList.Create(AOwner: TPotFile);
begin
FOwner := AOwner;
inherited Create(True);
end;
procedure TPoFileList.Clear;
var
i: Integer;
begin
for i := 0 to Count - 1 do
Items[i].Clear;
inherited Clear;
end;
function TPoFileList.PoFileForLang(ALang: String; ACreate: Boolean): TPoFile;
var
i: Integer;
h: TPoSection;
begin
i := Count - 1;
while i >= 0 do begin
if Items[i].LangName = ALang then
exit(Items[i]);
dec(i);
end;
Result := TPoFile.Create(ExtractFileNameWithoutExt(FOwner.FileName) + '.' + ALang + '.po', True);
h := TPoSection.Create;
h.Text :=
'msgid ""' + LineEnding +
'msgstr ""' + LineEnding +
'"Project-Id-Version: \n"' + LineEnding +
'"MIME-Version: 1.0\n"' + LineEnding +
'"Content-Type: text/plain; charset=utf-8\n"' + LineEnding +
'"Content-Transfer-Encoding: 8bit\n"' + LineEnding
;
Result.Add(h);
Add(Result);
end;
{ TPotFile }
function TPotFile.CreateEntry: TTranslationSection;
begin
Result := TPotSection.Create;
end;
procedure TPotFile.LoadPoFiles;
var
ADir: String;
AList: TStringList;
i: Integer;
begin
ADir := AppendPathDelim(ExtractFileDir(FFileName));
AList := FindAllFiles(ADir, FName + '.*.po', False, faAnyFile);
if (AList = nil) then
exit;
for i := 0 to AList.Count - 1 do
FPoFiles.Add( TPoFile.Create(AList[i]) );
AList.Free;
end;
procedure TPotFile.SavePoFiles;
var
i: Integer;
begin
for i := 0 to FPoFiles.Count - 1 do
FPoFiles[i].Save;
end;
constructor TPotFile.Create(AFileName: String; ACreateEmpty: boolean);
begin
FPoFiles := TPoFileList.Create(Self);
inherited Create(AFileName, ACreateEmpty);
end;
destructor TPotFile.Destroy;
begin
inherited Destroy;
FreeAndNil(FPoFiles);
end;
procedure TPotFile.Clear;
begin
FPoFiles.Clear;
inherited Clear;
end;
procedure TPotFile.Load;
begin
inherited Load;
LoadPoFiles;
end;
procedure TPotFile.Save;
begin
inherited Save;
SavePoFiles;
end;
{ TPotFileList }
procedure TPotFileList.FindDuplicateMsgId(ARes: TPotFile; AFlags: TFindDupFlags
);
procedure AddDup(ANewVarName: String; ASrc: TPotSection);
var
po: TPoFile;
poSect: TPoSection;
e: LongInt;
i: Integer;
n: String;
begin
n := ASrc.Owner.Name;
po := ARes.PoFiles.PoFileForLang(n+' ');
e := po.IndexOfVarContent(ANewVarName);
i := 0;
while e >= 0 do begin
inc(i);
po := ARes.PoFiles.PoFileForLang(n+'_'+IntToStr(i));
e := po.IndexOfVarContent(ANewVarName);
end;
poSect := TPoSection.Create;
poSect.Text := '#: ' + ANewVarName + LineEnding +
'msgstr "' + ASrc.VarNameContent + ': ' + ASrc.MsgIdCleanContent + '"' + LineEnding;
po.Add(poSect);
end;
function GetComparableMsgId(msgid: string): String;
var
i, j: Integer;
begin
Result := msgid;
if fdIgnoreCase in AFlags then
Result := LowerCase(Result);
if fdIgnoreSpaceDiff in AFlags then begin
Result := Trim(Result);
i := 0;
j := 0;
while i < length(Result) do begin
inc(i);
inc(j);
Result[j] := Result[i];
if Result[i] in [#0..' '] then begin
Result[j] := ' ';
while (i < length(Result)) and (Result[i+1] in [#0..' ']) do
inc(i);
if ( (j > 1) and (not (Result[j-1] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) ) or
( (i < Length(Result)) and (not (Result[i+1] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) )
then
dec(j);
end;
end;
SetLength(Result, j);
end;
end;
var
TmpHash: TFPObjectHashTable;
i, j: Integer;
pot: TPotFile;
potItm: TPotSection;
dupPotItm, newDupPotItm: TPotSection;
msgid: String;
begin
ARes.Clear;
TmpHash := TFPObjectHashTable.Create(False);
for i := 0 to Count - 1 do begin
pot := Items[i];
for j := 1 to pot.Count - 1 do begin
potItm := pot.Items[j];
msgid := GetComparableMsgId(potItm.MsgIdCleanContent);
dupPotItm := TPotSection(TmpHash[msgid]);
if dupPotItm = nil then begin
TmpHash.Add(msgid, potItm);
end
else
if dupPotItm.Owner = ARes then begin
// already a dup
AddDup(DupPotItm.VarNameContent, potItm);
end
else
begin
newDupPotItm := TPotSection.Create;
newDupPotItm.Text := '#: ' + dupPotItm.VarNameIdent + '__' + IntToHex(PtrUInt(newDupPotItm)) + LineEnding +
dupPotItm.MsgId + LineEnding;
ARes.Add(newDupPotItm);
TmpHash[msgid] := newDupPotItm;
AddDup(newDupPotItm.VarNameContent, dupPotItm);
AddDup(newDupPotItm.VarNameContent, potItm);
end;
end;
end;
TmpHash.Free;
end;
end.

239
tools/pofilemaintenance/unit1.lfm Normal file
View File

@ -0,0 +1,239 @@
object Form1: TForm1
Left = 426
Height = 571
Top = 223
Width = 896
AllowDropFiles = True
Caption = 'Po-File maintenance'
ClientHeight = 571
ClientWidth = 896
OnCreate = FormCreate
OnDropFiles = FormDropFiles
LCLVersion = '2.3.0.0'
object lbPoFiles: TListBox
Left = 0
Height = 493
Top = 26
Width = 250
Align = alLeft
ItemHeight = 0
OnClick = lbPoFilesClick
TabOrder = 0
end
object ToolBar1: TToolBar
Left = 0
Height = 26
Top = 0
Width = 896
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 1
object ToolButton1: TToolButton
Left = 1
Top = 2
Caption = 'Open POT'
OnClick = ToolButton1Click
end
object tbMovePoItems: TToolButton
Left = 202
Top = 2
Caption = 'Move items to'
DropdownMenu = popMoveTo
Enabled = False
Style = tbsButtonDrop
end
object tbSave: TToolButton
Left = 170
Top = 2
Caption = 'Save'
Enabled = False
OnClick = tbSaveClick
end
object tbDupId: TToolButton
Left = 296
Top = 2
Caption = 'Find duplicate MsgId'
DropdownMenu = popDupFinder
OnClick = tbDupIdClick
Style = tbsDropDown
end
object ToolButton2: TToolButton
Left = 162
Height = 22
Top = 2
Caption = 'ToolButton2'
Style = tbsSeparator
end
object ToolButton3: TToolButton
Left = 63
Height = 22
Top = 2
Caption = 'ToolButton3'
Style = tbsSeparator
end
object tbShowMsgIdEntries: TToolButton
Left = 71
Top = 2
Caption = 'MsgId'
Down = True
Grouped = True
OnClick = tbShowMsgIdEntriesClick
Style = tbsCheck
end
object tbShowPoFileInfo: TToolButton
Left = 112
Top = 2
Caption = 'Po-Files'
Grouped = True
OnClick = tbShowMsgIdEntriesClick
Style = tbsCheck
end
end
object Splitter1: TSplitter
Left = 250
Height = 493
Top = 26
Width = 7
MinSize = 200
end
object lbPoItems: TListBox
Left = 257
Height = 493
Top = 26
Width = 350
Align = alLeft
ItemHeight = 0
MultiSelect = True
OnClick = lbPoItemsClick
TabOrder = 3
end
object pnlSearch: TPanel
Left = 0
Height = 52
Top = 519
Width = 896
Align = alBottom
AutoSize = True
ClientHeight = 52
ClientWidth = 896
TabOrder = 4
object edSearchPoItems: TEdit
Left = 3
Height = 23
Top = 3
Width = 865
Align = alClient
BorderSpacing.Around = 2
OnChange = edSearchPoItemsChange
OnEditingDone = edSearchPoItemsEditingDone
TabOrder = 0
TextHint = 'Search po items (comma separated)'
end
object btnClearSearchPoItem: TSpeedButton
Left = 870
Height = 23
Top = 3
Width = 23
Align = alRight
BorderSpacing.Around = 2
Caption = 'X'
OnClick = btnClearSearchPoItemClick
end
object Panel1: TPanel
Left = 1
Height = 23
Top = 28
Width = 894
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 894
TabOrder = 1
object chkSearchPoItemFullWord: TCheckBox
Left = 709
Height = 19
Top = 2
Width = 72
Align = alRight
BorderSpacing.Around = 2
Caption = 'Full words'
OnChange = chkSearchPoItemFullWordChange
OnClick = chkSearchPoItemFullWordChange
TabOrder = 0
end
object chkSearchPoItemIdText: TCheckBox
Left = 592
Height = 19
Top = 2
Width = 115
Align = alRight
BorderSpacing.Around = 2
Caption = 'Also search ID text'
OnChange = chkSearchPoItemFullWordChange
OnClick = chkSearchPoItemFullWordChange
TabOrder = 1
end
object chkSearchPoItemIgnoreUnit: TCheckBox
Left = 783
Height = 19
Top = 2
Width = 109
Align = alRight
BorderSpacing.Around = 2
Caption = 'Ignore unit name'
Checked = True
OnChange = chkSearchPoItemFullWordChange
OnClick = chkSearchPoItemFullWordChange
State = cbChecked
TabOrder = 2
end
end
end
object Splitter2: TSplitter
Left = 607
Height = 493
Top = 26
Width = 5
end
object memInfo: TMemo
Left = 612
Height = 493
Top = 26
Width = 284
Align = alClient
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 6
end
object OpenDialog1: TOpenDialog
Title = 'Open pot file'
Filter = 'pot|*.pot'
Left = 88
Top = 88
end
object Timer1: TTimer
Interval = 1500
OnTimer = Timer1Timer
Left = 299
Top = 213
end
object popMoveTo: TPopupMenu
Left = 93
Top = 16
end
object popDupFinder: TPopupMenu
Left = 228
Top = 25
object mnDupIgnCase: TMenuItem
AutoCheck = True
Caption = 'Ignore case'
ShowAlwaysCheckable = True
end
object mnDupIgnoreSpaceDiff: TMenuItem
AutoCheck = True
Caption = 'Ignore space diffs'
ShowAlwaysCheckable = True
end
end
end

456
tools/pofilemaintenance/unit1.pas Normal file
View File

@ -0,0 +1,456 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
ExtCtrls, Buttons, Menus, LCLIntf, LazFileUtils, PotFile;
type
{ TForm1 }
TForm1 = class(TForm)
chkSearchPoItemIgnoreUnit: TCheckBox;
chkSearchPoItemIdText: TCheckBox;
chkSearchPoItemFullWord: TCheckBox;
edSearchPoItems: TEdit;
lbPoFiles: TListBox;
lbPoItems: TListBox;
memInfo: TMemo;
mnDupIgnCase: TMenuItem;
mnDupIgnoreSpaceDiff: TMenuItem;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
pnlSearch: TPanel;
btnClearSearchPoItem: TSpeedButton;
popMoveTo: TPopupMenu;
popDupFinder: TPopupMenu;
Splitter1: TSplitter;
Splitter2: TSplitter;
Timer1: TTimer;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
tbMovePoItems: TToolButton;
tbSave: TToolButton;
tbDupId: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
tbShowMsgIdEntries: TToolButton;
tbShowPoFileInfo: TToolButton;
procedure btnClearSearchPoItemClick(Sender: TObject);
procedure chkSearchPoItemFullWordChange(Sender: TObject);
procedure edSearchPoItemsChange(Sender: TObject);
procedure edSearchPoItemsEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
procedure lbPoFilesClick(Sender: TObject);
procedure lbPoItemsClick(Sender: TObject);
procedure tbDupIdClick(Sender: TObject);
procedure tbSaveClick(Sender: TObject);
procedure tbShowMsgIdEntriesClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
FPotList: TPotFileList;
FCurPotFile: TPotFile;
FInbPoFilesClick: Boolean;
FDupIdPotFile: TPotFile;
function AddFile(AFileName: String): TPotFile;
procedure OnMoveClicked(Sender: TObject);
procedure SetCurrentFile(ACurPotFile: TPotFile);
procedure UpdateSaveButton;
procedure UpdatePoItems;
procedure UpdatePoItemFiles;
procedure UpdatePotItems;
public
destructor Destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.ToolButton1Click(Sender: TObject);
var
f: TPotFile;
begin
if OpenDialog1.Execute then begin
f := AddFile(OpenDialog1.FileName);
SetCurrentFile(f);
end;
end;
function TForm1.AddFile(AFileName: String): TPotFile;
var
m: TMenuItem;
i: Integer;
begin
for i := 0 to lbPoFiles.Count - 1 do
if TPotFile(lbPoFiles.Items.Objects[i]).FileName = AFileName then
exit;
Result := TPotFile.Create(AFileName);
lbPoFiles.AddItem(Format('%s (%d)', [Result.Name, Result.Count]), Result);
FPotList.Add(Result);
m := TMenuItem.Create(popMoveTo);
m.Caption := Result.Name;
m.Tag := PtrInt(Result);
m.OnClick := @OnMoveClicked;
popMoveTo.Items.Add(m);
end;
procedure TForm1.OnMoveClicked(Sender: TObject);
var
target: TPotFile;
i, j, e: Integer;
itm, newItm: TPotSection;
po, targetPo: TPoFile;
entry, newEntry: TPoSection;
prefix: String;
begin
target := TPotFile(TMenuItem(Sender).Tag);
prefix := '';
if target.Count > 1 then
prefix := target.Items[1].VarNameUnit;
if prefix = '' then
prefix := LowerCase(target.Name);
if not InputQuery('Move items', 'Enter the Unit-name used in the target file:', prefix) then
exit;
for i := 0 to lbPoItems.Count - 1 do begin
if not lbPoItems.Selected[i] then
continue;
itm := TPotSection(lbPoItems.Items.Objects[i]);
newItm := TPotSection.Create;
newItm.Text := itm.Text;
newItm.DeleteMsgCtxt;
newItm.ReplaceUnitPrefix(prefix);
target.Add(newItm);
for j := 0 to FCurPotFile.PoFiles.Count - 1 do begin
po := FCurPotFile.PoFiles[j];
e := po.IndexOfVar(itm.VarName);
if e < 0 then
Continue;
entry := po.Items[e];
targetPo := target.PoFiles.PoFileForLang(po.LangName, True);
newEntry := TPoSection.Create;
newEntry.Text := entry.Text;
newEntry.DeleteMsgCtxt;
newEntry.ReplaceUnitPrefix(prefix);
targetPo.Add(newEntry);
po.Remove(entry);
end;
FCurPotFile.Remove(itm);
end;
FCurPotFile.SetModified;
target.SetModified;
UpdateSaveButton;
UpdatePotItems;
UpdatePoItems;
end;
procedure TForm1.SetCurrentFile(ACurPotFile: TPotFile);
var
i: Integer;
begin
FCurPotFile := ACurPotFile;
i := lbPoFiles.Items.IndexOfObject(ACurPotFile);
if i > 0 then
lbPoFiles.ItemIndex := i;
UpdatePoItems;
UpdateSaveButton;
for i := 0 to popMoveTo.Items.Count - 1 do
popMoveTo.Items[i].Enabled := popMoveTo.Items[i].Tag <> PtrInt(FCurPotFile);
end;
procedure TForm1.UpdateSaveButton;
begin
tbSave.Enabled := (FCurPotFile <> nil) and FCurPotFile.Modified;
if FCurPotFile <> nil then
tbSave.Caption := format('Save %s', [FCurPotFile.Name]);
end;
procedure TForm1.UpdatePoItems;
function HasWord(AWord, AText: String): Boolean;
var
i: SizeInt;
begin
i := Pos(AWord, AText);
Result := (i > 0) and
( (i = 1) or not (AText[i-1] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) ) and
( (i + Length(AWord) > Length(AText)) or not (AText[i + Length(AWord)] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) )
;
end;
var
i, j, CntAll, CntNoneEmpty: Integer;
itm: TPotSection;
MatchWords, MatchTxtId, fnd, MatchIgnUName: Boolean;
t: String;
FindTerms: TStringArray;
begin
Timer1.Enabled := False;
if tbShowPoFileInfo.Down then begin
UpdatePoItemFiles;
exit;
end;
lbPoItems.Clear;
if FCurPotFile = nil then
exit;
// Start at 1, Item 0 is the header
t := lowercase(edSearchPoItems.Text);
FindTerms := t.Split(',');
for j := Length(FindTerms) - 1 downto 0 do begin
FindTerms[j] := Trim(FindTerms[j]);
if FindTerms[j] = '' then
Delete(FindTerms, j, 1);
end;
MatchWords := chkSearchPoItemFullWord.Checked;
MatchIgnUName := chkSearchPoItemIgnoreUnit.Checked;
MatchTxtId := chkSearchPoItemIdText.Checked;
lbPoItems.Items.BeginUpdate;
for i := 1 to FCurPotFile.Count - 1 do begin
itm := FCurPotFile.Items[i];
if Length(FindTerms) > 0 then begin
fnd := False;
for j := 0 to Length(FindTerms) - 1 do begin
if MatchWords then begin
if MatchIgnUName
then fnd := HasWord(itm.VarNameIdent, FindTerms[j])
else fnd := HasWord(itm.VarNameContent, FindTerms[j]);
end
else begin
if MatchIgnUName
then fnd := Pos(FindTerms[j], itm.VarNameIdent) > 0
else fnd := Pos(FindTerms[j], itm.VarNameContent) > 0;
end;
if fnd then
break;
if MatchTxtId then begin
if MatchWords
then fnd := HasWord(itm.MsgIdCleanContent, FindTerms[j])
else fnd := Pos(FindTerms[j], LowerCase(itm.MsgIdCleanContent)) > 0;
if fnd then
break;
end;
end;
if not fnd then
continue;
end;
//itm.GetTranslationyCount(CntAll, CntNoneEmpty);
//lbPoItems.AddItem(Format('%s (%d / %d): %s', [itm.MsgIdContent, CntNoneEmpty, CntAll, itm.VarNameContent]), itm);
lbPoItems.AddItem(Format('%s (%s)', [itm.MsgIdContent, itm.VarNameContent]), itm);
end;
lbPoItems.Items.EndUpdate;
lbPoItemsClick(nil);
end;
procedure TForm1.UpdatePoItemFiles;
var
i: Integer;
po: TPoFile;
begin
lbPoItems.Clear;
if FCurPotFile = nil then
exit;
for i := 1 to FCurPotFile.PoFiles.Count - 1 do begin
po := FCurPotFile.PoFiles[i];
lbPoItems.AddItem(Format('%s (%d / %d)', [po.LangName, po.NoneEmptyCount, po.Count-1]), po);
end;
end;
procedure TForm1.UpdatePotItems;
var
i: Integer;
pot: TPotFile;
begin
for i := 0 to lbPoFiles.Count - 1 do begin
pot := TPotFile(lbPoFiles.Items.Objects[i]);
if pot.Modified
then lbPoFiles.Items[i] := Format('* %s (%d)', [pot.Name, pot.Count - 1])
else lbPoFiles.Items[i] := Format('%s (%d)', [pot.Name, pot.Count - 1]);
end;
end;
destructor TForm1.Destroy;
begin
inherited Destroy;
FDupIdPotFile.Free;
FPotList.Free;
end;
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of string
);
var
s: String;
f: TPotFile;
begin
f := nil;
for s in FileNames do
f := AddFile(s);
SetCurrentFile(f);
end;
procedure TForm1.btnClearSearchPoItemClick(Sender: TObject);
begin
if (edSearchPoItems.Text = '') and not Timer1.Enabled then
exit;
edSearchPoItems.Clear;
if tbShowMsgIdEntries.Down then
UpdatePoItems;
end;
procedure TForm1.chkSearchPoItemFullWordChange(Sender: TObject);
begin
if (edSearchPoItems.Text = '') and not Timer1.Enabled then
exit;
if tbShowMsgIdEntries.Down then
UpdatePoItems;
end;
procedure TForm1.edSearchPoItemsChange(Sender: TObject);
begin
if tbShowPoFileInfo.Down then
exit;
Timer1.Enabled := False;
Timer1.Enabled := True;
end;
procedure TForm1.edSearchPoItemsEditingDone(Sender: TObject);
begin
if tbShowMsgIdEntries.Down then
UpdatePoItems;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FPotList := TPotFileList.Create;
end;
procedure TForm1.lbPoFilesClick(Sender: TObject);
var
i: Integer;
begin
if FInbPoFilesClick then
exit;
i := lbPoFiles.ItemIndex;
if i < 0 then
exit;
FInbPoFilesClick := True;
SetCurrentFile(TPotFile(lbPoFiles.Items.Objects[i]));
FInbPoFilesClick := False;
end;
procedure TForm1.lbPoItemsClick(Sender: TObject);
var
i, j, cnt: Integer;
itm: TPotSection;
s: String;
po: TPoFile;
e: LongInt;
begin
if not tbShowMsgIdEntries.Down then
exit;
memInfo.Clear;
cnt := 0;
for i := 0 to lbPoItems.Count - 1 do begin
if not lbPoItems.Selected[i] then
continue;
inc(cnt);
if not (lbPoItems.Items.Objects[i] is TPotSection) then
continue;
itm := TPotSection(lbPoItems.Items.Objects[i]);
//itmid := itm.MsgId;
s := itm.VarName + LineEnding;
s := s + itm.MsgId + LineEnding;
s := s + itm.MsgStr + LineEnding;
for j := 0 to FCurPotFile.PoFiles.Count - 1 do begin
po := FCurPotFile.PoFiles[j];
e := po.IndexOfVar(itm.VarName);
if e >= 0 then begin
s := s + po.LangName + ': ' + po.Items[e].MsgStr + LineEnding;
end;
end;
s := s + LineEnding;
memInfo.Append(s);
end;
tbMovePoItems.Enabled := cnt > 0;
tbMovePoItems.Caption := format('Move %d items to', [cnt]);
end;
procedure TForm1.tbDupIdClick(Sender: TObject);
var
fl: TFindDupFlags;
begin
if FDupIdPotFile = nil then begin
FDupIdPotFile := TPotFile.Create('', True);
lbPoFiles.AddItem('Dups', FDupIdPotFile);
end;
fl := [];
if mnDupIgnCase.Checked then
Include(fl, fdIgnoreCase);
if mnDupIgnoreSpaceDiff.Checked then
Include(fl, fdIgnoreSpaceDiff);
FPotList.FindDuplicateMsgId(FDupIdPotFile, fl);
UpdatePotItems;
SetCurrentFile(FDupIdPotFile);
end;
procedure TForm1.tbSaveClick(Sender: TObject);
begin
if FCurPotFile = nil then
exit;
FCurPotFile.Save;
UpdatePotItems;
tbSave.Enabled := False;
end;
procedure TForm1.tbShowMsgIdEntriesClick(Sender: TObject);
begin
UpdatePoItems;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
UpdatePoItems;
end;
end.