{ *************************************************************************** * * * 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 . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, 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, TypInfo, types, Laz_AVL_Tree, // LazUtils LazFileUtils, LazFileCache, LazMethodList, LazDbgLog, AvgLvlTree, LazStringUtils, // Codetools FileProcs, BasicCodeTools, CodeToolsStrConsts, EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, FindOverloads, CodeBeautifier, FindDeclarationCache, DirectoryCacher, PPUCodeTools, LFMTrees, DirectivesTree, CodeCompletionTemplater, PascalParserTool, CodeToolsConfig, CustomCodeTool, FindDeclarationTool, IdentCompletionTool, StdCodeTools, ResourceCodeTool, CodeToolsStructs, CTUnitGraph, 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; TOnFindFPCMangledSource = procedure(Sender: TObject; SrcType: TCodeTreeNodeDesc; const SrcName: string; out SrcFilename: string) of object; { ECodeToolManagerError } ECodeToolManagerError = class(Exception) public Id: int64; constructor Create(TheID: int64; const Msg: string); constructor CreateFmt(TheID: int64; const Msg: string; const Args: array of const); end; 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; FErrorId: int64; FErrorLine: integer; FErrorMsg: string; FErrorTopLine: integer; FCodeTreeNodesDeletedStep: integer; FIndentSize: integer; FJumpSingleLinePos: integer; FJumpCodeBlockPos: integer; FIdentifierListUpdating: boolean; FOnAfterApplyChanges: TOnAfterApplyCTChanges; FOnBeforeApplyChanges: TOnBeforeApplyCTChanges; FOnCheckAbort: TOnCodeToolCheckAbort; FOnFindFPCMangledSource: TOnFindFPCMangledSource; FOnGatherExternalChanges: TOnGatherExternalChanges; FOnFindDefinePropertyForContext: TOnFindDefinePropertyForContext; FOnFindDefineProperty: TOnFindDefineProperty; FOnGatherUserIdentifiers: TOnGatherUserIdentifiers; FOnGetIndenterExamples: TOnGetFABExamples; FOnGetMethodName: TOnGetMethodname; FOnRescanFPCDirectoryCache: TNotifyEvent; FOnScannerInit: TOnScannerInit; FOnSearchUsedUnit: TOnSearchUsedUnit; FResourceTool: TResourceCodeTool; FSetPropertyVariablename: string; FSetPropertyVariableIsPrefix: Boolean; FSetPropertyVariableUseConst: Boolean; 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; FErrorDbgMsg: string; procedure DoOnGatherUserIdentifiers(Sender: TIdentCompletionTool; const ContextFlags: TIdentifierListContextFlags); procedure DoOnRescanFPCDirectoryCache(Sender: TObject); 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 SetSetPropertyVariableIsPrefix(aValue: Boolean); procedure SetSetPropertyVariablename(AValue: string); procedure SetSetPropertyVariableUseConst(aValue: Boolean); procedure SetTabWidth(const AValue: integer); procedure SetUseTabs(AValue: boolean); procedure SetVisibleEditorLines(NewValue: integer); procedure SetJumpSingleLinePos(NewValue: integer); procedure SetJumpCodeBlockPos(NewValue: integer); 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 {%H-}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({%H-}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; CompilerDefinesCache: TCompilerDefinesCache; IdentifierList: TIdentifierList; IdentifierHistory: TIdentifierHistoryList; Positions: TCodeXYPositions; Indenter: TFullyAutomaticBeautifier; property FPCDefinesCache: TCompilerDefinesCache read CompilerDefinesCache; deprecated 'use CompilerDefinesCache'; // 1.9 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; property OnRescanFPCDirectoryCache: TNotifyEvent read FOnRescanFPCDirectoryCache write FOnRescanFPCDirectoryCache; // 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(Id: int64; 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 ErrorId: int64 read FErrorId; property ErrorTopLine: integer read fErrorTopLine; property ErrorDbgMsg: string read FErrorDbgMsg; 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 JumpSingleLinePos: integer read FJumpSingleLinePos write SetJumpSingleLinePos; property JumpCodeBlockPos: integer read FJumpCodeBlockPos write SetJumpCodeBlockPos; property SetPropertyVariablename: string read FSetPropertyVariablename write SetSetPropertyVariablename; property SetPropertyVariableIsPrefix: Boolean read FSetPropertyVariableIsPrefix write SetSetPropertyVariableIsPrefix; property SetPropertyVariableUseConst: Boolean read FSetPropertyVariableUseConst write SetSetPropertyVariableUseConst; 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; {%H-}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 {%H-}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); function GetPCVersionForDirectory(const Directory: string): integer; deprecated 'use below'; // 2.0.1 function GetPCVersionForDirectory(const Directory: string; out Kind: TPascalCompiler): integer; function GetNamespacesForDirectory(const Directory: string; UseCache: boolean = true): string;// value of macro #Namespaces // miscellaneous property OnGetMethodName: TOnGetMethodname read FOnGetMethodName write FOnGetMethodName; property OnGetIndenterExamples: TOnGetFABExamples read FOnGetIndenterExamples write FOnGetIndenterExamples; property OnGatherUserIdentifiers: TOnGatherUserIdentifiers read FOnGatherUserIdentifiers write FOnGatherUserIdentifiers; // 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; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean; // find include directive of include file at position X,Y function FindEnclosingIncludeDirective(Code: TCodeBuffer; X,Y: integer; out NewCode: TCodeBuffer; out 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 AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string; const NewSrc: string = ''): boolean; function AddUnitWarnDirective(Code: TCodeBuffer; WarnID, Comment: string; TurnOn: boolean): 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; KeepDirectives: boolean = false; KeepVerbosityDirectives: boolean = false): 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, BlockTopLine, BlockBottomLine: 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, BlockTopLine, BlockBottomLine: 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 FindDeclarationInInterface(Code: TCodeBuffer; const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: 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; function FindFileAtCursor(Code: TCodeBuffer; X,Y: integer; out Found: TFindFileAtCursorFlag; out FoundFilename: string; Allowed: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed; StartPos: PCodeXYPosition = nil): boolean; // get code context (aka parameter hints) function FindCodeContext(Code: TCodeBuffer; X,Y: integer; out CodeContexts: TCodeContextInfo): boolean; function ExtractProcedureHeader(Code: TCodeBuffer; X,Y: integer; Attributes: TProcHeadAttributes; out ProcHead: string): boolean; function HasInterfaceRegisterProc(Code: TCodeBuffer; out HasRegisterProc: boolean): 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; out 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; WithTypeDefIfScoped: boolean = true): 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; // expressions function GetStringConstBounds(Code: TCodeBuffer; X,Y: integer; out StartCode: TCodeBuffer; out StartX, StartY: integer; out EndCode: TCodeBuffer; out EndX, EndY: integer; ResolveComments: boolean): boolean; procedure ImproveStringConstantStart(const ACode: string; var StartPos: integer); procedure ImproveStringConstantEnd(const ACode: string; var EndPos: integer); 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, BlockTopLine, BlockBottomLine: integer;Interactive: Boolean): boolean; function CreateVariableForIdentifier(Code: TCodeBuffer; X,Y,TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; Interactive: Boolean): boolean; function AddMethods(Code: TCodeBuffer; X,Y, TopLine: integer; ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: 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 GetPossibleInitsForVariable(Code: TCodeBuffer; X,Y: integer; out Statements: TStrings; out InsertPositions: TObjectList // e.g. [use unit1, unit2;]i:=0; ): boolean; 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; // simplifications 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; // custom class completion function InitClassCompletion(Code: TCodeBuffer; const AClassName: string; out CodeTool: TCodeTool): boolean; // insert/replace function InsertStatements(InsertPos: TInsertStatementPosDescription; const Statements: string): boolean; // alter proc function AddProcModifier(Code: TCodeBuffer; X, Y: integer; const aModifier: string): 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, BlockTopLine, BlockBottomLine: 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; // 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; out FoundInUnits, MissingInUnits, NormalUnits: TStrings; IgnoreNormalUnits: boolean = false): boolean; function FindDelphiPackageUnits(Code: TCodeBuffer; var FoundInUnits, MissingInUnits, NormalUnits: TStrings; IgnoreNormalUnits: boolean = false): 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; function FindUnusedUnits(Code: TCodeBuffer; Units: TStrings): boolean; // 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; {%H-}LFMNode: TLFMTreeNode; const IdentName: string; var IsDefined: 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; // Application.Scaled:= statements in program source function GetApplicationScaledStatement(Code: TCodeBuffer; var AScaled: Boolean): boolean; function SetApplicationScaledStatement(Code: TCodeBuffer; const NewScaled: Boolean): boolean; function RemoveApplicationScaledStatement(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; // utilities for 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; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: 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 = ''; AddOverride: boolean = false ): 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; const Filter: TOnIDEDirectiveFilter = nil): boolean; function SetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter = nil): 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 FindFPCMangledIdentifier(GDBIdentifier: string; out aComplete: boolean; out aMessage: string; const OnFindSource: TOnFindFPCMangledSource; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean; property OnFindFPCMangledSource: TOnFindFPCMangledSource read FOnFindFPCMangledSource write FOnFindFPCMangledSource; // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 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 Src1Src2 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 Src1Src2 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; { ECodeToolManagerError } constructor ECodeToolManagerError.Create(TheID: int64; const Msg: string); begin Id:=TheID; inherited Create(Msg); end; constructor ECodeToolManagerError.CreateFmt(TheID: int64; const Msg: string; const Args: array of const); begin Id:=TheID; inherited CreateFmt(Msg,Args); 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; CompilerDefinesCache:=TCompilerDefinesCache.Create(nil); PPUCache:=TPPUTools.Create; FAddInheritedCodeToOverrideMethod:=true; FAdjustTopLineDueToComment:=true; FCatchExceptions:=true; FCompleteProperties:=true; FSetPropertyVariablename:='AValue'; FSetPropertyVariableIsPrefix := false; FSetPropertyVariableUseConst := false; FAddInheritedCodeToOverrideMethod := true; FCursorBeyondEOL:=true; FIndentSize:=2; FJumpSingleLinePos:=50; FJumpSingleLinePos:=0; 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(CompilerDefinesCache); 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: TPCTargetConfigCache; 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; CompilerDefinesCache.ConfigCaches.Assign(Config.ConfigCaches); CompilerDefinesCache.SourceCaches.Assign(Config.SourceCaches); CompilerDefinesCache.TestFilename:=Config.TestPascalFile; if CompilerDefinesCache.TestFilename='' then CompilerDefinesCache.TestFilename:=GetTempFilename('fpctest.pas',''); UnitSetCache:=CompilerDefinesCache.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(CompilerDefinesCache.ConfigCaches); Config.SourceCaches.Assign(CompilerDefinesCache.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'') 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; fErrorTopLine:=0; FErrorId:=0; FErrorMsg := ''; FErrorDbgMsg := ''; 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; begin Result:=pcFPC; Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); if Evaluator=nil then exit; Result:=TLinkScanner.GetPascalCompiler(Evaluator); 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:=CompilerDefinesCache.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; FPCFullVersion: LongInt; begin FPCVersion:=0; FPCRelease:=0; FPCPatch:=0; Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); if Evaluator=nil then exit; FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0); FPCVersion:=FPCFullVersion div 10000; FPCRelease:=(FPCFullVersion div 100) mod 100; FPCPatch:=FPCFullVersion mod 100; end; function TCodeToolManager.GetPCVersionForDirectory(const Directory: string ): integer; var Kind: TPascalCompiler; begin Result:=GetPCVersionForDirectory(Directory,Kind); if Kind=pcFPC then ; end; function TCodeToolManager.GetPCVersionForDirectory(const Directory: string; out Kind: TPascalCompiler): integer; var Evaluator: TExpressionEvaluator; s: String; begin Result:=0; Kind:=pcFPC; Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); if Evaluator=nil then exit; s:=Evaluator['FPC_FULLVERSION']; if s<>'' then exit(StrToIntDef(s,0)); s:=Evaluator['PAS2JS_FULLVERSION']; if s<>'' then begin Kind:=pcPas2js; exit(StrToIntDef(s,0)); end; end; function TCodeToolManager.GetNamespacesForDirectory(const Directory: string; UseCache: boolean): string; var Evaluator: TExpressionEvaluator; FPCFullVersion: LongInt; UnitSet: TFPCUnitSetCache; begin if UseCache then begin Result:=DirectoryCachePool.GetString(Directory,ctdcsNamespaces,true) end else begin Result:=''; Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); if Evaluator=nil then exit; if Evaluator.IsDefined('PAS2JS') then Result:=Evaluator[NamespacesMacroName] else begin FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0); if FPCFullVersion>=30101 then Result:=Evaluator[NamespacesMacroName]; end; // add default unit scopes from compiler cfg UnitSet:=GetUnitSetForDirectory(Directory); if UnitSet<>nil then Result:=MergeWithDelimiter(Result,UnitSet.GetUnitScopes,';'); 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 ClearError; 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 ClearError; 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 ClearError; fErrorMsg:=AnException.Message; if (AnException is ELinkScannerError) then begin // link scanner error FErrorId:=ELinkScannerError(AnException).Id; 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; FErrorId:=ECodeToolError(AnException).Id; 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 FErrorId:=ECDirectiveParserException(AnException).Id; ErrorDirTool:=ECDirectiveParserException(AnException).Sender; fErrorCode:=ErrorDirTool.Code; end else if (AnException is ESourceChangeCacheError) then begin // SourceChangeCache error FErrorId:=ESourceChangeCacheError(AnException).Id; end else if (AnException is ECodeToolManagerError) then begin // CodeToolManager error FErrorId:=ECodeToolManagerError(AnException).Id; 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; FErrorId:=20170421202914; 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 (JumpSingleLinePos>0) then begin dec(fErrorTopLine,VisibleEditorLines*JumpSingleLinePos div 100); if fErrorTopLine<1 then fErrorTopLine:=1; end; end; end; procedure TCodeToolManager.WriteError; begin if FWriteExceptions then begin FErrorDbgMsg:='### TCodeToolManager.HandleException: ['+IntToStr(FErrorId)+'] "'+ErrorMessage+'"'; if ErrorLine>0 then FErrorDbgMsg+=' at Line='+DbgS(ErrorLine); if ErrorColumn>0 then FErrorDbgMsg+=' Col='+DbgS(ErrorColumn); if ErrorCode<>nil then FErrorDbgMsg+=' in "'+ErrorCode.Filename+'"'; Debugln(FErrorDbgMsg); {$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, BlockTopLine, BlockBottomLine: 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, BlockTopLine,BlockBottomLine,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, BlockTopLine, BlockBottomLine: 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,BlockTopLine,BlockBottomLine); 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, BlockTopLine, BlockBottomLine: 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,BlockTopLine,BlockBottomLine); 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.FindDeclarationInInterface(Code: TCodeBuffer; const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean; var BlockTopLine, BlockBottomLine: integer; begin Result := FindDeclarationInInterface(Code, Identifier, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine); 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.FindFileAtCursor(Code: TCodeBuffer; X, Y: integer; out Found: TFindFileAtCursorFlag; out FoundFilename: string; Allowed: TFindFileAtCursorFlags; StartPos: PCodeXYPosition): boolean; var CursorPos: TCodeXYPosition; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.FindFileAtCursor 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.FindFileAtCursor(CursorPos,Found,FoundFilename, Allowed,StartPos); except on e: Exception do HandleException(e); end; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.FindFileAtCursor 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; out 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.HasInterfaceRegisterProc(Code: TCodeBuffer; out HasRegisterProc: boolean): boolean; begin Result:=false; HasRegisterProc:=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.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.GetApplicationScaledStatement(Code: TCodeBuffer; var AScaled: Boolean): boolean; var StartPos, BooleanConstStartPos, EndPos: integer; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.GetApplicationScaledStatement A ',Code.Filename); {$ENDIF} if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.FindApplicationScaledStatement(StartPos, BooleanConstStartPos,EndPos); Result:=FCurCodeTool.GetApplicationScaledStatement(BooleanConstStartPos, EndPos,AScaled); except on e: Exception do Result:=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; out 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; WithTypeDefIfScoped: boolean): 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,WithTypeDefIfScoped); 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 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(20170421203205,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(20170421203210,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; out StartCode: TCodeBuffer; out StartX, StartY: integer; out EndCode: TCodeBuffer; out 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.InsertStatements( InsertPos: TInsertStatementPosDescription; const Statements: string): boolean; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.InsertStatements A ',Code.Filename,' Line=',Y,',Col=',X); {$ENDIF} if not InitCurCodeTool(InsertPos.CodeXYPos.Code) then exit; try Result:=FCurCodeTool.InsertStatements(InsertPos,Statements,SourceChangeCache); except on e: Exception do HandleException(e); end; end; function TCodeToolManager.AddProcModifier(Code: TCodeBuffer; X, Y: integer; const aModifier: string): boolean; var CursorPos: TCodeXYPosition; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename); {$ENDIF} if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; try Result:=FCurCodeTool.AddProcModifier(CursorPos,aModifier,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; out NewCode: TCodeBuffer; out 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; out NewCode: TCodeBuffer; out 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.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.AddUnitWarnDirective(Code: TCodeBuffer; WarnID, Comment: string; TurnOn: boolean): boolean; begin Result:=false; {$IFDEF CTDEBUG} DebugLn(['TCodeToolManager.AddUnitWarnDirective A ',Code.Filename,' aParam="',aParam,'" TurnOn=',TurnOn]); {$ENDIF} if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.AddUnitWarnDirective(WarnID,Comment,TurnOn,SourceChangeCache); 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; FErrorId:=20170421202903; 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,20170421202139, '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; KeepDirectives: boolean; KeepVerbosityDirectives: boolean): string; begin Result:=CleanCodeFromComments(Code.Source, GetNestedCommentsFlagForFile(Code.Filename),KeepDirectives, KeepVerbosityDirectives); 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; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: 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,BlockTopLine,BlockBottomLine,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; AddOverride: boolean): 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,AddOverride); 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; const Filter: TOnIDEDirectiveFilter): boolean; begin {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename); {$ENDIF} Result:=false; if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.GetIDEDirectives(DirectiveList,Filter); except on e: Exception do Result:=HandleException(e); end; end; function TCodeToolManager.SetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter): 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,Filter); 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.FindFPCMangledIdentifier(GDBIdentifier: string; out aComplete: boolean; out aMessage: string; const OnFindSource: TOnFindFPCMangledSource; 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 begin // user search if Assigned(OnFindSource) then OnFindSource(Self,ctnUnit,TheUnitName,aFilename) else if Assigned(OnFindFPCMangledSource) then OnFindFPCMangledSource(Self,ctnUnit,TheUnitName,aFilename) end; Result:=aFilename<>''; 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^)]); aMessage:='operator not supported: '+dbgstr(p^); exit; end else begin // example: ?? end; aMessage:='unknown identifier "'+GDBIdentifier+'"'; end; function TCodeToolManager.CompleteCode(Code: TCodeBuffer; X, Y, TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer; Interactive: Boolean): 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, BlockTopLine, BlockBottomLine,SourceChangeCache,Interactive); 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; Interactive: Boolean): 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,Interactive); 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, BlockTopLine, BlockBottomLine: 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,BlockTopLine,BlockBottomLine,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.GetPossibleInitsForVariable(Code: TCodeBuffer; X, Y: integer; out Statements: TStrings; out InsertPositions: TObjectList ): boolean; var CursorPos: TCodeXYPosition; begin {$IFDEF CTDEBUG} DebugLn(['TCodeToolManager.GetPossibleInitsForVariable 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.GetPossibleInitsForVariable(CursorPos,Statements, InsertPositions,SourceChangeCache); 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.RemoveApplicationScaledStatement(Code: TCodeBuffer ): boolean; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.RemoveApplicationScaledStatement A ',Code.Filename); {$ENDIF} if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.RemoveApplicationScaledStatement(SourceChangeCache); except on e: Exception do Result:=HandleException(e); 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; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: 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,BlockTopLine,BlockBottomLine,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.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; out FoundInUnits, MissingInUnits, NormalUnits: TStrings; IgnoreNormalUnits: boolean): 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, false, IgnoreNormalUnits); except on e: Exception do Result:=HandleException(e); end; end; function TCodeToolManager.FindDelphiPackageUnits(Code: TCodeBuffer; var FoundInUnits, MissingInUnits, NormalUnits: TStrings; IgnoreNormalUnits: boolean): 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,IgnoreNormalUnits); 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.SetApplicationScaledStatement(Code: TCodeBuffer; const NewScaled: Boolean): boolean; begin Result:=false; {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.SetApplicationScaledStatement A ',Code.Filename); {$ENDIF} if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.SetApplicationScaledStatement(NewScaled, 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.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; procedure TCodeToolManager.DoOnGatherUserIdentifiers( Sender: TIdentCompletionTool; const ContextFlags: TIdentifierListContextFlags ); begin if Assigned(FOnGatherUserIdentifiers) then FOnGatherUserIdentifiers(Sender, ContextFlags); 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)) else Result:=''; 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.DoOnRescanFPCDirectoryCache(Sender: TObject); begin if Assigned(FOnRescanFPCDirectoryCache) then FOnRescanFPCDirectoryCache(Sender); 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 CTTemplateExpander=nil then CTTemplateExpander:=TTemplateExpander.Create; CTTemplateExpander.Code:=Code; end else begin FreeAndNil(CTTemplateExpander); 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.SetJumpSingleLinePos(NewValue: integer); begin if NewValue=FJumpSingleLinePos then exit; FJumpSingleLinePos:=NewValue; if FCurCodeTool<>nil then FCurCodeTool.JumpSingleLinePos:=NewValue; end; procedure TCodeToolManager.SetJumpCodeBlockPos(NewValue: integer); begin if NewValue=FJumpCodeBlockPos then exit; FJumpCodeBlockPos:=NewValue; if FCurCodeTool<>nil then FCurCodeTool.JumpCodeBlockPos:=NewValue; end; procedure TCodeToolManager.SetSetPropertyVariableIsPrefix(aValue: Boolean); begin if FSetPropertyVariableIsPrefix = aValue then Exit; FSetPropertyVariableIsPrefix := aValue; end; procedure TCodeToolManager.SetSetPropertyVariablename(AValue: string); begin if FSetPropertyVariablename=aValue then Exit; FSetPropertyVariablename:=aValue; end; procedure TCodeToolManager.SetSetPropertyVariableUseConst(aValue: Boolean); begin if FSetPropertyVariableUseConst = aValue then Exit; FSetPropertyVariableUseConst := 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 CurSrcnil) do begin CurSrc:=Pointer(TDirectivesTool(ANode.Data).Code); if CurSrc>SearchedSrc then ANode:=ANode.Left else if CurSrcnil 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); ctdcsNamespaces: Result:=GetNamespacesForDirectory(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:=CompilerDefinesCache.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:=CompilerDefinesCache.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: TPCTargetConfigCache; Node: TAVLTreeNode; Item: PStringToStringItem; begin UnitSetCache:=CompilerDefinesCache.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:=PStringToStringItem(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; begin if FCurCodeTool<>nil then begin FCurCodeTool.ConsistencyCheck; end; DefinePool.ConsistencyCheck; DefineTree.ConsistencyCheck; SourceCache.ConsistencyCheck; GlobalValues.ConsistencyCheck; SourceChangeCache.ConsistencyCheck; FPascalTools.ConsistencyCheck; FDirectivesTools.ConsistencyCheck; end; procedure TCodeToolManager.WriteDebugReport(WriteTool, WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues, WriteMemStats: boolean); begin DebugLn('[TCodeToolManager.WriteDebugReport]'); if FCurCodeTool<>nil then begin if WriteTool then begin FCurCodeTool.WriteDebugTreeReport; if FCurCodeTool.Scanner<>nil then FCurCodeTool.Scanner.WriteDebugReport; end; 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) +PtrUInt(SizeOf(FSetPropertyVariableIsPrefix)) +PtrUInt(SizeOf(FSetPropertyVariableUseConst)) +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; //----------------------------------------------------------------------------- function FindIncFileInCfgCache(const Name: string; out ExpFilename: string): boolean; var CfgCache: TPCTargetConfigCache; UnitSet: TFPCUnitSetCache; begin // search the include file in directories defines in fpc.cfg (by -Fi option) UnitSet:=CodeToolBoss.GetUnitSetForDirectory(''); if UnitSet<>nil then begin CfgCache:=UnitSet.GetConfigCache(false); Result:=Assigned(CfgCache) and Assigned(CfgCache.Includes) and CfgCache.Includes.GetString(Name,ExpFilename); end else Result:=False; end; initialization CodeToolBoss:=TCodeToolManager.Create; OnFindOwnerOfCodeTreeNode:=@GetOwnerForCodeTreeNode; BasicCodeTools.FindIncFileInCfgCache:=@FindIncFileInCfgCache; finalization {$IFDEF CTDEBUG} DebugLn('codetoolmanager.pas - finalization'); {$ENDIF} OnFindOwnerOfCodeTreeNode:=nil; CodeToolBoss.Free; CodeToolBoss:=nil; FreeAndNil(CTTemplateExpander); {$IFDEF CTDEBUG} DebugLn('codetoolmanager.pas - finalization finished'); {$ENDIF} end.