paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-28 05:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

Jedi Code Format: Keep breakpoint position by using a new diff tool. Issue #38196, patch from Domingo Galmés.

Browse Source 
git-svn-id: trunk@64347 -
This commit is contained in:
juha 2021-01-07 22:59:42 +00:00
parent 4d0ffa3d5e
commit 0e2c500f81
8 changed files with 1454 additions and 442 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2373,6 +2373,7 @@ components/jcf2/ReadWrite/CodeReader.pas svneol=native#text/pascal
components/jcf2/ReadWrite/CodeWriter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/ConvertTypes.pas svneol=native#text/pascal
components/jcf2/ReadWrite/Converter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/Diff.pas svneol=native#text/pascal
components/jcf2/ReadWrite/EditorConverter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/EditorReader.pas svneol=native#text/pascal
components/jcf2/ReadWrite/EditorWriter.pas svneol=native#text/pascal
@ -2382,6 +2383,7 @@ components/jcf2/ReadWrite/FileWriter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/StringsConverter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/StringsReader.pas svneol=native#text/pascal
components/jcf2/ReadWrite/StringsWriter.pas svneol=native#text/pascal
components/jcf2/ReadWrite/diffmerge.pas svneol=native#text/pascal
components/jcf2/Settings/JcfRegistrySettings.pas svneol=native#text/pascal
components/jcf2/Settings/JcfSetBase.pas svneol=native#text/pascal
components/jcf2/Settings/JcfSettings.pas svneol=native#text/pascal

701
components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk
View File

File diff suppressed because it is too large Load Diff

2
components/jcf2/IdePlugin/lazarus/jcfidelazarus.pas
View File

@ -41,7 +41,7 @@ uses
frClarifyCaseBlocks, frComments, frWarnings, frReservedCapsSettings,
frAnyCapsSettings, frIdentifierCapsSettings, frNotIdentifierCapsSettings,
frUnitCaps, frReplace, frUses, frTransform, frAsm, frPreProcessor,
jcfuiconsts, LazarusPackageIntf;
JcfUIConsts, Diff, diffmerge, LazarusPackageIntf;
implementation

7
components/jcf2/IdePlugin/lazarus/jcfidemain.pas
View File

