From 01233f98fec6918258bd6b51fa3e743178edb4f2 Mon Sep 17 00:00:00 2001 From: juha Date: Sun, 25 Dec 2011 13:15:33 +0000 Subject: [PATCH] New PoChecker IDE package from Bart Broersma git-svn-id: trunk@34404 - --- .gitattributes | 10 + components/pochecker/.directory | 5 + components/pochecker/README.txt | 7 + components/pochecker/pochecker.lpk | 75 ++ components/pochecker/pochecker.pas | 21 + components/pochecker/pocheckermain.lfm | 149 +++ components/pochecker/pocheckermain.pp | 335 ++++++ components/pochecker/pofamilies.pp | 703 +++++++++++ components/pochecker/resultdlg.lfm | 620 ++++++++++ components/pochecker/resultdlg.pp | 102 ++ components/pochecker/simplepofiles.pp | 1511 ++++++++++++++++++++++++ 11 files changed, 3538 insertions(+) create mode 100644 components/pochecker/.directory create mode 100644 components/pochecker/README.txt create mode 100644 components/pochecker/pochecker.lpk create mode 100644 components/pochecker/pochecker.pas create mode 100644 components/pochecker/pocheckermain.lfm create mode 100644 components/pochecker/pocheckermain.pp create mode 100644 components/pochecker/pofamilies.pp create mode 100644 components/pochecker/resultdlg.lfm create mode 100644 components/pochecker/resultdlg.pp create mode 100644 components/pochecker/simplepofiles.pp diff --git a/.gitattributes b/.gitattributes index 0d15629a58..19074a7c3b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/pochecker/.directory b/components/pochecker/.directory new file mode 100644 index 0000000000..a77b996f02 --- /dev/null +++ b/components/pochecker/.directory @@ -0,0 +1,5 @@ +[Dolphin] +AdditionalInfoV2=Details_Size,Details_Date,CustomizedDetails +Timestamp=2011,12,25,14,41,0 +Version=2 +ViewMode=1 diff --git a/components/pochecker/README.txt b/components/pochecker/README.txt new file mode 100644 index 0000000000..7bcce94435 --- /dev/null +++ b/components/pochecker/README.txt @@ -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 diff --git a/components/pochecker/pochecker.lpk b/components/pochecker/pochecker.lpk new file mode 100644 index 0000000000..7b33b232c2 --- /dev/null +++ b/components/pochecker/pochecker.lpk @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/pochecker/pochecker.pas b/components/pochecker/pochecker.pas new file mode 100644 index 0000000000..c019d21924 --- /dev/null +++ b/components/pochecker/pochecker.pas @@ -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. diff --git a/components/pochecker/pocheckermain.lfm b/components/pochecker/pocheckermain.lfm new file mode 100644 index 0000000000..02ae939a1a --- /dev/null +++ b/components/pochecker/pocheckermain.lfm @@ -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 diff --git a/components/pochecker/pocheckermain.pp b/components/pochecker/pocheckermain.pp new file mode 100644 index 0000000000..fff3f6ffc4 --- /dev/null +++ b/components/pochecker/pocheckermain.pp @@ -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 . 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. + diff --git a/components/pochecker/pofamilies.pp b/components/pochecker/pofamilies.pp new file mode 100644 index 0000000000..4c56199c2b --- /dev/null +++ b/components/pochecker/pofamilies.pp @@ -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. + diff --git a/components/pochecker/resultdlg.lfm b/components/pochecker/resultdlg.lfm new file mode 100644 index 0000000000..992c63b27d --- /dev/null +++ b/components/pochecker/resultdlg.lfm @@ -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 diff --git a/components/pochecker/resultdlg.pp b/components/pochecker/resultdlg.pp new file mode 100644 index 0000000000..5411195772 --- /dev/null +++ b/components/pochecker/resultdlg.pp @@ -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. + diff --git a/components/pochecker/simplepofiles.pp b/components/pochecker/simplepofiles.pp new file mode 100644 index 0000000000..57855ebe27 --- /dev/null +++ b/components/pochecker/simplepofiles.pp @@ -0,0 +1,1511 @@ +{ + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL.txt, included in this distribution, * + * for details about the copyright. * + * * + * This program 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. * + * * + ***************************************************************************** + + This file is based upon the translations.pas file by Mattias Gaertner + Author: Bart Broersma + Year: 2011 + + Abstract: + Methods and classes for loading and checking validity of po-files. + + Note: + Most references to unneeded methods/functions/procedures are commented out, + if we later need them, we can easily uncomment the relevant parts + * For the moment I left out all character encoding stuff: all the relevant + strings I need to investigate can be investigated without knowing the encoding + If a program needs to know the encoding, it can read the CharSet property of TSimplePoFile + * Change the implementation of ReadPoText to use Strings instead of PChars, this resulted in + a speed-up with a factor 20 + (ifdef-ed the old method) + * Added LineNr to TPoFileItem + +} + + +{ $define DebugSimplePoFiles} +{ $define ReadPoTextPChar} //define this to use the old ReadPoText method which uses PChars + + +unit SimplePoFiles; + +{$mode objfpc}{$H+}{$INLINE ON} +{ $include include/lcl_defines.inc} + +interface + +uses + Classes, SysUtils, LCLProc, FileUtil, StringHashList + {, LConvEncoding} + //{$IFDEF UNIX}{$IFNDEF DisableCWString}, cwstring{$ENDIF}{$ENDIF} + ; + +{ +type + TStringsType = (stLrt, stRst); + TTranslateUnitResult = (turOK, turNoLang, turNoFBLang, turEmptyParam); +} + +type + { TPOFileItem } + + TPOFileItem = class + public + LineNr: Integer; + Tag: Integer; + Comments: string; + Identifier: string; + Original: string; + Translation: string; + Flags: string; + PreviousID: string; + Context: string; + constructor Create(const TheIdentifier, TheOriginal, TheTranslated: string); + procedure ModifyFlag(const AFlag: string; Check: boolean); + end; + + { TSimplePOFile } + + TSimplePOFile = class + protected + FItems: TFPList;// list of TPOFileItem + FIdentifierToItem: TStringHashList; + //FIdentVarToItem: TStringHashList; + FOriginalToItem: TStringHashList; + FCharSet: String; + FHeader: TPOFileItem; + FAllEntries: boolean; + FTag: Integer; + //FModified: boolean; + FHelperList: TStringList; + FModuleList: TStringList; + //procedure RemoveTaggedItems(aTag: Integer); + //procedure RemoveUntaggedModules; + function GetCount: Integer; + procedure SetCharSet(const AValue: String); + {$ifdef ReadPoTextPChar} + procedure ReadPOText(const Txt: string); + {$else} + procedure ReadPOText(AStream: TStream); + {$endif ReadPoTextPChar} + function GetPoItem(Index: Integer): TPoFileItem; + protected + property Items: TFPList read FItems; + public + constructor Create(const AFilename: String; const Full: Boolean = True); + constructor Create(AStream: TStream; const Full: Boolean = True); + destructor Destroy; override; + procedure Add(const Identifier, OriginalValue, TranslatedValue, Comments, + Context, Flags, PreviousID: string; LineNr: Integer); + //function Translate(const Identifier, OriginalValue: String): String; + procedure Report; + procedure Report(StartIndex, StopIndex: Integer; const DisplayHeader: Boolean); + procedure Report(Log: TStrings; StartIndex, StopIndex: Integer; const DisplayHeader: Boolean); + procedure CreateHeader; + //procedure UpdateStrings(InputLines:TStrings; SType: TStringsType); + //procedure SaveToFile(const AFilename: string); + //procedure UpdateItem(const Identifier: string; Original: string); + //procedure UpdateTranslation(BasePOFile: TSimplePOFile); + //procedure ClearModuleList; + //procedure AddToModuleList(Identifier: string); + //procedure UntagAll; + + function FindPoItem(const Identifier: String): TPoFileItem; + function OriginalToItem(Data: String): TPoFileItem; + + property CharSet: String read FCharSet; + property Tag: integer read FTag write FTag; + //property Modified: boolean read FModified; + property PoItems[Index: Integer]: TPoFileItem read GetPoItem; + property Count: Integer read GetCount; + + end; + + EPOFileError = class(Exception) + public + ResFileName: string; + POFileName: string; + end; + +var + SystemCharSetIsUTF8: Boolean = true;// the LCL interfaces expect UTF-8 as default + // if you don't use UTF-8, install a proper widestring manager and set this + // to false. + + +// translate resource strings for one unit +function UTF8ToSystemCharSet(const s: string): string; inline; + +//function UpdatePoFile(Files: TStrings; const POFilename: string): boolean; + +implementation + +{$ifdef DebugSimplePoFiles} +var + T0, T1: DWord; function GetTickCount: DWord; + +var + HH, MM, SS, MS: Word; +begin + DecodeTime(Now, HH, MM, SS, MS); + Result := DWord(MS) + (DWord(SS) * 1000) + (DWord(MM) * 1000 * 60) + (DWord(HH) * 1000 * 60 * 24); +end; +{$endif} + + + +function UTF8ToSystemCharSet(const s: string): string; inline; +begin + if SystemCharSetIsUTF8 then + exit(s); + {$IFDEF NoUTF8Translations} + Result:=s; + {$ELSE} + Result:=UTF8ToSys(s); + {$ENDIF} +end; + + +function StrToPoStr(const s:string):string; +var + SrcPos, DestPos: Integer; + NewLength: Integer; +begin + NewLength:=length(s); + for SrcPos:=1 to length(s) do + if s[SrcPos] in ['"','\'] then inc(NewLength); + if NewLength=length(s) then begin + Result:=s; + end else begin + SetLength(Result,NewLength); + DestPos:=1; + for SrcPos:=1 to length(s) do begin + case s[SrcPos] of + '"','\': + begin + Result[DestPos]:='\'; + inc(DestPos); + Result[DestPos]:=s[SrcPos]; + inc(DestPos); + end; + else + Result[DestPos]:=s[SrcPos]; + inc(DestPos); + end; + end; + end; +end; + + + +{ +function UpdatePOFile(Files: TStrings; const POFilename: string): boolean; +var + InputLines: TStringList; + Filename: string; + BasePoFile, POFile: TSimplePOFile; + i: Integer; + E: EPOFileError; + + procedure UpdatePoFilesTranslation; + var + j: Integer; + Lines: TStringList; + begin + // Update translated PO files + Lines := FindAllTranslatedPoFiles(POFilename); + try + for j:=0 to Lines.Count-1 do begin + POFile := TSimplePOFile.Create(Lines[j], true); + try + POFile.Tag:=1; + POFile.UpdateTranslation(BasePOFile); + try + POFile.SaveToFile(Lines[j]); + except + on Ex: Exception do begin + E := EPOFileError.Create(Ex.Message); + E.ResFileName:=Lines[j]; + E.POFileName:=POFileName; + raise E; + end; + end; + finally + POFile.Free; + end; + end; + finally + Lines.Free; + end; + end; + +begin + Result := false; + + if (Files=nil) or (Files.Count=0) then begin + + if FileExistsUTF8(POFilename) then begin + // just update translated po files + BasePOFile := TSimplePOFile.Create(POFilename, true); + try + UpdatePoFilesTranslation; + finally + BasePOFile.Free; + end; + end; + + exit; + + end; + + InputLines := TStringList.Create; + try + // Read base po items + if FileExistsUTF8(POFilename) then + BasePOFile := TSimplePOFile.Create(POFilename, true) + else + BasePOFile := TSimplePOFile.Create; + BasePOFile.Tag:=1; + + // Update po file with lrt or/and rst files + for i:=0 to Files.Count-1 do begin + Filename:=Files[i]; + if (CompareFileExt(Filename,'.lrt')=0) + or (CompareFileExt(Filename,'.rst')=0) then + try + //DebugLn(''); + //DebugLn(['AddFiles2Po Filename="',Filename,'"']); + InputLines.Clear; + InputLines.LoadFromFile(UTF8ToSys(FileName)); + + if CompareFileExt(Filename,'.lrt')=0 then + BasePOFile.UpdateStrings(InputLines, stLrt) + else + BasePOFile.UpdateStrings(InputLines, stRst); + + except + on Ex: Exception do begin + E := EPOFileError.Create(Ex.Message); + E.ResFileName:=FileName; + E.POFileName:=POFileName; + raise E; + end; + end; + end; + BasePOFile.SaveToFile(POFilename); + Result := BasePOFile.Modified; + + UpdatePOFilesTranslation; + + finally + InputLines.Free; + BasePOFile.Free; + end; +end; +} + +{ +function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString; +var + po: TSimplePOFile; +begin + po:=TSimplePOFile(arg); + // get UTF8 string + result := po.Translate(Name,Value); + // convert UTF8 to current local + if result<>'' then + result:=UTF8ToSystemCharSet(result); +end; +} + + +{ TSimplePOFile } + +{ +procedure TSimplePOFile.RemoveUntaggedModules; +var + Module: string; + Item,VItem: TPOFileItem; + i, p: Integer; +begin + if FModuleList=nil then + exit; + + // remove all module references that were not tagged + for i:=FItems.Count-1 downto 0 do begin + Item := TPOFileItem(FItems[i]); + p := pos('.',Item.Identifier); + if P=0 then + continue; // module not found (?) + + Module :=LeftStr(Item.Identifier, p-1); + if (FModuleList.IndexOf(Module)<0) then + continue; // module was not modified this time + + if Item.Tag=FTag then + continue; // PO item was updated + + // this item is not more in updated modules, delete it + FIdentifierToItem.Remove(Item.Identifier); + // delete it also from VarToItem + Module := RightStr(Item.Identifier, Length(Item.Identifier)-P); + VItem := TPoFileItem(FIdentVarToItem.Data[Module]); + if (VItem=Item) then + FIdentVarToItem.Remove(Module); + + FOriginalToItem.Remove(Item.Original); // isn't this tricky? + FItems.Delete(i); + Item.Free; + end; +end; +} + +function TSimplePOFile.GetCount: Integer; +begin + Result := FItems.Count; +end; + +procedure TSimplePOFile.SetCharSet(const AValue: String); +begin + if (CompareText(FCharSet, AValue) = 0) then Exit; + if (AValue = '') then FCharSet := 'UTF-8' + else FCharSet := AValue; +end; + + + +constructor TSimplePOFile.Create(const AFilename: String; const Full: Boolean = True); +var + f: TStream; +begin + f := TFileStream.Create(UTF8ToSys(AFilename), fmOpenRead or fmShareDenyNone); + try + Create(f, Full); + if FHeader=nil then CreateHeader; + finally + f.Free; + end; +end; + +constructor TSimplePOFile.Create(AStream: TStream; const Full: Boolean = True); +var + Size: Integer; + {$ifdef ReadPoTextPChar} + S: String; + {$endif ReadPoTextPChar} +begin + inherited Create; + FAllEntries:=true; + FItems:=TFPList.Create; + FIdentifierToItem:=TStringHashList.Create(false); + //FIdentVarToItem:=TStringHashList.Create(false); + FOriginalToItem:=TStringHashList.Create(true); + FAllEntries := Full; + Size:=AStream.Size-AStream.Position; + if Size<=0 then exit; + {$ifdef ReadPoTextPChar} + SetLength(s,Size); + AStream.Read(S[1],Size); + ReadPOText(S); + {$else} + ReadPoText(AStream); + {$endif ReadPoTextPChar} +end; + + +destructor TSimplePOFile.Destroy; +var + i: Integer; +begin + if FModuleList<>nil then + FModuleList.Free; + if FHelperList<>nil then + FHelperList.Free; + if FHeader<>nil then + FHeader.Free; + for i:=0 to FItems.Count-1 do + TObject(FItems[i]).Free; + FItems.Free; + //FIdentVarToItem.Free; + FIdentifierToItem.Free; + FOriginalToItem.Free; + inherited Destroy; +end; + +function SliceToStr(SourceStart: PChar; SourceLen: PtrInt) : string; +//converts PChar (can be in the middle of some larger string) to a string +var + Dest: PChar; +begin + SetLength(Result, SourceLen); + Dest := PChar(Result); + System.Move(SourceStart^, Dest^, SourceLen); +end; + + +{$ifdef ReadPoTextPChar} +procedure TSimplePOFile.ReadPOText(const Txt: string); +{ Read a .po file. Structure: + +Example +#: lazarusidestrconsts:lisdonotshowsplashscreen +msgid "Do not show splash screen" +msgstr "" + +} +const + sCommentIdentifier: PChar = '#: '; + sCharSetIdentifier: PChar = '"Content-Type: text/plain; charset='; + sMsgID: PChar = 'msgid "'; + sMsgStr: PChar = 'msgstr "'; + sMsgCtxt: Pchar = 'msgctxt "'; + sFlags: Pchar = '#, '; + sPrevMsgID: PChar = '#| msgid "'; + sPrevStr: PChar = '#| "'; + +const + ciNone = 0; + ciMsgID = 1; + ciMsgStr = 2; + ciPrevMsgID = 3; + +var + l: Integer; + LineNr: Integer; + LineLen: Integer; + p: PChar; + LineStart: PChar; + LineEnd: PChar; + Identifier: String; + MsgID,MsgStr,PrevMsgID: String; + Line: String; + Comments: String; + Context: string; + Flags: string; + TextEnd: PChar; + i, CollectedIndex: Integer; + OldLineStartPos: PtrUInt; + NewSrc: String; + s: String; + + procedure ResetVars; + begin + MsgId := ''; + MsgStr := ''; + Line := ''; + Identifier := ''; + Comments := ''; + Context := ''; + Flags := ''; + PrevMsgID := ''; + CollectedIndex := ciNone; + end; + + procedure StoreCollectedLine; + begin + case CollectedIndex of + ciMsgID: MsgID := Line; + ciMsgStr: MsgStr := Line; + ciPrevMsgID: PrevMsgID := Line; + end; + CollectedIndex := ciNone; + end; + + procedure AddEntry; + var + Item: TPOFileItem; + begin + + + StoreCollectedLine; + if Identifier<>'' then begin + // check for unresolved duplicates in po file + { + Item := TPOFileItem(FOriginalToItem.Data[MsgID]); + if (Item<>nil) then begin + // fix old duplicate context + if Item.Context='' then + Item.Context:=Item.Identifier; + // set context of new duplicate + if Context='' then + Context := Identifier; + // if old duplicate was translated and + // new one is not, provide a initial translation + if MsgStr='' then + MsgStr := Item.Translation; + end; + } + Add(Identifier,MsgID,MsgStr,Comments,Context,Flags,PrevMsgID, LineNr); + ResetVars; + end else + if (Line<>'') and (FHeader=nil) then begin + FHeader := TPOFileItem.Create('',MsgID,Line); + FHeader.Comments:=Comments; + ResetVars; + end + end; + + function TestPrefixStr(AIndex: Integer): boolean; + var + s: string; + l: Integer; + begin + case aIndex of + ciMsgID: s:=sMsgId; + ciMsgStr: s:=sMsgStr; + ciPrevMsgId: s:=sPrevMsgId; + end; + L := Length(s); + result := CompareMem(LineStart, pchar(s), L); + if Result then begin + StoreCollectedLine; + CollectedIndex := AIndex; + Line:=SliceToStr(LineStart+L,LineLen-L-1); + end; + end; + +begin + {$ifdef DebugSimplePoFiles} + T0 := GetTickCount; + {$endif} + if Txt='' then exit; + s:=Txt; + l:=length(s); + p:=PChar(s); + LineStart:=p; + TextEnd:=p+l; + + Identifier:=''; + Comments:=''; + Line:=''; + Flags:=''; + CollectedIndex := ciNone; + LineNr := 0; + while LineStart0 then begin + + if CompareMem(LineStart,sCommentIdentifier,3) then begin + AddEntry; + Identifier:=copy(s,LineStart-p+4,LineLen-3); + // the RTL creates identifier paths with point instead of colons + // fix it: + for i:=1 to length(Identifier) do + if Identifier[i]=':' then + Identifier[i]:='.'; + end else if TestPrefixStr(ciMsgId) then begin + end else if TestPrefixStr(ciMsgStr) then begin + end else if TestPrefixStr(ciPrevMsgId) then begin + end else if CompareMem(LineStart, sMsgCtxt,9) then begin + Context:= Copy(LineStart, 10, LineLen-10); + end else if CompareMem(LineStart, sFlags, 3) then begin + Flags := copy(LineStart, 4, LineLen-3); + end else if (LineStart^='"') then begin + if (MsgID='') and CompareMem(LineStart,sCharSetIdentifier,35) then + begin + + SetCharSet(copy(LineStart,36,LineLen-38)); + {if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin + // convert encoding to UTF-8 + OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1; + NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)), + FCharSet,EncodingUTF8); + // replace text and update all pointers + s:=copy(s,1,OldLineStartPos-1)+NewSrc; + l:=length(s); + p:=PChar(s); + TextEnd:=p+l; + LineStart:=p+(OldLineStartPos-1); + LineEnd:=LineStart; + while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd); + LineLen:=LineEnd-LineStart; + end; + } + end; + Line := Line + SliceToStr(LineStart+1,LineLen-2); + end else if CompareMem(LineStart, sPrevStr, 4) then begin + Line := Line + SliceToStr(LineStart+5,LineLen-6); + end else if LineStart^='#' then begin + if Comments<>'' then + Comments := Comments + LineEnding; + Comments := Comments + Copy(LineStart, 1, LineLen); + end else + AddEntry; + end + else Inc(LineNr); + LineStart:=LineEnd+1; + while (LineStart'' then + begin + // check for unresolved duplicates in po file + { + Item := TPOFileItem(FOriginalToItem.Data[MsgID]); + if (Item<>nil) then begin + // fix old duplicate context + if Item.Context='' then + Item.Context:=Item.Identifier; + // set context of new duplicate + if Context='' then + Context := Identifier; + // if old duplicate was translated and + // new one is not, provide a initial translation + if MsgStr='' then + MsgStr := Item.Translation; + end; + } + Add(Identifier,MsgID,MsgStr,Comments,Context,Flags,PrevMsgID, LineNr); + ResetVars; + end else + if (Line<>'') and (FHeader=nil) then + begin + FHeader := TPOFileItem.Create('',MsgID,Line); + FHeader.Comments:=Comments; + ResetVars; + end + end; + + function TestPrefixStr(AIndex: Integer): boolean; + var + s: string; + l: Integer; + begin + case aIndex of + ciMsgID: s:=sMsgId; + ciMsgStr: s:=sMsgStr; + ciPrevMsgId: s:=sPrevMsgId; + end; + L := Length(s); + result := Pos(S, CurLine) = 1; + if Result then + begin + StoreCollectedLine; + CollectedIndex := AIndex; + Line := Copy(CurLine,L+1,LineLen-L-1); + end; + end; + +begin + {$ifdef DebugSimplePoFiles} + T0 := GetTickCount; + {$endif} + SL := TStringList.Create; + SL.LoadFromStream(AStream); + try + if SL.Count > 0 then AdjustLinebreaks(SL.Text); + Identifier:=''; + Comments:=''; + Line:=''; + Flags:=''; + CollectedIndex := ciNone; + LineNr := 0; + + for Cnt := 0 to SL.Count - 1 do + begin + CurLine := Sl.Strings[Cnt]; + + + LineLen := Length(CurLine); + if (LineLen > 0) then + begin + p := Pos(sCommentIdentifier,CurLine); + if (p = 1) then + begin + //Add the Entry collected before this line (not the current line) + AddEntry(LineNr); + LineNr := Cnt + 1; + Identifier:=copy(CurLine,lCommentIdentifier+1,LineLen-lCommentIdentifier); + // the RTL creates identifier paths with point instead of colons + // fix it: + for i:=1 to length(Identifier) do + if Identifier[i]=':' then + Identifier[i]:='.'; + end + else if TestPrefixStr(ciMsgId) then + begin + end + else if TestPrefixStr(ciMsgStr) then + begin + end + else if TestPrefixStr(ciPrevMsgId) then + begin + end else if (Pos(sMsgCtxt, CurLine) = 1) then + begin + Context:= Copy(CurLine,lMsgCtxt+1,LineLen - lMsgCtxt - 1); + end + else if Pos(SFlags, CurLine) = 1 then + begin + Flags := Copy(CurLine, lFlags + 1, LineLen - lFlags); + end + else if (CurLine[1] = '"') then + begin + if (MsgID='') and (Pos(sCharSetIdentifier,CurLine) = 1) then + begin + + SetCharSet(copy(CurLine,lCharSetIdentifier+1,LineLen-lCharSetIdentifier-3)); + {if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin + // convert encoding to UTF-8 + OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1; + NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)), + FCharSet,EncodingUTF8); + // replace text and update all pointers + s:=copy(s,1,OldLineStartPos-1)+NewSrc; + l:=length(s); + p:=PChar(s); + TextEnd:=p+l; + LineStart:=p+(OldLineStartPos-1); + LineEnd:=LineStart; + while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd); + LineLen:=LineEnd-LineStart; + end; + } + end; + Line := Line + Copy(CurLine,2,LineLen-2); + end + else if Pos(sPrevStr,CurLine) = 1 then + begin + Line := Line + Copy(CurLine,lPrevStr + 1,LineLen - lPrevStr - 1); + end + else if CurLine[1] = '#' then + begin + if Comments<>'' then Comments := Comments + LineEnding; + Comments := Comments + CurLine; + end + else + begin + AddEntry(LineNr); + end; + end;//LineLen > 0 + end; + //debugln('Last entry:'); + //debugln('Identifier = ',Identifier); + //debugln('LineNr = ',DbgS(LineNr)); + //debugln('Cnt = ',DbgS(Cnt)); + + AddEntry(LineNr); + finally + SL.Free; + end; + + {$ifdef DebugSimplePoFiles} + T1 := gettickcount; + debugln('T1 = ',dbgs(t1-t0)); + debugln('Count = ',DbgS(Count)); + {$endif} +end; + +{$endif ReadPoTextPChar} + +procedure TSimplePOFile.Add(const Identifier, OriginalValue, TranslatedValue, + Comments, Context, Flags, PreviousID: string; LineNr: Integer); +var + Item: TPOFileItem; + //p: Integer; +begin + if (not FAllEntries) and (TranslatedValue='') then exit; + + Item:=TPOFileItem.Create(Identifier,OriginalValue,TranslatedValue); + Item.Comments:=Comments; + Item.Context:=Context; + Item.Flags:=Flags; + Item.PreviousID:=PreviousID; + Item.Tag:=FTag; + Item.LineNr := LineNr; + FItems.Add(Item); + + //debugln('TPOFile.Add %8x Tag=%d Id="%s" Org="%s" Trn="%s"', + // [ptrint(Item),FTag,Identifier,dbgstr(OriginalValue),dbgstr(TranslatedValue)]); + + + FIdentifierToItem.Add(Identifier,Item); + + + { + P := Pos('.', Identifier); + if P>0 then + FIdentVarToItem.Add(copy(Identifier, P+1, Length(IDentifier)), Item); + } + + //if FIdentifierToItem.Data[UpperCase(Identifier)]=nil then raise Exception.Create(''); + FOriginalToItem.Add(OriginalValue,Item); + //if FOriginalToItem.Data[OriginalValue]=nil then raise Exception.Create(''); +end; + +{ +function TSimplePOFile.Translate(const Identifier, OriginalValue: String): String; +var + Item: TPOFileItem; +begin + Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]); + if Item=nil then + Item:=TPOFileItem(FOriginalToItem.Data[OriginalValue]); + if Item<>nil then begin + Result:=Item.Translation; + if Result='' then RaiseGDBException('TPOFile.Translate Inconsistency'); + end else + Result:=OriginalValue; +end; +} + +procedure TSimplePOFile.Report; +begin + Report(0, Count - 1, True); +end; + +procedure TSimplePOFile.Report(StartIndex, StopIndex: Integer; + const DisplayHeader: Boolean); +var + Item: TPOFileItem; + i: Integer; +begin + if DisplayHeader then + begin + DebugLn('Header:'); + DebugLn('---------------------------------------------'); + + if FHeader=nil then + DebugLn('No header found in po file') + else begin + DebugLn('Comments=',FHeader.Comments); + DebugLn('Identifier=',FHeader.Identifier); + DebugLn('msgid=',FHeader.Original); + DebugLn('msgstr=', FHeader.Translation); + end; + DebugLn; + end; + + if (StartIndex > StopIndex) then + begin + i := StopIndex; + StopIndex := StartIndex; + StartIndex := i; + end; + if (StopIndex > Count - 1) then StopIndex := Count - 1; + if (StartIndex < 0) then StartIndex := 0; + + DebugLn('Entries [',DbgS(StartIndex),'..',Dbgs(StopIndex),']:'); + DebugLn('---------------------------------------------'); + for i := StartIndex to StopIndex do begin + DebugLn('#',dbgs(i),': '); + Item := TPOFileItem(FItems[i]); + DebugLn('Identifier=',Item.Identifier); + DebugLn('msgid=',Item.Original); + DebugLn('msgstr=', Item.Translation); + DebugLn('Comments=',Item.Comments); + DebugLn; + end; +end; + +procedure TSimplePOFile.Report(Log: TStrings; StartIndex, StopIndex: Integer; + const DisplayHeader: Boolean); +var + Item: TPOFileItem; + i: Integer; +begin + if DisplayHeader then + begin + Log.Add('Header:'); + Log.Add('---------------------------------------------'); + + if FHeader=nil then + Log.Add('No header found in po file') + else begin + Log.Add('Comments='+FHeader.Comments); + Log.Add('Identifier='+FHeader.Identifier); + Log.Add('msgid='+FHeader.Original); + Log.Add('msgstr='+ FHeader.Translation); + end; + Log.Add(''); + end; + + if (StartIndex > StopIndex) then + begin + i := StopIndex; + StopIndex := StartIndex; + StartIndex := i; + end; + if (StopIndex > Count - 1) then StopIndex := Count - 1; + if (StartIndex < 0) then StartIndex := 0; + + Log.Add('Entries ['+DbgS(StartIndex)+'..'+Dbgs(StopIndex)+']:'); + Log.Add('---------------------------------------------'); + for i := StartIndex to StopIndex do begin + Log.Add('#'+dbgs(i)+': '); + Item := TPOFileItem(FItems[i]); + Log.Add('Identifier='+Item.Identifier); + Log.Add('msgid='+Item.Original); + Log.Add('msgstr='+ Item.Translation); + Log.Add('Comments='+Item.Comments); + Log.Add(''); + end; +end; + +procedure TSimplePOFile.CreateHeader; +begin + if FHeader=nil then + FHeader := TPOFileItem.Create('','',''); + FHeader.Translation:='Content-Type: text/plain; charset=UTF-8'; + FHeader.Comments:=''; +end; + +{ +procedure TSimplePOFile.UpdateStrings(InputLines: TStrings; SType: TStringsType); +var + i,j,n: integer; + p: LongInt; + Identifier, Value,Line: string; + Ch: Char; + MultiLinedValue: boolean; + + procedure NextLine; + begin + if i0 then begin + + Identifier := copy(Line,1,p-1); + inc(p); // points to ' after = + + Value := ''; + while p<=n do begin + + if Line[p]='''' then begin + inc(p); + j:=p; + while (p<=n)and(Line[p]<>'''') do + inc(p); + Value := Value + copy(Line, j, P-j); + inc(p); + continue; + end else + if Line[p] = '#' then begin + // a #decimal + repeat + inc(p); + j:=p; + while (p<=n)and(Line[p] in ['0'..'9']) do + inc(p); + + Ch := Chr(StrToInt(copy(Line, j, p-j))); + Value := Value + Ch; + if Ch in [#13,#10] then + MultilinedValue := True; + + if (p=n) and (Line[p]='+') then + NextLine; + + until (p>n) or (Line[p]<>'#'); + end else + if Line[p]='+' then + NextLine + else + inc(p); // this is an unexpected string + end; + + if Value<>'' then begin + if MultiLinedValue then begin + // check that we end on lineending, multilined + // resource strings from rst usually do not end + // in lineending, fix here. + if not (Value[Length(Value)] in [#13,#10]) then + Value := Value + LineEnding; + end; + // po requires special characters as #number + p:=1; + while p<=length(Value) do begin + j := UTF8CharacterLength(pchar(@Value[p])); + if (j=1) and (Value[p] in [#0..#9,#11,#12,#14..#31,#127..#255]) then + Value := copy(Value,1,p-1)+'#'+IntToStr(ord(Value[p]))+copy(Value,p+1,length(Value)) + else + inc(p,j); + end; + + UpdateItem(Identifier, Value); + end; + + end; // if p>0 then begin + end; + end; + + inc(i); + end; + + RemoveUntaggedModules; +end; +} + + +{ +procedure TSimplePOFile.RemoveTaggedItems(aTag: Integer); +var + Item: TPOFileItem; + i: Integer; +begin + // get rid of all entries that have Tag=aTag + for i:=FItems.Count-1 downto 0 do begin + Item := TPOFileItem(FItems[i]); + if Item.Tag<>aTag then + Continue; + FIdentifierToItem.Remove(Item.Identifier); + FOriginalToItem.Remove(Item.Original); // isn't this tricky? + FItems.Delete(i); + Item.Free; + end; +end; +} + +function ComparePOItems(Item1, Item2: Pointer): Integer; +begin + result := CompareText(TPOFileItem(Item1).Identifier, + TPOFileItem(Item2).Identifier); +end; + +{ +procedure TSimplePOFile.SaveToFile(const AFilename: string); +var + OutLst: TStringList; + j: Integer; + + procedure WriteLst(const AProp, AValue: string ); + var + i: Integer; + s: string; + begin + if (AValue='') and (AProp='') then + exit; + + FHelperList.Text:=AValue; + if FHelperList.Count=1 then begin + if AProp='' then OutLst.Add(FHelperList[0]) + else OutLst.Add(AProp+' "'+FHelperList[0]+'"'); + end else begin + if AProp<>'' then + OutLst.Add(AProp+' ""'); + for i:=0 to FHelperList.Count-1 do begin + s := FHelperList[i]; + if AProp<>'' then begin + s := '"' + s + '\n"'; + if AProp='#| msgid' then + s := '#| ' + s; + end; + OutLst.Add(s) + end; + end; + end; + + procedure WriteItem(Item: TPOFileItem); + begin + WriteLst('',Item.Comments); + if Item.Identifier<>'' then + OutLst.Add('#: '+Item.Identifier); + if Trim(Item.Flags)<>'' then + OutLst.Add('#, '+Trim(Item.Flags)); + if Item.PreviousID<>'' then + WriteLst('#| msgid', strToPoStr(Item.PreviousID)); + if Item.Context<>'' then + WriteLst('msgctxt', Item.Context); + WriteLst('msgid', StrToPoStr(Item.Original)); + WriteLst('msgstr', StrToPoStr(Item.Translation)); + OutLst.Add(''); + end; + +begin + if FHeader=nil then + CreateHeader; + + if FHelperList=nil then + FHelperList:=TStringList.Create; + + OutLst := TStringList.Create; + try + // write header + WriteItem(FHeader); + + // Sort list of items by identifier + FItems.Sort(@ComparePOItems); + + for j:=0 to Fitems.Count-1 do + WriteItem(TPOFileItem(FItems[j])); + + OutLst.SaveToFile(UTF8ToSys(AFilename)); + + finally + OutLst.Free; + end; + +end; +} + +function SkipLineEndings(var P: PChar; var DecCount: Integer): Integer; + procedure Skip; + begin + Dec(DecCount); + Inc(P); + end; +begin + Result := 0; + while (P^ in [#10,#13]) do begin + Inc(Result); + if (P^=#13) then begin + Skip; + if P^=#10 then + Skip; + end else + Skip; + end; +end; + +function CompareMultilinedStrings(const S1,S2: string): Integer; +var + C1,C2,L1,L2: Integer; + P1,P2: PChar; +begin + L1 := Length(S1); + L2 := Length(S2); + P1 := pchar(S1); + P2 := pchar(S2); + Result := ord(P1^) - ord(P2^); + + while (Result=0) and (P1^<>#0) do begin + Inc(P1); Inc(P2); + Dec(L1); Dec(L2); + if P1^<>P2^ then begin + C1 := SkipLineEndings(P1, L1); + C2 := SkipLineEndings(P2, L2); + if (C1<>C2) then + // different amount of lineendings + result := C1-C2 + else + if (C1=0) then + // there are no lineendings at all, will end loop + result := Ord(P1^)-Ord(P2^); + end; + end; + + // if strings are the same, check that all chars have been consumed + // just in case there are unexpected chars in between, in this case + // L1=L2=0; + if Result=0 then + Result := L1-L2; +end; + +{ +procedure TSimplePOFile.UpdateItem(const Identifier: string; Original: string); +var + Item: TPOFileItem; + AContext,AComment,ATranslation,AFlags,APrevStr: string; +begin + if FHelperList=nil then + FHelperList := TStringList.Create; + + // try to find PO entry by identifier + Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]); + if Item<>nil then begin + // found, update item value + AddToModuleList(IDentifier); + + if CompareMultilinedStrings(Item.Original, Original)<>0 then begin + FModified := True; + if Item.Translation<>'' then begin + Item.ModifyFlag('fuzzy', true); + Item.PreviousID:=Item.Original; + end; + end; + Item.Original:=Original; + Item.Tag:=FTag; + exit; + end; + + // try to find po entry based only on it's value + AContext := ''; + AComment := ''; + ATranslation := ''; + AFlags := ''; + APrevStr := ''; + Item := TPOFileItem(FOriginalToItem.Data[Original]); + if Item<>nil then begin + // old item don't have context, add one + if Item.Context='' then + Item.Context := Item.Identifier; + + // if old item it's already translated use translation + if Item.Translation<>'' then + ATranslation := Item.Translation; + + AFlags := Item.Flags; + // if old item was fuzzy, new should be fuzzy too. + if (ATranslation<>'') and (pos('fuzzy', AFlags)<>0) then + APrevStr := Item.PreviousID; + + // update identifier list + AContext := Identifier; + end; + + // this appear to be a new item + FModified := true; + Add(Identifier, Original, ATranslation, AComment, AContext, AFlags, APrevStr); +end; +} + +{ +procedure TSimplePOFile.UpdateTranslation(BasePOFile: TSimplePOFile); +var + Item: TPOFileItem; + i: Integer; +begin + UntagAll; + ClearModuleList; + for i:=0 to BasePOFile.Items.Count-1 do begin + Item := TPOFileItem(BasePOFile.Items[i]); + UpdateItem(Item.Identifier, Item.Original); + end; + RemoveTaggedItems(0); // get rid of any item not existing in BasePOFile +end; +} + +{ +procedure TSimplePOFile.ClearModuleList; +begin + if FModuleList<>nil then + FModuleList.Clear; +end; +} + +{ +procedure TSimplePOFile.AddToModuleList(Identifier: string); +var + p: Integer; +begin + if FModuleList=nil then begin + FModuleList := TStringList.Create; + FModuleList.Duplicates:=dupIgnore; + end; + p := pos('.', Identifier); + if p>0 then + FModuleList.Add(LeftStr(Identifier, P-1)); +end; +} + +{ +procedure TSimplePOFile.UntagAll; +var + Item: TPOFileItem; + i: Integer; +begin + for i:=0 to Items.Count-1 do begin + Item := TPOFileItem(Items[i]); + Item.Tag:=0; + end; +end; +} + +function TSimplePOFile.FindPoItem(const Identifier: String): TPoFileItem; +begin + Result := TPOFileItem(FIdentifierToItem.Data[Identifier]); +end; + +function TSimplePOFile.GetPoItem(Index: Integer): TPoFileItem; +begin + Result := TPoFileItem(FItems.Items[Index]); +end; + +function TSimplePOFile.OriginalToItem(Data: String): TPoFileItem; +begin + Result := TPOFileItem(FOriginalToItem.Data[Data]); +end; + +{ TPOFileItem } + +constructor TPOFileItem.Create(const TheIdentifier, TheOriginal, + TheTranslated: string); +begin + Identifier:=TheIdentifier; + Original:=TheOriginal; + Translation:=TheTranslated; +end; + +procedure TPOFileItem.ModifyFlag(const AFlag: string; Check: boolean); +var + i: Integer; + F: TStringList; +begin + F := TStringList.Create; + try + + F.CommaText := Flags; + i := F.IndexOf(AFlag); + + if (i<0) and Check then + F.Add(AFlag) + else + if (i>=0) and (not Check) then + F.Delete(i); + + Flags := F.CommaText; + + finally + F.Free; + end; +end; + +end. + +