unit BasicCodeTools;

{$mode objfpc}

{$ifdef MSWindows}

{$define Windows}

{$endif}

Classes, SysUtils, StrUtils, AVL_Tree,

// LazUtils

LazFileUtils, LazStringUtils, LazUTF8,

// Codetools

SourceLog, KeywordFuncLists, FileProcs;

function FindNextNonSpace(const ASource: string; StartPos: integer): integer;

function FindPrevNonSpace(const ASource: string; StartPos: integer): integer;

function FindCommentEnd(const ASource: string; StartPos: integer;

NestedComments: boolean): integer; overload;

function FindCommentEnd(Src: PChar; NestedComments: boolean): PChar; overload;

function IsCommentEnd(const ASource: string; EndPos: integer): boolean;

function FindNextComment(const ASource: string;

StartPos: integer; MaxPos: integer = 0): integer;

procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;

out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;

NestedComments: boolean = false);

function FindNextCompilerDirective(const ASource: string; StartPos: integer;

NestedComments: boolean; MaxPos: integer = -1): integer;

function FindNextCompilerDirectiveWithName(const ASource: string;

StartPos: integer; const DirectiveName: string;

NestedComments: boolean; out ParamPos: integer): integer;

function FindNextIncludeDirective(const ASource: string;

StartPos: integer; NestedComments: boolean;

out FilenameStartPos, FileNameEndPos,

CommentStartPos, CommentEndPos: integer): integer;

function FindNextIDEDirective(const ASource: string; StartPos: integer;

NestedComments: boolean; EndPos: integer = 0): integer;

function CleanCodeFromComments(const Src: string;

NestedComments: boolean; KeepDirectives: boolean = false;

KeepVerbosityDirectives: boolean = false): string;

function ExtractCommentContent(const ASource: string; CommentStart: integer;

NestedComments: boolean;

TrimStart: boolean = false; TrimEnd: boolean = false;

TrimPasDoc: boolean = false): string;

function FindMainUnitHint(const ASource: string; out Filename: string): boolean;

function InEmptyLine(const ASource: string; StartPos: integer): boolean;

function SkipResourceDirective(const ASource: string; StartPos, EndPos: integer;

NestedComments: boolean): integer;

function GetLineIndent(const Source: string; Position: integer): integer;

function GetLineIndentWithTabs(const Source: string; Position: integer;

TabWidth: integer): integer;

function GetPosInLine(const Source: string; Position: integer): integer; // 0 based

function GetBlockMinIndent(const Source: string;

StartPos, EndPos: integer): integer;

function GetIndentStr(Indent: integer; TabWidth: integer = 0): string;

procedure IndentText(const Source: string; Indent, TabWidth: integer;

out NewSource: string);

function FindFirstNonSpaceCharInLine(const Source: string;

Position: integer): integer;

function IsFirstNonSpaceCharInLine(const Source: string;

Position: integer): boolean;

procedure GuessIndentSize(const Source: string;

var IndentSize: integer; TabWidth: integer = 2; MaxLineCount: integer = 10000);

function ReIndent(const Source: string; OldIndent, OldTabWidth,

NewIndent, NewTabWidth: integer): string;

procedure GetIdentStartEndAtPosition(const Source:string; Position:integer;

out IdentStart,IdentEnd:integer);

function GetIdentStartPosition(const Source:string; Position:integer): integer;

function GetIdentLen(Identifier: PChar): integer;

function GetIdentifier(Identifier: PChar; aSkipAmp: Boolean = True;

IsDottedIdent: Boolean = False): string;

function FindNextIdentifier(const Source: string; StartPos, MaxPos: integer): integer;

function FindNextIdentifierSkipStrings(const Source: string;

StartPos, MaxPos: integer): integer;

function IsValidDottedIdent(const Ident: string; AllowDots: Boolean = True): Boolean; // as sysutils.IsValidIdent, but faster and supports &

function IsValidIdentPair(const NamePair: string): boolean; // true if exactly two identifiers separated by a dot

function IsValidIdentPair(const NamePair: string; out First, Second: string): boolean;

function ExtractPasIdentifier(const Ident: string; AllowDots: Boolean): string; // removes non identifier chars

function SrcPosToLineCol(const s: string; Position: integer;

out Line, Col: integer): boolean;

procedure GetLineStartEndAtPosition(const Source: string; Position:integer;

out LineStart,LineEnd:integer); // LineEnd at first line break character