@ -82,6 +82,9 @@ type
implementation
uses
diffmerge;
function FileIsAllowedType(const psFileName: string): boolean;
const
ALLOWED_FILE_TYPES: array[1..5] of string = ('.pas', '.pp', '.dpr', '.lpr', '.dpk');
@ -275,7 +278,7 @@ begin
while (wI > 1) and (fcConverter.OutputCode[wI] in [#10, #13, ' ']) do
Dec(wI);
outputstr := Copy(fcConverter.OutputCode, 1, wI);
srcEditor.ReplaceLines(BlockBegin.Y, BlockEnd.Y, outputstr, false);
DiffMergeEditor(srcEditor,outputstr,BlockBegin.Y,BlockEnd.Y);
end
else
begin //try formating wrapping selected code in fake unit.
@ -291,7 +294,7 @@ begin
fcConverter.GuiMessages := true;
fcConverter.ConvertUsingFakeUnit;
if not fcConverter.ConvertError then
srcEditor.ReplaceText(BlockBegin, BlockEnd, fcConverter.OutputCode);
DiffMergeEditor(srcEditor,fcConverter.OutputCode,BlockBegin.Y,BlockEnd.Y);
end;
finally
fcConverter.Free;

11
components/jcf2/ReadWrite/Converter.pas
View File

@ -392,14 +392,17 @@ begin
{ put markers into the input }
fsInputCode := StrInsert(FORMAT_END, fsInputCode, liRealInputEnd);
fsInputCode := StrInsert(FORMAT_START, fsInputCode, liRealInputStart);
{ add a new line after FORMAT_START, prevents bad formating of first selected line. }
fsInputCode := StrInsert(FORMAT_START+#10, fsInputCode, liRealInputStart);
Convert;
{ locate the markers in the output, and replace before and after }
liOutputStart := Pos(FORMAT_START, fsOutputCode) + Length(FORMAT_START);
{remode new line added after FORMAT_START }
if (liOutputStart<length(fsOutputCode)) and (fsOutputCode[liOutputStart]=#13) then
inc(liOutputStart);
if (liOutputStart<length(fsOutputCode)) and (fsOutputCode[liOutputStart]=#10) then
inc(liOutputStart);
liOutputEnd := PosEx(FORMAT_END, fsOutputCode,liOutputStart);
{ splice }
if aOnlyOutputSelection then
lsNewOutput := Copy(fsOutputCode, liOutputStart, (liOutputEnd - liOutputStart))

882
components/jcf2/ReadWrite/Diff.pas Normal file
View File

@ -0,0 +1,882 @@
unit Diff;
{$mode delphi}{$H+}
(*******************************************************************************
* Component TDiff *
* Version: 5.03 *
* Date: 23 May 2020 *
* Compilers: FPC 3.0+ *
* Author: Angus Johnson - angusj-AT-myrealbox-DOT-com *
* Copyright: © 2001-2009 Angus Johnson *
* Updated by: Rickard Johansson (RJ TextEd) *
* *
* Licence to use, terms and conditions: *
* The code in the TDiff component is released as freeware *
* provided you agree to the following terms & conditions: *
* 1. the copyright notice, terms and conditions are *
* left unchanged *
* 2. modifications to the code by other authors must be *
* clearly documented and accompanied by the modifier's name. *
* 3. the TDiff component may be freely compiled into binary *
* format and no acknowledgement is required. However, a *
* discrete acknowledgement would be appreciated (eg. in a *
* program's 'About Box'). *
* *
* Description: Component to list differences between two integer arrays *
* using a "longest common subsequence" algorithm. *
* Typically, this component is used to diff 2 text files *
* once their individuals lines have been hashed. *
* *
* Acknowledgements: The key algorithm in this component is based on: *
* "An O(NP) Sequence Comparison Algorithm" *
* by Sun Wu, Udi Manber & Gene Myers *
* and uses a "divide-and-conquer" technique to avoid *
* using exponential amounts of memory as described in *
* "An O(ND) Difference Algorithm and its Variations" *
* By E Myers - Algorithmica Vol. 1 No. 2, 1986, pp. 251-266 *
*******************************************************************************)
(*******************************************************************************
* History: *
* 13 December 2001 - Original release (used Myer's O(ND) Difference Algorithm) *
* 22 April 2008 - Complete rewrite to greatly improve the code and *
* provide a much simpler view of differences through a new *
* 'Compares' property. *
* 21 May 2008 - Another complete code rewrite to use Sun Wu et al.'s *
* O(NP) Sequence Comparison Algorithm which more than *
* halves times of typical comparisons. *
* 24 May 2008 - Reimplemented "divide-and-conquer" technique (which was *
* omitted in 21 May release) so memory use is again minimal.*
* 25 May 2008 - Removed recursion to avoid the possibility of running out *
* of stack memory during massive comparisons. *
* 2 June 2008 - Bugfix: incorrect number of appended AddChangeInt() calls *
* in Execute() for integer arrays. (It was OK with Chars) *
* Added check to prevent repeat calls to Execute() while *
* already executing. *
* Added extra parse of differences to find occasional *
* missed matches. (See readme.txt for further discussion) *
* 7 November 2009 - Updated so now compiles in newer versions of Delphi. *
* *
* 11 November 2018 - Added TList<Cardinal> to store hash values *
* Made some minor code formatting and code changes *
* 19 May 2020 Added Lazarus support *
* 23 May 2020 - Minor changes and fixed an issue in AddChangeChr() *
* 7 January 2021 - Removed Delphi support from version copied to JCF package *
* under Lazarus sources. Use TCardinalList from LazUtils. *
* by Juha Manninen. *
*******************************************************************************)
interface
uses
Classes, SysUtils,
// LCL
Forms,
// LazUtils
IntegerList;
const
MAX_DIAGONAL = $FFFFFF; //~16 million
type
P8Bits = PByte;
PDiags = ^TDiags;
TDiags = array [-MAX_DIAGONAL .. MAX_DIAGONAL] of integer;
TChangeKind = (ckNone, ckAdd, ckDelete, ckModify);
PCompareRec = ^TCompareRec;
TCompareRec = record
Kind : TChangeKind;
oldIndex1 : Integer;
oldIndex2 : Integer;
case boolean of
false : (chr1, chr2 : Char);
true : (int1, int2 : Cardinal);
end;
PDiffVars = ^TDiffVars;
TDiffVars = record
offset1 : integer;
offset2 : integer;
len1 : integer;
len2 : integer;
end;
TDiffStats = record
matches : integer;
adds : integer;
deletes : integer;
modifies : integer;
end;
TDiff = class(TComponent)
private
FCompareList: TList;
FDiffList: TList; //this TList circumvents the need for recursion
FCancelled: boolean;
FExecuting: boolean;
FCompareInts: boolean; //ie are we comparing integer arrays or char arrays
DiagBufferF: pointer;
DiagBufferB: pointer;
DiagF, DiagB: PDiags;
FDiffStats: TDiffStats;
FLastCompareRec: TCompareRec;
FList1: TCardinalList;
FList2: TCardinalList;
FStr1: string;
FStr2: string;
procedure PushDiff(offset1, offset2, len1, len2: integer);
function PopDiff: boolean;
procedure InitDiagArrays(len1, len2: integer);
procedure DiffInt(offset1, offset2, len1, len2: integer);
procedure DiffChr(offset1, offset2, len1, len2: integer);
function SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean;
function SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean;
function SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean;
function SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean;
procedure AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind);
procedure AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind);
function GetCompareCount: integer;
function GetCompare(index: integer): TCompareRec;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
// Compare strings or list of Cardinals ...
function Execute(const alist1, alist2: TCardinalList): boolean; overload;
function Execute(const s1, s2: string): boolean; overload;
// Cancel allows interrupting excessively prolonged comparisons
procedure Cancel;
procedure Clear;
property Cancelled: boolean read FCancelled;
property Count: integer read GetCompareCount;
property Compares[index: integer]: TCompareRec read GetCompare; default;
property DiffStats: TDiffStats read FDiffStats;
end;
implementation
{
procedure Register;
begin
RegisterComponents('Samples', [TDiff]);
end;
}
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor TDiff.Create(aOwner: TComponent);
begin
inherited;
FCompareList := TList.create;
FDiffList := TList.Create;
end;
//------------------------------------------------------------------------------
destructor TDiff.Destroy;
begin
Clear;
FCompareList.free;
FDiffList.Free;
inherited;
end;
//------------------------------------------------------------------------------
function TDiff.Execute(const alist1, alist2: TCardinalList): boolean;
var
i, Len1Minus1: integer;
len1,len2: Integer;
begin
Result := not FExecuting;
if not Result then exit;
FCancelled := false;
FExecuting := true;
try
FList1 := alist1;
FList2 := alist2;
len1 := FList1.Count;
len2 := FList2.Count;
Clear;
Len1Minus1 := len1 -1;
FCompareList.Capacity := len1 + len2;
FCompareInts := true;
GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3));
GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3));
try
PushDiff(0, 0, len1, len2);
while PopDiff do;
finally
freeMem(DiagBufferF);
freeMem(DiagBufferB);
end;
if FCancelled then
begin
Result := false;
Clear;
exit;
end;
//correct the occasional missed match ...
for i := 1 to count -1 do
with PCompareRec(FCompareList[i])^ do
if (Kind = ckModify) and (int1 = int2) then
begin
Kind := ckNone;
Dec(FDiffStats.modifies);
Inc(FDiffStats.matches);
end;
//finally, append any trailing matches onto compareList ...
with FLastCompareRec do
AddChangeInt(oldIndex1,len1Minus1-oldIndex1, ckNone);
finally
FExecuting := false;
end;
end;
//------------------------------------------------------------------------------
function TDiff.Execute(const s1, s2: string): boolean;
var
i, Len1Minus1: integer;
len1,len2: Integer;
begin
Result := not FExecuting;
if not Result then exit;
FCancelled := false;
FExecuting := true;
try
Clear;
len1 := Length(s1);
len2 := Length(s2);
Len1Minus1 := len1 -1;
FCompareList.Capacity := len1 + len2;
FDiffList.Capacity := 1024;
FCompareInts := false;
GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3));
GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3));
FStr1 := s1;
FStr2 := s2;
try
PushDiff(1, 1, len1, len2);
while PopDiff do;
finally
freeMem(DiagBufferF);
freeMem(DiagBufferB);
end;
if FCancelled then
begin
Result := false;
Clear;
exit;
end;
//correct the occasional missed match ...
for i := 1 to count -1 do
with PCompareRec(FCompareList[i])^ do
if (Kind = ckModify) and (chr1 = chr2) then
begin
Kind := ckNone;
Dec(FDiffStats.modifies);
Inc(FDiffStats.matches);
end;
//finally, append any trailing matches onto compareList ...
with FLastCompareRec do
begin
AddChangeChr(oldIndex1,len1Minus1-oldIndex1, ckNone);
end;
finally
FExecuting := false;
end;
end;
//------------------------------------------------------------------------------
procedure TDiff.PushDiff(offset1, offset2, len1, len2: integer);
var
DiffVars: PDiffVars;
begin
new(DiffVars);
DiffVars.offset1 := offset1;
DiffVars.offset2 := offset2;
DiffVars.len1 := len1;
DiffVars.len2 := len2;
FDiffList.Add(DiffVars);
end;
//------------------------------------------------------------------------------
function TDiff.PopDiff: boolean;
var
DiffVars: PDiffVars;
idx: integer;
begin
idx := FDiffList.Count -1;
Result := idx >= 0;
if not Result then exit;
DiffVars := PDiffVars(FDiffList[idx]);
with DiffVars^ do
if FCompareInts then
DiffInt(offset1, offset2, len1, len2) else
DiffChr(offset1, offset2, len1, len2);
Dispose(DiffVars);
FDiffList.Delete(idx);
end;
//------------------------------------------------------------------------------
procedure TDiff.InitDiagArrays(len1, len2: integer);
var
i: integer;
begin
//assumes that top and bottom matches have been excluded
P8Bits(DiagF) := P8Bits(DiagBufferF) - sizeof(integer)*(MAX_DIAGONAL-(len1+1));
for i := - (len1+1) to (len2+1) do
DiagF^[i] := -MAXINT;
DiagF^[1] := -1;
P8Bits(DiagB) := P8Bits(DiagBufferB) - sizeof(integer)*(MAX_DIAGONAL-(len1+1));
for i := - (len1+1) to (len2+1) do
DiagB^[i] := MAXINT;
DiagB^[len2-len1+1] := len2;
end;
//------------------------------------------------------------------------------
procedure TDiff.DiffInt(offset1, offset2, len1, len2: integer);
var
p, k, delta: integer;
begin
if offset1+len1 > FList1.Count then len1 := FList1.Count - offset1;
if offset2+len2 > FList2.Count then len2 := FList2.Count - offset2;
//trim matching bottoms ...
while (len1 > 0) and (len2 > 0) and (FList1[offset1] = FList2[offset2]) do
begin
inc(offset1); inc(offset2); dec(len1); dec(len2);
end;
//trim matching tops ...
while (len1 > 0) and (len2 > 0) and (FList1[offset1+len1-1] = FList2[offset2+len2-1]) do
begin
dec(len1); dec(len2);
end;
//stop diff'ing if minimal conditions reached ...
if (len1 = 0) then
begin
AddChangeInt(offset1 ,len2, ckAdd);
exit;
end
else if (len2 = 0) then
begin
AddChangeInt(offset1 ,len1, ckDelete);
exit;
end
else if (len1 = 1) and (len2 = 1) then
begin
AddChangeInt(offset1, 1, ckDelete);
AddChangeInt(offset1, 1, ckAdd);
exit;
end;
p := -1;
delta := len2 - len1;
InitDiagArrays(len1, len2);
if delta < 0 then
begin
repeat
inc(p);
if (p mod 1024) = 1023 then
begin
Application.ProcessMessages;
if FCancelled then exit;
end;
//nb: the Snake order is important here
for k := p downto delta +1 do
if SnakeIntF(k,offset1,offset2,len1,len2) then exit;
for k := -p + delta to delta-1 do
if SnakeIntF(k,offset1,offset2,len1,len2) then exit;
for k := delta -p to -1 do
if SnakeIntB(k,offset1,offset2,len1,len2) then exit;
for k := p downto 1 do
if SnakeIntB(k,offset1,offset2,len1,len2) then exit;
if SnakeIntF(delta,offset1,offset2,len1,len2) then exit;
if SnakeIntB(0,offset1,offset2,len1,len2) then exit;
until(false);
end else
begin
repeat
inc(p);
if (p mod 1024) = 1023 then
begin
Application.ProcessMessages;
if FCancelled then exit;
end;
//nb: the Snake order is important here
for k := -p to delta -1 do
if SnakeIntF(k,offset1,offset2,len1,len2) then exit;
for k := p + delta downto delta +1 do
if SnakeIntF(k,offset1,offset2,len1,len2) then exit;
for k := delta + p downto 1 do
if SnakeIntB(k,offset1,offset2,len1,len2) then exit;
for k := -p to -1 do
if SnakeIntB(k,offset1,offset2,len1,len2) then exit;
if SnakeIntF(delta,offset1,offset2,len1,len2) then exit;
if SnakeIntB(0,offset1,offset2,len1,len2) then exit;
until(false);
end;
end;
//------------------------------------------------------------------------------
procedure TDiff.DiffChr(offset1, offset2, len1, len2: integer);
var
p, k, delta: integer;
begin
//trim matching bottoms ...
while (len1 > 0) and (len2 > 0) and (FStr1[offset1] = FStr2[offset2]) do
begin
inc(offset1); inc(offset2); dec(len1); dec(len2);
end;
//trim matching tops ...
while (len1 > 0) and (len2 > 0) and (FStr1[offset1+len1-1] = FStr2[offset2+len2-1]) do
begin
dec(len1); dec(len2);
end;
//stop diff'ing if minimal conditions reached ...
if (len1 = 0) then
begin
AddChangeChr(offset1 ,len2, ckAdd);
exit;
end
else if (len2 = 0) then
begin
AddChangeChr(offset1, len1, ckDelete);
exit;
end
else if (len1 = 1) and (len2 = 1) then
begin
AddChangeChr(offset1, 1, ckDelete);
AddChangeChr(offset1, 1, ckAdd);
exit;
end;
p := -1;
delta := len2 - len1;
InitDiagArrays(len1, len2);
if delta < 0 then
begin
repeat
inc(p);
if (p mod 1024 = 1023) then
begin
Application.ProcessMessages;
if FCancelled then exit;
end;
//nb: the Snake order is important here
for k := p downto delta +1 do
if SnakeChrF(k,offset1,offset2,len1,len2) then exit;
for k := -p + delta to delta-1 do
if SnakeChrF(k,offset1,offset2,len1,len2) then exit;
for k := delta -p to -1 do
if SnakeChrB(k,offset1,offset2,len1,len2) then exit;
for k := p downto 1 do
if SnakeChrB(k,offset1,offset2,len1,len2) then exit;
if SnakeChrF(delta,offset1,offset2,len1,len2) then exit;
if SnakeChrB(0,offset1,offset2,len1,len2) then exit;
until(false);
end else
begin
repeat
inc(p);
if (p mod 1024 = 1023) then
begin
Application.ProcessMessages;
if FCancelled then exit;
end;
//nb: the Snake order is important here
for k := -p to delta -1 do
if SnakeChrF(k,offset1,offset2,len1,len2) then exit;
for k := p + delta downto delta +1 do
if SnakeChrF(k,offset1,offset2,len1,len2) then exit;
for k := delta + p downto 1 do
if SnakeChrB(k,offset1,offset2,len1,len2) then exit;
for k := -p to -1 do
if SnakeChrB(k,offset1,offset2,len1,len2) then exit;
if SnakeChrF(delta,offset1,offset2,len1,len2) then exit;
if SnakeChrB(0,offset1,offset2,len1,len2) then exit;
until(false);
end;
end;
//------------------------------------------------------------------------------
function TDiff.SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean;
var
x,y: integer;
begin
if DiagF[k+1] > DiagF[k-1] then
y := DiagF[k+1] else
y := DiagF[k-1]+1;
x := y - k;
while (x < len1-1) and (y < len2-1) and (FStr1[offset1+x+1] = FStr2[offset2+y+1]) do
begin
inc(x); inc(y);
end;
DiagF[k] := y;
Result := (DiagF[k] >= DiagB[k]);
if not Result then exit;
inc(x); inc(y);
PushDiff(offset1+x, offset2+y, len1-x, len2-y);
PushDiff(offset1, offset2, x, y);
end;
//------------------------------------------------------------------------------
function TDiff.SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean;
var
x,y: integer;
begin
if DiagB[k-1] < DiagB[k+1] then
y := DiagB[k-1]
else
y := DiagB[k+1]-1;
x := y - k;
while (x >= 0) and (y >= 0) and (FStr1[offset1+x] = FStr2[offset2+y]) do
begin
dec(x); dec(y);
end;
DiagB[k] := y;
Result := DiagB[k] <= DiagF[k];
if not Result then exit;
inc(x); inc(y);
PushDiff(offset1+x, offset2+y, len1-x, len2-y);
PushDiff(offset1, offset2, x, y);
end;
//------------------------------------------------------------------------------
function TDiff.SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean;
var
x,y: integer;
begin
if DiagF^[k+1] > DiagF^[k-1] then
y := DiagF^[k+1]
else
y := DiagF^[k-1]+1;
x := y - k;
while (x < len1-1) and (y < len2-1) and (FList1[offset1+x+1] = FList2[offset2+y+1]) do
begin
inc(x); inc(y);
end;
DiagF^[k] := y;
Result := (DiagF^[k] >= DiagB^[k]);
if not Result then exit;
inc(x); inc(y);
PushDiff(offset1+x, offset2+y, len1-x, len2-y);
PushDiff(offset1, offset2, x, y);
end;
//------------------------------------------------------------------------------
function TDiff.SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean;
var
x,y: integer;
begin
if DiagB^[k-1] < DiagB^[k+1] then
y := DiagB^[k-1]
else
y := DiagB^[k+1]-1;
x := y - k;
while (x >= 0) and (y >= 0) and (FList1[offset1+x] = FList2[offset2+y]) do
begin
dec(x); dec(y);
end;
DiagB^[k] := y;
Result := DiagB^[k] <= DiagF^[k];
if not Result then exit;
inc(x); inc(y);
PushDiff(offset1+x, offset2+y, len1-x, len2-y);
PushDiff(offset1, offset2, x, y);
end;
//------------------------------------------------------------------------------
procedure TDiff.AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind);
var
i,j: integer;
compareRec: PCompareRec;
begin
//first, add any unchanged items into this list ...
while (FLastCompareRec.oldIndex1 < offset1 -1) do
begin
with FLastCompareRec do
begin
chr1 := #0;
chr2 := #0;
Kind := ckNone;
inc(oldIndex1);
inc(oldIndex2);
if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then
chr1 := FStr1[oldIndex1];
if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then
chr2 := FStr2[oldIndex2];
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.matches);
end;
case ChangeKind of
ckNone:
for i := 1 to range do
begin
with FLastCompareRec do
begin
Kind := ckNone;
inc(oldIndex1);
inc(oldIndex2);
chr1 := FStr1[oldIndex1];
chr2 := FStr2[oldIndex2];
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.matches);
end;
ckAdd :
begin
for i := 1 to range do
begin
with FLastCompareRec do
begin
//check if a range of adds are following a range of deletes
//and convert them to modifies ...
if Kind = ckDelete then
begin
j := FCompareList.Count -1;
while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do
dec(j);
PCompareRec(FCompareList[j]).Kind := ckModify;
dec(FDiffStats.deletes);
inc(FDiffStats.modifies);
inc(FLastCompareRec.oldIndex2);
PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2;
PCompareRec(FCompareList[j]).chr2 := FStr2[oldIndex2];
if j = FCompareList.Count-1 then
FLastCompareRec.Kind := ckModify;
continue;
end;
Kind := ckAdd;
chr1 := #0;
inc(oldIndex2);
chr2 := FStr2[oldIndex2]; //ie what we added
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.adds);
end;
end;
ckDelete :
begin
for i := 1 to range do
begin
with FLastCompareRec do
begin
//check if a range of deletes are following a range of adds
//and convert them to modifies ...
if Kind = ckAdd then
begin
j := FCompareList.Count -1;
while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do
dec(j);
PCompareRec(FCompareList[j]).Kind := ckModify;
dec(FDiffStats.adds);
inc(FDiffStats.modifies);
inc(FLastCompareRec.oldIndex1);
PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1;
PCompareRec(FCompareList[j]).chr1 := FStr1[oldIndex1];
if j = FCompareList.Count-1 then
FLastCompareRec.Kind := ckModify;
continue;
end;
Kind := ckDelete;
chr2 := #0;
inc(oldIndex1);
chr1 := FStr1[oldIndex1]; //ie what we deleted
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.deletes);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TDiff.AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind);
var
i,j: integer;
compareRec: PCompareRec;
begin
//first, add any unchanged items into this list ...
while (FLastCompareRec.oldIndex1 < offset1 -1) do
begin
with FLastCompareRec do
begin
Kind := ckNone;
inc(oldIndex1);
inc(oldIndex2);
if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then
int1 := FList1[oldIndex1];
if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then
int2 := FList2[oldIndex2];
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.matches);
end;
case ChangeKind of
ckNone:
for i := 1 to range do
begin
with FLastCompareRec do
begin
Kind := ckNone;
inc(oldIndex1);
inc(oldIndex2);
if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then
int1 := FList1[oldIndex1];
if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then
int2 := FList2[oldIndex2];
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.matches);
end;
ckAdd :
begin
for i := 1 to range do
begin
with FLastCompareRec do
begin
//check if a range of adds are following a range of deletes
//and convert them to modifies ...
if Kind = ckDelete then
begin
j := FCompareList.Count -1;
while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do
dec(j);
PCompareRec(FCompareList[j]).Kind := ckModify;
dec(FDiffStats.deletes);
inc(FDiffStats.modifies);
inc(FLastCompareRec.oldIndex2);
PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2;
PCompareRec(FCompareList[j]).int2 := FList2[oldIndex2];
if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify;
continue;
end;
Kind := ckAdd;
int1 := $0;
inc(oldIndex2);
if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then
int2 := FList2[oldIndex2]; //ie what we added
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.adds);
end;
end;
ckDelete :
begin
for i := 1 to range do
begin
with FLastCompareRec do
begin
//check if a range of deletes are following a range of adds
//and convert them to modifies ...
if Kind = ckAdd then
begin
j := FCompareList.Count -1;
while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do
dec(j);
PCompareRec(FCompareList[j]).Kind := ckModify;
dec(FDiffStats.adds);
inc(FDiffStats.modifies);
inc(FLastCompareRec.oldIndex1);
PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1;
PCompareRec(FCompareList[j]).int1 := FList1[oldIndex1];
if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify;
continue;
end;
Kind := ckDelete;
int2 := $0;
inc(oldIndex1);
if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then
int1 := FList1[oldIndex1]; //ie what we deleted
end;
New(compareRec);
compareRec^ := FLastCompareRec;
FCompareList.Add(compareRec);
inc(FDiffStats.deletes);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TDiff.Clear;
var
i: integer;
begin
for i := 0 to FCompareList.Count-1 do
dispose(PCompareRec(FCompareList[i]));
FCompareList.clear;
FLastCompareRec.Kind := ckNone;
FLastCompareRec.oldIndex1 := -1;
FLastCompareRec.oldIndex2 := -1;
FDiffStats.matches := 0;
FDiffStats.adds := 0;
FDiffStats.deletes :=0;
FDiffStats.modifies :=0;
end;
//------------------------------------------------------------------------------
function TDiff.GetCompareCount: integer;
begin
Result := FCompareList.count;
end;
//------------------------------------------------------------------------------
function TDiff.GetCompare(index: integer): TCompareRec;
begin
Result := PCompareRec(FCompareList[index])^;
end;
//------------------------------------------------------------------------------
procedure TDiff.Cancel;
begin
FCancelled := true;
end;
//------------------------------------------------------------------------------
end.

