{******************************************************************************}

{* *}

{* Delphi Designer Parser *}

{* *}

{* (C) 2005 Andreas Hausladen *}

{* *}

{******************************************************************************}

//TODO: Generics

//TODO: verify reference to procedure/function

unit DelphiDesignerParser;

{$I DelphiParser.inc}

interface

uses

SysUtils, Classes, Contnrs, DelphiPreproc, DelphiLexer;

type

TCodeClassList = class;

TModuleType = (

mtUnit, mtProgram, mtLibrary, mtPackage

);

TAccessKind = (

akPrivate, akStrictPrivate, akProtected, akStrictProtected,

akPublic, akPublished

);

TVirtualKind = (

vkStatic, vkVirtual, vkOverride, vkAbstract, vkDynamic, vkMessage

);

TCallConvention = (

ccRegister, ccStdCall, ccCdecl, ccPascal, ccSafecall

);

TArgModifier = (

amNone, amVar, amOut, amConst

);

TMethodType = (

mtConstructor, mtDestructor, mtFunction, mtProcedure

);

TVarListMode = (

vmFunctionArguments, vmFields, vmVariables

);

{ TLocation represents the location in a file }

TLocation = record

Line, Column: Integer;

Filename: string;

Index: Integer; // linear position

end;

{ TCodeSymbol is the base class for all symbols of the parser. }

TCodeSymbol = class(TObject)

private

FName: string;

FAccess: TAccessKind;

FLocation: TLocation;

FStartLocation: TLocation;

FEndLocation: TLocation;

protected

class function FindSymbol(List: TObjectList; const AName: string): TCodeSymbol;

public

constructor Create(const AName: string; const ALocation: TLocation);

function ToString: string; override;

property Name: string read FName;

