diff --git a/.gitattributes b/.gitattributes index 02424a908d..1289674d46 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk b/components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk index b8527f3b21..28a4adbcc8 100644 --- a/components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk +++ b/components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk @@ -25,702 +25,709 @@ - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + + + + + + + + + - - - + + - + diff --git a/components/jcf2/IdePlugin/lazarus/jcfidelazarus.pas b/components/jcf2/IdePlugin/lazarus/jcfidelazarus.pas index e01392abdf..a0b69c2092 100644 --- a/components/jcf2/IdePlugin/lazarus/jcfidelazarus.pas +++ b/components/jcf2/IdePlugin/lazarus/jcfidelazarus.pas @@ -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 diff --git a/components/jcf2/IdePlugin/lazarus/jcfidemain.pas b/components/jcf2/IdePlugin/lazarus/jcfidemain.pas index 058399b740..3c151210ff 100644 --- a/components/jcf2/IdePlugin/lazarus/jcfidemain.pas +++ b/components/jcf2/IdePlugin/lazarus/jcfidemain.pas @@ -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; diff --git a/components/jcf2/ReadWrite/Converter.pas b/components/jcf2/ReadWrite/Converter.pas index 9a3c51bd33..5a7b9c7e1e 100644 --- a/components/jcf2/ReadWrite/Converter.pas +++ b/components/jcf2/ReadWrite/Converter.pas @@ -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 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. diff --git a/components/jcf2/ReadWrite/EditorConverter.pas b/components/jcf2/ReadWrite/EditorConverter.pas index 571ae84595..7770882512 100644 --- a/components/jcf2/ReadWrite/EditorConverter.pas +++ b/components/jcf2/ReadWrite/EditorConverter.pas @@ -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; diff --git a/components/jcf2/ReadWrite/diffmerge.pas b/components/jcf2/ReadWrite/diffmerge.pas new file mode 100644 index 0000000000..6ca0c24a5f --- /dev/null +++ b/components/jcf2/ReadWrite/diffmerge.pas @@ -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 . 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.