91
components/jcf2/ReadWrite/EditorConverter.pas
View File

@ -34,7 +34,7 @@ See http://www.gnu.org/licenses/gpl.html
interface
uses
Classes, SysUtils, Math,
Classes, SysUtils,
// IdeIntf
SrcEditorIntf,
{ local }
@ -85,7 +85,7 @@ implementation
uses
{ local }
JcfLog, JcfRegistrySettings, JcfMiscFunctions;
JcfLog, JcfRegistrySettings, diffmerge;
constructor TEditorConverter.Create;
begin
@ -136,98 +136,13 @@ begin
end;
procedure TEditorConverter.WriteToIDE(const pcUnit: TSourceEditorInterface; const psText: string);
var
lLogicalCaretXY:TPoint;
lStart,lEnd:TPoint;
begin
if pcUnit = nil then
exit;
if psText <> fcConverter.InputCode then
begin
try
lLogicalCaretXY:=pcUnit.CursorTextXY;
pcUnit.BeginUpdate;
pcUnit.BeginUndoBlock;
lStart.X:=0; //select all text.
lStart.Y:=0;
lEnd.X:=0;
if pcUnit.LineCount>0 then
lEnd.X:=length(pcUnit.Lines[pcUnit.LineCount-1])+1;
lEnd.Y:=pcUnit.LineCount;
//pcUnit.Lines.Text := psText; // removes undo history.
pcUnit.ReplaceText(lStart,lEnd,psText);
pcUnit.CursorTextXY:=lLogicalCaretXY;
pcUnit.Modified := True;
finally
pcUnit.EndUndoBlock;
pcUnit.EndUpdate;
end;
end;
DiffMergeEditor(pcUnit, psText);
end;
//BUGGY: inserts empty blank lines in "random" position in the editor.
// and if only one line es added or deleted after formatting then doesn't syncronize well.
// i think is better change all text in the editor.
// TODO: delete
{
procedure TEditorConverter.WriteToIDE(const pcUnit: TSourceEditorInterface; const psText: string);
var
lcSourceLines, lcDestLines: TStrings;
lcSameStart, lcSameEnd: TStrings;
lsSourceLine, lsDestLine: string;
liStart, liIndex, liMaxIndex: integer;
hasSourceLine: Boolean;
begin
if pcUnit = nil then
exit;
lcSourceLines := TStringList.Create;
lcSourceLines.Text := fcConverter.InputCode;
lcDestLines := TStringList.Create;
lcDestLines.Text := psText;
lcSameStart := TStringList.Create;
lcSameEnd := TStringList.Create;
SplitIntoChangeSections(lcSourceLines, lcDestLines, lcSameStart, lcSameEnd);
try
pcUnit.BeginUpdate;
pcUnit.BeginUndoBlock;
liStart := lcSameStart.Count;
liIndex := 0;
liMaxIndex := Max(lcSourceLines.Count, lcDestLines.Count);
while (liIndex < liMaxIndex) do
begin
hasSourceLine := liIndex < lcSourceLines.Count;
if hasSourceLine then
lsSourceLine := lcSourceLines[liIndex]
else
lsSourceLine := '';
if liIndex < lcDestLines.Count then
lsDestLine := lcDestLines[liIndex]
else
lsDestLine := '';
if not hasSourceLine then
pcUnit.InsertLine(liStart + liIndex + 1, lsDestLine, True)
else
if not AnsiSameStr(lsSourceLine, lsDestLine) then
// the line is different, replace it
pcUnit.ReplaceLines(liStart + liIndex + 1, liStart + liIndex + 1, lsDestLine, True);
inc(liIndex);
end;
finally
pcUnit.EndUndoBlock;
pcUnit.EndUpdate;
lcSourceLines.Free;
lcDestLines.Free;
lcSameStart.Free;
lcSameEnd.Free;
end;
end;
}
procedure TEditorConverter.AfterConvert;
begin
FinalSummary;