function GetLineStartPosition(const Source: string; Position:integer): integer;

function GetLineInSrc(const Source: string; Position:integer): string;

function LineEndCount(const Txt: string): integer; inline;

function LineEndCount(const Txt: string; out LengthOfLastLine:integer): integer; inline;

function LineEndCount(const Txt: string; StartPos, EndPos: integer;

out LengthOfLastLine:integer): integer;

function EmptyCodeLineCount(const Source: string; StartPos, EndPos: integer;

NestedComments: boolean): integer;

function PositionsInSameLine(const Source: string;

Pos1, Pos2: integer): boolean;

function FindLineEndOrCodeInFrontOfPosition(const Source: string;

Position, MinPosition: integer; NestedComments: boolean;

StopAtDirectives: boolean = true; SkipSemicolonComma: boolean = true;

SkipEmptyLines: boolean = false): integer;

function FindLineEndOrCodeAfterPosition(const Source: string;

Position, MaxPosition: integer; NestedComments: boolean;

StopAtDirectives: boolean = true; SkipEmptyLines: boolean = false;

IncludeLineEnd: boolean = false): integer;

function FindFirstLineEndInFrontOfInCode(const Source: string;

Position, MinPosition: integer; NestedComments: boolean): integer;

function FindFirstLineEndAfterInCode(const Source: string;

Position, MaxPosition: integer; NestedComments: boolean): integer;

function ChompLineEndsAtEnd(const s: string): string;

function ChompOneLineEndAtEnd(const s: string): string;

function TrimLineEnds(const s: string; TrimStart, TrimEnd: boolean): string;

function GetBracketLvl(const Src: string; StartPos, EndPos: integer;

NestedComments: boolean): integer;

procedure SkipPascalInterpolatedString(var p: PChar; NestedComments: Boolean);

function ReplacementNeedsLineEnd(const Source: string;

FromPos, ToPos, NewLength, MaxLineLength: integer): boolean;

function CountNeededLineEndsToAddForward(const Src: string;

StartPos, MinLineEnds: integer): integer;

function CountNeededLineEndsToAddBackward(const Src: string;

StartPos, MinLineEnds: integer): integer;

procedure AdjustPositionAfterInsert(var p: integer; IsStart: boolean;

FromPos, ToPos, DiffPos: integer);

function CompareText(Txt1: PChar; Len1: integer; Txt2: PChar; Len2: integer;

CaseSensitive: boolean): integer; overload;

function CompareTextCT(const Txt1, Txt2: string;

CaseSensitive: boolean = false): integer; overload;

function CompareText(Txt1: PChar; Len1: integer; Txt2: PChar; Len2: integer;

CaseSensitive, IgnoreSpace: boolean): integer; overload;

function CompareTextIgnoringSpace(const Txt1, Txt2: string;

CaseSensitive: boolean): integer;

function CompareTextIgnoringSpace(Txt1: PChar; Len1: integer;

Txt2: PChar; Len2: integer; CaseSensitive: boolean): integer;

function CompareAnsiStringIgnoringSpaceIgnoreCase(Txt1, Txt2: pointer): integer;

function CompareSubStrings(const Find, Txt: string;

FindStartPos, TxtStartPos, Len: integer; CaseSensitive: boolean): integer;

function CompareIdentifiers(Identifier1, Identifier2: PChar): integer; {$IFDEF HasInline}inline;{$ENDIF}

function CompareIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;

function CompareIdentifierPtrs(Identifier1, Identifier2: Pointer): integer; {$IFDEF HasInline}inline;{$ENDIF}

function ComparePrefixIdent(PrefixIdent, Identifier: PChar): boolean;

function TextBeginsWith(Txt: PChar; TxtLen: integer; StartTxt: PChar;

StartTxtLen: integer; CaseSensitive: boolean): boolean;

function StrBeginsWith(const s, Prefix: string): boolean;

function IdentifierPos(Search, Identifier: PChar): PtrInt; // search Search in Identifier

function CompareAtom(p1, p2: PChar; NestedComments: boolean): integer;

function CompareStringConstants(p1, p2: PChar): integer; // compare case sensitive

function CompareComments(p1, p2: PChar; NestedComments: boolean): integer; // compare case insensitive

function FindDiff(const s1, s2: string): integer;

