From f7dbe415c8c6a18d443eb6a445638000ddab51f4 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 20 Apr 2010 09:28:44 +0200 Subject: Alternative Translation Strings (ats) editor. An example application created by Nagy Viktor back in 2006. I added it to the "user contributed" area of the repository so the code doesn't get lost. --- extras/contributed/ats/ats_editor.lpi | 66 ++++ extras/contributed/ats/ats_editor.pas | 526 ++++++++++++++++++++++++++ extras/contributed/ats/ats_main.pas | 643 ++++++++++++++++++++++++++++++++ extras/contributed/ats/atstable.ats | 218 +++++++++++ extras/contributed/ats/atstable.csv | 92 +++++ extras/contributed/ats/atstable.inc | 291 +++++++++++++++ extras/contributed/ats/extrafpc.cfg | 5 + extras/contributed/ats/ptrparsefunc.pas | 165 ++++++++ extras/contributed/ats/readme.txt | 10 + 9 files changed, 2016 insertions(+) create mode 100644 extras/contributed/ats/ats_editor.lpi create mode 100644 extras/contributed/ats/ats_editor.pas create mode 100644 extras/contributed/ats/ats_main.pas create mode 100644 extras/contributed/ats/atstable.ats create mode 100644 extras/contributed/ats/atstable.csv create mode 100644 extras/contributed/ats/atstable.inc create mode 100644 extras/contributed/ats/extrafpc.cfg create mode 100644 extras/contributed/ats/ptrparsefunc.pas create mode 100644 extras/contributed/ats/readme.txt (limited to 'extras/contributed/ats') diff --git a/extras/contributed/ats/ats_editor.lpi b/extras/contributed/ats/ats_editor.lpi new file mode 100644 index 00000000..16f21757 --- /dev/null +++ b/extras/contributed/ats/ats_editor.lpi @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/extras/contributed/ats/ats_editor.pas b/extras/contributed/ats/ats_editor.pas new file mode 100644 index 00000000..92d5ce3e --- /dev/null +++ b/extras/contributed/ats/ats_editor.pas @@ -0,0 +1,526 @@ +program ats_editor; + +{$mode objfpc}{$H+} + +uses + SysUtils, Classes, fpg_base, fpg_main, fpg_customgrid, fpg_basegrid, + ats_main, fpg_grid, fpg_form, fpg_button, fpg_edit, fpg_menu, fpg_label, + fpg_combobox, fpg_dialogs, fpg_utils; + +const + langtabledata: + {$I atstable.inc} + +type + + { TLangGrid } + + TLangGrid = class(TfpgCustomGrid) + protected + procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + function GetRowCount: Integer; override; + public + atstable: TatsTextTable; + procedure UpdateColumns; + end; + + { TfrmLangTable } + + TfrmLangTable = class(TfpgForm) + public + menuFile: TfpgPopupMenu; + + {@VFD_HEAD_BEGIN: frmLangTable} + mainmenu: TfpgMenuBar; + grid: TLangGrid; + btnNewRow: TfpgButton; + btnCopyRow: TfpgButton; + btnDeleteRow: TfpgButton; + btnEdit: TfpgButton; + {@VFD_HEAD_END: frmLangTable} + + procedure AfterCreate; override; + + procedure menuProcExit(Sender: TObject); + procedure menuProcSave(Sender: TObject); + procedure menuProcOpen(Sender: TObject); + procedure menuProcNew(Sender: TObject); + + procedure EditClick(Sender : TObject); + + end; + + { TfrmTextEdit } + + TfrmTextEdit = class(TfpgForm) + public + {@VFD_HEAD_BEGIN: frmTextEdit} + Label1: TfpgLabel; + edID: TfpgEdit; + cmbLang1: TfpgComboBox; + edLang1: TfpgEdit; + cmbLang2: TfpgComboBox; + edLang2: TfpgEdit; + btnOK: TfpgButton; + btnCancel: TfpgButton; + {@VFD_HEAD_END: frmTextEdit} + + textrow : TatsTextRow; + + procedure AfterCreate; override; + + procedure OnLangChange(sender : TObject); + + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + + procedure LoadTexts; + end; + +{@VFD_NEWFORM_DECL} + +var + frmMain : TfrmLangTable; + +{@VFD_NEWFORM_IMPL} + +{ TLangGrid } + +procedure TLangGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); +var + s : string; + tr : TatsTextRow; + b : boolean; +begin + tr := atstable.GetRow(ARow); + if ACol = 0 then + begin + s := tr.TextId; + end + else + begin + //s := 'Col '+IntToStr(ACol); + s := tr.GetText(Columns[ACol].Title, b); + end; + Canvas.DrawString(ARect.Left+1, ARect.Top+1, s); + + //inherited DrawCell(ARow, ACol, ARect, AFlags); +end; + +function TLangGrid.GetRowCount: Integer; +begin + if atstable <> nil then + result := atstable.RowCount + else + result := 2; +end; + +procedure TLangGrid.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +begin + if keycode = keyEnter then + begin + frmMain.btnEdit.Click; + end + else + inherited HandleKeyPress(keycode, shiftstate, consumed); +end; + +procedure TLangGrid.UpdateColumns; +var + n : integer; + gc : TfpgGridColumn; +begin + if atstable = nil then Exit; + + ColumnCount := atstable.LangList.Count+1; + + gc := Columns[0]; + gc.Title := 'ID'; + gc.Width := 140; + + for n := 0 to atstable.LangList.Count-1 do + begin + gc := Columns[n+1]; + gc.Title := atstable.Langlist[n]; + gc.Width := 80; + end; +end; + +procedure TfrmTextEdit.AfterCreate; +begin + textrow := nil; + + {@VFD_BODY_BEGIN: frmTextEdit} + Name := 'frmTextEdit'; + SetPosition(326, 139, 466, 168); + WindowTitle := 'Edit Text'; + Hint := ''; + + Label1 := TfpgLabel.Create(self); + with Label1 do + begin + Name := 'Label1'; + SetPosition(8, 8, 80, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Text ID:'; + end; + + edID := TfpgEdit.Create(self); + with edID do + begin + Name := 'edID'; + SetPosition(8, 28, 228, 24); + ExtraHint := ''; + Hint := ''; + TabOrder := 1; + Text := ''; + FontDesc := '#Edit1'; + end; + + cmbLang1 := TfpgComboBox.Create(self); + with cmbLang1 do + begin + Name := 'cmbLang1'; + SetPosition(8, 65, 80, 22); + FontDesc := '#List'; + Hint := ''; + TabOrder := 3; + OnChange := @OnLangChange; + end; + + edLang1 := TfpgEdit.Create(self); + with edLang1 do + begin + Name := 'edLang1'; + SetPosition(100, 64, 356, 24); + ExtraHint := ''; + Hint := ''; + TabOrder := 3; + Text := ''; + FontDesc := '#Edit1'; + end; + + cmbLang2 := TfpgComboBox.Create(self); + with cmbLang2 do + begin + Name := 'cmbLang2'; + SetPosition(8, 97, 80, 22); + FontDesc := '#List'; + Hint := ''; + TabOrder := 4; + OnChange := @OnLangChange; + end; + + edLang2 := TfpgEdit.Create(self); + with edLang2 do + begin + Name := 'edLang2'; + SetPosition(100, 96, 356, 24); + ExtraHint := ''; + Hint := ''; + TabOrder := 4; + Text := ''; + FontDesc := '#Edit1'; + end; + + btnOK := TfpgButton.Create(self); + with btnOK do + begin + Name := 'btnOK'; + SetPosition(8, 133, 99, 24); + Text := 'OK'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := 'stdimg.ok'; + ModalResult := mrOK; + TabOrder := 6; + Default := true; + end; + + btnCancel := TfpgButton.Create(self); + with btnCancel do + begin + Name := 'btnCancel'; + SetPosition(356, 133, 99, 24); + Text := 'Cancel'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := 'stdimg.cancel'; + ModalResult := mrCancel; + TabOrder := 7; + end; + + {@VFD_BODY_END: frmTextEdit} +end; + +procedure TfrmTextEdit.OnLangChange(sender: TObject); +var + b : boolean; +begin + if sender = cmbLang1 then + begin + edLang1.Text := textrow.GetText(cmbLang1.Text, b); + end + else + begin + edLang2.Text := textrow.GetText(cmbLang2.Text, b); + end; +end; + +procedure TfrmTextEdit.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +begin + if keycode = keyEnter then btnOK.Click + else if keycode = keyEscape then btnCancel.Click + else inherited HandleKeyPress(keycode, shiftstate, consumed); +end; + +procedure TfrmTextEdit.LoadTexts; +var + b : boolean; +begin + edLang1.Text := textrow.GetText(cmbLang1.Text, b); + edLang2.Text := textrow.GetText(cmbLang2.Text, b); +end; + + +procedure TfrmLangTable.AfterCreate; +var + mi : TfpgMenuItem; +begin + {@VFD_BODY_BEGIN: frmLangTable} + Name := 'frmLangTable'; + SetPosition(282, 304, 619, 513); + WindowTitle := 'ATS Table Editor'; + Hint := ''; + + mainmenu := TfpgMenuBar.Create(self); + with mainmenu do + begin + Name := 'mainmenu'; + SetPosition(0, 0, 619, 28); + Anchors := [anLeft,anRight,anTop]; + end; + + grid := TLangGrid.Create(self); + with grid do + begin + Name := 'grid'; + SetPosition(0, 28, 619, 447); + Anchors := [anLeft,anRight,anTop,anBottom]; + end; + + btnNewRow := TfpgButton.Create(self); + with btnNewRow do + begin + Name := 'btnNewRow'; + SetPosition(8, 482, 75, 24); + Anchors := [anLeft,anBottom]; + Text := 'New Row'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 2; + end; + + btnCopyRow := TfpgButton.Create(self); + with btnCopyRow do + begin + Name := 'btnCopyRow'; + SetPosition(92, 482, 71, 24); + Anchors := [anLeft,anBottom]; + Text := 'Copy Row'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 3; + end; + + btnDeleteRow := TfpgButton.Create(self); + with btnDeleteRow do + begin + Name := 'btnDeleteRow'; + SetPosition(292, 482, 83, 24); + Anchors := [anLeft,anBottom]; + Text := 'Delete Row'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 4; + end; + + btnEdit := TfpgButton.Create(self); + with btnEdit do + begin + Name := 'btnEdit'; + SetPosition(188, 482, 79, 24); + Anchors := [anLeft,anBottom]; + Text := 'Edit Item'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 5; + OnClick := @EditClick; + end; + + {@VFD_BODY_END: frmLangTable} + + menuFile := TfpgPopupMenu.Create(self); + menuFile.AddMenuItem('&New', '', @menuProcNew); + menuFile.AddMenuItem('&Open...', '', @menuProcOpen); + menuFile.AddMenuItem('&Save...', '', @menuProcSave); + menuFile.AddMenuItem('-', '', nil); + menuFile.AddMenuItem('&Exit', '', @menuProcExit); + + mainmenu.AddMenuItem('&File', nil).SubMenu := menuFile; + + grid.atstable := atsTexts; + grid.UpdateColumns; +end; + +procedure TfrmLangTable.menuProcExit(Sender: TObject); +begin + Close; +end; + +procedure TfrmLangTable.menuProcSave(Sender: TObject); +var + dlg : TfpgFileDialog; + fname : string; +begin + dlg := TfpgFileDialog.Create(nil); + dlg.Filter := 'Pascal include (*.inc;*.pas)|*.inc;*.pas|ATS text (*.ats)|*.ats|CSV (*.csv)|*.csv|All Files (*)|*|'; + + if dlg.RunSaveFile then fname := dlg.FileName + else fname := ''; + + dlg.Free; + + if fname <> '' then + begin + if ExtractFileExt(fname) = '' then fname := fname + '.inc'; + if (UpperCase(ExtractFileExt(fname)) = '.INC') + or (UpperCase(ExtractFileExt(fname)) = '.PAS') then + begin + atsTexts.SaveToFile(fname, atsPascalSource); + end + else if UpperCase(ExtractFileExt(fname)) = '.CSV' then + begin + atsTexts.SaveToFile(fname, atsCSV); + end + else // if UpperCase(ExtractFileExt(fname)) = '.ATS' then + begin + atsTexts.SaveToFile(fname, atsPureText); + end; + + ShowMessage('Save done.'); + end; +end; + +procedure TfrmLangTable.menuProcOpen(Sender: TObject); +var + dlg : TfpgFileDialog; + fname : string; +begin + dlg := TfpgFileDialog.Create(nil); + dlg.Filter := 'Pascal include (*.inc;*.pas)|*.inc;*.pas|ATS text (*.ats)|*.ats|CSV (*.csv)|*.csv|All Files (*)|*|'; + + if dlg.RunOpenFile then fname := dlg.FileName + else fname := ''; + + dlg.Free; + + if not FileExists(fname) then + begin + ShowMessage('File does not exists.'); + Exit; + end; + + if fname <> '' then + begin + if (UpperCase(ExtractFileExt(fname)) = '.INC') + or (UpperCase(ExtractFileExt(fname)) = '.PAS') then + begin + atsTexts.LoadFromPascalFile(fname); + end + else if UpperCase(ExtractFileExt(fname)) = '.CSV' then + begin + ShowMessage('CSV loading is not supported.'); + + //atsTexts.SaveToFile(fname, atsCSV); + end + else // if UpperCase(ExtractFileExt(fname)) = '.ATS' then + begin + atsTexts.LoadFromFile(fname); + end; + end; +end; + +procedure TfrmLangTable.menuProcNew(Sender: TObject); +begin + atsTexts.Clear; + grid.Update; +end; + +procedure TfrmLangTable.EditClick(Sender: TObject); +var + frm : TfrmTextEdit; + tr : TatsTextRow; +begin + tr := grid.atstable.GetRow(grid.FocusRow); + + frm := TfrmTextEdit.Create(nil); + + frm.textrow := tr; + + // load + frm.edID.Text := tr.TextID; + + frm.cmbLang1.Items.Assign(grid.atstable.LangList); + frm.cmbLang2.Items.Assign(grid.atstable.LangList); + + frm.cmbLang1.Text := 'EN'; + + if grid.FocusCol > 0 + then frm.cmbLang2.Text := grid.Columns[grid.FocusCol].Title + else frm.cmbLang2.Text := 'EN'; + + frm.LoadTexts; + + frm.ActiveWidget := frm.edLang2; + + if frm.ShowModal = mrOK then + begin + // store + tr.SetText(frm.cmbLang1.Text,frm.edLang1.Text); + if frm.cmbLang2.Text <> frm.cmbLang1.Text + then tr.SetText(frm.cmbLang2.Text,frm.edLang2.Text); + + grid.Update; + end; + + frm.Free; +end; + +procedure MainProc; +begin + fpgApplication.Initialize; + + //atsTexts.LoadFromFile('test.ats'); + + //atsTexts.LoadFromArray(langtabledata); + if fpgFileExists('atstable.inc') then + atsTexts.LoadFromPascalFile('atstable.inc'); + + frmMain := TfrmLangTable.Create(nil); + + frmMain.Show; + fpgApplication.Run; + frmMain.Free; +end; + +begin + MainProc; +end. + + diff --git a/extras/contributed/ats/ats_main.pas b/extras/contributed/ats/ats_main.pas new file mode 100644 index 00000000..e8efb251 --- /dev/null +++ b/extras/contributed/ats/ats_main.pas @@ -0,0 +1,643 @@ +unit ats_main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TatsFormat = (atsPureText, atsPascalSource, atsCSV); + + TatsTextItem = record + LangId : string; + Text : string; + end; + + { TatsTextRow } + + TatsTextRow = class + protected + FTextId : string; + FTexts : array of TatsTextItem; + public + constructor Create(const atextid : string); + destructor Destroy; override; + + procedure SetText(const alangid, atext : string); + procedure DeleteText(const alangid : string); + + function GetText(const alangid : string; var afound : boolean) : string; + + property TextId : string read FTextId; + end; + + { TatsTextTable } + + TatsTextTable = class + private + FLangIds : TStringList; + + FTable : TStringList; + + FCurrentLangId : string; + + protected + function FindRow(const atextid : string) : TatsTextRow; + + function AddRow(const atextid : string) : TatsTextRow; + + public + constructor Create; + destructor Destroy; override; + + procedure Clear; + + procedure AddLang(const alangid : string); + + procedure SetText(const atextid, alangid, atext : string); + function GetText(const atextid, alangid : string; var found : boolean) : string; overload; + function GetText(const atextid : string) : string; overload; + + // later this can prepare a fast search table too: + procedure SelectLang(const alangid : string); + + //procedure SetFallbackOrder(const alangids : string); + + property CurrentLang : string read FCurrentLangId; + + public + + function LoadFromFile(const afilename : string) : boolean; + + function LoadFromPascalFile(const afilename : string) : boolean; + + function LoadFromArray(const aarr : array of string) : boolean; + + procedure LoadPureText(const fdata : string); + + procedure SaveToFile(const afilename : string; aformat : TatsFormat); + + // utility functions + function RowCount : integer; + function GetRow(arow : integer) : TatsTextRow; + + property LangList : TStringList read FLangIds; + end; + +var + atsTexts : TatsTextTable; + +function atsGetText(const atextid : string) : string; +function atsText(const atextid : string) : string; + +implementation + +uses + ptrparsefunc; + +function atsGetText(const atextid : string) : string; +begin + result := atsTexts.GetText(atextid); +end; + +function atsText(const atextid : string) : string; +begin + result := atsTexts.GetText(atextid); +end; + +{ TatsTextRow } + +constructor TatsTextRow.Create(const atextid : string); +begin + FTextId := atextid; + SetLength(FTexts,0); +end; + +destructor TatsTextRow.Destroy; +var + n : integer; +begin + // good to be sure about freeing ansi string + for n := 0 to length(FTexts)-1 do + begin + FTexts[n].LangId := ''; + FTexts[n].Text := ''; + end; + SetLength(FTexts,0); +end; + +procedure TatsTextRow.SetText(const alangid, atext: string); +var + n : integer; +begin + // search for an existing + for n := 0 to length(FTexts)-1 do + begin + if FTexts[n].LangId = alangid then + begin + FTexts[n].Text := atext; + Exit; //==> + end; + end; + // add as new + n := length(FTexts); + SetLength(FTexts,n+1); + FTexts[n].LangId := alangid; + FTexts[n].Text := atext; +end; + +procedure TatsTextRow.DeleteText(const alangid: string); +var + n : integer; +begin + // search for an existing + n := 0; + while (n < length(FTexts)) and (FTexts[n].LangId <> alangid) do + begin + inc(n); + end; + + // for ansi string safety + if n < length(FTexts) then + begin + FTexts[n].LangId := ''; + FTexts[n].Text := ''; + inc(n); + end; + + while (n < length(FTexts)) do + begin + FTexts[n-1] := FTexts[n]; + inc(n); + end; + + SetLength(FTexts,length(FTexts)-1); +end; + +function TatsTextRow.GetText(const alangid: string; var afound : boolean) : string; +var + n : integer; +begin + // search for an existing + for n := 0 to length(FTexts)-1 do + begin + if FTexts[n].LangId = alangid then + begin + result := FTexts[n].Text; + afound := true; + Exit; //==> + end; + end; + result := ''; + afound := false; +end; + +{ TatsTextTable } + +function TatsTextTable.FindRow(const atextid: string) : TatsTextRow; +var + i : integer; +begin + i := FTable.IndexOf(atextid); + + if i >= 0 then result := TatsTextRow(FTable.Objects[i]) + else result := nil; +end; + +function TatsTextTable.AddRow(const atextid: string) : TatsTextRow; +begin + result := FindRow(atextid); + if result = nil then + begin + result := TatsTextRow.Create(atextid); + FTable.AddObject(atextid, result); + end; +end; + +constructor TatsTextTable.Create; +begin + FTable := TStringList.Create; + FLangIds := TStringList.Create; + FCurrentLangId := ''; +end; + +destructor TatsTextTable.Destroy; +begin + Clear; + FTable.Free; + FLangIds.Free; +end; + +procedure TatsTextTable.Clear; +var + n : integer; +begin + for n := 0 to FTable.Count - 1 do + begin + TatsTextRow(FTable.Objects[n]).Free; + end; + FTable.Clear; + FLangIds.Clear; +end; + +procedure TatsTextTable.AddLang(const alangid: string); +var + i : integer; +begin + i := FLangIds.IndexOf(alangid); + if i < 0 then FLangIds.Add(alangid); + if FCurrentLangId = '' then FCurrentLangId := alangid; +end; + +procedure TatsTextTable.SetText(const atextid, alangid, atext: string); +var + tr : TatsTextRow; +begin + AddLang(alangid); + tr := AddRow(atextid); + tr.SetText(alangid, atext); +end; + +function TatsTextTable.GetText(const atextid, alangid: string; var found: boolean): string; +var + tr : TatsTextRow; +begin + tr := FindRow(atextid); + if tr <> nil then result := tr.GetText(alangid, found) + else + begin + result := ''; + found := false; + end; +end; + +function TatsTextTable.GetText(const atextid: string): string; +var + found : boolean; +begin + result := GetText(atextid, FCurrentLangId, found); + if not found then + begin + // some fallback mechanism + result := '#'+atextid+'@'+FCurrentLangId; + end; +end; + +procedure TatsTextTable.SelectLang(const alangid: string); +var + i : integer; +begin + i := FLangIds.indexof(alangid); + if i >= 0 then + begin + FCurrentLangId := alangid; + end; +end; + +function GetFileContent(const afilename : string) : string; +var + f : file; + toread, rcnt, brres : integer; +begin + try + AssignFile(f,afilename); + Reset(f,1); + + toread := FileSize(f); + rcnt := 0; + + SetLength(result, toread); + + repeat + BlockRead(f, result[1+rcnt], toread, brres); + + if brres > 0 then + begin + inc(rcnt,brres); + dec(toread,brres); + end; + until toread <= 0; + + finally + CloseFile(f); + end; +end; + +procedure PutFileContent(const afilename : string; const adata : string); +var + f : file; + towrite, wcnt, wrres : integer; +begin + try + AssignFile(f,afilename); + Rewrite(f,1); + + towrite := length(adata); + wcnt := 0; + + repeat + BlockWrite(f, adata[1+wcnt], towrite, wrres); + + if wrres > 0 then + begin + inc(wcnt,wrres); + dec(towrite,wrres); + end; + until towrite <= 0; + + finally + CloseFile(f); + end; +end; + + +function TatsTextTable.LoadFromFile(const afilename: string): boolean; +var + fdata : string; +begin + fdata := GetFileContent(afilename); + //writeln('File content:'); + //writeln(fdata); + LoadPureText(fdata); + + result := true; +end; + +function TatsTextTable.LoadFromPascalFile(const afilename : string) : boolean; +var + fdata, data : string; + rp,sp,ep : PChar; // read ptr, start ptr, end ptr + len : integer; + tid, lid, txt : string; + inquote : boolean; +begin + result := false; + + fdata := GetFileContent(afilename); + + if fdata = '' then Exit; + + sp := @fdata[1]; + ep := sp + length(fdata); + + rp := sp; + + // skipping UTF8 marker first + ppCheckSymbol(rp, ep, #$EF#$BB#$BF); + + ppSkipSpaces(rp, ep); + + if not ppCheckSymbolCI(rp, ep, 'array') then EXIT; + + ppSkipSpaces(rp, ep); + if not ppCheckSymbol(rp, ep, '[') then EXIT; + + if not ppSearchPattern(rp, ep, ']', len) then EXIT; + + ppSkipSpaces(rp, ep); + if not ppCheckSymbolCI(rp, ep, 'of') then EXIT; + ppSkipSpaces(rp, ep); + if not ppCheckSymbolCI(rp, ep, 'string') then EXIT; + ppSkipSpaces(rp, ep); + if not ppCheckSymbol(rp, ep, '=') then EXIT; + ppSkipSpaces(rp, ep); + if not ppCheckSymbol(rp, ep, '(') then EXIT; + + ppSkipSpaces(rp, ep); + + data := ''; + + inquote := false; + + while rp < ep do + begin + if not inquote then + begin + ppSkipSpaces(rp, ep); + if ppCheckSymbol(rp, ep, '''') then + begin + inquote := true; + sp := rp; + end + else if ppCheckSymbol(rp, ep, ',') then + begin + // just skip ip + ppSkipSpaces(rp, ep); + end + else if ppCheckSymbol(rp, ep, ')') then + begin + // closing char + break; + end + else + begin + // invalid char + break; + end; + end; + + if inquote then + begin + if ppReadTo(rp, ep, '''', len) then + begin + // closing quote or double quote + if len > 0 then data := data + ppMakeString(sp, len); + inc(rp); + if (rp < ep) and (rp^ = '''') then + begin + data := data + ''''; + inc(rp); + sp := rp; + end + else + begin + data := data + #10; + inquote := false; + end; + end; + end; + end; // while + + //writeln('Pure content:'); + //writeln(data); + + LoadPureText(data); + + result := true; +end; + +function TatsTextTable.LoadFromArray(const aarr: array of string): boolean; +var + fdata : string; + n : integer; +begin + fdata := ''; + for n := low(aarr) to high(aarr) do + begin + fdata := fdata + aarr[n] + #10; + end; + LoadPureText(fdata); +end; + +procedure TatsTextTable.LoadPureText(const fdata: string); +var + rp,sp,ep : PChar; // read ptr, start ptr, end ptr + len : integer; + tid, lid, txt : string; +begin + if fdata = '' then Exit; + + sp := @fdata[1]; + ep := sp + length(fdata); + + rp := sp; + + // skipping UTF8 marker first + ppCheckSymbol(rp, ep, #$EF#$BB#$BF); + + ppSkipSpaces(rp, ep); + + tid := '???'; + + while rp < ep do + begin + sp := rp; + // reading identifier (txt or lang) + if ppReadTo(rp, ep, '=:', len) then + begin + if rp^ = ':' then + begin + // text id is this + tid := trim(ppMakeString(sp, len)); + inc(rp); // skip ':' + end + else if rp^ = '=' then + begin + // lang id is this + lid := trim(ppMakeString(sp,len)); + inc(rp); // skip '=' + + ppSkipSpaces(rp, ep); + + if not ppCheckSymbol(rp,ep,'"') then + begin + // starting quote is missing + end; + + txt := ''; + sp := rp; + if ppReadTo(rp, ep, '"', len) then + begin + txt := ppMakeString(sp,len); + inc(rp); + end + else + begin + // end quote is missing + end; + + if txt <> '' then + begin + atsTexts.SetText(tid, lid, txt); + end; + end; + + ppSkipSpaces(rp, ep); + end; // reading identifier + end; +end; + +procedure TatsTextTable.SaveToFile(const afilename: string; aformat: TatsFormat); +var + sl : TStringList; + tr : TatsTextRow; + n,i : integer; + s : string; + b : boolean; + fdata : string; +begin + sl := TStringList.Create; + + for n:=0 to FTable.Count-1 do + begin + tr := TatsTextRow(FTable.Objects[n]); + if aformat = atsCSV then + begin + s := '"'+tr.TextId+'"'; + for i := 0 to FLangIds.Count-1 do + begin + s := s + ',"' + tr.GetText(FLangIds[i],b) + '"'; + end; + sl.Add(s); + end + else + begin + sl.Add(tr.TextID+':'); + for i := 0 to FLangIds.Count-1 do + begin + s := tr.GetText(FLangIds[i],b); + if b then sl.Add(' '+FLangIds[i]+'="'+s+'"'); + end; + end; + end; + + // assembly the final buffer + + if aformat = atsCSV then + begin + fdata := '"ATSF1"'; + for i := 0 to FLangIds.Count-1 do + begin + fdata := fdata + ',"' + FLangIds[i] + '"'; + end; + for n := 0 to sl.Count-1 do + begin + fdata := fdata + #13#10 + sl[n]; + end; + end + else if aformat = atsPascalSource then + begin + fdata := 'array[1..'+IntToStr(sl.Count)+'] of string = ('+#13#10; + s := ' '; + for n := 0 to sl.Count-1 do + begin + fdata := fdata + ' ' + s + QuotedStr(sl[n]) + #13#10; + s := ','; + end; + fdata := fdata + #13#10 + ');' + #13#10; + end + else + begin + // pure text... + fdata := ''; // no header + for n := 0 to sl.Count-1 do + begin + fdata := fdata + sl[n] + #13#10; + end; + end; + + sl.Free; + + PutFileContent(afilename, fdata); +end; + +function TatsTextTable.RowCount: integer; +begin + result := FTable.Count; +end; + +function TatsTextTable.GetRow(arow: integer): TatsTextRow; +begin + result := TatsTextRow(FTable.Objects[arow]); +end; + + +initialization +begin + atsTexts := TatsTextTable.Create; +end; + +end. + diff --git a/extras/contributed/ats/atstable.ats b/extras/contributed/ats/atstable.ats new file mode 100644 index 00000000..412fa3c5 --- /dev/null +++ b/extras/contributed/ats/atstable.ats @@ -0,0 +1,218 @@ +rsLanguage: + EN="English" + RU="Русский" + AF="Afrikaans" +rsOK: + EN="OK" + RU="OK" + AF="Goed" +rsCancel: + EN="Cancel" + RU="Отмена" + AF="Kanseleer" +rsHelp: + EN="Help" + RU="Справка" + AF="Help" +rsOpen: + EN="Open" + RU="Открыть" + AF="Maak oop" +rsSave: + EN="Save" + RU="Сохранить" + AF="Stoor" +rsCreate: + EN="Create" + RU="Создать" +rsChange: + EN="Change" + RU="Изменить" +rsFind: + EN="Find" + RU="Найти" +rsSearch: + EN="Search" + RU="Поиск" +rsReplace: + EN="Replace" + RU="Заменить" +rsConfirm: + EN="Confirm" + RU="Подтвердить" +rsAll: + EN="All" + RU="Все" +rsSelect: + EN="Select" + RU="Выбрать" +rsYes: + EN="Yes" + RU="Да" +rsNo: + EN="No" + RU="Нет" + AF="Nee" +rsAbort: + EN="Abort" + RU="Прервать" +rsRetry: + EN="Retry" + RU="Повторить" +rsIgnore: + EN="Ignore" + RU="Пропустить" +rsClose: + EN="Close" + RU="Закрыть" +rsInsert: + EN="Insert" + RU="Вставка" +rsEdit: + EN="Edit" + RU="Редактировать" +rsDelete: + EN="Delete" + RU="Удалить" +rsExit: + EN="Exit" + RU="Выход" +rsYesToAll: + EN="Yes to All" + RU="Да для всех" +rsNoToAll: + EN="No to All" + RU="Нет для всех" +rsCut: + EN="Cut" + RU="Вырезать" +rsCopy: + EN="Copy" + RU="Копировать" +rsPaste: + EN="Paste" + RU="Вставить" +rsError: + EN="Error" +rsCriticalError: + EN="Critical Error" +rsInformation: + EN="Information" +rsConfirmation: + EN="Confirmation" +rsWarning: + EN="Warning" +rsMessage: + EN="Message" +rsAbout: + EN="About %s" +rsAllFiles: + EN="All Files" +rsCreateDirectory: + EN="Create directory" +rsEnterNewDirectory: + EN="Enter new directory name" +rsCannotCreateDir: + EN="Cannot create directory" +rsSelectAFont: + EN="Select a font" +rsName: + EN="Name" +rsCollection: + EN="Collection" +rsSize: + EN="Size" +rsStyle: + EN="Style" +rsItalic: + EN="Italic" +rsBold: + EN="Bold" +rsUnderScore: + EN="UnderScore" +rsTypeface: + EN="Typeface" +rsAntiAliasing: + EN="Anti aliasing" +rsExampleText: + EN="Example Text" +rsCollectionAllFonts: + EN="All Fonts" +rsCollectionRecentlyUsed: + EN="Recently Used" +rsCollectionFavourites: + EN="Favourites" +rsCollectionFixedWidth: + EN="Fixed Width" +rsCollectionSans: + EN="Sans" +rsCollectionSerif: + EN="Serif" +rsCollectionFontAliases: + EN="Font Aliases" +rsOpenAFile: + EN="Open a file" +rsFileName: + EN="Filename" +rsFileType: + EN="Type of file" +rsDrive: + EN="Drive" +rsFiles: + EN="Files" +rsDirectories: + EN="Directories" +rsShowHidden: + EN="Show hidden files" +rsFileSelection: + EN="File Selection" +rsFileModifiedTime: + EN="Mod. Time" +rsFileAttributes: + EN="Attributes" +rsFileRights: + EN="Rights" +rsFileOwner: + EN="Owner" +rsFileGroup: + EN="Group" +rsSaveAFile: + EN="Save file as" +rsErrListMustBeEmpty: + EN="List must be empty" +rsErrCouldNotOpenDir: + EN="Could not open the directory <%s>" +rsErrItemOfWrongType: + EN="Item is not of <%s> type!" +rsErrFailedToCreateDir: + EN="Failed to create the directory <%s>" +rsErrNotAssigned: + EN="<%s> not assigned" +rsShortMon: + EN="Mon" +rsShortTue: + EN="Tue" +rsShortWed: + EN="Wed" +rsShortThu: + EN="Thu" +rsShortFri: + EN="Fri" +rsShortSat: + EN="Sat" +rsShortSun: + EN="Sun" +rsLongMon: + EN="Monday" +rsLongTue: + EN="Tuesday" +rsLongWed: + EN="Wednesday" +rsLongThu: + EN="Thursday" +rsLongFri: + EN="Friday" +rsLongSat: + EN="Saturday" +rsLongSun: + EN="Sunday" diff --git a/extras/contributed/ats/atstable.csv b/extras/contributed/ats/atstable.csv new file mode 100644 index 00000000..84dffa92 --- /dev/null +++ b/extras/contributed/ats/atstable.csv @@ -0,0 +1,92 @@ +"ATSF1","EN","RU","AF" +"rsLanguage","English","Русский","Afrikaans" +"rsOK","OK","OK","Goed" +"rsCancel","Cancel","Отмена","Kanseleer" +"rsHelp","Help","Справка","Help" +"rsOpen","Open","Открыть","Maak oop" +"rsSave","Save","Сохранить","Stoor" +"rsCreate","Create","Создать","" +"rsChange","Change","Изменить","" +"rsFind","Find","Найти","" +"rsSearch","Search","Поиск","" +"rsReplace","Replace","Заменить","" +"rsConfirm","Confirm","Подтвердить","" +"rsAll","All","Все","" +"rsSelect","Select","Выбрать","" +"rsYes","Yes","Да","" +"rsNo","No","Нет","Nee" +"rsAbort","Abort","Прервать","" +"rsRetry","Retry","Повторить","" +"rsIgnore","Ignore","Пропустить","" +"rsClose","Close","Закрыть","" +"rsInsert","Insert","Вставка","" +"rsEdit","Edit","Редактировать","" +"rsDelete","Delete","Удалить","" +"rsExit","Exit","Выход","" +"rsYesToAll","Yes to All","Да для всех","" +"rsNoToAll","No to All","Нет для всех","" +"rsCut","Cut","Вырезать","" +"rsCopy","Copy","Копировать","" +"rsPaste","Paste","Вставить","" +"rsError","Error","","" +"rsCriticalError","Critical Error","","" +"rsInformation","Information","","" +"rsConfirmation","Confirmation","","" +"rsWarning","Warning","","" +"rsMessage","Message","","" +"rsAbout","About %s","","" +"rsAllFiles","All Files","","" +"rsCreateDirectory","Create directory","","" +"rsEnterNewDirectory","Enter new directory name","","" +"rsCannotCreateDir","Cannot create directory","","" +"rsSelectAFont","Select a font","","" +"rsName","Name","","" +"rsCollection","Collection","","" +"rsSize","Size","","" +"rsStyle","Style","","" +"rsItalic","Italic","","" +"rsBold","Bold","","" +"rsUnderScore","UnderScore","","" +"rsTypeface","Typeface","","" +"rsAntiAliasing","Anti aliasing","","" +"rsExampleText","Example Text","","" +"rsCollectionAllFonts","All Fonts","","" +"rsCollectionRecentlyUsed","Recently Used","","" +"rsCollectionFavourites","Favourites","","" +"rsCollectionFixedWidth","Fixed Width","","" +"rsCollectionSans","Sans","","" +"rsCollectionSerif","Serif","","" +"rsCollectionFontAliases","Font Aliases","","" +"rsOpenAFile","Open a file","","" +"rsFileName","Filename","","" +"rsFileType","Type of file","","" +"rsDrive","Drive","","" +"rsFiles","Files","","" +"rsDirectories","Directories","","" +"rsShowHidden","Show hidden files","","" +"rsFileSelection","File Selection","","" +"rsFileModifiedTime","Mod. Time","","" +"rsFileAttributes","Attributes","","" +"rsFileRights","Rights","","" +"rsFileOwner","Owner","","" +"rsFileGroup","Group","","" +"rsSaveAFile","Save file as","","" +"rsErrListMustBeEmpty","List must be empty","","" +"rsErrCouldNotOpenDir","Could not open the directory <%s>","","" +"rsErrItemOfWrongType","Item is not of <%s> type!","","" +"rsErrFailedToCreateDir","Failed to create the directory <%s>","","" +"rsErrNotAssigned","<%s> not assigned","","" +"rsShortMon","Mon","","" +"rsShortTue","Tue","","" +"rsShortWed","Wed","","" +"rsShortThu","Thu","","" +"rsShortFri","Fri","","" +"rsShortSat","Sat","","" +"rsShortSun","Sun","","" +"rsLongMon","Monday","","" +"rsLongTue","Tuesday","","" +"rsLongWed","Wednesday","","" +"rsLongThu","Thursday","","" +"rsLongFri","Friday","","" +"rsLongSat","Saturday","","" +"rsLongSun","Sunday","","" \ No newline at end of file diff --git a/extras/contributed/ats/atstable.inc b/extras/contributed/ats/atstable.inc new file mode 100644 index 00000000..3a06923e --- /dev/null +++ b/extras/contributed/ats/atstable.inc @@ -0,0 +1,291 @@ +array[1..288] of string = ( + 'rsLanguage:' + ,' EN="English"' + ,' RU="Русский"' + ,' HU="Magyar"' + ,' AF="Afrikaans"' + ,'rsOK:' + ,' EN="OK"' + ,' RU="OK"' + ,' HU="OK"' + ,' AF="Goed"' + ,'rsCancel:' + ,' EN="Cancel"' + ,' RU="Отмена"' + ,' HU="Mégse"' + ,' AF="Kanselleer"' + ,'rsHelp:' + ,' EN="Help"' + ,' RU="Справка"' + ,' HU="Segítség"' + ,'rsOpen:' + ,' EN="Open"' + ,' RU="Открыть"' + ,' HU="Megnyitás"' + ,'rsSave:' + ,' EN="Save"' + ,' RU="Сохранить"' + ,' HU="Mentés"' + ,' AF="Stoor"' + ,'rsCreate:' + ,' EN="Create"' + ,' RU="Создать"' + ,' HU="Létrehoz"' + ,'rsChange:' + ,' EN="Change"' + ,' RU="Изменить"' + ,' HU="Változtat"' + ,' AF="Verander"' + ,'rsFind:' + ,' EN="Find"' + ,' RU="Найти"' + ,' HU="Talál"' + ,' AF="Vind"' + ,'rsSearch:' + ,' EN="Search"' + ,' RU="Поиск"' + ,' HU="Keres"' + ,' AF="Soek"' + ,'rsReplace:' + ,' EN="Replace"' + ,' RU="Заменить"' + ,' HU="Cserél"' + ,' AF="Vervang"' + ,'rsConfirm:' + ,' EN="Confirm"' + ,' RU="Подтвердить"' + ,' HU="Jóváhagy"' + ,'rsAll:' + ,' EN="All"' + ,' RU="Все"' + ,' HU="Mind"' + ,' AF="Alles"' + ,'rsSelect:' + ,' EN="Select"' + ,' RU="Выбрать"' + ,' HU="Kiválaszt"' + ,'rsYes:' + ,' EN="Yes"' + ,' RU="Да"' + ,' HU="Igen"' + ,' AF="Ja"' + ,'rsNo:' + ,' EN="No"' + ,' RU="Нет"' + ,' HU="Nem"' + ,' AF="Nee"' + ,'rsAbort:' + ,' EN="Abort"' + ,' RU="Прервать"' + ,' HU="Megszakít"' + ,'rsRetry:' + ,' EN="Retry"' + ,' RU="Повторить"' + ,' HU="Újra"' + ,'rsIgnore:' + ,' EN="Ignore"' + ,' RU="Пропустить"' + ,' HU="Kihagy"' + ,' AF="Ignoreer"' + ,'rsClose:' + ,' EN="Close"' + ,' RU="Закрыть"' + ,' HU="Bezár"' + ,' AF="Sluit"' + ,'rsInsert:' + ,' EN="Insert"' + ,' RU="Вставка"' + ,' HU="Beszúr"' + ,'rsEdit:' + ,' EN="Edit"' + ,' RU="Редактировать"' + ,' HU="Szerkeszt"' + ,'rsDelete:' + ,' EN="Delete"' + ,' RU="Удалить"' + ,' HU="Töröl"' + ,'rsExit:' + ,' EN="Exit"' + ,' RU="Выход"' + ,' HU="Kilép"' + ,' AF="Verlaat"' + ,'rsYesToAll:' + ,' EN="Yes to All"' + ,' RU="Да для всех"' + ,' HU="Mindre igen"' + ,'rsNoToAll:' + ,' EN="No to All"' + ,' RU="Нет для всех"' + ,' HU="Mindre nem"' + ,'rsCut:' + ,' EN="Cut"' + ,' RU="Вырезать"' + ,' HU="Kivág"' + ,'rsCopy:' + ,' EN="Copy"' + ,' RU="Копировать"' + ,' HU="Másol"' + ,'rsPaste:' + ,' EN="Paste"' + ,' RU="Вставить"' + ,' HU="Beilleszt"' + ,'rsError:' + ,' EN="Error"' + ,' HU="Hiba"' + ,'rsCriticalError:' + ,' EN="Critical Error"' + ,' HU="Kritikus hiba"' + ,'rsInformation:' + ,' EN="Information"' + ,' HU="Információ"' + ,'rsConfirmation:' + ,' EN="Confirmation"' + ,' HU="Megerősítés"' + ,'rsWarning:' + ,' EN="Warning"' + ,' HU="Figyelmeztetés"' + ,'rsMessage:' + ,' EN="Message"' + ,' HU="Üzenet"' + ,'rsAbout:' + ,' EN="About %s"' + ,' HU="About %s"' + ,'rsAllFiles:' + ,' EN="All Files"' + ,' HU="Összes fájl"' + ,'rsCreateDirectory:' + ,' EN="Create directory"' + ,' HU="Könyvtár létrehozása"' + ,'rsEnterNewDirectory:' + ,' EN="Enter new directory name"' + ,'rsCannotCreateDir:' + ,' EN="Cannot create directory"' + ,'rsSelectAFont:' + ,' EN="Select a font"' + ,'rsName:' + ,' EN="Name"' + ,' AF="Naam"' + ,'rsCollection:' + ,' EN="Collection"' + ,'rsSize:' + ,' EN="Size"' + ,' AF="Goote"' + ,'rsStyle:' + ,' EN="Style"' + ,' AF="Steil"' + ,'rsItalic:' + ,' EN="Italic"' + ,'rsBold:' + ,' EN="Bold"' + ,'rsUnderScore:' + ,' EN="UnderScore"' + ,'rsTypeface:' + ,' EN="Typeface"' + ,'rsAntiAliasing:' + ,' EN="Anti aliasing"' + ,'rsExampleText:' + ,' EN="Example Text"' + ,' AF="Voorbeeld Teks"' + ,'rsCollectionAllFonts:' + ,' EN="All Fonts"' + ,'rsCollectionRecentlyUsed:' + ,' EN="Recently Used"' + ,'rsCollectionFavourites:' + ,' EN="Favourites"' + ,'rsCollectionFixedWidth:' + ,' EN="Fixed Width"' + ,'rsCollectionSans:' + ,' EN="Sans"' + ,'rsCollectionSerif:' + ,' EN="Serif"' + ,'rsCollectionFontAliases:' + ,' EN="Font Aliases"' + ,'rsOpenAFile:' + ,' EN="Open a file"' + ,'rsFileName:' + ,' EN="Filename"' + ,'rsFileType:' + ,' EN="Type of file"' + ,'rsDrive:' + ,' EN="Drive"' + ,'rsFiles:' + ,' EN="Files"' + ,'rsDirectories:' + ,' EN="Directories"' + ,'rsShowHidden:' + ,' EN="Show hidden files"' + ,'rsFileSelection:' + ,' EN="File Selection"' + ,'rsFileModifiedTime:' + ,' EN="Mod. Time"' + ,'rsFileAttributes:' + ,' EN="Attributes"' + ,'rsFileRights:' + ,' EN="Rights"' + ,'rsFileOwner:' + ,' EN="Owner"' + ,'rsFileGroup:' + ,' EN="Group"' + ,'rsSaveAFile:' + ,' EN="Save file as"' + ,'rsErrListMustBeEmpty:' + ,' EN="List must be empty"' + ,'rsErrCouldNotOpenDir:' + ,' EN="Could not open the directory <%s>"' + ,'rsErrItemOfWrongType:' + ,' EN="Item is not of <%s> type!"' + ,'rsErrFailedToCreateDir:' + ,' EN="Failed to create the directory <%s>"' + ,'rsErrNotAssigned:' + ,' EN="<%s> not assigned"' + ,'rsShortMon:' + ,' EN="Mon"' + ,' HU="H"' + ,'rsShortTue:' + ,' EN="Tue"' + ,' HU="K"' + ,'rsShortWed:' + ,' EN="Wed"' + ,' HU="Sz"' + ,'rsShortThu:' + ,' EN="Thu"' + ,' HU="Cs"' + ,'rsShortFri:' + ,' EN="Fri"' + ,' HU="P"' + ,'rsShortSat:' + ,' EN="Sat"' + ,' HU="Szo"' + ,'rsShortSun:' + ,' EN="Sun"' + ,' HU="V"' + ,'rsLongMon:' + ,' EN="Monday"' + ,' HU="Hétfő"' + ,' AF="Maandag"' + ,'rsLongTue:' + ,' EN="Tuesday"' + ,' HU="Kedd"' + ,' AF="Dinsdag"' + ,'rsLongWed:' + ,' EN="Wednesday"' + ,' HU="Szerda"' + ,' AF="Woensdag"' + ,'rsLongThu:' + ,' EN="Thursday"' + ,' HU="Csütörtök"' + ,' AF="Donderdag"' + ,'rsLongFri:' + ,' EN="Friday"' + ,' HU="Péntek"' + ,' AF="Vrydag"' + ,'rsLongSat:' + ,' EN="Saturday"' + ,' HU="Szombat"' + ,' AF="Saterdag"' + ,'rsLongSun:' + ,' EN="Sunday"' + ,' HU="Vasárnap"' + ,' AF="Sondag"' + +); diff --git a/extras/contributed/ats/extrafpc.cfg b/extras/contributed/ats/extrafpc.cfg new file mode 100644 index 00000000..775d592f --- /dev/null +++ b/extras/contributed/ats/extrafpc.cfg @@ -0,0 +1,5 @@ +-FUunits +-Fu../../../lib/$fpctarget +-Xs +-XX +-CX diff --git a/extras/contributed/ats/ptrparsefunc.pas b/extras/contributed/ats/ptrparsefunc.pas new file mode 100644 index 00000000..7c2c0790 --- /dev/null +++ b/extras/contributed/ats/ptrparsefunc.pas @@ -0,0 +1,165 @@ +unit ptrparsefunc; + +interface + +procedure ppSkipSpaces(var ReadPtr : PChar; bufend : PChar); + +function ppReadLine(var ReadPtr : PChar; bufend : PChar; var LineLength : integer) : boolean; + +function ppReadTo(var ReadPtr : PChar; bufend : PChar; const stopchars : shortstring; var CharCount : integer) : boolean; + +function ppCheckSymbol(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring) : boolean; +function ppCheckSymbolCI(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring) : boolean; // case insensitive + +function ppSearchPattern(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring; + var distance : integer) : boolean; + +function ppMakeString(buf : pointer; len : integer) : string; + +implementation + +function ppMakeString(buf : pointer; len : integer) : string; +begin + SetLength(result, len); + if len > 0 then move(buf^, result[1], len); +end; + +procedure ppSkipSpaces(var ReadPtr : PChar; bufend : PChar); +begin + while (ReadPtr < bufend) and (ReadPtr^ in [#13,#10,#9,#32]) do + begin + inc(ReadPtr); + end; +end; + +function ppReadLine(var ReadPtr : PChar; bufend : PChar; var LineLength : integer) : boolean; +begin + LineLength := 0; + result := true; + while (ReadPtr < bufend) do + begin + if ReadPtr^ = #10 then + begin + // unix line end + inc(ReadPtr); + exit; + end + else if ReadPtr^ = #13 then + begin + // DOS or Mac line end + inc(ReadPtr); + if (ReadPtr < bufend) and (ReadPtr^ = #10) then inc(ReadPtr); // DOS line ending + Exit; + end; + inc(LineLength); + inc(ReadPtr); + end; + result := false; +end; + +function ppReadTo(var ReadPtr : PChar; bufend : PChar; const stopchars : shortstring; var CharCount : integer) : boolean; +begin + CharCount := 0; + while (ReadPtr < bufend) do + begin + if pos(ReadPtr^,stopchars) > 0 then + begin + result := true; + exit; + end; + inc(CharCount); + inc(ReadPtr); + end; + Result := false; +end; + + +function ppCheckSymbol(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring) : boolean; +var + rp : PChar; + cc : integer; +begin + result := false; + cc := 1; + rp := ReadPtr; + while rp < bufend do + begin + if checkstring[cc] <> rp^ then + begin + EXIT; + end + else if cc >= length(checkstring) then + begin + ReadPtr := rp; + inc(ReadPtr); + result := true; + EXIT; + end; + inc(cc); + inc(rp); + end; +end; + +function ppCheckSymbolCI(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring) : boolean; +var + rp : PChar; + cc : integer; +begin + result := false; + cc := 1; + rp := ReadPtr; + while rp < bufend do + begin + if UpCase(checkstring[cc]) <> UpCase(rp^) then + begin + EXIT; + end + else if cc >= length(checkstring) then + begin + ReadPtr := rp; + inc(ReadPtr); + result := true; + EXIT; + end; + inc(cc); + inc(rp); + end; +end; + +function ppSearchPattern(var ReadPtr : PChar; bufend : PChar; const checkstring : shortstring; + var distance : integer) : boolean; +var + rp, cstartp : PChar; + cc : integer; +begin + result := false; + cc := 1; + cstartp := ReadPtr; + rp := ReadPtr; + while rp < bufend do + begin + if checkstring[cc] <> rp^ then + begin + // try the next position + inc(cstartp); + rp := cstartp; + cc := 1; + end + else if cc >= length(checkstring) then + begin + inc(rp); + distance := rp - ReadPtr; + ReadPtr := rp; + result := true; + EXIT; + end + else + begin + inc(cc); + inc(rp); + end; + end; +end; + +end. + diff --git a/extras/contributed/ats/readme.txt b/extras/contributed/ats/readme.txt new file mode 100644 index 00000000..9e6941e6 --- /dev/null +++ b/extras/contributed/ats/readme.txt @@ -0,0 +1,10 @@ + +Name: ats (alternative translation strings) editor +Author: Nagy Viktor +Date: around 2006 +Description: +This uses a single file for all language translations. You can then +use the ats editor to edit that *.ats file. The editor was planned +to support *.ats, *.inc and *.csv file formats, but not all of them +are implemented. + -- cgit v1.2.3-70-g09d2