paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-07 17:58:16 +02:00
Code Issues Packages Projects Releases Wiki Activity
b4ca7445ee
lazarus/components/jcf2/ReadWrite/Diff.pas

883 lines
28 KiB
ObjectPascal
Raw Blame History

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.
Reference in New Issue View Git Blame Copy Permalink