200
components/jcf2/ReadWrite/diffmerge.pas Normal file
View File

@ -0,0 +1,200 @@
{
/***************************************************************************
diffmerge.pas - functions to merge new text with the JCF changes into the
editor
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Author: Domingo Galmés
Abstract:
Methods for creating diffs and applying them to the editor.
Uses TextDiff
https://github.com/rickard67/TextDiff
http://www.angusj.com/delphi/textdiff.html
Author : Angus Johnson - angusj-AT-myrealbox-DOT-com
Copyright : © 2001-2008 Angus Johnson
Updated by : Rickard Johansson (RJ TextEd)
}
unit diffmerge;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, crc,
// LazUtils
IntegerList,
// IdeIntf
SrcEditorIntf,
Diff;
procedure DiffMergeEditor(aEdit: TSourceEditorInterface; const aNewText: string; aFromLine: integer = 1; aToLine: integer = maxint);
implementation
function HashLine(const line: string; aIgnoreFinalSpaces: boolean = False): cardinal;
var
lLen: integer;
begin
lLen := Length(line);
if aIgnoreFinalSpaces then
begin
while (lLen > 0) and (line[lLen] in [' ', #9]) do
Dec(lLen);
end;
if lLen = 0 then
Result := CRC32(0, nil, lLen)
else
Result := CRC32(0, pbyte(@line[1]), lLen);
end;
//Line number 1 based as TSourceEditorInterface.
procedure FillHashList(aList: TCardinalList; aLines: TStrings; aFirstLine: integer = 1; aLastLine: integer = maxint);
var
i: integer;
begin
aList.Clear;
Dec(aFirstLine);
Dec(aLastLine);
if aFirstLine < 0 then
aFirstLine := 0;
if aLastLine > aLines.Count - 1 then
aLastLine := aLines.Count - 1;
for i := aFirstLine to aLastLine do
aList.Add(HashLine(aLines[i]));
end;
function EditorGetLastColumn(aEdit: TSourceEditorInterface; aLineNumber: integer): integer;
begin
Result := length(aEdit.Lines[aLineNumber - 1]) + 1;
end;
procedure EditorDeleteLine(aEdit: TSourceEditorInterface; aLineNumber: integer);
var
lStartPoint, lEndPoint: Tpoint;
begin
if (aLineNumber < 0) or (aLineNumber > aEdit.Lines.Count) then
Exit;
lStartPoint.X := 1;
lStartPoint.Y := aLineNumber;
lEndPoint.X := 1;
lEndPoint.Y := aLineNumber + 1;
if lEndPoint.Y > aEdit.Lines.Count then
begin
lEndPoint.Y := aLineNumber;
lEndPoint.X := EditorGetLastColumn(aEdit, aLineNumber);
if aLineNumber > 1 then
begin
lStartPoint.X := EditorGetLastColumn(aEdit, aLineNumber - 1);
lStartPoint.Y := aLineNumber - 1;
end;
end;
aEdit.ReplaceText(lStartPoint, lEndPoint, '');
end;
procedure EditorInsertLine(aEdit: TSourceEditorInterface; aLineNumber: integer; aText: string);
begin
aEdit.InsertLine(aLineNumber, aText, True);
end;
procedure EditorReplaceLine(aEdit: TSourceEditorInterface; aLineNumber: integer; aNewText: string);
begin
aEdit.ReplaceLines(aLineNumber, aLineNumber, aNewText, True);
end;
procedure DiffMergeEditor(aEdit: TSourceEditorInterface; const aNewText: string; aFromLine: integer = 1; aToLine: integer = maxint);
var
lDiff: TDiff;
lI: integer;
lListOldTextHashes, lListNewTextHashes: TCardinalList;
lDeltaLines: integer;
lStartLine: integer;
lNewText: TStringList;
lCursor: TPoint;
lCursorAdjusted: boolean;
lCursorNeedAdjustX: boolean;
begin
lDiff := nil;
lNewText := nil;
lListOldTextHashes := nil;
lListNewTextHashes := nil;
lDeltaLines := 0;
lStartLine := aFromLine - 1; // 0 based offset.
lCursor := aEdit.CursorTextXY;
lCursorAdjusted := False;
lCursorNeedAdjustX := False;
try
aEdit.BeginUpdate;
aEdit.BeginUndoBlock;
lDiff := TDiff.Create(nil);
lNewText := TStringList.Create;
lNewText.Text := aNewText;
lListOldTextHashes := TCardinalList.Create;
lListNewTextHashes := TCardinalList.Create;
FillHashList(lListOldTextHashes, aEdit.Lines, aFromLine, aToLine);
FillHashList(lListNewTextHashes, lNewText);
lDiff.Execute(lListOldTextHashes, lListNewTextHashes);
for lI := 0 to lDiff.Count - 1 do
begin
with lDiff.Compares[lI] do
begin
if (lCursorAdjusted = False) and (lCursor.Y = lStartLine + oldIndex1 + 1) then
begin
lCursor.Y := lCursor.Y + lDeltaLines;
lCursorAdjusted := True;
lCursorNeedAdjustX := Kind <> ckNone;
end;
case Kind of
ckAdd:
begin
EditorInsertLine(aEdit, lStartLine + oldIndex2 + 1, lNewText[oldIndex2]);
Inc(lDeltaLines);
end;
ckDelete:
begin
EditorDeleteLine(aEdit, lStartLine + oldIndex1 + 1 + lDeltaLines);
Dec(lDeltaLines);
end;
ckModify:
begin
EditorReplaceLine(aEdit, lStartLine + oldIndex2 + 1, lNewText[oldIndex2]);
end;
end;
end;
end;
if lCursorNeedAdjustX then
lCursor.X := EditorGetLastColumn(aEdit, lCursor.Y);
aEdit.CursorTextXY := lCursor;
finally
lDiff.Free;
lListOldTextHashes.Free;
lListNewTextHashes.Free;
lNewText.Free;
aEdit.EndUndoBlock;
aEdit.EndUpdate;
end;
end;
end.