unit dwsScriptSource;

System.SysUtils, dwsStrings, dwsUtils, dwsXPlatform;

// TSourceFile

//

TSourceFile = class (TRefCountedObject)

private

FLineCount : Integer;

FName, FLocation, FCode : String;

FNotSteppable : Boolean;

public

property Name : String read FName write FName;

property Location : String read FLocation write FLocation;

property Code : String read FCode write FCode;

function LineCount : Integer;

property NotSteppable : Boolean read FNotSteppable write FNotSteppable;

end;

// TScriptPos

//

PScriptPos = ^TScriptPos;

TScriptPos = packed record

public

Line : Integer;

Col : Integer;

SourceFile : TSourceFile;

class function Create(aSourceFile : TSourceFile; aLine, aCol : Integer) : TScriptPos; static;

procedure Clear; inline;

function SamePosAs(const aPos : TScriptPos) : Boolean; inline;

function IsMainModule : Boolean;

function IsSourceFile(const name : String) : Boolean;

procedure GetSourceName(var result : String); inline;

function SourceName : String; inline;

function SourceCode : String; inline;

function Defined : Boolean;

procedure IncCol; inline;

procedure DecCol; inline;

procedure NewLine; inline;

procedure SetColLine(aCol, aLine : Integer); inline;

procedure SetLineCol(const aPos : TScriptPos); inline;

function IsBeforeOrEqual(const aPos : TScriptPos) : Boolean;

function Compare(const aPos : TScriptPos) : Integer;

procedure ReplaceIfArgIsDefined(const aPos : TScriptPos);

function AsInfo : String;

end;

TScriptPosArray = array of TScriptPos; // dynamic array that can hold ScriptPos settings (needed for ReadNameList)

TScriptSourceType = (stMain, stUnit, stUnitNamespace, stInclude, stRecompile);

// A specific ScriptSource entry. The text of the script contained in that unit.

TScriptSourceItem = class (TRefCountedObject)

private

FNameReference : String;

FSourceFile : TSourceFile;

FSourceType : TScriptSourceType;

public

constructor Create(const ANameReference: String; ASourceFile: TSourceFile; ASourceType: TScriptSourceType);

destructor Destroy; override;

property NameReference : String read FNameReference write FNameReference;

property SourceFile : TSourceFile read FSourceFile;

property SourceType : TScriptSourceType read FSourceType;

end;

// Manage a list of all the different Script Texts (files) used in the program.

TScriptSourceList = class

private

FSourceList : TTightList;

FMainScript : TScriptSourceItem;

protected

function GetSourceItem(index : Integer) : TScriptSourceItem; inline;

public

constructor Create;

destructor Destroy; override;

procedure Clear;

function Add(const nameReference : String; const code: String; sourceType: TScriptSourceType;

const location : String) : TSourceFile;

function FindScriptSourceItem(const sourceFileName: String): TScriptSourceItem; overload;

function IndexOf(const sourceFileName: String): Integer; overload;

property Count : Integer read FSourceList.FCount;

property Items[index: Integer] : TScriptSourceItem read GetSourceItem; default;

property MainScript: TScriptSourceItem read FMainScript;

end;

procedure ConcatScriptPosArray(var dest : TScriptPosarray; const src : TScriptPosarray; nb : Integer);

cNullPos: TScriptPos = (Line: 0; Col: 0; SourceFile: nil);

procedure ConcatScriptPosArray(var dest : TScriptPosarray; const src : TScriptPosarray; nb : Integer);

nd : Integer;

if nb=0 then Exit;

nd:=Length(dest);

SetLength(dest, nd+nb);

System.Move(src[0], dest[nd], SizeOf(TScriptPos)*nb);

end;

class function TScriptPos.Create(aSourceFile : TSourceFile; aLine, aCol : Integer) : TScriptPos;

Result.SourceFile:=aSourceFile;

Result.Line:=aLine;

Result.Col:=aCol;

end;

procedure TScriptPos.Clear;

SourceFile:=nil;

Line:=0;

Col:=Line;

end;

function TScriptPos.SamePosAs(const aPos : TScriptPos) : Boolean;

Result:= (Line=aPos.Line) and (Col=aPos.Col)

and (SourceFile=aPos.SourceFile);

end;

function TScriptPos.IsMainModule : Boolean;

Result:=(SourceFile=nil) or (SourceFile.Name=MSG_MainModule);

end;

function TScriptPos.IsSourceFile(const name : String) : Boolean;

Result:=(SourceFile<>nil) and UnicodeSameText(SourceFile.Name, name);

end;

procedure TScriptPos.GetSourceName(var result : String);

if SourceFile<>nil then

Result := SourceFile.Name

else Result := '';

end;