function dbgsDiff(Expected, Actual: string): string; overload;

function DottedIdentifierLength(Identifier: PChar): integer;

function GetDottedIdentifier(Identifier: PChar): string;

function IsDottedIdentifier(const Identifier: string; AllowAmp: boolean = True): boolean;

function GetDotCountInIdentifier(Identifier: PChar): integer; // -1 if not an identifier

function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;

function CompareDottedIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;

function ChompDottedIdentifier(const Identifier: string): string;

function SkipDottedIdentifierPart(var Identifier: PChar): boolean;

function DottedIdentifierStartsWith(Identifier, StartsWithIdent: PChar): boolean; // true if equal or longer

function DottedIdentifierEndsWith(Identifier, EndsWithIdent: PChar): boolean; // true if equal or longer

function SplitDottedIdentifier(const Dotted: string; out Arr: TStringArray; SkipAmps: boolean = false): boolean;

function TrimCodeSpace(const ACode: string): string;

function CodeIsOnlySpace(const ACode: string; FromPos, ToPos: integer): boolean;

function StringToPascalConst(const s: string): string;

function UnicodeSpacesToASCII(const s: string): string;

function RemoveAmpersands(const s: string): string;

function SplitStringConstant(const StringConstant: string;

FirstLineLength, OtherLineLengths, Indent: integer;

const aLineBreak: string): string;

procedure ImproveStringConstantStart(const ACode: string; var StartPos: integer);

procedure ImproveStringConstantEnd(const ACode: string; var EndPos: integer);

function HexStrToIntDef(p: PChar; Def: integer): integer;

function SearchNextInText(Search: PChar; SearchLen: PtrInt;

Src: PChar; SrcLen: PtrInt;

StartPos: PtrInt;// 0 based

out MatchStart, MatchEnd: PtrInt;// 0 based

WholeWords: boolean = false; MultiLine: boolean = false): boolean;

procedure HasTxtWord(SearchWord, Txt: PChar; out WholeWord: boolean;

out Count: SizeInt);

function SubString(p: PChar; Count: SizeInt): string; overload;

{ TUnitFileInfo }

TUnitFileInfo = class

private

FFilename: string;

FUnitName: string;

function GetFileUnitNameWithoutNamespace: string;

function GetIdentifierStartInUnitName: Integer;

public

constructor Create(const TheUnitName, TheFilename: string);

property FileUnitName: string read FUnitName;

property FileUnitNameWithoutNamespace: string read GetFileUnitNameWithoutNamespace;

property Filename: string read FFilename;

property IdentifierStartInUnitName: Integer read GetIdentifierStartInUnitName;

end;

{ TNameSpaceInfo }

TNameSpaceInfo = class

private

FUnitName: string;

FNamespace: string;

FIdentifierStartInUnitName: Integer;

public

constructor Create(const TheNamespace, TheUnitName: string; TheIdentifierStartInUnitName: Integer);

property UnitName: string read FUnitName;

property Namespace: string read FNamespace;

property IdentifierStartInUnitName: Integer read FIdentifierStartInUnitName;

end;

function ExtractFileNamespace(const Filename: string): string;

procedure AddToTreeOfUnitFilesOrNamespaces(

var TreeOfUnitFiles, TreeOfNameSpaces: TAVLTree;

const NameSpacePath, Filename: string;

CaseInsensitive, KeepDoubles: boolean);

function GatherUnitFiles(const BaseDir, SearchPath,

Extensions, NameSpacePath: string; KeepDoubles, CaseInsensitive: boolean;

var TreeOfUnitFiles, TreeOfNamespaces: TAVLTree): boolean;

procedure FreeTreeOfUnitFiles(TreeOfUnitFiles: TAVLTree);

procedure AddToTreeOfUnitFiles(var TreeOfUnitFiles: TAVLTree;

const Filename, Unitname: string;

KeepDoubles: boolean);

procedure AddToTreeOfNamespaces(var TreeOfNameSpaces: TAVLTree;

const UnitName, ParentNameSpacePath: string;

KeepDoubles: boolean);

function CompareUnitFileInfos(Data1, Data2: Pointer): integer;

function CompareNameSpaceInfos(Data1, Data2: Pointer): integer;

function CompareUnitNameAndUnitFileInfo(UnitnamePAnsiString,

UnitFileInfo: Pointer): integer;