{ Location returns the location of the symbol's name. }

property Location: TLocation read FLocation;

{ BeginLocation return the location of the symbol's start. }

property StartLocation: TLocation read FStartLocation;

{ EndLocation return the location of the symbol's end. }

property EndLocation: TLocation read FEndLocation;

property Access: TAccessKind read FAccess;

end;

{ TCodeField represents a field of a class. }

TCodeField = class(TCodeSymbol)

private

FTypeName: string;

FIsClassField: Boolean;

protected

procedure SetTypeNameLater(const ATypeName: string);

public

function ToString: string; override;

{ TypeName returns the reformated type as string. E.g. "array [ 0 .. 20 ] of string" }

property TypeName: string read FTypeName;

{ IsClassField return True if the field is a class variable (static)}

property IsClassField: Boolean read FIsClassField;

end;

TCodeProperty = class(TCodeSymbol)

private

FTypeName: string;

FSetter: string;

FAdder: string;

FIsDefault: Boolean;

FRemover: string;

FStorer: string;

FGetter: string;

FIsArray: Boolean;

FIsClassProperty: Boolean;

FIsInheritChange: Boolean;

FIsNoDefault: Boolean;

public

function ToString: string; override;

{ TypeName returns the reformated type as string. E.g. "array [ 0 .. 20 ] of string" }

property TypeName: string read FTypeName;

property Getter: string read FGetter;

property Setter: string read FSetter;

property Adder: string read FAdder;

property Remover: string read FRemover;

property Storer: string read FStorer;

property IsDefault: Boolean read FIsDefault;

property IsNoDefault: Boolean read FIsNoDefault;

property IsArray: Boolean read FIsArray;

property IsClassProperty: Boolean read FIsClassProperty;

property IsInheritChange: Boolean read FIsInheritChange; // specifies if the property is inherited but with differnent visibility/default value.

end;

TCodeLocalVariable = class(TCodeField)

end;

TCodeMethodArg = class(TCodeField)

private

FModifier: TArgModifier;

public

function ToString: string; override;

{ Returns the parameter modifier (none, var, out, const). }

property Modifier: TArgModifier read FModifier;

end;

TCodeMethod = class(TCodeSymbol)

private

FArgs: TObjectList;

FCodeInsert: TLocation;

FVarInsert: TLocation;

FLocalVariables: TObjectList;

FLocalProcs: TObjectList;

FImplLocation: TLocation;

FReturnTypeName: string;

FIsClassStatic: Boolean;

FIsClassMethod: Boolean;

FVirtualKind: TVirtualKind;

FConvention: TCallConvention;

FMethodType: TMethodType;

FIsImplemented: Boolean;

FIsDeclared: Boolean;

FImplEndLocation: TLocation;

FImplBeginLocation: TLocation;

FIsImplEmpty: Boolean;

function GetArg(Index: Integer): TCodeMethodArg;

function GetArgCount: Integer;

function GetLocalVariable(Index: Integer): TCodeLocalVariable;

function GetLocalVariableCount: Integer;

function GetLocalProc(Index: Integer): TCodeMethod;

function GetLocalProcCount: Integer;

protected

function AddArg(Item: TCodeMethodArg): Integer;

function AddLocalVariable(Item: TCodeLocalVariable): Integer;

function AddLocalProc(Item: TCodeMethod): Integer;

public

constructor Create(const AName: string; const ALocation: TLocation);

destructor Destroy; override;

function ToString: string; override;

{ FindArg return nil if no matching parameter was found with the name. }

function FindArg(const AName: string): TCodeMethodArg;

{ IsCompatible returns True if both methods have the same signature

(no name comparision, only type and arg-types). }

function IsCompatible(M: TCodeMethod): Boolean;

{ ImplLocation returns the location where the method is implemented. }

property ImplLocation: TLocation read FImplLocation;

{ ImplBeginLocation returns the location of the method's impl. start }

property ImplBeginLocation: TLocation read FImplBeginLocation;

{ ImplEndLocation returns the location of the method's impl. end }

property ImplEndLocation: TLocation read FImplEndLocation;

{ IsImplEmpty returns True if the impl. method consists only of "begin end" }

property IsImplEmpty: Boolean read FIsImplEmpty;

{ CodeInsert returns the location after the BEGIN in the implementation. }

property CodeInsert: TLocation read FCodeInsert;

{ MethodType returns the type of the method (constructor, destructor,

function, procedure). }

property MethodType: TMethodType read FMethodType;

{ ReturnTypeName returns the reformated return-type as string. E.g. "array [ 0 .. 20 ] of string" }

property ReturnTypeName: string read FReturnTypeName;

{ IsClassMethod returns True if the method is a class method. }

property IsClassMethod: Boolean read FIsClassMethod;

{ IsClassStatic returns True if the method is a static class method. }

property IsClassStatic: Boolean read FIsClassStatic;

{ VirtualKind returns the methods' virtuality kind. }

property VirtualKind: TVirtualKind read FVirtualKind;

{ Convention returns call convention of the method. }

property Convention: TCallConvention read FConvention;

{ IsImplemented return True if the method is in the implementation section.

Is IsDeclared <> IsImplemented then one is missing. }

property IsImplemented: Boolean read FIsImplemented;

{ IsDeclared return True if the method is in the interface section. }

property IsDeclared: Boolean read FIsDeclared;

{ Returns the number of parameters. }

property ArgCount: Integer read GetArgCount;

{ Returns the parameters. }

property Args[Index: Integer]: TCodeMethodArg read GetArg;

{ Returns the number of local variables. }

property LocalVariableCount: Integer read GetLocalVariableCount;

{ Returns the local variables. }

property LocalVariables[Index: Integer]: TCodeLocalVariable read GetLocalVariable;

{ Returns the number of local procedures. }

property LocalProcCount: Integer read GetLocalProcCount;

{ Returns the local procedures. }

property LocalProcss[Index: Integer]: TCodeMethod read GetLocalProc;

end;

{ TCodeClass contains all information the designer parser extracted for a

class (methods, properties, fields). }

TCodeClass = class(TCodeSymbol)

private

FAccessInsert: array[TAccessKind] of TLocation;

FBaseClass: string;

FIsUnitPrivate: Boolean;

FInterfaces: TStringList;

FFields: TObjectList;

FProperties: TObjectList;

FMethods: TObjectList;

function GetInterfaceCount: Integer;

function GetInterfaceItem(Index: Integer): string;

function GetAccessInsert(Access: TAccessKind): TLocation;

function GetField(Index: Integer): TCodeField;

function GetFieldCount: Integer;

function GetMethodCount: Integer;

function GetMethodItem(Index: Integer): TCodeMethod;

function GetProperty(Index: Integer): TCodeProperty;

function GetPropertyCount: Integer;

protected

function AddInterface(const Item: string): Integer;

function AddField(Item: TCodeField): Integer;

function AddProperty(Item: TCodeProperty): Integer;

function AddMethod(Item: TCodeMethod): Integer;

public

constructor Create(const AName: string; const ALocation: TLocation);

destructor Destroy; override;

{ SupportsInterface returns True if the class implements the given

interface directly. }

function SupportsInterface(const AName: string): Boolean;

{ FindProperty return nil if no matching property was found. }

function FindProperty(const AName: string): TCodeProperty;

{ FindField return nil if no matching field was found. }

function FindField(const AName: string): TCodeField;

{ FindMethod return nil if no matching method was found. }

function FindMethod(const AName: string): TCodeMethod;

{ AccessInsert[] returns the location of the access-kind (private, public, ...).

This is the before the next access-kind. }

property AccessInsert[Access: TAccessKind]: TLocation read GetAccessInsert;

{ BaseClass returns the name of the base class. }

property BaseClass: string read FBaseClass;

{ IsUnitPrivate returns True if the class is declared in the implementation

section. }

property IsUnitPrivate: Boolean read FIsUnitPrivate;

{ Supported interfaces. }

property InterfaceCount: Integer read GetInterfaceCount;

property Interfaces[Index: Integer]: string read GetInterfaceItem;

{ Member methods. }

property MethodCount: Integer read GetMethodCount;

property Methods[Index: Integer]: TCodeMethod read GetMethodItem;

{ Member properties. }

property PropertyCount: Integer read GetPropertyCount;

property Properties[Index: Integer]: TCodeProperty read GetProperty;

{ Member fields. }

property FieldCount: Integer read GetFieldCount;

property Fields[Index: Integer]: TCodeField read GetField;

end;

{ TCodeClassList contains a list of code-classes }

TCodeClassList = class(TObject)

private

FItems: TObjectList;

function GetItem(Index: Integer): TCodeClass;

function GetCount: Integer;

protected

procedure Clear;

function Add(Item: TCodeClass): Integer;

public

constructor Create;

destructor Destroy; override;

{ Find returns nil if the class was not found. }

function Find(const ClassName: string): TCodeClass;

{ Classes }

property Count: Integer read GetCount;

property Items[Index: Integer]: TCodeClass read GetItem; default;

end;

TUsesItem = class(TCodeSymbol)

private

FFilename: string;

public

constructor Create(const AName, AFilename: string; const ALocation: TLocation);

{ Name returns the included unit name. }

property Name;

{ Filename returns the specified filename ("bla in 'bla.pas'"), if no

filename was specified it return ''. }

property Filename: string read FFilename;

end;

{ TUsesList contains a list of USES-items. }

TUsesList = class(TObject)

private

FItems: TObjectList;

FLocation: TLocation;

FEndLocation: TLocation;

function GetCount: Integer;

function GetItem(Index: Integer): TUsesItem;

protected

procedure Clear;

function AddUses(Item: TUsesItem): Integer;

public

constructor Create;

destructor Destroy; override;

{ FindUses return nil if no matching USES-item was found. }

function FindUses(const AName: string): TUsesItem;

function IndexOf(AItem: TUsesItem): Integer;

property Count: Integer read GetCount;

property Items[Index: Integer]: TUsesItem read GetItem; default;

{ Location returns the location of the USES-keyword. }

property Location: TLocation read FLocation;

property EndLocation: TLocation read FEndLocation;

end;

{ TDesignerParser parses a file in highspeed. It does not really parse the

code, it simply searches for certain keywords.

After the designer parser has finished it's lists are filled with

information the designer needs. }

TDesignerParser = class(TObject)

private

p: TDelphiPreprocessor;

FImplementation: Boolean;

FClasses: TCodeClassList;

FModuleName: string;

FFormResource: string;

FFilename: string;

FText: UTF8String;

FRepeatLastToken: Boolean;

FImplUses: TUsesList;

FInterfaceUses: TUsesList;

FImplLocation: TLocation;

FInterfaceLocation: TLocation;

FResources: TStringList;

FIncludeFiles: TStringList;

FContains: TUsesList;

FRequires: TUsesList;

FModuleType: TModuleType;

FFunctions: TObjectList;

FIncludeDirs: TStrings;

procedure IncludeFile(Sender: TObject; const Name: string);

procedure Directive(Sender: TObject; Token: TToken);

procedure GetDeclared(Sender: TObject; const Name: string; var Value: Boolean);

procedure GetConstValue(Sender: TObject; const Name: string; var Kind: TTokenKind; var Value: string);

procedure GetConstBoolValue(Sender: TObject; const Name: string; var Value: Boolean);

procedure Clear;

function Look: TToken;

function Next: Boolean;

procedure NextA;

procedure IgnoreProc;

procedure IgnoreRecord;

procedure IgnoreInterface;

function IgnoreBlock(out Empty: Boolean): TLocation;

procedure IgnoreToClassAccess;

procedure IgnoreExternal;

procedure IgnoreFunctionType;

procedure ParseClass;

procedure ParseMethodDecl(C: TCodeClass; Access: TAccessKind; IsClass: Boolean);

procedure ParseProperty(C: TCodeClass; Access: TAccessKind; IsClass: Boolean);

procedure ParseField(C: TCodeClass; Access: TAccessKind; IsClass: Boolean);

function ParseTypeName(const Stop: TTokenKindSet): string;

procedure ParseFunctionArgs(M: TCodeMethod);

procedure ParseUses(List: TUsesList);

procedure ParseFunctionImpl(AParent: TCodeMethod);

procedure ParseDirectives(M: TCodeMethod);

procedure ParseVariableList(List: TObjectList; Mode: TVarListMode);

procedure ParseVariableDecl(List: TObjectList);

function GetResource(Index: Integer): string;

function GetResourceCount: Integer;

function GetIncludeFiles(Index: Integer): string;

function GetIncludeFileCount: Integer;

function GetFunctionCount: Integer;

function GetFunctionItem(Index: Integer): TCodeMethod;

function AddFunction(Item: TCodeMethod): Integer;

function ParseQualifiedName: string;

procedure ParseHead;

protected

procedure InitDefines(Parser: TDelphiPreprocessor); virtual;

public

constructor Create(const AFilename: string; const AText: UTF8String);

destructor Destroy; override;

property IncludeDirs: TStrings read FIncludeDirs;

{ Parses the text which was specified in the constructor call. It fills

the following structures. }

procedure Parse;

{ Parses the head and the interface/implementation uses. }

procedure ParseUsesOnly;

{ Contains every class the parser found in this file (and include files) }

property Classes: TCodeClassList read FClasses;

{ ModuleType can be either mtUnit, mtProgram, mtLibrary or mtPackage }

property ModuleType: TModuleType read FModuleType;

{ ModuleName is the name of the module read from the file content (UNIT name) }

property ModuleName: string read FModuleName;

{ FormResource contains *.dfm, *.nfm or *.xfm if the file includes such a

resource. Otherwise it is '' }

property FormResource: string read FFormResource;

{ ResourceCount returns the number of included resources. }

property ResourceCount: Integer read GetResourceCount;

{ Resources[] returns the resource filename (or *.xxx). The FormResource is

also in this list. }

property Resources[Index: Integer]: string read GetResource;

{ ResourceCount returns the number of included resources. }

property IncludeFileCount: Integer read GetIncludeFileCount;

{ Resources[] returns the resource filename (or *.xxx). The FormResource is

also in this list. }

property IncludeFiles[Index: Integer]: string read GetIncludeFiles;

{ InterfaceUses contains every unit name (+filename if specified) of the

interface USES-clausel (program/library uses). }

property InterfaceUses: TUsesList read FInterfaceUses;

{ ImplUses contains every unit name (+filename if specified) of the

implementation USES-clausel (unit only). }

property ImplUses: TUsesList read FImplUses;

{ Requires contains every required package of the REQUIRES-clausel (package only). }

property Requires: TUsesList read FRequires;

{ Contains contains every contained unit name (+filename if specified) of

the CONTAINS-clausel (package only). }

property Contains: TUsesList read FContains;

{ Functions }

function FindFunction(const AName: string): TCodeMethod;

property FunctionCount: Integer read GetFunctionCount;

property Functions[Index: Integer]: TCodeMethod read GetFunctionItem;

{ InterfaceLocation returns the location of the INTERFACE-keyword. }

property InterfaceLocation: TLocation read FInterfaceLocation;

{ ImplLocation returns the location of the IMPLEMENTATION-keyword. }

property ImplLocation: TLocation read FImplLocation;

{ Filename returns the name of the file to parse (-> constructor) }

property Filename: string read FFilename;

{ Text returns the text to parse (-> constructor) }

property Text: UTF8String read FText;

end;

const

EmptyLocation: TLocation = (Line: 0; Column: 0; Filename: '');

implementation

uses

StrUtils;

const

ClassAvailableTokens = [tkIdent..tkIdentStrictReserved] -

[tkI_public, tkI_private, tkI_protected, tkI_strict, tkI_published,

tkI_end, tkI_class, tkI_var, tkI_const, tkI_out, tkI_property,

tkI_implementation];

SectionEndTokens = [tkIdentStrictReserved..tkLast];

ClassSectionEndTokens = SectionEndTokens + [tkI_strict];

ArgModifierTokens = [tkI_var, tkI_out, tkI_const];

PropertyTokens = [tkI_read, tkI_write, tkI_add, tkI_remove, tkI_stored, tkI_default];

function TokenToLocation(Token: TToken): TLocation;

begin

Result.Line := Token.Line;

Result.Column := Token.Column;

Result.Filename := Token.Filename;

Result.Index := Token.Index;

end;

{ TCodeSymbol }

constructor TCodeSymbol.Create(const AName: string; const ALocation: TLocation);

begin

inherited Create;

FName := AName;

FLocation := ALocation;

FAccess := akPublished;

end;

class function TCodeSymbol.FindSymbol(List: TObjectList; const AName: string): TCodeSymbol;

var

i: Integer;

begin

for i := 0 to List.Count - 1 do

begin

Result := TCodeSymbol(List[i]);

if SameText(Result.Name, AName) then

Exit;

end;

Result := nil;

end;

function TCodeSymbol.ToString: string;

begin

Result := FName;

end;

{ TCodeField }

procedure TCodeField.SetTypeNameLater(const ATypeName: string);

begin

FTypeName := ATypeName;

end;

function TCodeField.ToString: string;

begin

Result := Name + ': ' + TypeName;

end;

{ TCodeProperty }

function TCodeProperty.ToString: string;

begin

Result := Name;

if IsArray then

Result := Result + '[]';

Result := Result + ': ' + TypeName;

if Getter <> '' then

Result := Result + ' read ' + Getter;

if Adder <> '' then

Result := Result + ' add ' + Adder;

if Setter <> '' then

Result := Result + ' write ' + Setter;

if Remover <> '' then

Result := Result + ' remove ' + Remover;

if Storer <> '' then

Result := Result + ' stored ' + Storer;

if IsDefault then

Result := Result + '; default'

else

if IsNoDefault then

Result := Result + '; nodefault';

end;

{ TCodeMethodArg }

function TCodeMethodArg.ToString: string;

begin

case Modifier of

amVar: Result := 'var ';

amOut: Result := 'out ';

amConst: Result := 'const ';

else

Result := '';

end;

Result := Result + inherited ToString;

end;

{ TCodeMethod }

function TCodeMethod.AddArg(Item: TCodeMethodArg): Integer;

begin

Result := FArgs.Add(Item);

end;

function TCodeMethod.AddLocalVariable(Item: TCodeLocalVariable): Integer;

begin

Result := FLocalVariables.Add(Item);

end;

function TCodeMethod.AddLocalProc(Item: TCodeMethod): Integer;

begin

Result := FLocalProcs.Add(Item);

end;

constructor TCodeMethod.Create(const AName: string; const ALocation: TLocation);

begin

inherited Create(AName, ALocation);

FArgs := TObjectList.Create;

FLocalVariables := TObjectList.Create;

FLocalProcs := TObjectList.Create;

end;

destructor TCodeMethod.Destroy;

begin

FLocalProcs.Free;

FLocalVariables.Free;

FArgs.Free;

inherited Destroy;

end;

function TCodeMethod.IsCompatible(M: TCodeMethod): Boolean;

var

i: Integer;

begin

if M = Self then

Result := True

else if M = nil then

Result := False

else

begin

Result := (MethodType = M.MethodType) and (Convention = M.Convention) and

(IsClassMethod = M.IsClassMethod) and (IsClassStatic = M.IsClassStatic) and

(ArgCount = M.ArgCount) and (ReturnTypeName = M.ReturnTypeName);

if Result then

begin

for i := 0 to ArgCount - 1 do

begin

Result := (Args[i].Modifier = M.Args[i].Modifier) and

(Args[i].TypeName = M.Args[i].TypeName);

if not Result then

Exit;

end;

end;

end;

end;

function TCodeMethod.FindArg(const AName: string): TCodeMethodArg;

begin

Result := TCodeMethodArg(FindSymbol(FArgs, AName));

end;

function TCodeMethod.GetArg(Index: Integer): TCodeMethodArg;

begin

Result := TCodeMethodArg(FArgs[Index]);

end;

function TCodeMethod.GetArgCount: Integer;

begin

Result := FArgs.Count;

end;

function TCodeMethod.ToString: string;

var

i: Integer;

begin

case MethodType of

mtConstructor: Result := 'constructor';

mtDestructor: Result := 'destructor';

mtFunction: Result := 'function';

mtProcedure: Result := 'procedure';

end;

Result := Result + ' ' + Name + '(';

for i := 0 to ArgCount - 1 do

begin

Result := Result + Args[i].ToString;

if i < ArgCount - 1 then

Result := Result + '; ';

end;

Result := Result + ')';

if ReturnTypeName <> '' then

Result := Result + ': ' + ReturnTypeName;

end;

function TCodeMethod.GetLocalVariableCount: Integer;

begin

Result := FLocalVariables.Count;

end;

function TCodeMethod.GetLocalVariable(Index: Integer): TCodeLocalVariable;

begin

Result := TCodeLocalVariable(FLocalVariables[Index]);

end;

function TCodeMethod.GetLocalProcCount: Integer;

begin

Result := FLocalProcs.Count;

end;

function TCodeMethod.GetLocalProc(Index: Integer): TCodeMethod;

begin

Result := TCodeMethod(FLocalProcs[Index]);

end;

{ TCodeClass }

constructor TCodeClass.Create(const AName: string; const ALocation: TLocation);

begin

inherited Create(AName, ALocation);

FInterfaces := TStringList.Create;

FFields := TObjectList.Create;

FProperties := TObjectList.Create;

FMethods := TObjectList.Create;

end;

destructor TCodeClass.Destroy;

begin

FInterfaces.Free;

FFields.Free;

FProperties.Free;

FMethods.Free;

inherited Destroy;

end;

function TCodeClass.GetInterfaceItem(Index: Integer): string;

begin

Result := FInterfaces[Index];

end;

function TCodeClass.GetInterfaceCount: Integer;

begin

Result := FInterfaces.Count;

end;

function TCodeClass.GetAccessInsert(Access: TAccessKind): TLocation;

begin

Result := FAccessInsert[Access];

end;

function TCodeClass.GetPropertyCount: Integer;

begin

Result := FProperties.Count;

end;

function TCodeClass.GetMethodCount: Integer;

begin

Result := FMethods.Count;

end;

function TCodeClass.GetFieldCount: Integer;

begin

Result := FFields.Count;

end;

function TCodeClass.GetProperty(Index: Integer): TCodeProperty;

begin

Result := TCodeProperty(FProperties[Index]);

end;

function TCodeClass.GetMethodItem(Index: Integer): TCodeMethod;

begin

Result := TCodeMethod(FMethods[Index]);

end;

function TCodeClass.GetField(Index: Integer): TCodeField;

begin

Result := TCodeField(FFields[Index]);

end;

function TCodeClass.FindField(const AName: string): TCodeField;

begin

Result := TCodeField(FindSymbol(FFields, AName));

end;

function TCodeClass.FindProperty(const AName: string): TCodeProperty;

begin

Result := TCodeProperty(FindSymbol(FProperties, AName));

end;

function TCodeClass.FindMethod(const AName: string): TCodeMethod;

begin

Result := TCodeMethod(FindSymbol(FMethods, AName));

end;

function TCodeClass.AddProperty(Item: TCodeProperty): Integer;

begin

Result := FProperties.Add(Item);

end;

function TCodeClass.AddMethod(Item: TCodeMethod): Integer;

begin

Result := FMethods.Add(Item);

end;

function TCodeClass.AddField(Item: TCodeField): Integer;

begin

Result := FFields.Add(Item);

end;

function TCodeClass.AddInterface(const Item: string): Integer;

begin

Result := FInterfaces.Add(Item);

end;

function TCodeClass.SupportsInterface(const AName: string): Boolean;

begin

Result := FInterfaces.IndexOf(AName) >= 0;

end;

{ TCodeClassList }

constructor TCodeClassList.Create;

begin

inherited Create;

FItems := TObjectList.Create;

end;

destructor TCodeClassList.Destroy;

begin

FItems.Free;

inherited Destroy;

end;

function TCodeClassList.GetCount: Integer;

begin

Result := FItems.Count;

end;

function TCodeClassList.Find(const ClassName: string): TCodeClass;

var

i: Integer;

begin

for i := 0 to Count - 1 do

begin

Result := Items[i];

if SameText(Result.Name, ClassName) then

Exit;

end;

Result := nil;

end;

function TCodeClassList.Add(Item: TCodeClass): Integer;

begin

Result := FItems.Add(Item);

end;

function TCodeClassList.GetItem(Index: Integer): TCodeClass;

begin

Result := TCodeClass(FItems[Index]);

end;

procedure TCodeClassList.Clear;

begin

FItems.Clear;

end;

{ TUsesItem }

constructor TUsesItem.Create(const AName, AFilename: string; const ALocation: TLocation);

begin

inherited Create(AName, ALocation);

FName := AName;

FFilename := AFilename;

FLocation := ALocation;

end;

{ TUsesList }

constructor TUsesList.Create;

begin

inherited Create;

FItems := TObjectList.Create;

end;

destructor TUsesList.Destroy;

begin

FItems.Free;

inherited Destroy;

end;

function TUsesList.AddUses(Item: TUsesItem): Integer;

begin

Result := FItems.Add(Item);

end;

function TUsesList.FindUses(const AName: string): TUsesItem;

var

i: Integer;

begin

for i := 0 to Count - 1 do

begin

Result := Items[i];

if SameText(Result.Name, AName) then

Exit;

end;

Result := nil;

end;

function TUsesList.GetCount: Integer;

begin

Result := FItems.Count;

end;

function TUsesList.GetItem(Index: Integer): TUsesItem;

begin

Result := TUsesItem(FItems[Index]);

end;

function TUsesList.IndexOf(AItem: TUsesItem): Integer;

begin

Result := FItems.IndexOf(AItem);

end;

procedure TUsesList.Clear;

begin

FItems.Clear;

end;

{ TDesignerParser }

constructor TDesignerParser.Create(const AFilename: string; const AText: UTF8String);

begin

inherited Create;

FClasses := TCodeClassList.Create;

FFilename := AFilename;

FText := AText;

FInterfaceUses := TUsesList.Create;

FImplUses := TUsesList.Create;

FResources := TStringList.Create;

FIncludeFiles := TStringList.Create;

FRequires := TUsesList.Create;

FContains := TUsesList.Create;

FFunctions := TObjectList.Create;

FIncludeDirs := TStringList.Create;

end;

destructor TDesignerParser.Destroy;

begin

FIncludeDirs.Free;

FFunctions.Free;

FInterfaceUses.Free;

FImplUses.Free;

FClasses.Free;

FIncludeFiles.Free;

FResources.Free;

FRequires.Free;

FContains.Free;

inherited Destroy;

end;

procedure TDesignerParser.Clear;

begin

FInterfaceUses.Clear;

FImplUses.Clear;

FResources.Clear;

FIncludeFiles.Clear;

FClasses.Clear;

FModuleName := '';

FModuleType := mtUnit;

FFormResource := '';

FImplLocation := EmptyLocation;

FInterfaceLocation := EmptyLocation;

FImplementation := False;

FRepeatLastToken := False;

FRequires.Clear;

FContains.Clear;

FFunctions.Clear;

end;

function TDesignerParser.GetResource(Index: Integer): string;

begin

Result := FResources[Index];

end;

function TDesignerParser.GetResourceCount: Integer;

begin

Result := FResources.Count;

end;

function TDesignerParser.GetIncludeFiles(Index: Integer): string;

begin

Result := FIncludeFiles[Index];

end;

function TDesignerParser.GetIncludeFileCount: Integer;

begin

Result := FIncludeFiles.Count;