mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 15:33:46 +02:00
6641 lines
227 KiB
ObjectPascal
6641 lines
227 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* 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 <http://www.gnu.org/copyleft/gpl.html>. 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:
|
|
TStandardCodeTool enhances TIdentCompletionTool with many standard code
|
|
editing functions for the following categories:
|
|
- source name
|
|
- uses sections
|
|
- lazarus resources
|
|
- Application.CreateForm statements
|
|
- published variables
|
|
- resource strings
|
|
- compiler and IDE directives
|
|
- code exploring
|
|
- code blocks
|
|
}
|
|
unit StdCodeTools;
|
|
|
|
{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
{ $DEFINE VerboseGetStringConstBounds}
|
|
{ $DEFINE ShowCompleteBlock}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, TypInfo, CodeToolsStrConsts, FileProcs, CodeTree, CodeAtom,
|
|
FindDeclarationTool, IdentCompletionTool, PascalReaderTool, PascalParserTool,
|
|
CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner,
|
|
CodeCache, AVL_Tree, LFMTrees, SourceChanger,
|
|
CustomCodeTool, CodeToolsStructs;
|
|
|
|
type
|
|
TOnFindDefinePropertyForContext = procedure(Sender: TObject;
|
|
const ClassContext, AncestorClassContext: TFindContext;
|
|
LFMNode: TLFMTreeNode;
|
|
const IdentName: string; var IsDefined: boolean) of object;
|
|
|
|
{ TStandardCodeTool }
|
|
|
|
TStandardCodeTool = class(TIdentCompletionTool)
|
|
private
|
|
function ReadTilGuessedUnclosedBlock(MinCleanPos: integer;
|
|
ReadOnlyOneBlock: boolean): boolean;
|
|
function ReadForwardTilAnyBracketClose: boolean;
|
|
function ReadBackwardTilAnyBracketClose: boolean;
|
|
public
|
|
// explore the code
|
|
function Explore(WithStatements: boolean;
|
|
OnlyInterface: boolean = false): boolean;
|
|
|
|
// source name e.g. 'unit UnitName;'
|
|
function GetCachedSourceName: string;
|
|
function RenameSource(const NewName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
// uses sections
|
|
function RenameUsedUnit(const OldUpperUnitName, NewUnitName,
|
|
NewUnitInFile: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function ReplaceUsedUnits(UnitNamePairs: TStringToStringTree;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function AddUnitToUsesSection(UsesNode: TCodeTreeNode;
|
|
const NewUnitName, NewUnitInFile: string;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
|
|
function AddUnitToMainUsesSection(const NewUnitName, NewUnitInFile: string;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
|
|
function RemoveUnitFromUsesSection(UsesNode: TCodeTreeNode;
|
|
const UpperUnitName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RemoveUnitFromAllUsesSections(const UpperUnitName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FixUsedUnitCase(SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FixUsedUnitCaseInUsesSection(UsesNode: TCodeTreeNode;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FindUsedUnitNames(var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean;
|
|
function FindUsedUnitNames(var List: TStringToStringTree): boolean;
|
|
function FindUsedUnitFiles(var MainUsesSection: TStrings): boolean;
|
|
function FindUsedUnitFiles(var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean;
|
|
function FindDelphiProjectUnits(var FoundInUnits, MissingInUnits,
|
|
NormalUnits: TStrings;
|
|
UseContainsSection: boolean = false): boolean;
|
|
function UsesSectionToFilenames(UsesNode: TCodeTreeNode): TStrings;
|
|
function UsesSectionToUnitnames(UsesNode: TCodeTreeNode): TStrings;
|
|
function FindMissingUnits(var MissingUnits: TStrings; FixCase: boolean;
|
|
SearchImplementation: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function CommentUnitsInUsesSections(MissingUnits: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FindUnusedUnits(Units: TStrings): boolean;
|
|
|
|
// lazarus resources
|
|
function FindNextIncludeInInitialization(
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
function FindLazarusResourceInBuffer(ResourceCode: TCodeBuffer;
|
|
const ResourceName: string): TAtomPosition;
|
|
function FindLazarusResource(const ResourceName: string): TAtomPosition;
|
|
function AddLazarusResource(ResourceCode: TCodeBuffer;
|
|
const ResourceName, ResourceData: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RemoveLazarusResource(ResourceCode: TCodeBuffer;
|
|
const ResourceName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RenameInclude(LinkIndex: integer; const NewFilename: string;
|
|
KeepPath: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function CheckLFM(LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
|
|
const OnFindDefineProperty: TOnFindDefinePropertyForContext;
|
|
RootMustBeClassInIntf, ObjectsMustExist: boolean): boolean;
|
|
|
|
// Application.Createform statements
|
|
function FindCreateFormStatement(StartPos: integer;
|
|
const UpperClassName, UpperVarName: string;
|
|
out Position: TAtomPosition): integer; // 0=found, -1=not found, 1=found, but wrong classname
|
|
function AddCreateFormStatement(const AClassName, AVarName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RemoveCreateFormStatement(const UpperVarName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function ChangeCreateFormStatement(StartPos: integer;
|
|
const OldClassName, OldVarName: string;
|
|
const NewClassName, NewVarName: string;
|
|
OnlyIfExists: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function ListAllCreateFormStatements: TStrings;
|
|
function SetAllCreateFromStatements(List: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
// Application.Title:=<string const> statements
|
|
function FindApplicationTitleStatement(out StartPos, StringConstStartPos,
|
|
EndPos: integer): boolean;
|
|
function GetApplicationTitleStatement(StringConstStartPos, EndPos: integer;
|
|
var Title: string): boolean;
|
|
function SetApplicationTitleStatement(const NewTitle: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RemoveApplicationTitleStatement(
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
// forms
|
|
function RenameForm(const OldFormName, OldFormClassName: string;
|
|
const NewFormName, NewFormClassName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FindFormAncestor(const UpperClassName: string;
|
|
var AncestorClassName: string): boolean;
|
|
|
|
// published variables
|
|
function FindPublishedVariable(const UpperClassName, UpperVarName: string;
|
|
ExceptionOnClassNotFound: boolean): TCodeTreeNode;
|
|
function AddPublishedVariable(const UpperClassName,VarName, VarType: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean; virtual;
|
|
function RemovePublishedVariable(const UpperClassName, UpperVarName: string;
|
|
ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RenamePublishedVariable(const UpperClassName,
|
|
UpperOldVarName: string; const NewVarName, VarType: shortstring;
|
|
ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function GatherPublishedClassElements(const TheClassName: string;
|
|
ExceptionOnClassNotFound, WithVariables, WithMethods,
|
|
WithProperties, WithAncestors: boolean;
|
|
out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
|
|
function RetypeClassVariables(const AClassName: string;
|
|
ListOfTypes: TStringToStringTree; ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function FindDanglingComponentEvents(const TheClassName: string;
|
|
RootComponent: TComponent; ExceptionOnClassNotFound,
|
|
SearchInAncestors: boolean;
|
|
out ListOfPInstancePropInfo: TFPList;
|
|
const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
|
|
|
|
// variables, constants, types
|
|
function RemoveIdentifierDefinition(const CursorPos: TCodeXYPosition;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
// blocks (e.g. begin..end)
|
|
function FindBlockCounterPart(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
function FindBlockStart(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
function GuessUnclosedBlock(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
function FindBlockCleanBounds(const CursorPos: TCodeXYPosition;
|
|
out BlockCleanStart, BlockCleanEnd: integer): boolean;
|
|
function CompleteBlock(const CursorPos: TCodeXYPosition;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
OnlyIfCursorBlockIndented: boolean;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
|
|
// compiler directives
|
|
function GuessMisplacedIfdefEndif(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
function FindEnclosingIncludeDirective(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
function FindModeDirective(DoBuildTree: boolean;
|
|
out ACleanPos: integer): boolean;
|
|
function FindResourceDirective(DoBuildTree: boolean;
|
|
var ACleanPos: integer; const Filename: string = ''): boolean;
|
|
function FindResourceDirective(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
|
const Filename: string = ''): boolean;
|
|
function AddResourceDirective(const Filename: string;
|
|
SourceChangeCache: TSourceChangeCache; const NewSrc: string = ''
|
|
): boolean;
|
|
function FindIncludeDirective(DoBuildTree: boolean;
|
|
var ACleanPos: integer; const Filename: string = ''): boolean;
|
|
function FindIncludeDirective(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
|
const Filename: string = ''): boolean;
|
|
function AddIncludeDirective(const Filename: string;
|
|
SourceChangeCache: TSourceChangeCache; const NewSrc: string = ''
|
|
): boolean;
|
|
function FixIncludeFilenames(Code: TCodeBuffer;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
out FoundIncludeFiles: TStrings;
|
|
var MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
|
|
|
// search & replace
|
|
function ReplaceWords(IdentList: TStrings; ChangeStrings: boolean;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
SkipPointWords: boolean = false): boolean;
|
|
function FindNearestIdentifierNode(const CursorPos: TCodeXYPosition;
|
|
IdentTree: TAVLTree): TAVLTreeNode;
|
|
function ReplaceWord(const OldWord, NewWord: string; ChangeStrings: boolean;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
SkipPointWords: boolean = false): boolean;
|
|
|
|
// expressions
|
|
function GetStringConstBounds(const CursorPos: TCodeXYPosition;
|
|
out StartPos, EndPos: TCodeXYPosition;
|
|
ResolveComments: boolean): boolean;
|
|
function ReplaceCode(const StartPos, EndPos: TCodeXYPosition;
|
|
const NewCode: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function GetStringConstAsFormatString(StartPos, EndPos: integer;
|
|
out FormatStringConstant, FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
function GetStringConstAsFormatString(StartPos, EndPos: integer;
|
|
out FormatStringConstant, FormatParameters: string): boolean;
|
|
function ExtractOperand(const CursorPos: TCodeXYPosition;
|
|
out Operand: string; WithPostTokens, WithAsOperator,
|
|
WithoutTrailingPoints: boolean): boolean;
|
|
|
|
// resource strings
|
|
function GatherResourceStringSections(const CursorPos: TCodeXYPosition;
|
|
PositionList: TCodeXYPositions): boolean;
|
|
function IdentifierExistsInResourceStringSection(
|
|
const CursorPos: TCodeXYPosition;
|
|
const ResStrIdentifier: string): boolean;
|
|
function GatherResourceStringsWithValue(const CursorPos: TCodeXYPosition;
|
|
const StringValue: string;
|
|
PositionList: TCodeXYPositions): boolean;
|
|
function GatherResourceStringIdents(const SectionPos: TCodeXYPosition;
|
|
var IdentTree: TAVLTree): boolean;
|
|
function FindNearestResourceString(const CursorPos,
|
|
SectionPos: TCodeXYPosition;
|
|
var NearestPos: TCodeXYPosition): boolean;
|
|
function AddResourceString(const SectionPos: TCodeXYPosition;
|
|
const NewIdentifier, NewValue: string;
|
|
InsertPolicy: TResourcestringInsertPolicy;
|
|
const NearestPos: TCodeXYPosition;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function CreateIdentifierFromStringConst(
|
|
const StartCursorPos, EndCursorPos: TCodeXYPosition;
|
|
out Identifier: string; MaxLen: integer): boolean;
|
|
function StringConstToFormatString(
|
|
const StartCursorPos, EndCursorPos: TCodeXYPosition;
|
|
out FormatStringConstant,FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
|
|
// register procedure
|
|
function HasInterfaceRegisterProc(var HasRegisterProc: boolean): boolean;
|
|
|
|
// Delphi to Lazarus conversion
|
|
function ConvertDelphiToLazarusSource(AddLRSCode: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
// IDE % directives
|
|
function GetIDEDirectives(DirectiveList: TStrings): boolean;
|
|
function SetIDEDirectives(DirectiveList: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
procedure CalcMemSize(Stats: TCTMemStats); override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
type
|
|
TBlockKeyword = (bkwNone, bkwBegin, bkwAsm, bkwTry, bkwCase, bkwRepeat,
|
|
bkwRecord, bkwClass, bkwObject, bkwInterface,
|
|
bkwDispInterface, bkwEnd, bkwUntil, bkwFinally,
|
|
bkwExcept);
|
|
|
|
const
|
|
BlockKeywords: array[TBlockKeyword] of string = (
|
|
'(unknown)', 'BEGIN', 'ASM', 'TRY', 'CASE', 'REPEAT', 'RECORD', 'CLASS',
|
|
'OBJECT', 'INTERFACE', 'DISPINTERFACE', 'END', 'UNTIL', 'FINALLY',
|
|
'EXCEPT'
|
|
);
|
|
|
|
var
|
|
BlockKeywordFuncList: TKeyWordFunctionList;
|
|
|
|
procedure BuildBlockKeyWordFuncList;
|
|
var BlockWord: TBlockKeyword;
|
|
begin
|
|
if BlockKeywordFuncList=nil then begin
|
|
BlockKeywordFuncList:=TKeyWordFunctionList.Create;
|
|
for BlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do
|
|
with BlockKeywordFuncList do
|
|
Add(BlockKeywords[BlockWord],{$ifdef FPC}@{$endif}AllwaysTrue);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TStandardCodeTool }
|
|
|
|
{-------------------------------------------------------------------------------
|
|
function TStandardCodeTool.GetCachedSourceName: string;
|
|
Params: none
|
|
Result: the source name (= e.g. the identifier behind 'program'/'unit' keyword)
|
|
|
|
This function does neither check if source needs reparsing, nor does it check
|
|
for errors in code. It simple checks if there is a first node, which is
|
|
typically the source type and name.
|
|
This function can therefore be used as a fast GetSourceName function.
|
|
-------------------------------------------------------------------------------}
|
|
function TStandardCodeTool.GetCachedSourceName: string;
|
|
begin
|
|
if Tree.Root<>nil then begin
|
|
MoveCursorToNodeStart(Tree.Root);
|
|
ReadNextAtom; // read source type 'program', 'unit' ...
|
|
ReadNextAtom; // read name
|
|
if (CurPos.StartPos<=SrcLen) then
|
|
CachedSourceName:=GetAtom;
|
|
end;
|
|
Result:=CachedSourceName;
|
|
end;
|
|
|
|
function TStandardCodeTool.RenameSource(const NewName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var NamePos: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
BuildTree(true);
|
|
if (not GetSourceNamePos(NamePos)) or (NamePos.StartPos<1) or (NewName='')
|
|
or (Length(NewName)>255) then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
SourceChangeCache.Replace(gtNone,gtNone,NamePos.StartPos,NamePos.EndPos,
|
|
NewName);
|
|
if not SourceChangeCache.Apply then exit;
|
|
CachedSourceName:=NewName;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RenameUsedUnit(const OldUpperUnitName,
|
|
NewUnitName, NewUnitInFile: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var UnitPos, InPos: TAtomPosition;
|
|
NewUsesTerm: string;
|
|
begin
|
|
Result:=false;
|
|
if (OldUpperUnitName='') or (length(OldUpperUnitName)>255) or (NewUnitName='')
|
|
or (length(NewUnitName)>255) then exit;
|
|
if not FindUnitInAllUsesSections(OldUpperUnitName,UnitPos,InPos) then begin
|
|
//debugln('TStandardCodeTool.RenameUsedUnit not found: ',OldUpperUnitName,' ');
|
|
exit;
|
|
end;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if InPos.StartPos>0 then
|
|
UnitPos.EndPos:=InPos.EndPos;
|
|
// build use unit term
|
|
NewUsesTerm:=NewUnitName;
|
|
if NewUnitInFile<>'' then
|
|
NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+'''';
|
|
// Note: do not use beautifier, unit names are case sensitive
|
|
if ReplacementNeedsLineEnd(Src,UnitPos.StartPos,UnitPos.EndPos,
|
|
length(NewUsesTerm),SourceChangeCache.BeautifyCodeOptions.LineLength) then
|
|
begin
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNone,
|
|
UnitPos.StartPos,UnitPos.EndPos,NewUsesTerm) then exit;
|
|
end else begin
|
|
if not SourceChangeCache.Replace(gtSpace,gtNone,
|
|
UnitPos.StartPos,UnitPos.EndPos,NewUsesTerm) then exit;
|
|
end;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReplaceUsedUnits(UnitNamePairs: TStringToStringTree;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
ExistingUnits: TStringToStringTree;
|
|
|
|
procedure CleanNewUnits(const AnUnitName: string; var NewText: string);
|
|
var
|
|
StartPos: Integer;
|
|
EndPos: LongInt;
|
|
CommaBehind: LongInt;
|
|
CommaInFront: Integer;
|
|
NewUnitName: String;
|
|
begin
|
|
// remove all units, that already exists
|
|
StartPos:=1;
|
|
CommaInFront:=-1;
|
|
while StartPos<=length(NewText) do begin
|
|
EndPos:=StartPos;
|
|
while (EndPos<=length(NewText)) and (IsIdentChar[NewText[EndPos]]) do
|
|
inc(EndPos);
|
|
if EndPos<=StartPos then break;
|
|
NewUnitName:=copy(NewText,StartPos,EndPos-StartPos);
|
|
// set EndPos to start of next unit
|
|
CommaBehind:=-1;
|
|
while (EndPos<=length(NewText)) do begin
|
|
if NewText[EndPos]='''' then begin
|
|
inc(EndPos);
|
|
while (EndPos<=length(NewText)) and (NewText[EndPos]<>'''') do
|
|
inc(EndPos);
|
|
end else if NewText[EndPos]=',' then begin
|
|
CommaBehind:=EndPos;
|
|
while (EndPos<=length(NewText))
|
|
and (not IsIdentStartChar[NewText[EndPos]]) do
|
|
inc(EndPos);
|
|
break;
|
|
end;
|
|
inc(EndPos);
|
|
end;
|
|
if (SysUtils.CompareText(AnUnitName,NewUnitName)=0) then begin
|
|
// this is the old unit or
|
|
//DebugLn('Replace: keep old unit "',NewUnitName,'"');
|
|
end else if ExistingUnits.Contains(NewUnitName) then begin
|
|
// this unit already exists and should not be added
|
|
//DebugLn('Replace: already exists: "',NewUnitName,'"="',ExistingUnits[NewUnitName],'" CommaInFront=',dbgs(CommaInFront),' CommaBehind=',dbgs(CommaBehind));
|
|
if CommaBehind>0 then
|
|
System.Delete(NewText,StartPos,EndPos-StartPos)
|
|
else if CommaInFront>0 then
|
|
System.Delete(NewText,CommaInFront,EndPos-CommaInFront)
|
|
else
|
|
System.Delete(NewText,StartPos,EndPos-StartPos);
|
|
EndPos:=StartPos;
|
|
CommaBehind:=-1;
|
|
end else begin
|
|
// this unit does not exist yet
|
|
//DebugLn('Replace new unit with "',NewUnitName,'"');
|
|
end;
|
|
if CommaBehind>0 then
|
|
CommaInFront:=CommaBehind;
|
|
StartPos:=EndPos;
|
|
end;
|
|
end;
|
|
|
|
function Replace(UsesNode: TCodeTreeNode): boolean;
|
|
var
|
|
UnitNameAtom: TAtomPosition;
|
|
InAtom: TAtomPosition;
|
|
NewText: string;
|
|
CommaInFront: LongInt;
|
|
FromPos: LongInt;
|
|
ToPos: LongInt;
|
|
CommaBehind: Integer;
|
|
AnUnitName: String;
|
|
begin
|
|
if UsesNode=nil then exit(true);
|
|
MoveCursorToUsesStart(UsesNode);
|
|
CommaInFront:=-1;
|
|
repeat
|
|
// read next unit name
|
|
ReadNextUsedUnit(UnitNameAtom, InAtom);
|
|
if CurPos.Flag=cafComma then
|
|
CommaBehind:=CurPos.StartPos
|
|
else
|
|
CommaBehind:=-1;
|
|
AnUnitName:=GetAtom(UnitNameAtom);
|
|
if UnitNamePairs.Contains(AnUnitName) then begin
|
|
// replace
|
|
NewText:=UnitNamePairs[AnUnitName];
|
|
//DebugLn('Replace Unit="',AnUnitName,'" NewText="',NewText,'"');
|
|
|
|
CleanNewUnits(AnUnitName,NewText);
|
|
|
|
if NewText='' then begin
|
|
// comment unit
|
|
if CommaInFront>0 then begin
|
|
// example: uses a{, b};
|
|
FromPos:=CommaInFront;
|
|
ToPos:=UnitNameAtom.EndPos;
|
|
if InAtom.StartPos>0 then
|
|
ToPos:=InAtom.EndPos;
|
|
end else if CommaBehind>0 then begin
|
|
// example: uses {a,} b;
|
|
// uses {a,} {b};
|
|
FromPos:=UnitNameAtom.StartPos;
|
|
ToPos:=CommaBehind+1;
|
|
end else begin
|
|
// examples: uses {b};
|
|
FromPos:=UnitNameAtom.StartPos;
|
|
ToPos:=UnitNameAtom.EndPos;
|
|
if InAtom.StartPos>0 then
|
|
ToPos:=InAtom.EndPos;
|
|
end;
|
|
if not CommentCode(FromPos,ToPos,SourceChangeCache,false) then
|
|
exit(false);
|
|
end else begin
|
|
// replace
|
|
FromPos:=UnitNameAtom.StartPos;
|
|
ToPos:=UnitNameAtom.EndPos;
|
|
if InAtom.StartPos>0 then
|
|
ToPos:=InAtom.EndPos;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewText)
|
|
then exit(false);
|
|
end;
|
|
end;
|
|
|
|
if CurPos.Flag=cafComma then begin
|
|
// read next unit name
|
|
CommaInFront:=CurPos.StartPos;
|
|
ReadNextAtom;
|
|
end else if CurPos.Flag=cafSemicolon then begin
|
|
break;
|
|
end else
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
BuildTree(false);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
ExistingUnits:=nil;
|
|
try
|
|
// first collect all units
|
|
if not FindUsedUnitNames(ExistingUnits) then exit;
|
|
// then change uses sections
|
|
Replace(FindMainUsesSection);
|
|
Replace(FindImplementationUsesSection);
|
|
finally
|
|
ExistingUnits.Free;
|
|
end;
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddUnitToUsesSection(UsesNode: TCodeTreeNode;
|
|
const NewUnitName, NewUnitInFile: string;
|
|
SourceChangeCache: TSourceChangeCache; AsLast: boolean;
|
|
CheckSpecialUnits: boolean): boolean;
|
|
const
|
|
SpecialUnits: array[1..5] of string = (
|
|
'cmem',
|
|
'sharedmem',
|
|
'lineinfo',
|
|
'heaptrc',
|
|
'cthreads'
|
|
);
|
|
var
|
|
Options: TBeautifyCodeOptions;
|
|
|
|
function SpecialUnitPriority(Identifier: PChar): integer;
|
|
begin
|
|
Result:=Low(SpecialUnits);
|
|
while Result<=High(SpecialUnits) do begin
|
|
if CompareIdentifierPtrs(Pointer(Identifier),Pointer(SpecialUnits[Result]))=0 then
|
|
exit;
|
|
inc(Result);
|
|
end;
|
|
end;
|
|
|
|
function NextUseUnitNodeInSameBlock(Node: TCodeTreeNode): boolean;
|
|
var
|
|
p: LongInt;
|
|
begin
|
|
if Node.NextBrother=nil then exit(false);
|
|
if PositionsInSameLine(Src,Node.EndPos,Node.NextBrother.StartPos) then
|
|
begin
|
|
// uses on same line belongs to the same formatting block
|
|
exit(true);
|
|
end;
|
|
// check that there is no comment/directive between
|
|
p:=FindPrevNonSpace(Src,Node.NextBrother.StartPos-1);
|
|
if Src[p]<>',' then exit(false);
|
|
p:=FindPrevNonSpace(Src,p-1);
|
|
if p>Node.EndPos then exit(false);
|
|
if LineEndCount(Src,Node.EndPos,Node.NextBrother.StartPos,p)>1 then exit(false);
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure AddUseUnit(Lines: TStrings; FirstIndent, Indent: integer;
|
|
const NewUses: string);
|
|
var
|
|
Line: string;
|
|
l: Integer;
|
|
begin
|
|
if Lines.Count=0 then begin
|
|
Lines.Add(NewUses);
|
|
exit;
|
|
end;
|
|
Line:=Lines[Lines.Count-1];
|
|
if (atIdentifier in Options.DoInsertSpaceAfter)
|
|
or (atComma in Options.DoInsertSpaceInFront) then
|
|
Line:=Line+' ';
|
|
Line:=Line+',';
|
|
l:=length(Line)+length(NewUses)+1; // +1 for the following , or ;
|
|
if (atComma in Options.DoInsertSpaceAfter)
|
|
or (atIdentifier in Options.DoInsertSpaceInFront) then
|
|
inc(l);
|
|
if Lines.Count=1 then
|
|
inc(l,FirstIndent);
|
|
//DebugLn(['AddUseUnit Lines.Count=',Lines.Count,' l=',l,' Line="',Line,'" NewUses=',NewUses,' FirstIndent=',FirstIndent]);
|
|
if l<=Options.LineLength then begin
|
|
// append to last line
|
|
if (atComma in Options.DoInsertSpaceAfter)
|
|
or (atIdentifier in Options.DoInsertSpaceInFront) then
|
|
Line:=Line+' ';
|
|
Line:=Line+NewUses;
|
|
Lines[Lines.Count-1]:=Line;
|
|
end else begin
|
|
// add new line
|
|
Lines[Lines.Count-1]:=Line;
|
|
Line:=GetIndentStr(Indent)+NewUses;
|
|
Lines.Add(Line);
|
|
end;
|
|
end;
|
|
|
|
var LineStart, LineEnd, Indent, InsertPos, InsertToPos, InsertLen: integer;
|
|
NewUsesTerm: string;
|
|
InsertBehind: Boolean;
|
|
InsertNode: TCodeTreeNode;
|
|
Node: TCodeTreeNode;
|
|
NewCode: TCodeBuffer;
|
|
DiffPath: String;
|
|
DiffCnt: Integer;
|
|
BestDiffCnt: LongInt;
|
|
AnUnitName: String;
|
|
AnUnitInFilename: String;
|
|
i: Integer;
|
|
NewFilename: String;
|
|
NewComma: string;
|
|
Lines: TStringList;
|
|
FirstIndent: Integer;
|
|
InsertCode: String;
|
|
UsesInsertPolicy: TUsesInsertPolicy;
|
|
Prio: LongInt;
|
|
FirstNormalUsesNode: TCodeTreeNode;
|
|
InsertPosFound: Boolean;
|
|
begin
|
|
Result:=false;
|
|
if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) or (NewUnitName='')
|
|
or (length(NewUnitName)>255) or (UsesNode.StartPos<1)
|
|
or (UsesNode.EndPos<1) then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
Options:=SourceChangeCache.BeautifyCodeOptions;
|
|
|
|
// find nice insert position
|
|
|
|
Prio:=SpecialUnitPriority(PChar(NewUnitName));
|
|
UsesInsertPolicy:=Options.UsesInsertPolicy;
|
|
if AsLast then
|
|
UsesInsertPolicy:=uipLast;
|
|
InsertPosFound:=false;
|
|
if CheckSpecialUnits and (Prio<=High(SpecialUnits)) then begin
|
|
// this is a special unit, insert at the beginning
|
|
InsertBehind:=false;
|
|
InsertNode:=UsesNode.FirstChild;
|
|
while (InsertNode<>nil)
|
|
and (Prio>SpecialUnitPriority(@Src[InsertNode.StartPos])) do
|
|
InsertNode:=InsertNode.NextBrother;
|
|
InsertPosFound:=true;
|
|
if InsertNode=nil then begin
|
|
InsertBehind:=true;
|
|
InsertNode:=UsesNode.LastChild;
|
|
end;
|
|
end;
|
|
if not InsertPosFound then begin
|
|
FirstNormalUsesNode:=UsesNode.FirstChild;
|
|
if CheckSpecialUnits and (UsesInsertPolicy<>uipLast) then begin
|
|
while (FirstNormalUsesNode<>nil)
|
|
and (SpecialUnitPriority(@Src[FirstNormalUsesNode.StartPos])<Prio) do
|
|
FirstNormalUsesNode:=FirstNormalUsesNode.NextBrother;
|
|
if FirstNormalUsesNode=nil then
|
|
UsesInsertPolicy:=uipLast;
|
|
end;
|
|
|
|
case UsesInsertPolicy of
|
|
|
|
uipFirst:
|
|
begin
|
|
InsertBehind:=false;
|
|
InsertNode:=FirstNormalUsesNode;
|
|
end;
|
|
|
|
uipInFrontOfRelated,uipBehindRelated:
|
|
begin
|
|
if UsesInsertPolicy=uipBehindRelated then begin
|
|
InsertNode:=UsesNode.LastChild;
|
|
InsertBehind:=true;
|
|
end else begin
|
|
InsertBehind:=false;
|
|
InsertNode:=FirstNormalUsesNode;
|
|
end;
|
|
NewCode:=FindUnitSource(NewUnitName,'',false);
|
|
if NewCode<>nil then begin
|
|
NewFilename:=NewCode.Filename;
|
|
BestDiffCnt:=High(integer);
|
|
Node:=FirstNormalUsesNode;
|
|
while Node<>nil do begin
|
|
MoveCursorToCleanPos(Node.StartPos);
|
|
ReadNextAtom;
|
|
AnUnitName:=GetAtom;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
AnUnitInFilename:=copy(Src,CurPos.StartPos+1,CurPos.EndPos-CurPos.StartPos-2);
|
|
end else
|
|
AnUnitInFilename:='';
|
|
// search unit
|
|
//DebugLn(['TStandardCodeTool.AddUnitToUsesSection Unit=',AnUnitName,' in "',AnUnitInFilename,'"']);
|
|
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
|
|
if NewCode<>nil then begin
|
|
// used unit found -> compute distance
|
|
DiffPath:=CreateRelativePath(NewCode.Filename,ExtractFilePath(NewFilename));
|
|
DiffCnt:=0;
|
|
for i:=1 to length(DiffPath) do
|
|
if DiffPath[i]=PathDelim then
|
|
inc(DiffCnt);
|
|
//DebugLn(['TStandardCodeTool.AddUnitToUsesSection DiffCnt=',DiffCnt,' "',NewCode.Filename,'" "',NewFilename,'"']);
|
|
if UsesInsertPolicy=uipInFrontOfRelated then begin
|
|
// insert in front of the first node with the lowest DiffCnt
|
|
if BestDiffCnt>DiffCnt then begin
|
|
BestDiffCnt:=DiffCnt;
|
|
InsertNode:=Node;
|
|
InsertBehind:=false;
|
|
end;
|
|
end else begin
|
|
// insert behind the last node with the lowest DiffCnt
|
|
if BestDiffCnt>=DiffCnt then begin
|
|
BestDiffCnt:=DiffCnt;
|
|
InsertNode:=Node;
|
|
InsertBehind:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
Node:=Node.NextBrother;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
uipLast:
|
|
begin
|
|
InsertNode:=UsesNode.LastChild;
|
|
InsertBehind:=true;
|
|
end;
|
|
|
|
uipAlphabetically:
|
|
begin
|
|
InsertNode:=FirstNormalUsesNode;
|
|
InsertBehind:=false;
|
|
while (InsertNode<>nil)
|
|
and (CompareIdentifiers(PChar(NewUnitName),@Src[InsertNode.StartPos])<0) do
|
|
InsertNode:=InsertNode.NextBrother;
|
|
if InsertNode=nil then begin
|
|
InsertNode:=UsesNode.LastChild;
|
|
InsertBehind:=true;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
// build insert text "newunitname in 'file'"
|
|
NewUsesTerm:=NewUnitName;
|
|
if NewUnitInFile<>'' then
|
|
NewUsesTerm:=NewUsesTerm+' '
|
|
+Options.BeautifyKeyWord('in')
|
|
+' '''+NewUnitInFile+'''';
|
|
|
|
NewComma:=',';
|
|
if (atComma in Options.DoInsertSpaceInFront)
|
|
or (atIdentifier in Options.DoInsertSpaceAfter)
|
|
then
|
|
NewComma:=' '+NewComma;
|
|
if (atComma in Options.DoInsertSpaceAfter)
|
|
or (atIdentifier in Options.DoInsertSpaceInFront)
|
|
then
|
|
NewComma:=NewComma+' ';
|
|
|
|
if InsertBehind then begin
|
|
// insert behind unit name, in front of semicolon or comma
|
|
// for example: uses unit1|, unit2 in 'unit2.pp'|;
|
|
InsertPos:=InsertNode.EndPos;
|
|
InsertCode:=NewComma+NewUsesTerm;
|
|
end else begin
|
|
// insert in front of unit name, behind 'uses' or comma
|
|
// for example: uses |unit1, |unit2;
|
|
InsertPos:=InsertNode.StartPos;
|
|
InsertCode:=NewUsesTerm+NewComma;
|
|
end;
|
|
InsertToPos:=InsertPos;
|
|
|
|
//DebugLn(['TStandardCodeTool.AddUnitToUsesSection InsertNode=',ExtractNode(InsertNode,[]),' InsertBehind=',InsertBehind]);
|
|
|
|
// check if addition fits into the line
|
|
// if not, rebuild the uses section
|
|
GetLineStartEndAtPosition(Src,InsertPos,LineStart,LineEnd);
|
|
InsertLen:=length(NewUsesTerm)+length(NewComma);
|
|
//DebugLn(['TStandardCodeTool.AddUnitToUsesSection Line=',copy(Src,LineStart,InsertPos-LineStart),'<InsertPos>',copy(Src,InsertPos,LineEnd-InsertPos),' NewLen=',LineEnd-LineStart+InsertLen,' Max=',Options.LineLength,' Addition=',NewUsesTerm]);
|
|
if (LineEnd-LineStart+InsertLen > Options.LineLength) then begin
|
|
// line too long => reformat block of used units
|
|
// find start of block of used units
|
|
Node:=InsertNode;
|
|
while (Node.PriorBrother<>nil)
|
|
and NextUseUnitNodeInSameBlock(Node.PriorBrother) do
|
|
Node:=Node.PriorBrother;
|
|
InsertPos:=Node.StartPos;
|
|
GetLineStartEndAtPosition(Src,InsertPos,LineStart,LineEnd);
|
|
FirstIndent:=InsertPos-LineStart;
|
|
Indent:=GetLineIndent(Src,InsertPos);
|
|
if PositionsInSameLine(Src,UsesNode.StartPos,InsertPos) then begin
|
|
// for example: uses |unit1;
|
|
inc(Indent,Options.Indent);
|
|
end;
|
|
// create new block of used units
|
|
Lines:=TStringList.Create;
|
|
try
|
|
while Node<>nil do begin
|
|
InsertToPos:=Node.EndPos;
|
|
if (Node=InsertNode) and (not InsertBehind) then
|
|
AddUseUnit(Lines,FirstIndent,Indent,NewUsesTerm);
|
|
MoveCursorToCleanPos(Node.StartPos);
|
|
ReadNextAtom;
|
|
InsertCode:=GetAtom;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
InsertCode:=InsertCode+' '+Options.BeautifyKeyWord('in')+' '+GetAtom;
|
|
end;
|
|
AddUseUnit(Lines,FirstIndent,Indent,InsertCode);
|
|
if (Node=InsertNode) and InsertBehind then
|
|
AddUseUnit(Lines,FirstIndent,Indent,NewUsesTerm);
|
|
if not NextUseUnitNodeInSameBlock(Node) then break;
|
|
Node:=Node.NextBrother;
|
|
end;
|
|
InsertCode:='';
|
|
for i:=0 to Lines.Count-1 do begin
|
|
if i>0 then
|
|
InsertCode:=InsertCode+Options.LineEnd;
|
|
InsertCode:=InsertCode+Lines[i];
|
|
end;
|
|
finally
|
|
Lines.Free;
|
|
end;
|
|
end;
|
|
|
|
//DebugLn(['TStandardCodeTool.AddUnitToUsesSection Replace="',copy(Src,InsertPos,InsertToPos-InsertPos),'" with "',InsertCode,'"']);
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertToPos,
|
|
InsertCode) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddUnitToMainUsesSection(const NewUnitName,
|
|
NewUnitInFile: string; SourceChangeCache: TSourceChangeCache;
|
|
AsLast: boolean; CheckSpecialUnits: boolean): boolean;
|
|
var UsesNode, SectionNode: TCodeTreeNode;
|
|
NewUsesTerm: string;
|
|
InsertPos: integer;
|
|
Junk : TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
if (NewUnitName='') or (length(NewUnitName)>255) then exit;
|
|
BuildTree(true);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
UsesNode:=FindMainUsesSection;
|
|
if UsesNode<>nil then begin
|
|
// add unit to existing uses section
|
|
if not (FindUnitInUsesSection(UsesNode,UpperCaseStr(NewUnitName),Junk,Junk))
|
|
then begin
|
|
if not AddUnitToUsesSection(UsesNode,NewUnitName,NewUnitInFile,
|
|
SourceChangeCache,AsLast,CheckSpecialUnits)
|
|
then
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// create a new uses section
|
|
if Tree.Root=nil then exit;
|
|
SectionNode:=Tree.Root;
|
|
InsertPos:=0;
|
|
NewUsesTerm:='';
|
|
if SectionNode.Desc=ctnUnit then begin
|
|
// unit
|
|
SectionNode:=FindInterfaceNode;
|
|
if SectionNode=nil then begin
|
|
// unit without interface section
|
|
NewUsesTerm:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('interface')
|
|
+SourceChangeCache.BeautifyCodeOptions.LineEnd;
|
|
end else begin
|
|
// insert behind interface keyword
|
|
MoveCursorToNodeStart(SectionNode);
|
|
ReadNextAtom;
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos,false);
|
|
end;
|
|
end;
|
|
if InsertPos<1 then begin
|
|
// insert after title and directives
|
|
if SectionNode.Next<>nil then begin
|
|
InsertPos:=FindLineEndOrCodeInFrontOfPosition(SectionNode.Next.StartPos,
|
|
true);
|
|
end else begin
|
|
MoveCursorToNodeStart(SectionNode);
|
|
ReadNextAtom; // read keyword
|
|
ReadNextAtom; // read name
|
|
ReadNextAtom; // read semicolon
|
|
if CurPos.Flag<>cafSemicolon then
|
|
RaiseCharExpectedButAtomFound(';');
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos,true);
|
|
end;
|
|
end;
|
|
NewUsesTerm:=NewUsesTerm
|
|
+SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
|
|
+' '+NewUnitName;
|
|
if NewUnitInFile<>'' then
|
|
NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+''';'
|
|
else
|
|
NewUsesTerm:=NewUsesTerm+';';
|
|
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
|
|
NewUsesTerm) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveUnitFromUsesSection(UsesNode: TCodeTreeNode;
|
|
const UpperUnitName: string; SourceChangeCache: TSourceChangeCache): boolean;
|
|
var UnitCount, StartPos, EndPos: integer;
|
|
begin
|
|
Result:=false;
|
|
if (UsesNode=nil) or (UpperUnitName='') or (length(UpperUnitName)>255) then
|
|
exit;
|
|
MoveCursorToNodeStart(UsesNode);
|
|
ReadNextAtom; // read 'uses'
|
|
UnitCount:=0;
|
|
repeat
|
|
EndPos:=CurPos.StartPos;
|
|
ReadNextAtom; // read name
|
|
if not AtomIsIdentifier(false) then exit;
|
|
inc(UnitCount);
|
|
if UpAtomIs(UpperUnitName) then begin
|
|
// unit found
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
StartPos:=CurPos.StartPos;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
ReadNextAtom;
|
|
end;
|
|
if UnitCount=1 then begin
|
|
// first unit in uses section
|
|
if AtomIsChar(';') then begin
|
|
// last unit in uses section -> delete whole uses section
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
UsesNode.StartPos,UsesNode.EndPos,'') then exit;
|
|
end else begin
|
|
// not last unit -> delete with comma behind
|
|
EndPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos);
|
|
if (EndPos>SrcLen) or (Src[EndPos] in [#10,#13]) then
|
|
StartPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);// delete space in front or even the empty line
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
StartPos,EndPos,'') then exit;
|
|
end;
|
|
end else begin
|
|
// not first unit in uses section -> delete with comma in front
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
EndPos,CurPos.StartPos,'') then exit;
|
|
end;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
ReadNextAtom;
|
|
end;
|
|
if AtomIsChar(';') then break;
|
|
if not AtomIsChar(',') then break;
|
|
until (CurPos.StartPos>UsesNode.EndPos) or (CurPos.StartPos>SrcLen);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveUnitFromAllUsesSections(
|
|
const UpperUnitName: string; SourceChangeCache: TSourceChangeCache): boolean;
|
|
var SectionNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if (UpperUnitName='') or (SourceChangeCache=nil) then exit;
|
|
BuildTree(false);
|
|
SectionNode:=Tree.Root;
|
|
while (SectionNode<>nil) do begin
|
|
if (SectionNode.FirstChild<>nil)
|
|
and (SectionNode.FirstChild.Desc=ctnUsesSection) then begin
|
|
if not RemoveUnitFromUsesSection(SectionNode.FirstChild,UpperUnitName,
|
|
SourceChangeCache)
|
|
then begin
|
|
exit;
|
|
end;
|
|
end;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FixUsedUnitCase(
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
SectionNode: TCodeTreeNode;
|
|
begin
|
|
debugln('TStandardCodeTool.FixUsedUnitCase ',MainFilename);
|
|
Result:=false;
|
|
BuildTree(false);
|
|
SectionNode:=Tree.Root;
|
|
while (SectionNode<>nil) do begin
|
|
if (SectionNode.FirstChild<>nil)
|
|
and (SectionNode.FirstChild.Desc=ctnUsesSection) then begin
|
|
if not FixUsedUnitCaseInUsesSection(
|
|
SectionNode.FirstChild,SourceChangeCache)
|
|
then begin
|
|
exit;
|
|
end;
|
|
end;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FixUsedUnitCaseInUsesSection(
|
|
UsesNode: TCodeTreeNode; SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
function FindUnit(const AFilename: string): string;
|
|
var
|
|
CurDir: String;
|
|
MainCodeIsVirtual: Boolean;
|
|
FileInfo: TSearchRec;
|
|
CurFilename: String;
|
|
begin
|
|
if FilenameIsAbsolute(AFilename) then
|
|
CurDir:=ExtractFilePath(AFilename)
|
|
else begin
|
|
MainCodeIsVirtual:=TCodeBuffer(Scanner.MainCode).IsVirtual;
|
|
if not MainCodeIsVirtual then begin
|
|
CurDir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename);
|
|
end else begin
|
|
CurDir:='';
|
|
end;
|
|
end;
|
|
CurFilename:=ExtractFilename(AFilename);
|
|
Result:='';
|
|
if FindFirstUTF8(AppendPathDelim(CurDir)+FileMask,
|
|
faAnyFile,FileInfo)=0 then
|
|
begin
|
|
repeat
|
|
// check if special file
|
|
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
|
|
then
|
|
continue;
|
|
if (SysUtils.CompareText(CurFilename,FileInfo.Name)=0)
|
|
then begin
|
|
if (Result='') or (FileInfo.Name=CurFilename) then
|
|
Result:=FileInfo.Name;
|
|
end;
|
|
until FindNextUTF8(FileInfo)<>0;
|
|
end;
|
|
FindCloseUTF8(FileInfo);
|
|
end;
|
|
|
|
var
|
|
UnitInFilename: String;
|
|
Changed: Boolean;
|
|
RealUnitInFilename: String;
|
|
begin
|
|
Result:=false;
|
|
if (UsesNode=nil) then exit;
|
|
MoveCursorToNodeStart(UsesNode);
|
|
ReadNextAtom; // read 'uses'
|
|
Changed:=false;
|
|
repeat
|
|
ReadNextAtom; // read name
|
|
if not AtomIsIdentifier(false) then exit;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
UnitInFilename:=GetAtom;
|
|
//debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection A UnitInFilename="',UnitInFilename,'"');
|
|
if (UnitInFilename<>'') and (UnitInFilename[1]='''') then begin
|
|
UnitInFilename:=copy(UnitInFilename,2,length(UnitInFilename)-2);
|
|
RealUnitInFilename:=FindUnit(UnitInFilename);
|
|
//debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection B RealUnitInFilename="',RealUnitInFilename,'"');
|
|
if (RealUnitInFilename<>'')
|
|
and (RealUnitInFilename<>UnitInFilename) then begin
|
|
if not Changed then begin
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
Changed:=true;
|
|
end;
|
|
debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection Replacing UnitInFilename="',UnitInFilename,'" with "',RealUnitInFilename,'"');
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
CurPos.StartPos,CurPos.EndPos,''''+RealUnitInFilename+'''') then exit;
|
|
end;
|
|
end;
|
|
ReadNextAtom;
|
|
end;
|
|
if AtomIsChar(';') then break;
|
|
if not AtomIsChar(',') then exit;
|
|
until (CurPos.StartPos>UsesNode.EndPos) or (CurPos.StartPos>SrcLen);
|
|
if Changed and (not SourceChangeCache.Apply) then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindUsedUnitNames(var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean;
|
|
var
|
|
MainUsesNode, ImplementatioUsesNode: TCodeTreeNode;
|
|
begin
|
|
MainUsesSection:=nil;
|
|
ImplementationUsesSection:=nil;
|
|
// find the uses sections
|
|
BuildTree(false);
|
|
MainUsesNode:=FindMainUsesSection;
|
|
ImplementatioUsesNode:=FindImplementationUsesSection;
|
|
// create lists
|
|
try
|
|
MainUsesSection:=UsesSectionToUnitNames(MainUsesNode);
|
|
ImplementationUsesSection:=UsesSectionToUnitNames(ImplementatioUsesNode);
|
|
except
|
|
FreeAndNil(MainUsesSection);
|
|
FreeAndNil(ImplementationUsesSection);
|
|
raise;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindUsedUnitNames(var List: TStringToStringTree
|
|
): boolean;
|
|
|
|
procedure Collect(UsesNode: TCodeTreeNode; const Tag: string);
|
|
var
|
|
UnitNameAtom: TAtomPosition;
|
|
InAtom: TAtomPosition;
|
|
OldTag: string;
|
|
AnUnitName: String;
|
|
begin
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToUsesStart(UsesNode);
|
|
repeat
|
|
// read next unit name
|
|
ReadNextUsedUnit(UnitNameAtom, InAtom);
|
|
AnUnitName:=GetAtom(UnitNameAtom);
|
|
// tag unit in list
|
|
OldTag:=List[AnUnitName];
|
|
if System.Pos(Tag,OldTag)<1 then
|
|
List[AnUnitName]:=OldTag+Tag;
|
|
if CurPos.Flag=cafComma then begin
|
|
// read next unit name
|
|
ReadNextAtom;
|
|
end else if CurPos.Flag=cafSemicolon then begin
|
|
break;
|
|
end else
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
begin
|
|
// find the uses sections
|
|
List:=TStringToStringTree.Create(false);
|
|
BuildTree(false);
|
|
Collect(FindMainUsesSection,'Main');
|
|
Collect(FindMainUsesSection,'Implementation');
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindUsedUnitFiles(var MainUsesSection: TStrings
|
|
): boolean;
|
|
var
|
|
MainUsesNode: TCodeTreeNode;
|
|
begin
|
|
MainUsesSection:=nil;
|
|
// find the uses sections
|
|
BuildTree(true);
|
|
MainUsesNode:=FindMainUsesSection;
|
|
// create lists
|
|
try
|
|
MainUsesSection:=UsesSectionToFilenames(MainUsesNode);
|
|
except
|
|
FreeAndNil(MainUsesSection);
|
|
raise;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindUsedUnitFiles(var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean;
|
|
var
|
|
MainUsesNode, ImplementatioUsesNode: TCodeTreeNode;
|
|
begin
|
|
MainUsesSection:=nil;
|
|
ImplementationUsesSection:=nil;
|
|
// find the uses sections
|
|
BuildTree(false);
|
|
MainUsesNode:=FindMainUsesSection;
|
|
ImplementatioUsesNode:=FindImplementationUsesSection;
|
|
// create lists
|
|
try
|
|
MainUsesSection:=UsesSectionToFilenames(MainUsesNode);
|
|
ImplementationUsesSection:=UsesSectionToFilenames(ImplementatioUsesNode);
|
|
except
|
|
FreeAndNil(MainUsesSection);
|
|
FreeAndNil(ImplementationUsesSection);
|
|
raise;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TStandardCodeTool.FindDelphiProjectUnits(var FoundInUnits,
|
|
MissingInUnits, NormalUnits: TStrings): boolean;
|
|
|
|
Reads the main uses section and tries to find each unit file having
|
|
an 'in' modifier.
|
|
The associated objects in the list will be the found codebuffers.
|
|
FoundInUnits returns the list of found 'in' unitnames plus TCodeBuffer
|
|
MissingInUnits returns the list of missing 'in' unitnames
|
|
NormalUnits returns the list of unitnames plus TCodeBuffer (if found)
|
|
|
|
If no codebuffer was found/created then the filename will be the unit name
|
|
plus the 'in' extension.
|
|
------------------------------------------------------------------------------}
|
|
function TStandardCodeTool.FindDelphiProjectUnits(var FoundInUnits,
|
|
MissingInUnits, NormalUnits: TStrings; UseContainsSection: boolean): boolean;
|
|
var
|
|
InAtom, UnitNameAtom: TAtomPosition;
|
|
AnUnitName, AnUnitInFilename: string;
|
|
NewCode: TCodeBuffer;
|
|
UsesNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
FoundInUnits:=nil;
|
|
MissingInUnits:=nil;
|
|
NormalUnits:=nil;
|
|
DebugLn('TStandardCodeTool.FindDelphiProjectUnits UseContainsSection=',dbgs(UseContainsSection));
|
|
// find the uses sections
|
|
BuildTree(false);
|
|
UsesNode:=FindMainUsesSection(UseContainsSection);
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToUsesStart(UsesNode);
|
|
FoundInUnits:=TStringList.Create;
|
|
MissingInUnits:=TStringList.Create;
|
|
NormalUnits:=TStringList.Create;
|
|
repeat
|
|
// read next unit name
|
|
ReadNextUsedUnit(UnitNameAtom, InAtom);
|
|
AnUnitName:=GetAtom(UnitNameAtom);
|
|
if InAtom.StartPos>0 then begin
|
|
AnUnitInFilename:=copy(Src,InAtom.StartPos+1,
|
|
InAtom.EndPos-InAtom.StartPos-2);
|
|
end else
|
|
AnUnitInFilename:='';
|
|
// find unit file
|
|
if AnUnitInFilename<>'' then begin
|
|
// An 'in' unit => Delphi project file
|
|
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
|
|
if (NewCode=nil) then begin
|
|
// no source found
|
|
MissingInUnits.Add(AnUnitName+' in '+AnUnitInFilename);
|
|
end else begin
|
|
// source found => add filename to list
|
|
FoundInUnits.AddObject(AnUnitName+' in '+AnUnitInFilename,NewCode);
|
|
end;
|
|
end else begin
|
|
// the units without 'in' are 'Forms' or units added by the user
|
|
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
|
|
NormalUnits.AddObject(AnUnitName,NewCode);
|
|
end;
|
|
if CurPos.Flag=cafComma then begin
|
|
// read next unit name
|
|
ReadNextAtom;
|
|
end else if CurPos.Flag=cafSemicolon then begin
|
|
break;
|
|
end else
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode
|
|
): TStrings;
|
|
|
|
Reads the uses section backwards and tries to find each unit file.
|
|
The associated objects in the list will be the found codebuffers.
|
|
If no codebuffer was found/created then the filename will be the unit name
|
|
plus the 'in' extension.
|
|
------------------------------------------------------------------------------}
|
|
function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode
|
|
): TStrings;
|
|
var
|
|
InAtom, UnitNameAtom: TAtomPosition;
|
|
AnUnitName, AnUnitInFilename: string;
|
|
NewCode: TCodeBuffer;
|
|
UnitFilename: string;
|
|
begin
|
|
Result:=TStringList.Create;
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToUsesEnd(UsesNode);
|
|
repeat
|
|
// read prior unit name
|
|
ReadPriorUsedUnit(UnitNameAtom, InAtom);
|
|
AnUnitName:=GetAtom(UnitNameAtom);
|
|
if InAtom.StartPos>0 then
|
|
AnUnitInFilename:=copy(Src,InAtom.StartPos+1,
|
|
InAtom.EndPos-InAtom.StartPos-2)
|
|
else
|
|
AnUnitInFilename:='';
|
|
// find unit file
|
|
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
|
|
if (NewCode=nil) then begin
|
|
// no source found
|
|
UnitFilename:=AnUnitName;
|
|
if AnUnitInFilename<>'' then
|
|
UnitFilename:=UnitFilename+' in '+AnUnitInFilename;
|
|
end else begin
|
|
// source found
|
|
UnitFilename:=NewCode.Filename;
|
|
end;
|
|
// add filename to list
|
|
Result.AddObject(UnitFilename,NewCode);
|
|
// read keyword 'uses' or comma
|
|
ReadPriorAtom;
|
|
until not AtomIsChar(',');
|
|
end;
|
|
|
|
function TStandardCodeTool.UsesSectionToUnitnames(UsesNode: TCodeTreeNode
|
|
): TStrings;
|
|
var
|
|
InAtom, UnitNameAtom: TAtomPosition;
|
|
AnUnitName: string;
|
|
begin
|
|
Result:=TStringList.Create;
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToUsesEnd(UsesNode);
|
|
repeat
|
|
// read prior unit name
|
|
ReadPriorUsedUnit(UnitNameAtom, InAtom);
|
|
AnUnitName:=GetAtom(UnitNameAtom);
|
|
Result.Add(AnUnitName);
|
|
// read keyword 'uses' or comma
|
|
ReadPriorAtom;
|
|
until not AtomIsChar(',');
|
|
end;
|
|
|
|
function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings;
|
|
FixCase: boolean; SearchImplementation: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
function CheckUsesSection(UsesNode: TCodeTreeNode): boolean;
|
|
var
|
|
InAtom, UnitNameAtom: TAtomPosition;
|
|
OldUnitName: String;
|
|
OldInFilename: String;
|
|
AFilename: String;
|
|
s: String;
|
|
NewUnitName: String;
|
|
NewInFilename: String;
|
|
FromPos: LongInt;
|
|
ToPos: LongInt;
|
|
begin
|
|
if UsesNode=nil then exit(true);
|
|
if not CheckDirectoryCache then exit(false);
|
|
|
|
MoveCursorToUsesStart(UsesNode);
|
|
repeat
|
|
// read next unit name
|
|
ReadNextUsedUnit(UnitNameAtom, InAtom);
|
|
OldUnitName:=GetAtom(UnitNameAtom);
|
|
if InAtom.StartPos>0 then
|
|
OldInFilename:=copy(Src,InAtom.StartPos+1,
|
|
InAtom.EndPos-InAtom.StartPos-2)
|
|
else
|
|
OldInFilename:='';
|
|
// find unit file
|
|
NewUnitName:=OldUnitName;
|
|
NewInFilename:=OldInFilename;
|
|
AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
|
|
NewUnitName,NewInFilename,true);
|
|
s:=NewUnitName;
|
|
if NewInFilename<>'' then
|
|
s:=s+' in '''+NewInFilename+'''';
|
|
if AFilename<>'' then begin
|
|
// unit found
|
|
if (NewUnitName<>OldUnitName) or (NewInFilename<>OldInFilename) then
|
|
begin
|
|
// fix case
|
|
FromPos:=UnitNameAtom.StartPos;
|
|
if InAtom.StartPos>0 then
|
|
ToPos:=InAtom.EndPos
|
|
else
|
|
ToPos:=UnitNameAtom.EndPos;
|
|
SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,s);
|
|
DebugLn('CheckUsesSection fix case Unit Name(',OldUnitName,'->',NewUnitName,') InFile(',OldInFilename,'->',NewInFilename,')');
|
|
end;
|
|
end else begin
|
|
// unit not found
|
|
if MissingUnits=nil then MissingUnits:=TStringList.Create;
|
|
MissingUnits.Add(s);
|
|
end;
|
|
if CurPos.Flag=cafComma then begin
|
|
// read next unit name
|
|
ReadNextAtom;
|
|
end else if CurPos.Flag=cafSemicolon then begin
|
|
break;
|
|
end else
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
BuildTree(false);
|
|
if FixCase then
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
try
|
|
if not CheckUsesSection(FindMainUsesSection) then exit;
|
|
if SearchImplementation
|
|
and not CheckUsesSection(FindImplementationUsesSection) then exit;
|
|
except
|
|
FreeAndNil(MissingUnits);
|
|
raise;
|
|
end;
|
|
if FixCase then
|
|
Result:=SourceChangeCache.Apply
|
|
else
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
procedure Comment(StartPos, EndPos: integer);
|
|
begin
|
|
CommentCode(StartPos,EndPos,SourceChangeCache,false);
|
|
end;
|
|
|
|
function CommentUnitsInUsesSection(UsesNode: TCodeTreeNode): boolean;
|
|
// Examples:
|
|
// 1. uses {a,} b, c; commenting one unit not at end
|
|
// 2. uses a, {b,} c; commenting one unit not at end
|
|
// 3. uses {a, b,} c; commenting several units not at end
|
|
// 4. uses a{, b, c} ; commenting units at end
|
|
// 5. {uses a, b, c;} commenting all units
|
|
// 6. uses {a,} b{, c}; commenting several units
|
|
var
|
|
i: Integer;
|
|
CurUnitName: String;
|
|
CommentCurUnit: Boolean;
|
|
FirstCommentUnitStart: Integer;
|
|
LastCommaAfterCommentUnitsStart: Integer;
|
|
LastNormalUnitEnd: Integer;
|
|
LastCommentUnitEnd: Integer;
|
|
begin
|
|
Result:=true;
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToUsesStart(UsesNode);
|
|
FirstCommentUnitStart:=-1;
|
|
LastCommaAfterCommentUnitsStart:=-1;
|
|
LastNormalUnitEnd:=-1;
|
|
LastCommentUnitEnd:=-1;
|
|
repeat
|
|
// check if unit should be commented
|
|
AtomIsIdentifier(true);
|
|
CurUnitName:=GetAtom;
|
|
i:=MissingUnits.Count-1;
|
|
while (i>=0)
|
|
and (CompareIdentifiers(PChar(Pointer(MissingUnits[i])),
|
|
PChar(Pointer(CurUnitName)))<>0) do
|
|
dec(i);
|
|
CommentCurUnit:=i>=0;
|
|
//debugln('CommentUnitsInUsesSection CurUnitName="',CurUnitName,'" CommentCurUnit=',dbgs(CommentCurUnit));
|
|
|
|
if CommentCurUnit then begin
|
|
// unit should be commented
|
|
if FirstCommentUnitStart<1 then FirstCommentUnitStart:=CurPos.StartPos;
|
|
LastCommentUnitEnd:=CurPos.EndPos;
|
|
end else begin
|
|
// unit should be kept
|
|
LastNormalUnitEnd:=CurPos.EndPos;
|
|
if FirstCommentUnitStart>=1 then begin
|
|
// there are some units to be commented
|
|
// See examples: 1., 2., 3. and 6.
|
|
Comment(FirstCommentUnitStart,LastCommaAfterCommentUnitsStart);
|
|
FirstCommentUnitStart:=-1;
|
|
LastCommentUnitEnd:=-1;
|
|
LastCommaAfterCommentUnitsStart:=-1;
|
|
end;
|
|
end;
|
|
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom; // read filename
|
|
if not AtomIsStringConstant then
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsStringConstant,GetAtom]);
|
|
if (not CommentCurUnit) then
|
|
LastNormalUnitEnd:=CurPos.EndPos;
|
|
if CommentCurUnit then
|
|
LastCommentUnitEnd:=CurPos.EndPos;
|
|
ReadNextAtom; // read comma or semicolon
|
|
end;
|
|
|
|
if CommentCurUnit then
|
|
LastCommaAfterCommentUnitsStart:=CurPos.EndPos;
|
|
|
|
if CurPos.Flag<>cafComma then begin
|
|
if CommentCurUnit then begin
|
|
// last unit must be commented
|
|
if LastNormalUnitEnd>=1 then begin
|
|
// comment last unit and keep some units in front
|
|
// See example: 4.
|
|
Comment(LastNormalUnitEnd,LastCommentUnitEnd);
|
|
end else begin
|
|
// all units should be commented
|
|
// See example: 5.
|
|
Comment(UsesNode.StartPos,CurPos.EndPos);
|
|
end;
|
|
end;
|
|
break;
|
|
end;
|
|
|
|
ReadNextAtom;
|
|
until false;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
if (MissingUnits=nil) or (MissingUnits.Count=0) then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
BuildTree(false);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if not CommentUnitsInUsesSection(FindMainUsesSection) then exit;
|
|
if not CommentUnitsInUsesSection(FindImplementationUsesSection) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindUnusedUnits(Units: TStrings): boolean;
|
|
// returns a list of unitname=flags
|
|
// flags are a comma separated list of words:
|
|
// 'implementation': unit is in implementation uses section
|
|
// 'used': an identifier of the interface is used
|
|
// 'code': unit has non empty initialization/finalization section
|
|
var
|
|
Identifiers: TAVLTree;// all identifiers used in this unit
|
|
|
|
function IsUnitAlreadyChecked(const AnUnitName: string): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to Units.Count-1 do
|
|
if SysUtils.CompareText(Units.Names[i],AnUnitName)=0 then exit(true);
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure GatherIdentifiersInRange(StartPos, EndPos: integer);
|
|
// gather all used identifiers from this unit in the range Startpos..EndPos
|
|
var
|
|
Identifier: PChar;
|
|
begin
|
|
if (StartPos<1) or (StartPos>=EndPos) then exit;
|
|
MoveCursorToCleanPos(StartPos);
|
|
repeat
|
|
ReadNextAtom;
|
|
if CurPos.StartPos>=EndPos then break;
|
|
if IsIdentStartChar[Src[CurPos.StartPos]] then begin
|
|
Identifier:=@Src[CurPos.StartPos];
|
|
if Identifiers.Find(Identifier)=nil then begin
|
|
DebugLn(['Used Identifier=',GetIdentifier(Identifier)]);
|
|
Identifiers.Add(Identifier);
|
|
end;
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
procedure GatherIdentifiers;
|
|
// gather all used identifiers from this unit
|
|
var
|
|
StartPos: Integer;
|
|
|
|
procedure Gather(EndPos: integer);
|
|
begin
|
|
if StartPos<1 then exit;
|
|
GatherIdentifiersInRange(StartPos,EndPos);
|
|
StartPos:=-1;
|
|
end;
|
|
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
if Identifiers<>nil then exit;
|
|
Identifiers:=TAVLTree.Create(@CompareIdentifierPtrs);
|
|
DebugLn(['GatherIdentifiers ']);
|
|
StartPos:=-1;
|
|
Node:=Tree.Root;
|
|
while Node<>nil do begin
|
|
case Node.Desc of
|
|
ctnUseUnit,ctnUsesSection,
|
|
ctnProgram,ctnUnit,ctnPackage,ctnLibrary,ctnEndPoint:
|
|
begin
|
|
// skip node
|
|
Gather(Node.StartPos);
|
|
end;
|
|
ctnEnumIdentifier,
|
|
ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition:
|
|
begin
|
|
// start reading behind identifier
|
|
Gather(Node.StartPos);
|
|
MoveCursorToCleanPos(Node.StartPos);
|
|
ReadNextAtom;
|
|
StartPos:=CurPos.EndPos;
|
|
end;
|
|
else
|
|
if StartPos<1 then
|
|
StartPos:=Node.StartPos;
|
|
end;
|
|
Node:=Node.Next;
|
|
end;
|
|
end;
|
|
|
|
function InterfaceIsUsed(Tool: TFindDeclarationTool;
|
|
IntfNode: TCodeTreeNode): boolean;
|
|
|
|
function IsIdentifierUsed(StartPos: integer): boolean;
|
|
begin
|
|
if CompareIdentifiers(PChar(GetIdentifier(@Tool.Src[StartPos])),'TComponent')=0 then
|
|
DebugLn(['IsIdentifierUsed ',GetIdentifier(@Tool.Src[StartPos])]);
|
|
Result:=Identifiers.Find(@Tool.Src[StartPos])<>nil;
|
|
end;
|
|
|
|
function IsNodeVisible(Node: TCodeTreeNode): boolean;
|
|
begin
|
|
if (Node.Parent=nil)
|
|
or (Node.Parent.Desc=ctnInterface)
|
|
or (Node.Parent.Parent=nil)
|
|
or (Node.Parent.Parent.Desc=ctnInterface) then
|
|
Result:=true
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Result:=true;
|
|
Node:=IntfNode.FirstChild;
|
|
while Node<>nil do begin
|
|
case Node.Desc of
|
|
ctnEnumIdentifier:
|
|
if IsIdentifierUsed(Node.StartPos) then exit;
|
|
ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition:
|
|
if IsNodeVisible(Node) and IsIdentifierUsed(Node.StartPos) then exit;
|
|
ctnProcedure:
|
|
if (Node.Parent.Desc=ctnInterface)
|
|
and (Node.FirstChild<>nil)
|
|
and (Node.FirstChild.Desc=ctnProcedureHead)
|
|
and IsIdentifierUsed(Node.FirstChild.StartPos) then exit;
|
|
ctnGlobalProperty:
|
|
if Tool.MoveCursorToPropName(Node)
|
|
and IsIdentifierUsed(Tool.CurPos.StartPos) then exit;
|
|
end;
|
|
Node:=Node.Next;
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure CheckUnit(Tool: TFindDeclarationTool;
|
|
out HasCode, UseInterface: boolean);
|
|
var
|
|
Node: TCodeTreeNode;
|
|
Identifier: String;
|
|
begin
|
|
GatherIdentifiers;
|
|
HasCode:=false;
|
|
UseInterface:=false;
|
|
// parse used unit
|
|
Tool.BuildTree(false);
|
|
Node:=Tool.Tree.Root;
|
|
while (Node<>nil) do begin
|
|
case Node.Desc of
|
|
ctnUnit,ctnPackage,ctnLibrary:
|
|
begin
|
|
Identifier:=Tool.ExtractSourceName;
|
|
if Identifiers.Find(PChar(Identifier))<>nil then
|
|
UseInterface:=true;
|
|
end;
|
|
ctnInterface:
|
|
if not UseInterface then
|
|
UseInterface:=InterfaceIsUsed(Tool,Node);
|
|
ctnInitialization,ctnFinalization,ctnBeginBlock:
|
|
begin
|
|
HasCode:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
Node:=Node.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckUsesSection(UsesNode: TCodeTreeNode; InImplementation: boolean);
|
|
var
|
|
UnitNamePos: TAtomPosition;
|
|
UnitInFilePos: TAtomPosition;
|
|
Unit_Name: String;
|
|
UnitInFilename: String;
|
|
Tool: TFindDeclarationTool;
|
|
HasCode: boolean;
|
|
UseInterface: boolean;
|
|
Flags: String;
|
|
OldPos: LongInt;
|
|
begin
|
|
HasCode:=false;
|
|
UseInterface:=false;
|
|
if UsesNode=nil then exit;
|
|
MoveCursorToNodeStart(UsesNode);
|
|
ReadNextAtom;
|
|
if not UpAtomIs('USES') then
|
|
RaiseUsesExpected;
|
|
repeat
|
|
ReadNextAtom; // read name
|
|
if AtomIsChar(';') then break;
|
|
AtomIsIdentifier(true);
|
|
UnitNamePos:=CurPos;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
if not AtomIsStringConstant then RaiseStrConstExpected;
|
|
UnitInFilePos:=CurPos;
|
|
ReadNextAtom;
|
|
end else
|
|
UnitInFilePos.StartPos:=-1;
|
|
Unit_Name:=copy(Src,UnitNamePos.StartPos,
|
|
UnitNamePos.EndPos-UnitNamePos.StartPos);
|
|
if not IsUnitAlreadyChecked(Unit_Name) then begin
|
|
OldPos:=CurPos.StartPos;
|
|
if UnitInFilePos.StartPos>=1 then begin
|
|
UnitInFilename:=copy(Src,UnitInFilePos.StartPos+1,
|
|
UnitInFilePos.EndPos-UnitInFilePos.StartPos-2);
|
|
end else
|
|
UnitInFilename:='';
|
|
// try to load the used unit
|
|
DebugLn(['CheckUsesSection ',Unit_Name,UnitInFilename]);
|
|
Tool:=FindCodeToolForUsedUnit(Unit_Name,UnitInFilename,true);
|
|
// parse the used unit
|
|
CheckUnit(Tool,HasCode,UseInterface);
|
|
Flags:='';
|
|
if InImplementation then
|
|
Flags:=Flags+',implementation';
|
|
if HasCode then
|
|
Flags:=Flags+',code';
|
|
if UseInterface then
|
|
Flags:=Flags+',used';
|
|
DebugLn(['CheckUsesSection ',Unit_Name,'=',Flags]);
|
|
Units.Add(Unit_Name+'='+Flags);
|
|
// restore cursor
|
|
MoveCursorToCleanPos(OldPos);
|
|
ReadNextAtom;
|
|
end;
|
|
if AtomIsChar(';') then break;
|
|
if not AtomIsChar(',') then
|
|
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom])
|
|
until (CurPos.StartPos>SrcLen);
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
DebugLn(['TStandardCodeTool.FindUnusedUnits ']);
|
|
BuildTree(false);
|
|
Identifiers:=nil;
|
|
try
|
|
CheckUsesSection(FindMainUsesSection,false);
|
|
CheckUsesSection(FindImplementationUsesSection,true);
|
|
finally
|
|
Identifiers.Free;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindNextIncludeInInitialization(
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
// LinkIndex < 0 -> search first
|
|
var
|
|
InitializationNode: TCodeTreeNode;
|
|
StartCode: TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
if LinkIndex<0 then begin
|
|
BuildTree(false);
|
|
InitializationNode:=FindInitializationNode;
|
|
if InitializationNode=nil then exit;
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(InitializationNode.StartPos);
|
|
end else
|
|
inc(LinkIndex);
|
|
if (LinkIndex<0) or (LinkIndex>=Scanner.LinkCount) then exit;
|
|
StartCode:=TCodeBuffer(Scanner.Links[LinkIndex].Code);
|
|
while (LinkIndex<Scanner.LinkCount)
|
|
and (Scanner.Links[LinkIndex].CleanedPos<InitializationNode.EndPos) do begin
|
|
Result:=TCodeBuffer(Scanner.Links[LinkIndex].Code);
|
|
if (Result<>StartCode) then
|
|
exit;
|
|
inc(LinkIndex);
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindLazarusResourceInBuffer(
|
|
ResourceCode: TCodeBuffer; const ResourceName: string): TAtomPosition;
|
|
var ResNameCode: string;
|
|
|
|
function ReadLazResource: boolean;
|
|
begin
|
|
Result:=false;
|
|
if not ReadNextAtomIsChar('.') then exit;
|
|
if not ReadNextUpAtomIs('ADD') then exit;
|
|
if not ReadNextAtomIsChar('(') then exit;
|
|
ReadNextAtom;
|
|
if not AtomIsStringConstant then exit;
|
|
if UpAtomIs(ResNameCode) then
|
|
Result:=true;
|
|
repeat
|
|
ReadNextAtom;
|
|
until (CurPos.StartPos>SrcLen) or (AtomIsChar(')'));
|
|
ReadNextAtom; // read ';'
|
|
end;
|
|
|
|
var CleanPos, MaxCleanPos: integer;
|
|
begin
|
|
Result.StartPos:=-1;
|
|
if (ResourceCode=nil) or (ResourceName='') or (length(ResourceName)>255) then
|
|
exit;
|
|
if Scanner.CursorToCleanPos(1,ResourceCode,CleanPos)<>0 then exit;
|
|
if Scanner.CursorToCleanPos(ResourceCode.SourceLength,ResourceCode,
|
|
MaxCleanPos)<>0 then
|
|
MaxCleanPos:=-1;
|
|
MoveCursorToCleanPos(CleanPos);
|
|
ResNameCode:=''''+UpperCaseStr(ResourceName)+'''';
|
|
// search "LazarusResources.Add('<ResourceName>',"
|
|
repeat
|
|
ReadNextAtom; // read 'LazarusResources'
|
|
if UpAtomIs('LAZARUSRESOURCES') then begin
|
|
Result.StartPos:=CurPos.StartPos;
|
|
if ReadLazResource then begin
|
|
Result.EndPos:=CurPos.EndPos;
|
|
exit;
|
|
end;
|
|
end;
|
|
until (CurPos.StartPos>SrcLen) or UpAtomIs('END')
|
|
or ((MaxCleanPos>0) and (CurPos.StartPos>MaxCleanPos));
|
|
Result.StartPos:=-1;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindLazarusResource(
|
|
const ResourceName: string): TAtomPosition;
|
|
// search Resource in all include files
|
|
var LinkIndex: integer;
|
|
CurCode: TCodeBuffer;
|
|
begin
|
|
Result.StartPos:=-1;
|
|
Result.EndPos:=-1;
|
|
Result.Flag:=cafNone;
|
|
LinkIndex:=-1;
|
|
CurCode:=FindNextIncludeInInitialization(LinkIndex);
|
|
while (CurCode<>nil) do begin
|
|
Result:=FindLazarusResourceInBuffer(CurCode,ResourceName);
|
|
if Result.StartPos>0 then exit;
|
|
CurCode:=FindNextIncludeInInitialization(LinkIndex);
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddLazarusResource(ResourceCode: TCodeBuffer;
|
|
const ResourceName, ResourceData: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
// ResoureData is the complete LazarusResource Statement
|
|
var FromPos, ToPos, i: integer;
|
|
OldPosition: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
if (ResourceCode=nil) or (ResourceName='') or (length(ResourceName)>255)
|
|
or (ResourceData='') or (SourceChangeCache=nil) then exit;
|
|
BuildTree(false);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
|
|
if OldPosition.StartPos>0 then begin
|
|
// replace old resource
|
|
FromPos:=OldPosition.StartPos;
|
|
ToPos:=OldPosition.EndPos;
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,ToPos,
|
|
ResourceData) then exit;
|
|
end else begin
|
|
// insert new resource
|
|
if ResourceCode.SourceLength>0 then begin
|
|
if Scanner.CursorToCleanPos(ResourceCode.SourceLength,ResourceCode,
|
|
FromPos)<>0 then exit;
|
|
inc(FromPos);
|
|
end else begin
|
|
// resource code empty -> can not be found in cleaned code
|
|
// special replace
|
|
i:=0;
|
|
while (i<Scanner.LinkCount)
|
|
and (Scanner.Links[i].Code<>Pointer(ResourceCode)) do
|
|
inc(i);
|
|
if i>=Scanner.LinkCount then exit;
|
|
FromPos:=Scanner.Links[i].CleanedPos;
|
|
end;
|
|
if not SourceChangeCache.ReplaceEx(gtNewLine,gtNewLine,FromPos,FromPos,
|
|
ResourceCode,ResourceCode.SourceLength+1,ResourceCode.SourceLength+1,
|
|
ResourceData)
|
|
then exit;
|
|
end;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveLazarusResource(ResourceCode: TCodeBuffer;
|
|
const ResourceName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var OldPosition: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
if (ResourceCode=nil) or (ResourceName='') or (length(ResourceName)>255)
|
|
or (SourceChangeCache=nil) then exit;
|
|
BuildTree(false);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
|
|
if OldPosition.StartPos>0 then begin
|
|
OldPosition.StartPos:=FindLineEndOrCodeInFrontOfPosition(
|
|
OldPosition.StartPos);
|
|
OldPosition.EndPos:=FindLineEndOrCodeAfterPosition(OldPosition.EndPos);
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
OldPosition.StartPos,OldPosition.EndPos,'') then exit;
|
|
end;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RenameInclude(LinkIndex: integer;
|
|
const NewFilename: string; KeepPath: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
{ change filename in an include directive
|
|
if KeepPath is true and the include dircetive contains a path
|
|
(relative or absolute), then this path is kept and only the filename is
|
|
replaced
|
|
}
|
|
var IncludeStart, IncludeEnd, FileStart, FileNameStart, FileEnd: integer;
|
|
begin
|
|
Result:=false;
|
|
if (LinkIndex<0) or (LinkIndex>=Scanner.LinkCount) or (NewFileName='')
|
|
or (KeepPath and (length(NewFilename)>255))
|
|
or (SourceChangeCache=nil) then exit;
|
|
// find include directive
|
|
IncludeEnd:=Scanner.Links[LinkIndex].CleanedPos;
|
|
IncludeStart:=IncludeEnd-1;
|
|
if IncludeStart<1 then exit;
|
|
case Src[IncludeStart] of
|
|
'}':
|
|
begin
|
|
FileEnd:=IncludeStart;
|
|
dec(IncludeStart);
|
|
while (IncludeStart>0) and (Src[IncludeStart]<>'{') do
|
|
dec(IncludeStart);
|
|
end;
|
|
')':
|
|
begin
|
|
dec(IncludeStart);
|
|
FileEnd:=IncludeStart;
|
|
while (IncludeStart>1)
|
|
and ((Src[IncludeStart]<>'*') or (Src[IncludeStart-1]<>'(')) do
|
|
dec(IncludeStart);
|
|
end;
|
|
#13,#10:
|
|
begin
|
|
FileEnd:=IncludeStart;
|
|
if (FileEnd>0) and (IsLineEndChar[Src[FileEnd]]) then dec(FileEnd);
|
|
dec(IncludeStart);
|
|
while (IncludeStart>1)
|
|
and ((Src[IncludeStart]<>'/') or (Src[IncludeStart-1]<>'/')) do
|
|
dec(IncludeStart);
|
|
end;
|
|
end;
|
|
if IncludeStart<1 then exit;
|
|
FileStart:=IncludeStart;
|
|
while (FileStart<IncludeEnd) and (Src[FileStart]<>'$') do
|
|
inc(FileStart);
|
|
while (FileStart<IncludeEnd) and (not (IsSpaceChar[Src[FileStart]])) do
|
|
inc(FileStart);
|
|
while (FileStart<IncludeEnd) and (IsSpaceChar[Src[FileStart]]) do
|
|
inc(FileStart);
|
|
if FileStart>=IncludeEnd then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if KeepPath then begin
|
|
FileNameStart:=FileEnd;
|
|
while (FileNameStart>FileStart) and (Src[FileNameStart]<>PathDelim) do
|
|
dec(FileNameStart);
|
|
if Src[FileNameStart]=PathDelim then
|
|
FileStart:=FileNameStart+1;
|
|
end;
|
|
if not SourceChangeCache.Replace(gtNone,GtNone,FileStart,FileEnd,
|
|
NewFilename) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.CheckLFM(LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
|
|
const OnFindDefineProperty: TOnFindDefinePropertyForContext;
|
|
RootMustBeClassInIntf, ObjectsMustExist: boolean): boolean;
|
|
var
|
|
RootContext: TFindContext;
|
|
|
|
function CheckLFMObjectValues(LFMObject: TLFMObjectNode;
|
|
const ClassContext: TFindContext; ContextIsDefault: boolean): boolean; forward;
|
|
|
|
function FindNonPublishedDefineProperty(LFMNode: TLFMTreeNode;
|
|
DefaultErrorPosition: integer;
|
|
const IdentName: string; const ClassContext: TFindContext): boolean;
|
|
var
|
|
PropertyNode: TLFMPropertyNode;
|
|
ObjectNode: TLFMObjectNode;
|
|
AncestorClassContext: TFindContext;
|
|
Params: TFindDeclarationParams;
|
|
IsDefined: Boolean;
|
|
begin
|
|
Result:=false;
|
|
if (not (LFMNode is TLFMPropertyNode)) then exit;
|
|
PropertyNode:=TLFMPropertyNode(LFMNode);
|
|
if (PropertyNode.Parent=nil)
|
|
or (not (PropertyNode.Parent is TLFMObjectNode)) then exit;
|
|
ObjectNode:=TLFMObjectNode(PropertyNode.Parent);
|
|
// find define property
|
|
IsDefined:=false;
|
|
if Assigned(OnFindDefineProperty) then begin
|
|
AncestorClassContext:=CleanFindContext;
|
|
if ClassContext.Tool=Self then begin
|
|
// the class is defined in this source
|
|
// -> try to find the ancestor class
|
|
if ObjectNode.AncestorContextValid then begin
|
|
AncestorClassContext:=CreateFindContext(
|
|
TFindDeclarationTool(ObjectNode.AncestorTool),
|
|
TCodeTreeNode(ObjectNode.AncestorNode));
|
|
end else begin
|
|
{$IFDEF VerboseCheckLFM}
|
|
debugln('FindNonPublishedDefineProperty Class is defined in this source: search ancestor ... ');
|
|
{$ENDIF}
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
|
|
fdfExceptionOnPredefinedIdent];
|
|
Params.ContextNode:=ClassContext.Node;
|
|
try
|
|
if ClassContext.Tool.FindAncestorOfClass(ClassContext.Node,
|
|
Params,true) then
|
|
begin
|
|
{$IFDEF VerboseCheckLFM}
|
|
debugln('FindNonPublishedDefineProperty Ancestor found');
|
|
{$ENDIF}
|
|
AncestorClassContext:=CreateFindContext(Params);
|
|
ObjectNode.AncestorTool:=AncestorClassContext.Tool;
|
|
ObjectNode.AncestorNode:=AncestorClassContext.Node;
|
|
end;
|
|
except
|
|
// ignore search/parse errors
|
|
on E: ECodeToolError do ;
|
|
end;
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
ObjectNode.AncestorContextValid:=true;
|
|
end;
|
|
end;
|
|
OnFindDefineProperty(Self,ClassContext,AncestorClassContext,LFMNode,
|
|
IdentName,IsDefined);
|
|
if IsDefined then begin
|
|
//debugln('FindNonPublishedDefineProperty Path=',LFMNode.GetPath,' IdentName="',IdentName,'"');
|
|
end else begin
|
|
{$IFDEF VerboseCheckLFM}
|
|
debugln('FindNonPublishedDefineProperty Path=',LFMNode.GetPath,' NO DEFINE PROPERTIES');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
Result:=IsDefined;
|
|
end;
|
|
|
|
function FindLFMIdentifier(LFMNode: TLFMTreeNode;
|
|
DefaultErrorPosition: integer;
|
|
const IdentName: string; const ClassContext: TFindContext;
|
|
SearchAlsoInDefineProperties, ErrorOnNotFound: boolean;
|
|
out IdentContext: TFindContext): boolean;
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
IdentifierNotPublished: Boolean;
|
|
IsPublished: Boolean;
|
|
begin
|
|
Result:=false;
|
|
IdentContext:=CleanFindContext;
|
|
IsPublished:=false;
|
|
if (ClassContext.Node=nil)
|
|
or (not (ClassContext.Node.Desc in AllClasses)) then begin
|
|
DebugLn('TStandardCodeTool.CheckLFM.FindLFMIdentifier Internal error');
|
|
exit;
|
|
end;
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
|
|
fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams,
|
|
fdfIgnoreOverloadedProcs];
|
|
Params.ContextNode:=ClassContext.Node;
|
|
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
|
try
|
|
{DebugLn('FindLFMIdentifier A ',
|
|
' Ident=',
|
|
'"'+GetIdentifier(Params.Identifier)+'"',
|
|
' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
|
|
' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
|
|
' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
|
|
);}
|
|
if ClassContext.Tool.FindIdentifierInContext(Params) then begin
|
|
Result:=true;
|
|
repeat
|
|
IdentContext:=CreateFindContext(Params);
|
|
if (not IsPublished)
|
|
and (IdentContext.Node.HasParentOfType(ctnClassPublished)) then
|
|
IsPublished:=true;
|
|
|
|
if (IdentContext.Node<>nil)
|
|
and (IdentContext.Node.Desc=ctnProperty)
|
|
and (IdentContext.Tool.PropNodeIsTypeLess(IdentContext.Node)) then
|
|
begin
|
|
// this is a typeless property -> search further
|
|
Params.Clear;
|
|
Params.Flags:=[fdfSearchInAncestors,
|
|
fdfIgnoreMissingParams,
|
|
fdfIgnoreCurContextNode,
|
|
fdfIgnoreOverloadedProcs];
|
|
Params.ContextNode:=IdentContext.Node.Parent;
|
|
while (Params.ContextNode<>nil)
|
|
and (not (Params.ContextNode.Desc in AllClasses)) do
|
|
Params.ContextNode:=Params.ContextNode.Parent;
|
|
if Params.ContextNode<>nil then begin
|
|
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
|
if not IdentContext.Tool.FindIdentifierInContext(Params) then
|
|
begin
|
|
DebugLn(['FindLFMIdentifier ERROR ancestor of property not found: ',FindContextToString(IdentContext),' IdentName=',IdentName]);
|
|
break;
|
|
end;
|
|
end;
|
|
end else
|
|
break;
|
|
until false;
|
|
end;
|
|
except
|
|
// ignore search/parse errors
|
|
on E: ECodeToolError do ;
|
|
end;
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
|
|
IdentifierNotPublished:=not IsPublished;
|
|
|
|
if (IdentContext.Node=nil) or IdentifierNotPublished then begin
|
|
// no proper node found
|
|
// -> search in DefineProperties
|
|
if SearchAlsoInDefineProperties then begin
|
|
//debugln('FindLFMIdentifier A SearchAlsoInDefineProperties=',dbgs(SearchAlsoInDefineProperties));
|
|
if FindNonPublishedDefineProperty(LFMNode,DefaultErrorPosition,
|
|
IdentName,ClassContext)
|
|
then begin
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
if (not Result) and ErrorOnNotFound then begin
|
|
if (IdentContext.Node<>nil) and IdentifierNotPublished then begin
|
|
LFMTree.AddError(lfmeIdentifierNotPublished,LFMNode,
|
|
'identifier '+IdentName+' is not published in class '
|
|
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false)+'"',
|
|
DefaultErrorPosition);
|
|
end else begin
|
|
LFMTree.AddError(lfmeIdentifierNotFound,LFMNode,
|
|
'identifier '+IdentName+' not found in class '
|
|
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false)+'"',
|
|
DefaultErrorPosition);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function FindClassNodeForLFMObject(LFMNode: TLFMTreeNode;
|
|
DefaultErrorPosition: integer;
|
|
StartTool: TFindDeclarationTool; DefinitionNode: TCodeTreeNode): TFindContext;
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
Identifier: PChar;
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
Result:=CleanFindContext;
|
|
if (DefinitionNode.Desc=ctnIdentifier) then
|
|
Identifier:=@StartTool.Src[DefinitionNode.StartPos]
|
|
else if DefinitionNode.Desc=ctnProperty then
|
|
Identifier:=StartTool.GetPropertyTypeIdentifier(DefinitionNode)
|
|
else
|
|
Identifier:=nil;
|
|
if Identifier=nil then exit;
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
|
|
fdfSearchInParentNodes,
|
|
fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams,
|
|
fdfIgnoreOverloadedProcs];
|
|
Params.ContextNode:=DefinitionNode;
|
|
Params.SetIdentifier(StartTool,Identifier,nil);
|
|
try
|
|
Params.Save(OldInput);
|
|
if StartTool.FindIdentifierInContext(Params) then begin
|
|
Params.Load(OldInput,true);
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
if (Result.Node=nil)
|
|
or (not (Result.Node.Desc in AllClasses)) then
|
|
Result:=CleanFindContext;
|
|
end;
|
|
except
|
|
// ignore search/parse errors
|
|
on E: ECodeToolError do ;
|
|
end;
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
if Result.Node=nil then begin
|
|
// FindClassNodeForLFMObject
|
|
LFMTree.AddError(lfmeIdentifierNotFound,LFMNode,
|
|
'class '+GetIdentifier(Identifier)+' not found',
|
|
DefaultErrorPosition);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function CreateFootNote(const Context: TFindContext): string;
|
|
var
|
|
Caret: TCodeXYPosition;
|
|
begin
|
|
Result:=' see '+Context.Tool.MainFilename;
|
|
if Context.Tool.CleanPosToCaret(Context.Node.StartPos,Caret) then
|
|
Result:=Result+'('+IntToStr(Caret.Y)+','+IntToStr(Caret.X)+')';
|
|
end;
|
|
|
|
function FindClassContext(const ClassName: string): TFindContext;
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
Identifier: PChar;
|
|
OldInput: TFindDeclarationInput;
|
|
StartTool: TStandardCodeTool;
|
|
begin
|
|
Result:=CleanFindContext;
|
|
Params:=TFindDeclarationParams.Create;
|
|
StartTool:=Self;
|
|
Identifier:=PChar(Pointer(ClassName));
|
|
try
|
|
Params.Flags:=[fdfExceptionOnNotFound,
|
|
fdfSearchInParentNodes,
|
|
fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams,
|
|
fdfIgnoreOverloadedProcs];
|
|
Params.ContextNode:=FindInterfaceNode;
|
|
if Params.ContextNode=nil then
|
|
Params.ContextNode:=FindMainUsesSection;
|
|
Params.SetIdentifier(StartTool,Identifier,nil);
|
|
try
|
|
Params.Save(OldInput);
|
|
if FindIdentifierInContext(Params) then begin
|
|
Params.Load(OldInput,true);
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
if (Result.Node=nil)
|
|
or (not (Result.Node.Desc in AllClasses)) then
|
|
Result:=CleanFindContext;
|
|
end;
|
|
except
|
|
// ignore search/parse errors
|
|
on E: ECodeToolError do ;
|
|
end;
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckLFMChildObject(LFMObject: TLFMObjectNode;
|
|
const ParentContext: TFindContext;
|
|
SearchAlsoInDefineProperties, ContextIsDefault: boolean);
|
|
var
|
|
LFMObjectName: String;
|
|
ChildContext: TFindContext;
|
|
VariableTypeName: String;
|
|
DefinitionNode: TCodeTreeNode;
|
|
ClassContext: TFindContext;
|
|
IdentifierFound: Boolean;
|
|
begin
|
|
// find variable for object
|
|
|
|
// find identifier in Lookup Root
|
|
LFMObjectName:=LFMObject.Name;
|
|
//DebugLn('CheckChildObject A LFMObjectName="',LFMObjectName,'"');
|
|
if LFMObjectName='' then begin
|
|
LFMTree.AddError(lfmeObjectNameMissing,LFMObject,'missing object name',
|
|
LFMObject.StartPos);
|
|
exit;
|
|
end;
|
|
|
|
IdentifierFound:=(not ContextIsDefault) and
|
|
FindLFMIdentifier(LFMObject,LFMObject.NamePosition,
|
|
LFMObjectName,RootContext,SearchAlsoInDefineProperties,ObjectsMustExist,
|
|
ChildContext);
|
|
|
|
if IdentifierFound and (ObjectsMustExist or (ChildContext.Node<>nil)) then
|
|
begin
|
|
if ChildContext.Node=nil then begin
|
|
// this is an extra entry, created via DefineProperties.
|
|
// There is no generic way to test such things
|
|
exit;
|
|
end;
|
|
|
|
// check if identifier is a variable or property
|
|
VariableTypeName:='';
|
|
if (ChildContext.Node.Desc=ctnVarDefinition) then begin
|
|
DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(
|
|
ChildContext.Node);
|
|
if DefinitionNode=nil then begin
|
|
ChildContext.Node:=DefinitionNode;
|
|
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
|
LFMObjectName+' is not a variable.'
|
|
+CreateFootNote(ChildContext),
|
|
LFMObject.NamePosition);
|
|
exit;
|
|
end;
|
|
|
|
VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
|
|
ChildContext.Node);
|
|
end else if (ChildContext.Node.Desc=ctnProperty) then begin
|
|
DefinitionNode:=ChildContext.Node;
|
|
VariableTypeName:=
|
|
ChildContext.Tool.ExtractPropType(ChildContext.Node,false,false);
|
|
end else begin
|
|
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
|
LFMObjectName+' is not a variable'
|
|
+CreateFootNote(ChildContext),
|
|
LFMObject.NamePosition);
|
|
exit;
|
|
end;
|
|
|
|
// check if variable/property has a compatible type
|
|
if (VariableTypeName<>'') then begin
|
|
if (LFMObject.TypeName<>'')
|
|
and (CompareIdentifiers(PChar(VariableTypeName),
|
|
PChar(LFMObject.TypeName))<>0)
|
|
then begin
|
|
ChildContext.Node:=DefinitionNode;
|
|
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
|
VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
|
|
+CreateFootNote(ChildContext),
|
|
LFMObject.NamePosition);
|
|
exit;
|
|
end;
|
|
|
|
// ToDo: check if variable/property type exists
|
|
|
|
end;
|
|
|
|
|
|
// find class node
|
|
ClassContext:=FindClassNodeForLFMObject(LFMObject,LFMObject.TypeNamePosition,
|
|
ChildContext.Tool,DefinitionNode);
|
|
end else begin
|
|
// try the object type
|
|
ClassContext:=FindClassContext(LFMObject.TypeName);
|
|
if ClassContext.Node=nil then begin
|
|
// object type not found
|
|
LFMTree.AddError(lfmeIdentifierNotFound,LFMObject,
|
|
'type '+LFMObject.TypeName+' not found',
|
|
LFMObject.TypeNamePosition);
|
|
end;
|
|
end;
|
|
// check child LFM nodes
|
|
if ClassContext.Node<>nil then
|
|
CheckLFMObjectValues(LFMObject,ClassContext,false)
|
|
else
|
|
CheckLFMObjectValues(LFMObject,ParentContext,true);
|
|
end;
|
|
|
|
function FindClassNodeForPropertyType(LFMProperty: TLFMPropertyNode;
|
|
DefaultErrorPosition: integer; const PropertyContext: TFindContext
|
|
): TFindContext;
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
begin
|
|
Result:=CleanFindContext;
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
|
|
fdfSearchInParentNodes,
|
|
fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams,
|
|
fdfIgnoreOverloadedProcs];
|
|
Params.ContextNode:=PropertyContext.Node;
|
|
Params.SetIdentifier(PropertyContext.Tool,nil,nil);
|
|
try
|
|
Result:=PropertyContext.Tool.FindBaseTypeOfNode(Params,
|
|
PropertyContext.Node);
|
|
except
|
|
// ignore search/parse errors
|
|
on E: ECodeToolError do ;
|
|
end;
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
if Result.Node=nil then begin
|
|
LFMTree.AddError(lfmePropertyHasNoSubProperties,LFMProperty,
|
|
'property has no sub properties',
|
|
DefaultErrorPosition);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckLFMProperty(LFMProperty: TLFMPropertyNode;
|
|
const ParentContext: TFindContext);
|
|
// checks properties. For example lines like 'OnShow = FormShow'
|
|
// or 'VertScrollBar.Range = 29'
|
|
// LFMProperty is the property node
|
|
// ParentContext is the context, where properties are searched.
|
|
// This can be a class or a property.
|
|
var
|
|
i: Integer;
|
|
CurName: string;
|
|
CurPropertyContext: TFindContext;
|
|
SearchContext: TFindContext;
|
|
begin
|
|
// find complete property name
|
|
//DebugLn('CheckLFMProperty A LFMProperty Name="',LFMProperty.CompleteName,'" ParentContext=',FindContextToString(ParentContext));
|
|
|
|
if LFMProperty.CompleteName='' then begin
|
|
LFMTree.AddError(lfmePropertyNameMissing,LFMProperty,
|
|
'property without name',LFMProperty.StartPos);
|
|
exit;
|
|
end;
|
|
|
|
// find every part of the property name
|
|
SearchContext:=ParentContext;
|
|
for i:=0 to LFMProperty.NameParts.Count-1 do begin
|
|
if SearchContext.Node.Desc=ctnProperty then begin
|
|
// get the type of the property and search the class node
|
|
SearchContext:=FindClassNodeForPropertyType(LFMProperty,
|
|
LFMProperty.NameParts.NamePositions[i],SearchContext);
|
|
if SearchContext.Node=nil then exit;
|
|
end;
|
|
|
|
CurName:=LFMProperty.NameParts.Names[i];
|
|
if not FindLFMIdentifier(LFMProperty,
|
|
LFMProperty.NameParts.NamePositions[i],
|
|
CurName,SearchContext,true,true,
|
|
CurPropertyContext)
|
|
then
|
|
break;
|
|
if CurPropertyContext.Node=nil then begin
|
|
// this is an extra entry, created via DefineProperties.
|
|
// There is no generic way to test such things
|
|
break;
|
|
end;
|
|
SearchContext:=CurPropertyContext;
|
|
end;
|
|
// ToDo: check value
|
|
end;
|
|
|
|
function CheckLFMObjectValues(LFMObject: TLFMObjectNode;
|
|
const ClassContext: TFindContext; ContextIsDefault: boolean): boolean;
|
|
var
|
|
CurLFMNode: TLFMTreeNode;
|
|
begin
|
|
//DebugLn('TStandardCodeTool.CheckLFM.CheckLFMObjectValues A ',LFMObject.Name,':',LFMObject.TypeName);
|
|
CurLFMNode:=LFMObject.FirstChild;
|
|
while CurLFMNode<>nil do begin
|
|
//DebugLn('TStandardCodeTool.CheckLFM.CheckLFMObjectValues B ',CurLFMNode.ClassName);
|
|
case CurLFMNode.TheType of
|
|
|
|
lfmnObject:
|
|
CheckLFMChildObject(TLFMObjectNode(CurLFMNode),ClassContext,false,
|
|
ContextIsDefault);
|
|
|
|
lfmnProperty:
|
|
if not ContextIsDefault then
|
|
CheckLFMProperty(TLFMPropertyNode(CurLFMNode),ClassContext);
|
|
|
|
end;
|
|
CurLFMNode:=CurLFMNode.NextSibling;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function CheckLFMRoot(RootLFMNode: TLFMTreeNode): boolean;
|
|
var
|
|
LookupRootLFMNode: TLFMObjectNode;
|
|
LookupRootTypeName: String;
|
|
RootClassNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
|
|
//DebugLn('TStandardCodeTool.CheckLFM.CheckLFMRoot checking root ...');
|
|
// get root object node
|
|
if (RootLFMNode=nil) or (not (RootLFMNode is TLFMObjectNode)) then begin
|
|
LFMTree.AddError(lfmeMissingRoot,nil,'missing root object',1);
|
|
exit;
|
|
end;
|
|
LookupRootLFMNode:=TLFMObjectNode(RootLFMNode);
|
|
|
|
// get type name of root object
|
|
LookupRootTypeName:=UpperCaseStr(LookupRootLFMNode.TypeName);
|
|
if LookupRootTypeName='' then begin
|
|
LFMTree.AddError(lfmeMissingRoot,nil,'missing type of root object',1);
|
|
exit;
|
|
end;
|
|
|
|
// find root type
|
|
if RootMustBeClassInIntf then begin
|
|
RootClassNode:=FindClassNodeInInterface(LookupRootTypeName,true,false,false);
|
|
RootContext:=CleanFindContext;
|
|
RootContext.Node:=RootClassNode;
|
|
RootContext.Tool:=Self;
|
|
end else begin
|
|
RootContext:=FindClassContext(LookupRootTypeName);
|
|
RootClassNode:=RootContext.Node;
|
|
end;
|
|
if RootClassNode=nil then begin
|
|
LFMTree.AddError(lfmeMissingRoot,LookupRootLFMNode,
|
|
'type '+LookupRootLFMNode.TypeName+' not found',
|
|
LookupRootLFMNode.TypeNamePosition);
|
|
exit;
|
|
end;
|
|
Result:=CheckLFMObjectValues(LookupRootLFMNode,RootContext,false);
|
|
end;
|
|
|
|
var
|
|
CurRootLFMNode: TLFMTreeNode;
|
|
begin
|
|
Result:=false;
|
|
//DebugLn('TStandardCodeTool.CheckLFM A');
|
|
// create tree from LFM file
|
|
LFMTree:=DefaultLFMTrees.GetLFMTree(LFMBuf,true);
|
|
ActivateGlobalWriteLock;
|
|
try
|
|
//DebugLn('TStandardCodeTool.CheckLFM parsing LFM ...');
|
|
if not LFMTree.ParseIfNeeded then exit;
|
|
// parse unit and find LookupRoot
|
|
//DebugLn('TStandardCodeTool.CheckLFM parsing unit ...');
|
|
BuildTree(true);
|
|
// find every identifier
|
|
//DebugLn('TStandardCodeTool.CheckLFM checking identifiers ...');
|
|
CurRootLFMNode:=LFMTree.Root;
|
|
while CurRootLFMNode<>nil do begin
|
|
if not CheckLFMRoot(CurRootLFMNode) then exit;
|
|
CurRootLFMNode:=CurRootLFMNode.NextSibling;
|
|
end;
|
|
finally
|
|
DeactivateGlobalWriteLock;
|
|
end;
|
|
|
|
Result:=LFMTree.FirstError=nil;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindCreateFormStatement(StartPos: integer;
|
|
const UpperClassName, UpperVarName: string;
|
|
out Position: TAtomPosition): integer;
|
|
// 0=found, -1=not found, 1=found, but wrong classname
|
|
var MainBeginNode: TCodeTreeNode;
|
|
ClassNameFits: boolean;
|
|
begin
|
|
Result:=-1;
|
|
Position.StartPos:=-1;
|
|
if (UpperClassName='') or (UpperVarName='') or (length(UpperClassName)>255)
|
|
or (length(UpperVarName)>255) then exit;
|
|
if StartPos<1 then begin
|
|
BuildTree(false);
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
StartPos:=MainBeginNode.StartPos;
|
|
if StartPos<1 then exit;
|
|
end;
|
|
MoveCursorToCleanPos(StartPos);
|
|
repeat
|
|
ReadNextAtom;
|
|
if UpAtomIs('APPLICATION') then begin
|
|
Position.StartPos:=CurPos.StartPos;
|
|
if ReadNextAtomIsChar('.') and ReadNextUpAtomIs('CREATEFORM')
|
|
and ReadNextAtomIsChar('(') then begin
|
|
ReadNextAtom;
|
|
ClassNameFits:=UpAtomIs(UpperClassName);
|
|
if ReadNextAtomIsChar(',')
|
|
and (ReadNextUpAtomIs(UpperVarName) or (UpperVarName='*')) then begin
|
|
if ReadNextAtomIsChar(')') then ReadNextAtomIsChar(';');
|
|
Position.EndPos:=CurPos.EndPos;
|
|
if ClassNameFits then
|
|
Result:=0
|
|
else
|
|
Result:=1;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
until (CurPos.StartPos>SrcLen);
|
|
Result:=-1;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddCreateFormStatement(const AClassName,
|
|
AVarName: string; SourceChangeCache: TSourceChangeCache): boolean;
|
|
var MainBeginNode: TCodeTreeNode;
|
|
OldPosition: TAtomPosition;
|
|
FromPos, ToPos, Indent: integer;
|
|
begin
|
|
Result:=false;
|
|
if (AClassName='') or (length(AClassName)>255) or (AVarName='')
|
|
or (length(AVarName)>255) then exit;
|
|
BuildTree(false);
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
FromPos:=-1;
|
|
if FindCreateFormStatement(MainBeginNode.StartPos,UpperCaseStr(AClassName),
|
|
UpperCaseStr(AVarName),OldPosition)=-1
|
|
then begin
|
|
// does not exist -> create as last in front of 'Application.Run'
|
|
MoveCursorToCleanPos(MainBeginNode.StartPos);
|
|
repeat
|
|
if ReadNextUpAtomIs('APPLICATION') then begin
|
|
FromPos:=CurPos.StartPos;
|
|
if ReadNextAtomIsChar('.') and ReadNextUpAtomIs('RUN') then begin
|
|
break;
|
|
end;
|
|
FromPos:=-1;
|
|
end;
|
|
until (CurPos.StartPos>SrcLen);
|
|
if FromPos<1 then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
Indent:=GetLineIndent(Src,FromPos);
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(FromPos);
|
|
SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,FromPos,
|
|
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
'Application.CreateForm('+AClassName+','+AVarName+');',Indent));
|
|
end else begin
|
|
// it exists -> replace it
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(OldPosition.StartPos);
|
|
ToPos:=FindLineEndOrCodeAfterPosition(OldPosition.EndPos);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,ToPos,
|
|
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
'Application.CreateForm('+AClassName+','+AVarName+');',
|
|
SourceChangeCache.BeautifyCodeOptions.Indent));
|
|
end;
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveCreateFormStatement(const UpperVarName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var Position: TAtomPosition;
|
|
FromPos, ToPos: integer;
|
|
begin
|
|
Result:=false;
|
|
if FindCreateFormStatement(-1,'*',UpperVarName,Position)=-1 then
|
|
exit;
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(Position.StartPos);
|
|
ToPos:=FindLineEndOrCodeAfterPosition(Position.EndPos);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.ChangeCreateFormStatement(StartPos: integer;
|
|
const OldClassName, OldVarName: string;
|
|
const NewClassName, NewVarName: string;
|
|
OnlyIfExists: boolean; SourceChangeCache: TSourceChangeCache): boolean;
|
|
var MainBeginNode: TCodeTreeNode;
|
|
OldPosition: TAtomPosition;
|
|
FromPos, ToPos: integer;
|
|
begin
|
|
Result:=false;
|
|
if (OldClassName='') or (length(OldClassName)>255)
|
|
or (OldVarName='') or (length(OldVarName)>255)
|
|
or (NewClassName='') or (length(NewClassName)>255)
|
|
or (NewVarName='') or (length(NewVarName)>255)
|
|
then exit;
|
|
BuildTree(false);
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
FromPos:=-1;
|
|
if FindCreateFormStatement(MainBeginNode.StartPos,UpperCaseStr(OldClassName),
|
|
UpperCaseStr(OldVarName),OldPosition)=-1 then begin
|
|
// does not exist
|
|
if OnlyIfExists then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
Result:=AddCreateFormStatement(NewClassName,NewVarName,SourceChangeCache);
|
|
end else begin
|
|
// replace
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(OldPosition.StartPos);
|
|
ToPos:=FindLineEndOrCodeAfterPosition(OldPosition.EndPos);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,ToPos,
|
|
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
'Application.CreateForm('+NewClassName+','+NewVarName+');',
|
|
SourceChangeCache.BeautifyCodeOptions.Indent));
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.ListAllCreateFormStatements: TStrings;
|
|
// list format: VarName:ClassName
|
|
var Position: integer;
|
|
StatementPos: TAtomPosition;
|
|
s:string;
|
|
var MainBeginNode: TCodeTreeNode;
|
|
begin
|
|
BuildTree(false);
|
|
Result:=TStringList.Create;
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
Position:=MainBeginNode.StartPos;
|
|
repeat
|
|
if FindCreateFormStatement(Position,'*','*',StatementPos)=-1 then
|
|
exit;
|
|
Position:=StatementPos.EndPos;
|
|
MoveCursorToCleanPos(StatementPos.StartPos);
|
|
ReadNextAtom; // read 'Application'
|
|
ReadNextAtom; // read '.'
|
|
ReadNextAtom; // read 'CreateForm'
|
|
ReadNextAtom; // read '('
|
|
ReadNextAtom; // read class name
|
|
s:=GetAtom;
|
|
ReadNextAtom; // read ','
|
|
ReadNextAtom; // read variable name
|
|
s:=GetAtom+':'+s;
|
|
Result.Add(s);
|
|
until false;
|
|
end;
|
|
|
|
function TStandardCodeTool.SetAllCreateFromStatements(List: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
{ every string in the list has the format VarName:ClassName
|
|
or simply VarName In the latter case it will be automatically expanded
|
|
to VarName:TVarName
|
|
}
|
|
var Position, InsertPos, i, ColonPos, Indent: integer;
|
|
StatementPos: TAtomPosition;
|
|
MainBeginNode: TCodeTreeNode;
|
|
AClassName, AVarName: string;
|
|
LastEndPos: Integer;
|
|
begin
|
|
Result:= false;
|
|
if (List = nil) or (SourceChangeCache = nil) then exit;
|
|
BuildTree(false);
|
|
|
|
{ first delete all CreateForm Statements }
|
|
SourceChangeCache.MainScanner:= Scanner;
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode = nil then exit;
|
|
Position:=MainBeginNode.StartPos;
|
|
InsertPos:=-1;
|
|
LastEndPos:=-1;
|
|
repeat
|
|
if FindCreateFormStatement(Position, '*', '*', StatementPos) = -1 then break;
|
|
|
|
Position:=StatementPos.EndPos;
|
|
StatementPos.StartPos:=FindLineEndOrCodeInFrontOfPosition(StatementPos.StartPos);
|
|
if (LastEndPos>0) and (StatementPos.StartPos<LastEndPos) then
|
|
StatementPos.StartPos:=LastEndPos;
|
|
if InsertPos < 1 then InsertPos:= StatementPos.StartPos;
|
|
|
|
StatementPos.EndPos:=FindLineEndOrCodeAfterPosition(StatementPos.EndPos);
|
|
LastEndPos:=StatementPos.EndPos;
|
|
|
|
if not SourceChangeCache.Replace(gtNone,gtNone, StatementPos.StartPos, StatementPos.EndPos, '') then
|
|
exit;
|
|
until false;
|
|
|
|
Result:=SourceChangeCache.Apply;
|
|
if not Result then exit;
|
|
|
|
{ then add all CreateForm Statements }
|
|
if InsertPos < 1 then begin
|
|
|
|
{ there was no createform statement -> insert in front of Application.Run }
|
|
MoveCursorToCleanPos(MainBeginNode.StartPos);
|
|
repeat
|
|
if ReadNextUpAtomIs('APPLICATION') then begin
|
|
InsertPos:=CurPos.StartPos;
|
|
if ReadNextAtomIsChar('.') and ReadNextUpAtomIs('RUN') then begin
|
|
InsertPos:=FindLineEndOrCodeInFrontOfPosition(InsertPos);
|
|
break;
|
|
end;
|
|
InsertPos:=-1;
|
|
end;
|
|
until (CurPos.StartPos>SrcLen);
|
|
if InsertPos < 1 then exit;
|
|
end;
|
|
|
|
for i:= 0 to List.Count - 1 do begin
|
|
if Length(List[i]) <= 1 then continue;
|
|
|
|
ColonPos:= Pos(List[i], ':');
|
|
if (ColonPos > 1) then begin
|
|
AVarName:= Copy(List[i], 1, ColonPos);
|
|
AClassName:= Copy(List[i], ColonPos + 1, Length(List[i]) - ColonPos);
|
|
end else begin
|
|
AVarName:= List[i];
|
|
AClassName:= 'T' + AVarName;
|
|
end;
|
|
Indent:= GetLineIndent(Src, InsertPos);
|
|
|
|
SourceChangeCache.Replace(gtNewLine, gtNewLine, InsertPos, InsertPos,
|
|
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
'Application.CreateForm('+AClassName+','+AVarName+');', Indent));
|
|
end;
|
|
Result:= Result and SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindApplicationTitleStatement(out StartPos,
|
|
StringConstStartPos, EndPos: integer): boolean;
|
|
var
|
|
MainBeginNode: TCodeTreeNode;
|
|
Position: Integer;
|
|
begin
|
|
Result:=false;
|
|
StartPos:=-1;
|
|
StringConstStartPos:=-1;
|
|
EndPos:=-1;
|
|
BuildTree(false);
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
Position:=MainBeginNode.StartPos;
|
|
if Position<1 then exit;
|
|
MoveCursorToCleanPos(Position);
|
|
repeat
|
|
ReadNextAtom;
|
|
if UpAtomIs('APPLICATION') then begin
|
|
StartPos:=CurPos.StartPos;
|
|
if ReadNextAtomIsChar('.') and ReadNextUpAtomIs('TITLE')
|
|
and ReadNextUpAtomIs(':=') then begin
|
|
// read till semicolon or end
|
|
repeat
|
|
ReadNextAtom;
|
|
if StringConstStartPos<1 then
|
|
StringConstStartPos:=CurPos.StartPos;
|
|
EndPos:=CurPos.EndPos;
|
|
if CurPos.Flag in [cafEnd,cafSemicolon] then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
until CurPos.StartPos>SrcLen;
|
|
end;
|
|
end;
|
|
until (CurPos.StartPos>SrcLen);
|
|
end;
|
|
|
|
function TStandardCodeTool.GetApplicationTitleStatement(StringConstStartPos,
|
|
EndPos: integer; var Title: string): boolean;
|
|
var
|
|
FormatStringParams: string;
|
|
begin
|
|
Result:=false;
|
|
Title:='';
|
|
if (StringConstStartPos<1) or (StringConstStartPos>SrcLen) then exit;
|
|
MoveCursorToCleanPos(StringConstStartPos);
|
|
ReadNextAtom;
|
|
if not AtomIsStringConstant then exit;
|
|
Result:=GetStringConstAsFormatString(StringConstStartPos,EndPos,Title,
|
|
FormatStringParams);
|
|
if FormatStringParams='' then ;
|
|
end;
|
|
|
|
function TStandardCodeTool.SetApplicationTitleStatement(const NewTitle: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
StartPos, StringConstStartPos, EndPos: integer;
|
|
OldExists: Boolean;
|
|
NewStatement: String;
|
|
Indent: Integer;
|
|
MainBeginNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
// search old Application.Title:= statement
|
|
OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
|
|
if StringConstStartPos=0 then ;
|
|
if OldExists then begin
|
|
// replace old statement
|
|
Indent:=0;
|
|
Indent:=GetLineIndent(Src,StartPos)
|
|
end else begin
|
|
// insert as first line in program begin..end block
|
|
MainBeginNode:=FindMainBeginEndNode;
|
|
if MainBeginNode=nil then exit;
|
|
MoveCursorToNodeStart(MainBeginNode);
|
|
ReadNextAtom;
|
|
StartPos:=CurPos.EndPos;
|
|
EndPos:=StartPos;
|
|
Indent:=GetLineIndent(Src,StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
end;
|
|
// create statement
|
|
NewStatement:='Application.Title:='+StringToPascalConst(NewTitle)+';';
|
|
NewStatement:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
NewStatement,Indent);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,StartPos,EndPos,
|
|
NewStatement)
|
|
then
|
|
exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveApplicationTitleStatement(
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
StartPos, StringConstStartPos, EndPos: integer;
|
|
OldExists: Boolean;
|
|
FromPos: Integer;
|
|
ToPos: Integer;
|
|
begin
|
|
Result:=false;
|
|
// search old Application.Title:= statement
|
|
OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
|
|
if not OldExists then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
if StringConstStartPos=0 then ;
|
|
// -> delete whole line
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);
|
|
ToPos:=FindLineEndOrCodeAfterPosition(EndPos);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RenameForm(const OldFormName,
|
|
OldFormClassName: string; const NewFormName, NewFormClassName: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
IdentList: TStringList;
|
|
begin
|
|
Result:=false;
|
|
if (OldFormName='') or (OldFormClassName='')
|
|
or (NewFormName='') or (NewFormClassName='')
|
|
or (SourceChangeCache=nil) then exit;
|
|
if (OldFormName=NewFormName)
|
|
and (OldFormClassName=NewFormClassName) then exit;
|
|
IdentList:=TStringList.Create;
|
|
try
|
|
if (OldFormName<>NewFormName) then begin
|
|
IdentList.Add(OldFormName);
|
|
IdentList.Add(NewFormName);
|
|
end;
|
|
if (OldFormClassName<>NewFormClassName) then begin
|
|
IdentList.Add(OldFormClassName);
|
|
IdentList.Add(NewFormClassName);
|
|
end;
|
|
Result:=ReplaceWords(IdentList,false,SourceChangeCache);
|
|
finally
|
|
IdentList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindFormAncestor(const UpperClassName: string;
|
|
var AncestorClassName: string): boolean;
|
|
var
|
|
ClassNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
AncestorClassName:='';
|
|
if UpperClassName='' then exit;
|
|
BuildTree(true);
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
|
|
if (ClassNode=nil) then exit;
|
|
// search the ancestor name
|
|
MoveCursorToNodeStart(ClassNode);
|
|
ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
|
|
while UpAtomIs('SEALED') or UpAtomIs('ABSTRACT') do ReadNextAtom;
|
|
if UpAtomIs('PACKED') or UpAtomIs('BITPACKED') then ReadNextAtom;
|
|
ReadNextAtom;
|
|
if AtomIsChar('(') then begin
|
|
ReadNextAtom;
|
|
if AtomIsIdentifier(false) then
|
|
AncestorClassName:=GetAtom;
|
|
end;
|
|
if AncestorClassName='' then
|
|
AncestorClassName:='TObject';
|
|
Result:=true;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
function TStandardCodeTool.ReplaceWords(IdentList: TStrings;
|
|
ChangeStrings: boolean; SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
Search in all used sources (not only the cleaned source) for identifiers.
|
|
It will find all identifiers, except identifiers in compiler directives.
|
|
This includes identifiers in string constants and comments.
|
|
|
|
ChangeStrings = true, means to replace in string constants too
|
|
-------------------------------------------------------------------------------}
|
|
function TStandardCodeTool.ReplaceWords(IdentList: TStrings;
|
|
ChangeStrings: boolean; SourceChangeCache: TSourceChangeCache;
|
|
SkipPointWords: boolean): boolean;
|
|
|
|
function CheckIdentifier(const CurSource: string;
|
|
IdentStart: integer): boolean;
|
|
var
|
|
p: integer;
|
|
begin
|
|
if not SkipPointWords then exit(true);
|
|
p:=IdentStart-1;
|
|
while (p>0) and (IsSpaceChar[CurSource[p]]) do dec(p);
|
|
Result:=(p<1) or (CurSource[p]<>'.');
|
|
end;
|
|
|
|
procedure ReplaceWordsInSource(ACode: TCodeBuffer);
|
|
var
|
|
StartPos, EndPos, MaxPos, IdentStart, IdentEnd: integer;
|
|
CurSource: string;
|
|
i: integer;
|
|
begin
|
|
CurSource:=ACode.Source;
|
|
MaxPos:=length(CurSource);
|
|
StartPos:=1;
|
|
// go through all source parts between compiler directives
|
|
//DebugLn('TStandardCodeTool.ReplaceWords ',ACode.Filename);
|
|
repeat
|
|
EndPos:=FindNextCompilerDirective(CurSource,StartPos,
|
|
Scanner.NestedComments);
|
|
if EndPos>MaxPos then EndPos:=MaxPos+1;
|
|
// search all identifiers
|
|
repeat
|
|
if ChangeStrings then
|
|
IdentStart:=FindNextIdentifier(CurSource,StartPos,EndPos-1)
|
|
else
|
|
IdentStart:=FindNextIdentifierSkipStrings(CurSource,StartPos,EndPos-1);
|
|
if IdentStart>=EndPos then
|
|
break;
|
|
i:=0;
|
|
while i<IdentList.Count do begin
|
|
if (IdentList[i]<>'')
|
|
and (BasicCodeTools.CompareIdentifiers(PChar(Pointer(IdentList[i])),
|
|
@CurSource[IdentStart])=0)
|
|
and CheckIdentifier(CurSource,IdentStart)
|
|
and (IdentList[i]<>IdentList[i+1])
|
|
then begin
|
|
// identifier found -> replace
|
|
IdentEnd:=IdentStart+length(IdentList[i]);
|
|
//DebugLn('TStandardCodeTool.ReplaceWords replacing: ',
|
|
//' "',copy(CurSource,IdentStart,IdentEnd-IdentStart),'" -> "',IdentList[i+1],'" at ',IdentStart
|
|
//);
|
|
SourceChangeCache.ReplaceEx(gtNone,gtNone,1,1,
|
|
ACode,IdentStart,IdentEnd,IdentList[i+1]);
|
|
break;
|
|
end;
|
|
inc(i,2);
|
|
end;
|
|
// skip identifier
|
|
StartPos:=IdentStart;
|
|
while (StartPos<MaxPos) and IsIdentChar[CurSource[StartPos]] do
|
|
inc(StartPos);
|
|
until false;
|
|
if EndPos<=MaxPos then begin
|
|
// skip comment
|
|
StartPos:=FindCommentEnd(CurSource,EndPos,Scanner.NestedComments);
|
|
if StartPos>MaxPos then break;
|
|
end else begin
|
|
break;
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
var
|
|
SourceList: TFPList;
|
|
i: integer;
|
|
begin
|
|
Result:=false;
|
|
if (IdentList=nil) or (IdentList.Count=0) or (SourceChangeCache=nil)
|
|
or (Odd(IdentList.Count)) then exit;
|
|
BuildTree(false);
|
|
if Scanner=nil then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
SourceList:=TFPList.Create;
|
|
try
|
|
Scanner.FindCodeInRange(1,SrcLen,SourceList);
|
|
for i:=0 to SourceList.Count-1 do begin
|
|
ReplaceWordsInSource(TCodeBuffer(SourceList[i]));
|
|
end;
|
|
finally
|
|
SourceList.Free;
|
|
end;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindNearestIdentifierNode(
|
|
const CursorPos: TCodeXYPosition; IdentTree: TAVLTree): TAVLTreeNode;
|
|
var
|
|
CleanCursorPos: integer;
|
|
BestDiff: Integer;
|
|
CurIdentNode: TAVLTreeNode;
|
|
CurDiff: Integer;
|
|
begin
|
|
Result:=nil;
|
|
if IdentTree=nil then exit;
|
|
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,[]);
|
|
BestDiff:=SrcLen+1;
|
|
MoveCursorToCleanPos(1);
|
|
repeat
|
|
ReadNextAtom;
|
|
if AtomIsIdentifier(false) then begin
|
|
CurIdentNode:=
|
|
IdentTree.FindKey(@Src[CurPos.StartPos],
|
|
TListSortCompare(@CompareIdentifiers));
|
|
if CurIdentNode<>nil then begin
|
|
CurDiff:=CurPos.StartPos-CleanCursorPos;
|
|
if CurDiff<0 then CurDiff:=-CurDiff;
|
|
if (Result=nil) or (CurDiff<BestDiff) then begin
|
|
BestDiff:=CurDiff;
|
|
Result:=CurIdentNode;
|
|
end;
|
|
end;
|
|
end;
|
|
until CurPos.EndPos>SrcLen;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReplaceWord(const OldWord, NewWord: string;
|
|
ChangeStrings: boolean; SourceChangeCache: TSourceChangeCache;
|
|
SkipPointWords: boolean): boolean;
|
|
var
|
|
IdentList: TStringList;
|
|
begin
|
|
Result:=false;
|
|
if OldWord='' then exit;
|
|
if OldWord=NewWord then exit(true);
|
|
if (SourceChangeCache=nil) then exit;
|
|
IdentList:=TStringList.Create;
|
|
try
|
|
IdentList.Add(OldWord);
|
|
IdentList.Add(NewWord);
|
|
Result:=ReplaceWords(IdentList,ChangeStrings,SourceChangeCache,SkipPointWords);
|
|
finally
|
|
IdentList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.GetStringConstBounds(
|
|
const CursorPos: TCodeXYPosition;
|
|
out StartPos, EndPos: TCodeXYPosition; ResolveComments: boolean): boolean;
|
|
// examples:
|
|
// 's1'+'s2'#13+AFunction(...)+inherited AMethod
|
|
{ $DEFINE VerboseGetStringConstBounds}
|
|
type
|
|
TStrConstTokenType = (scatNone, scatStrConst, scatPlus, scatIdent,
|
|
scatInherited, scatPoint, scatUp,
|
|
scatEdgedBracketOpen, scatEdgedBracketClose,
|
|
scatRoundBracketOpen, scatRoundBracketClose);
|
|
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
const
|
|
StrConstTokenTypeName: array[TStrConstTokenType] of string = (
|
|
'scatNone', 'scatStrConst', 'scatPlus', 'scatIdent',
|
|
'scatInherited', 'scatPoint', 'scatUp',
|
|
'scatEdgedBracketOpen', 'scatEdgedBracketClose',
|
|
'scatRoundBracketOpen', 'scatRoundBracketClose');
|
|
{$ENDIF}
|
|
|
|
function GetCurrentTokenType: TStrConstTokenType;
|
|
begin
|
|
if AtomIsStringConstant then
|
|
Result:=scatStrConst
|
|
else if AtomIsChar('+') then
|
|
Result:=scatPlus
|
|
else if AtomIsIdentifier(false) then
|
|
Result:=scatIdent
|
|
else if UpAtomIs('INHERITED') then
|
|
Result:=scatInherited
|
|
else if CurPos.Flag=cafPoint then
|
|
Result:=scatPoint
|
|
else if AtomIsChar('^') then
|
|
Result:=scatUp
|
|
else if CurPos.Flag=cafRoundBracketOpen then
|
|
Result:=scatRoundBracketOpen
|
|
else if CurPos.Flag=cafRoundBracketClose then
|
|
Result:=scatRoundBracketClose
|
|
else if CurPos.Flag=cafEdgedBracketOpen then
|
|
Result:=scatEdgedBracketOpen
|
|
else if CurPos.Flag=cafEdgedBracketClose then
|
|
Result:=scatEdgedBracketClose
|
|
else
|
|
Result:=scatNone;
|
|
end;
|
|
|
|
var
|
|
CleanCursorPos: integer;
|
|
SameArea: TAtomPosition;
|
|
LastToken, CurrentToken: TStrConstTokenType;
|
|
StartCleanPos, EndCleanPos: integer;
|
|
StringConstantFound: Boolean;
|
|
begin
|
|
StartPos:=CursorPos;
|
|
EndPos:=CursorPos;
|
|
Result:=true;
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds A Start at ',CleanPosToStr(CleanCursorPos),' "',copy(Src,CleanCursorPos-5,5),'" | "',copy(Src,CleanCursorPos,5),'"');
|
|
{$ENDIF}
|
|
GetCleanPosInfo(-1,CleanCursorPos,ResolveComments,SameArea);
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds B Same Area: ',CleanPosToStr(SameArea.StartPos),'-',CleanPosToStr(SameArea.EndPos),' "',copy(Src,SameArea.StartPos,SameArea.EndPos-SameArea.StartPos),'"');
|
|
{$ENDIF}
|
|
if (SameArea.EndPos=SameArea.StartPos) or (SameArea.StartPos>SrcLen) then
|
|
exit;
|
|
|
|
// read til end of string constant
|
|
MoveCursorToCleanPos(SameArea.StartPos);
|
|
ReadNextAtom;
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds read til end of string Atom=',GetAtom);
|
|
{$ENDIF}
|
|
CurrentToken:=GetCurrentTokenType;
|
|
if (CurrentToken=scatNone) then exit;
|
|
StringConstantFound:=(CurrentToken=scatStrConst);
|
|
repeat
|
|
EndCleanPos:=CurPos.EndPos;
|
|
ReadNextAtom;
|
|
LastToken:=CurrentToken;
|
|
CurrentToken:=GetCurrentTokenType;
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds Read Forward: ',GetAtom,' EndCleanPos=',dbgs(EndCleanPos),
|
|
' LastToken=',StrConstTokenTypeName[LastToken],
|
|
' CurrentToken=',StrConstTokenTypeName[CurrentToken],
|
|
' ',StrConstTokenTypeName[GetCurrentTokenType]);
|
|
{$ENDIF}
|
|
case CurrentToken of
|
|
scatNone, scatEdgedBracketClose, scatRoundBracketClose:
|
|
if not (LastToken in [scatStrConst,scatIdent,scatUp,
|
|
scatEdgedBracketClose, scatRoundBracketClose])
|
|
then
|
|
exit
|
|
else
|
|
break;
|
|
|
|
scatStrConst:
|
|
if not (LastToken in [scatPlus]) then
|
|
exit
|
|
else
|
|
StringConstantFound:=true;
|
|
|
|
scatPlus:
|
|
if not (LastToken in [scatStrConst, scatIdent, scatUp,
|
|
scatEdgedBracketClose, scatRoundBracketClose]) then exit;
|
|
|
|
scatIdent:
|
|
if not (LastToken in [scatPlus, scatPoint, scatInherited]) then exit;
|
|
|
|
scatInherited:
|
|
if not (LastToken in [scatPlus, scatPoint]) then exit;
|
|
|
|
scatPoint:
|
|
if not (LastToken in [scatIdent, scatUp, scatRoundBracketClose,
|
|
scatEdgedBracketClose]) then
|
|
exit;
|
|
|
|
scatEdgedBracketOpen,scatRoundBracketOpen:
|
|
if not (LastToken in [scatIdent, scatUp]) then
|
|
exit
|
|
else begin
|
|
ReadTilBracketClose(true);
|
|
CurrentToken:=GetCurrentTokenType;
|
|
end;
|
|
|
|
end;
|
|
until false;
|
|
|
|
// read til start of string constant
|
|
MoveCursorToCleanPos(SameArea.StartPos);
|
|
ReadNextAtom;
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds Read til start of string ',GetAtom);
|
|
{$ENDIF}
|
|
CurrentToken:=GetCurrentTokenType;
|
|
repeat
|
|
StartCleanPos:=CurPos.StartPos;
|
|
ReadPriorAtom;
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds Read backward: ',GetAtom,' StartCleanPos=',dbgs(StartCleanPos));
|
|
{$ENDIF}
|
|
LastToken:=CurrentToken;
|
|
CurrentToken:=GetCurrentTokenType;
|
|
case CurrentToken of
|
|
scatNone, scatEdgedBracketOpen, scatRoundBracketOpen:
|
|
if not (LastToken in [scatStrConst,scatIdent,scatPlus]) then
|
|
exit
|
|
else
|
|
break;
|
|
|
|
scatStrConst:
|
|
if not (LastToken in [scatPlus]) then
|
|
exit
|
|
else
|
|
StringConstantFound:=true;
|
|
|
|
scatPlus:
|
|
if not (LastToken in [scatStrConst, scatIdent, scatRoundBracketOpen]) then
|
|
exit;
|
|
|
|
scatIdent:
|
|
if not (LastToken in [scatPlus, scatPoint, scatUp, scatRoundBracketOpen,
|
|
scatEdgedBracketOpen]) then exit;
|
|
|
|
scatInherited:
|
|
if not (LastToken in [scatIdent]) then exit;
|
|
|
|
scatPoint:
|
|
if not (LastToken in [scatIdent]) then exit;
|
|
|
|
scatEdgedBracketClose,scatRoundBracketClose:
|
|
if not (LastToken in [scatPlus, scatUp, scatPoint]) then
|
|
exit
|
|
else begin
|
|
ReadBackTilBracketOpen(true);
|
|
CurrentToken:=GetCurrentTokenType;
|
|
end;
|
|
|
|
end;
|
|
until false;
|
|
|
|
// convert start and end position
|
|
{$IFDEF VerboseGetStringConstBounds}
|
|
DebugLn('TStandardCodeTool.GetStringConstBounds END "',copy(Src,StartCleanPos,EndCleanPos-StartCleanPos),'" StringConstantFound=',dbgs(StringConstantFound));
|
|
{$ENDIF}
|
|
if not StringConstantFound then begin
|
|
EndCleanPos:=StartCleanPos;
|
|
end;
|
|
if not CleanPosToCaret(StartCleanPos,StartPos) then exit;
|
|
if not CleanPosToCaret(EndCleanPos,EndPos) then exit;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReplaceCode(const StartPos, EndPos: TCodeXYPosition;
|
|
const NewCode: string; SourceChangeCache: TSourceChangeCache): boolean;
|
|
begin
|
|
Result:=false;
|
|
RaiseException('TStandardCodeTool.ReplaceCode not implemented yet');
|
|
end;
|
|
|
|
function TStandardCodeTool.GetStringConstAsFormatString(StartPos,
|
|
EndPos: integer; out FormatStringConstant, FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
{ Converts a string constant into the parameters for a Format call of the
|
|
system unit.
|
|
|
|
Examples:
|
|
|
|
'Hallo' -> "Hallo", ""
|
|
'A'+IntToStr(1) -> "A%s", "IntToStr(1)"
|
|
'A%B'#13#10 -> "A%sB%s", "'%', #13#10"
|
|
}
|
|
procedure AddChar(c: char);
|
|
begin
|
|
FormatStringConstant:=FormatStringConstant+c;
|
|
end;
|
|
|
|
procedure AddParameter(const NewParam: string);
|
|
begin
|
|
FormatStringConstant:=FormatStringConstant+'%s';
|
|
if FormatParameters<>'' then
|
|
FormatParameters:=FormatParameters+',';
|
|
FormatParameters:=FormatParameters+NewParam;
|
|
end;
|
|
|
|
procedure AddParameter(ParamStartPos,ParamEndPos: integer);
|
|
begin
|
|
AddParameter(copy(Src,ParamStartPos,ParamEndPos-ParamStartPos));
|
|
end;
|
|
|
|
procedure ConvertStringConstant;
|
|
var
|
|
APos: Integer;
|
|
CharConstStart: Integer;
|
|
InRange: Boolean;
|
|
begin
|
|
if (CurPos.StartPos<StartPos) and (CurPos.EndPos>StartPos) then
|
|
StartInStringConst:=true;
|
|
if (CurPos.StartPos<EndPos) and (CurPos.EndPos>EndPos) then
|
|
EndInStringConst:=true;
|
|
|
|
APos:=CurPos.StartPos;
|
|
while APos<EndPos do begin
|
|
InRange:=(APos>=StartPos);
|
|
//debugln('ConvertStringConstant InRange=',dbgs(InRange),' Src[APos]=',Src[APos]);
|
|
if Src[APos]='''' then begin
|
|
// read string constant
|
|
inc(APos);
|
|
while APos<EndPos do begin
|
|
InRange:=(APos>=StartPos);
|
|
case Src[APos] of
|
|
'''':
|
|
if (APos<EndPos-1) and (Src[APos+1]='''') then begin
|
|
// a double ' means a single '
|
|
if InRange then begin
|
|
AddChar('''');
|
|
AddChar('''');
|
|
end;
|
|
inc(APos,2);
|
|
end else begin
|
|
// a single ' means end of string constant
|
|
inc(APos);
|
|
break;
|
|
end;
|
|
else
|
|
begin
|
|
// normal char
|
|
if InRange then
|
|
AddChar(Src[APos]);
|
|
inc(APos);
|
|
end;
|
|
end;
|
|
end;
|
|
end else if Src[APos]='#' then begin
|
|
CharConstStart:=APos;
|
|
InRange:=(APos+1>=StartPos);
|
|
repeat
|
|
// read char constant
|
|
inc(APos);
|
|
if APos<EndPos then begin
|
|
if Src[APos-1]='#' then begin
|
|
if IsNumberChar[Src[APos]] then begin
|
|
// read decimal number
|
|
while (APos<EndPos) and IsNumberChar[Src[APos]] do
|
|
inc(APos);
|
|
end else if Src[APos]='$' then begin
|
|
// read hexnumber
|
|
while (APos<EndPos) and IsHexNumberChar[Src[APos]] do
|
|
inc(APos);
|
|
end;
|
|
end;
|
|
end;
|
|
until (APos>=EndPos) or (Src[APos]<>'#');
|
|
if InRange then
|
|
AddParameter(CharConstStart,APos);
|
|
end else
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure ConvertOther;
|
|
var
|
|
ParamStartPos: Integer;
|
|
ParamEndPos: Integer;
|
|
begin
|
|
// read till next string constant
|
|
ParamStartPos:=CurPos.StartPos;
|
|
ParamEndPos:=ParamStartPos;
|
|
while (not AtomIsStringConstant) and (CurPos.EndPos<=EndPos) do begin
|
|
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
|
|
ReadTilBracketClose(true);
|
|
if not AtomIsChar('+') then ParamEndPos:=CurPos.EndPos;
|
|
ReadNextAtom;
|
|
end;
|
|
if ParamEndPos>ParamStartPos then
|
|
AddParameter(ParamStartPos,ParamEndPos);
|
|
if AtomIsStringConstant then UndoReadNextAtom;
|
|
end;
|
|
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
CodePosInFront: LongInt;
|
|
begin
|
|
Result:=false;
|
|
// read string constants and convert it
|
|
FormatStringConstant:='';
|
|
FormatParameters:='';
|
|
StartInStringConst:=false;
|
|
EndInStringConst:=false;
|
|
ANode:=FindDeepestNodeAtPos(StartPos,True);
|
|
CodePosInFront:=ANode.StartPos;
|
|
MoveCursorToCleanPos(CodePosInFront);
|
|
if EndPos>SrcLen then EndPos:=SrcLen+1;
|
|
repeat
|
|
ReadNextAtom;
|
|
//debugln('GetStringConstAsFormatString Atom=',GetAtom);
|
|
if (CurPos.StartPos>=EndPos) then break;
|
|
if CurPos.EndPos>StartPos then begin
|
|
//debugln('GetStringConstAsFormatString Parsing...');
|
|
if AtomIsStringConstant then begin
|
|
// a string constant
|
|
ConvertStringConstant;
|
|
end else if AtomIsChar('+') then begin
|
|
// simply ignore
|
|
end else if (CurPos.Flag=cafRoundBracketOpen) or AtomIsIdentifier(false)
|
|
then begin
|
|
// add as parameter
|
|
ConvertOther;
|
|
end else
|
|
// string constant end
|
|
break;
|
|
end;
|
|
until false;
|
|
Result:=FormatStringConstant<>'';
|
|
end;
|
|
|
|
function TStandardCodeTool.GetStringConstAsFormatString(StartPos,
|
|
EndPos: integer; out FormatStringConstant, FormatParameters: string
|
|
): boolean;
|
|
var
|
|
StartInStringConst, EndInStringConstant: boolean;
|
|
begin
|
|
Result:=GetStringConstAsFormatString(StartPos,EndPos,FormatStringConstant,
|
|
FormatParameters,StartInStringConst,EndInStringConstant);
|
|
if StartInStringConst then ;
|
|
if EndInStringConstant then ;
|
|
end;
|
|
|
|
function TStandardCodeTool.ExtractOperand(const CursorPos: TCodeXYPosition; out
|
|
Operand: string; WithPostTokens, WithAsOperator,
|
|
WithoutTrailingPoints: boolean): boolean;
|
|
var
|
|
CleanPos: integer;
|
|
StartPos: LongInt;
|
|
EndPos: LongInt;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
Operand:='';
|
|
if CursorPos.Code.LineColIsSpace(CursorPos.Y,CursorPos.X) then exit;
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanPos,[]);
|
|
Node:=FindDeepestNodeAtPos(CleanPos,true);
|
|
StartPos:=FindStartOfTerm(CleanPos,NodeTermInType(Node));
|
|
if StartPos<1 then exit;
|
|
StartPos:=FindNextNonSpace(Src,StartPos);
|
|
if StartPos>CleanPos then exit;
|
|
EndPos:=FindEndOfTerm(CleanPos,false,WithAsOperator);
|
|
if not WithPostTokens then begin
|
|
MoveCursorToCleanPos(CleanPos);
|
|
ReadNextAtom;
|
|
if CurPos.EndPos<EndPos then
|
|
EndPos:=CurPos.EndPos;
|
|
end;
|
|
if EndPos<1 then exit;
|
|
//DebugLn(['TStandardCodeTool.ExtractOperand "',dbgstr(copy(Src,StartPos,EndPos-StartPos)),'"']);
|
|
Operand:=ExtractCode(StartPos,EndPos,[phpCommentsToSpace]);
|
|
if WithoutTrailingPoints then begin
|
|
while (Operand<>'') and (Operand[length(Operand)]='.') do
|
|
Operand:=copy(Operand,1,length(Operand)-1);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.GatherResourceStringSections(
|
|
const CursorPos: TCodeXYPosition; PositionList: TCodeXYPositions): boolean;
|
|
|
|
function SearchInUsesSection(UsesNode: TCodeTreeNode): boolean;
|
|
var
|
|
InAtom, UnitNameAtom: TAtomPosition;
|
|
NewCodeTool: TPascalReaderTool;
|
|
ANode: TCodeTreeNode;
|
|
NewCaret: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
MoveCursorToUsesEnd(UsesNode);
|
|
repeat
|
|
ReadPriorUsedUnit(UnitNameAtom, InAtom);
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringSections Uses ',GetAtom(UnitNameAtom));
|
|
// open the unit
|
|
NewCodeTool:=OpenCodeToolForUnit(UnitNameAtom,InAtom,false);
|
|
if NewCodeTool=nil then begin
|
|
MoveCursorToAtomPos(UnitNameAtom);
|
|
RaiseException(Format(ctsSourceOfUnitNotFound, [GetAtom]));
|
|
end;
|
|
NewCodeTool.BuildTree(true);
|
|
// search all resource string sections in the interface
|
|
ANode:=NewCodeTool.FindInterfaceNode;
|
|
if (ANode<>nil) and (ANode.LastChild<>nil) then begin
|
|
ANode:=ANode.LastChild;
|
|
while ANode<>nil do begin
|
|
if ANode.Desc=ctnResStrSection then begin
|
|
if not NewCodeTool.CleanPosToCaret(ANode.StartPos,NewCaret) then
|
|
break;
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringSections Found Other ',NewCodeTool.MainFilename,' Y=',NewCaret.Y);
|
|
PositionList.Add(NewCaret);
|
|
end;
|
|
ANode:=ANode.PriorBrother;
|
|
end;
|
|
end;
|
|
// restore the cursor
|
|
MoveCursorToCleanPos(UnitNameAtom.StartPos);
|
|
ReadPriorAtom; // read keyword 'uses' or comma
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringSections Uses B ',GetAtom);
|
|
until not AtomIsChar(',');
|
|
Result:=true;
|
|
end;
|
|
|
|
var
|
|
CleanCursorPos: integer;
|
|
CursorNode: TCodeTreeNode;
|
|
NewCaret: TCodeXYPosition;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringSections A ');
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
PositionList.Clear;
|
|
ANode:=CursorNode;
|
|
while ANode<>nil do begin
|
|
case ANode.Desc of
|
|
|
|
ctnResStrSection:
|
|
begin
|
|
if not CleanPosToCaret(ANode.StartPos,NewCaret) then exit;
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringSections Found Same Y=',NewCaret.Y);
|
|
PositionList.Add(NewCaret);
|
|
end;
|
|
|
|
ctnUsesSection:
|
|
if not SearchInUsesSection(ANode) then break;
|
|
|
|
end;
|
|
|
|
// go to next node
|
|
if ANode.PriorBrother<>nil then begin
|
|
ANode:=ANode.PriorBrother;
|
|
if (ANode.Desc=ctnInterface) and (ANode.LastChild<>nil) then
|
|
ANode:=ANode.LastChild;
|
|
end else begin
|
|
ANode:=ANode.Parent;
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.IdentifierExistsInResourceStringSection(
|
|
const CursorPos: TCodeXYPosition; const ResStrIdentifier: string): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if ResStrIdentifier='' then exit;
|
|
// parse source and find clean positions
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
// find resource string section
|
|
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
if (ANode=nil) then exit;
|
|
ANode:=ANode.GetNodeOfType(ctnResStrSection);
|
|
if ANode=nil then exit;
|
|
// search identifier in section
|
|
ANode:=ANode.FirstChild;
|
|
while ANode<>nil do begin
|
|
if (ANode.Desc=ctnConstDefinition)
|
|
and CompareSrcIdentifiers(ANode.StartPos,PChar(ResStrIdentifier)) then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.CreateIdentifierFromStringConst(const StartCursorPos,
|
|
EndCursorPos: TCodeXYPosition; out Identifier: string;
|
|
MaxLen: integer): boolean;
|
|
var
|
|
StartPos, EndPos: integer;
|
|
Dummy: Integer;
|
|
IdentStr: String;
|
|
ANode: TCodeTreeNode;
|
|
CodePosInFront: LongInt;
|
|
begin
|
|
Result:=false;
|
|
if MaxLen<=0 then exit;
|
|
// parse source and find clean positions
|
|
BuildTreeAndGetCleanPos(trAll,StartCursorPos,StartPos,[]);
|
|
Dummy:=CaretToCleanPos(EndCursorPos, EndPos);
|
|
if (Dummy<>0) and (Dummy<>-1) then exit;
|
|
ANode:=FindDeepestNodeAtPos(StartPos,True);
|
|
CodePosInFront:=ANode.StartPos;
|
|
// read string constants and extract identifier characters
|
|
Identifier:='';
|
|
MoveCursorToCleanPos(CodePosInFront);
|
|
repeat
|
|
ReadNextAtom;
|
|
//debugln('TStandardCodeTool.CreateIdentifierFromStringConst Atom=',GetAtom);
|
|
if (CurPos.StartPos>=EndPos) then break;
|
|
if AtomIsStringConstant then begin
|
|
IdentStr:=ExtractIdentCharsFromStringConstant(CurPos.StartPos,
|
|
StartPos,EndPos,MaxLen-length(Identifier));
|
|
//debugln('TStandardCodeTool.CreateIdentifierFromStringConst IdentStr=',IdentStr);
|
|
if (IdentStr<>'') then begin
|
|
IdentStr[1]:=UpChars[IdentStr[1]];
|
|
Identifier:=Identifier+IdentStr;
|
|
end;
|
|
end;
|
|
until length(Identifier)>=MaxLen;
|
|
Result:=Identifier<>'';
|
|
end;
|
|
|
|
function TStandardCodeTool.StringConstToFormatString(const StartCursorPos,
|
|
EndCursorPos: TCodeXYPosition;
|
|
out FormatStringConstant, FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
var
|
|
StartPos,EndPos,Dummy: Integer;
|
|
begin
|
|
Result:=false;
|
|
// parse source and find clean positions
|
|
BuildTreeAndGetCleanPos(trAll,StartCursorPos,StartPos,[]);
|
|
Dummy:=CaretToCleanPos(EndCursorPos, EndPos);
|
|
if (Dummy<>0) and (Dummy<>-1) then exit;
|
|
Result:=GetStringConstAsFormatString(StartPos,EndPos,FormatStringConstant,
|
|
FormatParameters,StartInStringConst,EndInStringConst);
|
|
end;
|
|
|
|
function TStandardCodeTool.HasInterfaceRegisterProc(var HasRegisterProc: boolean
|
|
): boolean;
|
|
var
|
|
InterfaceNode: TCodeTreeNode;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
HasRegisterProc:=false;
|
|
BuildTree(true);
|
|
InterfaceNode:=FindInterfaceNode;
|
|
if InterfaceNode=nil then exit;
|
|
ANode:=InterfaceNode.FirstChild;
|
|
while ANode<>nil do begin
|
|
if (ANode.Desc=ctnProcedure) then begin
|
|
MoveCursorToNodeStart(ANode);
|
|
if ReadNextUpAtomIs('PROCEDURE')
|
|
and ReadNextUpAtomIs('REGISTER')
|
|
and ReadNextAtomIsChar(';')
|
|
then begin
|
|
HasRegisterProc:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
function AddModeDelphiDirective: boolean;
|
|
var
|
|
ModeDirectivePos: integer;
|
|
InsertPos: Integer;
|
|
begin
|
|
Result:=false;
|
|
BuildTree(true);
|
|
if not FindModeDirective(false,ModeDirectivePos) then begin
|
|
// add {$MODE Delphi} behind source type
|
|
if Tree.Root=nil then exit;
|
|
MoveCursorToNodeStart(Tree.Root);
|
|
ReadNextAtom; // 'unit', 'program', ..
|
|
ReadNextAtom; // name
|
|
ReadNextAtom; // semicolon
|
|
InsertPos:=CurPos.EndPos;
|
|
SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
|
|
'{$MODE Delphi}');
|
|
if not SourceChangeCache.Apply then exit;
|
|
end;
|
|
// changing mode requires rescan
|
|
BuildTree(false);
|
|
Result:=true;
|
|
end;
|
|
|
|
function ConvertUsedUnits: boolean;
|
|
// replace unit 'Windows' with 'LCLIntf' and add 'LResources'
|
|
// rename 'in' filenames to case sensitive filename
|
|
var
|
|
NamePos, InPos: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
if FindUnitInAllUsesSections('WINDOWS',NamePos,InPos)
|
|
and (InPos.StartPos<1) then begin
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
NamePos.StartPos,NamePos.EndPos,'LCLIntf') then
|
|
begin
|
|
debugln('ConvertUsedUnits Unable to replace Windows with LCLIntf unit');
|
|
exit;
|
|
end;
|
|
end;
|
|
if AddLRSCode then
|
|
if not AddUnitToMainUsesSection('LResources','',SourceChangeCache) then
|
|
begin
|
|
debugln('ConvertUsedUnits Unable to add LResources to main uses section');
|
|
exit;
|
|
end;
|
|
if not RemoveUnitFromAllUsesSections('VARIANTS',SourceChangeCache) then
|
|
begin
|
|
debugln('ConvertUsedUnits Unable to remove Variants from all uses sections');
|
|
exit;
|
|
end;
|
|
if not FixUsedUnitCase(SourceChangeCache) then
|
|
begin
|
|
debugln('ConvertUsedUnits Unable to fix unit filename case sensitivity in all uses sections');
|
|
exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function RemoveDFMResourceDirective: boolean;
|
|
// remove {$R *.dfm} or {$R *.xfm} directive
|
|
var
|
|
ParamPos: Integer;
|
|
ACleanPos: Integer;
|
|
StartPos: Integer;
|
|
s: String;
|
|
begin
|
|
Result:=false;
|
|
// find $R directive
|
|
ACleanPos:=1;
|
|
repeat
|
|
ACleanPos:=FindNextCompilerDirectiveWithName(Src,ACleanPos,'R',
|
|
Scanner.NestedComments,ParamPos);
|
|
if (ACleanPos<1) or (ACleanPos>SrcLen) or (ParamPos>SrcLen) then break;
|
|
s:=UpperCaseStr(copy(Src,ParamPos,6));
|
|
if (Src[ACleanPos]='{')
|
|
and ((s='*.DFM}') or (s='*.XFM}'))
|
|
then begin
|
|
StartPos:=FindLineEndOrCodeInFrontOfPosition(ACleanPos,true);
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,StartPos,ParamPos+6,'')
|
|
then exit;
|
|
break;
|
|
end;
|
|
ACleanPos:=FindCommentEnd(Src,ACleanPos,Scanner.NestedComments);
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
function AddLRSIncludeDirective: boolean;
|
|
// add initialization and {$i unit.lrs} include directive
|
|
var
|
|
FirstInclude: TCodeBuffer;
|
|
LRSFilename: String;
|
|
InitializationNode: TCodeTreeNode;
|
|
ImplementationNode: TCodeTreeNode;
|
|
NewCode: String;
|
|
InsertPos: Integer;
|
|
LinkIndex: Integer;
|
|
begin
|
|
Result:=false;
|
|
if AddLRSCode then begin
|
|
LRSFilename:=ExtractFilenameOnly(MainFilename)+'.lrs';
|
|
LinkIndex:=-1;
|
|
FirstInclude:=FindNextIncludeInInitialization(LinkIndex);
|
|
if (FirstInclude<>nil)
|
|
and (CompareFilenames(FirstInclude.Filename,LRSFilename)=0) then begin
|
|
// already there
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
if Tree.Root.Desc=ctnUnit then begin
|
|
InitializationNode:=FindInitializationNode;
|
|
NewCode:=GetIndentStr(SourceChangeCache.BeautifyCodeOptions.Indent)
|
|
+'{$i '+LRSFilename+'}';
|
|
if InitializationNode=nil then begin
|
|
// add also an initialization section
|
|
ImplementationNode:=FindImplementationNode;
|
|
InsertPos:=ImplementationNode.EndPos;
|
|
NewCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord(
|
|
'initialization')
|
|
+SourceChangeCache.BeautifyCodeOptions.LineEnd
|
|
+NewCode;
|
|
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
|
|
InsertPos,InsertPos,
|
|
NewCode) then exit;
|
|
end else begin
|
|
InsertPos:=InitializationNode.StartPos+length('initialization');
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,
|
|
InsertPos,InsertPos,
|
|
NewCode) then exit;
|
|
end;
|
|
end else begin
|
|
// only Units supported yet
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
if SourceChangeCache=nil then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
DebugLn('ConvertDelphiToLazarusSource AddModeDelphiDirective');
|
|
if not AddModeDelphiDirective then exit;
|
|
DebugLn('ConvertDelphiToLazarusSource RemoveDFMResourceDirective');
|
|
if not RemoveDFMResourceDirective then exit;
|
|
DebugLn('ConvertDelphiToLazarusSource AddLRSIncludeDirective');
|
|
if not AddLRSIncludeDirective then exit;
|
|
DebugLn('ConvertDelphiToLazarusSource ConvertUsedUnits');
|
|
if not ConvertUsedUnits then exit;
|
|
DebugLn('ConvertDelphiToLazarusSource Apply');
|
|
if not SourceChangeCache.Apply then exit;
|
|
DebugLn('ConvertDelphiToLazarusSource END');
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.GetIDEDirectives(DirectiveList: TStrings): boolean;
|
|
var
|
|
StartPos: Integer;
|
|
EndPos: Integer;
|
|
begin
|
|
Result:=false;
|
|
DirectiveList.Clear;
|
|
BuildTree(true);
|
|
EndPos:=1;
|
|
repeat
|
|
StartPos:=FindNextIDEDirective(Src,EndPos,Scanner.NestedComments);
|
|
if StartPos<1 then break;
|
|
EndPos:=FindCommentEnd(Src,StartPos,Scanner.NestedComments);
|
|
DirectiveList.Add(copy(Src,StartPos,EndPos-StartPos));
|
|
if EndPos>SrcLen then break;
|
|
StartPos:=EndPos;
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.SetIDEDirectives(DirectiveList: TStrings;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
InsertPos: Integer;
|
|
EndPos: Integer;
|
|
StartPos: Integer;
|
|
InsertTxt: String;
|
|
ImplementationNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if SourceChangeCache=nil then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
BuildTree(false);
|
|
|
|
// find first old IDE directive
|
|
InsertPos:=FindNextIDEDirective(Src,1,Scanner.NestedComments);
|
|
if InsertPos<1 then InsertPos:=0;
|
|
|
|
// remove all old IDE directives
|
|
if InsertPos>=1 then
|
|
EndPos:=InsertPos
|
|
else
|
|
EndPos:=1;
|
|
repeat
|
|
// find next IDE directive
|
|
StartPos:=FindNextIDEDirective(Src,EndPos,Scanner.NestedComments);
|
|
if StartPos<1 then break;
|
|
EndPos:=FindCommentEnd(Src,StartPos,Scanner.NestedComments);
|
|
// remove also space in front of directive
|
|
while (StartPos>1) and (Src[StartPos-1] in [' ',#9]) do dec(StartPos);
|
|
// remove also space behind directive
|
|
while (EndPos<=SrcLen) and (Src[EndPos] in [' ',#9]) do inc(EndPos);
|
|
if (EndPos<=SrcLen) and (Src[EndPos] in [#10,#13]) then begin
|
|
inc(EndPos);
|
|
if (EndPos<=SrcLen) and (Src[EndPos] in [#10,#13])
|
|
and (Src[EndPos]<>Src[EndPos-1]) then
|
|
inc(EndPos);
|
|
end;
|
|
// remove directive
|
|
SourceChangeCache.Replace(gtNone,gtNone,StartPos,EndPos,'');
|
|
if EndPos>SrcLen then break;
|
|
StartPos:=EndPos;
|
|
until false;
|
|
|
|
// find a nice insert position
|
|
ImplementationNode:=FindImplementationNode;
|
|
if (ImplementationNode<>nil)
|
|
and (ImplementationNode.StartPos<=InsertPos) then
|
|
InsertPos:=0;
|
|
if InsertPos<1 then begin
|
|
// set default insert position
|
|
InsertPos:=1;
|
|
if (Tree<>nil) and (Tree.Root<>nil) then
|
|
InsertPos:=Tree.Root.StartPos;
|
|
end;
|
|
|
|
// add directives
|
|
InsertTxt:=ChompLineEndsAtEnd(DirectiveList.Text);
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
|
|
InsertTxt) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TStandardCodeTool.CalcMemSize(Stats: TCTMemStats);
|
|
begin
|
|
inherited CalcMemSize(Stats);
|
|
end;
|
|
|
|
function TStandardCodeTool.GatherResourceStringsWithValue(
|
|
const CursorPos: TCodeXYPosition; const StringValue: string;
|
|
PositionList: TCodeXYPositions): boolean;
|
|
|
|
procedure CompareStringConst(ANode: TCodeTreeNode);
|
|
var
|
|
CurValue: String;
|
|
NewCaret: TCodeXYPosition;
|
|
begin
|
|
MoveCursorToNodeStart(ANode);
|
|
ReadNextAtom; // read identifier
|
|
if not AtomIsIdentifier(false) then exit;
|
|
ReadNextAtom; // read =
|
|
if CurPos.Flag<>cafEqual then exit;
|
|
ReadNextAtom; // read start of string constant
|
|
if not AtomIsStringConstant then exit;
|
|
// extract string constant value
|
|
CurValue:=ReadStringConstantValue(CurPos.StartPos);
|
|
if CurValue<>StringValue then exit;
|
|
// values are the same
|
|
// -> add it to position list
|
|
// get x,y position
|
|
if not CleanPosToCaret(ANode.StartPos,NewCaret) then exit;
|
|
//DebugLn('TStandardCodeTool.GatherResourceStringsWithValue Found ',MainFilename,' Y=',NewCaret.Y);
|
|
PositionList.Add(NewCaret);
|
|
end;
|
|
|
|
var
|
|
CleanCursorPos: integer;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if PositionList=nil then exit;
|
|
// parse source and find clean positions
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
// find resource string section
|
|
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
if (ANode=nil) then exit;
|
|
ANode:=ANode.GetNodeOfType(ctnResStrSection);
|
|
if ANode=nil then exit;
|
|
// search identifier in section
|
|
ANode:=ANode.FirstChild;
|
|
while ANode<>nil do begin
|
|
if (ANode.Desc=ctnConstDefinition) then begin
|
|
CompareStringConst(ANode);
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.GatherResourceStringIdents(
|
|
const SectionPos: TCodeXYPosition; var IdentTree: TAVLTree): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
IdentTree:=nil;
|
|
// parse source and find clean positions
|
|
BuildTreeAndGetCleanPos(trAll,SectionPos,CleanCursorPos,[]);
|
|
// find resource string section
|
|
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
if (ANode=nil) then exit;
|
|
ANode:=ANode.GetNodeOfType(ctnResStrSection);
|
|
if ANode=nil then exit;
|
|
// search identifier in section
|
|
ANode:=ANode.FirstChild;
|
|
while ANode<>nil do begin
|
|
if (ANode.Desc=ctnConstDefinition) then begin
|
|
if IdentTree=nil then
|
|
IdentTree:=TAVLTree.Create(TListSortCompare(@BasicCodeTools.CompareIdentifiers));
|
|
IdentTree.Add(@Src[ANode.StartPos]);
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindNearestResourceString(const CursorPos,
|
|
SectionPos: TCodeXYPosition; var NearestPos: TCodeXYPosition): boolean;
|
|
var
|
|
CursorTool, SectionTool: TStandardCodeTool;
|
|
IdentTree: TAVLTree;
|
|
NearestNode: TAVLTreeNode;
|
|
NearestCleanPos: Integer;
|
|
begin
|
|
Result:=false;
|
|
NearestPos.Code:=nil;
|
|
// get both codetools
|
|
if not Assigned(OnGetCodeToolForBuffer) then exit;
|
|
CursorTool:=
|
|
TStandardCodeTool(OnGetCodeToolForBuffer(Self,CursorPos.Code,true));
|
|
SectionTool:=
|
|
TStandardCodeTool(OnGetCodeToolForBuffer(Self,SectionPos.Code,true));
|
|
if (CursorTool=nil) or (SectionTool=nil) then exit;
|
|
// get all resourcestring identifiers
|
|
IdentTree:=nil;
|
|
Result:=SectionTool.GatherResourceStringIdents(SectionPos,IdentTree);
|
|
if IdentTree=nil then exit;
|
|
try
|
|
// find nearest resourcestring identifier in the cursor source
|
|
NearestNode:=CursorTool.FindNearestIdentifierNode(CursorPos,IdentTree);
|
|
if NearestNode=nil then exit;
|
|
// convert node to cleanpos
|
|
NearestCleanPos:=PtrUInt(NearestNode.Data)-PtrUInt(@SectionTool.Src[1])+1;
|
|
// convert cleanpos to caret
|
|
CleanPosToCaret(NearestCleanPos,NearestPos);
|
|
finally
|
|
IdentTree.Free;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddResourceString(const SectionPos: TCodeXYPosition;
|
|
const NewIdentifier, NewValue: string;
|
|
InsertPolicy: TResourcestringInsertPolicy;
|
|
const NearestPos: TCodeXYPosition;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
CleanSectionPos: integer;
|
|
ANode, SectionNode: TCodeTreeNode;
|
|
Indent: Integer;
|
|
InsertPos: Integer;
|
|
InsertSrc: String;
|
|
NearestCleanPos: integer;
|
|
begin
|
|
Result:=false;
|
|
//DebugLn('TStandardCodeTool.AddResourcestring A ',NewIdentifier,'=',NewValue,' ');
|
|
if (NewIdentifier='') or (length(NewIdentifier)>255) then exit;
|
|
if SourceChangeCache=nil then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
// parse source and find clean positions
|
|
//DebugLn('TStandardCodeTool.AddResourcestring B');
|
|
BuildTreeAndGetCleanPos(trAll,SectionPos,CleanSectionPos,[]);
|
|
//DebugLn('TStandardCodeTool.AddResourcestring C');
|
|
// find resource string section
|
|
SectionNode:=FindDeepestNodeAtPos(CleanSectionPos,true);
|
|
if (SectionNode=nil) then exit;
|
|
SectionNode:=SectionNode.GetNodeOfType(ctnResStrSection);
|
|
if SectionNode=nil then exit;
|
|
|
|
//DebugLn('TStandardCodeTool.AddResourcestring D SectionChilds=',SectionNode.FirstChild<>nil);
|
|
// find insert position
|
|
if SectionNode.FirstChild=nil then begin
|
|
// no resourcestring in this section yet -> append as first child
|
|
Indent:=GetLineIndent(Src,SectionNode.StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
InsertPos:=SectionNode.StartPos+length('RESOURCESTRING');
|
|
end else begin
|
|
// search insert position
|
|
case InsertPolicy of
|
|
rsipAlphabetically:
|
|
begin
|
|
// insert new identifier alphabetically
|
|
ANode:=SectionNode.FirstChild;
|
|
while (ANode<>nil) do begin
|
|
if (ANode.Desc=ctnConstDefinition)
|
|
and (CompareIdentifiers(@Src[ANode.StartPos],
|
|
PChar(Pointer(NewIdentifier)))<0)
|
|
then
|
|
break;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
if ANode=nil then begin
|
|
// append new identifier as last
|
|
Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
|
|
end else begin
|
|
// insert in front of node
|
|
Indent:=GetLineIndent(Src,ANode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
|
|
end;
|
|
end;
|
|
|
|
rsipContext:
|
|
begin
|
|
// find nearest
|
|
ANode:=nil;
|
|
if (NearestPos.Code<>nil)
|
|
and (CaretToCleanPos(NearestPos,NearestCleanPos)=0) then begin
|
|
ANode:=SectionNode.FirstChild;
|
|
while (ANode<>nil) do begin
|
|
if (ANode.Desc=ctnConstDefinition)
|
|
and (ANode.StartPos<=NearestCleanPos)
|
|
and (ANode.EndPos>NearestCleanPos)
|
|
then begin
|
|
break;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
end;
|
|
if ANode=nil then begin
|
|
// append new identifier as last
|
|
Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
|
|
end else begin
|
|
// insert behind node
|
|
Indent:=GetLineIndent(Src,ANode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
|
|
end;
|
|
end;
|
|
|
|
else
|
|
begin
|
|
// append new identifier
|
|
Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//DebugLn('TStandardCodeTool.AddResourcestring E Indent=',Indent,' InsertPos=',InsertPos,' ',copy(Src,InsertPos-9,8),'|',copy(Src,InsertPos,8));
|
|
// insert
|
|
InsertSrc:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
NewIdentifier+' = '+NewValue+';',Indent);
|
|
//DebugLn('TStandardCodeTool.AddResourcestring F "',InsertSrc,'"');
|
|
SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,InsertSrc);
|
|
SourceChangeCache.Apply;
|
|
Result:=true;
|
|
//DebugLn('TStandardCodeTool.AddResourcestring END ',Result);
|
|
end;
|
|
|
|
function TStandardCodeTool.FindPublishedVariable(const UpperClassName,
|
|
UpperVarName: string; ExceptionOnClassNotFound: boolean): TCodeTreeNode;
|
|
var ClassNode, SectionNode: TCodeTreeNode;
|
|
begin
|
|
Result:=nil;
|
|
if (UpperClassName='') or (length(UpperClassName)>255) then
|
|
RaiseException(Format(ctsinvalidClassName, ['"', UpperClassName, '"']));
|
|
BuildTree(true);
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
|
|
if ClassNode=nil then begin
|
|
if ExceptionOnClassNotFound then
|
|
RaiseException(Format(ctsclassNotFound, ['"', UpperClassName, '"']))
|
|
else
|
|
exit;
|
|
end;
|
|
BuildSubTreeForClass(ClassNode);
|
|
SectionNode:=ClassNode.FirstChild;
|
|
while (SectionNode<>nil) do begin
|
|
if SectionNode.Desc=ctnClassPublished then begin
|
|
Result:=SectionNode.FirstChild;
|
|
while Result<>nil do begin
|
|
if (Result.Desc=ctnVarDefinition) then begin
|
|
MoveCursorToNodeStart(Result);
|
|
if ReadNextUpAtomIs(UpperVarName) then
|
|
exit;
|
|
end;
|
|
Result:=Result.NextBrother;
|
|
end;
|
|
end;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.AddPublishedVariable(const UpperClassName,
|
|
VarName, VarType: string; SourceChangeCache: TSourceChangeCache): boolean;
|
|
var ClassNode, SectionNode: TCodeTreeNode;
|
|
Indent, InsertPos: integer;
|
|
begin
|
|
Result:=false;
|
|
if (UpperClassName='') or (length(UpperClassName)>255) then
|
|
RaiseException(Format(ctsinvalidClassName2, ['"', UpperClassName, '"']));
|
|
if (VarName='') or (length(VarName)>255) then
|
|
RaiseException(Format(ctsinvalidVariableName, ['"', VarName, '"']));
|
|
if (VarType='') or (length(VarType)>255) then
|
|
RaiseException(Format(ctsinvalidVariableType, ['"', VarType, '"']));
|
|
if (SourceChangeCache=nil) then
|
|
RaiseException('missing SourceChangeCache');
|
|
if FindPublishedVariable(UpperClassName,UpperCaseStr(VarName),true)<>nil then
|
|
begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
|
|
if ClassNode=nil then
|
|
RaiseException(Format(ctsclassNotFound, ['"', UpperClassName, '"']));
|
|
BuildSubTreeForClass(ClassNode);
|
|
SectionNode:=ClassNode.FirstChild;
|
|
if (SectionNode.NextBrother<>nil)
|
|
and (SectionNode.NextBrother.Desc=ctnClassPublished) then
|
|
SectionNode:=SectionNode.NextBrother;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if SectionNode.FirstChild<>nil then begin
|
|
Indent:=GetLineIndent(Src,SectionNode.FirstChild.StartPos);
|
|
end else begin
|
|
Indent:=GetLineIndent(Src,SectionNode.StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
end;
|
|
InsertPos:=FindLineEndOrCodeInFrontOfPosition(SectionNode.EndPos);
|
|
SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
|
|
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
VarName+':'+VarType+';',Indent)
|
|
);
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemovePublishedVariable(const UpperClassName,
|
|
UpperVarName: string; ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var VarNode: TCodeTreeNode;
|
|
FromPos, ToPos: integer;
|
|
begin
|
|
Result:=false;
|
|
VarNode:=FindPublishedVariable(UpperClassName,UpperVarName,
|
|
ExceptionOnClassNotFound);
|
|
if VarNode=nil then exit;
|
|
if (VarNode.PriorBrother<>nil)
|
|
and (VarNode.PriorBrother.Desc=ctnVarDefinition)
|
|
and (VarNode.PriorBrother.FirstChild=nil) then begin
|
|
// variable definition has the form 'PriorVarName, VarName: VarType;'
|
|
// or 'PriorVarName, VarName, NextVarName: VarType'
|
|
// -> delete only ', VarName'
|
|
MoveCursorToNodeStart(VarNode.PriorBrother);
|
|
ReadNextAtom; // read 'PriorVarName'
|
|
ReadNextAtom; // read ','
|
|
FromPos:=CurPos.StartPos;
|
|
ReadNextAtom; // read 'VarName'
|
|
ReadNextAtom; // read ':'
|
|
ToPos:=CurPos.StartPos;
|
|
end else begin
|
|
if VarNode.FirstChild<>nil then begin
|
|
// variable definition has the form 'VarName: VarType;'
|
|
// -> delete whole line
|
|
FromPos:=FindLineEndOrCodeInFrontOfPosition(VarNode.StartPos);
|
|
ToPos:=FindLineEndOrCodeAfterPosition(VarNode.EndPos);
|
|
//debugln(['TStandardCodeTool.RemovePublishedVariable ',dbgstr(copy(Src,FromPos,ToPos-FromPos))]);
|
|
end else begin
|
|
// variable definition has the form 'VarName, NextVarName: VarType;'
|
|
// -> delete only 'VarName, '
|
|
FromPos:=VarNode.StartPos;
|
|
ToPos:=VarNode.NextBrother.StartPos;
|
|
end;
|
|
end;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then exit;
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.RenamePublishedVariable(const UpperClassName,
|
|
UpperOldVarName: string; const NewVarName, VarType: shortstring;
|
|
ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
TypeNode, VarNode: TCodeTreeNode;
|
|
ApplyNeeded: Boolean;
|
|
begin
|
|
Result:=false;
|
|
BuildTree(false);
|
|
VarNode:=FindPublishedVariable(UpperClassName,UpperOldVarName,
|
|
ExceptionOnClassNotFound);
|
|
if VarNode<>nil then begin
|
|
// old variable found
|
|
// check type
|
|
TypeNode:=FindTypeNodeOfDefinition(VarNode);
|
|
MoveCursorToNodeStart(TypeNode);
|
|
ReadNextAtom;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
ApplyNeeded:=false;
|
|
if (not AtomIs(VarType)) then begin
|
|
// change the type
|
|
ApplyNeeded:=true;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
CurPos.StartPos,CurPos.EndPos,VarType)
|
|
then begin
|
|
RaiseException('Unable to replace type');
|
|
end;
|
|
end;
|
|
// rename variable in source
|
|
if not ReplaceWord(UpperOldVarName,NewVarName,false,SourceChangeCache,true)
|
|
then
|
|
exit;
|
|
Result:=(not ApplyNeeded) or SourceChangeCache.Apply;
|
|
end else begin
|
|
// old variable not found -> add it
|
|
Result:=AddPublishedVariable(UpperClassName,NewVarName,VarType,
|
|
SourceChangeCache);
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.GatherPublishedClassElements(
|
|
const TheClassName: string;
|
|
ExceptionOnClassNotFound, WithVariables, WithMethods, WithProperties,
|
|
WithAncestors: boolean;
|
|
out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
|
|
|
|
function Add(AFindContext: PFindContext): boolean;
|
|
var
|
|
ClassNode: TCodeTreeNode;
|
|
CurTool: TFindDeclarationTool;
|
|
SectionNode: TCodeTreeNode;
|
|
ANode: TCodeTreeNode;
|
|
CurProcName: String;
|
|
NewNodeExt: TCodeTreeNodeExtension;
|
|
CurPropName: String;
|
|
CurVarName: String;
|
|
begin
|
|
Result:=false;
|
|
ClassNode:=AFindContext^.Node;
|
|
if (ClassNode=nil)
|
|
or (not (ClassNode.Desc in AllClasses)) then exit;
|
|
CurTool:=AFindContext^.Tool;
|
|
CurTool.BuildSubTreeForClass(ClassNode);
|
|
SectionNode:=ClassNode.FirstChild;
|
|
while (SectionNode<>nil) do begin
|
|
if SectionNode.Desc=ctnClassPublished then begin
|
|
ANode:=SectionNode.FirstChild;
|
|
while ANode<>nil do begin
|
|
if (ANode.Desc=ctnProcedure) and WithMethods then begin
|
|
CurProcName:=CurTool.ExtractProcName(ANode,[]);
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln('TStandardCodeTool.GatherPublishedClassElements CurProcName="',CurProcName,'"');
|
|
{$ENDIF}
|
|
NewNodeExt:=NodeExtMemManager.NewNode;
|
|
with NewNodeExt do begin
|
|
Node:=ANode;
|
|
Txt:=CurProcName;
|
|
end;
|
|
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
|
end
|
|
else if (ANode.Desc=ctnVarDefinition) and WithVariables then begin
|
|
CurVarName:=CurTool.ExtractDefinitionName(ANode);
|
|
NewNodeExt:=NodeExtMemManager.NewNode;
|
|
with NewNodeExt do begin
|
|
Node:=ANode;
|
|
Txt:=CurVarName;
|
|
end;
|
|
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
|
end
|
|
else if (ANode.Desc=ctnProperty) and WithProperties then begin
|
|
CurPropName:=CurTool.ExtractPropName(ANode,false);
|
|
NewNodeExt:=NodeExtMemManager.NewNode;
|
|
with NewNodeExt do begin
|
|
Node:=ANode;
|
|
Txt:=CurPropName;
|
|
end;
|
|
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
end;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
var
|
|
ClassNode: TCodeTreeNode;
|
|
AncestorList: TFPList;// of PFindContext
|
|
i: Integer;
|
|
begin
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExtension:=nil;
|
|
if (TheClassName='') or (length(TheClassName)>255) then
|
|
RaiseException(Format(ctsInvalidClassName, ['"', TheClassName, '"']));
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
DebugLn(['TStandardCodeTool.GatherPublishedClassElements BEFORE buildtree']);
|
|
{$ENDIF}
|
|
BuildTree(true);
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
DebugLn(['TStandardCodeTool.GatherPublishedClassElements after buildtree']);
|
|
{$ENDIF}
|
|
ClassNode:=FindClassNodeInInterface(TheClassName,true,false,
|
|
ExceptionOnClassNotFound);
|
|
if ClassNode=nil then exit;
|
|
AncestorList:=nil;
|
|
try
|
|
if WithAncestors then begin
|
|
if not FindClassAndAncestors(ClassNode,AncestorList,true) then exit;
|
|
end else begin
|
|
AddFindContext(AncestorList,CreateFindContext(Self,ClassNode));
|
|
end;
|
|
TreeOfCodeTreeNodeExtension:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
|
for i:=0 to AncestorList.Count-1 do begin
|
|
if not Add(PFindContext(AncestorList[i])) then exit;
|
|
end;
|
|
//debugln(['TStandardCodeTool.GatherPublishedClassElements END']);
|
|
finally
|
|
FreeListOfPFindContext(AncestorList);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.RetypeClassVariables(const AClassName: string;
|
|
ListOfTypes: TStringToStringTree; ExceptionOnClassNotFound: boolean;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var
|
|
ClassNode: TCodeTreeNode;
|
|
Node: TCodeTreeNode;
|
|
TypeNode: TCodeTreeNode;
|
|
OldType: String;
|
|
NewType: string;
|
|
HasChanged: Boolean;
|
|
begin
|
|
|
|
Result:=false;
|
|
BuildTree(true);
|
|
ClassNode:=FindClassNodeInInterface(AClassName,true,false,false);
|
|
if ClassNode=nil then begin
|
|
if ExceptionOnClassNotFound then
|
|
RaiseException(Format(ctsclassNotFound, ['"', AClassName, '"']))
|
|
else
|
|
exit;
|
|
end;
|
|
if (ListOfTypes=nil) or (ListOfTypes.Tree.Count=0) then exit(true);
|
|
|
|
HasChanged:=false;
|
|
BuildSubTreeForClass(ClassNode);
|
|
Node:=ClassNode.FirstChild;
|
|
while (Node<>nil) and (Node.HasAsParent(ClassNode)) do begin
|
|
if (Node.Desc=ctnVarDefinition) and (Node.FirstChild<>nil) then begin
|
|
TypeNode:=Node.FirstChild;
|
|
if TypeNode.Desc=ctnIdentifier then begin
|
|
MoveCursorToNodeStart(TypeNode);
|
|
ReadNextAtom;
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafPoint then begin
|
|
// skip unitname
|
|
ReadNextAtom;
|
|
end else begin
|
|
UndoReadNextAtom;
|
|
end;
|
|
// cursor is now on identifier
|
|
OldType:=GetAtom;
|
|
if ListOfTypes.Contains(OldType) then begin
|
|
NewType:=ListOfTypes[OldType];
|
|
if OldType<>NewType then begin
|
|
// change type (or case)
|
|
if not HasChanged then begin
|
|
HasChanged:=true;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
end;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,
|
|
CurPos.StartPos,CurPos.EndPos,NewType)
|
|
then
|
|
exit(false);
|
|
end;
|
|
end;
|
|
end;
|
|
Node:=Node.NextSkipChilds;
|
|
end else
|
|
Node:=Node.Next;
|
|
end;
|
|
if HasChanged then begin
|
|
if not SourceChangeCache.Apply then exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindDanglingComponentEvents(
|
|
const TheClassName: string; RootComponent: TComponent;
|
|
ExceptionOnClassNotFound, SearchInAncestors: boolean; out
|
|
ListOfPInstancePropInfo: TFPList;
|
|
const OverrideGetMethodName: TOnGetMethodname): boolean;
|
|
var
|
|
PublishedMethods: TAVLTree;
|
|
|
|
procedure AddDanglingEvent(Instance: TPersistent; PropInfo: PPropInfo);
|
|
var
|
|
NewItem: PInstancePropInfo;
|
|
begin
|
|
New(NewItem);
|
|
NewItem^.Instance:=Instance;
|
|
NewItem^.PropInfo:=PropInfo;
|
|
if ListOfPInstancePropInfo=nil then ListOfPInstancePropInfo:=TFPList.Create;
|
|
ListOfPInstancePropInfo.Add(NewItem);
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln('AddDanglingEvent ',DbgSName(Instance),' ',PropInfo^.Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure CheckMethodsInPersistent(APersistent: TPersistent);
|
|
var
|
|
TypeInfo: PTypeInfo;
|
|
TypeData: PTypeData;
|
|
PropInfo: PPropInfo;
|
|
CurCount: integer;
|
|
PropType: PTypeInfo;
|
|
NodeExt: TCodeTreeNodeExtension;
|
|
CurMethod: TMethod;
|
|
CurMethodName: String;
|
|
ObjValue: TObject;
|
|
begin
|
|
if APersistent=nil then exit;
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln('TStandardCodeTool.FindDanglingComponentEvents.CheckMethodsInPersistent Checking ',DbgSName(APersistent));
|
|
{$ENDIF}
|
|
// read all properties and remove doubles
|
|
TypeInfo:=APersistent.ClassInfo;
|
|
repeat
|
|
// read all property infos of current class
|
|
TypeData:=GetTypeData(TypeInfo);
|
|
// skip unit name
|
|
PropInfo:=PPropInfo(PByte(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
|
|
// read property count
|
|
CurCount:=PWord(PropInfo)^;
|
|
inc(PtrUInt(PropInfo),SizeOf(Word));
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln(' UnitName=',TypeData^.UnitName,' Type=',TypeInfo^.Name,' CurPropCount=',dbgs(CurCount));
|
|
{$ENDIF}
|
|
// read properties
|
|
while CurCount>0 do begin
|
|
// point PropInfo to next propinfo record.
|
|
// Located at Name[Length(Name)+1] !
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln(' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name);
|
|
{$ENDIF}
|
|
PropType:=PropInfo^.PropType;
|
|
|
|
if (PropType^.Kind=tkMethod) then begin
|
|
// RTTI property is method
|
|
// -> search method in source
|
|
CurMethod:=GetMethodProp(APersistent,PropInfo);
|
|
if (CurMethod.Data<>nil) or (CurMethod.Code<>nil) then begin
|
|
if Assigned(OverrideGetMethodName) then
|
|
CurMethodName:=OverrideGetMethodName(CurMethod,RootComponent)
|
|
else
|
|
CurMethodName:=OnGetMethodName(CurMethod,RootComponent);
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln(' Persistent ',DbgSName(APersistent),' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' CurMethodName="',CurMethodName,'"');
|
|
{$ENDIF}
|
|
if CurMethodName<>'' then begin
|
|
NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName);
|
|
if NodeExt=nil then begin
|
|
// method not found -> dangling event
|
|
AddDanglingEvent(APersistent,PropInfo);
|
|
end;
|
|
end;
|
|
end;
|
|
end else if (PropType^.Kind=tkClass) then begin
|
|
// RTTI property is class instance
|
|
ObjValue := TObject(GetObjectProp(APersistent, PropInfo));
|
|
if ObjValue is TCollection then begin
|
|
// collection
|
|
|
|
end else if (ObjValue is TPersistent)
|
|
and (not (ObjValue is TComponent)
|
|
or (csSubComponent in TComponent(ObjValue).ComponentStyle))
|
|
then begin
|
|
// sub persistent (e.g. Canvas.Font)
|
|
//debugln(['CheckMethodsInPersistent sub persistent: ',DbgSName(ObjValue)]);
|
|
CheckMethodsInPersistent(TPersistent(ObjValue));
|
|
end;
|
|
end;
|
|
PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1);
|
|
dec(CurCount);
|
|
end;
|
|
TypeInfo:=TypeData^.ParentInfo;
|
|
until TypeInfo=nil;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Collector: TComponentChildCollector;
|
|
AllComponents: TFPList;
|
|
begin
|
|
PublishedMethods:=nil;
|
|
ListOfPInstancePropInfo:=nil;
|
|
Collector:=nil;
|
|
AllComponents:=nil;
|
|
try
|
|
// search all available published methods
|
|
{$IFDEF VerboseDanglingComponentEvents}
|
|
debugln('TStandardCodeTool.FindDanglingComponentEvents A ',MainFilename,' ',DbgSName(RootComponent));
|
|
{$ENDIF}
|
|
Result:=GatherPublishedClassElements(TheClassName,ExceptionOnClassNotFound,
|
|
false,true,false,SearchInAncestors,
|
|
PublishedMethods);
|
|
if not Result then exit;
|
|
// go through all components
|
|
Collector:=TComponentChildCollector.Create;
|
|
AllComponents:=Collector.GetComponents(RootComponent,true);
|
|
for i:=0 to AllComponents.Count-1 do
|
|
CheckMethodsInPersistent(TComponent(AllComponents[i]));
|
|
finally
|
|
Collector.Free;
|
|
NodeExtMemManager.DisposeAVLTree(PublishedMethods);
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.RemoveIdentifierDefinition(
|
|
const CursorPos: TCodeXYPosition; SourceChangeCache: TSourceChangeCache
|
|
): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
Node: TCodeTreeNode;
|
|
PrevSibling: TCodeTreeNode;
|
|
NextSibling: TCodeTreeNode;
|
|
DeleteStartPos: LongInt;
|
|
DeleteEndPos: LongInt;
|
|
DeleteFirstTokenOfLine: Boolean;
|
|
begin
|
|
Result:=false;
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
Node:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
|
|
if Node.Desc in AllIdentifierDefinitions then begin
|
|
// Examples:
|
|
// var i, X: integer; -> var i[, X]: integer;
|
|
// var i, X, j: integer; -> var i, [X, ]j: integer;
|
|
// var X, i: integer; -> var [X, ]i: integer;
|
|
// type X = integer;
|
|
// const X = 0;
|
|
// const X : integer = 0;
|
|
PrevSibling:=nil;
|
|
NextSibling:=nil;
|
|
if (Node.PriorBrother<>nil) and (Node.PriorBrother.FirstChild=nil) then
|
|
PrevSibling:=Node.PriorBrother;
|
|
if (Node.FirstChild=nil) and (Node.NextBrother<>nil) then
|
|
NextSibling:=Node.NextBrother;
|
|
DeleteStartPos:=Node.StartPos;
|
|
DeleteEndPos:=Node.StartPos+GetIdentLen(@Src[Node.StartPos]);
|
|
if NextSibling<>nil then begin
|
|
// var i, X, j: integer; -> var i, [X, ]j: integer;
|
|
// var X, i: integer; -> var [X, ]i: integer;
|
|
MoveCursorToCleanPos(Node.StartPos);
|
|
ReadNextAtom;
|
|
AtomIsIdentifier(true);
|
|
if not ReadNextAtomIsChar(',') then RaiseCharExpectedButAtomFound(',');
|
|
DeleteEndPos:=CurPos.EndPos;
|
|
end else if PrevSibling<>nil then begin
|
|
// var i, X: integer; -> var i[, X]: integer;
|
|
MoveCursorToCleanPos(PrevSibling.StartPos);
|
|
ReadNextAtom;
|
|
AtomIsIdentifier(true);
|
|
if not ReadNextAtomIsChar(',') then RaiseCharExpectedButAtomFound(',');
|
|
DeleteStartPos:=CurPos.StartPos;
|
|
end else begin
|
|
// delete whole declaration
|
|
if (Node.Parent.Desc in AllDefinitionSections)
|
|
and (Node.PriorBrother=nil) and (Node.NextBrother=nil) then begin
|
|
// delete whole section
|
|
DeleteStartPos:=Node.Parent.StartPos;
|
|
DeleteEndPos:=Node.Parent.EndPos;
|
|
end else if Node.Parent.Desc=ctnParameterList then begin
|
|
// delete whole parameter including modifier, type and default value
|
|
if Node.PriorBrother<>nil then begin
|
|
// ... var i: integer; var X: ... -> ... var i: integer[; var X: ...
|
|
MoveCursorToCleanPos(Node.PriorBrother.EndPos);
|
|
repeat
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafSemicolon then begin
|
|
DeleteStartPos:=CurPos.EndPos;
|
|
break;
|
|
end;
|
|
until CurPos.StartPos>=Node.StartPos;
|
|
end else begin
|
|
// (var X: ... -> ([; X: ...
|
|
MoveCursorToCleanPos(Node.Parent.StartPos);
|
|
ReadNextAtom;
|
|
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
|
|
DeleteStartPos:=CurPos.EndPos;
|
|
end;
|
|
if Node.NextBrother<>nil then begin
|
|
// ... var X: integer; var i: ... -> .. var X: integer;] var i: ...
|
|
DeleteEndPos:=Node.PriorBrother.EndPos;
|
|
end else begin
|
|
// ... var X: integer) -> .. var X: integer])
|
|
DeleteEndPos:=Node.EndPos;
|
|
end;
|
|
end else begin
|
|
// keep section, delete whole declaration
|
|
DeleteEndPos:=Node.EndPos;
|
|
end;
|
|
end;
|
|
// include corresponding comments
|
|
DeleteFirstTokenOfLine:=FindFirstNonSpaceCharInLine(Src,DeleteStartPos)=DeleteStartPos;
|
|
//DebugLn(['TStandardCodeTool.RemoveIdentifierDefinition ',dbgstr(copy(Src,FindFirstNonSpaceCharInLine(Src,DeleteStartPos),10))]);
|
|
DeleteEndPos:=FindLineEndOrCodeAfterPosition(DeleteEndPos,true,DeleteFirstTokenOfLine);
|
|
if DeleteFirstTokenOfLine and (Src[DeleteEndPos-1] in [#10,#13]) then begin
|
|
// delete first and last token of line
|
|
// => remove the entire line
|
|
DeleteStartPos:=GetLineStartPosition(Src,DeleteStartPos);
|
|
end;
|
|
//DebugLn(['TStandardCodeTool.RemoveIdentifierDefinition "',dbgstr(copy(Src,DeleteStartPos,DeleteEndPos-DeleteStartPos)),'" IncludeLineEnd=',DeleteFirstTokenOfLine]);
|
|
|
|
// delete
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,DeleteStartPos,DeleteEndPos,'')
|
|
then exit;
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindBlockCounterPart(
|
|
const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
// jump from bracket-open to bracket-close or 'begin' to 'end'
|
|
// or 'until' to 'repeat' ...
|
|
var CleanCursorPos: integer;
|
|
begin
|
|
Result:=false;
|
|
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
|
|
// read word at cursor
|
|
MoveCursorToCleanPos(CleanCursorPos);
|
|
if Src[CurPos.StartPos] in ['(','[','{'] then begin
|
|
// jump forward to matching bracket
|
|
ReadNextAtom;
|
|
if not ReadForwardTilAnyBracketClose then exit;
|
|
end else if Src[CurPos.StartPos] in [')',']','}'] then begin
|
|
// jump backward to matching bracket
|
|
ReadNextAtom;
|
|
if not ReadBackwardTilAnyBracketClose then exit;
|
|
end else begin
|
|
if Src[CurPos.StartPos] in [';','.'] then dec(CurPos.StartPos);
|
|
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
|
dec(CurPos.StartPos);
|
|
MoveCursorToCleanPos(CurPos.StartPos);
|
|
ReadNextAtom;
|
|
if CurPos.EndPos=CurPos.StartPos then exit;
|
|
// read till block keyword counterpart
|
|
if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
|
|
or UpAtomIs('RECORD') or UpAtomIs('TRY') or UpAtomIs('REPEAT') then begin
|
|
// read forward till END, FINALLY, EXCEPT
|
|
ReadTilBlockEnd(true,false);
|
|
end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
|
or UpAtomIs('UNTIL') then
|
|
begin
|
|
// read backward till BEGIN, CASE, ASM, RECORD, REPEAT
|
|
ReadBackTilBlockEnd(true);
|
|
end else
|
|
exit;
|
|
end;
|
|
// CursorPos now contains the counter block keyword
|
|
Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
|
|
end;
|
|
|
|
function TStandardCodeTool.FindBlockStart(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
// jump to beginning of current block
|
|
// e.g. bracket open, 'begin', 'repeat', ...
|
|
var CleanCursorPos: integer;
|
|
begin
|
|
Result:=false;
|
|
// scan code
|
|
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
|
|
// read word at cursor
|
|
MoveCursorToCleanPos(CleanCursorPos);
|
|
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
|
dec(CurPos.StartPos);
|
|
MoveCursorToCleanPos(CurPos.StartPos);
|
|
ReadNextAtom;
|
|
try
|
|
repeat
|
|
ReadPriorAtom;
|
|
if (CurPos.StartPos<0) then begin
|
|
// start of source found -> this is always a block start
|
|
CurPos.StartPos:=1;
|
|
Result:=true;
|
|
exit;
|
|
end
|
|
else if Src[CurPos.StartPos] in [')',']','}'] then begin
|
|
// jump backward to matching bracket
|
|
if not ReadBackwardTilAnyBracketClose then exit;
|
|
end
|
|
else if WordIsBlockStatementStart.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
|
|
begin
|
|
// block start found
|
|
Result:=true;
|
|
exit;
|
|
end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
|
or UpAtomIs('UNTIL') then
|
|
begin
|
|
// read backward till BEGIN, CASE, ASM, RECORD, REPEAT
|
|
ReadBackTilBlockEnd(true);
|
|
end;
|
|
until false;
|
|
finally
|
|
if Result then begin
|
|
// CursorPos now contains the counter block keyword
|
|
Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.GuessUnclosedBlock(const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
{ search a block (e.g. begin..end) that looks unclosed, i.e. 'begin'
|
|
without 'end' or 'begin' with 'end' in a different column.
|
|
This function can be used as GuessNextUnclosedBlock, because it ignores blocks
|
|
in front of CursorPos.
|
|
|
|
Examples for good blocks:
|
|
|
|
repeat
|
|
until
|
|
|
|
begin end // start and end of block in the same line
|
|
|
|
if expr then begin // first char in line is relevant, not the block keyword
|
|
end
|
|
|
|
class;
|
|
|
|
|
|
Examples for bad blocks:
|
|
|
|
begin // block start and end has different indenting
|
|
end
|
|
|
|
asm // 'end.' is source end, never asm end
|
|
end.
|
|
|
|
try // different indenting
|
|
finally
|
|
|
|
repeat // keywords do not match
|
|
end
|
|
|
|
}
|
|
var CleanCursorPos: integer;
|
|
begin
|
|
Result:=false;
|
|
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
|
|
// start reading at beginning of code
|
|
MoveCursorToCleanPos(1);
|
|
BuildBlockKeyWordFuncList;
|
|
if ReadTilGuessedUnclosedBlock(CleanCursorPos,false) then
|
|
Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
|
|
//WriteDebugTreeReport;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindBlockCleanBounds(
|
|
const CursorPos: TCodeXYPosition; out BlockCleanStart, BlockCleanEnd: integer
|
|
): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
BlockStartFound: Boolean;
|
|
begin
|
|
Result:=false;
|
|
BlockCleanStart:=0;
|
|
BlockCleanEnd:=0;
|
|
// scan code
|
|
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
|
|
// read word at cursor
|
|
MoveCursorToCleanPos(CleanCursorPos);
|
|
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
|
dec(CurPos.StartPos);
|
|
MoveCursorToCleanPos(CurPos.StartPos);
|
|
ReadNextAtom;
|
|
BlockStartFound:=false;
|
|
repeat
|
|
ReadPriorAtom;
|
|
if (CurPos.StartPos<0) then begin
|
|
// start of source found -> this is always a block start
|
|
CurPos.StartPos:=1;
|
|
BlockStartFound:=true;
|
|
break;
|
|
end
|
|
else if Src[CurPos.StartPos] in [')',']','}'] then begin
|
|
// jump backward to matching bracket
|
|
if not ReadBackwardTilAnyBracketClose then exit;
|
|
end
|
|
else if WordIsBlockStatementStart.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
|
|
begin
|
|
// block start found
|
|
BlockStartFound:=true;
|
|
break;
|
|
end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
|
or UpAtomIs('UNTIL') then
|
|
begin
|
|
// read backward till BEGIN, CASE, ASM, RECORD, REPEAT
|
|
ReadBackTilBlockEnd(true);
|
|
end;
|
|
until false;
|
|
if not BlockStartFound then exit;
|
|
BlockCleanStart:=CurPos.StartPos;
|
|
|
|
// read word at cursor
|
|
MoveCursorToCleanPos(BlockCleanStart);
|
|
if Src[CurPos.StartPos] in ['(','[','{'] then begin
|
|
// jump forward to matching bracket
|
|
ReadNextAtom;
|
|
if not ReadForwardTilAnyBracketClose then exit;
|
|
end else begin
|
|
if Src[CurPos.StartPos] in [';','.'] then dec(CurPos.StartPos);
|
|
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
|
dec(CurPos.StartPos);
|
|
MoveCursorToCleanPos(CurPos.StartPos);
|
|
ReadNextAtom;
|
|
if CurPos.EndPos=CurPos.StartPos then exit;
|
|
// read till block keyword counterpart
|
|
if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
|
|
or UpAtomIs('RECORD') or UpAtomIs('TRY') or UpAtomIs('REPEAT') then begin
|
|
// read forward till END, FINALLY, EXCEPT
|
|
ReadTilBlockEnd(true,false);
|
|
end else
|
|
exit;
|
|
end;
|
|
BlockCleanEnd:=CurPos.StartPos;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.CompleteBlock(const CursorPos: TCodeXYPosition;
|
|
SourceChangeCache: TSourceChangeCache; OnlyIfCursorBlockIndented: boolean;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
{ For example:
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
begin
|
|
|
|
|
...
|
|
something
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
if then begin
|
|
|
|
|
...
|
|
something
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
begin
|
|
|
|
|
|
|
procedure
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
Statements:
|
|
begin: end;
|
|
asm: end;
|
|
try: finally end;
|
|
finally: end;
|
|
except: end;
|
|
repeat: until ;
|
|
case of: end;
|
|
case :: ;
|
|
case else: end;
|
|
(: )
|
|
[: ]
|
|
|
|
Types:
|
|
(: )
|
|
[: ]
|
|
record: end;
|
|
class: end;
|
|
object: end;
|
|
interface: end;
|
|
}
|
|
type
|
|
TBlockType = (
|
|
btNone,
|
|
btBegin,
|
|
btAsm,
|
|
btEdgedBracket,
|
|
btRoundBracket,
|
|
btTry,
|
|
btFinally,
|
|
btExcept,
|
|
btCase,
|
|
btCaseOf,
|
|
btCaseColon,
|
|
btCaseElse,
|
|
btRepeat,
|
|
btIf,
|
|
btIfElse,
|
|
btClass,
|
|
btInterface,
|
|
btObject,
|
|
btRecord
|
|
);
|
|
TBlock = record
|
|
Typ: TBlockType;
|
|
StartPos: integer;
|
|
InnerIndent: integer;
|
|
InnerStartPos: integer;
|
|
end;
|
|
PBlock = ^TBlock;
|
|
TBlockStack = record
|
|
Stack: PBlock;
|
|
Capacity: integer;
|
|
Top: integer;
|
|
end;
|
|
TExBool = (ebNone, ebTrue, ebFalse);
|
|
var
|
|
CleanCursorPos: integer;
|
|
StartNode: TCodeTreeNode;
|
|
InternalCursorAtEmptyLine: TExBool;
|
|
|
|
function CursorAtEmptyLine: Boolean;
|
|
// true if cursor in empty line or at line end in front of an empty line
|
|
var
|
|
p: LongInt;
|
|
begin
|
|
if InternalCursorAtEmptyLine=ebNone then begin
|
|
if (CleanCursorPos>SrcLen) or InEmptyLine(Src,CleanCursorPos) then
|
|
InternalCursorAtEmptyLine:=ebTrue
|
|
else begin
|
|
p:=CleanCursorPos;
|
|
while (p<=SrcLen) do begin
|
|
case Src[p] of
|
|
' ',#9: inc(p);
|
|
#10,#13:
|
|
begin
|
|
// after cursor the rest of the line is blank
|
|
// check the next line
|
|
inc(p);
|
|
if (p<=SrcLen) and (Src[p] in [#10,#13]) and (Src[p]<>Src[p-1]) then
|
|
inc(p);
|
|
if (p>SrcLen) or InEmptyLine(Src,p) then
|
|
InternalCursorAtEmptyLine:=ebTrue
|
|
else
|
|
InternalCursorAtEmptyLine:=ebFalse;
|
|
break;
|
|
end;
|
|
else
|
|
InternalCursorAtEmptyLine:=ebFalse;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Result:=InternalCursorAtEmptyLine=ebTrue;
|
|
end;
|
|
|
|
procedure InitStack(out Stack: TBlockStack);
|
|
begin
|
|
FillByte(Stack,SizeOf(Stack),0);
|
|
Stack.Top:=-1;
|
|
end;
|
|
|
|
procedure FreeStack(var Stack: TBlockStack);
|
|
begin
|
|
ReAllocMem(Stack.Stack,0);
|
|
Stack.Capacity:=0;
|
|
Stack.Top:=-1;
|
|
end;
|
|
|
|
procedure BeginBlock(var Stack: TBlockStack; Typ: TBlockType;
|
|
StartPos: integer);
|
|
var
|
|
Block: PBlock;
|
|
begin
|
|
inc(Stack.Top);
|
|
if Stack.Top>=Stack.Capacity then begin
|
|
if Stack.Capacity=0 then
|
|
Stack.Capacity:=16
|
|
else
|
|
Stack.Capacity:=Stack.Capacity*2;
|
|
ReAllocMem(Stack.Stack,SizeOf(TBlock)*Stack.Capacity);
|
|
end;
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn([GetIndentStr(Stack.Top*2),'BeginBlock ',CleanPosToStr(StartPos),' ',GetAtom]);
|
|
{$ENDIF}
|
|
Block:=@Stack.Stack[Stack.Top];
|
|
Block^.Typ:=Typ;
|
|
Block^.StartPos:=StartPos;
|
|
Block^.InnerIndent:=-1;
|
|
Block^.InnerStartPos:=-1;
|
|
end;
|
|
|
|
procedure EndBlock(var Stack: TBlockStack);
|
|
begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn([GetIndentStr(Stack.Top*2),'EndBlock ',GetAtom,' ',CleanPosToStr(CurPos.StartPos),', started at ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
{$ENDIF}
|
|
dec(Stack.Top);
|
|
end;
|
|
|
|
function TopBlockType(const Stack: TBlockStack): TBlockType;
|
|
begin
|
|
if Stack.Top>=0 then
|
|
Result:=Stack.Stack[Stack.Top].Typ
|
|
else
|
|
Result:=btNone;
|
|
end;
|
|
|
|
function Replace(NewCode: string; FromPos, ToPos, Indent: integer;
|
|
FrontGap, AfterGap: TGapTyp; BeautifyFlags: TBeautifyCodeFlags): boolean;
|
|
var
|
|
p: LongInt;
|
|
begin
|
|
if NewCode='' then exit(true);
|
|
// avoid changing current line
|
|
if (FrontGap=gtEmptyLine) then begin
|
|
p:=FromPos;
|
|
while (p>1) and (Src[p-1] in [' ',#9]) do dec(p);
|
|
if (p=1) or (Src[p] in [#10,#13]) then begin
|
|
while (p<=SrcLen) and (Src[p] in [' ',#9]) do inc(p);
|
|
if (p>SrcLen) or (Src[p] in [#10,#13]) then begin
|
|
// inserting in an empty line
|
|
inc(p);
|
|
if (p<=SrcLen) and (Src[p] in [#10,#13]) and (Src[p]<>Src[p-1]) then
|
|
inc(p);
|
|
FrontGap:=gtNewLine;
|
|
FromPos:=p;
|
|
if ToPos<FromPos then ToPos:=FromPos;
|
|
end;
|
|
end;
|
|
end;
|
|
// replace trailing spaces
|
|
while (ToPos<=SrcLen) and (Src[ToPos] in [' ',#9]) do inc(ToPos);
|
|
// use existing semicolon
|
|
if (NewCode[length(NewCode)]=';')
|
|
and (ToPos<=SrcLen) and (Src[ToPos]=';') then begin
|
|
AfterGap:=gtNone;
|
|
inc(ToPos);
|
|
end;
|
|
// use existing "else"
|
|
if (NewCode[length(NewCode)]=';') then begin
|
|
MoveCursorToCleanPos(ToPos);
|
|
ReadNextAtom;
|
|
if UpAtomIs('ELSE') then
|
|
NewCode:=copy(NewCode,1,length(NewCode)-1);
|
|
end;
|
|
|
|
// adjust indent of first line
|
|
if FrontGap in [gtNone,gtSpace] then begin
|
|
BeautifyFlags:=BeautifyFlags+[bcfDoNotIndentFirstLine];
|
|
NewCode:=GetIndentStr(Indent-GetPosInLine(Src,FromPos))+NewCode;
|
|
end;
|
|
// beautify
|
|
NewCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
|
|
NewCode,Indent,BeautifyFlags);
|
|
|
|
if AfterGap=gtNewLine then begin
|
|
// do not reuse existing newline, but always add newline
|
|
NewCode:=NewCode+SourceChangeCache.BeautifyCodeOptions.LineEnd;
|
|
if (ToPos<SrcLen) and (not (Src[ToPos] in [#10,#13])) then
|
|
NewCode:=NewCode+GetIndentStr(GetLineIndent(Src,ToPos));
|
|
AfterGap:=gtNone;
|
|
end;
|
|
{$IFDEF ShowCompleteBlock}
|
|
debugln(['Replace Indent=',Indent,' NewCode="',dbgstr(NewCode),'" Replace="',DbgStr(copy(Src,FromPos-5,5)),'|',dbgstr(copy(Src,FromPos,ToPos-FromPos)),'|',dbgstr(copy(Src,ToPos,5)),'"']);
|
|
{$ENDIF}
|
|
// insert
|
|
if not SourceChangeCache.Replace(FrontGap,AfterGap,
|
|
FromPos,ToPos,NewCode) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function CompleteStatements(var Stack: TBlockStack): Boolean;
|
|
var
|
|
CursorBlockLvl: Integer; // the stack level of the cursor
|
|
LastPos: Integer;
|
|
LineStart: boolean; // Atom is first atom of a line in cursor block (not in sub block)
|
|
Indent: Integer;
|
|
CursorBlockInnerIndent, CursorBlockOuterIndent: LongInt;
|
|
CursorBlock: TBlock;
|
|
AtomInFrontOfCursor: TAtomPosition;
|
|
BehindCursorBlock: Boolean; // atom is behind cursor block
|
|
InCursorBlock: Boolean;
|
|
NeedCompletion: integer;
|
|
InsertPos: LongInt;
|
|
NewCode: String;
|
|
AfterGap: TGapTyp;
|
|
FrontGap: TGapTyp;
|
|
BeautifyFlags: TBeautifyCodeFlags;
|
|
BehindPos: LongInt;
|
|
CursorInEmptyStatement: Boolean;
|
|
FromPos: LongInt;
|
|
ToPos: LongInt;
|
|
WasInCursorBlock: Boolean;
|
|
|
|
function EndBlockIsOk: boolean;
|
|
begin
|
|
//DebugLn(['EndBlockIsOk ']);
|
|
if (NeedCompletion>0) and (CursorBlockLvl>=0)
|
|
and (Stack.Top=CursorBlockLvl)
|
|
and (GetLineIndent(Src,CurPos.StartPos)=CursorBlockOuterIndent) then begin
|
|
// cursor block is properly closed => do not complete
|
|
{$IFDEF ShowCompleteBlock}
|
|
debugln(['EndBlockIsOk cursor block is properly closed at ',CleanPosToStr(CurPos.StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=0;
|
|
end;
|
|
EndBlock(Stack);
|
|
Result:=true;
|
|
if (not BehindCursorBlock) and (Stack.Top<CursorBlockLvl) then
|
|
BehindCursorBlock:=true;
|
|
end;
|
|
|
|
function CloseBrackets: boolean;
|
|
begin
|
|
while TopBlockType(Stack) in [btRoundBracket,btEdgedBracket] do begin
|
|
if not EndBlockIsOk then exit(false);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function InsertPosAtCursor: integer;
|
|
begin
|
|
Result:=BasicCodeTools.FindLineEndOrCodeInFrontOfPosition(Src,
|
|
CurPos.StartPos,CleanCursorPos,Scanner.NestedComments);
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
MoveCursorToNodeStart(StartNode);
|
|
CursorBlockLvl:=-2;
|
|
LastPos:=-1;
|
|
CursorBlockOuterIndent:=0;
|
|
CursorBlockInnerIndent:=0;
|
|
Indent:=0;
|
|
CursorBlock.StartPos:=0;
|
|
BehindCursorBlock:=false;
|
|
NeedCompletion:=0;
|
|
AtomInFrontOfCursor.StartPos:=0;
|
|
CursorInEmptyStatement:=false;
|
|
repeat
|
|
ReadNextAtom;
|
|
|
|
//DebugLn(['ReadStatements Atom=',GetAtom,' TopTyp=',ord(TopBlockType(Stack)),' Top=',Stack.Top]);
|
|
if (Stack.Top>=0) and (Stack.Stack[Stack.Top].InnerIndent<0)
|
|
and (not PositionsInSameLine(Src,Stack.Stack[Stack.Top].StartPos,CurPos.StartPos))
|
|
then begin
|
|
// the first atom of this block is on a new line
|
|
Stack.Stack[Stack.Top].InnerIndent:=GetLineIndent(Src,CurPos.StartPos);
|
|
Stack.Stack[Stack.Top].InnerStartPos:=CurPos.StartPos;
|
|
end;
|
|
|
|
// check if cursor reached
|
|
if (CurPos.StartPos>=CleanCursorPos) and (CursorBlockLvl<0) then begin
|
|
// reached cursor
|
|
CursorBlockLvl:=Stack.Top;
|
|
if CursorBlockLvl<0 then begin
|
|
// cursor outside blocks or on first atom of first block
|
|
exit;
|
|
end else begin
|
|
CursorBlock:=Stack.Stack[CursorBlockLvl];
|
|
CursorBlockOuterIndent:=GetLineIndent(Src,CursorBlock.StartPos);
|
|
CursorBlockInnerIndent:=Stack.Stack[Stack.Top].InnerIndent;
|
|
if (CursorBlockInnerIndent<=CursorBlockOuterIndent)
|
|
and OnlyIfCursorBlockIndented then begin
|
|
// cursor block not indented
|
|
exit;
|
|
end;
|
|
AtomInFrontOfCursor:=LastAtoms.GetValueAt(0);
|
|
if (CurPos.Flag=cafSemicolon)
|
|
and ((AtomInFrontOfCursor.Flag=cafSemicolon)
|
|
or (CursorBlock.StartPos=AtomInFrontOfCursor.StartPos))
|
|
and (FindNextNonSpace(Src,AtomInFrontOfCursor.EndPos)=CurPos.StartPos)
|
|
then begin
|
|
// cursor in empty statement
|
|
CursorInEmptyStatement:=true;
|
|
end;
|
|
end;
|
|
//DebugLn(['ReadStatements CursorBlockLvl=',CursorBlockLvl,' Indent=',CursorBlockIndent]);
|
|
end;
|
|
|
|
InCursorBlock:=(CursorBlockLvl>=0) and (CursorBlockLvl=Stack.Top)
|
|
and (not BehindCursorBlock);
|
|
WasInCursorBlock:=InCursorBlock;
|
|
|
|
// check if end of node
|
|
if (CurPos.StartPos>SrcLen) or (CurPos.StartPos>=StartNode.EndPos) then
|
|
begin
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: source end found at ',CleanPosToStr(CurPos.StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
break;
|
|
end;
|
|
|
|
// check if line start vs outer indent
|
|
LineStart:=InCursorBlock and (LastPos>0)
|
|
and not PositionsInSameLine(Src,LastPos,CurPos.StartPos);
|
|
if LineStart then
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos);
|
|
|
|
if LineStart and (NeedCompletion=0) then begin
|
|
// atom is in same block as cursor (not sub block)
|
|
// and first atom of a line
|
|
// => check indent
|
|
if (Indent=CursorBlockOuterIndent) then begin
|
|
if (CursorBlockLvl>0)
|
|
and (Stack.Stack[CursorBlockLvl-1].InnerIndent=Indent)
|
|
and (Stack.Stack[CursorBlockLvl-1].InnerStartPos<CurPos.StartPos)
|
|
then begin
|
|
{ for example:
|
|
Code;
|
|
begin|
|
|
Code;
|
|
}
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: between same indented ',CleanPosToStr(CurPos.StartPos),' Indent=',Indent,' < CursorBlockOuterIndent=',CursorBlockOuterIndent,' < CursorBlockInnerIndent=',CursorBlockInnerIndent,' Parent.InnerStartPos=',CleanPosToStr(Stack.Stack[CursorBlockLvl-1].InnerStartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=InsertPosAtCursor;
|
|
end;
|
|
end else if (Indent<CursorBlockOuterIndent) then begin
|
|
// for example:
|
|
// begin
|
|
// Code;
|
|
// |end;
|
|
//DebugLn(['ReadStatements Indent=',Indent,' < CursorBlockOuterIndent=',CursorBlockOuterIndent,' CursorBlockInnerIndent=',CursorBlockInnerIndent,' CursorAtEmptyLine=',CursorAtEmptyLine,' CursorInEmptyStatement=',CursorInEmptyStatement]);
|
|
if CursorBlockOuterIndent<CursorBlockInnerIndent then begin
|
|
// for example:
|
|
// begin
|
|
// Code;
|
|
// |end;
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: at out indented ',CleanPosToStr(CurPos.StartPos),' Indent=',Indent,' < CursorBlockOuterIndent=',CursorBlockOuterIndent,' < CursorBlockInnerIndent=',CursorBlockInnerIndent]);
|
|
{$ENDIF}
|
|
NeedCompletion:=InsertPosAtCursor;
|
|
end else if CursorAtEmptyLine or CursorInEmptyStatement
|
|
or (FindNextNonSpace(Src,CleanCursorPos)=CurPos.StartPos) then begin
|
|
{ for example:
|
|
begin
|
|
|
|
|
Code;
|
|
end;
|
|
|
|
begin
|
|
Code;
|
|
|
|
|
end;
|
|
}
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: at empty line ',CleanPosToStr(CleanCursorPos),' Indent=',Indent,' < CursorBlockOuterIndent=',CursorBlockOuterIndent,' < CursorBlockInnerIndent=',CursorBlockInnerIndent]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end else begin
|
|
{ It needs completion, but where?
|
|
for example:
|
|
begin
|
|
begin|
|
|
Code;
|
|
end;
|
|
}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// check block starts/ends
|
|
case CurPos.Flag of
|
|
cafEnd:
|
|
if (CurPos.EndPos<=SrcLen) and (Src[CurPos.EndPos]='.') then begin
|
|
if (Stack.Top=0) and (TopBlockType(Stack)=btBegin)
|
|
and (StartNode.Desc=ctnBeginBlock)
|
|
and ((StartNode.Parent=nil) or (StartNode.Parent.Desc in AllSourceTypes))
|
|
then begin
|
|
if not EndBlockIsOk then exit; // close main begin
|
|
end else begin
|
|
// unexpected end of source
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements unexpected end. at ',CleanPosToStr(CurPos.StartPos)]);
|
|
{$ENDIF}
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected end. at ',CleanPosToStr(CurPos.StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
end;
|
|
break;
|
|
end else begin
|
|
case TopBlockType(Stack) of
|
|
btCaseOf,btCaseElse:
|
|
begin
|
|
if not EndBlockIsOk then exit; // close btCaseOf,btCaseElse
|
|
if not EndBlockIsOk then exit; // close btCase
|
|
end;
|
|
btBegin,btFinally,btExcept,btCase:
|
|
if not EndBlockIsOk then exit;
|
|
btCaseColon,btRepeat:
|
|
begin
|
|
// missing semicolon or until
|
|
DebugLn(['ReadStatements CursorBlockLvl=',CursorBlockLvl,' Stack.Top=',Stack.Top,' BehindCursorBlock=',BehindCursorBlock]);
|
|
DebugLn(['ReadStatements unexpected end at ',CleanPosToStr(CurPos.StartPos),': missing finally ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected end at ',CleanPosToStr(CurPos.StartPos),': missing semicolon or until ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
break;
|
|
end;
|
|
btTry:
|
|
begin
|
|
// missing finally/except
|
|
DebugLn(['ReadStatements CursorBlockLvl=',CursorBlockLvl,' Stack.Top=',Stack.Top,' BehindCursorBlock=',BehindCursorBlock]);
|
|
DebugLn(['ReadStatements unexpected end at ',CleanPosToStr(CurPos.StartPos),': missing finally ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected end at ',CleanPosToStr(CurPos.StartPos),': missing finally ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
break;
|
|
end;
|
|
btAsm:
|
|
if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]<>'@') then begin
|
|
if not EndBlockIsOk then exit;
|
|
end;
|
|
else
|
|
// missing begin
|
|
exit;
|
|
end;
|
|
end;
|
|
cafEdgedBracketOpen:
|
|
BeginBlock(Stack,btEdgedBracket,CurPos.StartPos);
|
|
cafEdgedBracketClose:
|
|
if TopBlockType(Stack)=btEdgedBracket then begin
|
|
if not EndBlockIsOk then exit;
|
|
end else begin
|
|
// missing [
|
|
exit;
|
|
end;
|
|
cafRoundBracketOpen:
|
|
BeginBlock(Stack,btRoundBracket,CurPos.StartPos);
|
|
cafRoundBracketClose:
|
|
if TopBlockType(Stack)=btRoundBracket then begin
|
|
if not EndBlockIsOk then exit;
|
|
end else begin
|
|
// missing (
|
|
exit;
|
|
end;
|
|
cafColon:
|
|
if TopBlockType(Stack)=btCaseOf then
|
|
BeginBlock(Stack,btCaseColon,CurPos.StartPos);
|
|
cafSemicolon:
|
|
while TopBlockType(Stack)
|
|
in [btCaseColon,btIf,btIfElse,btRoundBracket,btEdgedBracket] do begin
|
|
if not EndBlockIsOk then exit;
|
|
end;
|
|
cafWord:
|
|
if TopBlockType(Stack)<>btAsm then begin
|
|
if UpAtomIs('BEGIN') then
|
|
BeginBlock(Stack,btBegin,CurPos.StartPos)
|
|
else if UpAtomIs('TRY') then
|
|
BeginBlock(Stack,btTry,CurPos.StartPos)
|
|
else if UpAtomIs('FINALLY') then begin
|
|
if TopBlockType(Stack)=btTry then
|
|
if not EndBlockIsOk then exit;
|
|
BeginBlock(Stack,btFinally,CurPos.StartPos)
|
|
end else if UpAtomIs('EXCEPT') then begin
|
|
if TopBlockType(Stack)=btTry then
|
|
if not EndBlockIsOk then exit;
|
|
BeginBlock(Stack,btExcept,CurPos.StartPos)
|
|
end else if UpAtomIs('REPEAT') then
|
|
BeginBlock(Stack,btRepeat,CurPos.StartPos)
|
|
else if UpAtomIs('UNTIL') then begin
|
|
if TopBlockType(Stack)=btRepeat then begin
|
|
if not EndBlockIsOk then exit;
|
|
end else begin
|
|
// until without repeat
|
|
DebugLn(['ReadStatements CursorBlockLvl=',CursorBlockLvl,' Stack.Top=',Stack.Top,' BehindCursorBlock=',BehindCursorBlock,' Block=',ord(TopBlockType(Stack))]);
|
|
DebugLn(['ReadStatements unexpected until at ',CleanPosToStr(CurPos.StartPos)]);
|
|
exit;
|
|
end;
|
|
end else if UpAtomIs('ASM') then begin
|
|
BeginBlock(Stack,btAsm,CurPos.StartPos);
|
|
end else if UpAtomIs('IF') then begin
|
|
BeginBlock(Stack,btIf,CurPos.StartPos);
|
|
end else if UpAtomIs('THEN') then begin
|
|
CloseBrackets;
|
|
if TopBlockType(Stack)=btIf then begin
|
|
Stack.Stack[Stack.Top].InnerIndent:=-1;
|
|
Stack.Stack[Stack.Top].InnerStartPos:=-1;
|
|
end;
|
|
end else if UpAtomIs('CASE') then begin
|
|
BeginBlock(Stack,btCase,CurPos.StartPos)
|
|
end else if UpAtomIs('OF') then begin
|
|
CloseBrackets;
|
|
if TopBlockType(Stack)=btCase then
|
|
BeginBlock(Stack,btCaseOf,CurPos.StartPos);
|
|
end else if UpAtomIs('ELSE') then begin
|
|
CloseBrackets;
|
|
case TopBlockType(Stack) of
|
|
btIf:
|
|
begin
|
|
if not EndBlockIsOk then exit;
|
|
BeginBlock(Stack,btIfElse,CurPos.StartPos);
|
|
end;
|
|
btCaseOf:
|
|
begin
|
|
if not EndBlockIsOk then exit;
|
|
BeginBlock(Stack,btCaseElse,CurPos.StartPos);
|
|
end;
|
|
btBegin:
|
|
begin
|
|
// missing end
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected else at ',CleanPosToStr(CurPos.StartPos),': missing end. block start: ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=InsertPosAtCursor;
|
|
end;
|
|
break;
|
|
end;
|
|
btCaseColon,btRepeat:
|
|
begin
|
|
// missing semicolon
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected else at ',CleanPosToStr(CurPos.StartPos),': missing semicolon or until. block start: ',CleanPosToStr(Stack.Stack[Stack.Top].StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=InsertPosAtCursor;
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
end else if UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION')
|
|
or UpAtomIs('CONSTRUCTOR') or UpAtomIs('DESTRUCTOR')
|
|
or UpAtomIs('VAR') or UpAtomIs('TYPE') or UpAtomIs('CONST')
|
|
or UpAtomIs('RESOURCESTRING') or UpAtomIs('LABEL') or UpAtomIs('CLASS')
|
|
or UpAtomIs('INITIALIZATION') or UpAtomIs('FINALIZATION')
|
|
then begin
|
|
// unexpected keyword => block not closed
|
|
if InCursorBlock and (NeedCompletion=0) then begin
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: unexpected keyword ',GetAtom,' at ',CleanPosToStr(CurPos.StartPos)]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// check if line start
|
|
if LineStart and WasInCursorBlock and (not BehindCursorBlock) then begin
|
|
// atom is first atom of a line
|
|
// and atom is in same block as cursor (not sub block)
|
|
// (maybe the atom started a new sub block, but it did not close it)
|
|
// => check indent
|
|
//debugln(['CompleteStatements ',CleanPosToStr(CurPos.StartPos),' Indent=',Indent,' CursorBlockInnerIndent=',CursorBlockInnerIndent,' CursorBlockOuterIndent=',CursorBlockOuterIndent]);
|
|
if (Indent<CursorBlockInnerIndent) and (NeedCompletion=0) then begin
|
|
if CursorBlockOuterIndent<CursorBlockInnerIndent then begin
|
|
// for example:
|
|
// begin
|
|
// Code;
|
|
// |
|
|
// Code;
|
|
// Code;
|
|
//DebugLn(['ReadStatements Indent=',Indent,' < CursorBlockIndent=',CursorBlockIndent]);
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: at ',CleanPosToStr(CurPos.StartPos),' Indent=',Indent,' < CursorBlockInnerIndent=',CursorBlockInnerIndent]);
|
|
{$ENDIF}
|
|
NeedCompletion:=InsertPosAtCursor;
|
|
end else begin
|
|
// for example:
|
|
// begin
|
|
// |
|
|
// Code;
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements NeedCompletion: at ',CleanPosToStr(CleanCursorPos),' Indent=',Indent,' CursorBlockInnerIndent=',CursorBlockInnerIndent]);
|
|
{$ENDIF}
|
|
NeedCompletion:=CleanCursorPos;
|
|
// Note: if the end is coming later, NeedCompletion is disabled
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
LastPos:=CurPos.StartPos;
|
|
until Stack.Top<0;
|
|
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['ReadStatements END Stack.Top=',Stack.Top,' CursorBlockLvl=',CursorBlockLvl,' BehindCursorBlock=',BehindCursorBlock]);
|
|
{$ENDIF}
|
|
|
|
if Stack.Top<0 then begin
|
|
// all blocks closed
|
|
{$IFDEF ShowCompleteBlock}
|
|
if NeedCompletion>0 then
|
|
DebugLn(['ReadStatements all blocks closed: no completion needed']);
|
|
{$ENDIF}
|
|
NeedCompletion:=0;
|
|
end;
|
|
|
|
if (NeedCompletion>0) then begin
|
|
InsertPos:=NeedCompletion;
|
|
while (InsertPos>CleanCursorPos) and (IsSpaceChar[Src[InsertPos-1]]) do
|
|
dec(InsertPos);
|
|
Indent:=CursorBlockOuterIndent;
|
|
|
|
// check code behind
|
|
BehindPos:=FindNextNonSpace(Src,InsertPos);
|
|
if BehindPos<=SrcLen then begin
|
|
if (not CursorInEmptyStatement)
|
|
and PositionsInSameLine(Src,InsertPos,BehindPos) then begin
|
|
// target line not empty
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['CompleteStatements target line not empty => skip']);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
if (GetLineIndent(Src,BehindPos)>Indent) then begin
|
|
// code behind is more indented
|
|
// for example
|
|
// repeat
|
|
// |
|
|
// DoSomething;
|
|
debugln(['CompleteStatements BehindPos ',dbgstr(copy(Src,BehindPos-8,8)),'|',dbgstr(copy(Src,BehindPos,8))]);
|
|
{$IFDEF ShowCompleteBlock}
|
|
DebugLn(['CompleteStatements code behind is indented more (Behind=',GetLineIndent(Src,BehindPos),' > Indent=',Indent,') => skip']);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
NewCode:=';';
|
|
FrontGap:=gtEmptyLine;
|
|
AfterGap:=gtNewLine;
|
|
FromPos:=InsertPos;
|
|
ToPos:=InsertPos;
|
|
BeautifyFlags:=[bcfIndentExistingLineBreaks];
|
|
if CursorInEmptyStatement and (BehindPos<=SrcLen) then begin
|
|
// replace the empty statement
|
|
FrontGap:=gtNewLine;
|
|
ToPos:=BehindPos;
|
|
end;
|
|
case CursorBlock.Typ of
|
|
btBegin,btFinally,btExcept,btAsm,btCaseOf,btCaseElse:
|
|
NewCode:='end'+NewCode;
|
|
btRepeat:
|
|
NewCode:='until '+NewCode;
|
|
btTry:
|
|
NewCode:='finally'+SourceChangeCache.BeautifyCodeOptions.LineEnd
|
|
+'end'+NewCode;
|
|
btCaseColon:
|
|
begin
|
|
FrontGap:=gtNone;
|
|
AfterGap:=gtNone;
|
|
end;
|
|
else
|
|
exit;
|
|
end;
|
|
if (CursorBlockLvl=0) and (AfterGap=gtNewLine) then begin
|
|
// top level => insert empty lines between top level structures
|
|
AfterGap:=gtEmptyLine;
|
|
end;
|
|
if not Replace(NewCode,FromPos,ToPos,Indent,FrontGap,AfterGap,
|
|
BeautifyFlags) then exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function CompleteClassSection(var Stack: TBlockStack): Boolean;
|
|
{ type
|
|
TMyClass = class
|
|
|
|
|
}
|
|
var
|
|
LastIndent: LongInt;
|
|
Indent: LongInt;
|
|
InsertPos: LongInt;
|
|
NeedCompletion: Integer;
|
|
begin
|
|
Result:=false;
|
|
if CleanCursorPos<StartNode.StartPos then exit;
|
|
LastIndent:=GetLineIndent(Src,StartNode.Parent.StartPos);
|
|
MoveCursorToNodeStart(StartNode);
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos);
|
|
if Indent<LastIndent then
|
|
LastIndent:=Indent;
|
|
ReadNextAtom;
|
|
NeedCompletion:=0;
|
|
if CurPos.Flag=cafWord then begin
|
|
if AtomIsIdentifier(false) then begin
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafEqual then begin
|
|
{ For example:
|
|
TMyClass = class
|
|
|
|
TIdentifier =
|
|
}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end else
|
|
exit(true);
|
|
end else begin
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos);
|
|
if Indent<LastIndent then begin
|
|
{ For example:
|
|
TMyClass = class
|
|
|
|
type
|
|
}
|
|
NeedCompletion:=CleanCursorPos;
|
|
end;
|
|
end;
|
|
end else
|
|
exit(true);
|
|
|
|
if NeedCompletion>0 then begin
|
|
InsertPos:=NeedCompletion;
|
|
Result:=Replace('end;',InsertPos,InsertPos,LastIndent,
|
|
gtNewLine,gtEmptyLine,
|
|
[bcfIndentExistingLineBreaks]);
|
|
end else
|
|
Result:=true;
|
|
end;
|
|
|
|
function CompleteClassInterface(var Stack: TBlockStack): Boolean;
|
|
{ type
|
|
TMyClass = interface
|
|
|
|
|
}
|
|
var
|
|
LastIndent: LongInt;
|
|
Indent: LongInt;
|
|
InsertPos: LongInt;
|
|
begin
|
|
Result:=false;
|
|
if CleanCursorPos<StartNode.StartPos then exit;
|
|
LastIndent:=GetLineIndent(Src,StartNode.StartPos);
|
|
MoveCursorToNodeStart(StartNode);
|
|
ReadNextAtom;
|
|
if CleanCursorPos<CurPos.EndPos then exit(true);
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafEnd then exit(true);
|
|
if CleanCursorPos<=CurPos.StartPos then begin
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos);
|
|
InsertPos:=CleanCursorPos;
|
|
if Indent<LastIndent then begin
|
|
if not Replace('end;',InsertPos,InsertPos,LastIndent,
|
|
gtNewLine,gtEmptyLine,
|
|
[bcfIndentExistingLineBreaks])
|
|
then
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function CompleteRecord(var Stack: TBlockStack): Boolean;
|
|
{ type
|
|
TMyClass = record
|
|
|
|
|
}
|
|
var
|
|
LastIndent: LongInt;
|
|
Indent: LongInt;
|
|
InsertPos: LongInt;
|
|
begin
|
|
Result:=false;
|
|
if CleanCursorPos<StartNode.StartPos then exit;
|
|
LastIndent:=GetLineIndent(Src,StartNode.StartPos);
|
|
MoveCursorToNodeStart(StartNode);
|
|
ReadNextAtom; // record
|
|
if CleanCursorPos<CurPos.EndPos then exit(true);
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafEnd then exit(true);
|
|
if CleanCursorPos<=CurPos.StartPos then begin
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos);
|
|
InsertPos:=CleanCursorPos;
|
|
if Indent<=LastIndent then begin
|
|
if not Replace('end;',InsertPos,InsertPos,LastIndent,
|
|
gtNewLine,gtEmptyLine,
|
|
[bcfIndentExistingLineBreaks])
|
|
then
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
var
|
|
Stack: TBlockStack;
|
|
begin
|
|
Result:=false;
|
|
NewPos:=CursorPos;
|
|
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
|
|
[btSetIgnoreErrorPos]);
|
|
StartNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
|
|
InternalCursorAtEmptyLine:=ebNone;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
InitStack(Stack);
|
|
try
|
|
//DebugLn(['TStandardCodeTool.CompleteBlock ',StartNode.DescAsString]);
|
|
|
|
if StartNode.Desc in AllPascalStatements then begin
|
|
while (StartNode.Parent<>nil)
|
|
and (StartNode.Parent.Desc in AllPascalStatements) do
|
|
StartNode:=StartNode.Parent;
|
|
if not CompleteStatements(Stack) then exit;
|
|
end
|
|
else if StartNode.Desc in AllClassSections then begin
|
|
if not CompleteClassSection(Stack) then exit;
|
|
end
|
|
else if StartNode.Desc in AllClassInterfaces then begin
|
|
if not CompleteClassInterface(Stack) then exit;
|
|
end
|
|
else if StartNode.Desc=ctnRecordType then begin
|
|
if not CompleteRecord(Stack) then exit;
|
|
end;
|
|
finally
|
|
FreeStack(Stack);
|
|
end;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.GuessMisplacedIfdefEndif(
|
|
const CursorPos: TCodeXYPosition;
|
|
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
var
|
|
StartCursorPos, EndCursorPos: integer;
|
|
StartCode, EndCode: Pointer;
|
|
begin
|
|
Result:=false;
|
|
try
|
|
BeginParsing(true,false);
|
|
except
|
|
// ignore scanner and parser errors
|
|
on e: ELinkScannerError do ;
|
|
on e: ECodeToolError do ;
|
|
end;
|
|
if Scanner<>nil then begin
|
|
CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,StartCursorPos);
|
|
StartCode:=CursorPos.Code;
|
|
Result:=Scanner.GuessMisplacedIfdefEndif(StartCursorPos,StartCode,
|
|
EndCursorPos,EndCode);
|
|
if Result then begin
|
|
NewPos.Code:=TCodeBuffer(EndCode);
|
|
NewPos.Code.AbsoluteToLineCol(EndCursorPos,NewPos.Y,NewPos.X);
|
|
if JumpCentered then begin
|
|
NewTopLine:=NewPos.Y-(VisibleEditorLines shr 1);
|
|
if NewTopLine<1 then NewTopLine:=1;
|
|
end else
|
|
NewTopLine:=NewPos.Y;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindEnclosingIncludeDirective(
|
|
const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition;
|
|
var NewTopLine: integer): boolean;
|
|
var
|
|
CleanCursorPos, LinkIndex, NewCleanPos: integer;
|
|
begin
|
|
Result:=false;
|
|
try
|
|
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
|
|
[btSetIgnoreErrorPos]);
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanCursorPos);
|
|
LinkIndex:=Scanner.FindParentLink(LinkIndex);
|
|
if LinkIndex<0 then
|
|
// this is no include file
|
|
exit;
|
|
NewPos.Code:=TCodeBuffer(Scanner.Links[LinkIndex].Code);
|
|
// calculate the directive end bracket
|
|
NewCleanPos:=Scanner.Links[LinkIndex].CleanedPos+Scanner.LinkSize(LinkIndex)-1;
|
|
Result:=CleanPosToCaretAndTopLine(NewCleanPos,NewPos,NewTopLine);
|
|
finally
|
|
ClearIgnoreErrorAfter;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindModeDirective(DoBuildTree: boolean;
|
|
out ACleanPos: integer): boolean;
|
|
var
|
|
ParamPos: Integer;
|
|
begin
|
|
Result:=false;
|
|
ACleanPos:=0;
|
|
if DoBuildTree then BuildTree(true);
|
|
ACleanPos:=FindNextCompilerDirectiveWithName(Src,1,'Mode',
|
|
Scanner.NestedComments,ParamPos);
|
|
if ParamPos=0 then ;
|
|
Result:=(ACleanPos>0) and (ACleanPos<=SrcLen);
|
|
end;
|
|
|
|
function TStandardCodeTool.FindResourceDirective(DoBuildTree: boolean;
|
|
var ACleanPos: integer; const Filename: string): boolean;
|
|
var
|
|
ParamPos: Integer;
|
|
FilenameStartPos: Integer;
|
|
FilenameEndPos: LongInt;
|
|
begin
|
|
Result:=false;
|
|
if DoBuildTree then BuildTree(true);
|
|
ACleanPos:=1;
|
|
repeat
|
|
ACleanPos:=FindNextCompilerDirectiveWithName(Src,ACleanPos,'R',
|
|
Scanner.NestedComments,ParamPos);
|
|
if ParamPos=0 then ;
|
|
if (ACleanPos<1) or (ACleanPos>SrcLen) then
|
|
exit(false);
|
|
if Filename='' then begin
|
|
// searching any filename -> found
|
|
exit(true);
|
|
end;
|
|
FilenameStartPos:=ACleanPos+length('{$R ');
|
|
FilenameEndPos:=FilenameStartPos;
|
|
while (FilenameEndPos<=SrcLen) and (Src[FilenameEndPos]<>'}') do
|
|
inc(FilenameEndPos);
|
|
if CompareText(PChar(Pointer(Filename)),length(Filename),
|
|
@Src[FilenameStartPos],FilenameEndPos-FilenameStartPos,
|
|
true,false)=0
|
|
then begin
|
|
// filename found
|
|
exit(true);
|
|
end;
|
|
ACleanPos:=FilenameEndPos+1;
|
|
until ACleanPos>SrcLen;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindResourceDirective(
|
|
const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition;
|
|
out NewTopLine: integer; const Filename: string): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
begin
|
|
Result:=false;
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
if not FindResourceDirective(false,CleanCursorPos,Filename) then begin
|
|
//DebugLn('TStandardCodeTool.FindResourceDirective resource directive not found');
|
|
exit;
|
|
end;
|
|
Result:=CleanPosToCaretAndTopLine(CleanCursorPos,NewPos,NewTopLine);
|
|
end;
|
|
|
|
function TStandardCodeTool.AddResourceDirective(const Filename: string;
|
|
SourceChangeCache: TSourceChangeCache; const NewSrc: string): boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
Indent: LongInt;
|
|
InsertPos: Integer;
|
|
AddSrc: String;
|
|
begin
|
|
Result:=false;
|
|
BuildTree(true);
|
|
// find an insert position
|
|
ANode:=FindImplementationNode;
|
|
if ANode<>nil then begin
|
|
Indent:=GetLineIndent(Src,ANode.StartPos);
|
|
InsertPos:=ANode.StartPos+length('implementation');
|
|
end else begin
|
|
ANode:=FindMainBeginEndNode;
|
|
if ANode<>nil then begin
|
|
Indent:=GetLineIndent(Src,ANode.StartPos);
|
|
InsertPos:=ANode.StartPos;
|
|
end else begin
|
|
ANode:=FindMainUsesSection;
|
|
if ANode<>nil then begin
|
|
Indent:=GetLineIndent(Src,ANode.StartPos);
|
|
InsertPos:=ANode.StartPos;
|
|
end else begin
|
|
Indent:=0;
|
|
InsertPos:=1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// insert directive
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if NewSrc<>'' then
|
|
AddSrc:=NewSrc
|
|
else
|
|
AddSrc:=GetIndentStr(Indent)+'{$R '+Filename+'}';
|
|
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
|
|
AddSrc) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindIncludeDirective(DoBuildTree: boolean;
|
|
var ACleanPos: integer; const Filename: string): boolean;
|
|
var
|
|
FilenameStartPos: Integer;
|
|
FilenameEndPos: LongInt;
|
|
CommentStart: integer;
|
|
CommentEnd: integer;
|
|
begin
|
|
Result:=false;
|
|
if DoBuildTree then BuildTree(true);
|
|
ACleanPos:=1;
|
|
repeat
|
|
ACleanPos:=FindNextIncludeDirective(Src,ACleanPos,Scanner.NestedComments,
|
|
FilenameStartPos,FilenameEndPos,CommentStart,CommentEnd);
|
|
if (ACleanPos<1) or (ACleanPos>SrcLen) then
|
|
exit(false);
|
|
if Filename='' then begin
|
|
// searching any filename -> found
|
|
exit(true);
|
|
end;
|
|
if CompareText(PChar(Pointer(Filename)),length(Filename),
|
|
@Src[FilenameStartPos],FilenameEndPos-FilenameStartPos,
|
|
true,false)=0
|
|
then begin
|
|
// filename found
|
|
exit(true);
|
|
end;
|
|
ACleanPos:=FilenameEndPos+1;
|
|
until ACleanPos>SrcLen;
|
|
end;
|
|
|
|
function TStandardCodeTool.FindIncludeDirective(
|
|
const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition; out
|
|
NewTopLine: integer; const Filename: string): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
begin
|
|
Result:=false;
|
|
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
|
if not FindIncludeDirective(false,CleanCursorPos,Filename) then begin
|
|
//DebugLn('TStandardCodeTool.FindIncludeDirective resource directive not found');
|
|
exit;
|
|
end;
|
|
Result:=CleanPosToCaretAndTopLine(CleanCursorPos,NewPos,NewTopLine);
|
|
end;
|
|
|
|
function TStandardCodeTool.AddIncludeDirective(const Filename: string;
|
|
SourceChangeCache: TSourceChangeCache; const NewSrc: string): boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
Indent: LongInt;
|
|
InsertPos: Integer;
|
|
AddSrc: String;
|
|
begin
|
|
Result:=false;
|
|
BuildTree(true);
|
|
// find an insert position
|
|
ANode:=FindInitializationNode;
|
|
if ANode<>nil then begin
|
|
Indent:=GetLineIndent(Src,ANode.StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
InsertPos:=ANode.StartPos+length('initialization');
|
|
end else begin
|
|
ANode:=FindMainBeginEndNode;
|
|
if ANode<>nil then begin
|
|
MoveCursorToNodeStart(ANode);
|
|
ReadNextAtom;
|
|
//debugln(['TStandardCodeTool.AddIncludeDirective ',GetAtom]);
|
|
Indent:=GetLineIndent(Src,CurPos.StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
InsertPos:=CurPos.EndPos;
|
|
end else begin
|
|
debugln(['TStandardCodeTool.AddIncludeDirective ToDo: add initialization / begin..end']);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// insert directive
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
if NewSrc<>'' then
|
|
AddSrc:=NewSrc
|
|
else
|
|
AddSrc:=GetIndentStr(Indent)+'{$I '+Filename+'}';
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
|
|
AddSrc) then exit;
|
|
if not SourceChangeCache.Apply then exit;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer;
|
|
SourceChangeCache: TSourceChangeCache;
|
|
out FoundIncludeFiles: TStrings;
|
|
var MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
|
var
|
|
ASource: String;
|
|
|
|
{procedure WriteMissingIncludeFilesCodeXYPos;
|
|
var
|
|
CodePos: PCodeXYPosition;
|
|
i: Integer;
|
|
begin
|
|
if MissingIncludeFilesCodeXYPos<>nil then begin
|
|
for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin
|
|
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]);
|
|
DebugLn('TStandardCodeTool.FixMissingUnits ',dbgs(CodePos));
|
|
DebugLn('TStandardCodeTool.FixMissingUnits ',CodePos^.Code.Filename);
|
|
debugln(CodePos^.Code.Filename
|
|
+'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')'
|
|
+' missing include file');
|
|
end;
|
|
end;
|
|
end;}
|
|
|
|
procedure Add(FilenameSrcPos: integer; const AFilename: string;
|
|
Found: boolean);
|
|
var
|
|
NewFilename: String;
|
|
p: PCodeXYPosition;
|
|
begin
|
|
if Found then begin
|
|
if FoundIncludeFiles=nil then
|
|
FoundIncludeFiles:=TStringList.Create;
|
|
NewFilename:=TrimFilename(AFilename);
|
|
if FoundIncludeFiles.IndexOf(NewFilename)<0 then
|
|
FoundIncludeFiles.Add(NewFilename);
|
|
end else begin
|
|
if MissingIncludeFilesCodeXYPos=nil then
|
|
MissingIncludeFilesCodeXYPos:=TFPList.Create;
|
|
New(p);
|
|
p^.Code:=Code;
|
|
Code.AbsoluteToLineCol(FilenameSrcPos,p^.y,p^.x);
|
|
MissingIncludeFilesCodeXYPos.Add(p);
|
|
///DebugLn('TStandardCodeTool.FixIncludeFilenames.Add "',p^.Code.Filename,'" ',dbgs(p),' X=',dbgs(p^.X),' Y=',dbgs(p^.Y));
|
|
//WriteMissingIncludeFilesCodeXYPos;
|
|
end;
|
|
end;
|
|
|
|
function SearchIncludeFilename(FilenameSrcPos: integer;
|
|
const AFilename: string): string;
|
|
var
|
|
AFilePath: String;
|
|
BaseDir: String;
|
|
CurFilename: String;
|
|
IncludePath: String;
|
|
PathDivider: String;
|
|
ACodeBuf: TCodeBuffer;
|
|
begin
|
|
Result:=TrimFilename(AFilename);
|
|
if FilenameIsAbsolute(Result) then begin
|
|
Result:=FindDiskFilename(Result);
|
|
Add(FilenameSrcPos,Result,FileExistsCached(Result));
|
|
//DebugLn('SearchIncludeFilename AbsoluteFilename="',Result,'"');
|
|
end else begin
|
|
BaseDir:=ExtractFilePath(MainFilename);
|
|
//DebugLn('SearchIncludeFilename BaseDir="',BaseDir,'"');
|
|
if FilenameIsAbsolute(BaseDir) then begin
|
|
// unit has normal path -> not virtual
|
|
AFilePath:=ExtractFilePath(Result);
|
|
if AFilePath<>'' then begin
|
|
// search relative to unit
|
|
CurFilename:=FindDiskFilename(BaseDir+Result);
|
|
Result:=copy(CurFilename,length(BaseDir)+1,length(CurFilename));
|
|
if FileExistsCached(CurFilename) then
|
|
Add(FilenameSrcPos,CurFilename,true)
|
|
else
|
|
Add(FilenameSrcPos,Result,false);
|
|
//DebugLn('SearchIncludeFilename relative filename="',CurFilename,'"');
|
|
end else begin
|
|
// search in path
|
|
IncludePath:='';
|
|
PathDivider:=':;';
|
|
if (Scanner.Values<>nil) then begin
|
|
IncludePath:=Scanner.Values.Variables[ExternalMacroStart+'INCPATH'];
|
|
if Scanner.Values.IsDefined('DELPHI') then
|
|
PathDivider:=':'
|
|
end;
|
|
CurFilename:=SearchFileInPath(Result,BaseDir,IncludePath,PathDivider,
|
|
ctsfcAllCase);
|
|
if CurFilename<>'' then begin
|
|
// found
|
|
Result:=CreateRelativePath(CurFilename,BaseDir);
|
|
Add(FilenameSrcPos,CurFilename,true);
|
|
end else begin
|
|
// not found
|
|
Add(FilenameSrcPos,Result,false);
|
|
end;
|
|
//DebugLn('SearchIncludeFilename search in include path="',IncludePath,'" Result="',Result,'"');
|
|
end;
|
|
end else begin
|
|
// unit has no path -> virtual unit -> search in virtual files
|
|
ACodeBuf:=TCodeBuffer(Scanner.LoadSourceCaseLoUp(Result));
|
|
if ACodeBuf<>nil then begin
|
|
Result:=ACodeBuf.Filename;
|
|
Add(FilenameSrcPos,Result,true);
|
|
end else begin
|
|
Add(FilenameSrcPos,Result,false);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FixFilename(StartPos, EndPos: integer);
|
|
var
|
|
OldFilename: String;
|
|
AFilename: String;
|
|
begin
|
|
OldFilename:=SetDirSeparators(copy(ASource,StartPos,EndPos-StartPos));
|
|
//DebugLn('FixFilename ',dbgs(StartPos),' ',dbgs(EndPos),' ',OldFilename);
|
|
AFilename:=OldFilename;
|
|
if ExtractFileExt(AFilename)='' then begin
|
|
// add default extension
|
|
if (Scanner.CompilerMode=cmDELPHI) then
|
|
AFilename:=AFilename+'.pas'
|
|
else
|
|
AFilename:=AFilename+'.pp';
|
|
end;
|
|
AFilename:=SearchIncludeFilename(StartPos,AFilename);
|
|
if OldFilename<>AFilename then begin
|
|
DebugLn('FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"');
|
|
SourceChangeCache.ReplaceEx(gtNone,gtNone,0,0,Code,StartPos,EndPos,AFilename);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
p: Integer;
|
|
NestedComments: Boolean;
|
|
FilenameStartPos, FileNameEndPos, CommentStartPos, CommentEndPos: integer;
|
|
begin
|
|
Result:=false;
|
|
FoundIncludeFiles:=nil;
|
|
if (Scanner=nil) or (Scanner.MainCode=nil) then exit;
|
|
ASource:=Code.Source;
|
|
Scanner.Scan(lsrInit,false);
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
|
|
Result:=true;
|
|
NestedComments:=Scanner.NestedComments;
|
|
p:=1;
|
|
repeat
|
|
p:=BasicCodeTools.FindNextIncludeDirective(ASource,p,NestedComments,
|
|
FilenameStartPos, FileNameEndPos, CommentStartPos, CommentEndPos);
|
|
if (p<1) or (p>length(ASource)) then break;
|
|
if (CommentStartPos=0) and (CommentEndPos=0) then ;
|
|
FixFilename(FilenameStartPos,FilenameEndPos);
|
|
p:=FindCommentEnd(ASource,p,NestedComments);
|
|
//DebugLn('TStandardCodeTool.FixIncludeFilenames ',dbgs(p));
|
|
until false;
|
|
//WriteMissingIncludeFilesCodeXYPos;
|
|
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReadTilGuessedUnclosedBlock(
|
|
MinCleanPos: integer; ReadOnlyOneBlock: boolean): boolean;
|
|
// returns true if unclosed block found
|
|
var BlockType, CurBlockWord: TBlockKeyword;
|
|
BlockStart: integer;
|
|
begin
|
|
Result:=false;
|
|
BlockType:=bkwNone;
|
|
BlockStart:=-1;
|
|
// read til this block is closed
|
|
while (CurPos.StartPos<=SrcLen) do begin
|
|
if BlockKeywordFuncList.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
|
|
begin
|
|
for CurBlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do
|
|
if UpAtomIs(BlockKeywords[CurBlockWord]) then
|
|
break;
|
|
if (CurBlockWord=bkwInterface) and (not LastAtomIs(0,'=')) then
|
|
CurBlockWord:=bkwNone;
|
|
|
|
if (CurBlockWord=bkwEnd) then begin
|
|
ReadNextAtom;
|
|
if AtomIsChar('.') then begin
|
|
// source end found
|
|
if BlockType in [bkwBegin,bkwNone] then begin
|
|
CurPos.StartPos:=SrcLen+1;
|
|
exit;
|
|
end else begin
|
|
MoveCursorToCleanPos(BlockStart);
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
end else
|
|
UndoReadNextAtom;
|
|
end;
|
|
|
|
if BlockType=bkwNone then begin
|
|
case CurBlockWord of
|
|
|
|
bkwBegin, bkwAsm, bkwRepeat, bkwCase, bkwTry, bkwRecord:
|
|
begin
|
|
BlockType:=CurBlockWord;
|
|
BlockStart:=CurPos.StartPos;
|
|
end;
|
|
|
|
bkwClass, bkwObject, bkwInterface, bkwDispInterface:
|
|
begin
|
|
ReadNextAtom;
|
|
if AtomIsChar(';') then begin
|
|
// forward class
|
|
end else if ((CurBlockWord=bkwClass) and UpAtomIs('OF')) then begin
|
|
// 'class of'
|
|
end else if ((CurBlockWord=bkwClass)
|
|
and (UpAtomIs('FUNCTION') or UpAtomIs('PROCEDURE'))) then begin
|
|
// 'class procedure'
|
|
end else if ((CurBlockWord=bkwObject) and LastUpAtomIs(0,'OF')) then
|
|
begin
|
|
// or 'of object'
|
|
end else begin
|
|
BlockType:=CurBlockWord;
|
|
BlockStart:=LastAtoms.GetValueAt(0).StartPos;
|
|
// read ancestor list class(...)
|
|
if CurPos.Flag=cafRoundBracketOpen then begin
|
|
repeat
|
|
ReadNextAtom;
|
|
if AtomIsIdentifier(false) then begin
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafPoint then begin
|
|
ReadNextAtom;
|
|
AtomIsIdentifier(true);
|
|
end;
|
|
end;
|
|
if CurPos.Flag=cafRoundBracketClose then break;
|
|
if CurPos.Flag<>cafComma then begin
|
|
exit(false);
|
|
end;
|
|
until false;
|
|
ReadNextAtom;
|
|
end;
|
|
// a semicolon directly behind the ancestor list ends the class
|
|
if (CurPos.Flag in [cafEnd,cafSemicolon]) then begin
|
|
// class ends
|
|
BlockType:=bkwNone;
|
|
end else begin
|
|
// class continues
|
|
UndoReadNextAtom;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
bkwEnd, bkwUntil:
|
|
begin
|
|
// close block keywords found, but no block was opened
|
|
// -> unclosed block found
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
|
|
end;
|
|
end
|
|
else
|
|
if ((BlockType in [bkwBegin, bkwAsm, bkwCase, bkwRecord, bkwClass,
|
|
bkwObject, bkwFinally, bkwExcept, bkwInterface, bkwDispInterface])
|
|
and (CurBlockWord=bkwEnd))
|
|
or ((BlockType=bkwRepeat) and (CurBlockWord=bkwUntil)) then begin
|
|
// block end found
|
|
if (MinCleanPos<=CurPos.StartPos)
|
|
and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
|
|
then begin
|
|
// different indent -> unclosed block found
|
|
if GetLineIndent(Src,BlockStart)>GetLineIndent(Src,CurPos.StartPos)
|
|
then begin
|
|
// the current block is more indented than the next block
|
|
// -> probably the current block misses a block end
|
|
MoveCursorToCleanPos(BlockStart);
|
|
end;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
// end block
|
|
if (BlockType=bkwRecord) and (CurBlockWord=bkwCase) then begin
|
|
// the 'end' keyword is the end for the case block and the record block
|
|
UndoReadNextAtom;
|
|
end;
|
|
BlockType:=bkwNone;
|
|
if ReadOnlyOneBlock then break;
|
|
end
|
|
else
|
|
if (BlockType=bkwTry) and (CurBlockWord in [bkwFinally,bkwExcept]) then
|
|
begin
|
|
// try..finally, try..except found
|
|
if (MinCleanPos<=CurPos.StartPos)
|
|
and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
|
|
then begin
|
|
// different indent -> unclosed block found
|
|
// probably a block start is missing, so the error position is
|
|
// here at block end
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
// change blocktype
|
|
BlockType:=CurBlockWord;
|
|
BlockStart:=CurPos.StartPos;
|
|
end
|
|
else
|
|
if ((BlockType in [bkwBegin,bkwRepeat,bkwTry,bkwFinally,bkwExcept,
|
|
bkwCase])
|
|
and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase,bkwAsm]))
|
|
or ((BlockType in [bkwClass,bkwInterface,bkwDispInterface,bkwObject,
|
|
bkwRecord])
|
|
and (CurBlockWord in [bkwRecord])) then
|
|
begin
|
|
// sub blockstart found -> read recursively
|
|
Result:=ReadTilGuessedUnclosedBlock(MinCleanPos,true);
|
|
if Result then exit;
|
|
end
|
|
else
|
|
if (BlockType=bkwRecord) and (CurBlockWord=bkwCase) then begin
|
|
// variant record
|
|
end
|
|
else
|
|
if (BlockType=bkwClass) and (CurBlockWord=bkwClass) then begin
|
|
// class method
|
|
end
|
|
else
|
|
begin
|
|
// unexpected keyword found
|
|
if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos)
|
|
then begin
|
|
// the current block is more or equal indented than the next block
|
|
// -> probably the current block misses a block end
|
|
MoveCursorToCleanPos(BlockStart);
|
|
end;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
ReadNextAtom;
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReadForwardTilAnyBracketClose: boolean;
|
|
// this function reads any bracket
|
|
// (the ReadTilBracketClose function reads only brackets in code, not comments)
|
|
var OpenBracket: char;
|
|
CommentLvl: integer;
|
|
begin
|
|
Result:=false;
|
|
OpenBracket:=Src[CurPos.StartPos];
|
|
if OpenBracket='{' then begin
|
|
// read til end of comment
|
|
CommentLvl:=1;
|
|
inc(CurPos.StartPos);
|
|
while (CurPos.StartPos<=SrcLen) and (CommentLvl>0) do begin
|
|
case Src[CurPos.StartPos] of
|
|
'{': if Scanner.NestedComments then inc(CommentLvl);
|
|
'}':
|
|
if CommentLvl=1 then begin
|
|
Result:=true;
|
|
break;
|
|
end else
|
|
dec(CommentLvl);
|
|
end;
|
|
inc(CurPos.StartPos);
|
|
end;
|
|
end else if OpenBracket='(' then begin
|
|
if (CurPos.StartPos<SrcLen) and (Src[CurPos.StartPos+1]='*') then begin
|
|
// read til end of comment
|
|
inc(CurPos.StartPos,3);
|
|
while true do begin
|
|
if (CurPos.StartPos<=SrcLen)
|
|
and ((Src[CurPos.StartPos-1]='*') and (Src[CurPos.StartPos]=')')) then
|
|
begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
inc(CurPos.StartPos);
|
|
end;
|
|
end else begin
|
|
Result:=ReadTilBracketClose(false);
|
|
end;
|
|
end else if OpenBracket='[' then begin
|
|
Result:=ReadTilBracketClose(false);
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.ReadBackwardTilAnyBracketClose: boolean;
|
|
// this function reads any bracket
|
|
// (the ReadBackTilBracketClose function reads only brackets in code,
|
|
// not comments)
|
|
var OpenBracket: char;
|
|
CommentLvl: integer;
|
|
begin
|
|
Result:=false;
|
|
OpenBracket:=Src[CurPos.StartPos];
|
|
if OpenBracket='}' then begin
|
|
// read backwards til end of comment
|
|
CommentLvl:=1;
|
|
dec(CurPos.StartPos);
|
|
while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
|
|
case Src[CurPos.StartPos] of
|
|
'}': if Scanner.NestedComments then inc(CommentLvl);
|
|
'{':
|
|
if CommentLvl=1 then begin
|
|
Result:=true;
|
|
break;
|
|
end else
|
|
dec(CommentLvl);
|
|
end;
|
|
dec(CurPos.StartPos);
|
|
end;
|
|
end else if OpenBracket=')' then begin
|
|
if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin
|
|
// read til end of comment
|
|
dec(CurPos.StartPos,3);
|
|
while true do begin
|
|
if (CurPos.StartPos>=1)
|
|
and ((Src[CurPos.StartPos+1]='*') and (Src[CurPos.StartPos]='(')) then
|
|
begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
dec(CurPos.StartPos);
|
|
end;
|
|
end else begin
|
|
Result:=ReadBackTilBracketOpen(false);
|
|
end;
|
|
end else if OpenBracket=']' then begin
|
|
Result:=ReadBackTilBracketOpen(false);
|
|
end;
|
|
end;
|
|
|
|
function TStandardCodeTool.Explore(WithStatements: boolean;
|
|
OnlyInterface: boolean): boolean;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Result:=true;
|
|
BuildTree(OnlyInterface);
|
|
Node:=Tree.Root;
|
|
while Node<>nil do begin
|
|
case Node.Desc of
|
|
ctnClass,ctnClassInterface,ctnDispinterface,ctnObject,
|
|
ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,ctnCPPClass:
|
|
BuildSubTreeForClass(Node);
|
|
ctnProcedure,ctnProcedureHead:
|
|
BuildSubTreeForProcHead(Node);
|
|
ctnBeginBlock:
|
|
if WithStatements then
|
|
BuildSubTreeForBeginBlock(Node);
|
|
ctnImplementation:
|
|
if OnlyInterface then exit;
|
|
end;
|
|
Node:=Node.Next;
|
|
end;
|
|
end;
|
|
|
|
finalization
|
|
FreeAndNil(BlockKeywordFuncList);
|
|
|
|
end.
|
|
|
|
|