function CompareNameSpaceAndNameSpaceInfo(NamespacePAnsiString,

NamespaceInfo: Pointer): integer;

function FindSourceType(const Source: string;

var SrcNameStart, SrcNameEnd: integer; NestedComments: boolean = false): string;

function ReadDottedIdentifier(const Source: string; var Position: integer;

NestedComments: boolean = false; aSkipAmp: boolean = true): string;

function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar;

NestedComments: boolean = false; aSkipAmp: boolean = true): string;

function RenameProgramInSource(Source:TSourceLog;

const NewProgramName:string):boolean;

function FindProgramNameInSource(const Source:string;

out ProgramNameStart,ProgramNameEnd:integer):string;

function RenameUnitInSource(Source:TSourceLog;const NewUnitName:string):boolean;

function FindUnitNameInSource(const Source:string;

out UnitNameStart,UnitNameEnd: integer; NestedComments: boolean = false):string;

function FindModuleNameInSource(const Source:string;

out ModuleType: string; out NameStart,NameEnd: integer;

NestedComments: boolean = false):string;

function UnitIsUsedInSource(const Source,SrcUnitName:string):boolean;

function RenameUnitInProgramUsesSection(Source:TSourceLog;

const OldUnitName, NewUnitName, NewInFile:string): boolean;

function AddToProgramUsesSection(Source:TSourceLog;

const AUnitName,InFileName:string):boolean;

function RemoveFromProgramUsesSection(Source:TSourceLog;

const AUnitName:string):boolean;

function RenameUnitInInterfaceUsesSection(Source:TSourceLog;

const OldUnitName, NewUnitName, NewInFile:string): boolean;

function AddToInterfaceUsesSection(Source:TSourceLog;

const AUnitName,InFileName:string):boolean;

function RemoveFromInterfaceUsesSection(Source:TSourceLog;

const AUnitName:string):boolean;

function IsUnitUsedInUsesSection(const Source,SrcUnitName:string;

UsesStart:integer):boolean;

function RenameUnitInUsesSection(Source:TSourceLog; UsesStart: integer;

const OldUnitName, NewUnitName, NewInFile:string): boolean;

function AddUnitToUsesSection(Source:TSourceLog;

const AnUnitName,InFilename:string; UsesStart:integer):boolean;

function RemoveUnitFromUsesSection(Source:TSourceLog;

const AnUnitName:string; UsesStart:integer):boolean;

function FindIncludeDirective(const Source,Section:string; Index:integer;

out IncludeStart,IncludeEnd:integer):boolean;

function ExtractLongParamDirective(const Source: string; CommentStartPos: integer;

out DirectiveName, FileParam: string): boolean;

function SplitCompilerDirective(const Directive:string;

out DirectiveName,Parameters:string):boolean;

function FindResourceInCode(const Source, AddCode:string;

out Position,EndPosition:integer):boolean;

function AddResourceCode(Source:TSourceLog; const AddCode:string):boolean;

function FindFormClassDefinitionInSource(const Source, FormClassName:string;

var FormClassNameStartPos, FormBodyStartPos: integer):boolean;

function FindFormComponentInSource(const Source: string; FormBodyStartPos: integer;

const ComponentName, ComponentClassName: string): integer;

function AddFormComponentToSource(Source:TSourceLog; FormBodyStartPos: integer;

const ComponentName, ComponentClassName: string): boolean;

function RemoveFormComponentFromSource(Source:TSourceLog;

FormBodyStartPos: integer;

const ComponentName, ComponentClassName: string): boolean;

function FindClassAncestorName(const Source, FormClassName: string): string;

function FindFirstProcSpecifier(const ProcText: string;

NestedComments: boolean = false): integer;

function SearchProcSpecifier(const ProcText, Specifier: string;

out SpecifierEndPosition: integer;

NestedComments: boolean = false;

WithSpaceBehindSemicolon: boolean = true): integer;

function RemoveProcSpecifier(const ProcText, Specifier: string;

NestedComments: boolean = false): string;

function SearchCodeInSource(const Source, Find: string; StartPos: integer;

out EndFoundPosition: integer; CaseSensitive: boolean;

NestedComments: boolean = false): integer;

function ReadNextPascalAtom(const Source: string;

var Position: integer; out AtomStart: integer; NestedComments: boolean = false;

SkipDirectives: boolean = false): string;

