mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 18:33:50 +02:00
6349 lines
211 KiB
ObjectPascal
6349 lines
211 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:
|
|
TCodeToolManager gathers all tools in one single Object
|
|
to easily use the code tools in a program.
|
|
|
|
}
|
|
unit CodeToolManager;
|
|
|
|
{$ifdef fpc}{$mode objfpc}{$endif}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
{.$DEFINE CTDEBUG}
|
|
{ $DEFINE DoNotHandleFindDeclException}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, contnrs, LazMethodList, TypInfo, types, FileProcs, BasicCodeTools,
|
|
CodeToolsStrConsts,
|
|
LazFileCache,
|
|
EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
|
|
ExprEval, LinkScanner, KeywordFuncLists, FindOverloads, CodeBeautifier,
|
|
FindDeclarationCache, DirectoryCacher, AVL_Tree,
|
|
PPUCodeTools, LFMTrees, DirectivesTree, codecompletiontemplater,
|
|
PascalParserTool, CodeToolsConfig, CustomCodeTool, FindDeclarationTool,
|
|
IdentCompletionTool, StdCodeTools, ResourceCodeTool, CodeToolsStructs,
|
|
CTUnitGraph, CodeTemplatesTool, ExtractProcTool;
|
|
|
|
type
|
|
TCodeToolManager = class;
|
|
TCodeTool = TEventsCodeTool;
|
|
TDirectivesTool = TCompilerDirectivesTree;
|
|
|
|
TOnBeforeApplyCTChanges = procedure(Manager: TCodeToolManager;
|
|
var Abort: boolean) of object;
|
|
TOnAfterApplyCTChanges = procedure(Manager: TCodeToolManager) of object;
|
|
TOnGatherExternalChanges = procedure(Manager: TCodeToolManager;
|
|
var Abort: boolean) of object;
|
|
TOnSearchUsedUnit = function(const SrcFilename: string;
|
|
const TheUnitName, TheUnitInFilename: string
|
|
): TCodeBuffer of object;
|
|
TOnCodeToolCheckAbort = function: boolean of object;
|
|
TOnFindDefineProperty = procedure(Sender: TObject;
|
|
const PersistentClassName, AncestorClassName, Identifier: string;
|
|
var IsDefined: boolean) of object;
|
|
TOnFindGDBSource = procedure(Sender: TObject; SrcType: TCodeTreeNodeDesc;
|
|
const SrcName: string; out SrcFilename: string) of object;
|
|
|
|
ECodeToolManagerError = class(Exception);
|
|
|
|
TCodeToolManagerHandler = (
|
|
ctmOnToolTreeChanging
|
|
);
|
|
TCodeToolManagerHandlers = set of TCodeToolManagerHandler;
|
|
TOnToolTreeChanging = TCodeTreeChangeEvent;
|
|
TOnScannerInit = procedure(Self: TCodeToolManager; Scanner: TLinkScanner) of object;
|
|
|
|
{ TCodeToolManager }
|
|
|
|
TCodeToolManager = class(TPersistent)
|
|
private
|
|
FAbortable: boolean;
|
|
FAddInheritedCodeToOverrideMethod: boolean;
|
|
FAdjustTopLineDueToComment: boolean;
|
|
FCatchExceptions: boolean;
|
|
FChangeStep: integer;
|
|
FCheckFilesOnDisk: boolean;
|
|
FCodeCompletionTemplateFileName: String;
|
|
FCodeNodeTreeChangeStep: integer;
|
|
FCompleteProperties: boolean;
|
|
FCurCodeTool: TCodeTool; // current codetool
|
|
FCurDirectivesTool: TDirectivesTool;
|
|
FCursorBeyondEOL: boolean;
|
|
FDirectivesTools: TAVLTree; // tree of TDirectivesTool sorted for Code (TCodeBuffer)
|
|
FErrorCode: TCodeBuffer;
|
|
FErrorColumn: integer;
|
|
FErrorLine: integer;
|
|
FErrorMsg: string;
|
|
FErrorTopLine: integer;
|
|
FCodeTreeNodesDeletedStep: integer;
|
|
FIndentSize: integer;
|
|
FJumpCentered: boolean;
|
|
FIdentifierListUpdating: boolean;
|
|
FOnAfterApplyChanges: TOnAfterApplyCTChanges;
|
|
FOnBeforeApplyChanges: TOnBeforeApplyCTChanges;
|
|
FOnCheckAbort: TOnCodeToolCheckAbort;
|
|
FOnGatherExternalChanges: TOnGatherExternalChanges;
|
|
FOnFindDefinePropertyForContext: TOnFindDefinePropertyForContext;
|
|
FOnFindDefineProperty: TOnFindDefineProperty;
|
|
FOnGetIndenterExamples: TOnGetFABExamples;
|
|
FOnGetMethodName: TOnGetMethodname;
|
|
FOnScannerInit: TOnScannerInit;
|
|
FOnSearchUsedUnit: TOnSearchUsedUnit;
|
|
FResourceTool: TResourceCodeTool;
|
|
FSetPropertyVariablename: string;
|
|
FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk'
|
|
FPascalTools: TAVLTree; // tree of TCustomCodeTool sorted TCustomCodeTool(Data).Scanner.MainCode
|
|
FTabWidth: integer;
|
|
FUseTabs: boolean;
|
|
FVisibleEditorLines: integer;
|
|
FWriteExceptions: boolean;
|
|
FWriteLockCount: integer;// Set/Unset counter
|
|
FWriteLockStep: integer; // current write lock ID
|
|
FHandlers: array[TCodeToolManagerHandler] of TMethodList;
|
|
function GetBeautifier: TBeautifyCodeOptions; inline;
|
|
function DoOnScannerGetInitValues(Scanner: TLinkScanner; Code: Pointer;
|
|
out AChangeStep: integer): TExpressionEvaluator;
|
|
procedure DoOnDefineTreeReadValue(Sender: TObject; const VariableName: string;
|
|
var Value: string; var Handled: boolean);
|
|
procedure DoOnGlobalValuesChanged;
|
|
function DoOnFindUsedUnit(SrcTool: TFindDeclarationTool; const TheUnitName,
|
|
TheUnitInFilename: string): TCodeBuffer;
|
|
function DoOnGetSrcPathForCompiledUnit(Sender: TObject;
|
|
const AFilename: string): string;
|
|
function DoOnInternalGetMethodName(const AMethod: TMethod;
|
|
CheckOwner: TObject): string;
|
|
function FindCodeOfMainUnitHint(Code: TCodeBuffer): TCodeBuffer;
|
|
procedure CreateScanner(Code: TCodeBuffer);
|
|
procedure SetAbortable(const AValue: boolean);
|
|
procedure SetAddInheritedCodeToOverrideMethod(const AValue: boolean);
|
|
procedure SetCheckFilesOnDisk(NewValue: boolean);
|
|
procedure SetCodeCompletionTemplateFileName(AValue: String);
|
|
procedure SetCompleteProperties(const AValue: boolean);
|
|
procedure SetIndentSize(NewValue: integer);
|
|
procedure SetSetPropertyVariablename(AValue: string);
|
|
procedure SetTabWidth(const AValue: integer);
|
|
procedure SetUseTabs(AValue: boolean);
|
|
procedure SetVisibleEditorLines(NewValue: integer);
|
|
procedure SetJumpCentered(NewValue: boolean);
|
|
procedure SetCursorBeyondEOL(NewValue: boolean);
|
|
procedure BeforeApplyingChanges(var Abort: boolean);
|
|
procedure AfterApplyingChanges;
|
|
procedure AdjustErrorTopLine;
|
|
procedure WriteError;
|
|
procedure DoOnFABGetNestedComments(Sender: TObject; Code: TCodeBuffer; out
|
|
NestedComments: boolean);
|
|
procedure DoOnFABGetExamples(Sender: TObject; Code: TCodeBuffer;
|
|
Step: integer; var CodeBuffers: TFPList; var ExpandedFilenames: TStrings);
|
|
procedure DoOnLoadFileForTool(Sender: TObject; const ExpandedFilename: string;
|
|
out Code: TCodeBuffer; var Abort: boolean);
|
|
function DoOnGetCodeToolForBuffer(Sender: TObject;
|
|
Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
|
|
function DoOnGetDirectoryCache(const ADirectory: string): TCTDirectoryCache;
|
|
procedure DoOnToolSetWriteLock(Lock: boolean);
|
|
procedure DoOnToolGetChangeSteps(out SourcesChangeStep, FilesChangeStep: int64;
|
|
out InitValuesChangeStep: integer);
|
|
function DoOnParserProgress(Tool: TCustomCodeTool): boolean;
|
|
procedure DoOnToolTreeChange(Tool: TCustomCodeTool; NodesDeleting: boolean);
|
|
function DoOnScannerProgress(Sender: TLinkScanner): boolean;
|
|
function GetResourceTool: TResourceCodeTool;
|
|
function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject;
|
|
function DirectoryCachePoolGetString(const ADirectory: string;
|
|
const AStringType: TCTDirCacheString): string;
|
|
function DirectoryCachePoolFindVirtualFile(const Filename: string): string;
|
|
function DirectoryCachePoolGetUnitFromSet(const UnitSet, AnUnitName: string;
|
|
SrcSearchRequiresPPU: boolean): string;
|
|
function DirectoryCachePoolGetCompiledUnitFromSet(
|
|
const UnitSet, AnUnitName: string): string;
|
|
procedure DirectoryCachePoolIterateFPCUnitsFromSet(const UnitSet: string;
|
|
const Iterate: TCTOnIterateFile);
|
|
procedure AddHandler(HandlerType: TCodeToolManagerHandler; const Handler: TMethod);
|
|
procedure RemoveHandler(HandlerType: TCodeToolManagerHandler; const Handler: TMethod);
|
|
public
|
|
DefinePool: TDefinePool; // definition templates (rules)
|
|
DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
|
|
SourceCache: TCodeCache; // cache for source (units, include files, ...)
|
|
SourceChangeCache: TSourceChangeCache; // cache for write accesses
|
|
PPUCache: TPPUTools;
|
|
GlobalValues: TExpressionEvaluator;
|
|
DirectoryCachePool: TCTDirectoryCachePool;
|
|
FPCDefinesCache: TFPCDefinesCache;
|
|
IdentifierList: TIdentifierList;
|
|
IdentifierHistory: TIdentifierHistoryList;
|
|
Positions: TCodeXYPositions;
|
|
Indenter: TFullyAutomaticBeautifier;
|
|
property Beautifier: TBeautifyCodeOptions read GetBeautifier;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
procedure Init(Config: TCodeToolsOptions);
|
|
procedure SimpleInit(const ConfigFilename: string);
|
|
|
|
procedure ActivateWriteLock;
|
|
procedure DeactivateWriteLock;
|
|
property ChangeStep: integer read FChangeStep; // code changes
|
|
procedure IncreaseChangeStep;
|
|
property CodeNodeTreeChangeStep: integer read FCodeNodeTreeChangeStep;// nodes altered, added, deleted
|
|
property CodeTreeNodesDeletedStep: integer read FCodeTreeNodesDeletedStep;// nodes deleted
|
|
procedure GetCodeTreeNodesDeletedStep(out NodesDeletedStep: integer);// use this for events
|
|
procedure AddHandlerToolTreeChanging(const OnToolTreeChanging: TOnToolTreeChanging);
|
|
procedure RemoveHandlerToolTreeChanging(const OnToolTreeChanging: TOnToolTreeChanging);
|
|
|
|
// file handling
|
|
property SourceExtensions: string
|
|
read FSourceExtensions write FSourceExtensions;
|
|
function FindFile(const ExpandedFilename: string): TCodeBuffer;
|
|
function LoadFile(const ExpandedFilename: string;
|
|
UpdateFromDisk, Revert: boolean): TCodeBuffer;
|
|
function CreateFile(const AFilename: string): TCodeBuffer;
|
|
function CreateTempFile(const AFilename: string): TCodeBuffer;
|
|
procedure ReleaseTempFile(Buffer: TCodeBuffer);
|
|
function SaveBufferAs(OldBuffer: TCodeBuffer; const ExpandedFilename: string;
|
|
out NewBuffer: TCodeBuffer): boolean;
|
|
function FilenameHasSourceExt(const AFilename: string): boolean;
|
|
function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
|
|
function GetIncludeCodeChain(Code: TCodeBuffer;
|
|
RemoveFirstCodesWithoutTool: boolean;
|
|
out ListOfCodeBuffer: TFPList): boolean;
|
|
property OnSearchUsedUnit: TOnSearchUsedUnit
|
|
read FOnSearchUsedUnit write FOnSearchUsedUnit;
|
|
|
|
// initializing single scanner
|
|
property OnScannerInit: TOnScannerInit read FOnScannerInit write FOnScannerInit;
|
|
|
|
// initializing single codetool
|
|
function GetCodeToolForSource(Code: TCodeBuffer;
|
|
GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
|
|
function FindCodeToolForSource(Code: TCodeBuffer): TCustomCodeTool;
|
|
property CurCodeTool: TCodeTool read FCurCodeTool;
|
|
procedure ClearCurCodeTool;
|
|
function InitCurCodeTool(Code: TCodeBuffer): boolean;
|
|
function InitResourceTool: boolean;
|
|
procedure ClearPositions;
|
|
|
|
// initializing single compilerdirectivestree
|
|
function GetDirectivesToolForSource(Code: TCodeBuffer;
|
|
ExceptionOnError: boolean): TCompilerDirectivesTree;
|
|
property CurDirectivesTool: TDirectivesTool read FCurDirectivesTool;
|
|
procedure ClearCurDirectivesTool;
|
|
function InitCurDirectivesTool(Code: TCodeBuffer): boolean;
|
|
function FindDirectivesToolForSource(Code: TCodeBuffer): TDirectivesTool;
|
|
|
|
// exception handling
|
|
procedure ClearError;
|
|
function HandleException(AnException: Exception): boolean;
|
|
procedure SetError(Code: TCodeBuffer; Line, Column: integer;
|
|
const TheMessage: string);
|
|
property CatchExceptions: boolean
|
|
read FCatchExceptions write FCatchExceptions;
|
|
property WriteExceptions: boolean
|
|
read FWriteExceptions write FWriteExceptions;
|
|
property ErrorCode: TCodeBuffer read fErrorCode;
|
|
property ErrorColumn: integer read fErrorColumn;
|
|
property ErrorLine: integer read fErrorLine;
|
|
property ErrorMessage: string read fErrorMsg;
|
|
property ErrorTopLine: integer read fErrorTopLine;
|
|
property Abortable: boolean read FAbortable write SetAbortable;
|
|
property OnCheckAbort: TOnCodeToolCheckAbort
|
|
read FOnCheckAbort write FOnCheckAbort;
|
|
|
|
// tool settings
|
|
property AdjustTopLineDueToComment: boolean read FAdjustTopLineDueToComment
|
|
write FAdjustTopLineDueToComment;
|
|
property CheckFilesOnDisk: boolean read FCheckFilesOnDisk
|
|
write SetCheckFilesOnDisk;
|
|
property CursorBeyondEOL: boolean read FCursorBeyondEOL
|
|
write SetCursorBeyondEOL;
|
|
property IndentSize: integer read FIndentSize write SetIndentSize;
|
|
property JumpCentered: boolean read FJumpCentered write SetJumpCentered;
|
|
property SetPropertyVariablename: string
|
|
read FSetPropertyVariablename write SetSetPropertyVariablename;
|
|
property VisibleEditorLines: integer
|
|
read FVisibleEditorLines write SetVisibleEditorLines;
|
|
property TabWidth: integer read FTabWidth write SetTabWidth;
|
|
property UseTabs: boolean read FUseTabs write SetUseTabs;
|
|
property CompleteProperties: boolean
|
|
read FCompleteProperties write SetCompleteProperties;
|
|
property AddInheritedCodeToOverrideMethod: boolean
|
|
read FAddInheritedCodeToOverrideMethod
|
|
write SetAddInheritedCodeToOverrideMethod;
|
|
|
|
// code completion templates
|
|
property CodeCompletionTemplateFileName : String read FCodeCompletionTemplateFileName
|
|
write SetCodeCompletionTemplateFileName;
|
|
|
|
// source changing
|
|
procedure BeginUpdate;
|
|
function EndUpdate: boolean;
|
|
function GatherExternalChanges: boolean;
|
|
property OnGatherExternalChanges: TOnGatherExternalChanges
|
|
read FOnGatherExternalChanges write FOnGatherExternalChanges;
|
|
function ApplyChanges: boolean;
|
|
property OnBeforeApplyChanges: TOnBeforeApplyCTChanges
|
|
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
|
|
property OnAfterApplyChanges: TOnAfterApplyCTChanges
|
|
read FOnAfterApplyChanges write FOnAfterApplyChanges;
|
|
|
|
// defines
|
|
function SetGlobalValue(const VariableName, VariableValue: string): boolean;
|
|
function GetUnitPathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetIncludePathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetSrcPathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetCompleteSrcPathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetPPUSrcPathForDirectory(const Directory: string): string;
|
|
function GetDCUSrcPathForDirectory(const Directory: string): string;
|
|
function GetCompiledSrcPathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetNestedCommentsFlagForFile(const Filename: string): boolean;
|
|
function GetPascalCompilerForDirectory(const Directory: string): TPascalCompiler;
|
|
function GetCompilerModeForDirectory(const Directory: string): TCompilerMode;
|
|
function GetCompiledSrcExtForDirectory(const Directory: string): string;
|
|
function FindUnitInUnitLinks(const Directory, AUnitName: string): string;
|
|
function GetUnitLinksForDirectory(const Directory: string;
|
|
UseCache: boolean = false): string;
|
|
function FindUnitInUnitSet(const Directory, AUnitName: string): string;
|
|
function GetUnitSetIDForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;
|
|
function GetUnitSetForDirectory(const Directory: string): TFPCUnitSetCache;
|
|
function GetFPCUnitPathForDirectory(const Directory: string;
|
|
UseCache: boolean = true): string;// value of macro #FPCUnitPath
|
|
procedure GetFPCVersionForDirectory(const Directory: string;
|
|
out FPCVersion, FPCRelease, FPCPatch: integer);
|
|
|
|
// miscellaneous
|
|
property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
|
|
write FOnGetMethodName;
|
|
property OnGetIndenterExamples: TOnGetFABExamples
|
|
read FOnGetIndenterExamples write FOnGetIndenterExamples;
|
|
|
|
// data function
|
|
procedure FreeListOfPCodeXYPosition(var List: TFPList);
|
|
procedure FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
|
|
function CreateTreeOfPCodeXYPosition: TAVLTree;
|
|
procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
|
|
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
|
|
|
|
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
// code exploring
|
|
function Explore(Code: TCodeBuffer; out ACodeTool: TCodeTool;
|
|
WithStatements: boolean; OnlyInterface: boolean = false): boolean;
|
|
function CheckSyntax(Code: TCodeBuffer; out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer; out ErrorMsg: string): boolean;
|
|
function ExploreDirectives(Code: TCodeBuffer;
|
|
out ADirectivesTool: TDirectivesTool): boolean;
|
|
function ExploreUnitDirectives(Code: TCodeBuffer;
|
|
out aScanner: TLinkScanner): boolean;
|
|
|
|
// compiler directives
|
|
function GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
// find include directive of include file at position X,Y
|
|
function FindEnclosingIncludeDirective(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindResourceDirective(Code: TCodeBuffer; StartX, StartY: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
|
|
const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
|
|
function AddResourceDirective(Code: TCodeBuffer; const Filename: string;
|
|
SearchInCleanSrc: boolean = true; const NewSrc: string = ''): boolean;
|
|
function FindIncludeDirective(Code: TCodeBuffer; StartX, StartY: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
|
|
const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
|
|
function AddIncludeDirective(Code: TCodeBuffer; const Filename: string;
|
|
const NewSrc: string = ''): boolean; deprecated;
|
|
function AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string;
|
|
const NewSrc: string = ''): boolean;
|
|
function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer;
|
|
RemoveEmptyIFs: boolean): boolean;
|
|
function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
|
|
out MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
|
function FixMissingH2PasDirectives(Code: TCodeBuffer;
|
|
var Changed: boolean): boolean;
|
|
function ReduceCompilerDirectives(Code: TCodeBuffer;
|
|
Undefines, Defines: TStrings; var Changed: boolean): boolean;
|
|
|
|
// keywords and comments
|
|
function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean;
|
|
function ExtractCodeWithoutComments(Code: TCodeBuffer): string;
|
|
function GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
|
|
out ListOfPCodeXYPosition: TFPList): boolean;
|
|
|
|
// blocks (e.g. begin..end, case..end, try..finally..end, repeat..until)
|
|
function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindBlockStart(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer;
|
|
SkipStart: boolean = false): boolean;
|
|
function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
|
|
OnlyIfCursorBlockIndented: boolean): boolean;
|
|
function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
|
|
OnlyIfCursorBlockIndented: boolean;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// method jumping
|
|
function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer;
|
|
out RevertableJump: boolean): boolean;
|
|
function FindProcDeclaration(Code: TCodeBuffer; CleanDef: string;
|
|
out Tool: TCodeTool; out Node: TCodeTreeNode;
|
|
Attr: TProcHeadAttributes = [phpWithoutSemicolon]): boolean;
|
|
|
|
// find declaration
|
|
function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer;
|
|
Flags: TFindSmartFlags = DefaultFindSmartFlags): boolean;
|
|
function FindDeclarationOfIdentifier(Code: TCodeBuffer; X,Y: integer;
|
|
Identifier: PChar;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindSmartHint(Code: TCodeBuffer; X,Y: integer;
|
|
Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
|
|
function FindDeclarationInInterface(Code: TCodeBuffer;
|
|
const Identifier: string; out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
|
|
const Identifier: string;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): Boolean;
|
|
function FindDeclarationAndOverload(Code: TCodeBuffer; X,Y: integer;
|
|
out ListOfPCodeXYPosition: TFPList;
|
|
Flags: TFindDeclarationListFlags): boolean;
|
|
function FindMainDeclaration(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindDeclarationOfPropertyPath(Code: TCodeBuffer;
|
|
const PropertyPath: string; out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): Boolean;
|
|
|
|
// get code context
|
|
function FindCodeContext(Code: TCodeBuffer; X,Y: integer;
|
|
out CodeContexts: TCodeContextInfo): boolean;
|
|
function ExtractProcedureHeader(Code: TCodeBuffer; X,Y: integer;
|
|
Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
|
|
|
|
// gather identifiers (i.e. all visible)
|
|
function GatherUnitNames(Code: TCodeBuffer): Boolean;
|
|
function GatherIdentifiers(Code: TCodeBuffer; X,Y: integer): boolean;
|
|
function GetIdentifierAt(Code: TCodeBuffer; X,Y: integer;
|
|
var Identifier: string): boolean;
|
|
function IdentItemCheckHasChilds(IdentItem: TIdentifierListItem): boolean;
|
|
function FindAbstractMethods(Code: TCodeBuffer; X,Y: integer;
|
|
out ListOfPCodeXYPosition: TFPList;
|
|
SkipAbstractsInStartClass: boolean = false): boolean;
|
|
function GetValuesOfCaseVariable(Code: TCodeBuffer; X,Y: integer;
|
|
List: TStrings): boolean;
|
|
function GatherOverloads(Code: TCodeBuffer; X,Y: integer;
|
|
out Graph: TDeclarationOverloadsGraph): boolean;
|
|
|
|
// find references, rename identifier, remove identifier
|
|
function FindReferences(IdentifierCode: TCodeBuffer;
|
|
X, Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
|
|
var ListOfPCodeXYPosition: TFPList;
|
|
var Cache: TFindIdentifierReferenceCache // you must free Cache
|
|
): boolean;
|
|
function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
|
|
SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
|
|
function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
|
|
SkipComments: boolean; out UsedUnitFilename: string;
|
|
var ListOfPCodeXYPosition: TFPList): boolean;
|
|
function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
|
|
const OldIdentifier, NewIdentifier: string;
|
|
DeclarationCode: TCodeBuffer = nil; DeclarationCaretXY: PPoint = nil): boolean;
|
|
function ReplaceWord(Code: TCodeBuffer; const OldWord, NewWord: string;
|
|
ChangeStrings: boolean): boolean;
|
|
function RemoveIdentifierDefinition(Code: TCodeBuffer; X, Y: integer
|
|
): boolean; // e.g. remove the variable definition at X,Y
|
|
function RemoveWithBlock(Code: TCodeBuffer; X, Y: integer): boolean;
|
|
function AddWithBlock(Code: TCodeBuffer; X1, Y1, X2, Y2: integer;
|
|
const WithExpr: string; // if empty: collect Candidates
|
|
Candidates: TStrings): boolean;
|
|
function ChangeParamList(Code: TCodeBuffer;
|
|
Changes: TObjectList; // list of TChangeParamListItem
|
|
var ProcPos: TCodeXYPosition; // if it is in this unit the proc declaration is changed and this position is cleared
|
|
TreeOfPCodeXYPosition: TAVLTree // positions in this unit are processed and removed from the tree
|
|
): boolean;
|
|
|
|
|
|
// resourcestring sections
|
|
function GatherResourceStringSections(
|
|
Code: TCodeBuffer; X,Y: integer;
|
|
CodePositions: TCodeXYPositions): boolean;
|
|
function IdentifierExistsInResourceStringSection(Code: TCodeBuffer;
|
|
X,Y: integer; const ResStrIdentifier: string): boolean;
|
|
function CreateIdentifierFromStringConst(
|
|
StartCode: TCodeBuffer; StartX, StartY: integer;
|
|
EndCode: TCodeBuffer; EndX, EndY: integer;
|
|
out Identifier: string; MaxLen: integer): boolean;
|
|
function StringConstToFormatString(
|
|
StartCode: TCodeBuffer; StartX, StartY: integer;
|
|
EndCode: TCodeBuffer; EndX, EndY: integer;
|
|
out FormatStringConstant, FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
function GatherResourceStringsWithValue(SectionCode: TCodeBuffer;
|
|
SectionX, SectionY: integer; const StringValue: string;
|
|
CodePositions: TCodeXYPositions): boolean;
|
|
function AddResourcestring(CursorCode: TCodeBuffer; X,Y: integer;
|
|
SectionCode: TCodeBuffer; SectionX, SectionY: integer;
|
|
const NewIdentifier, NewValue: string;
|
|
InsertPolicy: TResourcestringInsertPolicy): boolean;
|
|
procedure ImproveStringConstantStart(const ACode: string;
|
|
var StartPos: integer);
|
|
procedure ImproveStringConstantEnd(const ACode: string;
|
|
var EndPos: integer);
|
|
|
|
// expressions
|
|
function GetStringConstBounds(Code: TCodeBuffer; X,Y: integer;
|
|
var StartCode: TCodeBuffer; var StartX, StartY: integer;
|
|
var EndCode: TCodeBuffer; var EndX, EndY: integer;
|
|
ResolveComments: boolean): boolean;
|
|
function ReplaceCode(Code: TCodeBuffer; StartX, StartY: integer;
|
|
EndX, EndY: integer; const NewCode: string): boolean;
|
|
function ExtractOperand(Code: TCodeBuffer; X,Y: integer;
|
|
out Operand: string; WithPostTokens, WithAsOperator,
|
|
WithoutTrailingPoints: boolean): boolean;
|
|
function GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
|
|
out Operand: string; ResolveProperty: Boolean): Boolean;
|
|
|
|
// code completion = auto class completion, auto forward proc completion,
|
|
// local var assignment completion, event assignment completion
|
|
function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function CreateVariableForIdentifier(Code: TCodeBuffer; X,Y,TopLine: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function AddMethods(Code: TCodeBuffer; X,Y, TopLine: integer;
|
|
ListOfPCodeXYPosition: TFPList;
|
|
const VirtualToOverride: boolean;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
function GuessTypeOfIdentifier(Code: TCodeBuffer; X,Y: integer;
|
|
out ItsAKeyword, IsSubIdentifier: boolean;
|
|
out ExistingDefinition: TFindContext; // next existing definition
|
|
out ListOfPFindContext: TFPList; // possible classes
|
|
out NewExprType: TExpressionType; out NewType: string): boolean; // false = not at an identifier or syntax error
|
|
function DeclareVariableNearBy(Code: TCodeBuffer; X,Y: integer;
|
|
const VariableName, NewType, NewUnitName: string;
|
|
Visibility: TCodeTreeNodeDesc;
|
|
LvlPosCode: TCodeBuffer = nil; LvlPosX: integer = 0; LvlPosY: integer = 0
|
|
): boolean;
|
|
function DeclareVariableAt(Code: TCodeBuffer; X,Y: integer;
|
|
const VariableName, NewType, NewUnitName: string): boolean;
|
|
function FindRedefinitions(Code: TCodeBuffer;
|
|
out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
|
|
function RemoveRedefinitions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
|
|
function FindAliasDefinitions(Code: TCodeBuffer;
|
|
out TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
|
|
function FixAliasDefinitions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
|
|
function FindConstFunctions(Code: TCodeBuffer;
|
|
out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function ReplaceConstFunctions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
|
|
function FindTypeCastFunctions(Code: TCodeBuffer;
|
|
out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function ReplaceTypeCastFunctions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
function ReplaceAllTypeCastFunctions(Code: TCodeBuffer): boolean;
|
|
function FixForwardDefinitions(Code: TCodeBuffer): boolean;
|
|
function FindEmptyMethods(Code: TCodeBuffer;
|
|
const AClassName: string; // can be ''
|
|
X,Y: integer;
|
|
const Sections: TPascalClassSections;
|
|
ListOfPCodeXYPosition: TFPList;
|
|
out AllEmpty: boolean): boolean;
|
|
function RemoveEmptyMethods(Code: TCodeBuffer;
|
|
const AClassName: string; X,Y: integer;
|
|
const Sections: TPascalClassSections;
|
|
out AllRemoved: boolean;
|
|
const Attr: TProcHeadAttributes;
|
|
out RemovedProcHeads: TStrings): boolean;
|
|
function FindUnusedUnits(Code: TCodeBuffer; Units: TStrings): boolean;
|
|
|
|
// custom class completion
|
|
function InitClassCompletion(Code: TCodeBuffer;
|
|
const AClassName: string; out CodeTool: TCodeTool): boolean;
|
|
|
|
// extract proc (creates a new procedure from code in selection)
|
|
function CheckExtractProc(Code: TCodeBuffer;
|
|
const StartPoint, EndPoint: TPoint;
|
|
out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean;
|
|
out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
|
|
VarTree: TAVLTree = nil // tree of TExtractedProcVariable
|
|
): boolean;
|
|
function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint;
|
|
ProcType: TExtractProcType; const ProcName: string;
|
|
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
|
|
FunctionResultVariableStartPos: integer = 0
|
|
): boolean;
|
|
|
|
// Assign method
|
|
function FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
|
|
out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
|
|
out AssignDeclNode: TCodeTreeNode;
|
|
var MemberNodeExts: TAVLTree; // tree of TCodeTreeNodeExtension, Node=var or property, Data=write property
|
|
out AssignBodyNode: TCodeTreeNode;
|
|
out InheritedDeclContext: TFindContext;
|
|
ProcName: string = '' // default: Assign
|
|
): boolean;
|
|
|
|
// code templates
|
|
function InsertCodeTemplate(Code: TCodeBuffer;
|
|
SelectionStart, SelectionEnd: TPoint;
|
|
TopLine: integer;
|
|
CodeTemplate: TCodeToolTemplate;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// source name e.g. 'unit AUnitName;'
|
|
function GetSourceName(Code: TCodeBuffer; SearchMainCode: boolean): string;
|
|
function GetCachedSourceName(Code: TCodeBuffer): string;
|
|
function RenameSource(Code: TCodeBuffer; const NewName: string): boolean;
|
|
function GetSourceType(Code: TCodeBuffer; SearchMainCode: boolean): string;
|
|
|
|
// uses sections
|
|
function FindUnitInAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string; out NamePos, InPos: integer;
|
|
const IgnoreMissingIncludeFiles: Boolean = False): boolean;
|
|
function RenameUsedUnit(Code: TCodeBuffer;
|
|
const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
|
|
function ReplaceUsedUnits(Code: TCodeBuffer;
|
|
UnitNamePairs: TStringToStringTree): boolean;
|
|
function AddUnitToMainUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string;
|
|
AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
|
|
function AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string;
|
|
AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
|
|
function AddUnitToImplementationUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string;
|
|
AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
|
|
function RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string): boolean;
|
|
function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection: TStrings
|
|
): boolean; // only main uses section, if unit not found, returns "unitname" or "unitname in 'filename'"
|
|
function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean;
|
|
function FindUsedUnitNames(Code: TCodeBuffer; var MainUsesSection,
|
|
ImplementationUsesSection: TStrings): boolean; // ignoring 'in'
|
|
function FindMissingUnits(Code: TCodeBuffer; var MissingUnits: TStrings;
|
|
FixCase: boolean = false; SearchImplementation: boolean = true): boolean;
|
|
function FindDelphiProjectUnits(Code: TCodeBuffer;
|
|
var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean;
|
|
function FindDelphiPackageUnits(Code: TCodeBuffer;
|
|
var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean;
|
|
function CommentUnitsInUsesSections(Code: TCodeBuffer;
|
|
MissingUnits: TStrings): boolean;
|
|
function FindUnitCaseInsensitive(Code: TCodeBuffer;
|
|
var AnUnitName, AnUnitInFilename: string): string;
|
|
function FindUnitSource(Code: TCodeBuffer;
|
|
const AnUnitName, AnUnitInFilename: string): TCodeBuffer;
|
|
function CreateUsesGraph: TUsesGraph;
|
|
|
|
// resources
|
|
property OnFindDefinePropertyForContext: TOnFindDefinePropertyForContext
|
|
read FOnFindDefinePropertyForContext
|
|
write FOnFindDefinePropertyForContext;
|
|
property OnFindDefineProperty: TOnFindDefineProperty
|
|
read FOnFindDefineProperty
|
|
write FOnFindDefineProperty;
|
|
function FindLFMFileName(Code: TCodeBuffer): string;
|
|
function CheckLFM(UnitCode, LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
|
|
RootMustBeClassInUnit, RootMustBeClassInIntf,
|
|
ObjectsMustExist: boolean): boolean;
|
|
function FindNextResourceFile(Code: TCodeBuffer;
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
function AddLazarusResourceHeaderComment(Code: TCodeBuffer;
|
|
const CommentText: string): boolean;
|
|
function FindLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): TAtomPosition;
|
|
function AddLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName, ResourceData: string): boolean;
|
|
function RemoveLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): boolean;
|
|
function RenameMainInclude(Code: TCodeBuffer; const NewFilename: string;
|
|
KeepPath: boolean): boolean;
|
|
function RenameIncludeDirective(Code: TCodeBuffer; LinkIndex: integer;
|
|
const NewFilename: string; KeepPath: boolean): boolean;// in cleaned source
|
|
procedure DefaultFindDefinePropertyForContext(Sender: TObject;
|
|
const ClassContext, AncestorClassContext: TFindContext;
|
|
LFMNode: TLFMTreeNode;
|
|
const IdentName: string; var IsDefined: boolean);
|
|
|
|
// register proc
|
|
function HasInterfaceRegisterProc(Code: TCodeBuffer;
|
|
var HasRegisterProc: boolean): boolean;
|
|
|
|
// Delphi to Lazarus conversion
|
|
function ConvertDelphiToLazarusSource(Code: TCodeBuffer;
|
|
AddLRSCode: boolean): boolean;
|
|
|
|
// Application.Createform(ClassName,VarName) statements in program source
|
|
function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
|
|
const AClassName, AVarName: string;
|
|
out Position: integer): integer; // 0=found, -1=not found, 1=found, but wrong classname
|
|
function AddCreateFormStatement(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
function RemoveCreateFormStatement(Code: TCodeBuffer;
|
|
const AVarName: string): boolean;
|
|
function ChangeCreateFormStatement(Code: TCodeBuffer;
|
|
const OldClassName, OldVarName: string;
|
|
const NewClassName, NewVarName: string;
|
|
OnlyIfExists: boolean): boolean;
|
|
function ListAllCreateFormStatements(Code: TCodeBuffer): TStrings;
|
|
function SetAllCreateFromStatements(Code: TCodeBuffer;
|
|
List: TStrings): boolean;
|
|
|
|
// Application.Title:= statements in program source
|
|
function GetApplicationTitleStatement(Code: TCodeBuffer;
|
|
var Title: string): boolean;
|
|
function SetApplicationTitleStatement(Code: TCodeBuffer;
|
|
const NewTitle: string): boolean;
|
|
function RemoveApplicationTitleStatement(Code: TCodeBuffer): boolean;
|
|
|
|
// forms
|
|
// Hint: to find the class use FindDeclarationInInterface
|
|
function RenameForm(Code: TCodeBuffer;
|
|
const OldFormName, OldFormClassName: string;
|
|
const NewFormName, NewFormClassName: string): boolean;
|
|
function FindFormAncestor(Code: TCodeBuffer; const FormClassName: string;
|
|
var AncestorClassName: string; DirtySearch: boolean): boolean;
|
|
|
|
// form components
|
|
function CompleteComponent(Code: TCodeBuffer;
|
|
AComponent, AncestorComponent: TComponent): boolean;
|
|
function PublishedVariableExists(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string;
|
|
ErrorOnClassNotFound: boolean): boolean;
|
|
function AddPublishedVariable(Code: TCodeBuffer;
|
|
const AClassName,VarName, VarType: string): boolean;
|
|
function RemovePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string;
|
|
ErrorOnClassNotFound: boolean): boolean;
|
|
function RenamePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, OldVariableName, NewVarName,
|
|
VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
|
|
function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string;
|
|
ListOfReTypes: TStringToStringTree;
|
|
ErrorOnClassNotFound: boolean;
|
|
SearchImplementationToo: boolean = false): boolean;
|
|
function FindDanglingComponentEvents(Code: TCodeBuffer;
|
|
const AClassName: string;
|
|
RootComponent: TComponent; ExceptionOnClassNotFound,
|
|
SearchInAncestors: boolean;
|
|
out ListOfPInstancePropInfo: TFPList;
|
|
const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
|
|
|
|
// functions for events in the object inspector
|
|
function GetCompatiblePublishedMethods(Code: TCodeBuffer;
|
|
const AClassName: string;
|
|
PropInstance: TPersistent; const PropName: string;
|
|
const Proc: TGetStrProc): boolean;
|
|
function GetCompatiblePublishedMethods(Code: TCodeBuffer;
|
|
const AClassName: string; TypeData: PTypeData;
|
|
const Proc: TGetStrProc): boolean;
|
|
function PublishedMethodExists(Code:TCodeBuffer;
|
|
const AClassName, AMethodName: string;
|
|
PropInstance: TPersistent; const PropName: string;
|
|
out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
|
|
): boolean;
|
|
function PublishedMethodExists(Code:TCodeBuffer; const AClassName,
|
|
AMethodName: string; TypeData: PTypeData;
|
|
out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
|
|
): boolean;
|
|
function JumpToPublishedMethodBody(Code: TCodeBuffer;
|
|
const AClassName, AMethodName: string;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
function RenamePublishedMethod(Code: TCodeBuffer;
|
|
const AClassName, OldMethodName,
|
|
NewMethodName: string): boolean;
|
|
function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
|
|
NewMethodName: string; ATypeInfo: PTypeInfo;
|
|
UseTypeInfoForParameters: boolean = false;
|
|
const APropertyUnitName: string = ''; const APropertyPath: string = '';
|
|
const CallAncestorMethod: string = ''
|
|
): boolean;
|
|
|
|
// private class parts
|
|
function CreatePrivateMethod(Code: TCodeBuffer; const AClassName,
|
|
NewMethodName: string; ATypeInfo: PTypeInfo;
|
|
UseTypeInfoForParameters: boolean = false;
|
|
const APropertyUnitName: string = '';
|
|
const APropertyPath: string = ''): boolean;
|
|
|
|
// IDE % directives
|
|
function GetIDEDirectives(Code: TCodeBuffer;
|
|
DirectiveList: TStrings): boolean;
|
|
function SetIDEDirectives(Code: TCodeBuffer;
|
|
DirectiveList: TStrings): boolean;
|
|
|
|
// linker jumping
|
|
function JumpToLinkerIdentifier(Code: TCodeBuffer;
|
|
const SourceFilename: string; SourceLine: integer;
|
|
const MangledFunction, Identifier: string;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// gdb stacktraces
|
|
function FindGBDIdentifier(GDBIdentifier: string; out aComplete: boolean;
|
|
out aMessage: string; const OnFindSource: TOnFindGDBSource;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
procedure ConsistencyCheck;
|
|
procedure WriteDebugReport(WriteTool,
|
|
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
|
|
WriteMemStats: boolean);
|
|
procedure WriteMemoryStats;
|
|
end;
|
|
|
|
|
|
var CodeToolBoss: TCodeToolManager;
|
|
|
|
|
|
function CreateDefinesForFPCMode(const Name: string;
|
|
CompilerMode: TCompilerMode): TDefineTemplate;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
function CompareCodeToolMainSources(Data1, Data2: Pointer): integer;
|
|
var
|
|
Src1, Src2: Pointer;
|
|
begin
|
|
Src1:=TCustomCodeTool(Data1).Scanner.MainCode;
|
|
Src2:=TCustomCodeTool(Data2).Scanner.MainCode;
|
|
if Src1<Src2 then
|
|
Result:=-1
|
|
else if Src1>Src2 then
|
|
Result:=+1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareDirectivesTreeSources(Data1, Data2: Pointer): integer;
|
|
var
|
|
Src1, Src2: Pointer;
|
|
begin
|
|
Src1:=TCompilerDirectivesTree(Data1).Code;
|
|
Src2:=TCompilerDirectivesTree(Data2).Code;
|
|
if Src1<Src2 then
|
|
Result:=-1
|
|
else if Src1>Src2 then
|
|
Result:=+1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject;
|
|
begin
|
|
Result:=CodeToolBoss.GetOwnerForCodeTreeNode(ANode);
|
|
end;
|
|
|
|
procedure DumpExceptionBackTrace;
|
|
var
|
|
FrameCount: integer;
|
|
Frames: PPointer;
|
|
FrameNumber:Integer;
|
|
begin
|
|
DebugLn('Codetools Stack trace:');
|
|
DebugLn(BackTraceStrFunc(ExceptAddr));
|
|
FrameCount:=ExceptFrameCount;
|
|
Frames:=ExceptFrames;
|
|
for FrameNumber := 0 to FrameCount-1 do
|
|
DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
|
|
end;
|
|
|
|
function CreateDefinesForFPCMode(const Name: string; CompilerMode: TCompilerMode
|
|
): TDefineTemplate;
|
|
var
|
|
cm: TCompilerMode;
|
|
NewMode: String;
|
|
begin
|
|
Result:=TDefineTemplate.Create(Name,'set FPC compiler mode',
|
|
'','',da_Block);
|
|
for cm:=Low(TCompilerMode) to High(TCompilerMode) do begin
|
|
Result.AddChild(TDefineTemplate.Create(CompilerModeVars[cm],
|
|
CompilerModeVars[cm],CompilerModeVars[cm],'',da_Undefine));
|
|
end;
|
|
NewMode:=CompilerModeVars[CompilerMode];
|
|
Result.AddChild(TDefineTemplate.Create(NewMode,
|
|
NewMode,NewMode,'1',da_Define));
|
|
end;
|
|
|
|
|
|
{ TCodeToolManager }
|
|
|
|
// inline
|
|
function TCodeToolManager.GetBeautifier: TBeautifyCodeOptions;
|
|
begin
|
|
Result:=SourceChangeCache.BeautifyCodeOptions;
|
|
end;
|
|
|
|
constructor TCodeToolManager.Create;
|
|
begin
|
|
inherited Create;
|
|
FCheckFilesOnDisk:=true;
|
|
FOnFindDefinePropertyForContext:=@DefaultFindDefinePropertyForContext;
|
|
DirectoryCachePool:=TCTDirectoryCachePool.Create;
|
|
DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString;
|
|
DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile;
|
|
DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet;
|
|
DirectoryCachePool.OnGetCompiledUnitFromSet:=@DirectoryCachePoolGetCompiledUnitFromSet;
|
|
DirectoryCachePool.OnIterateFPCUnitsFromSet:=@DirectoryCachePoolIterateFPCUnitsFromSet;
|
|
DefineTree:=TDefineTree.Create;
|
|
DefineTree.OnReadValue:=@DoOnDefineTreeReadValue;
|
|
DefinePool:=TDefinePool.Create;
|
|
SourceCache:=TCodeCache.Create;
|
|
SourceCache.DirectoryCachePool:=DirectoryCachePool;
|
|
if DefaultConfigCodeCache=nil then
|
|
DefaultConfigCodeCache:=SourceCache;
|
|
SourceChangeCache:=TSourceChangeCache.Create;
|
|
SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
|
|
SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
|
|
Indenter:=TFullyAutomaticBeautifier.Create;
|
|
Indenter.OnGetNestedComments:=@DoOnFABGetNestedComments;
|
|
Indenter.OnGetExamples:=@DoOnFABGetExamples;
|
|
Indenter.OnLoadFile:=@DoOnLoadFileForTool;
|
|
GlobalValues:=TExpressionEvaluator.Create;
|
|
OnFileExistsCached:=@DirectoryCachePool.FileExists;
|
|
OnFileAgeCached:=@DirectoryCachePool.FileAge;
|
|
DefineTree.DirectoryCachePool:=DirectoryCachePool;
|
|
FPCDefinesCache:=TFPCDefinesCache.Create(nil);
|
|
PPUCache:=TPPUTools.Create;
|
|
FAddInheritedCodeToOverrideMethod:=true;
|
|
FAdjustTopLineDueToComment:=true;
|
|
FCatchExceptions:=true;
|
|
FCompleteProperties:=true;
|
|
FCursorBeyondEOL:=true;
|
|
FIndentSize:=2;
|
|
FJumpCentered:=true;
|
|
FSourceExtensions:='.pp;.pas;.p;.lpr;.lpk;.dpr;.dpk';
|
|
FVisibleEditorLines:=20;
|
|
FWriteExceptions:=true;
|
|
FPascalTools:=TAVLTree.Create(@CompareCodeToolMainSources);
|
|
FDirectivesTools:=TAVLTree.Create(@CompareDirectivesTreeSources);
|
|
IdentifierList:=TIdentifierList.Create;
|
|
IdentifierHistory:=TIdentifierHistoryList.Create;
|
|
IdentifierList.History:=IdentifierHistory;
|
|
DefaultLFMTrees:=TLFMTrees.Create;
|
|
end;
|
|
|
|
destructor TCodeToolManager.Destroy;
|
|
var
|
|
e: TCodeToolManagerHandler;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] A');
|
|
{$ENDIF}
|
|
FreeAndNil(GlobalValues);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] B');
|
|
{$ENDIF}
|
|
FreeAndNil(DefaultLFMTrees);
|
|
FreeAndNil(Positions);
|
|
FreeAndNil(IdentifierHistory);
|
|
FreeAndNil(IdentifierList);
|
|
FPascalTools.FreeAndClear;
|
|
FreeAndNil(FPascalTools);
|
|
FDirectivesTools.FreeAndClear;
|
|
FreeAndNil(FDirectivesTools);
|
|
FreeAndNil(PPUCache);
|
|
FreeAndNil(FResourceTool);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] C');
|
|
{$ENDIF}
|
|
FreeAndNil(DefineTree);
|
|
FreeAndNil(DefinePool);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] D');
|
|
{$ENDIF}
|
|
FreeAndNil(Indenter);
|
|
FreeAndNil(SourceChangeCache);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] E');
|
|
{$ENDIF}
|
|
if DefaultConfigCodeCache=SourceCache then
|
|
DefaultConfigCodeCache:=nil;
|
|
FreeAndNil(SourceCache);
|
|
if OnFileExistsCached=@DirectoryCachePool.FileExists then
|
|
OnFileExistsCached:=nil;
|
|
if OnFileAgeCached=@DirectoryCachePool.FileAge then
|
|
OnFileAgeCached:=nil;
|
|
FreeAndNil(DirectoryCachePool);
|
|
FreeAndNil(FPCDefinesCache);
|
|
for e:=low(FHandlers) to high(FHandlers) do
|
|
FreeAndNil(FHandlers[e]);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] F');
|
|
{$ENDIF}
|
|
inherited Destroy;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.Destroy] END');
|
|
{$ENDIF}
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap('TCodeToolManager.Destroy END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCodeToolManager.Init(Config: TCodeToolsOptions);
|
|
var
|
|
FPCDefines: TDefineTemplate;
|
|
FPCSrcDefines: TDefineTemplate;
|
|
LazarusSrcDefines: TDefineTemplate;
|
|
CurFPCOptions: String;
|
|
UnitSetCache: TFPCUnitSetCache;
|
|
//CfgCache: TFPCTargetConfigCache;
|
|
|
|
procedure AddFPCOption(s: string);
|
|
begin
|
|
if s='' then exit;
|
|
if CurFPCOptions<>'' then
|
|
CurFPCOptions:=CurFPCOptions+' ';
|
|
CurFPCOptions:=CurFPCOptions+s;
|
|
end;
|
|
|
|
begin
|
|
// set global values
|
|
with GlobalValues do begin
|
|
Variables[ExternalMacroStart+'LazarusSrcDir']:=Config.LazarusSrcDir;
|
|
Variables[ExternalMacroStart+'FPCSrcDir']:=Config.FPCSrcDir;
|
|
Variables[ExternalMacroStart+'LCLWidgetType']:=Config.LCLWidgetType;
|
|
Variables[ExternalMacroStart+'ProjectDir']:=Config.ProjectDir;
|
|
end;
|
|
|
|
FPCDefinesCache.ConfigCaches.Assign(Config.ConfigCaches);
|
|
FPCDefinesCache.SourceCaches.Assign(Config.SourceCaches);
|
|
FPCDefinesCache.TestFilename:=Config.TestPascalFile;
|
|
if FPCDefinesCache.TestFilename='' then
|
|
FPCDefinesCache.TestFilename:=GetTempFilename('fpctest.pas','');
|
|
|
|
UnitSetCache:=FPCDefinesCache.FindUnitSet(Config.FPCPath,
|
|
Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
|
|
true);
|
|
// parse compiler settings, fpc sources
|
|
UnitSetCache.Init;
|
|
//CfgCache:=UnitSetCache.GetConfigCache(false);
|
|
//if CfgCache.TargetOS<>CfgCache.RealTargetOS then
|
|
// debugln(['TCodeToolManager.Init TargetOS=',CfgCache.TargetOS,' RealTargetOS=',CfgCache.RealTargetOS]);
|
|
//if CfgCache.TargetCPU<>CfgCache.RealTargetCPU then
|
|
// debugln(['TCodeToolManager.Init TargetCPU=',CfgCache.TargetCPU,' RealTargetCPU=',CfgCache.RealTargetCPU]);
|
|
|
|
// save
|
|
Config.ConfigCaches.Assign(FPCDefinesCache.ConfigCaches);
|
|
Config.SourceCaches.Assign(FPCDefinesCache.SourceCaches);
|
|
|
|
// create template for FPC settings
|
|
FPCDefines:=CreateFPCTemplate(UnitSetCache,nil);
|
|
DefineTree.Add(FPCDefines);
|
|
|
|
// create template for FPC source directory
|
|
FPCSrcDefines:=CreateFPCSourceTemplate(UnitSetCache,nil);
|
|
DefineTree.Add(FPCSrcDefines);
|
|
|
|
// create template for lazarus source directory
|
|
LazarusSrcDefines:=DefinePool.CreateLazarusSrcTemplate('$(#LazarusSrcDir)',
|
|
'$(#LCLWidgetType)',Config.LazarusSrcOptions,nil);
|
|
DefineTree.Add(LazarusSrcDefines);
|
|
|
|
// create template for LCL project
|
|
DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
|
|
'$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil));
|
|
|
|
//debugln(['TCodeToolManager.Init defines: ',DefineTree.GetDefinesForVirtualDirectory.AsString]);
|
|
//debugln(['TCodeToolManager.Init inc path rtl/system: ',GetIncludePathForDirectory(UnitSetCache.FPCSourceDirectory+'/rtl/bsd')]);
|
|
end;
|
|
|
|
procedure TCodeToolManager.SimpleInit(const ConfigFilename: string);
|
|
var
|
|
Options: TCodeToolsOptions;
|
|
begin
|
|
// setup the Options
|
|
Options:=TCodeToolsOptions.Create;
|
|
try
|
|
// To not parse the FPC sources every time, the options are saved to a file.
|
|
DebugLn(['TCodeToolManager.SimpleInit Config=',ConfigFilename]);
|
|
if FileExistsUTF8(ConfigFilename) then
|
|
Options.LoadFromFile(ConfigFilename);
|
|
// use environment variables
|
|
Options.InitWithEnvironmentVariables;
|
|
// apply defaults
|
|
if Options.FPCSrcDir='' then
|
|
Options.FPCSrcDir:=ExpandFileNameUTF8('~/freepascal/fpc');
|
|
if Options.LazarusSrcDir='' then
|
|
Options.LazarusSrcDir:=ExpandFileNameUTF8('~/pascal/lazarus');
|
|
DebugLn(['TCodeToolManager.SimpleInit PP=',Options.FPCPath,' FPCDIR=',Options.FPCSrcDir,' LAZARUSDIR=',Options.LazarusSrcDir,' FPCTARGET=',Options.TargetOS]);
|
|
// init the codetools
|
|
if not Options.UnitLinkListValid then
|
|
debugln('Scanning FPC sources may take a while ...');
|
|
Init(Options);
|
|
|
|
// save the options and the FPC unit links results.
|
|
Options.SaveToFile(ConfigFilename);
|
|
finally
|
|
Options.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.BeginUpdate;
|
|
begin
|
|
SourceChangeCache.BeginUpdate;
|
|
end;
|
|
|
|
function TCodeToolManager.EndUpdate: boolean;
|
|
begin
|
|
Result:=SourceChangeCache.EndUpdate;
|
|
end;
|
|
|
|
function TCodeToolManager.GatherExternalChanges: boolean;
|
|
var
|
|
Abort: Boolean;
|
|
begin
|
|
Result:=true;
|
|
if Assigned(OnGatherExternalChanges) then begin
|
|
Abort:=false;
|
|
OnGatherExternalChanges(Self,Abort);
|
|
Result:=not Abort;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindFile(const ExpandedFilename: string): TCodeBuffer;
|
|
begin
|
|
Result:=SourceCache.FindFile(ExpandedFilename);
|
|
end;
|
|
|
|
function TCodeToolManager.LoadFile(const ExpandedFilename: string;
|
|
UpdateFromDisk, Revert: boolean): TCodeBuffer;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',dbgs(UpdateFromDisk),' Revert=',dbgs(Revert));
|
|
{$ENDIF}
|
|
if (not UpdateFromDisk) and (not Revert) then begin
|
|
Result:=SourceCache.FindFile(ExpandedFilename);
|
|
if (Result<>nil) and (not Result.IsDeleted) then exit;
|
|
end;
|
|
Result:=SourceCache.LoadFile(ExpandedFilename);
|
|
if Result<>nil then begin
|
|
if Revert then begin
|
|
if not Result.Revert then
|
|
Result:=nil;
|
|
end else if UpdateFromDisk and Result.AutoRevertFromDisk
|
|
and Result.FileNeedsUpdate then begin
|
|
//debugln(['TCodeToolManager.LoadFile ',ExpandedFilename,' AutoRevert=',Result.AutoRevertFromDisk,' Modified=',Result.Modified,' NeedLoad=',Result.FileNeedsUpdate]);
|
|
Result.Reload;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateFile(const AFilename: string): TCodeBuffer;
|
|
begin
|
|
Result:=SourceCache.CreateFile(AFilename);
|
|
DirectoryCachePool.IncreaseFileTimeStamp;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('****** TCodeToolManager.CreateFile "',AFilename,'" ',dbgs(Result<>nil));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.CreateTempFile(const AFilename: string): TCodeBuffer;
|
|
var
|
|
i: Integer;
|
|
TempFilename: string;
|
|
CurName: String;
|
|
CurExt: String;
|
|
begin
|
|
TempFilename:=VirtualTempDir+PathDelim+AFilename;
|
|
Result:=FindFile(TempFilename);
|
|
if (Result<>nil) and (Result.ReferenceCount=0) then exit;
|
|
CurName:=ExtractFileNameOnly(AFilename);
|
|
CurExt:=ExtractFileExt(AFilename);
|
|
i:=1;
|
|
repeat
|
|
TempFilename:=VirtualTempDir+PathDelim+CurName+IntToStr(i)+CurExt;
|
|
Result:=FindFile(TempFilename);
|
|
if (Result<>nil) and (Result.ReferenceCount=0) then exit;
|
|
inc(i);
|
|
until Result=nil;
|
|
Result:=SourceCache.CreateFile(TempFilename);
|
|
Result.IncrementRefCount;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ReleaseTempFile(Buffer: TCodeBuffer);
|
|
begin
|
|
Buffer.ReleaseRefCount;
|
|
end;
|
|
|
|
function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
|
|
const ExpandedFilename: string; out NewBuffer: TCodeBuffer): boolean;
|
|
begin
|
|
Result:=SourceCache.SaveBufferAs(OldBuffer,ExpandedFilename,NewBuffer);
|
|
end;
|
|
|
|
function TCodeToolManager.FilenameHasSourceExt(
|
|
const AFilename: string): boolean;
|
|
var i, CurExtStart, CurExtEnd, ExtStart, ExtLen: integer;
|
|
begin
|
|
ExtStart:=length(AFilename);
|
|
while (ExtStart>0) and (AFilename[ExtStart]<>'.')
|
|
and (AFilename[ExtStart]<>PathDelim) do
|
|
dec(ExtStart);
|
|
if (ExtStart<1) or (AFilename[ExtStart]<>'.') then begin
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
ExtLen:=length(AFilename)-ExtStart+1;
|
|
CurExtStart:=1;
|
|
CurExtEnd:=CurExtStart;
|
|
while CurExtEnd<=length(FSourceExtensions)+1 do begin
|
|
if (CurExtEnd>length(FSourceExtensions))
|
|
or (FSourceExtensions[CurExtEnd] in [':',';']) then begin
|
|
// compare current extension with filename-extension
|
|
if ExtLen=CurExtEnd-CurExtStart then begin
|
|
i:=0;
|
|
while (i<ExtLen)
|
|
and (UpChars[AFilename[i+ExtStart]]
|
|
=UpChars[FSourceExtensions[CurExtStart+i]]) do
|
|
inc(i);
|
|
if i=ExtLen then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
inc(CurExtEnd);
|
|
CurExtStart:=CurExtEnd;
|
|
end else
|
|
inc(CurExtEnd);
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCodeToolManager.GetMainCode(Code: TCodeBuffer): TCodeBuffer;
|
|
var
|
|
NewFile: TCodeBuffer;
|
|
begin
|
|
// find MainCode (= the start source, e.g. a unit/program/package source)
|
|
Result:=Code;
|
|
if Result=nil then exit;
|
|
// if this is an include file, find the top level source
|
|
while (Result.LastIncludedByFile<>'') do begin
|
|
NewFile:=SourceCache.LoadFile(Result.LastIncludedByFile);
|
|
if (NewFile=nil) then begin
|
|
Result.LastIncludedByFile:='';
|
|
break;
|
|
end;
|
|
Result:=NewFile;
|
|
end;
|
|
if (not FilenameHasSourceExt(Result.Filename)) then begin
|
|
NewFile:=FindCodeOfMainUnitHint(Result);
|
|
if NewFile<>nil then Result:=NewFile;
|
|
end;
|
|
CreateScanner(Result);
|
|
end;
|
|
|
|
function TCodeToolManager.GetIncludeCodeChain(Code: TCodeBuffer;
|
|
RemoveFirstCodesWithoutTool: boolean; out ListOfCodeBuffer: TFPList): boolean;
|
|
var
|
|
OldCode: TCodeBuffer;
|
|
NewCode: TCodeBuffer;
|
|
begin
|
|
// find MainCode (= the start source, e.g. a unit/program/package source)
|
|
Result:=false;
|
|
ListOfCodeBuffer:=nil;
|
|
if Code=nil then exit;
|
|
|
|
Result:=true;
|
|
ListOfCodeBuffer:=TFPList.Create;
|
|
ListOfCodeBuffer.Add(Code);
|
|
|
|
// if this is an include file, find the top level source
|
|
while (Code.LastIncludedByFile<>'') do begin
|
|
NewCode:=SourceCache.LoadFile(Code.LastIncludedByFile);
|
|
if NewCode=nil then begin
|
|
NewCode.LastIncludedByFile:='';
|
|
break;
|
|
end;
|
|
Code:=NewCode;
|
|
ListOfCodeBuffer.Insert(0,Code);
|
|
end;
|
|
|
|
if (not FilenameHasSourceExt(Code.Filename)) then begin
|
|
OldCode:=Code;
|
|
Code:=FindCodeOfMainUnitHint(OldCode);
|
|
if Code<>OldCode then
|
|
ListOfCodeBuffer.Insert(0,Code);
|
|
end;
|
|
|
|
if RemoveFirstCodesWithoutTool then begin
|
|
while ListOfCodeBuffer.Count>0 do begin
|
|
Code:=TCodeBuffer(ListOfCodeBuffer[0]);
|
|
if FindCodeToolForSource(Code)<>nil then break;
|
|
ListOfCodeBuffer.Delete(0);
|
|
end;
|
|
if ListOfCodeBuffer.Count=0 then begin
|
|
ListOfCodeBuffer.Free;
|
|
ListOfCodeBuffer:=nil;
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindCodeOfMainUnitHint(Code: TCodeBuffer
|
|
): TCodeBuffer;
|
|
var
|
|
MainUnitFilename: string;
|
|
begin
|
|
Result:=nil;
|
|
if Code=nil then exit;
|
|
//DebugLn('TCodeToolManager.FindCodeOfMainUnitHint ',Code.Filename);
|
|
if not FindMainUnitHint(Code.Source,MainUnitFilename) then exit;
|
|
if MainUnitFilename='' then exit;
|
|
MainUnitFilename:=TrimFilename(MainUnitFilename);
|
|
if (not FilenameIsAbsolute(MainUnitFilename))
|
|
and (not Code.IsVirtual) then
|
|
MainUnitFilename:=TrimFilename(ExtractFilePath(Code.Filename)+PathDelim
|
|
+MainUnitFilename);
|
|
//DebugLn('TCodeToolManager.FindCodeOfMainUnitHint B ');
|
|
Result:=SourceCache.LoadFile(MainUnitFilename);
|
|
end;
|
|
|
|
procedure TCodeToolManager.CreateScanner(Code: TCodeBuffer);
|
|
begin
|
|
if FilenameHasSourceExt(Code.Filename) and (Code.Scanner=nil) then begin
|
|
// create a scanner for the unit/program
|
|
Code.Scanner:=TLinkScanner.Create;
|
|
Code.Scanner.OnGetInitValues:=@DoOnScannerGetInitValues;
|
|
Code.Scanner.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
|
|
Code.Scanner.OnGetGlobalChangeSteps:=@DoOnToolGetChangeSteps;
|
|
Code.Scanner.OnProgress:=@DoOnScannerProgress;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ClearError;
|
|
begin
|
|
fErrorMsg:='';
|
|
fErrorCode:=nil;
|
|
fErrorLine:=-1;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ClearCurCodeTool;
|
|
begin
|
|
ClearError;
|
|
FCurCodeTool:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.ApplyChanges: boolean;
|
|
begin
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TCodeToolManager.SetGlobalValue(const VariableName,
|
|
VariableValue: string): boolean;
|
|
var
|
|
OldValue: string;
|
|
begin
|
|
OldValue:=GlobalValues[VariableName];
|
|
Result:=(OldValue<>VariableValue);
|
|
if not Result then exit;
|
|
GlobalValues[VariableName]:=VariableValue;
|
|
DefineTree.ClearCache;
|
|
end;
|
|
|
|
function TCodeToolManager.GetUnitPathForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
begin
|
|
if UseCache then
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitPath,true)
|
|
else
|
|
Result:=DefineTree.GetUnitPathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetIncludePathForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
begin
|
|
if UseCache then
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsIncludePath,true)
|
|
else
|
|
Result:=DefineTree.GetIncludePathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetSrcPathForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
begin
|
|
if UseCache then
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsSrcPath,true)
|
|
else
|
|
Result:=DefineTree.GetSrcPathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompleteSrcPathForDirectory(
|
|
const Directory: string; UseCache: boolean): string;
|
|
// returns the SrcPath + UnitPath + any CompiledSrcPath
|
|
var
|
|
CurUnitPath: String;
|
|
StartPos: Integer;
|
|
EndPos: LongInt;
|
|
CurSrcPath: String;
|
|
CurUnitDir: String;
|
|
CurCompiledSrcPath: String;
|
|
begin
|
|
if UseCache then
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsCompleteSrcPath,true)
|
|
else begin
|
|
CurUnitPath:='.;'+GetUnitPathForDirectory(Directory);
|
|
CurSrcPath:=GetSrcPathForDirectory(Directory);
|
|
// for every unit path, get the CompiledSrcPath
|
|
StartPos:=1;
|
|
while StartPos<=length(CurUnitPath) do begin
|
|
EndPos:=StartPos;
|
|
while (EndPos<=length(CurUnitPath)) and (CurUnitPath[EndPos]<>';') do
|
|
inc(EndPos);
|
|
if EndPos>StartPos then begin
|
|
CurUnitDir:=TrimFilename(copy(CurUnitPath,StartPos,EndPos-StartPos));
|
|
if not FilenameIsAbsolute(CurUnitDir) then
|
|
CurUnitDir:=TrimFilename(AppendPathDelim(Directory)+CurUnitDir);
|
|
CurCompiledSrcPath:=CreateAbsoluteSearchPath(
|
|
GetCompiledSrcPathForDirectory(CurUnitDir),CurUnitDir);
|
|
if CurCompiledSrcPath<>'' then
|
|
CurSrcPath:=CurSrcPath+';'+CurCompiledSrcPath;
|
|
end;
|
|
StartPos:=EndPos+1;
|
|
end;
|
|
// combine unit, src and compiledsrc search path
|
|
Result:=CurUnitPath+';'+CurSrcPath;
|
|
// make it absolute, so the user need less string concatenations
|
|
if FilenameIsAbsolute(Directory) then
|
|
Result:=CreateAbsoluteSearchPath(Result,Directory);
|
|
// trim the paths, remove doubles and empty paths
|
|
Result:=MinimizeSearchPath(Result);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetPPUSrcPathForDirectory(const Directory: string
|
|
): string;
|
|
begin
|
|
Result:=DefineTree.GetPPUSrcPathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetDCUSrcPathForDirectory(const Directory: string
|
|
): string;
|
|
begin
|
|
Result:=DefineTree.GetDCUSrcPathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompiledSrcPathForDirectory(
|
|
const Directory: string; UseCache: boolean): string;
|
|
begin
|
|
Result:=DefineTree.GetCompiledSrcPathForDirectory(Directory);
|
|
end;
|
|
|
|
function TCodeToolManager.GetNestedCommentsFlagForFile(
|
|
const Filename: string): boolean;
|
|
var
|
|
Directory: String;
|
|
begin
|
|
Result:=false;
|
|
Directory:=ExtractFilePath(Filename);
|
|
// check pascal compiler is FPC and mode is FPC or OBJFPC
|
|
if GetPascalCompilerForDirectory(Directory)<>pcFPC then exit;
|
|
if not (GetCompilerModeForDirectory(Directory) in [cmFPC,cmOBJFPC]) then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCodeToolManager.GetPascalCompilerForDirectory(const Directory: string
|
|
): TPascalCompiler;
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
PascalCompiler: string;
|
|
pc: TPascalCompiler;
|
|
begin
|
|
Result:=pcFPC;
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
PascalCompiler:=Evaluator.Variables[PascalCompilerDefine];
|
|
for pc:=Low(TPascalCompiler) to High(TPascalCompiler) do
|
|
if (PascalCompiler=PascalCompilerNames[pc]) then
|
|
Result:=pc;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompilerModeForDirectory(const Directory: string
|
|
): TCompilerMode;
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
cm: TCompilerMode;
|
|
begin
|
|
Result:=cmFPC;
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
for cm:=Succ(Low(TCompilerMode)) to High(TCompilerMode) do
|
|
if Evaluator.IsDefined(CompilerModeVars[cm]) then
|
|
Result:=cm;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompiledSrcExtForDirectory(const Directory: string
|
|
): string;
|
|
begin
|
|
Result:='.ppu';
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitInUnitLinks(const Directory, AUnitName: string
|
|
): string;
|
|
begin
|
|
Result:=DirectoryCachePool.FindUnitInUnitLinks(Directory,AUnitName);
|
|
end;
|
|
|
|
function TCodeToolManager.GetUnitLinksForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
begin
|
|
if UseCache then begin
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitLinks,true)
|
|
end else begin
|
|
Result:='';
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
Result:=Evaluator[UnitLinksMacroName];
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitInUnitSet(const Directory, AUnitName: string
|
|
): string;
|
|
begin
|
|
Result:=DirectoryCachePool.FindUnitInUnitSet(Directory,AUnitName);
|
|
end;
|
|
|
|
function TCodeToolManager.GetUnitSetIDForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
begin
|
|
if UseCache then begin
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitSet,true)
|
|
end else begin
|
|
Result:='';
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
Result:=Evaluator[UnitSetMacroName];
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetUnitSetForDirectory(const Directory: string
|
|
): TFPCUnitSetCache;
|
|
var
|
|
ID: String;
|
|
Changed: boolean;
|
|
begin
|
|
Result:=nil;
|
|
ID:=GetUnitSetIDForDirectory(Directory,true);
|
|
if ID='' then exit;
|
|
Changed:=false;
|
|
Result:=FPCDefinesCache.FindUnitSetWithID(ID,Changed,false);
|
|
if Changed then Result:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.GetFPCUnitPathForDirectory(const Directory: string;
|
|
UseCache: boolean): string;
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
begin
|
|
if UseCache then begin
|
|
Result:=DirectoryCachePool.GetString(Directory,ctdcsFPCUnitPath,true)
|
|
end else begin
|
|
Result:='';
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
Result:=Evaluator[FPCUnitPathMacroName];
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.GetFPCVersionForDirectory(const Directory: string;
|
|
out FPCVersion, FPCRelease, FPCPatch: integer);
|
|
var
|
|
Evaluator: TExpressionEvaluator;
|
|
i: Integer;
|
|
VarName: String;
|
|
p: Integer;
|
|
|
|
function ReadInt(var AnInteger: integer): boolean;
|
|
var
|
|
StartPos: Integer;
|
|
begin
|
|
StartPos:=p;
|
|
AnInteger:=0;
|
|
while (p<=length(VarName)) and (VarName[p] in ['0'..'9']) do begin
|
|
AnInteger:=AnInteger*10+(ord(VarName[p])-ord('0'));
|
|
if AnInteger>=100 then begin
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
inc(p);
|
|
end;
|
|
Result:=StartPos<p;
|
|
end;
|
|
|
|
begin
|
|
FPCVersion:=0;
|
|
FPCRelease:=0;
|
|
FPCPatch:=0;
|
|
Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
|
|
if Evaluator=nil then exit;
|
|
for i:=0 to Evaluator.Count-1 do begin
|
|
VarName:=Evaluator.Names(i);
|
|
if (length(VarName)>3) and (VarName[1] in ['V','v'])
|
|
and (VarName[2] in ['E','e']) and (VarName[3] in ['R','r'])
|
|
and (VarName[4] in ['0'..'9']) then begin
|
|
p:=4;
|
|
if not ReadInt(FPCVersion) then continue;
|
|
if (p>=length(VarName)) or (VarName[p]<>'_') then continue;
|
|
inc(p);
|
|
if not ReadInt(FPCRelease) then continue;
|
|
if (p>=length(VarName)) or (VarName[p]<>'_') then continue;
|
|
inc(p);
|
|
if not ReadInt(FPCPatch) then continue;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.FreeListOfPCodeXYPosition(var List: TFPList);
|
|
begin
|
|
CodeCache.FreeListOfPCodeXYPosition(List);
|
|
List:=nil;
|
|
end;
|
|
|
|
procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
|
|
begin
|
|
CodeCache.FreeTreeOfPCodeXYPosition(Tree);
|
|
Tree:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree;
|
|
begin
|
|
Result:=CodeCache.CreateTreeOfPCodeXYPosition;
|
|
end;
|
|
|
|
procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
|
|
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
|
|
begin
|
|
CodeCache.AddListToTreeOfPCodeXYPosition(SrcList,DestTree,ClearList,CreateCopies);
|
|
end;
|
|
|
|
function TCodeToolManager.Explore(Code: TCodeBuffer;
|
|
out ACodeTool: TCodeTool; WithStatements: boolean; OnlyInterface: boolean
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
ACodeTool:=nil;
|
|
try
|
|
if InitCurCodeTool(Code) then begin
|
|
ACodeTool:=FCurCodeTool;
|
|
FCurCodeTool.Explore(WithStatements,OnlyInterface);
|
|
Result:=true;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
|
|
var MainCode: TCodeBuffer;
|
|
begin
|
|
Result:=false;
|
|
ClearCurCodeTool;
|
|
MainCode:=GetMainCode(Code);
|
|
if MainCode=nil then begin
|
|
FErrorLine:=1;
|
|
FErrorColumn:=1;
|
|
fErrorCode:=Code;
|
|
if Code = nil then
|
|
begin
|
|
fErrorMsg:='TCodeToolManager.InitCurCodeTool Code=nil'
|
|
end
|
|
else begin
|
|
fErrorMsg:='unit of include file is not known (hint: open and explore unit first)';
|
|
end;
|
|
exit;
|
|
end;
|
|
if MainCode.Scanner=nil then begin
|
|
FErrorMsg:=Format(ctsNoScannerFound,[MainCode.Filename]);
|
|
exit;
|
|
end;
|
|
FCurCodeTool:=TCodeTool(GetCodeToolForSource(MainCode,false,true));
|
|
FCurCodeTool.ErrorPosition.Code:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$ENDIF}
|
|
Result:=(FCurCodeTool.Scanner<>nil);
|
|
if not Result then begin
|
|
fErrorCode:=MainCode;
|
|
fErrorMsg:=ctsNoScannerAvailable;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.InitResourceTool: boolean;
|
|
begin
|
|
fErrorMsg:='';
|
|
fErrorCode:=nil;
|
|
fErrorLine:=-1;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ClearPositions;
|
|
begin
|
|
if Positions=nil then
|
|
Positions:=TCodeXYPositions.Create
|
|
else
|
|
Positions.Clear;
|
|
end;
|
|
|
|
function TCodeToolManager.HandleException(AnException: Exception): boolean;
|
|
var
|
|
ErrorSrcTool: TCustomCodeTool;
|
|
DirtyPos: Integer;
|
|
ErrorDirTool: TCompilerDirectivesTree;
|
|
begin
|
|
fErrorMsg:=AnException.Message;
|
|
fErrorTopLine:=0;
|
|
fErrorCode:=nil;
|
|
fErrorColumn:=-1;
|
|
fErrorLine:=-1;
|
|
if (AnException is ELinkScannerError) then begin
|
|
// link scanner error
|
|
if AnException is ELinkScannerConsistency then
|
|
DumpExceptionBackTrace;
|
|
DirtyPos:=0;
|
|
if AnException is ELinkScannerEditError then begin
|
|
fErrorCode:=TCodeBuffer(ELinkScannerEditError(AnException).Buffer);
|
|
if fErrorCode<>nil then
|
|
DirtyPos:=ELinkScannerEditError(AnException).BufferPos;
|
|
end else begin
|
|
fErrorCode:=TCodeBuffer(ELinkScannerError(AnException).Sender.Code);
|
|
DirtyPos:=ELinkScannerError(AnException).Sender.SrcPos;
|
|
end;
|
|
if (fErrorCode<>nil) and (DirtyPos>0) then begin
|
|
fErrorCode.AbsoluteToLineCol(DirtyPos,fErrorLine,fErrorColumn);
|
|
end;
|
|
end else if (AnException is ECodeToolError) then begin
|
|
// codetool error
|
|
ErrorSrcTool:=ECodeToolError(AnException).Sender;
|
|
if ErrorSrcTool.ErrorNicePosition.Code<>nil then begin
|
|
fErrorCode:=ErrorSrcTool.ErrorNicePosition.Code;
|
|
fErrorColumn:=ErrorSrcTool.ErrorNicePosition.X;
|
|
fErrorLine:=ErrorSrcTool.ErrorNicePosition.Y;
|
|
end else begin
|
|
fErrorCode:=ErrorSrcTool.ErrorPosition.Code;
|
|
fErrorColumn:=ErrorSrcTool.ErrorPosition.X;
|
|
fErrorLine:=ErrorSrcTool.ErrorPosition.Y;
|
|
end;
|
|
end else if (AnException is ECDirectiveParserException) then begin
|
|
// Compiler directive parser error
|
|
ErrorDirTool:=ECDirectiveParserException(AnException).Sender;
|
|
fErrorCode:=ErrorDirTool.Code;
|
|
end else if (AnException is ESourceChangeCacheError) then begin
|
|
// SourceChangeCache error
|
|
end else if (AnException is ECodeToolManagerError) then begin
|
|
// CodeToolManager error
|
|
end else begin
|
|
// unknown exception
|
|
DumpExceptionBackTrace;
|
|
FErrorMsg:=AnException.ClassName+': '+FErrorMsg;
|
|
if FCurCodeTool<>nil then begin
|
|
fErrorCode:=FCurCodeTool.ErrorPosition.Code;
|
|
fErrorColumn:=FCurCodeTool.ErrorPosition.X;
|
|
fErrorLine:=FCurCodeTool.ErrorPosition.Y;
|
|
end;
|
|
end;
|
|
|
|
SourceChangeCache.Clear;
|
|
|
|
// adjust error topline
|
|
AdjustErrorTopLine;
|
|
// write error
|
|
WriteError;
|
|
// raise or catch
|
|
if not FCatchExceptions then raise AnException;
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TCodeToolManager.AdjustErrorTopLine;
|
|
begin
|
|
// adjust error topline
|
|
if (fErrorCode<>nil) and (fErrorTopLine<1) then begin
|
|
fErrorTopLine:=fErrorLine;
|
|
if (fErrorTopLine>0) and JumpCentered then begin
|
|
dec(fErrorTopLine,VisibleEditorLines div 2);
|
|
if fErrorTopLine<1 then fErrorTopLine:=1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.WriteError;
|
|
begin
|
|
if FWriteExceptions then begin
|
|
DbgOut('### TCodeToolManager.HandleException: "'+ErrorMessage+'"');
|
|
if ErrorLine>0 then DbgOut(' at Line=',DbgS(ErrorLine));
|
|
if ErrorColumn>0 then DbgOut(' Col=',DbgS(ErrorColumn));
|
|
if ErrorCode<>nil then DbgOut(' in "',ErrorCode.Filename,'"');
|
|
DebugLn('');
|
|
{$IFDEF CTDEBUG}
|
|
WriteDebugReport(true,false,false,false,false,false);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
|
|
out ErrorMsg: string): boolean;
|
|
// returns true on syntax correct
|
|
var
|
|
ACodeTool: TCodeTool;
|
|
begin
|
|
Result:=Explore(Code,ACodeTool,true);
|
|
if ACodeTool=nil then ;
|
|
NewCode:=ErrorCode;
|
|
NewX:=ErrorColumn;
|
|
NewY:=ErrorLine;
|
|
NewTopLine:=ErrorTopLine;
|
|
ErrorMsg:=ErrorMessage;
|
|
end;
|
|
|
|
function TCodeToolManager.ExploreDirectives(Code: TCodeBuffer; out
|
|
ADirectivesTool: TDirectivesTool): boolean;
|
|
begin
|
|
Result:=false;
|
|
ADirectivesTool:=nil;
|
|
try
|
|
if InitCurDirectivesTool(Code) then begin
|
|
ADirectivesTool:=FCurDirectivesTool;
|
|
FCurDirectivesTool.Parse;
|
|
Result:=true;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ExploreUnitDirectives(Code: TCodeBuffer; out
|
|
aScanner: TLinkScanner): boolean;
|
|
begin
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExploreUnitDirectives A ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
aScanner:=FCurCodeTool.Scanner;
|
|
if not aScanner.StoreDirectives then
|
|
aScanner.DemandStoreDirectives;
|
|
aScanner.Scan(lsrEnd,true);
|
|
Result:=true;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExploreUnitDirectives END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
|
|
out RevertableJump: boolean): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.JumpToMethod B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine,
|
|
RevertableJump);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.JumpToMethod END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindProcDeclaration(Code: TCodeBuffer;
|
|
CleanDef: string; out Tool: TCodeTool; out Node: TCodeTreeNode;
|
|
Attr: TProcHeadAttributes): boolean;
|
|
var
|
|
Paths: TStringList;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.FindProcDeclaration A ',Code.Filename,' CleanDef=',CleanDef]);
|
|
{$ENDIF}
|
|
Tool:=nil;
|
|
Node:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
Tool:=FCurCodeTool;
|
|
Paths:=TStringList.Create;
|
|
try
|
|
Paths.Add(CleanDef);
|
|
try
|
|
FCurCodeTool.BuildTree(lsrInitializationStart);
|
|
Node:=FCurCodeTool.FindSubProcPath(Paths,Attr,false);
|
|
Result:=Node<>nil;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
finally
|
|
Paths.Free;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindProcDeclaration END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclaration(Code: TCodeBuffer; X,Y: integer;
|
|
out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer;
|
|
Flags: TFindSmartFlags): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
NewTool: TFindDeclarationTool;
|
|
NewNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y]);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then begin
|
|
{$IFDEF VerboseFindDeclarationFail}
|
|
debugln(['TCodeToolManager.FindDeclaration InitCurCodeTool failed']);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclaration B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
{$IFDEF DoNotHandleFindDeclException}
|
|
DebugLn('TCodeToolManager.FindDeclaration NOT HANDLING EXCEPTIONS');
|
|
RaiseUnhandableExceptions:=true;
|
|
{$ENDIF}
|
|
Result:=FCurCodeTool.FindDeclaration(CursorPos,Flags,NewTool,NewNode,
|
|
NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
if (NewTool=nil) and (NewNode<>nil) then ;
|
|
{$IFDEF CTDEBUG}
|
|
debugln(['TCodeToolManager.FindDeclaration ',Dbgs(NewPos)]);
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF DoNotHandleFindDeclException}
|
|
finally
|
|
RaiseUnhandableExceptions:=false;
|
|
end;
|
|
{$ELSE}
|
|
except
|
|
on e: Exception do begin
|
|
Result:=HandleException(e);
|
|
{$IFDEF VerboseFindDeclarationFail}
|
|
if not Result then
|
|
debugln(['TCodeToolManager.FindDeclaration Exception=',e.Message]);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF VerboseFindDeclarationFail}
|
|
if not Result then begin
|
|
debugln(['TCodeToolManager.FindDeclaration FAILED at ',dbgs(CursorPos)]);
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclaration END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclarationOfIdentifier(Code: TCodeBuffer;
|
|
X,Y: integer; Identifier: PChar; out NewCode: TCodeBuffer; out NewX, NewY,
|
|
NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.FindDeclarationOfIdentifier A ',Code.Filename,' x=',x,' y=',y,' Identifier=',GetIdentifier(Identifier)]);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationOfIdentifier B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
{$IFDEF DoNotHandleFindDeclException}
|
|
DebugLn('TCodeToolManager.FindDeclarationOfIdentifier NOT HANDLING EXCEPTIONS');
|
|
RaiseUnhandableExceptions:=true;
|
|
{$ENDIF}
|
|
Result:=FCurCodeTool.FindDeclarationOfIdentifier(CursorPos,Identifier,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
{$IFDEF DoNotHandleFindDeclException}
|
|
finally
|
|
RaiseUnhandableExceptions:=false;
|
|
end;
|
|
{$ELSE}
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationOfIdentifier END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindSmartHint(Code: TCodeBuffer; X, Y: integer;
|
|
Flags: TFindSmartFlags): string;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindSmartHint A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindSmartHint B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindSmartHint(CursorPos,Flags);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindSmartHint END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclarationInInterface(Code: TCodeBuffer;
|
|
const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY,
|
|
NewTopLine: integer): boolean;
|
|
var
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationInInterface A ',Code.Filename,' Identifier=',Identifier);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationInInterface B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindDeclarationInInterface(Identifier,NewPos,
|
|
NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
|
|
const Identifier: string; out NewCode: TCodeBuffer;
|
|
out NewX, NewY, NewTopLine: integer): Boolean;
|
|
var
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationWithMainUsesSection A ',Code.Filename,' Identifier=',Identifier);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindDeclarationWithMainUsesSection(Identifier,NewPos,
|
|
NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclarationAndOverload(Code: TCodeBuffer; X,
|
|
Y: integer; out ListOfPCodeXYPosition: TFPList;
|
|
Flags: TFindDeclarationListFlags): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationAndOverload A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
ListOfPCodeXYPosition:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationAndOverload B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindDeclarationAndOverload(CursorPos,
|
|
ListOfPCodeXYPosition,Flags);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationAndOverload END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindMainDeclaration(Code: TCodeBuffer; X, Y: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindMainDeclaration A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindMainDeclaration(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindMainDeclaration END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclarationOfPropertyPath(Code: TCodeBuffer;
|
|
const PropertyPath: string; out NewCode: TCodeBuffer; out NewX, NewY,
|
|
NewTopLine: integer): Boolean;
|
|
var
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath A ',Code.Filename,' Path="',PropertyPath,'"');
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindDeclarationOfPropertyPath(PropertyPath,
|
|
NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindCodeContext(Code: TCodeBuffer; X, Y: integer; out
|
|
CodeContexts: TCodeContextInfo): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
CodeContexts:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindCodeContext A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindCodeContext(CursorPos,CodeContexts);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindCodeContext END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.ExtractProcedureHeader(Code: TCodeBuffer; X,
|
|
Y: integer; Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExtractProcedureHeader A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.ExtractProcedureHeader(CursorPos,Attributes,ProcHead);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExtractProcedureHeader END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GatherUnitNames(Code: TCodeBuffer): Boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result := False;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
if IdentifierList<>nil then IdentifierList.Clear;
|
|
CursorPos.X := 0;
|
|
CursorPos.Y := 0;
|
|
CursorPos.Code := Code;
|
|
try
|
|
Result := FCurCodeTool.GatherAvailableUnitNames(CursorPos, IdentifierList);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GatherIdentifiers(Code: TCodeBuffer; X, Y: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherIdentifiers A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
if IdentifierList<>nil then IdentifierList.Clear;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherIdentifiers B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
FIdentifierListUpdating:=true;
|
|
try
|
|
Result:=FCurCodeTool.GatherIdentifiers(CursorPos,IdentifierList);
|
|
finally
|
|
FIdentifierListUpdating:=false;
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherIdentifiers END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GetIdentifierAt(Code: TCodeBuffer; X, Y: integer;
|
|
var Identifier: string): boolean;
|
|
var
|
|
CleanPos: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetIdentifierAt A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
Code.LineColToPosition(Y,X,CleanPos);
|
|
if (CleanPos>0) and (CleanPos<=Code.SourceLength) then begin
|
|
Identifier:=GetIdentifier(@Code.Source[CleanPos]);
|
|
Result:=true;
|
|
end else begin
|
|
Identifier:='';
|
|
Result:=false;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.IdentItemCheckHasChilds(IdentItem: TIdentifierListItem
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.IdentItemCheckHasChilds A ');
|
|
{$ENDIF}
|
|
try
|
|
IdentItem.CheckHasChilds;
|
|
Result:=true;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindAbstractMethods(Code: TCodeBuffer; X, Y: integer;
|
|
out ListOfPCodeXYPosition: TFPList; SkipAbstractsInStartClass: boolean): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
ListOfPCodeXYPosition:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindAbstractMethods(CursorPos,ListOfPCodeXYPosition,
|
|
SkipAbstractsInStartClass);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetValuesOfCaseVariable(Code: TCodeBuffer; X,
|
|
Y: integer; List: TStrings): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetValuesOfCaseVariable A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.GetValuesOfCaseVariable(CursorPos,List);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GatherOverloads(Code: TCodeBuffer; X, Y: integer; out
|
|
Graph: TDeclarationOverloadsGraph): boolean;
|
|
var
|
|
NewCode: TCodeBuffer;
|
|
NewX, NewY, NewTopLine: integer;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherOverloads A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
Graph:=nil;
|
|
if not FindMainDeclaration(Code,X,Y,NewCode,NewX,NewY,NewTopLine)
|
|
then begin
|
|
DebugLn('TCodeToolManager.GatherOverloads unable to FindMainDeclaration ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
exit;
|
|
end;
|
|
if NewTopLine=0 then ;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Graph:=TDeclarationOverloadsGraph.Create;
|
|
Graph.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
|
|
Result:=Graph.Init(NewCode,NewX,NewY);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X,
|
|
Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
|
|
var ListOfPCodeXYPosition: TFPList; var Cache: TFindIdentifierReferenceCache
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewTopLine: integer;
|
|
ImplementationNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
if Cache=nil then
|
|
DebugLn('TCodeToolManager.FindReferences A ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y),' SearchInCode=',SearchInCode.Filename)
|
|
else
|
|
debugln(['TCodeToolManager.FindReferences A SearchInCode=',SearchInCode.Filename]);
|
|
{$ENDIF}
|
|
ListOfPCodeXYPosition:=nil;
|
|
if Cache=nil then
|
|
Cache:=TFindIdentifierReferenceCache.Create;
|
|
if (Cache.SourcesChangeStep=SourceCache.ChangeStamp)
|
|
and (Cache.SourcesChangeStep<>CTInvalidChangeStamp64)
|
|
and (Cache.FilesChangeStep=FileStateCache.TimeStamp)
|
|
and (Cache.FilesChangeStep<>CTInvalidChangeStamp64)
|
|
and (Cache.InitValuesChangeStep=DefineTree.ChangeStep)
|
|
and (Cache.InitValuesChangeStep<>CTInvalidChangeStamp)
|
|
and (Cache.IdentifierCode=IdentifierCode) and (Cache.X=X) and (Cache.Y=Y)
|
|
then begin
|
|
//debugln(['TCodeToolManager.FindReferences cache valid']);
|
|
// all sources and values are the same => use cache
|
|
Result:=true;
|
|
end else begin
|
|
//debugln(['TCodeToolManager.FindReferences cache not valid']);
|
|
{debugln(['TCodeToolManager.FindReferences IdentifierCode=',Cache.IdentifierCode=IdentifierCode,
|
|
' X=',Cache.X=X,' Y=',Cache.Y=Y,
|
|
' SourcesChangeStep=',Cache.SourcesChangeStep=SourceCache.ChangeStamp,',',Cache.SourcesChangeStep=CTInvalidChangeStamp64,
|
|
' FilesChangeStep=',Cache.FilesChangeStep=FileStateCache.TimeStamp,',',Cache.FilesChangeStep=CTInvalidChangeStamp64,
|
|
' InitValuesChangeStep=',Cache.InitValuesChangeStep=DefineTree.ChangeStep,',',Cache.InitValuesChangeStep=CTInvalidChangeStamp,
|
|
'']);}
|
|
Cache.Clear;
|
|
Cache.IdentifierCode:=IdentifierCode;
|
|
Cache.X:=X;
|
|
Cache.Y:=Y;
|
|
Cache.SourcesChangeStep:=SourceCache.ChangeStamp;
|
|
Cache.FilesChangeStep:=FileStateCache.TimeStamp;
|
|
Cache.InitValuesChangeStep:=DefineTree.ChangeStep;
|
|
|
|
if not InitCurCodeTool(IdentifierCode) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=IdentifierCode;
|
|
try
|
|
Result:=FCurCodeTool.FindDeclaration(CursorPos,[fsfFindMainDeclaration],
|
|
Cache.NewTool,Cache.NewNode,Cache.NewPos,NewTopLine);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
if not Result then begin
|
|
debugln(['TCodeToolManager.FindReferences FCurCodeTool.FindDeclaration failed']);
|
|
exit;
|
|
end;
|
|
// check if scope can be limited
|
|
if Cache.NewTool<>nil then begin
|
|
Cache.IsPrivate:=(Cache.NewTool.GetSourceType in [ctnLibrary,ctnProgram]);
|
|
if not Cache.IsPrivate then begin
|
|
ImplementationNode:=Cache.NewTool.FindImplementationNode;
|
|
if (ImplementationNode<>nil)
|
|
and (Cache.NewNode.StartPos>=ImplementationNode.StartPos) then
|
|
Cache.IsPrivate:=true;
|
|
end;
|
|
if not Cache.IsPrivate then begin
|
|
if (Cache.NewNode.GetNodeOfTypes([ctnParameterList,ctnClassPrivate])<>nil) then
|
|
Cache.IsPrivate:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
if (not Result) or (Cache.NewNode=nil) then begin
|
|
DebugLn('TCodeToolManager.FindReferences unable to FindDeclaration ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
exit;
|
|
end;
|
|
Result:=true;
|
|
if NewTopLine=0 then ;
|
|
if not InitCurCodeTool(SearchInCode) then exit;
|
|
if Cache.IsPrivate and (FCurCodeTool<>Cache.NewTool) then begin
|
|
//debugln(['TCodeToolManager.FindReferences identifier is not reachable from this unit => skipping search']);
|
|
exit(true);
|
|
end;
|
|
|
|
CursorPos:=Cache.NewPos;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindReferences Searching ',dbgs(FCurCodeTool.Scanner<>nil),' for reference to x=',dbgs(CursorPos.X),' y=',dbgs(CursorPos.Y),' ',CursorPos.Code.Filename);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindReferences(CursorPos,SkipComments,
|
|
ListOfPCodeXYPosition);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.FindReferences END ',Result]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
|
|
SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
|
|
// finds unit name of UnitCode in unit of TargetCode
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitReferences A ',UnitCode.Filename,' Target=',TargetCode.Filename);
|
|
{$ENDIF}
|
|
ListOfPCodeXYPosition:=nil;
|
|
if not InitCurCodeTool(TargetCode) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUnitReferences(UnitCode,SkipComments,
|
|
ListOfPCodeXYPosition);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitReferences END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindUsedUnitReferences(Code: TCodeBuffer; X,
|
|
Y: integer; SkipComments: boolean; out UsedUnitFilename: string;
|
|
var ListOfPCodeXYPosition: TFPList): boolean;
|
|
// finds in unit of Code all references of the unit at the uses clause at X,Y
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUsedUnitReferences A ',Code.Filename,' X=',X,' Y=',Y,' SkipComments=',SkipComments);
|
|
{$ENDIF}
|
|
ListOfPCodeXYPosition:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
FCurCodeTool.FindUsedUnitReferences(CursorPos,SkipComments,UsedUnitFilename,
|
|
ListOfPCodeXYPosition);
|
|
Result:=true;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitReferences END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
|
|
const OldIdentifier, NewIdentifier: string; DeclarationCode: TCodeBuffer;
|
|
DeclarationCaretXY: PPoint): boolean;
|
|
var
|
|
ANode, ANode2: TAVLTreeNode;
|
|
CurCodePos, LastCodePos: PCodeXYPosition;
|
|
IdentStartPos: integer;
|
|
IdentLen, IdentLenDiff: Integer;
|
|
SameLineCount: Integer;
|
|
i: Integer;
|
|
Code: TCodeBuffer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameIdentifier A Old=',OldIdentifier,' New=',NewIdentifier,' ',dbgs(TreeOfPCodeXYPosition<>nil));
|
|
{$ENDIF}
|
|
if TreeOfPCodeXYPosition=nil then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
if (NewIdentifier='') or (not IsValidIdent(NewIdentifier)) then exit;
|
|
|
|
ClearCurCodeTool;
|
|
SourceChangeCache.Clear;
|
|
CurCodePos := nil;
|
|
LastCodePos := nil;
|
|
SameLineCount := 0;
|
|
IdentLen:=length(OldIdentifier);
|
|
IdentLenDiff := length(NewIdentifier) - IdentLen;
|
|
if DeclarationCode = nil then
|
|
DeclarationCaretXY := nil;;
|
|
if DeclarationCaretXY = nil then
|
|
DeclarationCode := nil;;
|
|
|
|
// the tree is sorted for descending line code positions
|
|
// -> go from end of source to start of source, so that replacing does not
|
|
// change any CodeXYPosition not yet processed
|
|
ANode:=TreeOfPCodeXYPosition.FindLowest;
|
|
while ANode<>nil do begin
|
|
// next position
|
|
CurCodePos:=PCodeXYPosition(ANode.Data);
|
|
Code:=CurCodePos^.Code;
|
|
Code.LineColToPosition(CurCodePos^.Y,CurCodePos^.X,IdentStartPos);
|
|
DebugLn('TCodeToolManager.RenameIdentifier File ',Code.Filename,' Line=',dbgs(CurCodePos^.Y),' Col=',dbgs(CurCodePos^.X),' Identifier=',GetIdentifier(@Code.Source[IdentStartPos]));
|
|
// search absolute position in source
|
|
if IdentStartPos<1 then begin
|
|
SetError(Code, CurCodePos^.Y, CurCodePos^.X, ctsPositionNotInSource);
|
|
exit;
|
|
end;
|
|
// check if old identifier is there
|
|
if CompareIdentifiers(@Code.Source[IdentStartPos],PChar(Pointer(OldIdentifier)))<>0
|
|
then begin
|
|
debugln(['TCodeToolManager.RenameIdentifier CONSISTENCY ERROR ',Dbgs(CurCodePos^),' ']);
|
|
SetError(CurCodePos^.Code,CurCodePos^.Y,CurCodePos^.X,
|
|
Format(ctsStrExpectedButAtomFound,[OldIdentifier,
|
|
GetIdentifier(@Code.Source[IdentStartPos])])
|
|
);
|
|
exit;
|
|
end;
|
|
// change if needed
|
|
if CompareIdentifiersCaseSensitive(@Code.Source[IdentStartPos],
|
|
PChar(Pointer(NewIdentifier)))<>0
|
|
then begin
|
|
DebugLn('TCodeToolManager.RenameIdentifier Change ');
|
|
SourceChangeCache.ReplaceEx(gtNone,gtNone,1,1,Code,
|
|
IdentStartPos,IdentStartPos+IdentLen,NewIdentifier);
|
|
|
|
if (DeclarationCode = Code) and (CurCodePos^.Y = DeclarationCaretXY^.Y) and
|
|
(CurCodePos^.X < DeclarationCaretXY^.X)
|
|
then
|
|
DeclarationCaretXY^.X := DeclarationCaretXY^.X + IdentLenDiff;
|
|
|
|
if (LastCodePos <> nil) and (CurCodePos^.Y = LastCodePos^.Y) and
|
|
(CurCodePos^.Code = LastCodePos^.Code)
|
|
then
|
|
inc(SameLineCount);
|
|
|
|
end else begin
|
|
DebugLn('TCodeToolManager.RenameIdentifier KEPT ',GetIdentifier(@Code.Source[IdentStartPos]));
|
|
end;
|
|
|
|
LastCodePos := CurCodePos;
|
|
ANode2 := ANode;
|
|
ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
|
|
|
|
if (ANode = nil) or (PCodeXYPosition(ANode.Data)^.Code <> LastCodePos^.Code) or
|
|
(PCodeXYPosition(ANode.Data)^.Y <> LastCodePos^.Y)
|
|
then begin
|
|
if (SameLineCount > 0) then begin
|
|
for i := 1 to SameLineCount do begin
|
|
ANode2 := TreeOfPCodeXYPosition.FindPrecessor(ANode2);
|
|
PCodeXYPosition(ANode2.Data)^.X := PCodeXYPosition(ANode2.Data)^.X + i * IdentLenDiff;
|
|
end;
|
|
end;
|
|
SameLineCount := 0;
|
|
end;
|
|
end;
|
|
// apply
|
|
DebugLn('TCodeToolManager.RenameIdentifier Apply');
|
|
if not SourceChangeCache.Apply then exit;
|
|
|
|
//DebugLn('TCodeToolManager.RenameIdentifier Success');
|
|
Result:=true;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameIdentifier END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceWord(Code: TCodeBuffer; const OldWord,
|
|
NewWord: string; ChangeStrings: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceWord A ',Code.Filename,' OldWord="',OldWord,'" NewWord="',NewWord,'"');
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ReplaceWord(OldWord, NewWord, ChangeStrings,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveIdentifierDefinition(Code: TCodeBuffer; X,
|
|
Y: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.RemoveIdentifierDefinition A ',Code.Filename,' X=',X,' Y=',Y]);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.RemoveIdentifierDefinition(CursorPos,SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveWithBlock(Code: TCodeBuffer; X, Y: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.RemoveWithBlock A ',Code.Filename,' X=',X,' Y=',Y]);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.RemoveWithBlock(CursorPos,SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddWithBlock(Code: TCodeBuffer; X1, Y1, X2,
|
|
Y2: integer; const WithExpr: string; Candidates: TStrings): boolean;
|
|
var
|
|
StartPos, EndPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.AddWithBlock A ',Code.Filename,' X1=',X1,' Y1=',Y1,' X2=',X2,' Y2=',Y2,' WithExpr="',WithExpr,'"']);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
StartPos.X:=X1;
|
|
StartPos.Y:=Y1;
|
|
StartPos.Code:=Code;
|
|
EndPos.X:=X2;
|
|
EndPos.Y:=Y2;
|
|
EndPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.AddWithBlock(StartPos,EndPos,WithExpr,Candidates,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ChangeParamList(Code: TCodeBuffer;
|
|
Changes: TObjectList; var ProcPos: TCodeXYPosition;
|
|
TreeOfPCodeXYPosition: TAVLTree): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ChangeParamList A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ChangeParamList(Changes,ProcPos,TreeOfPCodeXYPosition,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GatherResourceStringSections(Code: TCodeBuffer;
|
|
X, Y: integer; CodePositions: TCodeXYPositions): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherResourceStringSections A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
if CodePositions=nil then begin
|
|
ClearPositions;
|
|
CodePositions:=Positions;
|
|
end;
|
|
try
|
|
Result:=FCurCodeTool.GatherResourceStringSections(CursorPos,CodePositions);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.IdentifierExistsInResourceStringSection(
|
|
Code: TCodeBuffer; X, Y: integer; const ResStrIdentifier: string): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.IdentifierExistsInResourceStringSection A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.IdentifierExistsInResourceStringSection(CursorPos,
|
|
ResStrIdentifier);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateIdentifierFromStringConst(
|
|
StartCode: TCodeBuffer; StartX, StartY: integer;
|
|
EndCode: TCodeBuffer; EndX, EndY: integer;
|
|
out Identifier: string; MaxLen: integer): boolean;
|
|
var
|
|
StartCursorPos, EndCursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CreateIdentifierFromStringConst A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(StartCode) then exit;
|
|
StartCursorPos.X:=StartX;
|
|
StartCursorPos.Y:=StartY;
|
|
StartCursorPos.Code:=StartCode;
|
|
EndCursorPos.X:=EndX;
|
|
EndCursorPos.Y:=EndY;
|
|
EndCursorPos.Code:=EndCode;
|
|
Identifier:='';
|
|
try
|
|
Result:=FCurCodeTool.CreateIdentifierFromStringConst(
|
|
StartCursorPos,EndCursorPos,Identifier,MaxLen);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.StringConstToFormatString(
|
|
StartCode: TCodeBuffer; StartX, StartY: integer;
|
|
EndCode: TCodeBuffer; EndX, EndY: integer;
|
|
out FormatStringConstant, FormatParameters: string;
|
|
out StartInStringConst, EndInStringConst: boolean): boolean;
|
|
var
|
|
StartCursorPos, EndCursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.StringConstToFormatString A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(StartCode) then exit;
|
|
StartCursorPos.X:=StartX;
|
|
StartCursorPos.Y:=StartY;
|
|
StartCursorPos.Code:=StartCode;
|
|
EndCursorPos.X:=EndX;
|
|
EndCursorPos.Y:=EndY;
|
|
EndCursorPos.Code:=EndCode;
|
|
try
|
|
Result:=FCurCodeTool.StringConstToFormatString(
|
|
StartCursorPos,EndCursorPos,FormatStringConstant,FormatParameters,
|
|
StartInStringConst,EndInStringConst);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GatherResourceStringsWithValue(
|
|
SectionCode: TCodeBuffer; SectionX, SectionY: integer;
|
|
const StringValue: string; CodePositions: TCodeXYPositions): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GatherResourceStringsWithValue A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(SectionCode) then exit;
|
|
CursorPos.X:=SectionX;
|
|
CursorPos.Y:=SectionY;
|
|
CursorPos.Code:=SectionCode;
|
|
if CodePositions=nil then begin
|
|
ClearPositions;
|
|
CodePositions:=Positions;
|
|
end;
|
|
try
|
|
Result:=FCurCodeTool.GatherResourceStringsWithValue(CursorPos,StringValue,
|
|
CodePositions);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddResourcestring(
|
|
CursorCode: TCodeBuffer; X,Y: integer;
|
|
SectionCode: TCodeBuffer; SectionX, SectionY: integer;
|
|
const NewIdentifier, NewValue: string;
|
|
InsertPolicy: TResourcestringInsertPolicy): boolean;
|
|
var
|
|
CursorPos, SectionPos, NearestPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddResourcestring A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(SectionCode) then exit;
|
|
SectionPos.X:=SectionX;
|
|
SectionPos.Y:=SectionY;
|
|
SectionPos.Code:=SectionCode;
|
|
try
|
|
NearestPos.Code:=nil;
|
|
if InsertPolicy=rsipContext then begin
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=CursorCode;
|
|
Result:=FCurCodeTool.FindNearestResourceString(CursorPos, SectionPos,
|
|
NearestPos);
|
|
if not Result then exit;
|
|
end;
|
|
Result:=FCurCodeTool.AddResourcestring(SectionPos, NewIdentifier, NewValue,
|
|
InsertPolicy,NearestPos,SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ImproveStringConstantStart(const ACode: string;
|
|
var StartPos: integer);
|
|
begin
|
|
BasicCodeTools.ImproveStringConstantStart(ACode,StartPos);
|
|
end;
|
|
|
|
procedure TCodeToolManager.ImproveStringConstantEnd(const ACode: string;
|
|
var EndPos: integer);
|
|
begin
|
|
BasicCodeTools.ImproveStringConstantEnd(ACode,EndPos);
|
|
end;
|
|
|
|
function TCodeToolManager.GetStringConstBounds(Code: TCodeBuffer; X, Y: integer;
|
|
var StartCode: TCodeBuffer; var StartX, StartY: integer;
|
|
var EndCode: TCodeBuffer; var EndX, EndY: integer;
|
|
ResolveComments: boolean): boolean;
|
|
var
|
|
CursorPos, StartPos, EndPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetStringConstBounds A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.GetStringConstBounds(CursorPos,StartPos,EndPos,
|
|
ResolveComments);
|
|
if Result then begin
|
|
StartCode:=StartPos.Code;
|
|
StartX:=StartPos.X;
|
|
StartY:=StartPos.Y;
|
|
EndCode:=EndPos.Code;
|
|
EndX:=EndPos.X;
|
|
EndY:=EndPos.Y;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceCode(Code: TCodeBuffer; StartX,
|
|
StartY: integer; EndX, EndY: integer; const NewCode: string): boolean;
|
|
var
|
|
StartCursorPos, EndCursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceCode A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
StartCursorPos.X:=StartX;
|
|
StartCursorPos.Y:=StartY;
|
|
StartCursorPos.Code:=Code;
|
|
EndCursorPos.X:=EndX;
|
|
EndCursorPos.Y:=EndY;
|
|
EndCursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.ReplaceCode(StartCursorPos,EndCursorPos,NewCode,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ExtractOperand(Code: TCodeBuffer; X, Y: integer; out
|
|
Operand: string; WithPostTokens, WithAsOperator,
|
|
WithoutTrailingPoints: boolean): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename);
|
|
{$ENDIF}
|
|
Operand:='';
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.ExtractOperand(CursorPos,Operand,
|
|
WithPostTokens,WithAsOperator,WithoutTrailingPoints);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
|
|
out Operand: string; ResolveProperty: Boolean): Boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result := False;
|
|
Operand := '';
|
|
if not InitCurCodeTool(Code) then Exit;
|
|
CursorPos.X := X;
|
|
CursorPos.Y := Y;
|
|
CursorPos.Code := Code;
|
|
try
|
|
Result := FCurCodeTool.GetExpandedOperand(CursorPos, Operand, ResolveProperty);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GuessMisplacedIfdefEndif A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.GuessMisplacedIfdefEndif(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindEnclosingIncludeDirective(Code: TCodeBuffer; X,
|
|
Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindEnclosingIncludeDirective A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindEnclosingIncludeDirective(CursorPos,
|
|
NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindResourceDirective(Code: TCodeBuffer; StartX,
|
|
StartY: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
|
|
const Filename: string; SearchInCleanSrc: boolean): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
p: integer;
|
|
ADirectivesTool: TDirectivesTool;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindResourceDirective A ',Code.Filename);
|
|
{$ENDIF}
|
|
NewCode:=nil;
|
|
NewX:=0;
|
|
NewY:=0;
|
|
NewTopLine:=0;
|
|
if SearchInCleanSrc then begin
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=StartX;
|
|
CursorPos.Y:=StartY;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindResourceDirective(CursorPos,NewPos,NewTopLine,
|
|
Filename);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end else begin
|
|
try
|
|
if not InitCurDirectivesTool(Code) then exit;
|
|
ADirectivesTool:=FCurDirectivesTool;
|
|
FCurDirectivesTool.Parse;
|
|
Code.LineColToPosition(StartY,StartX,p);
|
|
Result:=ADirectivesTool.NodeStartToCodePos(
|
|
ADirectivesTool.FindResourceDirective(Filename,p),
|
|
CursorPos);
|
|
NewCode:=CursorPos.Code;
|
|
NewX:=CursorPos.X;
|
|
NewY:=CursorPos.Y;
|
|
NewTopLine:=NewY;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddResourceDirective(Code: TCodeBuffer;
|
|
const Filename: string; SearchInCleanSrc: boolean; const NewSrc: string
|
|
): boolean;
|
|
var
|
|
Tree: TCompilerDirectivesTree;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddResourceDirective A ',Code.Filename,' Filename=',Filename);
|
|
{$ENDIF}
|
|
if SearchInCleanSrc then begin
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddResourceDirective(Filename,SourceChangeCache,NewSrc);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end else begin
|
|
try
|
|
Tree:=TCompilerDirectivesTree.Create;
|
|
try
|
|
Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
|
|
Node:=Tree.FindResourceDirective(Filename);
|
|
if Node=nil then
|
|
Result:=AddResourceDirective(Code,Filename,true,NewSrc)
|
|
else
|
|
Result:=true;
|
|
finally
|
|
Tree.Free;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindIncludeDirective(Code: TCodeBuffer; StartX,
|
|
StartY: integer; out NewCode: TCodeBuffer; out NewX, NewY,
|
|
NewTopLine: integer; const Filename: string; SearchInCleanSrc: boolean
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
Tree: TCompilerDirectivesTree;
|
|
p: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindIncludeDirective A ',Code.Filename);
|
|
{$ENDIF}
|
|
NewCode:=nil;
|
|
NewX:=0;
|
|
NewY:=0;
|
|
NewTopLine:=0;
|
|
if SearchInCleanSrc then begin
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=StartX;
|
|
CursorPos.Y:=StartY;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindIncludeDirective(CursorPos,NewPos,NewTopLine,
|
|
Filename);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end else begin
|
|
try
|
|
Tree:=TCompilerDirectivesTree.Create;
|
|
try
|
|
Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
|
|
Code.LineColToPosition(StartY,StartX,p);
|
|
Result:=Tree.NodeStartToCodePos(Tree.FindIncludeDirective(Filename,p),
|
|
CursorPos);
|
|
NewCode:=CursorPos.Code;
|
|
NewX:=CursorPos.X;
|
|
NewY:=CursorPos.Y;
|
|
NewTopLine:=NewY;
|
|
finally
|
|
Tree.Free;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddIncludeDirective(Code: TCodeBuffer;
|
|
const Filename: string; const NewSrc: string): boolean;
|
|
begin
|
|
Result:=AddIncludeDirectiveForInit(Code,Filename,NewSrc);
|
|
end;
|
|
|
|
function TCodeToolManager.AddIncludeDirectiveForInit(Code: TCodeBuffer;
|
|
const Filename: string; const NewSrc: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddIncludeDirectiveForInit A ',Code.Filename,' Filename=',Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddIncludeDirectiveForInit(Filename,SourceChangeCache,NewSrc);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX,
|
|
NewY: integer; RemoveEmptyIFs: boolean): boolean;
|
|
var
|
|
Tree: TCompilerDirectivesTree;
|
|
p: integer;
|
|
Node: TCodeTreeNode;
|
|
Changed: boolean;
|
|
ParentNode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveDirective A ',Code.Filename);
|
|
{$ENDIF}
|
|
try
|
|
Code.LineColToPosition(NewY,NewX,p);
|
|
if (p<1) or (p>Code.SourceLength) then exit;
|
|
Tree:=TCompilerDirectivesTree.Create;
|
|
try
|
|
Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
|
|
Node:=Tree.FindNodeAtPos(p);
|
|
if Node=nil then exit;
|
|
ParentNode:=Node.Parent;
|
|
Changed:=false;
|
|
Tree.DisableNode(Node,Changed,true);
|
|
if RemoveEmptyIFs and (ParentNode<>nil) and Tree.NodeIsEmpty(ParentNode) then
|
|
Tree.DisableNode(ParentNode,Changed,true);
|
|
Result:=Changed;
|
|
finally
|
|
Tree.Free;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
|
|
Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
|
|
|
procedure CreateErrorForMissingIncludeFile;
|
|
var
|
|
CodePos: PCodeXYPosition;
|
|
begin
|
|
ClearError;
|
|
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[0]);
|
|
fErrorCode:=CodePos^.Code;
|
|
fErrorLine:=CodePos^.Y;
|
|
fErrorColumn:=CodePos^.X;
|
|
FErrorMsg:='missing include file';
|
|
end;
|
|
|
|
var
|
|
FoundIncludeFiles: TStrings;
|
|
i: Integer;
|
|
AFilename: string;
|
|
ToFixIncludeFiles: TStringList;
|
|
FixedIncludeFiles: TStringList;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=', DbgS(Recursive));
|
|
{$ENDIF}
|
|
MissingIncludeFilesCodeXYPos:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
FixedIncludeFiles:=nil;
|
|
ToFixIncludeFiles:=TStringList.Create;
|
|
try
|
|
ToFixIncludeFiles.Add(Code.Filename);
|
|
while ToFixIncludeFiles.Count>0 do begin
|
|
// get next include file
|
|
AFilename:=ToFixIncludeFiles[ToFixIncludeFiles.Count-1];
|
|
ToFixIncludeFiles.Delete(ToFixIncludeFiles.Count-1);
|
|
Code:=LoadFile(AFilename,false,false);
|
|
if Code=nil then begin
|
|
raise ECodeToolError.Create(FCurCodeTool,
|
|
'unable to read file "'+AFilename+'"');
|
|
end;
|
|
// fix file
|
|
FoundIncludeFiles:=nil;
|
|
try
|
|
Result:=FCurCodeTool.FixIncludeFilenames(Code,SourceChangeCache,
|
|
FoundIncludeFiles,MissingIncludeFilesCodeXYPos);
|
|
if (MissingIncludeFilesCodeXYPos<>nil)
|
|
and (MissingIncludeFilesCodeXYPos.Count>0) then begin
|
|
DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',dbgs(MissingIncludeFilesCodeXYPos.Count));
|
|
Result:=false;
|
|
CreateErrorForMissingIncludeFile;
|
|
exit;
|
|
end;
|
|
if not Recursive then begin
|
|
// check only main file -> stop
|
|
exit;
|
|
end;
|
|
// remember, that the file has been fixed to avoid cycles
|
|
if FixedIncludeFiles=nil then
|
|
FixedIncludeFiles:=TStringList.Create;
|
|
FixedIncludeFiles.Add(Code.Filename);
|
|
// add new include files to stack
|
|
if FoundIncludeFiles<>nil then begin
|
|
for i:=0 to FoundIncludeFiles.Count-1 do begin
|
|
AFilename:=FoundIncludeFiles[i];
|
|
if ((FixedIncludeFiles=nil)
|
|
or (FixedIncludeFiles.IndexOf(AFilename)<0))
|
|
and (ToFixIncludeFiles.IndexOf(AFilename)<0) then begin
|
|
ToFixIncludeFiles.Add(AFilename);
|
|
end;
|
|
end;
|
|
end;
|
|
//DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text);
|
|
finally
|
|
FoundIncludeFiles.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
FixedIncludeFiles.Free;
|
|
ToFixIncludeFiles.Free;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FixMissingH2PasDirectives(Code: TCodeBuffer;
|
|
var Changed: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
try
|
|
if InitCurDirectivesTool(Code) then begin
|
|
FCurDirectivesTool.Parse;
|
|
FCurDirectivesTool.FixMissingH2PasDirectives(Changed);
|
|
Result:=true;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReduceCompilerDirectives(Code: TCodeBuffer;
|
|
Undefines, Defines: TStrings; var Changed: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
try
|
|
if InitCurDirectivesTool(Code) then begin
|
|
FCurDirectivesTool.Parse;
|
|
FCurDirectivesTool.ReduceCompilerDirectives(Undefines,Defines,Changed);
|
|
Result:=true;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.IsKeyword(Code: TCodeBuffer; const KeyWord: string
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.IsKeyword A ',Code.Filename,' Keyword=',KeyWord);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.StringIsKeyWord(KeyWord);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ExtractCodeWithoutComments(Code: TCodeBuffer): string;
|
|
begin
|
|
Result:=CleanCodeFromComments(Code.Source,
|
|
GetNestedCommentsFlagForFile(Code.Filename));
|
|
end;
|
|
|
|
function TCodeToolManager.GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
|
|
out ListOfPCodeXYPosition: TFPList): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetPasDocComments A ',Code.Filename);
|
|
{$ENDIF}
|
|
ListOfPCodeXYPosition:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetPasDocComments B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.GetPasDocComments(CursorPos,true,ListOfPCodeXYPosition);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetPasDocComments END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindBlockCounterPart(Code: TCodeBuffer;
|
|
X, Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockCounterPart A ',Code.Filename);
|
|
{$ENDIF}
|
|
NewCode:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockCounterPart B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockCounterPart END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindBlockStart(Code: TCodeBuffer; X, Y: integer; out
|
|
NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; SkipStart: boolean
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockStart A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockStart B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindBlockStart(CursorPos,NewPos,NewTopLine,SkipStart);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindBlockStart END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GuessUnclosedBlock B ',dbgs(FCurCodeTool.Scanner<>nil));
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GuessUnclosedBlock END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
|
|
OnlyIfCursorBlockIndented: boolean): boolean;
|
|
var
|
|
NewCode: TCodeBuffer;
|
|
NewX, NewY, NewTopLine: integer;
|
|
begin
|
|
Result:=CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
|
|
NewCode,NewX,NewY,NewTopLine);
|
|
if (NewCode=nil) and (NewX<0) and (NewY<0) and (NewTopLine<1) then ;
|
|
end;
|
|
|
|
function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
|
|
OnlyIfCursorBlockIndented: boolean;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos, NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
NewCode:=Code;
|
|
NewX:=X;
|
|
NewY:=Y;
|
|
NewTopLine:=-1;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CompleteBlock A ',Code.Filename,' x=',dbgs(X),' y=',dbgs(Y));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.CompleteBlock(CursorPos,SourceChangeCache,
|
|
OnlyIfCursorBlockIndented,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewCode:=NewPos.Code;
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
|
|
const AClassName: string; PropInstance: TPersistent; const PropName: string;
|
|
const Proc: TGetStrProc): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname,' Instance=',DbgSName(PropInstance),' PropName=',PropName]);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,
|
|
PropInstance,PropName,Proc);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
|
|
const AClassName: string; TypeData: PTypeData; const Proc: TGetStrProc): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,TypeData,Proc);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.PublishedMethodExists(Code: TCodeBuffer;
|
|
const AClassName, AMethodName: string; PropInstance: TPersistent;
|
|
const PropName: string; out MethodIsCompatible, MethodIsPublished,
|
|
IdentIsMethod: boolean): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName,' Porperty=',DbgSName(PropInstance),'.',PropName]);
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
Result:=FCurCodeTool.PublishedMethodExists(AClassName,
|
|
AMethodName,PropInstance,PropName,
|
|
MethodIsCompatible,MethodIsPublished,IdentIsMethod);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.PublishedMethodExists(Code:TCodeBuffer;
|
|
const AClassName, AMethodName: string; TypeData: PTypeData;
|
|
out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName);
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
Result:=FCurCodeTool.PublishedMethodExists(AClassName,
|
|
AMethodName,TypeData,
|
|
MethodIsCompatible,MethodIsPublished,IdentIsMethod);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.JumpToPublishedMethodBody(Code: TCodeBuffer;
|
|
const AClassName, AMethodName: string;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
|
var NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.JumpToPublishedMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName);
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
Result:=FCurCodeTool.JumpToPublishedMethodBody(AClassName,
|
|
AMethodName,NewPos,NewTopLine,true);
|
|
if Result then begin
|
|
NewCode:=NewPos.Code;
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenamePublishedMethod(Code: TCodeBuffer;
|
|
const AClassName, OldMethodName, NewMethodName: string): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenamePublishedMethod A');
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
SourceChangeCache.Clear;
|
|
Result:=FCurCodeTool.RenamePublishedMethod(AClassName,
|
|
OldMethodName,NewMethodName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
|
|
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
|
|
UseTypeInfoForParameters: boolean;
|
|
const APropertyUnitName: string; const APropertyPath: string;
|
|
const CallAncestorMethod: string): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CreatePublishedMethod A');
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
SourceChangeCache.Clear;
|
|
Result:=FCurCodeTool.CreateMethod(AClassName,
|
|
NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
|
|
SourceChangeCache,UseTypeInfoForParameters,pcsPublished,
|
|
CallAncestorMethod);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer;
|
|
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
|
|
UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
|
|
const APropertyPath: string): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CreatePrivateMethod A');
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
SourceChangeCache.Clear;
|
|
Result:=FCurCodeTool.CreateMethod(AClassName,
|
|
NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
|
|
SourceChangeCache,UseTypeInfoForParameters,pcsPrivate);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetIDEDirectives(Code: TCodeBuffer;
|
|
DirectiveList: TStrings): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetIDEDirectives(DirectiveList);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.SetIDEDirectives(Code: TCodeBuffer;
|
|
DirectiveList: TStrings): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.SetIDEDirectives(DirectiveList,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.JumpToLinkerIdentifier(Code: TCodeBuffer;
|
|
const SourceFilename: string; SourceLine: integer;
|
|
const MangledFunction, Identifier: string; out NewCode: TCodeBuffer; out
|
|
NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.JumpToLinkerIdentifier A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindJumpPointForLinkerPos(
|
|
SourceFilename, SourceLine, MangledFunction, Identifier,
|
|
NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindGBDIdentifier(GDBIdentifier: string; out
|
|
aComplete: boolean; out aMessage: string;
|
|
const OnFindSource: TOnFindGDBSource; out NewCode: TCodeBuffer; out NewX,
|
|
NewY, NewTopLine: integer): boolean;
|
|
{ Examples:
|
|
compiler built-in
|
|
fpc_raiseexception
|
|
??
|
|
PASCALMAIN
|
|
SYSTEM_FPC_SYSTEMMAIN$LONGINT$PPCHAR$PPCHAR
|
|
|
|
unit:
|
|
procedure
|
|
SYSUTILS_RUNERRORTOEXCEPT$LONGINT$POINTER$POINTER
|
|
SYSTEM_HANDLEERRORADDRFRAME$LONGINT$POINTER$POINTER
|
|
method
|
|
EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$$TMODALRESULT
|
|
EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$ANSISTRING$$TMODALRESULT
|
|
ENVIRONMENTOPTS_TENVIRONMENTOPTIONS_$__LOAD$BOOLEAN
|
|
MAIN_TMAINIDE_$__LOADGLOBALOPTIONS
|
|
MAIN_TMAINIDE_$__CREATE$TCOMPONENT$$TMAINIDE
|
|
|
|
program:
|
|
P$TESTPROJECT1_DOTEST
|
|
P$TESTPROJECT1_DOTEST_SUBTEST
|
|
P$TESTPROJECT1_DOTEST$CHAR_SUBTEST$LONGINT
|
|
P$TESTSTACKTRACE1_TMAINCLASS_$_TSUBCLASS_$__RAISESOMETHING$ANSISTRING
|
|
}
|
|
var
|
|
p: PChar;
|
|
TheSrcName: string;
|
|
Code: TCodeBuffer;
|
|
CurIdentifier: string;
|
|
Tool: TCodeTool;
|
|
Node: TCodeTreeNode;
|
|
SubNode: TCodeTreeNode;
|
|
ClassNode: TCodeTreeNode;
|
|
ProcNode: TCodeTreeNode;
|
|
SectionNode: TCodeTreeNode;
|
|
SrcFilename: string;
|
|
NewPos: TCodeXYPosition;
|
|
|
|
procedure ReadIdentifier(out Identifier: string);
|
|
var
|
|
StartP: PChar;
|
|
begin
|
|
StartP:=p;
|
|
while p^ in ['A'..'Z','0'..'9'] do inc(p);
|
|
Identifier:=copy(GDBIdentifier,StartP-PChar(GDBIdentifier)+1,p-StartP);
|
|
end;
|
|
|
|
procedure ReadParamList;
|
|
begin
|
|
if p^='$' then begin
|
|
// parameter list => skip
|
|
while (p^ in ['$','A'..'Z','0'..'9']) do inc(p);
|
|
end;
|
|
end;
|
|
|
|
function FindUnit(TheUnitName: string; out aFilename: string): boolean;
|
|
var
|
|
InFilename: string;
|
|
begin
|
|
// search in main search path
|
|
InFilename:='';
|
|
aFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
|
|
'',TheUnitName,InFilename,true);
|
|
if aFilename<>'' then
|
|
exit(true);
|
|
|
|
// user search
|
|
if Assigned(OnFindSource) then begin
|
|
OnFindSource(Self,ctnUnit,TheUnitName,aFilename);
|
|
Result:=aFilename<>'';
|
|
end;
|
|
end;
|
|
|
|
function FindProgram(TheSrcName: string; out aFilename: string): boolean;
|
|
begin
|
|
aFilename:='';
|
|
// user search
|
|
if Assigned(OnFindSource) then begin
|
|
OnFindSource(Self,ctnProgram,TheSrcName,aFilename);
|
|
end;
|
|
Result:=aFilename<>'';
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
aComplete:=false;
|
|
aMessage:='';
|
|
NewCode:=nil;
|
|
NewTopLine:=-1;
|
|
NewX:=-1;
|
|
NewY:=-1;
|
|
|
|
if GDBIdentifier='' then begin
|
|
aMessage:='missing identifier';
|
|
exit;
|
|
end;
|
|
p:=PChar(GDBIdentifier);
|
|
if p^ in ['a'..'z'] then begin
|
|
// lower case unit name means compiler built in function
|
|
aMessage:='the function "'+GDBIdentifier+'" is a compiler special function without source';
|
|
exit;
|
|
end;
|
|
TheSrcName:='';
|
|
if p^ in ['A'..'Z'] then begin
|
|
ReadIdentifier(TheSrcName);
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier first identifier=',TheSrcName,' ...']);
|
|
if (TheSrcName='P') and (p^='$') then begin
|
|
// P$programname
|
|
inc(p);
|
|
if IsIdentStartChar[p^] then
|
|
ReadIdentifier(TheSrcName);
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier search source of program "',TheSrcName,'" ...']);
|
|
if not FindProgram(TheSrcName,SrcFilename) then begin
|
|
aMessage:='can''t find program "'+TheSrcName+'"';
|
|
exit;
|
|
end;
|
|
end else if p^='_' then begin
|
|
// a unit name
|
|
// => search unit
|
|
if not FindUnit(TheSrcName,SrcFilename) then begin
|
|
aMessage:='can''t find unit '+TheSrcName;
|
|
exit;
|
|
end;
|
|
end else if p^<>'_' then begin
|
|
// only one uppercase identifier, e.g. PASCALMAIN
|
|
aMessage:='compiler built in function "'+GDBIdentifier+'"';
|
|
exit;
|
|
end;
|
|
// load unit source
|
|
Code:=LoadFile(SrcFilename,true,false);
|
|
if Code=nil then begin
|
|
aMessage:='unable to read file "'+SrcFilename+'"';
|
|
exit;
|
|
end;
|
|
|
|
inc(p);
|
|
if p^ in ['A'..'Z'] then begin
|
|
ReadIdentifier(CurIdentifier);
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier Identifier="',CurIdentifier,'"']);
|
|
|
|
if not Explore(Code,Tool,false,true) then begin
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier parse error']);
|
|
aMessage:=CodeToolBoss.ErrorMessage;
|
|
exit;
|
|
end;
|
|
|
|
ReadParamList;
|
|
|
|
Node:=nil;
|
|
if Tool.GetSourceType=ctnUnit then begin
|
|
// a unit => first search in interface, then in implementation
|
|
SectionNode:=Tool.FindInterfaceNode;
|
|
if SectionNode<>nil then begin
|
|
Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
|
|
end;
|
|
if Node=nil then begin
|
|
// search in implementation
|
|
try
|
|
Node:=Tool.FindDeclarationNodeInImplementation(CurIdentifier,true);
|
|
except
|
|
on E: Exception do begin
|
|
HandleException(E);
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier FindDeclarationNodeInImplementation parse error in "',Code.Filename,'": ',E.Message]);
|
|
aMessage:=ErrorMessage;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
// not a unit, e.g. a program
|
|
SectionNode:=Tool.Tree.Root;
|
|
if SectionNode<>nil then begin
|
|
Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
|
|
end;
|
|
end;
|
|
if Node=nil then begin
|
|
// identifier not found => use only SrcFilename
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier identifier "',CurIdentifier,'" not found in "',Code.Filename,'"']);
|
|
aMessage:='identifier "'+CurIdentifier+'" not found in "'+Code.Filename+'"';
|
|
exit;
|
|
end;
|
|
|
|
repeat
|
|
if (p^='_') and (p[1]='$') and (p[2]='_') and (p[3]='_') then begin
|
|
// sub identifier is method or member
|
|
inc(p,4);
|
|
end else if (p^='_') and (p[1] in ['A'..'Z']) then begin
|
|
// sub identifier is proc
|
|
inc(p);
|
|
end else
|
|
break;
|
|
if not (p^ in ['A'..'Z']) then begin
|
|
break;
|
|
end;
|
|
// _$__identifier => sub identifier
|
|
ReadIdentifier(CurIdentifier);
|
|
ReadParamList;
|
|
// find sub identifier
|
|
SubNode:=Tool.FindSubDeclaration(CurIdentifier,Node);
|
|
if SubNode=nil then begin
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" not found']);
|
|
break;
|
|
end;
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" found']);
|
|
Node:=SubNode;
|
|
until false;
|
|
|
|
if Node.Desc=ctnProcedure then begin
|
|
// proc node => find body
|
|
ClassNode:=Tool.FindClassOrInterfaceNode(Node);
|
|
if ClassNode<>nil then begin
|
|
try
|
|
Tool.BuildTree(lsrInitializationStart);
|
|
except
|
|
on E: Exception do begin
|
|
// ignore
|
|
end;
|
|
end;
|
|
ProcNode:=Tool.FindCorrespondingProcNode(Node,[phpAddClassName]);
|
|
if ProcNode<>nil then
|
|
Node:=ProcNode;
|
|
end;
|
|
end;
|
|
|
|
aComplete:=p^ in [#0,#9,#10,#13,' '];
|
|
Result:=Tool.JumpToCleanPos(Node.StartPos,-1,-1,NewPos,NewTopLine,false);
|
|
NewCode:=NewPos.Code;
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
end;
|
|
// unknown operator => use only SrcFilename
|
|
//debugln(['TCodeToolManager.FindGBDIdentifier operator not yet supported: ',dbgstr(p^)]);
|
|
exit;
|
|
end else begin
|
|
// example: ??
|
|
end;
|
|
|
|
aMessage:='unkown identifier "'+GDBIdentifier+'"';
|
|
end;
|
|
|
|
function TCodeToolManager.CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CompleteCode A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
NewX := 0;
|
|
NewY := 0;
|
|
NewTopLine := 0;
|
|
NewCode := NIL;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.CompleteCode(CursorPos,TopLine,
|
|
NewPos,NewTopLine,SourceChangeCache);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateVariableForIdentifier(Code: TCodeBuffer; X, Y,
|
|
TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY,
|
|
NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CreateVariableForIdentifier A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.CreateVariableForIdentifier(CursorPos,TopLine,
|
|
NewPos,NewTopLine,SourceChangeCache);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y, TopLine: integer;
|
|
ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean;
|
|
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos, NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddMethods A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
NewCode:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.AddMethods(CursorPos,TopLine,ListOfPCodeXYPosition,
|
|
VirtualToOverride,NewPos,NewTopLine,SourceChangeCache);
|
|
NewCode:=NewPos.Code;
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GuessTypeOfIdentifier(Code: TCodeBuffer; X,
|
|
Y: integer; out ItsAKeyword, IsSubIdentifier: boolean;
|
|
out ExistingDefinition: TFindContext;
|
|
out ListOfPFindContext: TFPList; out NewExprType: TExpressionType;
|
|
out NewType: string): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.GuessTypeOfIdentifier A ',Code.Filename,' X=',X,' Y=',Y]);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.GuessTypeOfIdentifier(CursorPos,ItsAKeyword,
|
|
IsSubIdentifier,ExistingDefinition,ListOfPFindContext,
|
|
NewExprType,NewType);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.DeclareVariableNearBy(Code: TCodeBuffer; X,
|
|
Y: integer; const VariableName, NewType, NewUnitName: string;
|
|
Visibility: TCodeTreeNodeDesc; LvlPosCode: TCodeBuffer; LvlPosX: integer;
|
|
LvlPosY: integer): boolean;
|
|
var
|
|
CursorPos, LvlPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.Code:=Code;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
LvlPos.Code:=LvlPosCode;
|
|
LvlPos.X:=LvlPosX;
|
|
LvlPos.Y:=LvlPosY;
|
|
try
|
|
Result:=FCurCodeTool.DeclareVariableNearBy(CursorPos,VariableName,
|
|
NewType,NewUnitName,Visibility,SourceChangeCache,LvlPos);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.DeclareVariableAt(Code: TCodeBuffer; X, Y: integer;
|
|
const VariableName, NewType, NewUnitName: string): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.Code:=Code;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
try
|
|
Result:=FCurCodeTool.DeclareVariableAt(CursorPos,VariableName,
|
|
NewType,NewUnitName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindRedefinitions(Code: TCodeBuffer; out
|
|
TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,WithEnums);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveRedefinitions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveRedefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
|
|
var
|
|
TreeOfCodeTreeNodeExt: TAVLTree;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveAllRedefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
try
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,false);
|
|
if not Result then exit;
|
|
Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
finally
|
|
DisposeAVLTree(TreeOfCodeTreeNodeExt);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindAliasDefinitions(Code: TCodeBuffer; out
|
|
TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindAliasDefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,
|
|
OnlyWrongType);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FixAliasDefinitions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FixAliasDefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
|
|
var
|
|
TreeOfCodeTreeNodeExt: TAVLTree;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FixAllAliasDefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
try
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,true);
|
|
if not Result then exit;
|
|
Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
finally
|
|
DisposeAVLTree(TreeOfCodeTreeNodeExt);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindConstFunctions(Code: TCodeBuffer; out
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindConstFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceConstFunctions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceConstFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
|
|
var
|
|
TreeOfCodeTreeNodeExt: TAVLTree;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceAllConstFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
repeat
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
try
|
|
Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
|
|
if (not Result) or (TreeOfCodeTreeNodeExt=nil)
|
|
or (TreeOfCodeTreeNodeExt.Count=0) then
|
|
break;
|
|
Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
finally
|
|
DisposeAVLTree(TreeOfCodeTreeNodeExt);
|
|
end;
|
|
until not Result;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindTypeCastFunctions(Code: TCodeBuffer; out
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindTypeCastFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceTypeCastFunctions(Code: TCodeBuffer;
|
|
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceTypeCastFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceAllTypeCastFunctions(Code: TCodeBuffer
|
|
): boolean;
|
|
var
|
|
TreeOfCodeTreeNodeExt: TAVLTree;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceAllTypeCastFunctions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
repeat
|
|
TreeOfCodeTreeNodeExt:=nil;
|
|
try
|
|
Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
|
|
if (not Result) or (TreeOfCodeTreeNodeExt=nil)
|
|
or (TreeOfCodeTreeNodeExt.Count=0) then
|
|
break;
|
|
Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
|
|
SourceChangeCache);
|
|
finally
|
|
DisposeAVLTree(TreeOfCodeTreeNodeExt);
|
|
end;
|
|
until not Result;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FixForwardDefinitions(Code: TCodeBuffer): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FixForwardDefinitions A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FixForwardDefinitions(SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindEmptyMethods(Code: TCodeBuffer;
|
|
const AClassName: string; X, Y: integer;
|
|
const Sections: TPascalClassSections; ListOfPCodeXYPosition: TFPList;
|
|
out AllEmpty: boolean): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindEmptyMethods(CursorPos,AClassName,Sections,
|
|
ListOfPCodeXYPosition,AllEmpty);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveEmptyMethods(Code: TCodeBuffer;
|
|
const AClassName: string; X,Y: integer;
|
|
const Sections: TPascalClassSections; out AllRemoved: boolean;
|
|
const Attr: TProcHeadAttributes; out RemovedProcHeads: TStrings): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveEmptyMethods A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.RemoveEmptyMethods(CursorPos,AClassName,Sections,
|
|
SourceChangeCache,AllRemoved,Attr,RemovedProcHeads);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnusedUnits(Code: TCodeBuffer; Units: TStrings
|
|
): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUnusedUnits(Units);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.InitClassCompletion(Code: TCodeBuffer;
|
|
const AClassName: string; out CodeTool: TCodeTool): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.InitClassCompletion A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
CodeTool:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.InitClassCompletion(AClassName,SourceChangeCache);
|
|
CodeTool:=FCurCodeTool;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
|
|
EndPoint: TPoint; out MethodPossible, SubProcPossible,
|
|
SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree;
|
|
VarTree: TAVLTree): boolean;
|
|
var
|
|
StartPos, EndPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CheckExtractProc A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
StartPos.X:=StartPoint.X;
|
|
StartPos.Y:=StartPoint.Y;
|
|
StartPos.Code:=Code;
|
|
EndPos.X:=EndPoint.X;
|
|
EndPos.Y:=EndPoint.Y;
|
|
EndPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
|
|
SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,
|
|
VarTree);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint,
|
|
EndPoint: TPoint; ProcType: TExtractProcType; const ProcName: string;
|
|
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
|
|
FunctionResultVariableStartPos: integer): boolean;
|
|
var
|
|
StartPos, EndPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ExtractProc A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
StartPos.X:=StartPoint.X;
|
|
StartPos.Y:=StartPoint.Y;
|
|
StartPos.Code:=Code;
|
|
EndPos.X:=EndPoint.X;
|
|
EndPos.Y:=EndPoint.Y;
|
|
EndPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
|
|
IgnoreIdentifiers,NewPos,NewTopLine,SourceChangeCache,
|
|
FunctionResultVariableStartPos);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
|
|
out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
|
|
out AssignDeclNode: TCodeTreeNode; var MemberNodeExts: TAVLTree;
|
|
out AssignBodyNode: TCodeTreeNode; out InheritedDeclContext: TFindContext;
|
|
ProcName: string): boolean;
|
|
var
|
|
CodePos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindAssignMethod A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
AssignDeclNode:=nil;
|
|
AssignBodyNode:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
Tool:=FCurCodeTool;
|
|
CodePos.X:=X;
|
|
CodePos.Y:=Y;
|
|
CodePos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.FindAssignMethod(CodePos,ClassNode,
|
|
AssignDeclNode,MemberNodeExts,AssignBodyNode,
|
|
InheritedDeclContext,ProcName);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.InsertCodeTemplate(Code: TCodeBuffer;
|
|
SelectionStart, SelectionEnd: TPoint; TopLine: integer;
|
|
CodeTemplate: TCodeToolTemplate; var NewCode: TCodeBuffer; var NewX, NewY,
|
|
NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
EndPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.InsertCodeTemplate A ',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=SelectionStart.X;
|
|
CursorPos.Y:=SelectionStart.Y;
|
|
CursorPos.Code:=Code;
|
|
EndPos.X:=SelectionStart.X;
|
|
EndPos.Y:=SelectionStart.Y;
|
|
EndPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.InsertCodeTemplate(CursorPos,EndPos,TopLine,
|
|
CodeTemplate,NewPos,NewTopLine,SourceChangeCache);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetSourceName(Code: TCodeBuffer;
|
|
SearchMainCode: boolean): string;
|
|
begin
|
|
Result:='';
|
|
if (Code=nil)
|
|
or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$ENDIF}
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetSourceName;
|
|
except
|
|
on e: Exception do begin
|
|
Result:=FCurCodeTool.ExtractSourceName;
|
|
HandleException(e);
|
|
end;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
|
|
{$ENDIF}
|
|
DebugLn('SourceName=',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GetCachedSourceName(Code: TCodeBuffer): string;
|
|
begin
|
|
Result:='';
|
|
if (Code=nil)
|
|
or (Code.LastIncludedByFile<>'') then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetCachedSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$ENDIF}
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetCachedSourceName;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetCachedSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
|
|
{$ENDIF}
|
|
DebugLn('SourceName=',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GetSourceType(Code: TCodeBuffer;
|
|
SearchMainCode: boolean): string;
|
|
begin
|
|
Result:='';
|
|
if (Code=nil)
|
|
or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetSourceType A ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
// GetSourceType does not parse the code -> parse it with GetSourceName
|
|
FCurCodeTool.GetSourceName;
|
|
case FCurCodeTool.GetSourceType of
|
|
ctnProgram: Result:='PROGRAM';
|
|
ctnPackage: Result:='PACKAGE';
|
|
ctnLibrary: Result:='LIBRARY';
|
|
ctnUnit: Result:='UNIT';
|
|
else
|
|
Result:='';
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetSourceType END ',Code.Filename,',',dbgs(Code.SourceLength));
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
|
|
{$ENDIF}
|
|
DebugLn('SourceType=',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.RenameSource(Code: TCodeBuffer;
|
|
const NewName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitInAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string; out NamePos, InPos: integer;
|
|
const IgnoreMissingIncludeFiles: Boolean = False): boolean;
|
|
var
|
|
NameAtomPos, InAtomPos: TAtomPosition;
|
|
OldIgnoreMissingIncludeFiles: Boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' AUnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
OldIgnoreMissingIncludeFiles := FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
|
|
try
|
|
FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := IgnoreMissingIncludeFiles;
|
|
Result:=FCurCodeTool.FindUnitInAllUsesSections(AnUnitName,
|
|
NameAtomPos, InAtomPos);
|
|
if Result then begin
|
|
NamePos:=NameAtomPos.StartPos;
|
|
InPos:=InAtomPos.StartPos;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := OldIgnoreMissingIncludeFiles;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameUsedUnit(Code: TCodeBuffer;
|
|
const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameUsedUnit A ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameUsedUnit(OldUnitName,NewUnitName,
|
|
NewUnitInFile,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ReplaceUsedUnits(Code: TCodeBuffer;
|
|
UnitNamePairs: TStringToStringTree): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ReplaceUsedUnits A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ReplaceUsedUnits(UnitNamePairs,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddUnitToMainUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string; AsLast: boolean;
|
|
CheckSpecialUnits: boolean = true): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
|
|
SourceChangeCache,AsLast,CheckSpecialUnits);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string; AsLast: boolean;
|
|
CheckSpecialUnits: boolean): boolean;
|
|
var
|
|
NamePos, InPos: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddUnitToMainUsesSectionIfNeeded A ',Code.Filename,' NewUnitName=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
if not FCurCodeTool.FindUnitInAllUsesSections(NewUnitName,NamePos,InPos) then
|
|
Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
|
|
SourceChangeCache,AsLast,CheckSpecialUnits);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddUnitToImplementationUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string; AsLast: boolean;
|
|
CheckSpecialUnits: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddUnitToImplementationUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddUnitToImplementationUsesSection(
|
|
NewUnitName, NewUnitInFile,
|
|
SourceChangeCache,AsLast,CheckSpecialUnits);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(AnUnitName,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
|
|
var MainUsesSection: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
|
|
var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection,
|
|
ImplementationUsesSection);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUsedUnitNames(Code: TCodeBuffer;
|
|
var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUsedUnitNames A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUsedUnitNames(MainUsesSection,
|
|
ImplementationUsesSection);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindMissingUnits(Code: TCodeBuffer;
|
|
var MissingUnits: TStrings; FixCase: boolean;
|
|
SearchImplementation: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindMissingUnits A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindMissingUnits(MissingUnits,FixCase,
|
|
SearchImplementation,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindDelphiProjectUnits(Code: TCodeBuffer;
|
|
var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDelphiProjectUnits A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits,
|
|
MissingInUnits, NormalUnits);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindDelphiPackageUnits(Code: TCodeBuffer;
|
|
var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDelphiPackageUnits A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits,
|
|
MissingInUnits, NormalUnits,true);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CommentUnitsInUsesSections(Code: TCodeBuffer;
|
|
MissingUnits: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CommentUnitsInUsesSections A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.CommentUnitsInUsesSections(MissingUnits,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitCaseInsensitive(Code: TCodeBuffer;
|
|
var AnUnitName, AnUnitInFilename: string): string;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnitCaseInsensitive A ',Code.Filename,' AnUnitName="',AnUnitName,'"',' AnUnitInFilename="',AnUnitInFilename,'"');
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUnitCaseInsensitive(AnUnitName,AnUnitInFilename);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitSource(Code: TCodeBuffer; const AnUnitName,
|
|
AnUnitInFilename: string): TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindUnit A ',Code.Filename,' AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'"');
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindUnitSource(AnUnitName,AnUnitInFilename,false);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateUsesGraph: TUsesGraph;
|
|
begin
|
|
Result:=TUsesGraph.Create;
|
|
Result.DirectoryCachePool:=DirectoryCachePool;
|
|
Result.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
|
|
Result.OnLoadFile:=@DoOnLoadFileForTool;
|
|
end;
|
|
|
|
function TCodeToolManager.FindLFMFileName(Code: TCodeBuffer): string;
|
|
var LinkIndex: integer;
|
|
CurCode: TCodeBuffer;
|
|
Ext: string;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindLFMFileName A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
LinkIndex:=-1;
|
|
CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
while (CurCode<>nil) do begin
|
|
if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin
|
|
Result:=CurCode.Filename;
|
|
Ext:=ExtractFileExt(Result);
|
|
Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm';
|
|
exit;
|
|
end;
|
|
CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CheckLFM(UnitCode, LFMBuf: TCodeBuffer;
|
|
out LFMTree: TLFMTree; RootMustBeClassInUnit, RootMustBeClassInIntf,
|
|
ObjectsMustExist: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CheckLFM A ',UnitCode.Filename,' ',LFMBuf.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(UnitCode) then exit;
|
|
try
|
|
Result:=FCurCodeTool.CheckLFM(LFMBuf,LFMTree,OnFindDefinePropertyForContext,
|
|
RootMustBeClassInUnit,RootMustBeClassInIntf,ObjectsMustExist);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindNextResourceFile(Code: TCodeBuffer;
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddLazarusResourceHeaderComment(Code: TCodeBuffer;
|
|
const CommentText: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
if not InitResourceTool then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddLazarusResourceHeaderComment A ',Code.Filename,' CommentText=',CommentText);
|
|
{$ENDIF}
|
|
try
|
|
Result:=GetResourceTool.AddLazarusResourceHeaderComment(Code,
|
|
'{ '+CommentText+' }'+SourceChangeCache.BeautifyCodeOptions.LineEnd
|
|
+SourceChangeCache.BeautifyCodeOptions.LineEnd);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): TAtomPosition;
|
|
begin
|
|
Result.StartPos:=-1;
|
|
if not InitResourceTool then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
|
{$ENDIF}
|
|
try
|
|
Result:=GetResourceTool.FindLazarusResource(Code,ResourceName,-1);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName, ResourceData: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',dbgs(length(ResourceData)));
|
|
{$ENDIF}
|
|
if not InitResourceTool then exit;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddLazarusResource B ');
|
|
{$ENDIF}
|
|
try
|
|
Result:=GetResourceTool.AddLazarusResource(Code,ResourceName,ResourceData);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
|
{$ENDIF}
|
|
if not InitResourceTool then exit;
|
|
try
|
|
Result:=GetResourceTool.RemoveLazarusResource(Code,ResourceName);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameMainInclude(Code: TCodeBuffer;
|
|
const NewFilename: string; KeepPath: boolean): boolean;
|
|
var
|
|
LinkIndex: integer;
|
|
OldIgnoreMissingIncludeFiles: boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
OldIgnoreMissingIncludeFiles:=
|
|
FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
|
|
FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=true;
|
|
LinkIndex:=-1;
|
|
if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
|
|
Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
|
|
SourceChangeCache);
|
|
FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=
|
|
OldIgnoreMissingIncludeFiles;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameIncludeDirective(Code: TCodeBuffer;
|
|
LinkIndex: integer; const NewFilename: string; KeepPath: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameIncludeDirective A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.DefaultFindDefinePropertyForContext(Sender: TObject;
|
|
const ClassContext, AncestorClassContext: TFindContext; LFMNode: TLFMTreeNode;
|
|
const IdentName: string; var IsDefined: boolean);
|
|
var
|
|
PersistentClassName: String;
|
|
AncestorClassName: String;
|
|
begin
|
|
if Assigned(OnFindDefineProperty) then begin
|
|
PersistentClassName:=ClassContext.Tool.ExtractClassName(
|
|
ClassContext.Node,false);
|
|
AncestorClassName:='';
|
|
if AncestorClassContext.Tool<>nil then
|
|
AncestorClassName:=AncestorClassContext.Tool.ExtractClassName(
|
|
AncestorClassContext.Node,false);
|
|
OnFindDefineProperty(ClassContext.Tool,
|
|
PersistentClassName,AncestorClassName,IdentName,
|
|
IsDefined);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindCreateFormStatement(Code: TCodeBuffer;
|
|
StartPos: integer;
|
|
const AClassName, AVarName: string;
|
|
out Position: integer): integer;
|
|
// 0=found, -1=not found, 1=found, but wrong classname
|
|
var PosAtom: TAtomPosition;
|
|
begin
|
|
Result:=-1;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',dbgs(StartPos),' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindCreateFormStatement(StartPos,AClassName,
|
|
AVarName,PosAtom);
|
|
if Result<>-1 then
|
|
Position:=PosAtom.StartPos;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddCreateFormStatement(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveCreateFormStatement(Code: TCodeBuffer;
|
|
const AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveCreateFormStatement(AVarName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ChangeCreateFormStatement(Code: TCodeBuffer;
|
|
const OldClassName, OldVarName: string; const NewClassName,
|
|
NewVarName: string; OnlyIfExists: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ChangeCreateFormStatement A ',Code.Filename,
|
|
' ',OldVarName+':',OldClassName,' -> ',NewVarName+':',NewClassName,
|
|
' OnlyIfExists=',dbgs(OnlyIfExists));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ChangeCreateFormStatement(-1,OldClassName,OldVarName,
|
|
NewClassName,NewVarName,OnlyIfExists,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ListAllCreateFormStatements(
|
|
Code: TCodeBuffer): TStrings;
|
|
begin
|
|
Result:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ListAllCreateFormStatements;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.SetAllCreateFromStatements(Code: TCodeBuffer;
|
|
List: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetApplicationTitleStatement(Code: TCodeBuffer;
|
|
var Title: string): boolean;
|
|
var
|
|
StartPos, StringConstStartPos, EndPos: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.GetApplicationTitleStatement A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos,
|
|
StringConstStartPos,EndPos);
|
|
if StartPos=0 then ;
|
|
Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos,
|
|
EndPos,Title);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.SetApplicationTitleStatement(Code: TCodeBuffer;
|
|
const NewTitle: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.SetApplicationTitleStatement A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.SetApplicationTitleStatement(NewTitle,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveApplicationTitleStatement(Code: TCodeBuffer
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemoveApplicationTitleStatement A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveApplicationTitleStatement(SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameForm(Code: TCodeBuffer; const OldFormName,
|
|
OldFormClassName: string; const NewFormName, NewFormClassName: string
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenameForm A ',Code.Filename,
|
|
' OldFormName=',OldFormName,' OldFormClassName=',OldFormClassName,
|
|
' NewFormName=',NewFormName,' NewFormClassName=',NewFormClassName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameForm(OldFormName,OldFormClassName,
|
|
NewFormName,NewFormClassName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindFormAncestor(Code: TCodeBuffer;
|
|
const FormClassName: string; var AncestorClassName: string;
|
|
DirtySearch: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindFormAncestor A ',Code.Filename,' ',FormClassName);
|
|
{$ENDIF}
|
|
AncestorClassName:='';
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindFormAncestor(FormClassName,AncestorClassName);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
if (not Result) and DirtySearch then begin
|
|
AncestorClassName:=FindClassAncestorName(Code.Source,FormClassName);
|
|
Result:=AncestorClassName<>'';
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CompleteComponent(Code: TCodeBuffer;
|
|
AComponent, AncestorComponent: TComponent): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.CompleteComponent A ',Code.Filename,' ',AComponent.Name,':',AComponent.ClassName,' ',dbgsName(AncestorComponent));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.CompleteComponent(AComponent,AncestorComponent,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindPublishedVariable(AClassName,
|
|
AVarName,ErrorOnClassNotFound)<>nil;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddPublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, VarName, VarType: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddPublishedVariable(AClassName,
|
|
VarName,VarType,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemovePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemovePublishedVariable(AClassName,
|
|
AVarName,ErrorOnClassNotFound,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenamePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, OldVariableName, NewVarName, VarType: shortstring;
|
|
ErrorOnClassNotFound: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RenamePublishedVariable A ',Code.Filename,' ',AClassName,' OldVar=',OldVariableName,' NewVar=',NewVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenamePublishedVariable(AClassName,
|
|
OldVariableName,NewVarName,VarType,
|
|
ErrorOnClassNotFound,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer;
|
|
const AClassName: string; ListOfReTypes: TStringToStringTree;
|
|
ErrorOnClassNotFound: boolean; SearchImplementationToo: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.RetypeClassVariables A ',Code.Filename,' ',AClassName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RetypeClassVariables(AClassName,ListOfReTypes,
|
|
ErrorOnClassNotFound,SourceChangeCache,SearchImplementationToo);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
|
|
const AClassName: string; RootComponent: TComponent;
|
|
ExceptionOnClassNotFound, SearchInAncestors: boolean; out
|
|
ListOfPInstancePropInfo: TFPList;
|
|
const OverrideGetMethodName: TOnGetMethodname): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.FindDanglingComponentEvents A ',Code.Filename,' ',AClassName);
|
|
{$ENDIF}
|
|
ListOfPInstancePropInfo:=nil;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent,
|
|
ExceptionOnClassNotFound,SearchInAncestors,
|
|
ListOfPInstancePropInfo,OverrideGetMethodName);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.HasInterfaceRegisterProc(Code: TCodeBuffer;
|
|
var HasRegisterProc: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.HasInterfaceRegisterProc A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.HasInterfaceRegisterProc(HasRegisterProc);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ConvertDelphiToLazarusSource(Code: TCodeBuffer;
|
|
AddLRSCode: boolean): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCodeToolManager.ConvertDelphiToLazarusSource A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ConvertDelphiToLazarusSource(AddLRSCode,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnFindUsedUnit(SrcTool: TFindDeclarationTool;
|
|
const TheUnitName, TheUnitInFilename: string): TCodeBuffer;
|
|
begin
|
|
if Assigned(OnSearchUsedUnit) then
|
|
Result:=OnSearchUsedUnit(SrcTool.MainFilename,
|
|
TheUnitName,TheUnitInFilename)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnGetSrcPathForCompiledUnit(Sender: TObject;
|
|
const AFilename: string): string;
|
|
begin
|
|
if CompareFileExt(AFilename,'.ppu',false)=0 then
|
|
Result:=GetPPUSrcPathForDirectory(ExtractFilePath(AFilename))
|
|
else if CompareFileExt(AFilename,'.dcu',false)=0 then
|
|
Result:=GetDCUSrcPathForDirectory(ExtractFilePath(AFilename));
|
|
if Result='' then
|
|
Result:=GetCompiledSrcPathForDirectory(ExtractFilePath(AFilename));
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnInternalGetMethodName(const AMethod: TMethod;
|
|
CheckOwner: TObject): string;
|
|
begin
|
|
if Assigned(OnGetMethodName) then
|
|
Result:=OnGetMethodName(AMethod,CheckOwner)
|
|
else if (AMethod.Data=nil) or (AMethod.Code=nil) then
|
|
Result:=''
|
|
else if (CheckOwner<>nil) and (TObject(AMethod.Data)<>CheckOwner) then
|
|
Result:=''
|
|
else
|
|
Result:=TObject(AMethod.Data).MethodName(AMethod.Code);
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnParserProgress(Tool: TCustomCodeTool): boolean;
|
|
begin
|
|
Result:=true;
|
|
if not FAbortable then exit;
|
|
if not Assigned(OnCheckAbort) then exit;
|
|
Result:=not OnCheckAbort();
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnToolTreeChange(Tool: TCustomCodeTool;
|
|
NodesDeleting: boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
CTIncreaseChangeStamp(FCodeNodeTreeChangeStep);
|
|
if NodesDeleting then begin
|
|
CTIncreaseChangeStamp(FCodeTreeNodesDeletedStep);
|
|
// Note: IdentifierList nodes do not need to be cleared, because Node
|
|
// is accessed via GetNode, which checks if nodes were deleted
|
|
end;
|
|
//debugln(['TCodeToolManager.OnToolTreeChange ',FHandlers[ctmOnToolTreeChanging].Count]);
|
|
i:=FHandlers[ctmOnToolTreeChanging].Count;
|
|
while FHandlers[ctmOnToolTreeChanging].NextDownIndex(i) do
|
|
TOnToolTreeChanging(FHandlers[ctmOnToolTreeChanging][i])(Tool,NodesDeleting);
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnScannerProgress(Sender: TLinkScanner): boolean;
|
|
begin
|
|
Result:=true;
|
|
if not FAbortable then exit;
|
|
if not Assigned(OnCheckAbort) then exit;
|
|
Result:=not OnCheckAbort();
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnFABGetNestedComments(Sender: TObject;
|
|
Code: TCodeBuffer; out NestedComments: boolean);
|
|
begin
|
|
NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnFABGetExamples(Sender: TObject; Code: TCodeBuffer;
|
|
Step: integer; var CodeBuffers: TFPList; var ExpandedFilenames: TStrings);
|
|
begin
|
|
if Assigned(OnGetIndenterExamples) then
|
|
OnGetIndenterExamples(Sender,Code,Step,CodeBuffers,ExpandedFilenames);
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnLoadFileForTool(Sender: TObject;
|
|
const ExpandedFilename: string; out Code: TCodeBuffer; var Abort: boolean);
|
|
begin
|
|
Code:=LoadFile(ExpandedFilename,true,false);
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnScannerGetInitValues(Scanner: TLinkScanner;
|
|
Code: Pointer; out AChangeStep: integer): TExpressionEvaluator;
|
|
begin
|
|
Result:=nil;
|
|
AChangeStep:=DefineTree.ChangeStep;
|
|
if Code=nil then exit;
|
|
//DefineTree.WriteDebugReport;
|
|
if not TCodeBuffer(Code).IsVirtual then
|
|
Result:=DefineTree.GetDefinesForDirectory(
|
|
ExtractFilePath(TCodeBuffer(Code).Filename),false)
|
|
else
|
|
Result:=DefineTree.GetDefinesForVirtualDirectory;
|
|
if Assigned(OnScannerInit) then
|
|
OnScannerInit(Self,Scanner);
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnDefineTreeReadValue(Sender: TObject;
|
|
const VariableName: string; var Value: string; var Handled: boolean);
|
|
begin
|
|
Handled:=GlobalValues.IsDefined(VariableName);
|
|
if Handled then
|
|
Value:=GlobalValues[VariableName];
|
|
//DebugLn('[TCodeToolManager.OnDefineTreeReadValue] Name="',VariableName,'" = "',Value,'"');
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnGlobalValuesChanged;
|
|
begin
|
|
DefineTree.ClearCache;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean);
|
|
begin
|
|
if NewValue=FCheckFilesOnDisk then exit;
|
|
FCheckFilesOnDisk:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.CheckFilesOnDisk:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCodeCompletionTemplateFileName(AValue: String);
|
|
var
|
|
OldValue: String;
|
|
Code: TCodeBuffer;
|
|
begin
|
|
AValue:=CleanAndExpandFilename(AValue);
|
|
if FCodeCompletionTemplateFileName=AValue then Exit;
|
|
OldValue:=FCodeCompletionTemplateFileName;
|
|
FCodeCompletionTemplateFileName:=AValue;
|
|
if CompareFilenames(FCodeCompletionTemplateFileName,OldValue)=0 then exit;
|
|
if (FCodeCompletionTemplateFileName<>'') then
|
|
Code:=LoadFile(FCodeCompletionTemplateFileName,true,false)
|
|
else
|
|
Code:=nil;
|
|
if Code<>nil then begin
|
|
if Expander=nil then
|
|
Expander:=TTemplateExpander.Create;
|
|
Expander.Code:=Code;
|
|
end else begin
|
|
FreeAndNil(Expander);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCompleteProperties(const AValue: boolean);
|
|
begin
|
|
if CompleteProperties=AValue then exit;
|
|
FCompleteProperties:=AValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.CompleteProperties:=AValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetIndentSize(NewValue: integer);
|
|
begin
|
|
if NewValue=FIndentSize then exit;
|
|
FIndentSize:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.IndentSize:=NewValue;
|
|
SourceChangeCache.BeautifyCodeOptions.Indent:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetTabWidth(const AValue: integer);
|
|
begin
|
|
if FTabWidth=AValue then exit;
|
|
FTabWidth:=AValue;
|
|
SourceChangeCache.BeautifyCodeOptions.TabWidth:=AValue;
|
|
Indenter.DefaultTabWidth:=AValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetUseTabs(AValue: boolean);
|
|
begin
|
|
if FUseTabs=AValue then Exit;
|
|
FUseTabs:=AValue;
|
|
SourceChangeCache.BeautifyCodeOptions.UseTabs:=UseTabs;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer);
|
|
begin
|
|
if NewValue=FVisibleEditorLines then exit;
|
|
FVisibleEditorLines:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.VisibleEditorLines:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetJumpCentered(NewValue: boolean);
|
|
begin
|
|
if NewValue=FJumpCentered then exit;
|
|
FJumpCentered:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.JumpCentered:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetSetPropertyVariablename(aValue: string);
|
|
begin
|
|
if FSetPropertyVariablename=aValue then Exit;
|
|
FSetPropertyVariablename:=aValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean);
|
|
begin
|
|
if NewValue=FCursorBeyondEOL then exit;
|
|
FCursorBeyondEOL:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.CursorBeyondEOL:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean);
|
|
begin
|
|
IncreaseChangeStep;
|
|
if Assigned(FOnBeforeApplyChanges) then
|
|
FOnBeforeApplyChanges(Self,Abort);
|
|
end;
|
|
|
|
procedure TCodeToolManager.AfterApplyingChanges;
|
|
begin
|
|
// clear all codetrees of changed buffers
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.Clear;
|
|
|
|
// user callback
|
|
if Assigned(FOnAfterApplyChanges) then
|
|
FOnAfterApplyChanges(Self);
|
|
end;
|
|
|
|
function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer
|
|
): TCustomCodeTool;
|
|
var
|
|
ANode: TAVLTreeNode;
|
|
CurSrc, SearchedSrc: Pointer;
|
|
begin
|
|
ANode:=FPascalTools.Root;
|
|
SearchedSrc:=Pointer(Code);
|
|
while (ANode<>nil) do begin
|
|
CurSrc:=Pointer(TCustomCodeTool(ANode.Data).Scanner.MainCode);
|
|
if CurSrc>SearchedSrc then
|
|
ANode:=ANode.Left
|
|
else if CurSrc<SearchedSrc then
|
|
ANode:=ANode.Right
|
|
else begin
|
|
Result:=TCustomCodeTool(ANode.Data);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetError(Code: TCodeBuffer; Line, Column: integer;
|
|
const TheMessage: string);
|
|
begin
|
|
FErrorMsg:=TheMessage;
|
|
FErrorCode:=Code;
|
|
FErrorLine:=Line;
|
|
FErrorColumn:=Column;
|
|
FErrorTopLine:=FErrorLine;
|
|
AdjustErrorTopLine;
|
|
WriteError;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
|
|
GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
|
|
// return a codetool for the source
|
|
begin
|
|
Result:=nil;
|
|
if Code=nil then begin
|
|
if ExceptionOnError then
|
|
raise Exception.Create('TCodeToolManager.GetCodeToolForSource '
|
|
+'internal error: Code=nil');
|
|
exit;
|
|
end;
|
|
if GoToMainCode then
|
|
Code:=GetMainCode(Code);
|
|
Result:=FindCodeToolForSource(Code);
|
|
if Result=nil then begin
|
|
CreateScanner(Code);
|
|
if Code.Scanner=nil then begin
|
|
if ExceptionOnError then
|
|
raise ECodeToolManagerError.CreateFmt(ctsNoScannerFound,[Code.Filename]);
|
|
exit;
|
|
end;
|
|
Result:=TCodeTool.Create;
|
|
Result.Scanner:=Code.Scanner;
|
|
FPascalTools.Add(Result);
|
|
TCodeTool(Result).Beautifier:=SourceChangeCache.BeautifyCodeOptions;
|
|
TCodeTool(Result).OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
|
|
TCodeTool(Result).OnGetDirectoryCache:=@DoOnGetDirectoryCache;
|
|
TCodeTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
|
|
TCodeTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
|
|
TCodeTool(Result).OnGetMethodName:=@DoOnInternalGetMethodName;
|
|
TCodeTool(Result).DirectoryCache:=
|
|
DirectoryCachePool.GetCache(ExtractFilePath(Code.Filename),
|
|
true,true);
|
|
Result.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
|
|
Result.OnTreeChange:=@DoOnToolTreeChange;
|
|
TCodeTool(Result).OnParserProgress:=@DoOnParserProgress;
|
|
end;
|
|
with TCodeTool(Result) do begin
|
|
AdjustTopLineDueToComment:=Self.AdjustTopLineDueToComment;
|
|
AddInheritedCodeToOverrideMethod:=Self.AddInheritedCodeToOverrideMethod;
|
|
CompleteProperties:=Self.CompleteProperties;
|
|
SetPropertyVariablename:=Self.SetPropertyVariablename;
|
|
end;
|
|
Result.CheckFilesOnDisk:=FCheckFilesOnDisk;
|
|
Result.IndentSize:=FIndentSize;
|
|
Result.VisibleEditorLines:=FVisibleEditorLines;
|
|
Result.JumpCentered:=FJumpCentered;
|
|
Result.CursorBeyondEOL:=FCursorBeyondEOL;
|
|
end;
|
|
|
|
function TCodeToolManager.FindDirectivesToolForSource(Code: TCodeBuffer
|
|
): TDirectivesTool;
|
|
var
|
|
ANode: TAVLTreeNode;
|
|
CurSrc, SearchedSrc: Pointer;
|
|
begin
|
|
ANode:=FDirectivesTools.Root;
|
|
SearchedSrc:=Pointer(Code);
|
|
while (ANode<>nil) do begin
|
|
CurSrc:=Pointer(TDirectivesTool(ANode.Data).Code);
|
|
if CurSrc>SearchedSrc then
|
|
ANode:=ANode.Left
|
|
else if CurSrc<SearchedSrc then
|
|
ANode:=ANode.Right
|
|
else begin
|
|
Result:=TDirectivesTool(ANode.Data);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ClearCurDirectivesTool;
|
|
begin
|
|
ClearError;
|
|
FCurDirectivesTool:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.InitCurDirectivesTool(Code: TCodeBuffer): boolean;
|
|
begin
|
|
Result:=false;
|
|
ClearCurDirectivesTool;
|
|
FCurDirectivesTool:=TDirectivesTool(GetDirectivesToolForSource(Code,true));
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.InitCurDirectivesTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
|
|
{$ENDIF}
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCodeToolManager.GetDirectivesToolForSource(Code: TCodeBuffer;
|
|
ExceptionOnError: boolean): TCompilerDirectivesTree;
|
|
begin
|
|
Result:=FindDirectivesToolForSource(Code);
|
|
if Result=nil then begin
|
|
Result:=TDirectivesTool.Create;
|
|
Result.Code:=Code;
|
|
FDirectivesTools.Add(Result);
|
|
end;
|
|
Result.NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetAbortable(const AValue: boolean);
|
|
begin
|
|
if FAbortable=AValue then exit;
|
|
FAbortable:=AValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetAddInheritedCodeToOverrideMethod(
|
|
const AValue: boolean);
|
|
begin
|
|
if FAddInheritedCodeToOverrideMethod=AValue then exit;
|
|
FAddInheritedCodeToOverrideMethod:=AValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.AddInheritedCodeToOverrideMethod:=AValue;
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnGetCodeToolForBuffer(Sender: TObject;
|
|
Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DbgOut('[TCodeToolManager.OnGetCodeToolForBuffer]');
|
|
if Sender is TCustomCodeTool then
|
|
DbgOut(' Sender=',TCustomCodeTool(Sender).MainFilename);
|
|
debugln(' Code=',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=TFindDeclarationTool(GetCodeToolForSource(Code,GoToMainCode,true));
|
|
end;
|
|
|
|
function TCodeToolManager.DoOnGetDirectoryCache(const ADirectory: string
|
|
): TCTDirectoryCache;
|
|
begin
|
|
Result:=DirectoryCachePool.GetCache(ADirectory,true,true);
|
|
end;
|
|
|
|
procedure TCodeToolManager.ActivateWriteLock;
|
|
begin
|
|
if FWriteLockCount=0 then begin
|
|
// start a new write lock
|
|
if FWriteLockStep<>$7fffffff then
|
|
inc(FWriteLockStep)
|
|
else
|
|
FWriteLockStep:=-$7fffffff;
|
|
SourceCache.GlobalWriteLockIsSet:=true;
|
|
SourceCache.GlobalWriteLockStep:=FWriteLockStep;
|
|
end;
|
|
inc(FWriteLockCount);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.ActivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCodeToolManager.DeactivateWriteLock;
|
|
begin
|
|
if FWriteLockCount>0 then begin
|
|
dec(FWriteLockCount);
|
|
if FWriteLockCount=0 then begin
|
|
// end the write lock
|
|
if FWriteLockStep<>$7fffffff then
|
|
inc(FWriteLockStep)
|
|
else
|
|
FWriteLockStep:=-$7fffffff;
|
|
SourceCache.GlobalWriteLockIsSet:=false;
|
|
SourceCache.GlobalWriteLockStep:=FWriteLockStep;
|
|
end;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('[TCodeToolManager.DeactivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCodeToolManager.IncreaseChangeStep;
|
|
begin
|
|
if FChangeStep<>High(Integer) then
|
|
inc(FChangeStep)
|
|
else
|
|
FChangeStep:=Low(Integer);
|
|
end;
|
|
|
|
procedure TCodeToolManager.GetCodeTreeNodesDeletedStep(out
|
|
NodesDeletedStep: integer);
|
|
begin
|
|
NodesDeletedStep:=FCodeTreeNodesDeletedStep;
|
|
end;
|
|
|
|
procedure TCodeToolManager.AddHandlerToolTreeChanging(
|
|
const OnToolTreeChanging: TOnToolTreeChanging);
|
|
begin
|
|
AddHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
|
|
end;
|
|
|
|
procedure TCodeToolManager.RemoveHandlerToolTreeChanging(
|
|
const OnToolTreeChanging: TOnToolTreeChanging);
|
|
begin
|
|
RemoveHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
|
|
end;
|
|
|
|
function TCodeToolManager.GetResourceTool: TResourceCodeTool;
|
|
begin
|
|
if FResourceTool=nil then FResourceTool:=TResourceCodeTool.Create;
|
|
Result:=FResourceTool;
|
|
end;
|
|
|
|
function TCodeToolManager.GetOwnerForCodeTreeNode(ANode: TCodeTreeNode
|
|
): TObject;
|
|
var
|
|
AToolNode: TAVLTreeNode;
|
|
CurTool: TCustomCodeTool;
|
|
RootCodeTreeNode: TCodeTreeNode;
|
|
CurDirTool: TCompilerDirectivesTree;
|
|
begin
|
|
Result:=nil;
|
|
if ANode=nil then exit;
|
|
RootCodeTreeNode:=ANode.GetRoot;
|
|
|
|
// search in codetools
|
|
AToolNode:=FPascalTools.FindLowest;
|
|
while (AToolNode<>nil) do begin
|
|
CurTool:=TCustomCodeTool(AToolNode.Data);
|
|
if (CurTool.Tree<>nil) and (CurTool.Tree.Root=RootCodeTreeNode) then begin
|
|
Result:=CurTool;
|
|
exit;
|
|
end;
|
|
AToolNode:=FPascalTools.FindSuccessor(AToolNode);
|
|
end;
|
|
|
|
// search in directivestools
|
|
AToolNode:=FDirectivesTools.FindLowest;
|
|
while (AToolNode<>nil) do begin
|
|
CurDirTool:=TCompilerDirectivesTree(AToolNode.Data);
|
|
if (CurDirTool.Tree<>nil) and (CurDirTool.Tree.Root=RootCodeTreeNode) then
|
|
begin
|
|
Result:=CurDirTool;
|
|
exit;
|
|
end;
|
|
AToolNode:=FDirectivesTools.FindSuccessor(AToolNode);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.DirectoryCachePoolGetString(const ADirectory: string;
|
|
const AStringType: TCTDirCacheString): string;
|
|
begin
|
|
case AStringType of
|
|
ctdcsUnitPath: Result:=GetUnitPathForDirectory(ADirectory,false);
|
|
ctdcsSrcPath: Result:=GetSrcPathForDirectory(ADirectory,false);
|
|
ctdcsIncludePath: Result:=GetIncludePathForDirectory(ADirectory,false);
|
|
ctdcsCompleteSrcPath: Result:=GetCompleteSrcPathForDirectory(ADirectory,false);
|
|
ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false);
|
|
ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false);
|
|
ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false);
|
|
else RaiseCatchableException('');
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.DirectoryCachePoolFindVirtualFile(
|
|
const Filename: string): string;
|
|
var
|
|
Code: TCodeBuffer;
|
|
begin
|
|
Result:='';
|
|
if (Filename='') or (System.Pos(PathDelim,Filename)>0) then
|
|
exit;
|
|
Code:=FindFile(Filename);
|
|
if Code<>nil then
|
|
Result:=Code.Filename;
|
|
end;
|
|
|
|
function TCodeToolManager.DirectoryCachePoolGetUnitFromSet(const UnitSet,
|
|
AnUnitName: string; SrcSearchRequiresPPU: boolean): string;
|
|
var
|
|
Changed: boolean;
|
|
UnitSetCache: TFPCUnitSetCache;
|
|
begin
|
|
Result:='';
|
|
UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
|
|
if UnitSetCache=nil then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
if Changed then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
Result:=UnitSetCache.GetUnitSrcFile(AnUnitName,SrcSearchRequiresPPU);
|
|
end;
|
|
|
|
function TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet(
|
|
const UnitSet, AnUnitName: string): string;
|
|
var
|
|
Changed: boolean;
|
|
UnitSetCache: TFPCUnitSetCache;
|
|
begin
|
|
Result:='';
|
|
UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
|
|
if UnitSetCache=nil then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
if Changed then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
Result:=UnitSetCache.GetCompiledUnitFile(AnUnitName);
|
|
end;
|
|
|
|
procedure TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet(
|
|
const UnitSet: string; const Iterate: TCTOnIterateFile);
|
|
var
|
|
Changed: boolean;
|
|
UnitSetCache: TFPCUnitSetCache;
|
|
aConfigCache: TFPCTargetConfigCache;
|
|
Node: TAVLTreeNode;
|
|
Item: PStringToStringTreeItem;
|
|
begin
|
|
UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
|
|
if UnitSetCache=nil then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
if Changed then begin
|
|
debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
|
|
exit;
|
|
end;
|
|
aConfigCache:=UnitSetCache.GetConfigCache(false);
|
|
if (aConfigCache=nil) or (aConfigCache.Units=nil) then exit;
|
|
Node:=aConfigCache.Units.Tree.FindLowest;
|
|
while Node<>nil do begin
|
|
Item:=PStringToStringTreeItem(Node.Data);
|
|
Iterate(Item^.Value);
|
|
Node:=aConfigCache.Units.Tree.FindSuccessor(Node);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeToolManager.AddHandler(HandlerType: TCodeToolManagerHandler;
|
|
const Handler: TMethod);
|
|
begin
|
|
if Handler.Code=nil then RaiseCatchableException('TCodeToolManager.AddHandler');
|
|
if FHandlers[HandlerType]=nil then
|
|
FHandlers[HandlerType]:=TMethodList.Create;
|
|
FHandlers[HandlerType].Add(Handler);
|
|
end;
|
|
|
|
procedure TCodeToolManager.RemoveHandler(HandlerType: TCodeToolManagerHandler;
|
|
const Handler: TMethod);
|
|
begin
|
|
FHandlers[HandlerType].Remove(Handler);
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnToolSetWriteLock(Lock: boolean);
|
|
begin
|
|
if Lock then ActivateWriteLock else DeactivateWriteLock;
|
|
end;
|
|
|
|
procedure TCodeToolManager.DoOnToolGetChangeSteps(out SourcesChangeStep,
|
|
FilesChangeStep: int64; out InitValuesChangeStep: integer);
|
|
begin
|
|
SourcesChangeStep:=SourceCache.ChangeStamp;
|
|
FilesChangeStep:=FileStateCache.TimeStamp;
|
|
InitValuesChangeStep:=DefineTree.ChangeStep;
|
|
end;
|
|
|
|
procedure TCodeToolManager.ConsistencyCheck;
|
|
var
|
|
CurResult: LongInt;
|
|
begin
|
|
if FCurCodeTool<>nil then begin
|
|
FCurCodeTool.ConsistencyCheck;
|
|
end;
|
|
DefinePool.ConsistencyCheck;
|
|
DefineTree.ConsistencyCheck;
|
|
SourceCache.ConsistencyCheck;
|
|
GlobalValues.ConsistencyCheck;
|
|
SourceChangeCache.ConsistencyCheck;
|
|
CurResult:=FPascalTools.ConsistencyCheck;
|
|
if CurResult<>0 then
|
|
RaiseCatchableException(IntToStr(CurResult));
|
|
CurResult:=FDirectivesTools.ConsistencyCheck;
|
|
if CurResult<>0 then
|
|
RaiseCatchableException(IntToStr(CurResult));
|
|
end;
|
|
|
|
procedure TCodeToolManager.WriteDebugReport(WriteTool,
|
|
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
|
|
WriteMemStats: boolean);
|
|
begin
|
|
DebugLn('[TCodeToolManager.WriteDebugReport]');
|
|
if FCurCodeTool<>nil then begin
|
|
if WriteTool then
|
|
FCurCodeTool.WriteDebugTreeReport;
|
|
end;
|
|
if WriteDefPool then
|
|
DefinePool.WriteDebugReport
|
|
else
|
|
DefinePool.ConsistencyCheck;
|
|
if WriteDefTree then
|
|
DefineTree.WriteDebugReport
|
|
else
|
|
DefineTree.ConsistencyCheck;
|
|
if WriteCache then
|
|
SourceCache.WriteDebugReport
|
|
else
|
|
SourceCache.ConsistencyCheck;
|
|
if WriteGlobalValues then
|
|
GlobalValues.WriteDebugReport
|
|
else
|
|
GlobalValues.ConsistencyCheck;
|
|
if WriteMemStats then WriteMemoryStats;
|
|
|
|
ConsistencyCheck;
|
|
end;
|
|
|
|
procedure TCodeToolManager.WriteMemoryStats;
|
|
var
|
|
Node: TAVLTreeNode;
|
|
ATool: TEventsCodeTool;
|
|
Stats: TCTMemStats;
|
|
begin
|
|
DebugLn(['Memory stats: ']);
|
|
Stats:=TCTMemStats.Create;
|
|
// boss
|
|
Stats.Add('Boss',
|
|
PtrUInt(InstanceSize)
|
|
+MemSizeString(FErrorMsg)
|
|
+MemSizeString(FSetPropertyVariablename)
|
|
+MemSizeString(FSourceExtensions)
|
|
);
|
|
if DefinePool<>nil then
|
|
DefinePool.CalcMemSize(Stats);
|
|
if DefineTree<>nil then
|
|
DefineTree.CalcMemSize(Stats);
|
|
if SourceCache<>nil then
|
|
SourceCache.CalcMemSize(Stats);
|
|
if SourceChangeCache<>nil then
|
|
SourceChangeCache.CalcMemSize(Stats);
|
|
if GlobalValues<>nil then
|
|
Stats.Add('GlobalValues',GlobalValues.CalcMemSize);
|
|
if DirectoryCachePool<>nil then
|
|
DirectoryCachePool.CalcMemSize(Stats);
|
|
if IdentifierList<>nil then
|
|
Stats.Add('IdentifierList',IdentifierList.CalcMemSize);
|
|
if IdentifierHistory<>nil then
|
|
Stats.Add('IdentifierHistory',IdentifierHistory.CalcMemSize);
|
|
if Positions<>nil then
|
|
Stats.Add('Positions',Positions.CalcMemSize);
|
|
|
|
if FDirectivesTools<>nil then begin
|
|
Stats.Add('FDirectivesTools.Count',FDirectivesTools.Count);
|
|
// ToDo
|
|
end;
|
|
if FPascalTools<>nil then begin
|
|
Stats.Add('PascalTools.Count',FPascalTools.Count);
|
|
Stats.Add('PascalTools',PtrUInt(FPascalTools.Count)*SizeOf(Node));
|
|
Node:=FPascalTools.FindLowest;
|
|
while Node<>nil do begin
|
|
ATool:=TCodeTool(Node.Data);
|
|
ATool.CalcMemSize(Stats);
|
|
Node:=FPascalTools.FindSuccessor(Node);
|
|
end;
|
|
end;
|
|
Stats.Add('KeywordFuncLists.Global',KeywordFuncLists.CalcMemSize);
|
|
Stats.Add('FileStateCache',FileStateCache.CalcMemSize);
|
|
Stats.Add('GlobalIdentifierTree',GlobalIdentifierTree.CalcMemSize);
|
|
Stats.WriteReport;
|
|
Stats.Free;
|
|
end;
|
|
|
|
//-----------------------------------------------------------------------------
|
|
|
|
initialization
|
|
CodeToolBoss:=TCodeToolManager.Create;
|
|
OnFindOwnerOfCodeTreeNode:=@GetOwnerForCodeTreeNode;
|
|
|
|
|
|
finalization
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('codetoolmanager.pas - finalization');
|
|
{$ENDIF}
|
|
OnFindOwnerOfCodeTreeNode:=nil;
|
|
CodeToolBoss.Free;
|
|
CodeToolBoss:=nil;
|
|
FreeAndNil(Expander);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('codetoolmanager.pas - finalization finished');
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|