mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 01:57:57 +02:00
New PoChecker IDE package from Bart Broersma
git-svn-id: trunk@34404 -
This commit is contained in:
juha
parent
3b7d2b72f2
commit
01233f98fe
10
.gitattributes
vendored
10
.gitattributes
vendored
@ -1937,6 +1937,16 @@ components/plotfunction/regplotpanel.lrs svneol=native#text/pascal
|
||||
components/plotfunction/regplotpanel.pp svneol=native#text/plain
|
||||
components/plotfunction/tplotexpressionpanel.png -text svneol=unset#image/png
|
||||
components/plotfunction/tplotfunctionpanel.png -text svneol=unset#image/png
|
||||
components/pochecker/.directory svneol=native#text/plain
|
||||
components/pochecker/README.txt svneol=native#text/plain
|
||||
components/pochecker/pochecker.lpk svneol=native#text/plain
|
||||
components/pochecker/pochecker.pas svneol=native#text/plain
|
||||
components/pochecker/pocheckermain.lfm svneol=native#text/plain
|
||||
components/pochecker/pocheckermain.pp svneol=native#text/plain
|
||||
components/pochecker/pofamilies.pp svneol=native#text/plain
|
||||
components/pochecker/resultdlg.lfm svneol=native#text/plain
|
||||
components/pochecker/resultdlg.pp svneol=native#text/plain
|
||||
components/pochecker/simplepofiles.pp svneol=native#text/plain
|
||||
components/prettymessages/README.txt svneol=native#text/plain
|
||||
components/prettymessages/hidefpchints.pas svneol=native#text/plain
|
||||
components/prettymessages/prettymessages.lpk svneol=native#text/plain
|
||||
|
||||
5
components/pochecker/.directory
Normal file
5
components/pochecker/.directory
Normal file
@ -0,0 +1,5 @@
|
||||
[Dolphin]
|
||||
AdditionalInfoV2=Details_Size,Details_Date,CustomizedDetails
|
||||
Timestamp=2011,12,25,14,41,0
|
||||
Version=2
|
||||
ViewMode=1
|
||||
7
components/pochecker/README.txt
Normal file
7
components/pochecker/README.txt
Normal file
@ -0,0 +1,7 @@
|
||||
This package checks the validity of translated PO files.
|
||||
|
||||
Original version made by Bart Broersma
|
||||
|
||||
ToDo:
|
||||
- Find automatically all PO files belonging to the current project.
|
||||
- Improve IDE integration
|
||||
75
components/pochecker/pochecker.lpk
Normal file
75
components/pochecker/pochecker.lpk
Normal file
@ -0,0 +1,75 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="PoChecker"/>
|
||||
<AddToProjectUsesSection Value="True"/>
|
||||
<Author Value="Bart Broersma"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="Check the validity of translated PO files.
|
||||
"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="7">
|
||||
<Item1>
|
||||
<Filename Value="resultdlg.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="resultdlg.pp"/>
|
||||
<UnitName Value="ResultDlg"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="pofamilies.pp"/>
|
||||
<UnitName Value="PoFamilies"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="pocheckermain.pp"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="pocheckermain"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="simplepofiles.pp"/>
|
||||
<UnitName Value="SimplePoFiles"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="resultdlg.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="pocheckermain.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
</Item7>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="SynEdit"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
21
components/pochecker/pochecker.pas
Normal file
21
components/pochecker/pochecker.pas
Normal file
@ -0,0 +1,21 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit PoChecker;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ResultDlg, PoFamilies, pocheckermain, SimplePoFiles, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('pocheckermain', @pocheckermain.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('PoChecker', @Register);
|
||||
end.
|
||||
149
components/pochecker/pocheckermain.lfm
Normal file
149
components/pochecker/pocheckermain.lfm
Normal file
@ -0,0 +1,149 @@
|
||||
object PoCheckerForm: TPoCheckerForm
|
||||
Left = 409
|
||||
Height = 295
|
||||
Top = 133
|
||||
Width = 463
|
||||
Caption = 'GUI Po-file checking tool'
|
||||
ClientHeight = 295
|
||||
ClientWidth = 463
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '0.9.31'
|
||||
object TestListBox: TCheckListBox
|
||||
Left = 168
|
||||
Height = 163
|
||||
Top = 44
|
||||
Width = 288
|
||||
Enabled = False
|
||||
ItemHeight = 0
|
||||
OnItemClick = TestListBoxItemClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 168
|
||||
Height = 15
|
||||
Top = 24
|
||||
Width = 105
|
||||
Caption = 'Select test types'
|
||||
Font.Style = [fsBold]
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object OpenBtn: TBitBtn
|
||||
Left = 8
|
||||
Height = 79
|
||||
Top = 44
|
||||
Width = 144
|
||||
Caption = '&Open a po-file'
|
||||
Glyph.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00005E8E8D005D
|
||||
8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D
|
||||
8CBD005D8CBD005D8CBD005D8CBD005E8E8D005B8900005B890000679AB06AB7
|
||||
DAFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CC
|
||||
EDFF82CCEDFF82CCEDFF83CDEEFF318DB9C9005E8E40005F8F000070A9A256AA
|
||||
CEFF80CBEAFF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9
|
||||
E9FF7EC9E9FF7EC9E9FF7EC9E9FF57AFD6D90066996E006699000074AD9D44A1
|
||||
CBFF8AD3EFFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CD
|
||||
EBFF83CDEBFF83CDEBFF83CDEBFF81CDEBF2006FA8930071AB010076B29952B0
|
||||
D7FF85D2EDFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2
|
||||
EEFF89D2EEFF89D2EEFF89D2EEFF90D8F1FF228EC1AA0077B31D0079B69574CA
|
||||
E8FF75CAE8FF90D8F2FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7
|
||||
F1FF8FD7F1FF8FD7F1FF8FD7F1FF91D8F2FF4FB1DAC2007FBD46007CBA928FDD
|
||||
F4FF63C0E5FFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EE
|
||||
FAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFF86D8EFDE0083C571007FBD8EA6EC
|
||||
FCFF64C2E9FF4FB5E2FF4DB4E2FF4CB3E1FF4BB2E0FF49B1DFFF48B0DFFF47AE
|
||||
DEFF45ADDDFF44ACDDFF46AEDFFF0084C6C70087CB810087CB610081C18BABF0
|
||||
FEFFA4E9FCFFA2E7FBFF9FE5FAFF9CE3F8FF9AE1F7FF97DEF6FF94DCF4FF91D9
|
||||
F3FF8ED7F1FF8BD4F0FF90D8F3FF0081C18B0087CA000087CB000083C488ADF1
|
||||
FFFFA6EBFDFFA4E9FCFFA2E7FBFF9FE5FAFF9CE3F8FF9AE1F7FF97DEF6FF94DC
|
||||
F4FF91D9F3FF8ED7F1FF93DAF4FF0083C4880083C4000085C8000085C785B0F4
|
||||
FFFFADF1FFFFABF0FEFFA9EEFDFFA7ECFCFFA5EAFBFFA2E8FAFFA0E6F9FF9DE3
|
||||
F8FF9AE1F7FF98DFF6FF99E0F7FF0085C7850085C7000085C7000087CA620087
|
||||
CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF5F5EEFFEBEB
|
||||
DDFFFEC941FFF4B62EFF0087CA830087CA620086C9000086C9000087CA000087
|
||||
CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088CC810088
|
||||
CC810088CC810088CC810088CC2E0087CA000086C9000086C900FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
||||
}
|
||||
OnClick = OpenBtnClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object RunBtn: TBitBtn
|
||||
Left = 8
|
||||
Height = 79
|
||||
Top = 128
|
||||
Width = 144
|
||||
Caption = '&Run Selected Tests'
|
||||
Enabled = False
|
||||
Kind = bkOK
|
||||
OnClick = RunBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object StatusPanel: TPanel
|
||||
Left = 0
|
||||
Height = 48
|
||||
Top = 247
|
||||
Width = 463
|
||||
Align = alBottom
|
||||
BevelOuter = bvLowered
|
||||
ClientHeight = 48
|
||||
ClientWidth = 463
|
||||
TabOrder = 3
|
||||
object Label2: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 8
|
||||
Width = 74
|
||||
Caption = 'Current Test:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 24
|
||||
Width = 87
|
||||
Caption = 'Current po-file:'
|
||||
ParentColor = False
|
||||
end
|
||||
object CurTestLabel: TLabel
|
||||
Left = 104
|
||||
Height = 15
|
||||
Top = 8
|
||||
Width = 73
|
||||
Caption = 'CurTestLabel'
|
||||
ParentColor = False
|
||||
end
|
||||
object CurPoLabel: TLabel
|
||||
Left = 104
|
||||
Height = 15
|
||||
Top = 24
|
||||
Width = 65
|
||||
Caption = 'CurPoLabel'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
object NoErrLabel: TLabel
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 216
|
||||
Width = 171
|
||||
Caption = 'No errors found'
|
||||
Font.Color = clRed
|
||||
Font.Height = -19
|
||||
Font.Style = [fsBold]
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object OpenDialog: TOpenDialog
|
||||
Filter = 'po-files (*.po)|*.po|all files|*'
|
||||
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
|
||||
left = 40
|
||||
top = 512
|
||||
end
|
||||
end
|
||||
335
components/pochecker/pocheckermain.pp
Normal file
335
components/pochecker/pocheckermain.pp
Normal file
@ -0,0 +1,335 @@
|
||||
{
|
||||
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.
|
||||
}
|
||||
|
||||
// Original version made by Bart Broersma
|
||||
|
||||
unit pocheckermain;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, LCLProc, CheckLst, Buttons, ExtCtrls, IDEIntf, MenuIntf,
|
||||
SimplePoFiles, PoFamilies, ResultDlg;
|
||||
|
||||
type
|
||||
|
||||
{ TPoCheckerForm }
|
||||
|
||||
TPoCheckerForm = class(TForm)
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
CurTestLabel: TLabel;
|
||||
CurPoLabel: TLabel;
|
||||
NoErrLabel: TLabel;
|
||||
StatusPanel: TPanel;
|
||||
RunBtn: TBitBtn;
|
||||
OpenBtn: TBitBtn;
|
||||
Button3: TButton;
|
||||
Label1: TLabel;
|
||||
OpenDialog: TOpenDialog;
|
||||
TestListBox: TCheckListBox;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure OpenBtnClick(Sender: TObject);
|
||||
procedure RunBtnClick(Sender: TObject);
|
||||
procedure TestListBoxItemClick(Sender: TObject; Index: integer);
|
||||
private
|
||||
PoFamily: TPoFamily;
|
||||
FChoosenMasterName: String;
|
||||
FChoosenChildName: String;
|
||||
procedure OnTestStart(const ATestName, APoFileName: String);
|
||||
procedure OnTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||
procedure FillTestListBox;
|
||||
function GetOptionsFromListBox: TPoTestOptions;
|
||||
procedure ShowError(const Msg: String);
|
||||
function TrySelectFile: Boolean;
|
||||
procedure RunSelectedTests;
|
||||
procedure ClearAndDisableStatusPanel;
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
resourcestring
|
||||
rsPoChecker = 'PO File Checker';
|
||||
sSelectAllTests = 'Select all tests';
|
||||
sUnSelectAllTests = 'Unselect all tests';
|
||||
sCannotFindMaster = 'Cannot find master po file:'^m'%s'^m'for selected file'^m'%s';
|
||||
sNotAProperFileName = 'Selected filename'^m'%s'^m'does not seem to be a proper name for a po-file';
|
||||
sErrorOnCreate = 'Error creating an instance of TPoFamily:'^m'%s';
|
||||
sErrorOnCleanup = 'An unrecoverable error occurred'^m'%s'^m'Please close the program';
|
||||
|
||||
sTotalErrors = 'Total errors found: %d';
|
||||
//sNoErrorsFound = 'No errors found.';
|
||||
sNoTestSelected = 'There are no tests selected.';
|
||||
|
||||
var
|
||||
PoCheckerForm: TPoCheckerForm;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
procedure ShowPoCheckerForm();
|
||||
begin
|
||||
if not Assigned(PoCheckerForm) then
|
||||
PoCheckerForm := TPoCheckerForm.Create(Application);
|
||||
PoCheckerForm.Show;
|
||||
end;
|
||||
|
||||
|
||||
{ TPoCheckerForm }
|
||||
|
||||
procedure TPoCheckerForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FillTestListBox;
|
||||
ClearAndDisableStatusPanel;
|
||||
NoErrLabel.Visible := False;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
if Assigned(PoFamily) then PoFamily.Free;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.OpenBtnClick(Sender: TObject);
|
||||
begin
|
||||
if TrySelectFile then
|
||||
begin
|
||||
RunBtn.Enabled := True;
|
||||
TestListBox.Enabled := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
RunBtn.Enabled := False;
|
||||
TestListBox.Enabled := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.RunBtnClick(Sender: TObject);
|
||||
begin
|
||||
RunSelectedTests;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.TestListBoxItemClick(Sender: TObject; Index: integer);
|
||||
var
|
||||
Check: Boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
if (Index = TestListBox.Count - 1) then
|
||||
begin//Run All Test checkbox
|
||||
Check := TestListBox.Checked[Index];
|
||||
for i := 0 to TestListBox.Count - 2 do TestListBox.Checked[i] := Check;
|
||||
if Check then
|
||||
TestListBox.Items[Index] := sUnSelectAllTests
|
||||
else
|
||||
TestListBox.Items[Index] := sSelectAllTests;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.OnTestStart(const ATestName, APoFileName: String);
|
||||
begin
|
||||
//debugln('OnTestStart: ATestName = "',AtestName,'" APoFileName = "',APoFileName);
|
||||
CurTestLabel.Caption := ATestName;
|
||||
CurPoLabel.Caption := APoFileName;
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.OnTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||
begin
|
||||
//CurTestLabel.Caption := '';
|
||||
//CurPoLabel.Caption := '';
|
||||
debugln('OnTestEnd [',ATestName,']: ErrorCount = ',DbgS(ErrorCount));
|
||||
//Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.FillTestListBox;
|
||||
var
|
||||
Opt: TPoTestOption;
|
||||
begin
|
||||
for Opt := Low(PoTestOptionNames) to High(PoTestOptionNames) do
|
||||
begin
|
||||
TestListBox.Items.Add(PoTestOptionNames[Opt]);
|
||||
end;
|
||||
TestListBox.Items.Add(sSelectAllTests);
|
||||
end;
|
||||
|
||||
function TPoCheckerForm.GetOptionsFromListBox: TPoTestOptions;
|
||||
var
|
||||
Opt: TPoTestOption;
|
||||
Index: Integer;
|
||||
begin
|
||||
Result := [];
|
||||
for Opt := Low(TpoTestOption) to High(TPoTestOption) do
|
||||
begin
|
||||
Index := Ord(Opt);
|
||||
if (Index < TestListBox.Count) then
|
||||
begin
|
||||
if TestListBox.Checked[Index] then Result := Result + [Opt];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.ShowError(const Msg: String);
|
||||
begin
|
||||
MessageDlg('GPoCheck', Msg, mtError, [mbOk], 0);
|
||||
end;
|
||||
|
||||
function TPoCheckerForm.TrySelectFile: Boolean;
|
||||
var
|
||||
Fn: String;
|
||||
ShortFn: String;
|
||||
OK: Boolean;
|
||||
begin
|
||||
NoErrLabel.Visible := False;
|
||||
OK := False;
|
||||
if OpenDialog.Execute then
|
||||
begin
|
||||
Fn := OpenDialog.FileName;
|
||||
ShortFn := ExtractFileName(Fn);
|
||||
if IsMasterPoName(Fn) then
|
||||
begin
|
||||
FChoosenMasterName := Fn;
|
||||
FChoosenChildName := '';
|
||||
end
|
||||
else
|
||||
begin //not a mastername, may be a child
|
||||
FChoosenChildName := Fn;
|
||||
FChoosenMasterName := ExtractMasterNameFromChildName(Fn);
|
||||
if (FChoosenMasterName = '') then
|
||||
begin
|
||||
FChoosenMasterName := '';
|
||||
FChoosenChildName := '';
|
||||
ShowError(Format(sNotAProperFileName,[ShortFn]));
|
||||
end
|
||||
else if not FileExistsUtf8(FChoosenMasterName) then
|
||||
begin
|
||||
FChoosenMasterName := '';
|
||||
FChoosenChildName := '';
|
||||
ShowError(Format(sCannotFindMaster,[ShortFn]));
|
||||
end;
|
||||
end;
|
||||
OK := (FChoosenMasterName <> '');
|
||||
if OK then
|
||||
begin
|
||||
if Assigned(PoFamily) then PoFamily.Free;
|
||||
try
|
||||
PoFamily := TPoFamily.Create(FChoosenMasterName, FChoosenChildName);
|
||||
PoFamily.OnTestStart := @OnTestStart;
|
||||
PoFamily.OnTestEnd := @OnTestEnd;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
OK := False;
|
||||
ShowError(Format(sErrorOnCreate,[E.Message]));
|
||||
if Assigned(PoFamily) then
|
||||
begin
|
||||
try
|
||||
PoFamily.Free;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
ShowError(Format(sErrorOnCleanUp,[E.Message]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result := OK;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.RunSelectedTests;
|
||||
var
|
||||
Options: TPoTestOptions;
|
||||
ErrorCount: Integer;
|
||||
SL: TStrings;
|
||||
ResultDlg: TResultDlgForm;
|
||||
begin
|
||||
Options := GetOptionsFromListBox;
|
||||
if (Options = []) then
|
||||
begin
|
||||
ShowError(sNoTestSelected);
|
||||
Exit;
|
||||
end;
|
||||
NoErrLabel.Visible := False;
|
||||
Application.ProcessMessages;
|
||||
SL := TStringList.Create;
|
||||
try
|
||||
StatusPanel.Enabled := True;
|
||||
if (not (ptoFindAllChilds in Options)) and Assigned(PoFamily.Child) and
|
||||
(PoFamily.ChildName <> FChoosenChildName) then PoFamily.ChildName := FChoosenChildName;
|
||||
PoFamily.RunTests(Options, ErrorCount, SL);
|
||||
if (ErrorCount > 0) then
|
||||
begin
|
||||
debugln('RunSelectedTests: ',Format(sTotalErrors,[ErrorCount]));
|
||||
SL.Add(Format(sTotalErrors,[ErrorCount]));
|
||||
ResultDlg := TResultDlgForm.Create(Nil);
|
||||
try
|
||||
ResultDlg.Log.Assign(SL);
|
||||
FreeAndNil(SL); //No need to keep 2 copies of this data
|
||||
ResultDlg.ShowModal;
|
||||
finally
|
||||
ResultDlg.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin//no errors
|
||||
NoErrLabel.Visible := True;
|
||||
end;
|
||||
finally
|
||||
if Assigned(SL) then
|
||||
SL.Free;
|
||||
ClearAndDisableStatusPanel;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.ClearAndDisableStatusPanel;
|
||||
begin
|
||||
CurTestLabel.Caption := '';
|
||||
CurPoLabel.Caption := '';
|
||||
StatusPanel.Enabled := False;
|
||||
end;
|
||||
|
||||
|
||||
function SameItem(Item1, Item2: TPoFileItem): Boolean;
|
||||
begin
|
||||
Result := (Item1.Identifier = Item2.Identifier) and
|
||||
(Item1.Original = Item2.Original) and
|
||||
(Item1.Context = Item2.Context) and
|
||||
(Item1.Flags = Item2.Flags) and
|
||||
(Item1.PreviousID = Item2.PreviousID) and
|
||||
(Item1.Translation = Item2.Translation);
|
||||
end;
|
||||
|
||||
procedure IDEMenuClicked(Sender: TObject);
|
||||
begin
|
||||
ShowPoCheckerForm;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterIDEMenuCommand(itmSecondaryTools, 'mnuPoChecker', rsPoChecker, nil, @IDEMenuClicked);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
703
components/pochecker/pofamilies.pp
Normal file
703
components/pochecker/pofamilies.pp
Normal file
@ -0,0 +1,703 @@
|
||||
unit PoFamilies;
|
||||
|
||||
{ $define DebugSimplePoFiles}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, FileUtil, StringHashList,
|
||||
{LConvEncoding}
|
||||
//{$IFDEF UNIX}{$IFNDEF DisableCWString}, cwstring{$ENDIF}{$ENDIF},
|
||||
SimplePoFiles;
|
||||
|
||||
Type
|
||||
|
||||
TPoTestOption = (ptoCheckNrOfItems, ptoCheckFormatArgs, ptoCheckMissingIdentifiers,
|
||||
ptoCheckMismatchedOriginals, ptoCheckDuplicateOriginals,
|
||||
ptoFindAllChilds);
|
||||
TPoTestOptions = Set of TPoTestOption;
|
||||
|
||||
const
|
||||
optRunAllTests: TPoTestOptions = [];
|
||||
optRunAllTestsOnAllChilds: TPoTestOptions = [];
|
||||
|
||||
PoTestOptionNames: array[TPoTestOption] of String = ('Check number of items', 'Check for incompatible format arguments',
|
||||
'Check missing identifiers','Check for mismatches in untranslated strings',
|
||||
'Check for duplicate untranslated values',
|
||||
'Find all translated po-files');
|
||||
|
||||
Type
|
||||
{ TPoFamily }
|
||||
|
||||
TTestStartEvent = procedure(const ATestName, APoFileName: String) of object;
|
||||
TTestEndEvent = procedure(const ATestName: String; const ErrorCount: Integer) of object;
|
||||
|
||||
TPoFamily = class
|
||||
private
|
||||
FMaster: TSimplePoFile;
|
||||
FChild: TSimplePoFile;
|
||||
FMasterName: String;
|
||||
FChildName: String;
|
||||
FOnTestStart: TTestStartEvent;
|
||||
FOnTestEnd: TTestEndEvent;
|
||||
procedure SetChildName(AValue: String);
|
||||
procedure SetMasterName(AValue: String);
|
||||
function GetShortMasterName: String;
|
||||
function GetShortChildName: String;
|
||||
protected
|
||||
procedure DoTestStart(const ATestName, APoFileName: String);
|
||||
procedure DoTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||
public
|
||||
constructor Create;
|
||||
constructor Create(const MasterName: String);
|
||||
constructor Create(const AMasterName, AChildName: String);
|
||||
destructor Destroy; override;
|
||||
|
||||
protected
|
||||
procedure CheckNrOfItems(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
procedure CheckFormatArgs(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
procedure CheckMissingIdentifiers(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
procedure CheckMismatchedOriginals(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
procedure CheckDuplicateOriginals(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
|
||||
public
|
||||
procedure RunTests(const Options: TPoTestOptions; out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
|
||||
property Master: TSimplePoFile read FMaster;
|
||||
property Child: TSimplePoFile read FChild;
|
||||
property MasterName: String read FMasterName write SetMasterName;
|
||||
property ChildName: String read FChildName write SetChildName;
|
||||
property ShortMasterName: String read GetShortMasterName;
|
||||
property ShortChildName: String read GetShortChildName;
|
||||
property OnTestStart: TTestStartEvent read FOnTestStart write FOnTestStart;
|
||||
property OnTestEnd: TTestEndEvent read FOnTestEnd write FOnTestEnd;
|
||||
end;
|
||||
|
||||
function ExtractFormatArgs(S: String): String;
|
||||
function IsMasterPoName(const Fn: String): Boolean;
|
||||
function ExtractMasterNameFromChildName(const AChildName: String): String;
|
||||
function FindAllTranslatedPoFiles(const Filename: string): TStringList;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
NoError = 0;
|
||||
sCommentIdentifier = '#: ';
|
||||
//sCharSetIdentifier = '"Content-Type: text/plain; charset=';
|
||||
sMsgID = 'msgid "';
|
||||
sMsgStr = 'msgstr "';
|
||||
//sMsgCtxt = 'msgctxt "';
|
||||
//sFlags = '#, ';
|
||||
//sPrevMsgID = '#| msgid "';
|
||||
//sPrevStr = '#| "';
|
||||
|
||||
Divider = '--------------------------------------------------';
|
||||
sOriginal = 'Original';
|
||||
sTranslation = 'Translation';
|
||||
sErrorsByTest = 'Errors reported by %s for:';
|
||||
sCheckFormatArgs = 'CheckFormatArgs';
|
||||
sCheckMissingIdentifiers = 'CheckMissingIdentifiers';
|
||||
sCheckNrOfItems = 'CheckNrOfItems';
|
||||
sCheckMismatchedOriginals = 'CheckMismatchedOriginals';
|
||||
sCheckDuplicateOriginals = 'CheckDiplicateOriginals';
|
||||
sIncompatibleFormatArgs = '[Line: %d] Incompatible format() arguments for:' ;
|
||||
|
||||
|
||||
sNrErrorsFound = 'Found %d errors.';
|
||||
sLineInFileName = '[Line %d] in %s:';
|
||||
sIdentifierNotFoundIn = 'Identifier [%s] not found in %s';
|
||||
sMissingMasterIdentifier = 'Identifier [%s] found in %s, but it does not exist in %s';
|
||||
sLineNr = '[Line: %d]';
|
||||
|
||||
sFormatArgsID = '%s %s';
|
||||
sFormatArgsValues = '%s%s" (= %s)';
|
||||
|
||||
sNrOfItemsMisMatch = 'Mismatch in number of items for master and child';
|
||||
sNrOfItemsMismatchM = '%s: %d items';
|
||||
sNrOfItemsMismatchC = '%s: %d items';
|
||||
|
||||
sMismatchOriginalsID = '%s';
|
||||
sMismatchOriginalsM = '%s: %s';
|
||||
sMismatchOriginalsC = '%s: %s';
|
||||
|
||||
sDuplicateOriginals = 'This resourcestring:';
|
||||
sDuplicateIdentifier = '#: %s';
|
||||
sDuplicateOriginal = 'msgid "%s"';
|
||||
sDuplicateContext = 'msgctxt "%s"';
|
||||
sDuplicateOriginals2 = 'has the same value as idenftifier %s at line %d';
|
||||
sDuplicateOriginals3 = 'For this entry it is recommended to set: msgctxt="%s"';
|
||||
|
||||
//Helper functions
|
||||
|
||||
function ExtractFormatArgs(S: String): String;
|
||||
const
|
||||
FormatSpecs = ['D','E','F','G','N','M','P','S','X'];
|
||||
var
|
||||
i,p: Integer;
|
||||
InFormat: Boolean;
|
||||
NewStr: String;
|
||||
c: Char;
|
||||
begin
|
||||
SetLength(NewStr, Length(S));
|
||||
InFormat := False;
|
||||
p := 0;
|
||||
for i := 1 to length(S) do
|
||||
begin
|
||||
c := S[i];
|
||||
if (c = '%') then InFormat := not InFormat;
|
||||
//debugln('i = ',dbgs(i),' c = ',c,' InFormat = ',dbgs(informat));
|
||||
if InFormat and (UpCase(c) in (FormatSpecs+['%'])) then
|
||||
begin
|
||||
begin
|
||||
Inc(p);
|
||||
NewStr[p] := c;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (c = '%') and (i > 1) and (S[i-1] = '%') and (p > 0) and (NewStr[p] = '%') then
|
||||
begin//2 consecutive % means a literal % and is not a format specifier
|
||||
//debugln('p = ',dbgs(p), 'i = ',dbgs(i));
|
||||
NewStr[p] := '#';
|
||||
Dec(p);
|
||||
end;
|
||||
end;
|
||||
if InFormat and (Upcase(c) in FormatSpecs) then InFormat := False;
|
||||
end;
|
||||
SetLength(NewStr, p);
|
||||
Result := NewStr;
|
||||
end;
|
||||
|
||||
function IsMasterPoName(const Fn: String): Boolean;
|
||||
//Returns True if Fn is like '[Path/To/]somename.po'
|
||||
var
|
||||
Ext: String;
|
||||
S: String;
|
||||
begin
|
||||
S := ExtractFileName(Fn);
|
||||
Ext := ExtractFileExt(S);
|
||||
S := Copy(S, 1, Length(S) - Length(Ext));
|
||||
Result := (Length(S) > 0) and
|
||||
(CompareText(Ext, ExtensionSeparator + 'po') = 0) and
|
||||
(Pos(ExtensionSeparator, S) = 0);
|
||||
end;
|
||||
|
||||
function ExtractMasterNameFromChildName(const AChildName: String): String;
|
||||
{
|
||||
Pre condition: AChildName is like: somename.some_language_specifier.po
|
||||
Post condition: Result = somename.po
|
||||
}
|
||||
var
|
||||
Ext: String;
|
||||
EndSep: Set of Char;
|
||||
Len: Integer;
|
||||
begin
|
||||
EndSep := AllowDirectorySeparators + AllowDriveSeparators + [ExtensionSeparator];
|
||||
Ext := ExtractFileExt(AChildName);
|
||||
Result := Copy(AChildName, 1, Length(AChildName) - Length(Ext));
|
||||
Len := Length(Result);
|
||||
While (Len > 0) and (not (Result[Len] in EndSep)) do Dec(Len);
|
||||
|
||||
//debugln('Len = ',DbgS(Len));
|
||||
//debugln('Length(Result) = ',DbgS(Length(result)));
|
||||
//if Len > 0 then debugln('Result[Len] = ',Result[len]);
|
||||
|
||||
if (Len > 1) and (Len < Length(Result)) and (Result[Len] = ExtensionSeparator) then
|
||||
Result := Copy(Result, 1, Len - 1) + Ext
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function FindAllTranslatedPoFiles(const Filename: string): TStringList;
|
||||
var
|
||||
Path: String;
|
||||
Name: String;
|
||||
NameOnly: String;
|
||||
Ext: String;
|
||||
FileInfo: TSearchRec;
|
||||
CurExt: String;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
Path := ExtractFilePath(Filename);
|
||||
Name := ExtractFilename(Filename);
|
||||
Ext := ExtractFileExt(Filename);
|
||||
NameOnly := LeftStr(Name,length(Name)-length(Ext));
|
||||
if FindFirstUTF8(Path+GetAllFilesMask,faAnyFile,FileInfo)=0 then
|
||||
begin
|
||||
repeat
|
||||
if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '')
|
||||
or (CompareFilenames(FileInfo.Name,Name) = 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 FindNextUTF8(FileInfo)<>0;
|
||||
end;
|
||||
FindCloseUTF8(FileInfo);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function CompareFormatArgs(S1, S2: String): Boolean;
|
||||
begin
|
||||
Result := CompareText(ExtractFormatArgs(S1), ExtractFormatArgs(S2)) = 0;
|
||||
end;
|
||||
|
||||
{ TPoFamily }
|
||||
|
||||
procedure TPoFamily.SetMasterName(AValue: String);
|
||||
begin
|
||||
if FMasterName = AValue then Exit;
|
||||
FMaster.Free;
|
||||
FMaster := nil;
|
||||
FMasterName := '';
|
||||
if (AValue <> '') then FMaster := TSimplePoFile.Create(AValue{, True});
|
||||
FMasterName := AValue;
|
||||
end;
|
||||
|
||||
function TPoFamily.GetShortMasterName: String;
|
||||
begin
|
||||
Result := ExtractFileName(FMasterName);
|
||||
end;
|
||||
|
||||
function TPoFamily.GetShortChildName: String;
|
||||
begin
|
||||
Result := ExtractFileName(FChildName);
|
||||
end;
|
||||
|
||||
procedure TPoFamily.DoTestStart(const ATestName, APoFileName: String);
|
||||
begin
|
||||
if Assigned(FOnTestStart) then FOnTestStart(ATestName, APoFileName);
|
||||
end;
|
||||
|
||||
procedure TPoFamily.DoTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||
begin
|
||||
if Assigned(FOnTestEnd) then FOnTestEnd(ATestName, ErrorCount);
|
||||
end;
|
||||
|
||||
|
||||
procedure TPoFamily.SetChildName(AValue: String);
|
||||
begin
|
||||
if FChildName = AValue then Exit;
|
||||
FChild.Free;
|
||||
FChild := nil;
|
||||
FChildName := '';
|
||||
if (AValue <> '') then FChild := TSimplePoFile.Create(AValue{, True});
|
||||
FChildName := AValue;
|
||||
end;
|
||||
|
||||
constructor TPoFamily.Create;
|
||||
begin
|
||||
Create('','');
|
||||
end;
|
||||
|
||||
constructor TPoFamily.Create(const MasterName: String);
|
||||
begin
|
||||
Create(MasterName, '');
|
||||
end;
|
||||
|
||||
constructor TPoFamily.Create(const AMasterName, AChildName: String);
|
||||
begin
|
||||
if (AMasterName <> '') then
|
||||
begin
|
||||
FMaster := TSimplePoFile.Create(AMasterName, True);
|
||||
FMasterName := AMasterName;
|
||||
//debugln('TPoFamily.Create: created ',FMasterName);
|
||||
end;
|
||||
if (AChildName <> '') then
|
||||
begin
|
||||
FChild := TSimplePoFile.Create(AChildName, True);
|
||||
FChildName := AChildName;
|
||||
//debugln('TPoFamily.Create: created ',FChildName);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TPoFamily.Destroy;
|
||||
begin
|
||||
if Assigned(FMaster) then FMaster.Free;
|
||||
if Assigned(FChild) then FChild.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPoFamily.CheckNrOfItems(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
begin
|
||||
//debugln('TPoFamily.CheckNrOfItems');
|
||||
DoTestStart(PoTestOptionNames[ptoCheckNrOfItems], ShortChildName);
|
||||
if (FMaster.Count <> FChild.Count) then
|
||||
begin
|
||||
ErrorCount := 1;
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckNrOfItems]));
|
||||
ErrorLog.Add(ShortChildName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add(sNrOfItemsMismatch);
|
||||
ErrorLog.Add(Format(sNrOfItemsMismatchM,[ShortMasterName,FMaster.Count]));
|
||||
ErrorLog.Add(Format(sNrOfItemsMismatchC,[ShortChildName,FChild.Count]));
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add('');
|
||||
end
|
||||
else ErrorCount := NoError;
|
||||
DoTestEnd(PoTestOptionNames[ptoCheckNrOfItems], ErrorCount);
|
||||
//debugln('TPoFamily.CheckNrOfItemsMismatch: ',Dbgs(ErrorCount),' Errors');
|
||||
end;
|
||||
|
||||
procedure TPoFamily.CheckFormatArgs(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
CPoItem: TPOFileItem;
|
||||
begin
|
||||
//debugln('TPoFamily.CheckFormatArgs');
|
||||
DoTestStart(PoTestOptionNames[ptoCheckFormatArgs], ShortChildName);
|
||||
ErrorCount := NoError;
|
||||
//for i := 0 to FMaster.Count - 1 do
|
||||
for i := 0 to FChild.Count - 1 do
|
||||
begin
|
||||
//debugln(' i = ',DbgS(i));
|
||||
//MPoItem := FMaster.PoItems[i];
|
||||
CPoItem := FChild.PoItems[i];
|
||||
//CPoItem := FChild.FindPoItem(MPoItem.Identifier);
|
||||
if Assigned(CPoItem) then
|
||||
begin
|
||||
if (Pos('%', CPoItem.Translation) > 0) and not CompareFormatArgs(CPoItem.Original, CPoItem.Translation) then
|
||||
begin
|
||||
if (ErrorCount = 0) then
|
||||
begin
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckFormatArgs]));
|
||||
ErrorLog.Add(ShortChildName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
Inc(ErrorCount);
|
||||
ErrorLog.Add(Format(sIncompatibleFormatArgs,[CPoItem.LineNr]));
|
||||
ErrorLog.Add(Format(sFormatArgsID,[sCommentIdentifier, CPoItem.Identifier]));
|
||||
ErrorLog.Add(Format(sFormatArgsValues,[sMsgID,CPoItem.Original,sOriginal]));
|
||||
ErrorLog.Add(Format(sFormatArgsValues,[sMsgStr,CPoItem.Translation,sTranslation]));
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (ErrorCount > 0) then
|
||||
begin
|
||||
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
DoTestEnd(PoTestOptionNames[ptoCheckFormatArgs], ErrorCount);
|
||||
//debugln('TPoFamily.CheckIncompatibleFormatArgs: ',Dbgs(ErrorCount),' Errors');
|
||||
end;
|
||||
|
||||
procedure TPoFamily.CheckMissingIdentifiers(out ErrorCount: Integer;
|
||||
ErrorLog: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
MPoItem, CPoItem: TPOFileItem;
|
||||
begin
|
||||
//debugln('TPoFamily.CheckMissingIdentifiers');
|
||||
DoTestStart(PoTestOptionNames[ptoCheckMissingIdentifiers], ShortChildName);
|
||||
ErrorCount := NoError;
|
||||
for i := 0 to FMaster.Count - 1 do
|
||||
begin
|
||||
MPoItem := FMaster.PoItems[i];
|
||||
if Assigned(MPoItem) and (MPoItem.Identifier <> '') then
|
||||
begin
|
||||
CPoItem := FChild.FindPoItem(MPoItem.Identifier);
|
||||
if not Assigned(CPoItem) then
|
||||
begin
|
||||
if (ErrorCount = 0) then
|
||||
begin
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckMissingIdentifiers]));
|
||||
ErrorLog.Add(ShortChildName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
Inc(ErrorCount);
|
||||
ErrorLog.Add(Format(sLineInFileName,
|
||||
[MPoItem.LineNr,ShortMasterName]));
|
||||
ErrorLog.Add(Format(sIdentifierNotFoundIn,
|
||||
[MPoItem.Identifier,ShortChildName]));
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
//Now reverse the search
|
||||
for i := 0 to FChild.Count - 1 do
|
||||
begin
|
||||
CPoItem := FChild.PoItems[i];
|
||||
if Assigned(CPoItem) and (CPoItem.Identifier <> '') then
|
||||
begin
|
||||
MPoItem := FMaster.FindPoItem(CPoItem.Identifier);
|
||||
if not Assigned(MPoItem) then
|
||||
begin
|
||||
if (ErrorCount = 0) then
|
||||
begin
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckMissingIdentifiers]));
|
||||
ErrorLog.Add(ShortChildName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
Inc(ErrorCount);
|
||||
ErrorLog.Add(Format(sLineNr,
|
||||
[CPoItem.LineNr]));
|
||||
ErrorLog.Add(Format(sMissingMasterIdentifier,
|
||||
[CPoItem.Identifier,ShortChildName,ShortMasterName]));
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (ErrorCount > 0) then
|
||||
begin
|
||||
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
DoTestEnd(PoTestOptionNames[ptoCheckMissingIdentifiers], ErrorCount);
|
||||
//debugln('TPoFamily.CheckMissingIdentifiers: ',Dbgs(ErrorCount),' Errors');
|
||||
end;
|
||||
|
||||
procedure TPoFamily.CheckMismatchedOriginals(out ErrorCount: Integer;
|
||||
ErrorLog: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
MPoItem, CPoItem: TPOFileItem;
|
||||
begin
|
||||
//debugln('TPoFamily.CheckMismatchedOriginals');
|
||||
DoTestStart(PoTestOptionNames[ptoCheckMismatchedOriginals], ShortChildName);
|
||||
ErrorCount := NoError;
|
||||
for i := 0 to FMaster.Count - 1 do
|
||||
begin
|
||||
MPoItem := FMaster.PoItems[i];
|
||||
CPoItem := FChild.FindPoItem(MpoItem.Identifier);
|
||||
if Assigned(CPoItem) then
|
||||
begin
|
||||
if (MPoItem.Original <> CPoItem.Original) then
|
||||
begin
|
||||
if (ErrorCount = 0) then
|
||||
begin
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckMismatchedOriginals]));
|
||||
ErrorLog.Add(ShortChildName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
Inc(ErrorCount);
|
||||
ErrorLog.Add(Format(sLineInFileName,[CpoItem.LineNr, ShortChildName]));
|
||||
ErrorLog.Add(Format(sMismatchOriginalsID,[CPoItem.Identifier]));
|
||||
ErrorLog.Add(Format(sMismatchOriginalsM,[ShortMasterName,MPoItem.Original]));
|
||||
ErrorLog.Add(Format(sMismatchOriginalsC,[ShortChildName, CPoItem.Original]));
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (ErrorCount > 0) then
|
||||
begin
|
||||
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
DoTestEnd(PoTestOptionNames[ptoCheckMismatchedOriginals], ErrorCount);
|
||||
//debugln('TPoFamily.CheckMismatchedOriginals: ',Dbgs(ErrorCount),' Errors');
|
||||
end;
|
||||
|
||||
procedure TPoFamily.CheckDuplicateOriginals(out ErrorCount: Integer;
|
||||
ErrorLog: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
PoItem, Dup: TPOFileItem;
|
||||
begin
|
||||
//debugln('TPoFamily.CheckMismatchedOriginals');
|
||||
DoTestStart(PoTestOptionNames[ptoCheckDuplicateOriginals], ShortMasterName);
|
||||
ErrorCount := NoError;
|
||||
for i := FMaster.Count - 1 downto 0 do
|
||||
begin
|
||||
PoItem := FMaster.PoItems[i];
|
||||
Dup := FMaster.OriginalToItem(PoItem.Original);
|
||||
if Assigned(Dup) and (Dup.Identifier <> PoItem.Identifier) and (Dup.Context = '') then
|
||||
begin
|
||||
if (ErrorCount = 0) then
|
||||
begin
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add(Format(sErrorsByTest,[sCheckDuplicateOriginals]));
|
||||
ErrorLog.Add(ShortMasterName);
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
Inc(ErrorCount);
|
||||
ErrorLog.Add(Format(sLineNr,[PoItem.LineNr]));
|
||||
ErrorLog.Add(sDuplicateOriginals);
|
||||
ErrorLog.Add(Format(sDuplicateIdentifier,[PoItem.Identifier]));
|
||||
ErrorLog.Add(Format(sDuplicateOriginal,[PoItem.Original]));
|
||||
ErrorLog.Add(Format(sDuplicateContext,[PoItem.Context]));
|
||||
ErrorLog.Add(Format(sDuplicateOriginals2,[Dup.Identifier,Dup.LineNr]));
|
||||
ErrorLog.Add(Format(sDuplicateOriginals3,[PoItem.Identifier]));
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
end;
|
||||
if (ErrorCount > 0) then
|
||||
begin
|
||||
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||
ErrorLog.Add(Divider);
|
||||
ErrorLog.Add('');
|
||||
ErrorLog.Add('');
|
||||
end;
|
||||
DoTestEnd(PoTestOptionNames[ptoCheckDuplicateOriginals], ErrorCount);
|
||||
//debugln('TPoFamily.CheckDuplicateOriginals: ',Dbgs(ErrorCount),' Errors');
|
||||
end;
|
||||
|
||||
{
|
||||
procedure TPoFamily.RunTests(const Options: TPoTestOptions; out
|
||||
Pre conditions:
|
||||
* Master and a matching Child must be assigned at start ot testing
|
||||
* If a Child is assigned it must be child of Master
|
||||
}
|
||||
procedure TPoFamily.RunTests(const Options: TPoTestOptions; out
|
||||
ErrorCount: Integer; ErrorLog: TStrings);
|
||||
var
|
||||
SL: TStringList;
|
||||
CurrErrCnt: Integer;
|
||||
i: Integer;
|
||||
CurrChildName: String;
|
||||
S: String;
|
||||
begin
|
||||
SL := nil;
|
||||
ErrorCount := NoError;
|
||||
if (not Assigned(FMaster)) and (not Assigned(FChild)) then
|
||||
begin
|
||||
{$ifdef DebugSimplePoFiles}
|
||||
debugln('TPoFamily.RunTests: Both master and child are unassigned.');
|
||||
{$endif}
|
||||
Exit;
|
||||
end;
|
||||
if not Assigned(FMaster) then
|
||||
begin
|
||||
S := ExtractMasterNameFromChildName(FChildName);
|
||||
if (S <> '') and FileExistsUtf8(S) then
|
||||
begin
|
||||
SetMasterName(S);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifdef DebugSimplePoFiles}
|
||||
Debugln('TPoFamily.RunTests: Cannot find master for ',ShortChildName);
|
||||
{$endif}
|
||||
Exit;
|
||||
end
|
||||
end;
|
||||
if not Assigned(FChild) and ([ptoFindAllChilds, ptoCheckDuplicateOriginals] * Options = []) then
|
||||
begin
|
||||
{$ifdef DebugSimplePoFiles}
|
||||
Debugln('TPoFamily.RunTests: no child assigned for ',ShortMasterName);
|
||||
{$endif}
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (ptoFindAllChilds in Options) then
|
||||
begin
|
||||
SL := FindAllTranslatedPoFiles(FMasterName);
|
||||
//We want current Child (if currently assigned) at index 0
|
||||
if Assigned(FChild) then
|
||||
begin
|
||||
for i := 0 to SL.Count - 1 do
|
||||
begin
|
||||
if (CompareFileNames(Sl.Strings[i], FChildName) = 0) then
|
||||
begin
|
||||
if (i <> 0) then SL.Exchange(i,0);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
SL := TStringList.Create;
|
||||
Sl.Add(FChildName);
|
||||
end;
|
||||
|
||||
// for i := 0 to sl.count - 1 do debugln(extractfilename(sl.strings[i]));
|
||||
|
||||
try
|
||||
|
||||
//First run checks that are Master-only
|
||||
if (ptoCheckDuplicateOriginals in Options) then
|
||||
begin
|
||||
CheckDuplicateOriginals(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
|
||||
//then iterate all Children
|
||||
for i := 0 to SL.Count - 1 do
|
||||
begin
|
||||
CurrChildName := SL.Strings[i];
|
||||
//debugln('TPoFamily.RunTests: setting ChildName to ',CurrChildName);
|
||||
SetChildName(CurrChildName);
|
||||
|
||||
if (ptoCheckNrOfItems in Options) then
|
||||
begin
|
||||
CheckNrOfItems(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
|
||||
if (ptoCheckFormatArgs in Options) then
|
||||
begin
|
||||
CheckFormatArgs(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
|
||||
|
||||
if (ptoCheckMissingIdentifiers in Options) then
|
||||
begin
|
||||
CheckMissingIdentifiers(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
|
||||
|
||||
if (ptoCheckMismatchedOriginals in Options) then
|
||||
begin
|
||||
CheckMismatchedOriginals(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{
|
||||
if (pto in Options) then
|
||||
begin
|
||||
Check(CurrErrCnt, ErrorLog);
|
||||
ErrorCount := CurrErrCnt + ErrorCount;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
finally
|
||||
SL.Free;
|
||||
end;
|
||||
//debugln('TPoFamilyRunTests: ErrorCount = ',DbgS(ErrorCount));
|
||||
end;
|
||||
|
||||
procedure InitTestOptions;
|
||||
var
|
||||
Index: TPoTestOption;
|
||||
begin
|
||||
for Index := Low(TPoTestOption) to High(TPotestOption) do optRunAllTestsOnAllChilds := optRunAllTestsOnAllChilds + [Index];
|
||||
optRunAllTests := optRunAllTestsOnAllChilds - [ptoFindAllChilds];
|
||||
end;
|
||||
|
||||
Initialization
|
||||
|
||||
InitTestOptions;
|
||||
|
||||
end.
|
||||
|
||||
620
components/pochecker/resultdlg.lfm
Normal file
620
components/pochecker/resultdlg.lfm
Normal file
@ -0,0 +1,620 @@
|
||||
object ResultDlgForm: TResultDlgForm
|
||||
Left = 284
|
||||
Height = 635
|
||||
Top = 108
|
||||
Width = 742
|
||||
ActiveControl = CopyBtn
|
||||
Caption = 'Results'
|
||||
ClientHeight = 635
|
||||
ClientWidth = 742
|
||||
KeyPreview = True
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnShow = FormShow
|
||||
LCLVersion = '0.9.31'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 585
|
||||
Width = 742
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 50
|
||||
ClientWidth = 742
|
||||
TabOrder = 1
|
||||
object CloseBtn: TBitBtn
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 657
|
||||
Height = 30
|
||||
Top = 10
|
||||
Width = 75
|
||||
Anchors = [akRight]
|
||||
BorderSpacing.Right = 10
|
||||
DefaultCaption = True
|
||||
Kind = bkClose
|
||||
ModalResult = 11
|
||||
TabOrder = 2
|
||||
end
|
||||
object SaveBtn: TBitBtn
|
||||
AnchorSideRight.Control = CloseBtn
|
||||
Left = 572
|
||||
Height = 30
|
||||
Top = 10
|
||||
Width = 75
|
||||
Anchors = [akRight]
|
||||
BorderSpacing.Around = 10
|
||||
Caption = '&Save to file'
|
||||
TabOrder = 1
|
||||
end
|
||||
object CopyBtn: TBitBtn
|
||||
AnchorSideRight.Control = SaveBtn
|
||||
Left = 487
|
||||
Height = 30
|
||||
Top = 10
|
||||
Width = 75
|
||||
Anchors = [akRight]
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'CopyBtn'
|
||||
OnClick = CopyBtnClick
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
inline LogMemo: TSynEdit
|
||||
Left = 98
|
||||
Height = 150
|
||||
Top = 120
|
||||
Width = 200
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
Font.Pitch = fpFixed
|
||||
Font.Quality = fqNonAntialiased
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
Gutter.Width = 21
|
||||
Gutter.MouseActions = <
|
||||
item
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = emcOnMainGutterClick
|
||||
end
|
||||
item
|
||||
Button = mbRight
|
||||
Command = emcContextMenu
|
||||
end>
|
||||
RightGutter.Width = 0
|
||||
RightGutter.MouseActions = <
|
||||
item
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = emcOnMainGutterClick
|
||||
end
|
||||
item
|
||||
Button = mbRight
|
||||
Command = emcContextMenu
|
||||
end>
|
||||
Keystrokes = <
|
||||
item
|
||||
Command = ecUp
|
||||
ShortCut = 38
|
||||
end
|
||||
item
|
||||
Command = ecSelUp
|
||||
ShortCut = 8230
|
||||
end
|
||||
item
|
||||
Command = ecScrollUp
|
||||
ShortCut = 16422
|
||||
end
|
||||
item
|
||||
Command = ecDown
|
||||
ShortCut = 40
|
||||
end
|
||||
item
|
||||
Command = ecSelDown
|
||||
ShortCut = 8232
|
||||
end
|
||||
item
|
||||
Command = ecScrollDown
|
||||
ShortCut = 16424
|
||||
end
|
||||
item
|
||||
Command = ecLeft
|
||||
ShortCut = 37
|
||||
end
|
||||
item
|
||||
Command = ecSelLeft
|
||||
ShortCut = 8229
|
||||
end
|
||||
item
|
||||
Command = ecWordLeft
|
||||
ShortCut = 16421
|
||||
end
|
||||
item
|
||||
Command = ecSelWordLeft
|
||||
ShortCut = 24613
|
||||
end
|
||||
item
|
||||
Command = ecRight
|
||||
ShortCut = 39
|
||||
end
|
||||
item
|
||||
Command = ecSelRight
|
||||
ShortCut = 8231
|
||||
end
|
||||
item
|
||||
Command = ecWordRight
|
||||
ShortCut = 16423
|
||||
end
|
||||
item
|
||||
Command = ecSelWordRight
|
||||
ShortCut = 24615
|
||||
end
|
||||
item
|
||||
Command = ecPageDown
|
||||
ShortCut = 34
|
||||
end
|
||||
item
|
||||
Command = ecSelPageDown
|
||||
ShortCut = 8226
|
||||
end
|
||||
item
|
||||
Command = ecPageBottom
|
||||
ShortCut = 16418
|
||||
end
|
||||
item
|
||||
Command = ecSelPageBottom
|
||||
ShortCut = 24610
|
||||
end
|
||||
item
|
||||
Command = ecPageUp
|
||||
ShortCut = 33
|
||||
end
|
||||
item
|
||||
Command = ecSelPageUp
|
||||
ShortCut = 8225
|
||||
end
|
||||
item
|
||||
Command = ecPageTop
|
||||
ShortCut = 16417
|
||||
end
|
||||
item
|
||||
Command = ecSelPageTop
|
||||
ShortCut = 24609
|
||||
end
|
||||
item
|
||||
Command = ecLineStart
|
||||
ShortCut = 36
|
||||
end
|
||||
item
|
||||
Command = ecSelLineStart
|
||||
ShortCut = 8228
|
||||
end
|
||||
item
|
||||
Command = ecEditorTop
|
||||
ShortCut = 16420
|
||||
end
|
||||
item
|
||||
Command = ecSelEditorTop
|
||||
ShortCut = 24612
|
||||
end
|
||||
item
|
||||
Command = ecLineEnd
|
||||
ShortCut = 35
|
||||
end
|
||||
item
|
||||
Command = ecSelLineEnd
|
||||
ShortCut = 8227
|
||||
end
|
||||
item
|
||||
Command = ecEditorBottom
|
||||
ShortCut = 16419
|
||||
end
|
||||
item
|
||||
Command = ecSelEditorBottom
|
||||
ShortCut = 24611
|
||||
end
|
||||
item
|
||||
Command = ecToggleMode
|
||||
ShortCut = 45
|
||||
end
|
||||
item
|
||||
Command = ecCopy
|
||||
ShortCut = 16429
|
||||
end
|
||||
item
|
||||
Command = ecPaste
|
||||
ShortCut = 8237
|
||||
end
|
||||
item
|
||||
Command = ecDeleteChar
|
||||
ShortCut = 46
|
||||
end
|
||||
item
|
||||
Command = ecCut
|
||||
ShortCut = 8238
|
||||
end
|
||||
item
|
||||
Command = ecDeleteLastChar
|
||||
ShortCut = 8
|
||||
end
|
||||
item
|
||||
Command = ecDeleteLastChar
|
||||
ShortCut = 8200
|
||||
end
|
||||
item
|
||||
Command = ecDeleteLastWord
|
||||
ShortCut = 16392
|
||||
end
|
||||
item
|
||||
Command = ecUndo
|
||||
ShortCut = 32776
|
||||
end
|
||||
item
|
||||
Command = ecRedo
|
||||
ShortCut = 40968
|
||||
end
|
||||
item
|
||||
Command = ecLineBreak
|
||||
ShortCut = 13
|
||||
end
|
||||
item
|
||||
Command = ecSelectAll
|
||||
ShortCut = 16449
|
||||
end
|
||||
item
|
||||
Command = ecCopy
|
||||
ShortCut = 16451
|
||||
end
|
||||
item
|
||||
Command = ecBlockIndent
|
||||
ShortCut = 24649
|
||||
end
|
||||
item
|
||||
Command = ecLineBreak
|
||||
ShortCut = 16461
|
||||
end
|
||||
item
|
||||
Command = ecInsertLine
|
||||
ShortCut = 16462
|
||||
end
|
||||
item
|
||||
Command = ecDeleteWord
|
||||
ShortCut = 16468
|
||||
end
|
||||
item
|
||||
Command = ecBlockUnindent
|
||||
ShortCut = 24661
|
||||
end
|
||||
item
|
||||
Command = ecPaste
|
||||
ShortCut = 16470
|
||||
end
|
||||
item
|
||||
Command = ecCut
|
||||
ShortCut = 16472
|
||||
end
|
||||
item
|
||||
Command = ecDeleteLine
|
||||
ShortCut = 16473
|
||||
end
|
||||
item
|
||||
Command = ecDeleteEOL
|
||||
ShortCut = 24665
|
||||
end
|
||||
item
|
||||
Command = ecUndo
|
||||
ShortCut = 16474
|
||||
end
|
||||
item
|
||||
Command = ecRedo
|
||||
ShortCut = 24666
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker0
|
||||
ShortCut = 16432
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker1
|
||||
ShortCut = 16433
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker2
|
||||
ShortCut = 16434
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker3
|
||||
ShortCut = 16435
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker4
|
||||
ShortCut = 16436
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker5
|
||||
ShortCut = 16437
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker6
|
||||
ShortCut = 16438
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker7
|
||||
ShortCut = 16439
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker8
|
||||
ShortCut = 16440
|
||||
end
|
||||
item
|
||||
Command = ecGotoMarker9
|
||||
ShortCut = 16441
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker0
|
||||
ShortCut = 24624
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker1
|
||||
ShortCut = 24625
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker2
|
||||
ShortCut = 24626
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker3
|
||||
ShortCut = 24627
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker4
|
||||
ShortCut = 24628
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker5
|
||||
ShortCut = 24629
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker6
|
||||
ShortCut = 24630
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker7
|
||||
ShortCut = 24631
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker8
|
||||
ShortCut = 24632
|
||||
end
|
||||
item
|
||||
Command = ecSetMarker9
|
||||
ShortCut = 24633
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel1
|
||||
ShortCut = 41009
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel2
|
||||
ShortCut = 41010
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel1
|
||||
ShortCut = 41011
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel1
|
||||
ShortCut = 41012
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel1
|
||||
ShortCut = 41013
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel6
|
||||
ShortCut = 41014
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel7
|
||||
ShortCut = 41015
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel8
|
||||
ShortCut = 41016
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel9
|
||||
ShortCut = 41017
|
||||
end
|
||||
item
|
||||
Command = EcFoldLevel0
|
||||
ShortCut = 41008
|
||||
end
|
||||
item
|
||||
Command = EcFoldCurrent
|
||||
ShortCut = 41005
|
||||
end
|
||||
item
|
||||
Command = EcUnFoldCurrent
|
||||
ShortCut = 41003
|
||||
end
|
||||
item
|
||||
Command = EcToggleMarkupWord
|
||||
ShortCut = 32845
|
||||
end
|
||||
item
|
||||
Command = ecNormalSelect
|
||||
ShortCut = 24654
|
||||
end
|
||||
item
|
||||
Command = ecColumnSelect
|
||||
ShortCut = 24643
|
||||
end
|
||||
item
|
||||
Command = ecLineSelect
|
||||
ShortCut = 24652
|
||||
end
|
||||
item
|
||||
Command = ecTab
|
||||
ShortCut = 9
|
||||
end
|
||||
item
|
||||
Command = ecShiftTab
|
||||
ShortCut = 8201
|
||||
end
|
||||
item
|
||||
Command = ecMatchBracket
|
||||
ShortCut = 24642
|
||||
end
|
||||
item
|
||||
Command = ecColSelUp
|
||||
ShortCut = 40998
|
||||
end
|
||||
item
|
||||
Command = ecColSelDown
|
||||
ShortCut = 41000
|
||||
end
|
||||
item
|
||||
Command = ecColSelLeft
|
||||
ShortCut = 40997
|
||||
end
|
||||
item
|
||||
Command = ecColSelRight
|
||||
ShortCut = 40999
|
||||
end
|
||||
item
|
||||
Command = ecColSelPageDown
|
||||
ShortCut = 40994
|
||||
end
|
||||
item
|
||||
Command = ecColSelPageBottom
|
||||
ShortCut = 57378
|
||||
end
|
||||
item
|
||||
Command = ecColSelPageUp
|
||||
ShortCut = 40993
|
||||
end
|
||||
item
|
||||
Command = ecColSelPageTop
|
||||
ShortCut = 57377
|
||||
end
|
||||
item
|
||||
Command = ecColSelLineStart
|
||||
ShortCut = 40996
|
||||
end
|
||||
item
|
||||
Command = ecColSelLineEnd
|
||||
ShortCut = 40995
|
||||
end
|
||||
item
|
||||
Command = ecColSelEditorTop
|
||||
ShortCut = 57380
|
||||
end
|
||||
item
|
||||
Command = ecColSelEditorBottom
|
||||
ShortCut = 57379
|
||||
end>
|
||||
MouseActions = <
|
||||
item
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
ClickDir = cdDown
|
||||
Command = emcStartSelections
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
Shift = [ssShift]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
ClickDir = cdDown
|
||||
Command = emcStartSelections
|
||||
MoveCaret = True
|
||||
Option = 1
|
||||
end
|
||||
item
|
||||
Shift = [ssAlt]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
ClickDir = cdDown
|
||||
Command = emcStartColumnSelections
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
Shift = [ssShift, ssAlt]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
ClickDir = cdDown
|
||||
Command = emcStartColumnSelections
|
||||
MoveCaret = True
|
||||
Option = 1
|
||||
end
|
||||
item
|
||||
Button = mbRight
|
||||
Command = emcContextMenu
|
||||
end
|
||||
item
|
||||
ClickCount = ccDouble
|
||||
ClickDir = cdDown
|
||||
Command = emcSelectWord
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
ClickCount = ccTriple
|
||||
ClickDir = cdDown
|
||||
Command = emcSelectLine
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
ClickCount = ccQuad
|
||||
ClickDir = cdDown
|
||||
Command = emcSelectPara
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
Button = mbMiddle
|
||||
ClickDir = cdDown
|
||||
Command = emcPasteSelection
|
||||
MoveCaret = True
|
||||
end
|
||||
item
|
||||
Shift = [ssCtrl]
|
||||
ShiftMask = [ssShift, ssAlt, ssCtrl]
|
||||
Command = emcMouseLink
|
||||
end>
|
||||
MouseSelActions = <
|
||||
item
|
||||
ClickDir = cdDown
|
||||
Command = emcStartDragMove
|
||||
end>
|
||||
Lines.Strings = (
|
||||
'LogMemo'
|
||||
)
|
||||
VisibleSpecialChars = [vscSpace, vscTabAtLast]
|
||||
ReadOnly = True
|
||||
ScrollBars = ssAutoBoth
|
||||
BracketHighlightStyle = sbhsBoth
|
||||
inline SynLeftGutterPartList1: TSynGutterPartList
|
||||
object SynGutterLineNumber1: TSynGutterLineNumber
|
||||
Width = 17
|
||||
MouseActions = <>
|
||||
MarkupInfo.Background = clBtnFace
|
||||
MarkupInfo.Foreground = clNone
|
||||
DigitCount = 2
|
||||
ShowOnlyLineNumbersMultiplesOf = 1
|
||||
ZeroStart = False
|
||||
LeadingZeros = False
|
||||
end
|
||||
object SynGutterChanges1: TSynGutterChanges
|
||||
Width = 4
|
||||
MouseActions = <>
|
||||
ModifiedColor = 59900
|
||||
SavedColor = clGreen
|
||||
end
|
||||
end
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
Filter = 'Text files|*.txt|All files|*'
|
||||
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
|
||||
left = 40
|
||||
top = 320
|
||||
end
|
||||
end
|
||||
102
components/pochecker/resultdlg.pp
Normal file
102
components/pochecker/resultdlg.pp
Normal file
@ -0,0 +1,102 @@
|
||||
unit ResultDlg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, Buttons, ClipBrd, LCLType, LCLProc, SynEdit, SynHighlighterPo;
|
||||
|
||||
type
|
||||
|
||||
{ TResultDlgForm }
|
||||
|
||||
TResultDlgForm = class(TForm)
|
||||
CopyBtn: TBitBtn;
|
||||
SaveBtn: TBitBtn;
|
||||
CloseBtn: TBitBtn;
|
||||
Panel1: TPanel;
|
||||
SaveDialog: TSaveDialog;
|
||||
FLog: TStringList;
|
||||
LogMemo: TSynEdit;
|
||||
procedure CopyBtnClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
PoHL: TSynPoSyn;
|
||||
procedure SaveToFile;
|
||||
public
|
||||
{ public declarations }
|
||||
property Log: TStringList read FLog write FLog;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
sSaveError = 'Error saving file:'^m'%s';
|
||||
|
||||
{ TResultDlgForm }
|
||||
|
||||
procedure TResultDlgForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
LogMemo.Lines.Clear;
|
||||
LogMemo.Align := alClient;
|
||||
FLog := TStringList.Create;
|
||||
PoHL := TSynPoSyn.Create(Self);
|
||||
LogMemo.Highlighter := PoHL;
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
FLog.Clear;
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.CopyBtnClick(Sender: TObject);
|
||||
begin
|
||||
ClipBoard.AsText := LogMemo.Text;
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FLog.Free;
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if (Key = VK_Tab) and (Shift = []) and LogMemo.Focused then
|
||||
begin
|
||||
//Workaroud: cannot tab out of LogMemo
|
||||
CopyBtn.SetFocus;
|
||||
//debugln('Tab');
|
||||
Key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.FormShow(Sender: TObject);
|
||||
begin
|
||||
LogMemo.Lines.Assign(FLog);
|
||||
end;
|
||||
|
||||
procedure TResultDlgForm.SaveToFile;
|
||||
begin
|
||||
if SaveDialog.Execute then
|
||||
begin
|
||||
try
|
||||
LogMemo.Lines.SaveToFile(SaveDialog.FileName);
|
||||
except
|
||||
MessageDlg('GPoCheck',Format(sSaveError,[SaveDialog.FileName]), mtError, [mbOk], 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
1511
components/pochecker/simplepofiles.pp
Normal file
1511
components/pochecker/simplepofiles.pp
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user