procedure ReadRawNextPascalAtom(const Source: string;

var Position: integer; out AtomStart: integer;

NestedComments: boolean = false; SkipDirectives: boolean = false);

procedure ReadRawNextPascalAtom(var Position: PChar; out AtomStart: PChar;

const SrcEnd: PChar = nil; NestedComments: boolean = false;

SkipDirectives: boolean = false);

function ReadRawPascal(StartP: PChar; SrcEnd: PChar = nil; NestedComments: boolean = false;

SkipDirectives: boolean = true): string;

procedure ReadPriorPascalAtom(const Source: string;

var Position: integer; out AtomEnd: integer; NestedComments: boolean = false);

function ReadTilPascalBracketClose(const Source: string;

var Position: integer; NestedComments: boolean = false): boolean;

function GetAtomLength(p: PChar; NestedComments: boolean): integer;

function GetAtomString(p: PChar; NestedComments: boolean): string;

function FindStartOfAtom(const Source: string; Position: integer): integer;

function FindEndOfAtom(const Source: string; Position: integer): integer;

MaxLineLength: integer = 80;

function Min(i1, i2: integer): integer; inline;

if i1<=i2 then Result:=i1 else Result:=i2;

end;

function Max(i1, i2: integer): integer; inline;

if i1>=i2 then Result:=i1 else Result:=i2;

end;

procedure SkipPascalInterpolatedString(var p: PChar; NestedComments: Boolean);

procedure SkipCurlyComment;

var Lvl: Integer;

begin

Lvl:=1;

inc(p);

while p^<>#0 do begin

case p^ of

'{': if NestedComments then inc(Lvl);

'}':

begin

dec(Lvl);

if Lvl=0 then begin

inc(p);

exit;

end;

end;

end;

inc(p);

end;

end;

procedure SkipRoundComment;

var Lvl: Integer;

begin

Lvl:=1;

inc(p,2);

while p^<>#0 do begin

if (p^='(') and (p[1]='*') and NestedComments then begin

inc(Lvl); inc(p,2);

end else if (p^='*') and (p[1]=')') then begin

dec(Lvl); inc(p,2);

if Lvl=0 then exit;

end else

inc(p);

end;

end;

procedure SkipRegularApostropheString;

// p^ = ''''; skip `'...'` with `''` as escaped apostrophe, single line

begin

inc(p);

while p^<>#0 do begin

case p^ of

'''':

if p[1]='''' then

inc(p,2)

else begin

inc(p);

exit;

end;

#10,#13:

exit;

else

inc(p);

end;

end;

end;

procedure SkipBacktickString;

begin

inc(p);

