{ *************************************************************************** * * * 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: Defines TSourceLog which manage a source (= an ansistring) and all changes like inserting, deleting and moving parts of it. } unit SourceLog; {$ifdef fpc}{$mode objfpc}{$endif}{$H+} interface {$I codetools.inc} uses {$IFDEF MEM_CHECK} MemCheck, {$ENDIF} Classes, SysUtils, FileProcs; type TSourceLog = class; TSourceLogEntryOperation = (sleoInsert, sleoDelete, sleoMove); TOnSourceLogInsert = procedure(Sender: TSourceLog; Pos: integer; const Txt: string) of object; TOnSourceLogDelete = procedure(Sender: TSourceLog; Pos, Len: integer) of object; TOnSourceLogMove = procedure(Sender: TSourceLog; Pos, Len, MoveTo: integer) of object; TOnSourceLogDecodeLoaded = procedure(Sender: TSourceLog; const Filename: string; var Source, DiskEncoding, MemEncoding: string) of object; TOnSourceLogEncodeSaving = procedure(Sender: TSourceLog; const Filename: string; var Source: string) of object; TSourceLogEntry = class private public Position: integer; Len: integer; MoveTo: integer; LineEnds: integer; // number of line ends in txt LengthOfLastLine: integer; Txt: string; Operation: TSourceLogEntryOperation; procedure AdjustPosition(var APosition: integer); constructor Create(APos, ALength, AMoveTo: integer; const ATxt: string; AnOperation: TSourceLogEntryOperation); end; TOnSourceChange = procedure(Sender: TSourceLog; Entry: TSourceLogEntry) of object; TSourceLogMarker = class private public Position: integer; NewPosition: integer; Deleted: boolean; Data: Pointer; end; TLineRange = record StartPos, EndPos: integer; end; { TSourceLog } TSourceLog = class private FDiskEncoding: string; FLineCount: integer; FLineRanges: {$ifdef fpc}^{$else}array of {$endif}TLineRange; FMemEncoding: string; FOnDecodeLoaded: TOnSourceLogDecodeLoaded; FOnEncodeSaving: TOnSourceLogEncodeSaving; // array of TLineRange FSrcLen: integer; FLog: TFPList; // list of TSourceLogEntry FMarkers: TFPList; // list of TSourceLogMarker; FModified: boolean; FOnInsert: TOnSourceLogInsert; FOnDelete: TOnSourceLogDelete; FOnMove: TOnSourceLogMove; FChangeHooks: {$ifdef fpc}^{$else}array of {$endif}TOnSourceChange; FChangeHookCount: integer; FSource: string; FChangeStep: integer; FReadOnly: boolean; FWriteLock: integer; FChangeHookLock: integer; procedure SetSource(const NewSrc: string); function GetItems(Index: integer): TSourceLogEntry; procedure SetItems(Index: integer; AnItem: TSourceLogEntry); function GetMarkers(Index: integer): TSourceLogMarker; procedure BuildLineRanges; procedure IncreaseChangeStep; procedure SetReadOnly(const Value: boolean); function IndexOfChangeHook(AChangeHook: TOnSourceChange): integer; protected procedure DecodeLoaded(const AFilename: string; var ASource, ADiskEncoding, AMemEncoding: string); virtual; procedure EncodeSaving(const AFilename: string; var ASource: string); virtual; public Data: Pointer; function LineCount: integer; function GetLine(Index: integer): string; procedure GetLineRange(Index: integer; out LineRange: TLineRange); property Items[Index: integer]: TSourceLogEntry read GetItems write SetItems; default; function Count: integer; // # Items property SourceLength: integer read fSrcLen; procedure ClearEntries; property ChangeStep: integer read FChangeStep; property Markers[Index: integer]: TSourceLogMarker read GetMarkers; function MarkerCount: integer; procedure AddMarker(Position: integer; SomeData: Pointer); procedure AddMarkerXY(Line, Column: integer; SomeData: Pointer); procedure AdjustPosition(var APosition: integer); procedure NotifyHooks(Entry: TSourceLogEntry); procedure IncreaseHookLock; procedure DecreaseHookLock; property Source: string read FSource write SetSource; property Modified: boolean read FModified write FModified; // Line and Column begin at 1 procedure LineColToPosition(Line, Column: integer; out Position: integer); procedure AbsoluteToLineCol(Position: integer; out Line, Column: integer); procedure Insert(Pos: integer; const Txt: string); procedure Delete(Pos, Len: integer); procedure Replace(Pos, Len: integer; const Txt: string); procedure Move(Pos, Len, MoveTo: integer); function LoadFromFile(const Filename: string): boolean; virtual; function SaveToFile(const Filename: string): boolean; virtual; function GetLines(StartLine, EndLine: integer): string; function IsEqual(sl: TStrings): boolean; procedure Assign(sl: TStrings); procedure AssignTo(sl: TStrings; UseAddStrings: Boolean); procedure LoadFromStream(s: TStream); procedure SaveToStream(s: TStream); property ReadOnly: boolean read FReadOnly write SetReadOnly; property DiskEncoding: string read FDiskEncoding write FDiskEncoding; property MemEncoding: string read FMemEncoding write FMemEncoding; property WriteLock: integer read FWriteLock; procedure IncWriteLock; procedure DecWriteLock; procedure Clear; virtual; function ConsistencyCheck: integer; constructor Create(const ASource: string); destructor Destroy; override; procedure AddChangeHook(AnOnSourceChange: TOnSourceChange); procedure RemoveChangeHook(AnOnSourceChange: TOnSourceChange); property OnInsert: TOnSourceLogInsert read FOnInsert write FOnInsert; property OnDelete: TOnSourceLogDelete read FOnDelete write FOnDelete; property OnMove: TOnSourceLogMove read FOnMove write FOnMove; property OnDecodeLoaded: TOnSourceLogDecodeLoaded read FOnDecodeLoaded write FOnDecodeLoaded; property OnEncodeSaving: TOnSourceLogEncodeSaving read FOnEncodeSaving write FOnEncodeSaving; end; implementation { useful function } function LineEndCount(const Txt: string;var LengthOfLastLine: integer): integer; var i, LastLineEndPos, TxtLen: integer; begin i:=1; LastLineEndPos:=0; Result:=0; TxtLen:=length(Txt); while iTxt[i]) then inc(i); LastLineEndPos:=i-1; end else inc(i); end; LengthOfLastLine:=TxtLen-LastLineEndPos; end; { TSourceLogEntry } constructor TSourceLogEntry.Create(APos, ALength, AMoveTo: integer; const ATxt: string; AnOperation: TSourceLogEntryOperation); begin Position:=APos; Len:=ALength; MoveTo:=AMoveTo; Operation:=AnOperation; LineEnds:=LineEndCount(Txt, LengthOfLastLine); Txt:=ATxt; end; procedure TSourceLogEntry.AdjustPosition(var APosition: integer); begin case Operation of sleoInsert: if APosition>=Position then inc(APosition,Len); sleoDelete: if (APosition>=Position) then begin if APosition>=Position+Len then dec(APosition,Len) else APosition:=Position; end; sleoMove: if Position=Position then begin if APosition=MoveTo then begin if APositionnil then begin FreeMem(FChangeHooks); FChangeHooks:=nil; end; FMarkers.Free; FLog.Free; inherited Destroy; end; function TSourceLog.LineCount: integer; begin if fLineCount<0 then BuildLineRanges; Result:=fLineCount; end; function TSourceLog.GetLine(Index: integer): string; var LineLen: integer; begin BuildLineRanges; if (Index>=0) and (Index0 then System.Move(fSource[fLineRanges[Index].StartPos],Result[1],LineLen); end else Result:=''; end; procedure TSourceLog.GetLineRange(Index: integer; out LineRange: TLineRange); begin BuildLineRanges; LineRange:=FLineRanges[Index]; end; procedure TSourceLog.ClearEntries; var i: integer; begin for i:=0 to Count-1 do Items[i].Free; FLog.Clear; end; procedure TSourceLog.Clear; var i: integer; begin ClearEntries; for i:=0 to MarkerCount-1 do Markers[i].Free; FMarkers.Clear; FSource:=''; FSrcLen:=0; FModified:=false; if FLineRanges<>nil then begin FreeMem(FLineRanges); FLineRanges:=nil; end; FLineCount:=-1; IncreaseChangeStep; Data:=nil; FReadOnly:=false; NotifyHooks(nil); end; function TSourceLog.GetItems(Index: integer): TSourceLogEntry; begin Result:=TSourceLogEntry(FLog[Index]); end; procedure TSourceLog.SetItems(Index: integer; AnItem: TSourceLogEntry); begin FLog[Index]:=AnItem; end; function TSourceLog.Count: integer; begin Result:=fLog.Count; end; function TSourceLog.GetMarkers(Index: integer): TSourceLogMarker; begin Result:=TSourceLogMarker(FMarkers[Index]); end; function TSourceLog.MarkerCount: integer; begin Result:=fMarkers.Count; end; procedure TSourceLog.NotifyHooks(Entry: TSourceLogEntry); var i: integer; begin if (FChangeHooks=nil) or (FChangeHookLock>0) then exit; for i:=0 to FChangeHookCount-1 do FChangeHooks[i](Self,Entry); end; procedure TSourceLog.IncreaseHookLock; begin inc(FChangeHookLock); end; procedure TSourceLog.DecreaseHookLock; begin if FChangeHookLock<=0 then exit; dec(FChangeHookLock); if FChangeHookLock=0 then NotifyHooks(nil); end; procedure TSourceLog.SetSource(const NewSrc: string); begin //DebugLn('TSourceLog.SetSource A ',length(NewSrc),' LineCount=',fLineCount,' SrcLen=',fSrcLen); if NewSrc<>FSource then begin Clear; FSource:=NewSrc; FSrcLen:=length(FSource); FLineCount:=-1; FReadOnly:=false; NotifyHooks(nil); end; end; procedure TSourceLog.Insert(Pos: integer; const Txt: string); var i: integer; NewSrcLogEntry: TSourceLogEntry; begin if Txt='' then exit; if Assigned(FOnInsert) then FOnInsert(Self,Pos,Txt); NewSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert); FLog.Add(NewSrcLogEntry); NotifyHooks(NewSrcLogEntry); FSource:=copy(FSource,1,Pos-1) +Txt +copy(FSource,Pos,length(FSource)-Pos+1); FSrcLen:=length(FSource); FLineCount:=-1; for i:=0 to FMarkers.Count-1 do begin if (not Markers[i].Deleted) then NewSrcLogEntry.AdjustPosition(Markers[i].NewPosition); end; FModified:=true; IncreaseChangeStep; end; procedure TSourceLog.Delete(Pos, Len: integer); var i: integer; NewSrcLogEntry: TSourceLogEntry; begin if Len=0 then exit; if Assigned(FOnDelete) then FOnDelete(Self,Pos,Len); NewSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,-1,'',sleoDelete); FLog.Add(NewSrcLogEntry); NotifyHooks(NewSrcLogEntry); System.Delete(FSource,Pos,Len); FSrcLen:=length(FSource); FLineCount:=-1; for i:=0 to FMarkers.Count-1 do begin if (Markers[i].Deleted=false) then begin if (Markers[i].NewPosition<=Pos) and (Markers[i].NewPositionLen then exit; end; if Assigned(FOnDelete) then FOnDelete(Self,Pos,Len); if Assigned(FOnInsert) then FOnInsert(Self,Pos,Txt); DeleteSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,-1,'',sleoDelete); FLog.Add(DeleteSrcLogEntry); NotifyHooks(DeleteSrcLogEntry); InsertSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert); FLog.Add(InsertSrcLogEntry); NotifyHooks(InsertSrcLogEntry); FSource:=copy(FSource,1,Pos-1) +Txt +copy(FSource,Pos+Len,length(FSource)-Pos-Len+1); FSrcLen:=length(FSource); FLineCount:=-1; for i:=0 to FMarkers.Count-1 do begin if (Markers[i].Deleted=false) then begin if (Markers[i].NewPosition<=Pos) and (Markers[i].NewPosition=Pos) and (MoveTo0 then begin GetMem(FLineRanges,FLineCount*SizeOf(TLineRange)); p:=1; line:=0; FLineRanges[line].StartPos:=1; FLineRanges[FLineCount-1].EndPos:=fSrcLen+1; while (p<=fSrcLen) do begin if (not (FSource[p] in [#10,#13])) then begin inc(p); end else begin // new line FLineRanges[line].EndPos:=p; inc(line); inc(p); if (p<=fSrcLen) and (FSource[p] in [#10,#13]) and (FSource[p]<>FSource[p-1]) then inc(p); if line=1) and (Line<=FLineCount) and (Column>=1) then begin if (Line=fSrcLen) then begin Line:=-1; Column:=-1; exit; end; if (Position>=FLineRanges[FLineCount-1].StartPos) then begin Line:=FLineCount; Column:=Position-FLineRanges[Line-1].StartPos+1; exit; end; // binary search for the line l:=0; r:=FLineCount-1; repeat m:=(l+r) shr 1; if FLineRanges[m].StartPos>Position then begin // too high, search lower r:=m-1; end else if FLineRanges[m+1].StartPos<=Position then begin // too low, search higher l:=m+1; end else begin // line found Line:=m+1; Column:=Position-FLineRanges[Line-1].StartPos+1; exit; end; until false; end; function TSourceLog.LoadFromFile(const Filename: string): boolean; var s: string; fs: TFileStream; begin Result := True; try fs := TFileStream.Create(UTF8ToSys(Filename), fmOpenRead or fmShareDenyNone); try SetLength(s, fs.Size); if s <> '' then fs.Read(s[1], length(s)); FDiskEncoding := ''; FMemEncoding := ''; DecodeLoaded(Filename, s, FDiskEncoding, FMemEncoding); Source := s; finally fs.Free; end; except Result := False; end; end; procedure TSourceLog.IncreaseChangeStep; begin if FChangeStep<>$7fffffff then inc(FChangeStep) else FChangeStep:=-$7fffffff; //DebugLn('[TSourceLog.IncreaseChangeStep] ',FChangeStep,',',DbgS(Self)); end; function TSourceLog.SaveToFile(const Filename: string): boolean; var fs: TFileStream; TheFilename: String; s: String; begin //DebugLn('TSourceLog.SaveToFile Self=',DbgS(Self)); Result := True; try InvalidateFileStateCache; // keep filename case on disk TheFilename := FindDiskFilename(Filename); if FileExistsUTF8(TheFilename) then fs := TFileStream.Create(UTF8ToSys(TheFilename), fmOpenWrite or fmShareDenyNone) else fs := TFileStream.Create(UTF8ToSys(TheFilename), fmCreate); try s := Source; EncodeSaving(Filename, s); if s <> '' then fs.Write(s[1], length(s)); finally fs.Free; end; except Result := False; end; end; function TSourceLog.GetLines(StartLine, EndLine: integer): string; var StartPos: Integer; EndPos: Integer; begin BuildLineRanges; if StartLine<1 then StartLine:=1; if EndLine>LineCount then EndLine:=LineCount; if StartLine<=EndLine then begin StartPos:=FLineRanges[StartLine-1].StartPos; if EndLinefSource[p] then exit; inc(x); inc(p); end; if (p<=fSrcLen) and (not (fSource[p] in [#10,#13])) then exit; inc(p); if (p<=fSrcLen) and (fSource[p] in [#10,#13]) and (fSource[p]<>fSource[p-1]) then inc(p); inc(y); end; if p'' then System.Move(fSource[fLineRanges[y].StartPos],s[1],length(s)); sl.Add(s); end; sl.EndUpdate; end; end; procedure TSourceLog.LoadFromStream(s: TStream); begin IncreaseHookLock; Clear; if s=nil then exit; s.Position:=0; fSrcLen:=s.Size-s.Position; if fSrcLen>0 then begin SetLength(fSource,fSrcLen); s.Read(fSource[1],fSrcLen); end; fLineCount:=-1; DecreaseHookLock; end; procedure TSourceLog.SaveToStream(s: TStream); begin if fSource<>'' then s.Write(fSource[1],fSrcLen); end; procedure TSourceLog.SetReadOnly(const Value: boolean); begin FReadOnly := Value; end; procedure TSourceLog.IncWriteLock; begin inc(FWriteLock); end; procedure TSourceLog.DecWriteLock; begin if FWriteLock>0 then dec(FWriteLock); end; function TSourceLog.ConsistencyCheck: integer; begin if fSrcLen<>length(fSource) then begin Result:=-1; exit; end; Result:=0; end; function TSourceLog.IndexOfChangeHook(AChangeHook: TOnSourceChange): integer; begin Result:=FChangeHookCount-1; while (Result>=0) and (FChangeHooks[Result]<>AChangeHook) do dec(Result); end; procedure TSourceLog.DecodeLoaded(const AFilename: string; var ASource, ADiskEncoding, AMemEncoding: string); begin if Assigned(OnDecodeLoaded) then OnDecodeLoaded(Self,AFilename,ASource,ADiskEncoding,AMemEncoding); end; procedure TSourceLog.EncodeSaving(const AFilename: string; var ASource: string); begin if Assigned(OnEncodeSaving) then OnEncodeSaving(Self,AFilename,ASource); end; procedure TSourceLog.AddChangeHook(AnOnSourceChange: TOnSourceChange); var i: integer; begin i:=IndexOfChangeHook(AnOnSourceChange); if i>=0 then exit; inc(FChangeHookCount); if FChangeHooks=nil then GetMem(FChangeHooks, SizeOf(TOnSourceChange)) else ReallocMem(FChangeHooks, SizeOf(TOnSourceChange) * FChangeHookCount); FChangeHooks[FChangeHookCount-1]:=AnOnSourceChange; end; procedure TSourceLog.RemoveChangeHook(AnOnSourceChange: TOnSourceChange); var i,j: integer; begin i:=IndexOfChangeHook(AnOnSourceChange); if i<0 then exit; dec(FChangeHookCount); if FChangeHookCount=1 then FreeMem(FChangeHooks) else begin for j:=i to FChangeHookCount-2 do FChangeHooks[j]:=FChangeHooks[j+1]; ReAllocMem(FChangeHooks,SizeOf(TOnSourceChange) * FChangeHookCount); end; end; end.