1 {
2 /***************************************************************************
3 diffpatch.pas - functions to extract differences between texts
4 (diffs, patches) and apply them (patching).
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Author: Mattias Gaertner
28
29 Abstract:
30 Methods for creating diffs and ToDo: applying them (patching).
31
32 }
33 unit DiffPatch;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils, LazLoggerBase;
41
42 type
43 TTextDiffFlag = (
44 tdfIgnoreCase, // ignore case of letters
45 tdfIgnoreEmptyLineChanges,// ignore if empty lines were added or removed
46 tdfIgnoreHeadingSpaces, // ignore spaces at start of line
47 tdfIgnoreLineEnds, // ignore if line end chars differ (e.g. #10 = #13#10)
48 tdfIgnoreSpaceCharAmount, // ignore if space chars were added or removed
49 // except if all spaces were removed
50 tdfIgnoreSpaceChars, // ignore spaces (newline chars not included)
51 tdfIgnoreTrailingSpaces // ignore spaces at end of line
52 );
53 TTextDiffFlags = set of TTextDiffFlag;
54
55 TTextDiffOutputType = (
56 tdoContext,
57 tdoRCS
58 );
59
60 TLineExtends = record
61 LineStart: integer;
62 LineEnd: integer;
63 LineNumber: integer; // starting at 1
64 NextLineStart: integer;
65 end;
66
67 TDiffOutput = class;
68
69 { TDiffPart }
70
71 TDiffPart = class
72 private
73 fOwner: TDiffOutput;
74 fSource: string;
75 fStartLine: integer; // starting at 1
76 fEndLine: integer; // starting at 1
77 fPosition: TLineExtends;
78 fStream: TStream;
79 public
80 constructor Create(aOwner: TDiffOutput; const aSource: string);
81 destructor Destroy; override;
82 procedure Init(StartExt: TLineExtends);
83 procedure Write(const HeaderPrefix, HeaderSuffix: string);
84 procedure Write2(const StartExt, EndExt: TLineExtends;
85 OtherPartHasChangedLines: boolean; CharForInsertDeletion: char);
86 procedure WriteLinesOfText(aStream: TStream; const aPrefix: string;
87 const aStartLine: TLineExtends; aEndPos: integer);
LineExtendsToStrnull88 function LineExtendsToStr(const LineExtends: TLineExtends): string;
89 procedure GetLineExtends(LineStart: integer; var LineEnd, NextLineStart: integer);
90 procedure GetLineExtends(var LineExtends: TLineExtends);
91 procedure GetPrevLineExtends(LineStart: integer; var PrevLineStart, PrevLineEnd: integer);
92 procedure GetPrevLineExtends(var LineExtends: TLineExtends);
CountLineEndsnull93 function CountLineEnds(StartPos, EndPos: integer): integer;
CountLinesTillEndnull94 function CountLinesTillEnd(StartPos: integer): integer;
IsEmptyLinenull95 function IsEmptyLine(LineStart, LineEnd: integer): boolean;
96 procedure GetNextLineExtends(var LineStart, LineEnd, NextLineStart, LineNumber: integer);
97 procedure GetNextLineExtends(var LineExtends: TLineExtends);
98 end;
99
100 TProgressEvent = procedure(aPosition: Integer) of object;
101
102 { TDiffOutput }
103
104 TDiffOutput = class
105 private
106 fText1, fText2: string;
107 fOutputType: TTextDiffOutputType;
108 fOnProgressPos: TProgressEvent;
109 fFlags: TTextDiffFlags;
110 fDiffStream: TStream;
111 fPart1, fPart2: TDiffPart;
112 procedure FindNextEqualLine(const Start1, Start2: TLineExtends;
113 out EqualLine1, EqualLine2: TLineExtends);
LinesAreEqualnull114 function LinesAreEqual(Line1Start, Line1End, NextLine1Start: integer;
115 Line2Start, Line2End, NextLine2Start: integer): boolean;
LinesAreEqualnull116 function LinesAreEqual(const Line1Extends, Line2Extends: TLineExtends): boolean;
117 procedure AddDefaultDiff(const Start1, End1, Start2, End2: TLineExtends);
118 procedure AddContextDiff(const Start1, End1, Start2, End2: TLineExtends);
119 procedure FinishOldContextBlock;
120 procedure FinishDiff;
121 procedure AddRestDiff(const Start1, Start2: TLineExtends);
122 procedure AddDiff(const Start1, End1, Start2, End2: TLineExtends);
123 procedure UpdateProgressBar(const Line: TLineExtends);
124 public
125 constructor Create(const aText1, aText2: string; aFlags: TTextDiffFlags);
126 destructor Destroy; override;
GetProgressMaxnull127 function GetProgressMax: Integer;
CreateTextDiffnull128 function CreateTextDiff: string;
129 public
130 property OutputType: TTextDiffOutputType read fOutputType write fOutputType;
131 property OnProgressPos: TProgressEvent read fOnProgressPos write fOnProgressPos;
132 end;
133
134
135 const
136 TextDiffFlagNames: array[TTextDiffFlag] of string = (
137 'IgnoreCase',
138 'IgnoreEmptyLineChanges',
139 'IgnoreHeadingSpaces',
140 'IgnoreLineEnds',
141 'IgnoreSpaceCharAmount',
142 'IgnoreSpaceChars',
143 'IgnoreTrailingSpaces'
144 );
145
146
147 implementation
148
149 const
150 LineBreak = #10;
151 ContextLineCount = 3;
152
153 var
154 IsSpaceChars: array[char] of boolean;
155 UpperCaseChars: array[char] of char;
156
TextToLinenull157 function TextToLine(const s: string): string;
158 var
159 i: integer;
160 OrdStr: string;
161 begin
162 Result:=s;
163 i:=1;
164 while i<=length(Result) do begin
165 if ord(Result[i])>=ord(' ') then begin
166 inc(i);
167 end else begin
168 OrdStr:='#'+IntToStr(ord(Result[i]));
169 Result:=LeftStr(Result,i-1)+OrdStr+RightStr(Result,length(Result)-i);
170 end;
171 end;
172 end;
173
GotoNextLinenull174 function GotoNextLine(var LineExtends: TLineExtends): boolean;
175 begin
176 with LineExtends do begin
177 Result:=LineStart<NextLineStart;
178 if Result then begin
179 inc(LineNumber);
180 LineStart:=NextLineStart;
181 end;
182 end;
183 end;
184
185 procedure WriteStrToStream(Stream: TStream; const s: string);
186 begin
187 if s='' then exit;
188 Stream.Write(s[1],length(s));
189 end;
190
191 { TDiffPart }
192
193 constructor TDiffPart.Create(aOwner: TDiffOutput; const aSource: string);
194 begin
195 fOwner:=aOwner;
196 fSource:=aSource;
197 end;
198
199 destructor TDiffPart.Destroy;
200 begin
201 fStream.Free;
202 inherited Destroy;
203 end;
204
205 procedure TDiffPart.Init(StartExt: TLineExtends);
206 begin
207 if fStream=nil then
208 fStream:=TMemoryStream.Create
209 else
210 fStream.Size:=0;
211 fStartLine:=StartExt.LineNumber-ContextLineCount;
212 if fStartLine<1 then fStartLine:=1;
213 fPosition:=StartExt;
214 while fPosition.LineNumber>fStartLine do
215 GetPrevLineExtends(fPosition);
216 end;
217
218 procedure TDiffPart.Write(const HeaderPrefix, HeaderSuffix: string);
219 begin
220 // check if part contains any changed lines
221 if fPosition.LineNumber > fStartLine then begin
222 // part contains changed lines -> append end context
223 while (fPosition.LineNumber <= fEndLine)
224 and (fPosition.LineStart < length(fSource)) do begin
225 WriteLinesOfText(fStream, ' ', fPosition, fPosition.NextLineStart);
226 if not GotoNextLine(fPosition) then
227 break;
228 GetLineExtends(fPosition);
229 end;
230 end else begin
231 // part does not contain changed lines -> skip
232 end;
233 fStream.Position:=0;
234 // write part
235 WriteStrToStream(fOwner.fDiffStream, HeaderPrefix +
236 IntToStr(fStartLine) + ',' + IntToStr(fEndLine) + HeaderSuffix + LineBreak);
237 if fStream.Size<>0 then
238 fOwner.fDiffStream.CopyFrom(fStream, fStream.Size);
239 end;
240
241 procedure TDiffPart.Write2(const StartExt, EndExt: TLineExtends;
242 OtherPartHasChangedLines: boolean; CharForInsertDeletion: char);
243 begin
244 // check if there are changed lines
245 if StartExt.LineStart < EndExt.LineStart then begin
246 // write lines
247 while fPosition.LineStart < EndExt.LineStart do begin
248 if fPosition.LineStart < StartExt.LineStart then
249 // this is an unchanged line in front of the changed lines
250 WriteStrToStream(fStream, ' ')
251 else begin
252 // this is a changed line
253 if OtherPartHasChangedLines then
254 WriteStrToStream(fStream, '! ')
255 else
256 WriteStrToStream(fStream, CharForInsertDeletion+' ');
257 end;
258 if fPosition.LineStart <> fPosition.NextLineStart then
259 fStream.Write(fSource[fPosition.LineStart], fPosition.NextLineStart-fPosition.LineStart);
260 if not GotoNextLine(fPosition) then
261 break;
262 GetLineExtends(fPosition);
263 end;
264 end;
265 end;
266
267 procedure TDiffPart.WriteLinesOfText(aStream: TStream;
268 const aPrefix: string; const aStartLine: TLineExtends; aEndPos: integer);
269 { Write all lines in front of EndLine, starting with StartLine }
270 var
271 Line: TLineExtends;
272 begin
273 Line:=aStartLine;
274 while (Line.LineStart<aEndPos) do begin
275 WriteStrToStream(aStream,aPrefix);
276 if (Line.LineEnd>Line.LineStart) then
277 aStream.Write(fSource[Line.LineStart],Line.LineEnd-Line.LineStart);
278 if (Line.NextLineStart>Line.LineEnd) then
279 aStream.Write(fSource[Line.LineEnd],Line.NextLineStart-Line.LineEnd)
280 else begin
281 WriteStrToStream(aStream,LineBreak);
282 WriteStrToStream(aStream,'\ No newline at end');
283 WriteStrToStream(aStream,LineBreak);
284 end;
285 if not GotoNextLine(Line) then break;
286 GetLineExtends(Line);
287 end;
288 end;
289
LineExtendsToStrnull290 function TDiffPart.LineExtendsToStr(const LineExtends: TLineExtends): string;
291 begin
292 with LineExtends do
293 Result:='(Start='+IntToStr(LineStart)+' End='+IntToStr(LineEnd)
294 +' Next='+IntToStr(NextLineStart)+' Number='+IntToStr(LineNumber)
295 +' Text="'+TextToLine(copy(fSource,LineStart,NextLineStart-LineStart))+'")';
296 end;
297
298 procedure TDiffPart.GetLineExtends(LineStart: integer; var LineEnd, NextLineStart: integer);
299 var
300 Len: integer;
301 begin
302 Len:=length(fSource);
303 LineEnd:=LineStart;
304 while LineEnd<=Len do begin
305 if (not (fSource[LineEnd] in [#10,#13])) then begin
306 inc(LineEnd);
307 end else begin
308 NextLineStart:=LineEnd+1;
309 if (NextLineStart<=Len) and (fSource[NextLineStart] in [#10,#13])
310 and (fSource[LineEnd]<>fSource[NextLineStart]) then
311 inc(NextLineStart);
312 exit;
313 end;
314 end;
315 // this was the last line and it has no line end
316 NextLineStart:=LineEnd;
317 end;
318
319 procedure TDiffPart.GetLineExtends(var LineExtends: TLineExtends);
320 begin
321 GetLineExtends(LineExtends.LineStart, LineExtends.LineEnd, LineExtends.NextLineStart);
322 end;
323
324 procedure TDiffPart.GetPrevLineExtends(LineStart: integer;
325 var PrevLineStart, PrevLineEnd: integer);
326 begin
327 // read line end
328 PrevLineEnd:=LineStart;
329 if (PrevLineEnd>1) and (fSource[PrevLineEnd-1] in [#10,#13]) then
330 dec(PrevLineEnd);
331 if (PrevLineEnd>1) and (fSource[PrevLineEnd-1] in [#10,#13])
332 and (fSource[PrevLineEnd]<>fSource[PrevLineEnd-1]) then
333 dec(PrevLineEnd);
334 // read line content
335 PrevLineStart:=PrevLineEnd;
336 while (PrevLineStart>1) and (not (fSource[PrevLineStart-1] in [#10,#13])) do
337 dec(PrevLineStart);
338 end;
339
340 procedure TDiffPart.GetPrevLineExtends(var LineExtends: TLineExtends);
341 begin
342 if LineExtends.LineStart<1 then exit;
343 LineExtends.NextLineStart:=LineExtends.LineStart;
344 GetPrevLineExtends(LineExtends.LineStart,LineExtends.LineStart,LineExtends.LineEnd);
345 dec(LineExtends.LineNumber);
346 end;
347
TDiffPart.CountLineEndsnull348 function TDiffPart.CountLineEnds(StartPos, EndPos: integer): integer;
349 begin
350 Result:=0;
351 while (StartPos<EndPos) do begin
352 if not (fSource[StartPos] in [#10,#13]) then begin
353 inc(StartPos);
354 end else begin
355 inc(Result);
356 inc(StartPos);
357 if (StartPos<EndPos) and (fSource[StartPos] in [#10,#13])
358 and (fSource[StartPos]<>fSource[StartPos-1]) then
359 inc(StartPos);
360 end;
361 end;
362 end;
363
TDiffPart.CountLinesTillEndnull364 function TDiffPart.CountLinesTillEnd(StartPos: integer): integer;
365 var
366 Len: integer;
367 begin
368 Len:=length(fSource);
369 Result:=CountLineEnds(StartPos,Len+1);
370 if (StartPos<=Len) and (not (fSource[Len] in [#10,#13])) then
371 inc(Result);
372 end;
373
TDiffPart.IsEmptyLinenull374 function TDiffPart.IsEmptyLine(LineStart, LineEnd: integer): boolean;
375 var
376 i: integer;
377 begin
378 if LineStart<=length(fSource) then begin
379 if ([tdfIgnoreSpaceCharAmount,tdfIgnoreSpaceChars,tdfIgnoreHeadingSpaces,
380 tdfIgnoreTrailingSpaces]*fOwner.fFlags)<>[] then
381 begin
382 Result:=true;
383 for i:=LineStart to LineEnd-1 do begin
384 if not IsSpaceChars[fSource[i]] then begin
385 Result:=false;
386 exit;
387 end;
388 end;
389 end else begin
390 Result:=(LineEnd=LineStart);
391 end;
392 end else begin
393 Result:=true;
394 exit;
395 end;
396 end;
397
398 procedure TDiffPart.GetNextLineExtends(var LineStart, LineEnd, NextLineStart, LineNumber: integer);
399 var
400 Len: integer;
401 begin
402 Len:=length(fSource);
403 repeat
404 GetLineExtends(LineStart,LineEnd,NextLineStart);
405 if (LineStart>Len)
406 or (not (tdfIgnoreEmptyLineChanges in fOwner.fFlags))
407 or (not IsEmptyLine(LineStart,LineEnd)) then
408 break;
409 LineStart:=NextLineStart;
410 inc(LineNumber);
411 until false;
412 end;
413
414 procedure TDiffPart.GetNextLineExtends(var LineExtends: TLineExtends);
415 begin
416 GetNextLineExtends(LineExtends.LineStart, LineExtends.LineEnd,
417 LineExtends.NextLineStart, LineExtends.LineNumber);
418 end;
419
420
421 { TDiffOutput }
422
LinesAreEqualnull423 function TDiffOutput.LinesAreEqual(
424 Line1Start, Line1End, NextLine1Start: integer;
425 Line2Start, Line2End, NextLine2Start: integer): boolean;
426 var
427 Start1, End1, Pos1,
428 Start2, End2, Pos2: integer;
429 begin
430 Start1:=Line1Start;
431 End1:=Line1End;
432 Start2:=Line2Start;
433 End2:=Line2End;
434 if [tdfIgnoreHeadingSpaces,tdfIgnoreSpaceChars]*fFlags<>[] then begin
435 // ignore spaces at start of line
436 while (Start1<End1) and IsSpaceChars[fText1[Start1]] do inc(Start1);
437 while (Start2<End2) and IsSpaceChars[fText2[Start2]] do inc(Start2);
438 end;
439 if [tdfIgnoreTrailingSpaces,tdfIgnoreSpaceChars]*fFlags<>[] then begin
440 // ignore spaces at end of line
441 while (Start1<End1) and IsSpaceChars[fText1[End1-1]] do dec(End1);
442 while (Start2<End2) and IsSpaceChars[fText2[End2-1]] do dec(End2);
443 end;
444
445 // compare line content (i.e. the chars without the line end)
446 Pos1:=Start1;
447 Pos2:=Start2;
448 while (Pos1<End1) and (Pos2<End2) do begin
449 if not IsSpaceChars[fText1[Pos1]] then begin
450 // fText1 contains a normal char
451 if not IsSpaceChars[fText2[Pos2]] then begin
452 // fText2 contains a normal char
453 if tdfIgnoreCase in fFlags then begin
454 // compare case insensitive
455 if UpperCaseChars[fText1[Pos1]]=UpperCaseChars[fText2[Pos2]] then begin
456 // no diff -> proceed with next chars
457 inc(Pos1);
458 inc(Pos2);
459 end else begin
460 // diff found -> lines differ
461 Result:=false;
462 exit;
463 end;
464 end else begin
465 // compare case sensitive
466 if fText1[Pos1]=fText2[Pos2] then begin
467 // no diff -> proceed with next chars
468 inc(Pos1);
469 inc(Pos2);
470 end else begin
471 // diff found -> lines differ
472 Result:=false;
473 exit;
474 end;
475 end;
476 end else begin
477 // fText2 contains a space
478 if not (tdfIgnoreSpaceChars in fFlags) then begin
479 // diff found -> lines differ
480 Result:=false;
481 exit;
482 end else begin
483 // skip all spaces in fText2 and proceed the search
484 repeat
485 inc(Pos2);
486 until (Pos2>=End2) or (not IsSpaceChars[fText2[Pos2]]);
487 end;
488 end;
489 end else begin
490 // fText1 contains a space
491 if not IsSpaceChars[fText2[Pos2]] then begin
492 // fText2 contains a normal char
493 if not (tdfIgnoreSpaceChars in fFlags) then begin
494 // diff found -> lines differ
495 Result:=false;
496 exit;
497 end else begin
498 // skip all spaces in fText1 and proceed the search
499 repeat
500 inc(Pos1);
501 until (Pos1>=End1) or (not IsSpaceChars[fText1[Pos1]]);
502 end;
503 end else begin
504 // fText2 contains a space
505 if [tdfIgnoreSpaceChars,tdfIgnoreSpaceCharAmount]*fFlags<>[] then begin
506 // skip all spaces in fText1 and fText2 and proceed the search
507 repeat
508 inc(Pos1);
509 until (Pos1>=End1) or (not IsSpaceChars[fText1[Pos1]]);
510 repeat
511 inc(Pos2);
512 until (Pos2>=End2) or (not IsSpaceChars[fText2[Pos2]]);
513 end else begin
514 // compare the space chars
515 if fText1[Pos1]=fText2[Pos2] then begin
516 // no diff -> proceed with next chars
517 inc(Pos1);
518 inc(Pos2);
519 end else begin
520 // diff found -> lines differ
521 Result:=false;
522 exit;
523 end;
524 end;
525 end;
526 end;
527 end;
528 if (Pos1<End1) or (Pos2<End2) then begin
529 // one line is longer -> lines differ
530 Result:=false;
531 exit;
532 end;
533 // compare line ends
534 if not (tdfIgnoreLineEnds in fFlags) then begin
535 Pos1:=Line1End;
536 Pos2:=Line2End;
537 while (Pos1<NextLine1Start) and (Pos2<NextLine2Start)
538 and (fText1[Pos1]=fText2[Pos2]) do begin
539 inc(Pos1);
540 inc(Pos2);
541 end;
542 Result:=(Pos1=NextLine1Start) and (Pos2=NextLine2Start);
543 end else begin
544 Result:=true;
545 end;
546 end;
547
LinesAreEqualnull548 function TDiffOutput.LinesAreEqual(const Line1Extends, Line2Extends: TLineExtends): boolean;
549 begin
550 Result:=LinesAreEqual(Line1Extends.LineStart, Line1Extends.LineEnd,
551 Line1Extends.NextLineStart,
552 Line2Extends.LineStart, Line2Extends.LineEnd,
553 Line2Extends.NextLineStart);
554 end;
555
556 procedure TDiffOutput.FindNextEqualLine(const Start1, Start2: TLineExtends;
557 out EqualLine1, EqualLine2: TLineExtends);
558 var
559 Max1, Max2, Cur1, Cur2: TLineExtends;
560 begin
561 Max1:=Start1;
562 Max2:=Start2;
563 Cur1:=Start1;
564 Cur2:=Start2;
565 try
566 if LinesAreEqual(Cur1,Cur2)
567 and (not fPart1.IsEmptyLine(Cur1.LineStart, Cur1.LineEnd)) then
568 exit;
569 repeat
570 // increase Max1
571 if GotoNextLine(Max1) then begin
572 fPart1.GetLineExtends(Max1);
573 // search Max1 Line in fText2
574 if Max1.LineStart<Max1.NextLineStart then begin
575 Cur1:=Max1;
576 Cur2:=Start2;
577 repeat
578 if LinesAreEqual(Cur1,Cur2)
579 and (not fPart1.IsEmptyLine(Cur1.LineStart, Cur1.LineEnd)) then
580 exit;
581 if Cur2.LineStart>=Max2.LineStart then break;
582 Cur2.LineStart:=Cur2.NextLineStart;
583 inc(Cur2.LineNumber);
584 fPart2.GetLineExtends(Cur2);
585 until false;
586 end;
587 UpdateProgressBar(Max1);
588 end;
589 // increase Max2
590 if GotoNextLine(Max2) then begin
591 fPart2.GetLineExtends(Max2);
592 // search Max2 Line in fText1
593 if Max2.LineStart<Max2.NextLineStart then begin
594 Cur1:=Start1;
595 Cur2:=Max2;
596 repeat
597 if LinesAreEqual(Cur1,Cur2)
598 and (not fPart1.IsEmptyLine(Cur1.LineStart,Cur1.LineEnd)) then
599 exit;
600 if Cur1.LineStart>=Max1.LineStart then break;
601 Cur1.LineStart:=Cur1.NextLineStart;
602 inc(Cur1.LineNumber);
603 fPart1.GetLineExtends(Cur1);
604 until false;
605 end;
606 end;
607 until (Max1.LineStart>=Max1.NextLineStart)
608 and (Max2.LineStart>=Max2.NextLineStart);
609 // no equal line found
610 Cur1:=Max1;
611 Cur2:=Max2;
612 finally
613 repeat
614 EqualLine1:=Cur1;
615 EqualLine2:=Cur2;
616 // chomp empty lines at end
617 fPart1.GetPrevLineExtends(Cur1);
618 fPart2.GetPrevLineExtends(Cur2);
619 if (Cur1.LineNumber < 1) or (Cur2.LineNumber < 1) then
620 break;
621 until not LinesAreEqual(Cur1,Cur2);
622 end;
623 end;
624
CreateTextDiffnull625 function TDiffOutput.CreateTextDiff: string;
626 var
627 Line1, Line2, EqualLine1, EqualLine2: TLineExtends;
628 Len1, Len2: integer;
629 begin
630 Result := '';
631 try
632 try
633 Len1:=length(fText1);
634 Len2:=length(fText2);
635 Line1.LineStart:=1;
636 Line1.LineNumber:=1;
637 Line2.LineStart:=1;
638 Line2.LineNumber:=1;
639 repeat
640 // search for a difference line ...
641 repeat
642 // skip empty lines in fText1 and get line1 extends ...
643 fPart1.GetNextLineExtends(Line1);
644 // skip empty lines in fText2 and get line2 extends ...
645 fPart2.GetNextLineExtends(Line2);
646 // skip equal lines ...
647 if (Line1.LineStart<=Len1) and (Line2.LineStart<=Len2) then begin
648 if not LinesAreEqual(Line1,Line2) then
649 break;
650 Line1.LineStart:=Line1.NextLineStart;
651 inc(Line1.LineNumber);
652 Line2.LineStart:=Line2.NextLineStart;
653 inc(Line2.LineNumber);
654 end else begin
655 if (Line1.LineStart<=Len1) or (Line2.LineStart<=Len2) then begin
656 // one text is longer than the other
657 AddRestDiff(Line1, Line2);
658 end else begin
659 // no more diff found
660 end;
661 exit;
662 end;
663 UpdateProgressBar(Line1);
664 until false;
665 // difference line found -> search next equal line
666 FindNextEqualLine(Line1, Line2, EqualLine1, EqualLine2);
667 AddDiff(Line1, EqualLine1, Line2, EqualLine2);
668 // continue the search ...
669 Line1:=EqualLine1;
670 GotoNextLine(Line1);
671 Line2:=EqualLine2;
672 GotoNextLine(Line2);
673 UpdateProgressBar(Line1);
674 until false;
675 except
676 on E: Exception do begin
677 DebugLogger.DebugLn('CreateTextDiff ',E.Message);
678 end;
679 end;
680 finally
681 FinishDiff;
682 SetLength(Result,fDiffStream.Size);
683 fDiffStream.Position:=0;
684 if Result<>'' then
685 fDiffStream.Read(Result[1],length(Result));
686 end;
687 end;
688
689 procedure TDiffOutput.AddRestDiff(const Start1, Start2: TLineExtends);
690 var
691 End1, End2: TLineExtends;
692 begin
693 End1.LineStart:=length(fText1)+1;
694 End1.LineEnd:=End1.LineStart;
695 End1.NextLineStart:=End1.LineStart;
696 End1.LineNumber:=Start1.LineNumber+fPart1.CountLinesTillEnd(Start1.LineStart);
697 End2.LineStart:=length(fText2)+1;
698 End2.LineEnd:=End2.LineStart;
699 End2.NextLineStart:=End2.LineStart;
700 End2.LineNumber:=Start2.LineNumber+fPart2.CountLinesTillEnd(Start2.LineStart);
701 AddDiff(Start1,End1, Start2,End2);
702 end;
703
704 procedure TDiffOutput.AddDiff(const Start1, End1, Start2, End2: TLineExtends);
705 begin
706 if (Start1.LineStart>length(fText1)) and (Start2.LineStart>length(fText2)) then
707 exit; // no diff
708 case fOutputType of
709 tdoContext:
710 AddContextDiff(Start1,End1,Start2,End2);
711 else
712 AddDefaultDiff(Start1,End1,Start2,End2);
713 end;
714 end;
715
716 procedure TDiffOutput.UpdateProgressBar(const Line: TLineExtends);
717 begin
718 if Assigned(OnProgressPos) then
719 OnProgressPos(Line.LineStart);
720 end;
721
722 procedure TDiffOutput.FinishOldContextBlock;
723 begin
724 if fPart1.fStream <> nil then begin
725 fPart1.Write('*** ',' ****');
726 fPart2.Write('--- ',' ----');
727 end;
728 end;
729
730 procedure TDiffOutput.FinishDiff;
731 begin
732 case fOutputType of
733 tdoContext: FinishOldContextBlock;
734 end;
735 end;
736
737 procedure TDiffOutput.AddDefaultDiff(const Start1, End1, Start2, End2: TLineExtends);
738 { Start1/2 is the first line that is different
739 End1/2 is the first line that is equal
740
741 The diff output:
742 - There are three types of diffs: insertions, deletions and replacements
743 - Insertions:
744 - An insertion/addition starts with a
745 <lines>a<lines>
746 followed by the lines of text 2.
747 - A deletion starts with a
748 <lines>d<lines>
749 followed by the lines of text 1.
750 - A replacement/change starts with a
751 <lines>c<lines>
752 followed by the lines of text 1, folowed by
753 ---
754 followed by the lines of text 2.
755 - <lines> can be single decimal number or a range. For example:
756 1
757 2,3
758 - The lines of text 1 are always prefixed with '< '
759 If the lines of text 1 do not end with a newline char it ends with a line
760 \ No newline at end
761 - The lines of text 2 are always prefixed with '> '
762 If the lines of text 1 do not end with a newline char it ends with a line
763 \ No newline at end
764 }
765 var
766 DiffStartLine1, DiffEndLine1: integer;
767 DiffStartLine2, DiffEndLine2: integer;
768 ActionChar: char;
769
770 procedure WriteActionLine;
771 begin
772 // write line numbers of text 1
773 WriteStrToStream(fDiffStream,IntToStr(DiffStartLine1));
774 if DiffEndLine1>DiffStartLine1 then begin
775 WriteStrToStream(fDiffStream,',');
776 WriteStrToStream(fDiffStream,IntToStr(DiffEndLine1));
777 end;
778 // write action character 'a', 'd' or 'c'
779 if (Start1.LineStart<End1.LineStart) then begin
780 // part of text 1 is replaced
781 if (Start2.LineStart<End2.LineStart) then
782 ActionChar:='c' // replacement
783 else
784 ActionChar:='d'; // deletion
785 end else begin
786 // insertion
787 ActionChar:='a';
788 end;
789 fDiffStream.Write(ActionChar,1);
790 // write line numbers of text 2
791 WriteStrToStream(fDiffStream,IntToStr(DiffStartLine2));
792 if DiffEndLine2>DiffStartLine2 then begin
793 WriteStrToStream(fDiffStream,',');
794 WriteStrToStream(fDiffStream,IntToStr(DiffEndLine2));
795 end;
796 // write <newline>
797 WriteStrToStream(fDiffStream,LineBreak);
798 end;
799
800 begin
801 DiffStartLine1:=Start1.LineNumber;
802 DiffEndLine1:=End1.LineNumber-1;
803 if DiffStartLine1>DiffEndLine1 then
804 DiffStartLine1:=DiffEndLine1;
805 DiffStartLine2:=Start2.LineNumber;
806 DiffEndLine2:=End2.LineNumber-1;
807 if DiffStartLine2>DiffEndLine2 then
808 DiffStartLine2:=DiffEndLine2;
809 WriteActionLine;
810 fPart1.WriteLinesOfText(fDiffStream,'< ',Start1,End1.LineStart);
811 if ActionChar='c' then begin
812 WriteStrToStream(fDiffStream,'---');
813 WriteStrToStream(fDiffStream,LineBreak);
814 end;
815 fPart2.WriteLinesOfText(fDiffStream,'> ',Start2,End2.LineStart);
816 end;
817
818 procedure TDiffOutput.AddContextDiff(const Start1, End1, Start2, End2: TLineExtends);
819 { Start1/2 is the first line that is different
820 End1/2 is the first line that is equal
821
822 The diff output:
823 - Every diff block starts with 15 stars
824 ***************
825 - Every diff block has two parts. One for each text.
826 - The first text part starts with
827 *** StartLine,EndLine ****
828 - The second text part starts with
829 --- StartLine,EndLine ----
830 - In front of and behind each changed line there are unchanged line. These
831 lines are the context.
832 - At the beginning and at the end there are at least
833 ContextLineCount number of unchanged lines.
834 - Between two changed lines there are at most 2x ContextLineCount number of
835 unchanged lines. If there are too many, the a new block is started
836 - Changed lines starts with '! ', unchanged with ' '.
837 - If a part contains no changed lines, its lines can be left out
838 }
839
840 var
841 Part1HasChangedLines: boolean;
842 Part2HasChangedLines: boolean;
843 begin
844 if (fPart1.fStream<>nil)
845 and (Start1.LineNumber-ContextLineCount<=fPart1.fEndLine-1)
846 and (Start2.LineNumber-ContextLineCount<=fPart2.fEndLine-1) then begin
847 // append the new difference
848 end else begin
849 // start a new block // StartContextBlock(Start1,Start2);
850 FinishOldContextBlock;
851 WriteStrToStream(fDiffStream,'***************'+LineBreak);
852 fPart1.Init(Start1);
853 fPart2.Init(Start2);
854 end;
855 fPart1.fEndLine:=End1.LineNumber+ContextLineCount-1;
856 fPart2.fEndLine:=End2.LineNumber+ContextLineCount-1;
857 Part1HasChangedLines:=End1.LineStart>Start1.LineStart;
858 Part2HasChangedLines:=End2.LineStart>Start2.LineStart;
859 fPart1.Write2(Start1,End1,Part2HasChangedLines,'-');
860 fPart2.Write2(Start2,End2,Part1HasChangedLines,'+');
861 end;
862
TDiffOutput.GetProgressMaxnull863 function TDiffOutput.GetProgressMax: Integer;
864 begin
865 Result := Length(fText1); // + Length(fText2);
866 end;
867
868 constructor TDiffOutput.Create(const aText1, aText2: string; aFlags: TTextDiffFlags);
869 begin
870 fText1:=aText1;
871 fText2:=aText2;
872 fFlags:=aFlags;
873 fOutputType:=tdoContext; // Default OutputType, can be changed later
874 fDiffStream:=TMemoryStream.Create;
875 fPart1:=TDiffPart.Create(Self, fText1);
876 fPart2:=TDiffPart.Create(Self, fText2);
877 end;
878
879 destructor TDiffOutput.Destroy;
880 begin
881 if Assigned(OnProgressPos) then
882 OnProgressPos(0);
883 fPart2.Free;
884 fPart1.Free;
885 fDiffStream.Free;
886 inherited Destroy;
887 end;
888
889
890 //-----------------------------------------------------------------------------
891 procedure InternalInit;
892 var
893 c: char;
894 begin
895 for c:=Low(char) to High(char) do begin
896 IsSpaceChars[c]:=c in [' ',#9];
897 UpperCaseChars[c]:=upcase(c);
898 end;
899 end;
900
901 initialization
902 InternalInit;
903
904 finalization
905
906
907 end.
908
909