while not (p^ in [#0,'`']) do inc(p);

if p^='`' then inc(p);

end;

procedure SkipCharConstant;

begin

inc(p);

if p^='$' then begin

inc(p);

while IsHexNumberChar[p^] do inc(p);

end else

while IsNumberChar[p^] do inc(p);

end;

procedure SkipInterpExpr;

// p is just past the expression-opening `{`; advance past the matching `}`

var PLvl: Integer;

begin

PLvl:=0;

while p^<>#0 do begin

case p^ of

'}':

begin

inc(p);

exit;

end;

':':

if PLvl=0 then begin

// `{expr:mask}` - mask runs raw to the closing `}`

while not (p^ in [#0,'}']) do inc(p);

end else

inc(p);

'{':

SkipCurlyComment;

'(':

if p[1]='*' then

SkipRoundComment

else begin

inc(PLvl); inc(p);

end;

')':

begin

if PLvl>0 then dec(PLvl);

inc(p);

end;

'[':

begin

inc(PLvl); inc(p);

end;

']':

begin

if PLvl>0 then dec(PLvl);

inc(p);

end;

'/':

if p[1]='/' then begin

while not (p^ in [#0,#10,#13]) do inc(p);

end else

inc(p);

'''':

SkipRegularApostropheString;

'`':

SkipBacktickString;

'#':

SkipCharConstant;

'$':

if p[1]='''' then

SkipPascalInterpolatedString(p,NestedComments)

else begin

inc(p);

while IsHexNumberChar[p^] do inc(p);

end;

else

inc(p);

end;

end;

end;

// skip $'

inc(p,2);

while p^<>#0 do begin

case p^ of

'''':

if p[1]='''' then

inc(p,2) // doubled apostrophe = literal

else begin

inc(p);

exit;

end;

'{':

if p[1]='{' then

inc(p,2) // escaped brace

else begin

inc(p);

SkipInterpExpr;

end;

'}':

if p[1]='}' then

inc(p,2) // escaped brace

else

inc(p);

#10,#13:

exit; // newline in string part ends the literal

else

inc(p);

end;

end;

end;

function FindIncludeDirective(const Source,Section:string; Index:integer;

out IncludeStart,IncludeEnd:integer):boolean;

var Atom,DirectiveName:string;

Position,EndPos,AtomStart:integer;

Filename:string;

Result:=false;

// find section

Position:=SearchCodeInSource(Source,Section,1,EndPos,false);

if (Position<1) or (EndPos<1) then exit;

// search for include directives

repeat

Atom:=ReadNextPascalAtom(Source,Position,AtomStart);

if LazStartsStr('{$',Atom) or LazStartsStr('(*$', Atom) then begin

SplitCompilerDirective(Atom,DirectiveName,Filename);

if (DirectiveName='i') or (DirectiveName='I')

or (CompareText(DirectiveName,'include')=0) then begin

// include directive

dec(Index);

if Index=0 then begin

IncludeStart:=AtomStart;

IncludeEnd:=Position;

Result:=true;

exit;

end;

end;

end;

until Atom='';

end;

function ExtractLongParamDirective(const Source: string; CommentStartPos: integer;

out DirectiveName, FileParam: string): boolean;

p, StartPos: PChar;

Result:=false;

FileParam:='';

if CommentStartPos>length(Source) then exit;

p:=@Source[CommentStartPos];

if (p^<>'{') or (p[1]<>'$') then exit;

inc(p,2);

StartPos:=p;

if not IsIdentStartChar[p^] then exit;

while IsIdentChar[p^] do inc(p);

DirectiveName:=copy(Source,StartPos-PChar(Source)+1,p-StartPos);

Result:=true;

while p^ in [' ',#9] do inc(p);

if p^='''' then begin

// 'param with spaces'

inc(p);

StartPos:=p;

while not (p^ in [#0,#10,#13,'''']) do inc(p);

end else begin

// param without spaces

StartPos:=p;

while not (p^ in [#0,#9,#10,#13,' ','}']) do inc(p);

end;

FileParam:=copy(Source,StartPos-PChar(Source)+1,p-StartPos);

end;

function SplitCompilerDirective(const Directive:string;

out DirectiveName,Parameters:string):boolean;

var EndPos,DirStart,DirEnd:integer;

if LazStartsStr('{$',Directive) or LazStartsStr('(*$',Directive) then begin

if LazStartsStr('{$',Directive) then begin

DirStart:=3;

DirEnd:=length(Directive);

end else begin

DirStart:=4;

DirEnd:=length(Directive)-1;

end;

EndPos:=DirStart;

while (EndPos<DirEnd) and (IsIdentChar[Directive[EndPos]]) do

inc(EndPos);

DirectiveName:=lowercase(copy(Directive,DirStart,EndPos-DirStart));

Parameters:=copy(Directive,EndPos+1,DirEnd-EndPos-1);

Result:=true;

end else

Result:=false;

end;

function FindSourceType(const Source: string; var SrcNameStart,

SrcNameEnd: integer; NestedComments: boolean): string;

u: String;

p, AtomStart: Integer;

// read first atom for type

SrcNameStart:=0;

SrcNameEnd:=0;

p:=1;

Result:=ReadNextPascalAtom(Source,p,AtomStart,NestedComments);

u:=Uppercase(Result);

if (u='UNIT') or (u='PROGRAM') or (u='LIBRARY') or (u='PACKAGE') then begin

// read name

ReadNextPascalAtom(Source,p,AtomStart,NestedComments);

if p<=AtomStart then exit;

if not IsIdentStartChar[Source[AtomStart]] then exit;

SrcNameStart:=AtomStart;

SrcNameEnd:=p;

repeat

ReadRawNextPascalAtom(Source,p,AtomStart,NestedComments);

if (AtomStart=p+1) and (Source[AtomStart]='.') then begin

ReadRawNextPascalAtom(Source,p,AtomStart,NestedComments);

if p<=AtomStart then exit;

if not IsIdentStartChar[Source[AtomStart]] then exit;

SrcNameEnd:=p;

end else

break;

until false;

end else begin

Result:='';

end;

end;

function RenameUnitInSource(Source:TSourceLog;const NewUnitName:string):boolean;

var UnitNameStart,UnitNameEnd:integer;

UnitNameStart:=0;

UnitNameEnd:=0;

Result:=(FindUnitNameInSource(Source.Source,UnitNameStart,UnitNameEnd)<>'');

if Result then

Source.Replace(UnitNameStart,UnitNameEnd-UnitNameStart,NewUnitName);

end;

function FindUnitNameInSource(const Source: string; out UnitNameStart,

UnitNameEnd: integer; NestedComments: boolean): string;

ModuleType: string;

Result:=FindModuleNameInSource(Source,ModuleType,UnitNameStart,UnitNameEnd,NestedComments);

if CompareText(ModuleType,'UNIT')<>0 then

Result:='';

end;

function FindModuleNameInSource(const Source: string; out ModuleType: string;

out NameStart, NameEnd: integer; NestedComments: boolean): string;

u: String;

p, AtomStart: Integer;

// read first atom for type

Result:='';

NameStart:=0;

NameEnd:=0;

p:=1;

ModuleType:=ReadNextPascalAtom(Source,p,AtomStart,NestedComments);

u:=UpperCase(ModuleType);

if (u='UNIT') or (u='PROGRAM') or (u='LIBRARY') or (u='PACKAGE') then begin

// read name

ReadNextPascalAtom(Source,p,AtomStart,NestedComments);

if p<=AtomStart then exit;

if not IsIdentStartChar[Source[AtomStart]] then exit;

NameStart:=AtomStart;

NameEnd:=AtomStart;

Result:=ReadDottedIdentifier(Source,NameEnd,NestedComments);

end else

ModuleType:='';

end;

function ReadDottedIdentifier(const Source: string; var Position: integer; NestedComments: boolean;

aSkipAmp: boolean): string;

p: PChar;

if (Position<1) or (Position>length(Source)) then exit('');

p:=@Source[Position];

Result:=ReadDottedIdentifier(p,PChar(Source)+length(Source),NestedComments,aSkipAmp);

Position:=p-PChar(Source)+1;

end;

function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar; NestedComments: boolean;

aSkipAmp: boolean): string;

AtomStart, p: PChar;

s: String;

Result:='';

p:=Position;

ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);

Position:=AtomStart;

if (AtomStart>=p) then exit;

Result:=GetIdentifier(AtomStart,aSkipAmp);

if Result='' then exit;

repeat

Position:=p;

ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);

if (AtomStart+1<>p) or (AtomStart^<>'.') then exit;

ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);

if (AtomStart>=p) then exit;

s:=GetIdentifier(AtomStart,aSkipAmp);

if s='' then exit;

Result:=Result+'.'+s;

until false;

end;

function RenameProgramInSource(Source: TSourceLog;

const NewProgramName:string):boolean;

var ProgramNameStart,ProgramNameEnd:integer;

Result:=(FindProgramNameInSource(Source.Source,

ProgramNameStart,ProgramNameEnd)<>'');

if Result then

Source.Replace(ProgramNameStart,

ProgramNameEnd-ProgramNameStart,NewProgramName)

end;

function FindProgramNameInSource(const Source:string;

out ProgramNameStart,ProgramNameEnd:integer):string;

ProgramNameStart:=0;

ProgramNameEnd:=0;

if UpperCaseStr(FindSourceType(Source,ProgramNameStart,ProgramNameEnd))='PROGRAM'

then

Result:=copy(Source,ProgramNameStart,ProgramNameEnd-ProgramNameStart)

else

Result:='';

end;

function UnitIsUsedInSource(const Source,SrcUnitName:string):boolean;

var UsesStart,UsesEnd:integer;

Result:=false;

repeat

UsesStart:=SearchCodeInSource(Source,'uses',1,UsesEnd,false);

if UsesEnd=0 then ;

if UsesStart>0 then begin

if IsUnitUsedInUsesSection(Source,SrcUnitName,UsesStart) then begin

Result:=true;

exit;

end;

end;

until UsesStart<1;

end;

function RenameUnitInProgramUsesSection(Source:TSourceLog;

const OldUnitName, NewUnitName, NewInFile:string): boolean;

ProgramTermStart,ProgramTermEnd,

UsesStart,UsesEnd:integer;

Result:=false;

// search Program section

ProgramTermStart:=SearchCodeInSource(Source.Source,'program',1,ProgramTermEnd

,false);

if ProgramTermStart<1 then exit;

// search programname

ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart);

// search semicolon after programname

if not (ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart)=';')

then exit;

UsesEnd:=ProgramTermEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

if UsesEnd>length(Source.Source) then exit;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then begin

// no uses section in interface -> add one

Source.Insert(ProgramTermEnd,LineEnding+LineEnding+'uses'+LineEnding+' ;');

UsesEnd:=ProgramTermEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

end;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then exit;

Result:=RenameUnitInUsesSection(Source,UsesStart,OldUnitName

,NewUnitName,NewInFile);

end;

function AddToProgramUsesSection(Source:TSourceLog;

const AUnitName,InFileName:string):boolean;

ProgramTermStart,ProgramTermEnd,

UsesStart,UsesEnd:integer;

Result:=false;

if (AUnitName='') or (AUnitName=';') then exit;

// search program

ProgramTermStart:=SearchCodeInSource(Source.Source,'program',1,ProgramTermEnd

,false);

if ProgramTermStart<1 then exit;

// search programname

ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart);

// search semicolon after programname

if not (ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart)=';')

then exit;

// search uses section

UsesEnd:=ProgramTermEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

if UsesEnd>length(Source.Source) then exit;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then begin

// no uses section after program term -> add one

Source.Insert(ProgramTermEnd,LineEnding+LineEnding+'uses'+LineEnding+' ;');

UsesEnd:=ProgramTermEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

end;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then exit;

Result:=AddUnitToUsesSection(Source,AUnitName,InFileName,UsesStart);

end;

function RenameUnitInInterfaceUsesSection(Source:TSourceLog;

const OldUnitName, NewUnitName, NewInFile:string): boolean;

InterfaceStart,InterfaceWordEnd,

UsesStart,UsesEnd:integer;

Result:=false;

// search interface section

InterfaceStart:=SearchCodeInSource(Source.Source,'interface',1

,InterfaceWordEnd,false);

if InterfaceStart<1 then exit;

UsesEnd:=InterfaceWordEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

if UsesEnd>length(Source.Source) then exit;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then begin

// no uses section in interface -> add one

Source.Insert(InterfaceWordEnd,LineEnding+LineEnding+'uses'+LineEnding+' ;');

UsesEnd:=InterfaceWordEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

end;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then exit;

Result:=RenameUnitInUsesSection(Source,UsesStart,OldUnitName

,NewUnitName,NewInFile);

end;

function AddToInterfaceUsesSection(Source:TSourceLog;

const AUnitName,InFileName:string):boolean;

InterfaceStart,InterfaceWordEnd,

UsesStart,UsesEnd:integer;

Result:=false;

if AUnitName='' then exit;

// search interface section

InterfaceStart:=SearchCodeInSource(Source.Source,'interface',1

,InterfaceWordEnd,false);

if InterfaceStart<1 then exit;

UsesEnd:=InterfaceWordEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

if UsesEnd>length(Source.Source) then exit;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then begin

// no uses section in interface -> add one

Source.Insert(InterfaceWordEnd,LineEnding+LineEnding+'uses'+LineEnding+' ;');

UsesEnd:=InterfaceWordEnd;

ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

end;

if CompareText(copy(Source.Source,UsesStart,UsesEnd-UsesStart),'uses')<>0

then exit;

Result:=AddUnitToUsesSection(Source,AUnitName,InFileName,UsesStart);

end;

function RemoveFromProgramUsesSection(Source:TSourceLog;

const AUnitName:string):boolean;

ProgramTermStart,ProgramTermEnd,

UsesStart,UsesEnd:integer;

Atom:string;

Result:=false;

if AUnitName='' then exit;

// search program

ProgramTermStart:=SearchCodeInSource(Source.Source,'program',1

,ProgramTermEnd,false);

if ProgramtermStart<1 then exit;

// search programname

ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart);

// search semicolon after programname

if not (ReadNextPascalAtom(Source.Source,ProgramTermEnd,ProgramTermStart)=';')

then exit;

UsesEnd:=ProgramTermEnd;

Atom:=ReadNextPascalAtom(Source.Source,UsesEnd,UsesStart);

if UsesEnd>length(Source.Source) then exit;

if CompareText(Atom,'uses')<>0 then exit;

Result:=RemoveUnitFromUsesSection(Source,AUnitName,UsesStart);