function TScriptPos.SourceName : String;

GetSourceName(Result);

end;

function TScriptPos.SourceCode : String;

if SourceFile<>nil then

Result:=SourceFile.Code

else Result:='';

end;

function TScriptPos.Defined : Boolean;

Result:=(SourceFile<>nil) and ((Line or Col)<>0);

end;

procedure TScriptPos.IncCol;

Inc(Col);

end;

procedure TScriptPos.DecCol;

Dec(Col);

end;

procedure TScriptPos.NewLine;

Inc(Line);

Col:=1;

end;

procedure TScriptPos.SetColLine(aCol, aLine : Integer);

Col:=aCol;

Line:=aLine;

end;

procedure TScriptPos.SetLineCol(const aPos : TScriptPos);

PUInt64(@Self)^:=PUInt64(@aPos)^;

end;

function TScriptPos.IsBeforeOrEqual(const aPos : TScriptPos) : Boolean;

Result:= (SourceFile=aPos.SourceFile)

and ( (Line<aPos.Line)

or ((Line=aPos.Line) and (Col<=aPos.Col)));

end;

function TScriptPos.Compare(const aPos : TScriptPos) : Integer;

if SourceFile <> aPos.SourceFile then begin

if SourceFile.Name < aPos.SourceName then

Result := 1

else Result := -1;

end else if Line < aPos.Line then

Result := -1

else if Line > aPos.Line then

Result := 1

else if Col < aPos.Col then

Result := -1

else if Col > aPos.Col then

Result := 1

else Result := 0;

end;

procedure TScriptPos.ReplaceIfArgIsDefined(const aPos : TScriptPos);

if aPos.Defined then

Self := aPos;

end;

function TScriptPos.AsInfo : String;

if SourceFile=nil then

Result:=''

else begin

if not IsMainModule then

if SourceFile.Location <> '' then

Result:=Format(MSG_ScriptPosFileFull, [SourceFile.Name, SourceFile.Location])

else Result:=Format(MSG_ScriptPosFile, [SourceFile.Name])

else Result:='';

if Col<>cNullPos.Col then begin

if Result<>'' then

Result:=', '+Result;

Result:=Format(MSG_ScriptPosColumn, [Col])+Result;

end;

if Line<>cNullPos.Line then begin

if Result<>'' then

Result:=', '+Result;

Result:=Format(MSG_ScriptPosLine, [Line])+Result;

end;

if Result<>'' then

Result:=' ['+Result+']';

end;

end;

function TSourceFile.LineCount : Integer;

i : Integer;

if FLineCount=0 then begin

FLineCount:=1;

for i:=1 to Length(Code) do

if Code[i]=#10 then

Inc(FLineCount);

end;

Result:=FLineCount;

end;

constructor TScriptSourceItem.Create(const ANameReference: String; ASourceFile: TSourceFile;

ASourceType: TScriptSourceType);

inherited Create;

FNameReference := ANameReference;

FSourceFile := ASourceFile;

FSourceType := ASourceType;

end;

destructor TScriptSourceItem.Destroy;

FSourceFile.Free;

inherited;

end;

constructor TScriptSourceList.Create;

inherited;

FMainScript:=nil;

end;

destructor TScriptSourceList.Destroy;

Clear;

FSourceList.Free;

inherited;

end;

function TScriptSourceList.Add(

const nameReference : String; const code : String;

sourceType: TScriptSourceType; const location : String) : TSourceFile;

srcItem : TScriptSourceItem;

srcItem := FindScriptSourceItem(nameReference);

if srcItem = nil then begin

Result := TSourceFile.Create;

Result.Name := nameReference;

Result.Location := location;

Result.Code := code;

srcItem := TScriptSourceItem.Create(nameReference, Result, sourceType);

FSourceList.Add(srcItem);

// get a pointer to the 'main' script item

if sourceType = stMain then

FMainScript := srcItem;

end else begin

Result := srcItem.SourceFile;

end;

end;

procedure TScriptSourceList.Clear;

FSourceList.Clean;

FMainScript:=nil;

end;

function TScriptSourceList.GetSourceItem(Index: Integer): TScriptSourceItem;

Result := TScriptSourceItem(FSourceList.List[Index]);

end;

function TScriptSourceList.FindScriptSourceItem(const sourceFileName: String): TScriptSourceItem;

x : Integer;

x:=IndexOf(SourceFileName);

if x>=0 then

Result:=Items[x]

else Result:=nil;

end;

function TScriptSourceList.IndexOf(const SourceFileName: String): Integer;

x: Integer;

for x := 0 to FSourceList.Count-1 do

if UnicodeSameText(Items[x].NameReference, SourceFileName) then

Exit(x);

Result:=-1;

end;

end.