1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 TCodeToolManager gathers all tools in one single Object
25 to easily use the code tools in a program.
26
27 }
28 unit CodeToolManager;
29
30 {$ifdef fpc}{$mode objfpc}{$endif}{$H+}
31
32 interface
33
34 {$I codetools.inc}
35
36 {.$DEFINE CTDEBUG}
37 { $DEFINE DoNotHandleFindDeclException}
38
39 uses
40 {$IFDEF MEM_CHECK}
41 MemCheck,
42 {$ENDIF}
43 Classes, SysUtils, contnrs, TypInfo, types, Laz_AVL_Tree,
44 // LazUtils
45 LazFileUtils, LazFileCache, LazMethodList, LazDbgLog, AvgLvlTree,
46 LazStringUtils,
47 // Codetools
48 FileProcs, BasicCodeTools, CodeToolsStrConsts,
49 EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
50 ExprEval, LinkScanner, KeywordFuncLists, FindOverloads, CodeBeautifier,
51 FindDeclarationCache, DirectoryCacher,
52 PPUCodeTools, LFMTrees, DirectivesTree, CodeCompletionTemplater,
53 PascalParserTool, CodeToolsConfig, CustomCodeTool, FindDeclarationTool,
54 IdentCompletionTool, StdCodeTools, ResourceCodeTool, CodeToolsStructs,
55 CTUnitGraph, ExtractProcTool;
56
57 type
58 TCodeToolManager = class;
59 TCodeTool = TEventsCodeTool;
60 TDirectivesTool = TCompilerDirectivesTree;
61
62 TOnBeforeApplyCTChanges = procedure(Manager: TCodeToolManager;
63 var Abort: boolean) of object;
64 TOnAfterApplyCTChanges = procedure(Manager: TCodeToolManager) of object;
65 TOnGatherExternalChanges = procedure(Manager: TCodeToolManager;
66 var Abort: boolean) of object;
onstnull67 TOnSearchUsedUnit = function(const SrcFilename: string;
68 const TheUnitName, TheUnitInFilename: string
69 ): TCodeBuffer of object;
booleannull70 TOnCodeToolCheckAbort = function: boolean of object;
71 TOnFindDefineProperty = procedure(Sender: TObject;
72 const PersistentClassName, AncestorClassName, Identifier: string;
73 var IsDefined: boolean) of object;
74 TOnFindFPCMangledSource = procedure(Sender: TObject; SrcType: TCodeTreeNodeDesc;
75 const SrcName: string; out SrcFilename: string) of object;
76
77 { ECodeToolManagerError }
78
79 ECodeToolManagerError = class(Exception)
80 public
81 Id: int64;
82 constructor Create(TheID: int64; const Msg: string);
83 constructor CreateFmt(TheID: int64; const Msg: string; const Args: array of const);
84 end;
85
86 TCodeToolManagerHandler = (
87 ctmOnToolTreeChanging
88 );
89 TCodeToolManagerHandlers = set of TCodeToolManagerHandler;
90 TOnToolTreeChanging = TCodeTreeChangeEvent;
91 TOnScannerInit = procedure(Self: TCodeToolManager; Scanner: TLinkScanner) of object;
92
93 { TCodeToolManager }
94
95 TCodeToolManager = class(TPersistent)
96 private
97 FAbortable: boolean;
98 FAddInheritedCodeToOverrideMethod: boolean;
99 FAdjustTopLineDueToComment: boolean;
100 FCatchExceptions: boolean;
101 FChangeStep: integer;
102 FCheckFilesOnDisk: boolean;
103 FCodeCompletionTemplateFileName: String;
104 FCodeNodeTreeChangeStep: integer;
105 FCompleteProperties: boolean;
106 FCurCodeTool: TCodeTool; // current codetool
107 FCurDirectivesTool: TDirectivesTool;
108 FCursorBeyondEOL: boolean;
109 FDirectivesTools: TAVLTree; // tree of TDirectivesTool sorted for Code (TCodeBuffer)
110 FErrorCode: TCodeBuffer;
111 FErrorColumn: integer;
112 FErrorId: int64;
113 FErrorLine: integer;
114 FErrorMsg: string;
115 FErrorTopLine: integer;
116 FCodeTreeNodesDeletedStep: integer;
117 FIndentSize: integer;
118 FJumpSingleLinePos: integer;
119 FJumpCodeBlockPos: integer;
120 FIdentifierListUpdating: boolean;
121 FOnAfterApplyChanges: TOnAfterApplyCTChanges;
122 FOnBeforeApplyChanges: TOnBeforeApplyCTChanges;
123 FOnCheckAbort: TOnCodeToolCheckAbort;
124 FOnFindFPCMangledSource: TOnFindFPCMangledSource;
125 FOnGatherExternalChanges: TOnGatherExternalChanges;
126 FOnFindDefinePropertyForContext: TOnFindDefinePropertyForContext;
127 FOnFindDefineProperty: TOnFindDefineProperty;
128 FOnGatherUserIdentifiers: TOnGatherUserIdentifiers;
129 FOnGetIndenterExamples: TOnGetFABExamples;
130 FOnGetMethodName: TOnGetMethodname;
131 FOnRescanFPCDirectoryCache: TNotifyEvent;
132 FOnScannerInit: TOnScannerInit;
133 FOnSearchUsedUnit: TOnSearchUsedUnit;
134 FResourceTool: TResourceCodeTool;
135 FSetPropertyVariablename: string;
136 FSetPropertyVariableIsPrefix: Boolean;
137 FSetPropertyVariableUseConst: Boolean;
138 FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk'
139 FPascalTools: TAVLTree; // tree of TCustomCodeTool sorted TCustomCodeTool(Data).Scanner.MainCode
140 FTabWidth: integer;
141 FUseTabs: boolean;
142 FVisibleEditorLines: integer;
143 FWriteExceptions: boolean;
144 FWriteLockCount: integer;// Set/Unset counter
145 FWriteLockStep: integer; // current write lock ID
146 FHandlers: array[TCodeToolManagerHandler] of TMethodList;
147 FErrorDbgMsg: string;
148 procedure DoOnGatherUserIdentifiers(Sender: TIdentCompletionTool;
149 const ContextFlags: TIdentifierListContextFlags);
150 procedure DoOnRescanFPCDirectoryCache(Sender: TObject);
GetBeautifiernull151 function GetBeautifier: TBeautifyCodeOptions; inline;
DoOnScannerGetInitValuesnull152 function DoOnScannerGetInitValues(Scanner: TLinkScanner; Code: Pointer;
153 out AChangeStep: integer): TExpressionEvaluator;
154 procedure DoOnDefineTreeReadValue(Sender: TObject; const VariableName: string;
155 var Value: string; var Handled: boolean);
156 procedure DoOnGlobalValuesChanged;
DoOnFindUsedUnitnull157 function DoOnFindUsedUnit(SrcTool: TFindDeclarationTool; const TheUnitName,
158 TheUnitInFilename: string): TCodeBuffer;
DoOnGetSrcPathForCompiledUnitnull159 function DoOnGetSrcPathForCompiledUnit(Sender: TObject;
160 const AFilename: string): string;
DoOnInternalGetMethodNamenull161 function DoOnInternalGetMethodName(const AMethod: TMethod;
162 CheckOwner: TObject): string;
FindCodeOfMainUnitHintnull163 function FindCodeOfMainUnitHint(Code: TCodeBuffer): TCodeBuffer;
164 procedure CreateScanner(Code: TCodeBuffer);
165 procedure SetAbortable(const AValue: boolean);
166 procedure SetAddInheritedCodeToOverrideMethod(const AValue: boolean);
167 procedure SetCheckFilesOnDisk(NewValue: boolean);
168 procedure SetCodeCompletionTemplateFileName(AValue: String);
169 procedure SetCompleteProperties(const AValue: boolean);
170 procedure SetIndentSize(NewValue: integer);
171 procedure SetSetPropertyVariableIsPrefix(aValue: Boolean);
172 procedure SetSetPropertyVariablename(AValue: string);
173 procedure SetSetPropertyVariableUseConst(aValue: Boolean);
174 procedure SetTabWidth(const AValue: integer);
175 procedure SetUseTabs(AValue: boolean);
176 procedure SetVisibleEditorLines(NewValue: integer);
177 procedure SetJumpSingleLinePos(NewValue: integer);
178 procedure SetJumpCodeBlockPos(NewValue: integer);
179 procedure SetCursorBeyondEOL(NewValue: boolean);
180 procedure BeforeApplyingChanges(var Abort: boolean);
181 procedure AfterApplyingChanges;
182 procedure AdjustErrorTopLine;
183 procedure WriteError;
184 procedure DoOnFABGetNestedComments(Sender: TObject; Code: TCodeBuffer; out
185 NestedComments: boolean);
186 procedure DoOnFABGetExamples(Sender: TObject; Code: TCodeBuffer;
187 Step: integer; var CodeBuffers: TFPList; var ExpandedFilenames: TStrings);
188 procedure DoOnLoadFileForTool(Sender: TObject; const ExpandedFilename: string;
189 out Code: TCodeBuffer; var {%H-}Abort: boolean);
DoOnGetCodeToolForBuffernull190 function DoOnGetCodeToolForBuffer(Sender: TObject;
191 Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
DoOnGetDirectoryCachenull192 function DoOnGetDirectoryCache(const ADirectory: string): TCTDirectoryCache;
193 procedure DoOnToolSetWriteLock(Lock: boolean);
194 procedure DoOnToolGetChangeSteps(out SourcesChangeStep, FilesChangeStep: int64;
195 out InitValuesChangeStep: integer);
DoOnParserProgressnull196 function DoOnParserProgress({%H-}Tool: TCustomCodeTool): boolean;
197 procedure DoOnToolTreeChange(Tool: TCustomCodeTool; NodesDeleting: boolean);
DoOnScannerProgressnull198 function DoOnScannerProgress(Sender: TLinkScanner): boolean;
GetResourceToolnull199 function GetResourceTool: TResourceCodeTool;
GetOwnerForCodeTreeNodenull200 function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject;
DirectoryCachePoolGetStringnull201 function DirectoryCachePoolGetString(const ADirectory: string;
202 const AStringType: TCTDirCacheString): string;
DirectoryCachePoolFindVirtualFilenull203 function DirectoryCachePoolFindVirtualFile(const Filename: string): string;
DirectoryCachePoolGetUnitFromSetnull204 function DirectoryCachePoolGetUnitFromSet(const UnitSet, AnUnitName: string;
205 SrcSearchRequiresPPU: boolean): string;
DirectoryCachePoolGetCompiledUnitFromSetnull206 function DirectoryCachePoolGetCompiledUnitFromSet(
207 const UnitSet, AnUnitName: string): string;
208 procedure DirectoryCachePoolIterateFPCUnitsFromSet(const UnitSet: string;
209 const Iterate: TCTOnIterateFile);
210 procedure AddHandler(HandlerType: TCodeToolManagerHandler; const Handler: TMethod);
211 procedure RemoveHandler(HandlerType: TCodeToolManagerHandler; const Handler: TMethod);
212 public
213 DefinePool: TDefinePool; // definition templates (rules)
214 DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
215 SourceCache: TCodeCache; // cache for source (units, include files, ...)
216 SourceChangeCache: TSourceChangeCache; // cache for write accesses
217 PPUCache: TPPUTools;
218 GlobalValues: TExpressionEvaluator;
219 DirectoryCachePool: TCTDirectoryCachePool;
220 CompilerDefinesCache: TCompilerDefinesCache;
221 IdentifierList: TIdentifierList;
222 IdentifierHistory: TIdentifierHistoryList;
223 Positions: TCodeXYPositions;
224 Indenter: TFullyAutomaticBeautifier;
225 property FPCDefinesCache: TCompilerDefinesCache read CompilerDefinesCache; deprecated 'use CompilerDefinesCache'; // 1.9
226 property Beautifier: TBeautifyCodeOptions read GetBeautifier;
227
228 constructor Create;
229 destructor Destroy; override;
230
231 procedure Init(Config: TCodeToolsOptions);
232 procedure SimpleInit(const ConfigFilename: string);
233
234 procedure ActivateWriteLock;
235 procedure DeactivateWriteLock;
236 property ChangeStep: integer read FChangeStep; // code changes
237 procedure IncreaseChangeStep;
238 property CodeNodeTreeChangeStep: integer read FCodeNodeTreeChangeStep;// nodes altered, added, deleted
239 property CodeTreeNodesDeletedStep: integer read FCodeTreeNodesDeletedStep;// nodes deleted
240 procedure GetCodeTreeNodesDeletedStep(out NodesDeletedStep: integer);// use this for events
241 procedure AddHandlerToolTreeChanging(const OnToolTreeChanging: TOnToolTreeChanging);
242 procedure RemoveHandlerToolTreeChanging(const OnToolTreeChanging: TOnToolTreeChanging);
243
244 // file handling
245 property SourceExtensions: string
246 read FSourceExtensions write FSourceExtensions;
FindFilenull247 function FindFile(const ExpandedFilename: string): TCodeBuffer;
LoadFilenull248 function LoadFile(const ExpandedFilename: string;
249 UpdateFromDisk, Revert: boolean): TCodeBuffer;
CreateFilenull250 function CreateFile(const AFilename: string): TCodeBuffer;
CreateTempFilenull251 function CreateTempFile(const AFilename: string): TCodeBuffer;
252 procedure ReleaseTempFile(Buffer: TCodeBuffer);
SaveBufferAsnull253 function SaveBufferAs(OldBuffer: TCodeBuffer; const ExpandedFilename: string;
254 out NewBuffer: TCodeBuffer): boolean;
FilenameHasSourceExtnull255 function FilenameHasSourceExt(const AFilename: string): boolean;
GetMainCodenull256 function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
GetIncludeCodeChainnull257 function GetIncludeCodeChain(Code: TCodeBuffer;
258 RemoveFirstCodesWithoutTool: boolean;
259 out ListOfCodeBuffer: TFPList): boolean;
260 property OnSearchUsedUnit: TOnSearchUsedUnit
261 read FOnSearchUsedUnit write FOnSearchUsedUnit;
262 property OnRescanFPCDirectoryCache: TNotifyEvent read FOnRescanFPCDirectoryCache write FOnRescanFPCDirectoryCache;
263
264 // initializing single scanner
265 property OnScannerInit: TOnScannerInit read FOnScannerInit write FOnScannerInit;
266
267 // initializing single codetool
GetCodeToolForSourcenull268 function GetCodeToolForSource(Code: TCodeBuffer;
269 GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
FindCodeToolForSourcenull270 function FindCodeToolForSource(Code: TCodeBuffer): TCustomCodeTool;
271 property CurCodeTool: TCodeTool read FCurCodeTool;
272 procedure ClearCurCodeTool;
InitCurCodeToolnull273 function InitCurCodeTool(Code: TCodeBuffer): boolean;
InitResourceToolnull274 function InitResourceTool: boolean;
275 procedure ClearPositions;
276
277 // initializing single compilerdirectivestree
GetDirectivesToolForSourcenull278 function GetDirectivesToolForSource(Code: TCodeBuffer;
279 ExceptionOnError: boolean): TCompilerDirectivesTree;
280 property CurDirectivesTool: TDirectivesTool read FCurDirectivesTool;
281 procedure ClearCurDirectivesTool;
InitCurDirectivesToolnull282 function InitCurDirectivesTool(Code: TCodeBuffer): boolean;
FindDirectivesToolForSourcenull283 function FindDirectivesToolForSource(Code: TCodeBuffer): TDirectivesTool;
284
285 // exception handling
286 procedure ClearError;
HandleExceptionnull287 function HandleException(AnException: Exception): boolean;
288 procedure SetError(Id: int64; Code: TCodeBuffer; Line, Column: integer;
289 const TheMessage: string);
290 property CatchExceptions: boolean
291 read FCatchExceptions write FCatchExceptions;
292 property WriteExceptions: boolean
293 read FWriteExceptions write FWriteExceptions;
294 property ErrorCode: TCodeBuffer read fErrorCode;
295 property ErrorColumn: integer read fErrorColumn;
296 property ErrorLine: integer read fErrorLine;
297 property ErrorMessage: string read fErrorMsg;
298 property ErrorId: int64 read FErrorId;
299 property ErrorTopLine: integer read fErrorTopLine;
300 property ErrorDbgMsg: string read FErrorDbgMsg;
301 property Abortable: boolean read FAbortable write SetAbortable;
302 property OnCheckAbort: TOnCodeToolCheckAbort
303 read FOnCheckAbort write FOnCheckAbort;
304
305 // tool settings
306 property AdjustTopLineDueToComment: boolean read FAdjustTopLineDueToComment
307 write FAdjustTopLineDueToComment;
308 property CheckFilesOnDisk: boolean read FCheckFilesOnDisk
309 write SetCheckFilesOnDisk;
310 property CursorBeyondEOL: boolean read FCursorBeyondEOL
311 write SetCursorBeyondEOL;
312 property IndentSize: integer read FIndentSize write SetIndentSize;
313 property JumpSingleLinePos: integer read FJumpSingleLinePos write SetJumpSingleLinePos;
314 property JumpCodeBlockPos: integer read FJumpCodeBlockPos write SetJumpCodeBlockPos;
315 property SetPropertyVariablename: string
316 read FSetPropertyVariablename write SetSetPropertyVariablename;
317 property SetPropertyVariableIsPrefix: Boolean
318 read FSetPropertyVariableIsPrefix write SetSetPropertyVariableIsPrefix;
319 property SetPropertyVariableUseConst: Boolean
320 read FSetPropertyVariableUseConst write SetSetPropertyVariableUseConst;
321 property VisibleEditorLines: integer
322 read FVisibleEditorLines write SetVisibleEditorLines;
323 property TabWidth: integer read FTabWidth write SetTabWidth;
324 property UseTabs: boolean read FUseTabs write SetUseTabs;
325 property CompleteProperties: boolean
326 read FCompleteProperties write SetCompleteProperties;
327 property AddInheritedCodeToOverrideMethod: boolean
328 read FAddInheritedCodeToOverrideMethod
329 write SetAddInheritedCodeToOverrideMethod;
330
331 // code completion templates
332 property CodeCompletionTemplateFileName : String read FCodeCompletionTemplateFileName
333 write SetCodeCompletionTemplateFileName;
334
335 // source changing
336 procedure BeginUpdate;
EndUpdatenull337 function EndUpdate: boolean;
GatherExternalChangesnull338 function GatherExternalChanges: boolean;
339 property OnGatherExternalChanges: TOnGatherExternalChanges
340 read FOnGatherExternalChanges write FOnGatherExternalChanges;
ApplyChangesnull341 function ApplyChanges: boolean;
342 property OnBeforeApplyChanges: TOnBeforeApplyCTChanges
343 read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
344 property OnAfterApplyChanges: TOnAfterApplyCTChanges
345 read FOnAfterApplyChanges write FOnAfterApplyChanges;
346
347 // defines
SetGlobalValuenull348 function SetGlobalValue(const VariableName, VariableValue: string): boolean;
GetUnitPathForDirectorynull349 function GetUnitPathForDirectory(const Directory: string;
350 UseCache: boolean = true): string;
GetIncludePathForDirectorynull351 function GetIncludePathForDirectory(const Directory: string;
352 UseCache: boolean = true): string;
GetSrcPathForDirectorynull353 function GetSrcPathForDirectory(const Directory: string;
354 UseCache: boolean = true): string;
GetCompleteSrcPathForDirectorynull355 function GetCompleteSrcPathForDirectory(const Directory: string;
356 UseCache: boolean = true): string;
GetPPUSrcPathForDirectorynull357 function GetPPUSrcPathForDirectory(const Directory: string): string;
GetDCUSrcPathForDirectorynull358 function GetDCUSrcPathForDirectory(const Directory: string): string;
GetCompiledSrcPathForDirectorynull359 function GetCompiledSrcPathForDirectory(const Directory: string;
360 {%H-}UseCache: boolean = true): string;
GetNestedCommentsFlagForFilenull361 function GetNestedCommentsFlagForFile(const Filename: string): boolean;
GetPascalCompilerForDirectorynull362 function GetPascalCompilerForDirectory(const Directory: string): TPascalCompiler;
GetCompilerModeForDirectorynull363 function GetCompilerModeForDirectory(const Directory: string): TCompilerMode;
GetCompiledSrcExtForDirectorynull364 function GetCompiledSrcExtForDirectory(const {%H-}Directory: string): string;
FindUnitInUnitLinksnull365 function FindUnitInUnitLinks(const Directory, AUnitName: string): string;
GetUnitLinksForDirectorynull366 function GetUnitLinksForDirectory(const Directory: string;
367 UseCache: boolean = false): string;
FindUnitInUnitSetnull368 function FindUnitInUnitSet(const Directory, AUnitName: string): string;
GetUnitSetIDForDirectorynull369 function GetUnitSetIDForDirectory(const Directory: string;
370 UseCache: boolean = true): string;
GetUnitSetForDirectorynull371 function GetUnitSetForDirectory(const Directory: string): TFPCUnitSetCache;
GetFPCUnitPathForDirectorynull372 function GetFPCUnitPathForDirectory(const Directory: string;
373 UseCache: boolean = true): string;// value of macro #FPCUnitPath
374 procedure GetFPCVersionForDirectory(const Directory: string;
375 out FPCVersion, FPCRelease, FPCPatch: integer);
GetPCVersionForDirectorynull376 function GetPCVersionForDirectory(const Directory: string): integer; deprecated 'use below'; // 2.0.1
GetPCVersionForDirectorynull377 function GetPCVersionForDirectory(const Directory: string; out Kind: TPascalCompiler): integer;
GetNamespacesForDirectorynull378 function GetNamespacesForDirectory(const Directory: string;
379 UseCache: boolean = true): string;// value of macro #Namespaces
380
381 // miscellaneous
382 property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
383 write FOnGetMethodName;
384 property OnGetIndenterExamples: TOnGetFABExamples
385 read FOnGetIndenterExamples write FOnGetIndenterExamples;
386 property OnGatherUserIdentifiers: TOnGatherUserIdentifiers
387 read FOnGatherUserIdentifiers write FOnGatherUserIdentifiers;
388
389 // data function
procedurenull390 procedure FreeListOfPCodeXYPosition(var List: TFPList);
391 procedure FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
CreateTreeOfPCodeXYPositionnull392 function CreateTreeOfPCodeXYPosition: TAVLTree;
393 procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
394 DestTree: TAVLTree; ClearList, CreateCopies: boolean);
395
396 // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
397
398 // code exploring
Explorenull399 function Explore(Code: TCodeBuffer; out ACodeTool: TCodeTool;
400 WithStatements: boolean; OnlyInterface: boolean = false): boolean;
CheckSyntaxnull401 function CheckSyntax(Code: TCodeBuffer; out NewCode: TCodeBuffer;
402 out NewX, NewY, NewTopLine: integer; out ErrorMsg: string): boolean;
ExploreDirectivesnull403 function ExploreDirectives(Code: TCodeBuffer;
404 out ADirectivesTool: TDirectivesTool): boolean;
ExploreUnitDirectivesnull405 function ExploreUnitDirectives(Code: TCodeBuffer;
406 out aScanner: TLinkScanner): boolean;
407
408 // compiler directives
GuessMisplacedIfdefEndifnull409 function GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,Y: integer;
410 out NewCode: TCodeBuffer;
411 out NewX, NewY, NewTopLine: integer): boolean;
412 // find include directive of include file at position X,Y
FindEnclosingIncludeDirectivenull413 function FindEnclosingIncludeDirective(Code: TCodeBuffer; X,Y: integer;
414 out NewCode: TCodeBuffer;
415 out NewX, NewY, NewTopLine: integer): boolean;
FindResourceDirectivenull416 function FindResourceDirective(Code: TCodeBuffer; StartX, StartY: integer;
417 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
418 const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
AddResourceDirectivenull419 function AddResourceDirective(Code: TCodeBuffer; const Filename: string;
420 SearchInCleanSrc: boolean = true; const NewSrc: string = ''): boolean;
FindIncludeDirectivenull421 function FindIncludeDirective(Code: TCodeBuffer; StartX, StartY: integer;
422 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
423 const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
AddIncludeDirectiveForInitnull424 function AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string;
425 const NewSrc: string = ''): boolean;
AddUnitWarnDirectivenull426 function AddUnitWarnDirective(Code: TCodeBuffer; WarnID, Comment: string;
427 TurnOn: boolean): boolean;
RemoveDirectivenull428 function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer;
429 RemoveEmptyIFs: boolean): boolean;
FixIncludeFilenamesnull430 function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
431 out MissingIncludeFilesCodeXYPos: TFPList): boolean;
FixMissingH2PasDirectivesnull432 function FixMissingH2PasDirectives(Code: TCodeBuffer;
433 var Changed: boolean): boolean;
ReduceCompilerDirectivesnull434 function ReduceCompilerDirectives(Code: TCodeBuffer;
435 Undefines, Defines: TStrings; var Changed: boolean): boolean;
436
437 // keywords and comments
IsKeywordnull438 function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean;
ExtractCodeWithoutCommentsnull439 function ExtractCodeWithoutComments(Code: TCodeBuffer;
440 KeepDirectives: boolean = false;
441 KeepVerbosityDirectives: boolean = false): string;
GetPasDocCommentsnull442 function GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
443 out ListOfPCodeXYPosition: TFPList): boolean;
444
445 // blocks (e.g. begin..end, case..end, try..finally..end, repeat..until)
FindBlockCounterPartnull446 function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
447 out NewCode: TCodeBuffer;
448 out NewX, NewY, NewTopLine: integer): boolean;
FindBlockStartnull449 function FindBlockStart(Code: TCodeBuffer; X,Y: integer;
450 out NewCode: TCodeBuffer;
451 out NewX, NewY, NewTopLine: integer;
452 SkipStart: boolean = false): boolean;
GuessUnclosedBlocknull453 function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer;
454 out NewCode: TCodeBuffer;
455 out NewX, NewY, NewTopLine: integer): boolean;
CompleteBlocknull456 function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
457 OnlyIfCursorBlockIndented: boolean): boolean;
CompleteBlocknull458 function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
459 OnlyIfCursorBlockIndented: boolean;
460 out NewCode: TCodeBuffer;
461 out NewX, NewY, NewTopLine: integer): boolean;
462
463 // method jumping
JumpToMethodnull464 function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
465 out NewCode: TCodeBuffer;
466 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
467 out RevertableJump: boolean): boolean;
FindProcDeclarationnull468 function FindProcDeclaration(Code: TCodeBuffer; CleanDef: string;
469 out Tool: TCodeTool; out Node: TCodeTreeNode;
470 Attr: TProcHeadAttributes = [phpWithoutSemicolon]): boolean;
471
472 // find declaration
FindDeclarationnull473 function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
474 out NewCode: TCodeBuffer;
475 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
476 Flags: TFindSmartFlags = DefaultFindSmartFlags): boolean;
FindDeclarationOfIdentifiernull477 function FindDeclarationOfIdentifier(Code: TCodeBuffer; X,Y: integer;
478 Identifier: PChar;
479 out NewCode: TCodeBuffer;
480 out NewX, NewY, NewTopLine: integer): boolean;
FindSmartHintnull481 function FindSmartHint(Code: TCodeBuffer; X,Y: integer;
482 Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
FindDeclarationInInterfacenull483 function FindDeclarationInInterface(Code: TCodeBuffer;
484 const Identifier: string; out NewCode: TCodeBuffer;
485 out NewX, NewY, NewTopLine: integer): boolean;
FindDeclarationInInterfacenull486 function FindDeclarationInInterface(Code: TCodeBuffer;
487 const Identifier: string; out NewCode: TCodeBuffer;
488 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
FindDeclarationWithMainUsesSectionnull489 function FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
490 const Identifier: string;
491 out NewCode: TCodeBuffer;
492 out NewX, NewY, NewTopLine: integer): Boolean;
FindDeclarationAndOverloadnull493 function FindDeclarationAndOverload(Code: TCodeBuffer; X,Y: integer;
494 out ListOfPCodeXYPosition: TFPList;
495 Flags: TFindDeclarationListFlags): boolean;
FindMainDeclarationnull496 function FindMainDeclaration(Code: TCodeBuffer; X,Y: integer;
497 out NewCode: TCodeBuffer;
498 out NewX, NewY, NewTopLine: integer): boolean;
FindDeclarationOfPropertyPathnull499 function FindDeclarationOfPropertyPath(Code: TCodeBuffer;
500 const PropertyPath: string; out NewCode: TCodeBuffer;
501 out NewX, NewY, NewTopLine: integer): Boolean;
FindFileAtCursornull502 function FindFileAtCursor(Code: TCodeBuffer; X,Y: integer;
503 out Found: TFindFileAtCursorFlag; out FoundFilename: string;
504 Allowed: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed;
505 StartPos: PCodeXYPosition = nil): boolean;
506
507 // get code context (aka parameter hints)
FindCodeContextnull508 function FindCodeContext(Code: TCodeBuffer; X,Y: integer;
509 out CodeContexts: TCodeContextInfo): boolean;
ExtractProcedureHeadernull510 function ExtractProcedureHeader(Code: TCodeBuffer; X,Y: integer;
511 Attributes: TProcHeadAttributes; out ProcHead: string): boolean;
HasInterfaceRegisterProcnull512 function HasInterfaceRegisterProc(Code: TCodeBuffer;
513 out HasRegisterProc: boolean): boolean;
514
515 // gather identifiers (i.e. all visible)
GatherUnitNamesnull516 function GatherUnitNames(Code: TCodeBuffer): Boolean;
GatherIdentifiersnull517 function GatherIdentifiers(Code: TCodeBuffer; X,Y: integer): boolean;
GetIdentifierAtnull518 function GetIdentifierAt(Code: TCodeBuffer; X,Y: integer;
519 out Identifier: string): boolean;
IdentItemCheckHasChildsnull520 function IdentItemCheckHasChilds(IdentItem: TIdentifierListItem): boolean;
FindAbstractMethodsnull521 function FindAbstractMethods(Code: TCodeBuffer; X,Y: integer;
522 out ListOfPCodeXYPosition: TFPList;
523 SkipAbstractsInStartClass: boolean = false): boolean;
GetValuesOfCaseVariablenull524 function GetValuesOfCaseVariable(Code: TCodeBuffer; X,Y: integer;
525 List: TStrings; WithTypeDefIfScoped: boolean = true): boolean;
GatherOverloadsnull526 function GatherOverloads(Code: TCodeBuffer; X,Y: integer;
527 out Graph: TDeclarationOverloadsGraph): boolean;
528
529 // find references, rename identifier, remove identifier
FindReferencesnull530 function FindReferences(IdentifierCode: TCodeBuffer;
531 X, Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
532 var ListOfPCodeXYPosition: TFPList;
533 var Cache: TFindIdentifierReferenceCache // you must free Cache
534 ): boolean;
FindUnitReferencesnull535 function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
536 SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
FindUsedUnitReferencesnull537 function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
538 SkipComments: boolean; out UsedUnitFilename: string;
539 var ListOfPCodeXYPosition: TFPList): boolean;
RenameIdentifiernull540 function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
541 const OldIdentifier, NewIdentifier: string;
542 DeclarationCode: TCodeBuffer = nil; DeclarationCaretXY: PPoint = nil): boolean;
ReplaceWordnull543 function ReplaceWord(Code: TCodeBuffer; const OldWord, NewWord: string;
544 ChangeStrings: boolean): boolean;
RemoveIdentifierDefinitionnull545 function RemoveIdentifierDefinition(Code: TCodeBuffer; X, Y: integer
546 ): boolean; // e.g. remove the variable definition at X,Y
RemoveWithBlocknull547 function RemoveWithBlock(Code: TCodeBuffer; X, Y: integer): boolean;
AddWithBlocknull548 function AddWithBlock(Code: TCodeBuffer; X1, Y1, X2, Y2: integer;
549 const WithExpr: string; // if empty: collect Candidates
550 Candidates: TStrings): boolean;
ChangeParamListnull551 function ChangeParamList(Code: TCodeBuffer;
552 Changes: TObjectList; // list of TChangeParamListItem
553 var ProcPos: TCodeXYPosition; // if it is in this unit the proc declaration is changed and this position is cleared
554 TreeOfPCodeXYPosition: TAVLTree // positions in this unit are processed and removed from the tree
555 ): boolean;
556
557 // resourcestring sections
GatherResourceStringSectionsnull558 function GatherResourceStringSections(
559 Code: TCodeBuffer; X,Y: integer;
560 CodePositions: TCodeXYPositions): boolean;
IdentifierExistsInResourceStringSectionnull561 function IdentifierExistsInResourceStringSection(Code: TCodeBuffer;
562 X,Y: integer; const ResStrIdentifier: string): boolean;
CreateIdentifierFromStringConstnull563 function CreateIdentifierFromStringConst(
564 StartCode: TCodeBuffer; StartX, StartY: integer;
565 EndCode: TCodeBuffer; EndX, EndY: integer;
566 out Identifier: string; MaxLen: integer): boolean;
StringConstToFormatStringnull567 function StringConstToFormatString(
568 StartCode: TCodeBuffer; StartX, StartY: integer;
569 EndCode: TCodeBuffer; EndX, EndY: integer;
570 out FormatStringConstant, FormatParameters: string;
571 out StartInStringConst, EndInStringConst: boolean): boolean;
GatherResourceStringsWithValuenull572 function GatherResourceStringsWithValue(SectionCode: TCodeBuffer;
573 SectionX, SectionY: integer; const StringValue: string;
574 CodePositions: TCodeXYPositions): boolean;
AddResourcestringnull575 function AddResourcestring(CursorCode: TCodeBuffer; X,Y: integer;
576 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
577 const NewIdentifier, NewValue: string;
578 InsertPolicy: TResourcestringInsertPolicy): boolean;
579
580 // expressions
GetStringConstBoundsnull581 function GetStringConstBounds(Code: TCodeBuffer; X,Y: integer;
582 out StartCode: TCodeBuffer; out StartX, StartY: integer;
583 out EndCode: TCodeBuffer; out EndX, EndY: integer;
584 ResolveComments: boolean): boolean;
585 procedure ImproveStringConstantStart(const ACode: string; var StartPos: integer);
586 procedure ImproveStringConstantEnd(const ACode: string; var EndPos: integer);
ExtractOperandnull587 function ExtractOperand(Code: TCodeBuffer; X,Y: integer;
588 out Operand: string; WithPostTokens, WithAsOperator,
589 WithoutTrailingPoints: boolean): boolean;
GetExpandedOperandnull590 function GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
591 out Operand: string; ResolveProperty: Boolean): Boolean;
592
593 // code completion = auto class completion, auto forward proc completion,
594 // (local) var assignment completion, event assignment completion
CompleteCodenull595 function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
596 out NewCode: TCodeBuffer;
597 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;Interactive: Boolean): boolean;
CreateVariableForIdentifiernull598 function CreateVariableForIdentifier(Code: TCodeBuffer; X,Y,TopLine: integer;
599 out NewCode: TCodeBuffer;
600 out NewX, NewY, NewTopLine: integer; Interactive: Boolean): boolean;
AddMethodsnull601 function AddMethods(Code: TCodeBuffer; X,Y, TopLine: integer;
602 ListOfPCodeXYPosition: TFPList;
603 const VirtualToOverride: boolean;
604 out NewCode: TCodeBuffer;
605 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
GuessTypeOfIdentifiernull606 function GuessTypeOfIdentifier(Code: TCodeBuffer; X,Y: integer;
607 out ItsAKeyword, IsSubIdentifier: boolean;
608 out ExistingDefinition: TFindContext; // next existing definition
609 out ListOfPFindContext: TFPList; // possible classes
610 out NewExprType: TExpressionType; out NewType: string): boolean; // false = not at an identifier or syntax error
GetPossibleInitsForVariablenull611 function GetPossibleInitsForVariable(Code: TCodeBuffer; X,Y: integer;
612 out Statements: TStrings; out InsertPositions: TObjectList // e.g. [use unit1, unit2;]i:=0;
613 ): boolean;
DeclareVariableNearBynull614 function DeclareVariableNearBy(Code: TCodeBuffer; X,Y: integer;
615 const VariableName, NewType, NewUnitName: string;
616 Visibility: TCodeTreeNodeDesc;
617 LvlPosCode: TCodeBuffer = nil; LvlPosX: integer = 0; LvlPosY: integer = 0
618 ): boolean;
DeclareVariableAtnull619 function DeclareVariableAt(Code: TCodeBuffer; X,Y: integer;
620 const VariableName, NewType, NewUnitName: string): boolean;
621
622 // simplifications
FindRedefinitionsnull623 function FindRedefinitions(Code: TCodeBuffer;
624 out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
RemoveRedefinitionsnull625 function RemoveRedefinitions(Code: TCodeBuffer;
626 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
RemoveAllRedefinitionsnull627 function RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
FindAliasDefinitionsnull628 function FindAliasDefinitions(Code: TCodeBuffer;
629 out TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
FixAliasDefinitionsnull630 function FixAliasDefinitions(Code: TCodeBuffer;
631 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
FixAllAliasDefinitionsnull632 function FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
FindConstFunctionsnull633 function FindConstFunctions(Code: TCodeBuffer;
634 out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceConstFunctionsnull635 function ReplaceConstFunctions(Code: TCodeBuffer;
636 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceAllConstFunctionsnull637 function ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
FindTypeCastFunctionsnull638 function FindTypeCastFunctions(Code: TCodeBuffer;
639 out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceTypeCastFunctionsnull640 function ReplaceTypeCastFunctions(Code: TCodeBuffer;
641 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceAllTypeCastFunctionsnull642 function ReplaceAllTypeCastFunctions(Code: TCodeBuffer): boolean;
FixForwardDefinitionsnull643 function FixForwardDefinitions(Code: TCodeBuffer): boolean;
FindEmptyMethodsnull644 function FindEmptyMethods(Code: TCodeBuffer;
645 const AClassName: string; // can be ''
646 X,Y: integer;
647 const Sections: TPascalClassSections;
648 ListOfPCodeXYPosition: TFPList;
649 out AllEmpty: boolean): boolean;
RemoveEmptyMethodsnull650 function RemoveEmptyMethods(Code: TCodeBuffer;
651 const AClassName: string; X,Y: integer;
652 const Sections: TPascalClassSections;
653 out AllRemoved: boolean;
654 const Attr: TProcHeadAttributes;
655 out RemovedProcHeads: TStrings): boolean;
656
657 // custom class completion
InitClassCompletionnull658 function InitClassCompletion(Code: TCodeBuffer;
659 const AClassName: string; out CodeTool: TCodeTool): boolean;
660
661 // insert/replace
InsertStatementsnull662 function InsertStatements(InsertPos: TInsertStatementPosDescription;
663 const Statements: string): boolean;
664
665 // alter proc
AddProcModifiernull666 function AddProcModifier(Code: TCodeBuffer; X, Y: integer;
667 const aModifier: string): boolean;
668
669 // extract proc (creates a new procedure from code in selection)
670 function CheckExtractProc(Code: TCodeBuffer;
671 const StartPoint, EndPoint: TPoint;
672 out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean;
673 out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
674 VarTree: TAVLTree = nil // tree of TExtractedProcVariable
675 ): boolean;
ExtractProcnull676 function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint;
677 ProcType: TExtractProcType; const ProcName: string;
678 IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
679 var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
680 FunctionResultVariableStartPos: integer = 0
681 ): boolean;
682
683 // 'Assign' method
FindAssignMethodnull684 function FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
685 out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
686 out AssignDeclNode: TCodeTreeNode;
687 var MemberNodeExts: TAVLTree; // tree of TCodeTreeNodeExtension, Node=var or property, Data=write property
688 out AssignBodyNode: TCodeTreeNode;
689 out InheritedDeclContext: TFindContext;
690 ProcName: string = '' // default: Assign
691 ): boolean;
692
693 // source name e.g. 'unit AUnitName;'
GetSourceNamenull694 function GetSourceName(Code: TCodeBuffer; SearchMainCode: boolean): string;
GetCachedSourceNamenull695 function GetCachedSourceName(Code: TCodeBuffer): string;
RenameSourcenull696 function RenameSource(Code: TCodeBuffer; const NewName: string): boolean;
GetSourceTypenull697 function GetSourceType(Code: TCodeBuffer; SearchMainCode: boolean): string;
698
699 // uses sections
FindUnitInAllUsesSectionsnull700 function FindUnitInAllUsesSections(Code: TCodeBuffer;
701 const AnUnitName: string; out NamePos, InPos: integer;
702 const IgnoreMissingIncludeFiles: Boolean = False): boolean;
RenameUsedUnitnull703 function RenameUsedUnit(Code: TCodeBuffer;
704 const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
ReplaceUsedUnitsnull705 function ReplaceUsedUnits(Code: TCodeBuffer;
706 UnitNamePairs: TStringToStringTree): boolean;
AddUnitToMainUsesSectionnull707 function AddUnitToMainUsesSection(Code: TCodeBuffer;
708 const NewUnitName, NewUnitInFile: string;
709 AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
AddUnitToMainUsesSectionIfNeedednull710 function AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
711 const NewUnitName, NewUnitInFile: string;
712 AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
AddUnitToImplementationUsesSectionnull713 function AddUnitToImplementationUsesSection(Code: TCodeBuffer;
714 const NewUnitName, NewUnitInFile: string;
715 AsLast: boolean = false; CheckSpecialUnits: boolean = true): boolean;
RemoveUnitFromAllUsesSectionsnull716 function RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
717 const AnUnitName: string): boolean;
FindUsedUnitFilesnull718 function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection: TStrings
719 ): boolean; // only main uses section, if unit not found, returns "unitname" or "unitname in 'filename'"
FindUsedUnitFilesnull720 function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection,
721 ImplementationUsesSection: TStrings): boolean;
FindUsedUnitNamesnull722 function FindUsedUnitNames(Code: TCodeBuffer; var MainUsesSection,
723 ImplementationUsesSection: TStrings): boolean; // ignoring 'in'
FindMissingUnitsnull724 function FindMissingUnits(Code: TCodeBuffer; var MissingUnits: TStrings;
725 FixCase: boolean = false; SearchImplementation: boolean = true): boolean;
FindDelphiProjectUnitsnull726 function FindDelphiProjectUnits(Code: TCodeBuffer;
727 out FoundInUnits, MissingInUnits, NormalUnits: TStrings;
728 IgnoreNormalUnits: boolean = false): boolean;
FindDelphiPackageUnitsnull729 function FindDelphiPackageUnits(Code: TCodeBuffer;
730 var FoundInUnits, MissingInUnits, NormalUnits: TStrings;
731 IgnoreNormalUnits: boolean = false): boolean;
CommentUnitsInUsesSectionsnull732 function CommentUnitsInUsesSections(Code: TCodeBuffer;
733 MissingUnits: TStrings): boolean;
FindUnitCaseInsensitivenull734 function FindUnitCaseInsensitive(Code: TCodeBuffer;
735 var AnUnitName, AnUnitInFilename: string): string;
FindUnitSourcenull736 function FindUnitSource(Code: TCodeBuffer;
737 const AnUnitName, AnUnitInFilename: string): TCodeBuffer;
CreateUsesGraphnull738 function CreateUsesGraph: TUsesGraph;
FindUnusedUnitsnull739 function FindUnusedUnits(Code: TCodeBuffer; Units: TStrings): boolean;
740
741 // resources
742 property OnFindDefinePropertyForContext: TOnFindDefinePropertyForContext
743 read FOnFindDefinePropertyForContext
744 write FOnFindDefinePropertyForContext;
745 property OnFindDefineProperty: TOnFindDefineProperty
746 read FOnFindDefineProperty
747 write FOnFindDefineProperty;
FindLFMFileNamenull748 function FindLFMFileName(Code: TCodeBuffer): string;
CheckLFMnull749 function CheckLFM(UnitCode, LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
750 RootMustBeClassInUnit, RootMustBeClassInIntf,
751 ObjectsMustExist: boolean): boolean;
FindNextResourceFilenull752 function FindNextResourceFile(Code: TCodeBuffer;
753 var LinkIndex: integer): TCodeBuffer;
AddLazarusResourceHeaderCommentnull754 function AddLazarusResourceHeaderComment(Code: TCodeBuffer;
755 const CommentText: string): boolean;
FindLazarusResourcenull756 function FindLazarusResource(Code: TCodeBuffer;
757 const ResourceName: string): TAtomPosition;
AddLazarusResourcenull758 function AddLazarusResource(Code: TCodeBuffer;
759 const ResourceName, ResourceData: string): boolean;
RemoveLazarusResourcenull760 function RemoveLazarusResource(Code: TCodeBuffer;
761 const ResourceName: string): boolean;
RenameMainIncludenull762 function RenameMainInclude(Code: TCodeBuffer; const NewFilename: string;
763 KeepPath: boolean): boolean;
RenameIncludeDirectivenull764 function RenameIncludeDirective(Code: TCodeBuffer; LinkIndex: integer;
765 const NewFilename: string; KeepPath: boolean): boolean;// in cleaned source
766 procedure DefaultFindDefinePropertyForContext(Sender: TObject;
767 const ClassContext, AncestorClassContext: TFindContext;
768 {%H-}LFMNode: TLFMTreeNode;
769 const IdentName: string; var IsDefined: boolean);
770
771 // Delphi to Lazarus conversion
ConvertDelphiToLazarusSourcenull772 function ConvertDelphiToLazarusSource(Code: TCodeBuffer;
773 AddLRSCode: boolean): boolean;
774
775 // Application.Createform(ClassName,VarName) statements in program source
FindCreateFormStatementnull776 function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
777 const AClassName, AVarName: string;
778 out Position: integer): integer; // 0=found, -1=not found, 1=found, but wrong classname
AddCreateFormStatementnull779 function AddCreateFormStatement(Code: TCodeBuffer;
780 const AClassName, AVarName: string): boolean;
RemoveCreateFormStatementnull781 function RemoveCreateFormStatement(Code: TCodeBuffer;
782 const AVarName: string): boolean;
ChangeCreateFormStatementnull783 function ChangeCreateFormStatement(Code: TCodeBuffer;
784 const OldClassName, OldVarName: string;
785 const NewClassName, NewVarName: string;
786 OnlyIfExists: boolean): boolean;
ListAllCreateFormStatementsnull787 function ListAllCreateFormStatements(Code: TCodeBuffer): TStrings;
SetAllCreateFromStatementsnull788 function SetAllCreateFromStatements(Code: TCodeBuffer;
789 List: TStrings): boolean;
790
791 // Application.Title:= statements in program source
GetApplicationTitleStatementnull792 function GetApplicationTitleStatement(Code: TCodeBuffer;
793 var Title: string): boolean;
SetApplicationTitleStatementnull794 function SetApplicationTitleStatement(Code: TCodeBuffer;
795 const NewTitle: string): boolean;
RemoveApplicationTitleStatementnull796 function RemoveApplicationTitleStatement(Code: TCodeBuffer): boolean;
797
798 // Application.Scaled:= statements in program source
GetApplicationScaledStatementnull799 function GetApplicationScaledStatement(Code: TCodeBuffer;
800 var AScaled: Boolean): boolean;
SetApplicationScaledStatementnull801 function SetApplicationScaledStatement(Code: TCodeBuffer;
802 const NewScaled: Boolean): boolean;
RemoveApplicationScaledStatementnull803 function RemoveApplicationScaledStatement(Code: TCodeBuffer): boolean;
804
805 // forms
806 // Hint: to find the class use FindDeclarationInInterface
RenameFormnull807 function RenameForm(Code: TCodeBuffer;
808 const OldFormName, OldFormClassName: string;
809 const NewFormName, NewFormClassName: string): boolean;
FindFormAncestornull810 function FindFormAncestor(Code: TCodeBuffer; const FormClassName: string;
811 var AncestorClassName: string; DirtySearch: boolean): boolean;
812
813 // form components
CompleteComponentnull814 function CompleteComponent(Code: TCodeBuffer;
815 AComponent, AncestorComponent: TComponent): boolean;
PublishedVariableExistsnull816 function PublishedVariableExists(Code: TCodeBuffer;
817 const AClassName, AVarName: string;
818 ErrorOnClassNotFound: boolean): boolean;
AddPublishedVariablenull819 function AddPublishedVariable(Code: TCodeBuffer;
820 const AClassName,VarName, VarType: string): boolean;
RemovePublishedVariablenull821 function RemovePublishedVariable(Code: TCodeBuffer;
822 const AClassName, AVarName: string;
823 ErrorOnClassNotFound: boolean): boolean;
RenamePublishedVariablenull824 function RenamePublishedVariable(Code: TCodeBuffer;
825 const AClassName, OldVariableName, NewVarName,
826 VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
RetypeClassVariablesnull827 function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string;
828 ListOfReTypes: TStringToStringTree;
829 ErrorOnClassNotFound: boolean;
830 SearchImplementationToo: boolean = false): boolean;
FindDanglingComponentEventsnull831 function FindDanglingComponentEvents(Code: TCodeBuffer;
832 const AClassName: string;
833 RootComponent: TComponent; ExceptionOnClassNotFound,
834 SearchInAncestors: boolean;
835 out ListOfPInstancePropInfo: TFPList;
836 const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
837
838 // utilities for the object inspector
GetCompatiblePublishedMethodsnull839 function GetCompatiblePublishedMethods(Code: TCodeBuffer;
840 const AClassName: string;
841 PropInstance: TPersistent; const PropName: string;
842 const Proc: TGetStrProc): boolean;
GetCompatiblePublishedMethodsnull843 function GetCompatiblePublishedMethods(Code: TCodeBuffer;
844 const AClassName: string; TypeData: PTypeData;
845 const Proc: TGetStrProc): boolean;
PublishedMethodExistsnull846 function PublishedMethodExists(Code:TCodeBuffer;
847 const AClassName, AMethodName: string;
848 PropInstance: TPersistent; const PropName: string;
849 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
850 ): boolean;
PublishedMethodExistsnull851 function PublishedMethodExists(Code:TCodeBuffer; const AClassName,
852 AMethodName: string; TypeData: PTypeData;
853 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
854 ): boolean;
JumpToPublishedMethodBodynull855 function JumpToPublishedMethodBody(Code: TCodeBuffer;
856 const AClassName, AMethodName: string;
857 out NewCode: TCodeBuffer;
858 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
RenamePublishedMethodnull859 function RenamePublishedMethod(Code: TCodeBuffer;
860 const AClassName, OldMethodName,
861 NewMethodName: string): boolean;
CreatePublishedMethodnull862 function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
863 NewMethodName: string; ATypeInfo: PTypeInfo;
864 UseTypeInfoForParameters: boolean = false;
865 const APropertyUnitName: string = ''; const APropertyPath: string = '';
866 const CallAncestorMethod: string = ''; AddOverride: boolean = false
867 ): boolean;
868
869 // private class parts
CreatePrivateMethodnull870 function CreatePrivateMethod(Code: TCodeBuffer; const AClassName,
871 NewMethodName: string; ATypeInfo: PTypeInfo;
872 UseTypeInfoForParameters: boolean = false;
873 const APropertyUnitName: string = '';
874 const APropertyPath: string = ''): boolean;
875
876 // IDE % directives
GetIDEDirectivesnull877 function GetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings;
878 const Filter: TOnIDEDirectiveFilter = nil): boolean;
SetIDEDirectivesnull879 function SetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings;
880 const Filter: TOnIDEDirectiveFilter = nil): boolean;
881
882 // linker jumping
JumpToLinkerIdentifiernull883 function JumpToLinkerIdentifier(Code: TCodeBuffer;
884 const SourceFilename: string; SourceLine: integer;
885 const MangledFunction, Identifier: string;
886 out NewCode: TCodeBuffer;
887 out NewX, NewY, NewTopLine: integer): boolean;
888
889 // gdb stacktraces
FindFPCMangledIdentifiernull890 function FindFPCMangledIdentifier(GDBIdentifier: string; out aComplete: boolean;
891 out aMessage: string; const OnFindSource: TOnFindFPCMangledSource;
892 out NewCode: TCodeBuffer;
893 out NewX, NewY, NewTopLine: integer): boolean;
894 property OnFindFPCMangledSource: TOnFindFPCMangledSource
895 read FOnFindFPCMangledSource write FOnFindFPCMangledSource;
896
897 // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
898
899 procedure ConsistencyCheck;
900 procedure WriteDebugReport(WriteTool,
901 WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
902 WriteMemStats: boolean);
903 procedure WriteMemoryStats;
904 end;
905
906
907 var CodeToolBoss: TCodeToolManager;
908
909
CreateDefinesForFPCModenull910 function CreateDefinesForFPCMode(const Name: string;
911 CompilerMode: TCompilerMode): TDefineTemplate;
912
913
914 implementation
915
916
CompareCodeToolMainSourcesnull917 function CompareCodeToolMainSources(Data1, Data2: Pointer): integer;
918 var
919 Src1, Src2: Pointer;
920 begin
921 Src1:=TCustomCodeTool(Data1).Scanner.MainCode;
922 Src2:=TCustomCodeTool(Data2).Scanner.MainCode;
923 if Src1<Src2 then
924 Result:=-1
925 else if Src1>Src2 then
926 Result:=+1
927 else
928 Result:=0;
929 end;
930
CompareDirectivesTreeSourcesnull931 function CompareDirectivesTreeSources(Data1, Data2: Pointer): integer;
932 var
933 Src1, Src2: Pointer;
934 begin
935 Src1:=TCompilerDirectivesTree(Data1).Code;
936 Src2:=TCompilerDirectivesTree(Data2).Code;
937 if Src1<Src2 then
938 Result:=-1
939 else if Src1>Src2 then
940 Result:=+1
941 else
942 Result:=0;
943 end;
944
GetOwnerForCodeTreeNodenull945 function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject;
946 begin
947 Result:=CodeToolBoss.GetOwnerForCodeTreeNode(ANode);
948 end;
949
950 procedure DumpExceptionBackTrace;
951 var
952 FrameCount: integer;
953 Frames: PPointer;
954 FrameNumber:Integer;
955 begin
956 DebugLn('Codetools Stack trace:');
957 DebugLn(BackTraceStrFunc(ExceptAddr));
958 FrameCount:=ExceptFrameCount;
959 Frames:=ExceptFrames;
960 for FrameNumber := 0 to FrameCount-1 do
961 DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
962 end;
963
CreateDefinesForFPCModenull964 function CreateDefinesForFPCMode(const Name: string; CompilerMode: TCompilerMode
965 ): TDefineTemplate;
966 var
967 cm: TCompilerMode;
968 NewMode: String;
969 begin
970 Result:=TDefineTemplate.Create(Name,'set FPC compiler mode',
971 '','',da_Block);
972 for cm:=Low(TCompilerMode) to High(TCompilerMode) do begin
973 Result.AddChild(TDefineTemplate.Create(CompilerModeVars[cm],
974 CompilerModeVars[cm],CompilerModeVars[cm],'',da_Undefine));
975 end;
976 NewMode:=CompilerModeVars[CompilerMode];
977 Result.AddChild(TDefineTemplate.Create(NewMode,
978 NewMode,NewMode,'1',da_Define));
979 end;
980
981 { ECodeToolManagerError }
982
983 constructor ECodeToolManagerError.Create(TheID: int64; const Msg: string);
984 begin
985 Id:=TheID;
986 inherited Create(Msg);
987 end;
988
989 constructor ECodeToolManagerError.CreateFmt(TheID: int64; const Msg: string;
990 const Args: array of const);
991 begin
992 Id:=TheID;
993 inherited CreateFmt(Msg,Args);
994 end;
995
996 { TCodeToolManager }
997
998 // inline
GetBeautifiernull999 function TCodeToolManager.GetBeautifier: TBeautifyCodeOptions;
1000 begin
1001 Result:=SourceChangeCache.BeautifyCodeOptions;
1002 end;
1003
1004 constructor TCodeToolManager.Create;
1005 begin
1006 inherited Create;
1007 FCheckFilesOnDisk:=true;
1008 FOnFindDefinePropertyForContext:=@DefaultFindDefinePropertyForContext;
1009 DirectoryCachePool:=TCTDirectoryCachePool.Create;
1010 DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString;
1011 DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile;
1012 DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet;
1013 DirectoryCachePool.OnGetCompiledUnitFromSet:=@DirectoryCachePoolGetCompiledUnitFromSet;
1014 DirectoryCachePool.OnIterateFPCUnitsFromSet:=@DirectoryCachePoolIterateFPCUnitsFromSet;
1015 DefineTree:=TDefineTree.Create;
1016 DefineTree.OnReadValue:=@DoOnDefineTreeReadValue;
1017 DefinePool:=TDefinePool.Create;
1018 SourceCache:=TCodeCache.Create;
1019 SourceCache.DirectoryCachePool:=DirectoryCachePool;
1020 if DefaultConfigCodeCache=nil then
1021 DefaultConfigCodeCache:=SourceCache;
1022 SourceChangeCache:=TSourceChangeCache.Create;
1023 SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
1024 SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
1025 Indenter:=TFullyAutomaticBeautifier.Create;
1026 Indenter.OnGetNestedComments:=@DoOnFABGetNestedComments;
1027 Indenter.OnGetExamples:=@DoOnFABGetExamples;
1028 Indenter.OnLoadFile:=@DoOnLoadFileForTool;
1029 GlobalValues:=TExpressionEvaluator.Create;
1030 OnFileExistsCached:=@DirectoryCachePool.FileExists;
1031 OnFileAgeCached:=@DirectoryCachePool.FileAge;
1032 DefineTree.DirectoryCachePool:=DirectoryCachePool;
1033 CompilerDefinesCache:=TCompilerDefinesCache.Create(nil);
1034 PPUCache:=TPPUTools.Create;
1035 FAddInheritedCodeToOverrideMethod:=true;
1036 FAdjustTopLineDueToComment:=true;
1037 FCatchExceptions:=true;
1038
1039 FCompleteProperties:=true;
1040 FSetPropertyVariablename:='AValue';
1041 FSetPropertyVariableIsPrefix := false;
1042 FSetPropertyVariableUseConst := false;
1043 FAddInheritedCodeToOverrideMethod := true;
1044
1045 FCursorBeyondEOL:=true;
1046 FIndentSize:=2;
1047 FJumpSingleLinePos:=50;
1048 FJumpSingleLinePos:=0;
1049 FSourceExtensions:='.pp;.pas;.p;.lpr;.lpk;.dpr;.dpk';
1050 FVisibleEditorLines:=20;
1051 FWriteExceptions:=true;
1052 FPascalTools:=TAVLTree.Create(@CompareCodeToolMainSources);
1053 FDirectivesTools:=TAVLTree.Create(@CompareDirectivesTreeSources);
1054 IdentifierList:=TIdentifierList.Create;
1055 IdentifierHistory:=TIdentifierHistoryList.Create;
1056 IdentifierList.History:=IdentifierHistory;
1057 DefaultLFMTrees:=TLFMTrees.Create;
1058 end;
1059
1060 destructor TCodeToolManager.Destroy;
1061 var
1062 e: TCodeToolManagerHandler;
1063 begin
1064 {$IFDEF CTDEBUG}
1065 DebugLn('[TCodeToolManager.Destroy] A');
1066 {$ENDIF}
1067 FreeAndNil(GlobalValues);
1068 {$IFDEF CTDEBUG}
1069 DebugLn('[TCodeToolManager.Destroy] B');
1070 {$ENDIF}
1071 FreeAndNil(DefaultLFMTrees);
1072 FreeAndNil(Positions);
1073 FreeAndNil(IdentifierHistory);
1074 FreeAndNil(IdentifierList);
1075 FPascalTools.FreeAndClear;
1076 FreeAndNil(FPascalTools);
1077 FDirectivesTools.FreeAndClear;
1078 FreeAndNil(FDirectivesTools);
1079 FreeAndNil(PPUCache);
1080 FreeAndNil(FResourceTool);
1081 {$IFDEF CTDEBUG}
1082 DebugLn('[TCodeToolManager.Destroy] C');
1083 {$ENDIF}
1084 FreeAndNil(DefineTree);
1085 FreeAndNil(DefinePool);
1086 {$IFDEF CTDEBUG}
1087 DebugLn('[TCodeToolManager.Destroy] D');
1088 {$ENDIF}
1089 FreeAndNil(Indenter);
1090 FreeAndNil(SourceChangeCache);
1091 {$IFDEF CTDEBUG}
1092 DebugLn('[TCodeToolManager.Destroy] E');
1093 {$ENDIF}
1094 if DefaultConfigCodeCache=SourceCache then
1095 DefaultConfigCodeCache:=nil;
1096 FreeAndNil(SourceCache);
1097 if OnFileExistsCached=@DirectoryCachePool.FileExists then
1098 OnFileExistsCached:=nil;
1099 if OnFileAgeCached=@DirectoryCachePool.FileAge then
1100 OnFileAgeCached:=nil;
1101 FreeAndNil(DirectoryCachePool);
1102 FreeAndNil(CompilerDefinesCache);
1103 for e:=low(FHandlers) to high(FHandlers) do
1104 FreeAndNil(FHandlers[e]);
1105 {$IFDEF CTDEBUG}
1106 DebugLn('[TCodeToolManager.Destroy] F');
1107 {$ENDIF}
1108 inherited Destroy;
1109 {$IFDEF CTDEBUG}
1110 DebugLn('[TCodeToolManager.Destroy] END');
1111 {$ENDIF}
1112 {$IFDEF MEM_CHECK}
1113 CheckHeap('TCodeToolManager.Destroy END');
1114 {$ENDIF}
1115 end;
1116
1117 procedure TCodeToolManager.Init(Config: TCodeToolsOptions);
1118 var
1119 FPCDefines: TDefineTemplate;
1120 FPCSrcDefines: TDefineTemplate;
1121 LazarusSrcDefines: TDefineTemplate;
1122 CurFPCOptions: String;
1123 UnitSetCache: TFPCUnitSetCache;
1124 //CfgCache: TPCTargetConfigCache;
1125
1126 procedure AddFPCOption(s: string);
1127 begin
1128 if s='' then exit;
1129 if CurFPCOptions<>'' then
1130 CurFPCOptions:=CurFPCOptions+' ';
1131 CurFPCOptions:=CurFPCOptions+s;
1132 end;
1133
1134 begin
1135 // set global values
1136 with GlobalValues do begin
1137 Variables[ExternalMacroStart+'LazarusSrcDir']:=Config.LazarusSrcDir;
1138 Variables[ExternalMacroStart+'FPCSrcDir']:=Config.FPCSrcDir;
1139 Variables[ExternalMacroStart+'LCLWidgetType']:=Config.LCLWidgetType;
1140 Variables[ExternalMacroStart+'ProjectDir']:=Config.ProjectDir;
1141 end;
1142
1143 CompilerDefinesCache.ConfigCaches.Assign(Config.ConfigCaches);
1144 CompilerDefinesCache.SourceCaches.Assign(Config.SourceCaches);
1145 CompilerDefinesCache.TestFilename:=Config.TestPascalFile;
1146 if CompilerDefinesCache.TestFilename='' then
1147 CompilerDefinesCache.TestFilename:=GetTempFilename('fpctest.pas','');
1148
1149 UnitSetCache:=CompilerDefinesCache.FindUnitSet(Config.FPCPath,
1150 Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
1151 true);
1152 // parse compiler settings, fpc sources
1153 UnitSetCache.Init;
1154 //CfgCache:=UnitSetCache.GetConfigCache(false);
1155 //if CfgCache.TargetOS<>CfgCache.RealTargetOS then
1156 // debugln(['TCodeToolManager.Init TargetOS=',CfgCache.TargetOS,' RealTargetOS=',CfgCache.RealTargetOS]);
1157 //if CfgCache.TargetCPU<>CfgCache.RealTargetCPU then
1158 // debugln(['TCodeToolManager.Init TargetCPU=',CfgCache.TargetCPU,' RealTargetCPU=',CfgCache.RealTargetCPU]);
1159
1160 // save
1161 Config.ConfigCaches.Assign(CompilerDefinesCache.ConfigCaches);
1162 Config.SourceCaches.Assign(CompilerDefinesCache.SourceCaches);
1163
1164 // create template for FPC settings
1165 FPCDefines:=CreateFPCTemplate(UnitSetCache,nil);
1166 DefineTree.Add(FPCDefines);
1167
1168 // create template for FPC source directory
1169 FPCSrcDefines:=CreateFPCSourceTemplate(UnitSetCache,nil);
1170 DefineTree.Add(FPCSrcDefines);
1171
1172 // create template for lazarus source directory
1173 LazarusSrcDefines:=DefinePool.CreateLazarusSrcTemplate('$(#LazarusSrcDir)',
1174 '$(#LCLWidgetType)',Config.LazarusSrcOptions,nil);
1175 DefineTree.Add(LazarusSrcDefines);
1176
1177 // create template for LCL project
1178 DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
1179 '$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil));
1180
1181 //debugln(['TCodeToolManager.Init defines: ',DefineTree.GetDefinesForVirtualDirectory.AsString]);
1182 //debugln(['TCodeToolManager.Init inc path rtl/system: ',GetIncludePathForDirectory(UnitSetCache.FPCSourceDirectory+'/rtl/bsd')]);
1183 end;
1184
1185 procedure TCodeToolManager.SimpleInit(const ConfigFilename: string);
1186 var
1187 Options: TCodeToolsOptions;
1188 begin
1189 // setup the Options
1190 Options:=TCodeToolsOptions.Create;
1191 try
1192 // To not parse the FPC sources every time, the options are saved to a file.
1193 DebugLn(['TCodeToolManager.SimpleInit Config=',ConfigFilename]);
1194 if FileExistsUTF8(ConfigFilename) then
1195 Options.LoadFromFile(ConfigFilename);
1196 // use environment variables
1197 Options.InitWithEnvironmentVariables;
1198 // apply defaults
1199 if Options.FPCSrcDir='' then
1200 Options.FPCSrcDir:=ExpandFileNameUTF8('~/freepascal/fpc');
1201 if Options.LazarusSrcDir='' then
1202 Options.LazarusSrcDir:=ExpandFileNameUTF8('~/pascal/lazarus');
1203 DebugLn(['TCodeToolManager.SimpleInit PP=',Options.FPCPath,' FPCDIR=',Options.FPCSrcDir,' LAZARUSDIR=',Options.LazarusSrcDir,' FPCTARGET=',Options.TargetOS]);
1204 // init the codetools
1205 if not Options.UnitLinkListValid then
1206 debugln('Scanning FPC sources may take a while ...');
1207 Init(Options);
1208
1209 // save the options and the FPC unit links results.
1210 Options.SaveToFile(ConfigFilename);
1211 finally
1212 Options.Free;
1213 end;
1214 end;
1215
1216 procedure TCodeToolManager.BeginUpdate;
1217 begin
1218 SourceChangeCache.BeginUpdate;
1219 end;
1220
TCodeToolManager.EndUpdatenull1221 function TCodeToolManager.EndUpdate: boolean;
1222 begin
1223 Result:=SourceChangeCache.EndUpdate;
1224 end;
1225
TCodeToolManager.GatherExternalChangesnull1226 function TCodeToolManager.GatherExternalChanges: boolean;
1227 var
1228 Abort: Boolean;
1229 begin
1230 Result:=true;
1231 if Assigned(OnGatherExternalChanges) then begin
1232 Abort:=false;
1233 OnGatherExternalChanges(Self,Abort);
1234 Result:=not Abort;
1235 end;
1236 end;
1237
FindFilenull1238 function TCodeToolManager.FindFile(const ExpandedFilename: string): TCodeBuffer;
1239 begin
1240 Result:=SourceCache.FindFile(ExpandedFilename);
1241 end;
1242
TCodeToolManager.LoadFilenull1243 function TCodeToolManager.LoadFile(const ExpandedFilename: string;
1244 UpdateFromDisk, Revert: boolean): TCodeBuffer;
1245 begin
1246 {$IFDEF CTDEBUG}
1247 DebugLn('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',dbgs(UpdateFromDisk),' Revert=',dbgs(Revert));
1248 {$ENDIF}
1249 if (not UpdateFromDisk) and (not Revert) then begin
1250 Result:=SourceCache.FindFile(ExpandedFilename);
1251 if (Result<>nil) and (not Result.IsDeleted) then exit;
1252 end;
1253 Result:=SourceCache.LoadFile(ExpandedFilename);
1254 if Result<>nil then begin
1255 if Revert then begin
1256 if not Result.Revert then
1257 Result:=nil;
1258 end else if UpdateFromDisk and Result.AutoRevertFromDisk
1259 and Result.FileNeedsUpdate then begin
1260 //debugln(['TCodeToolManager.LoadFile ',ExpandedFilename,' AutoRevert=',Result.AutoRevertFromDisk,' Modified=',Result.Modified,' NeedLoad=',Result.FileNeedsUpdate]);
1261 Result.Reload;
1262 end;
1263 end;
1264 end;
1265
CreateFilenull1266 function TCodeToolManager.CreateFile(const AFilename: string): TCodeBuffer;
1267 begin
1268 Result:=SourceCache.CreateFile(AFilename);
1269 DirectoryCachePool.IncreaseFileTimeStamp;
1270 {$IFDEF CTDEBUG}
1271 DebugLn('****** TCodeToolManager.CreateFile "',AFilename,'" ',dbgs(Result<>nil));
1272 {$ENDIF}
1273 end;
1274
CreateTempFilenull1275 function TCodeToolManager.CreateTempFile(const AFilename: string): TCodeBuffer;
1276 var
1277 i: Integer;
1278 TempFilename: string;
1279 CurName: String;
1280 CurExt: String;
1281 begin
1282 TempFilename:=VirtualTempDir+PathDelim+AFilename;
1283 Result:=FindFile(TempFilename);
1284 if (Result<>nil) and (Result.ReferenceCount=0) then exit;
1285 CurName:=ExtractFileNameOnly(AFilename);
1286 CurExt:=ExtractFileExt(AFilename);
1287 i:=1;
1288 repeat
1289 TempFilename:=VirtualTempDir+PathDelim+CurName+IntToStr(i)+CurExt;
1290 Result:=FindFile(TempFilename);
1291 if (Result<>nil) and (Result.ReferenceCount=0) then exit;
1292 inc(i);
1293 until Result=nil;
1294 Result:=SourceCache.CreateFile(TempFilename);
1295 Result.IncrementRefCount;
1296 end;
1297
1298 procedure TCodeToolManager.ReleaseTempFile(Buffer: TCodeBuffer);
1299 begin
1300 Buffer.ReleaseRefCount;
1301 end;
1302
SaveBufferAsnull1303 function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
1304 const ExpandedFilename: string; out NewBuffer: TCodeBuffer): boolean;
1305 begin
1306 Result:=SourceCache.SaveBufferAs(OldBuffer,ExpandedFilename,NewBuffer);
1307 end;
1308
FilenameHasSourceExtnull1309 function TCodeToolManager.FilenameHasSourceExt(
1310 const AFilename: string): boolean;
1311 var i, CurExtStart, CurExtEnd, ExtStart, ExtLen: integer;
1312 begin
1313 ExtStart:=length(AFilename);
1314 while (ExtStart>0) and (AFilename[ExtStart]<>'.')
1315 and (AFilename[ExtStart]<>PathDelim) do
1316 dec(ExtStart);
1317 if (ExtStart<1) or (AFilename[ExtStart]<>'.') then begin
1318 Result:=false;
1319 exit;
1320 end;
1321 ExtLen:=length(AFilename)-ExtStart+1;
1322 CurExtStart:=1;
1323 CurExtEnd:=CurExtStart;
1324 while CurExtEnd<=length(FSourceExtensions)+1 do begin
1325 if (CurExtEnd>length(FSourceExtensions))
1326 or (FSourceExtensions[CurExtEnd] in [':',';']) then begin
1327 // compare current extension with filename-extension
1328 if ExtLen=CurExtEnd-CurExtStart then begin
1329 i:=0;
1330 while (i<ExtLen)
1331 and (UpChars[AFilename[i+ExtStart]]
1332 =UpChars[FSourceExtensions[CurExtStart+i]]) do
1333 inc(i);
1334 if i=ExtLen then begin
1335 Result:=true;
1336 exit;
1337 end;
1338 end;
1339 inc(CurExtEnd);
1340 CurExtStart:=CurExtEnd;
1341 end else
1342 inc(CurExtEnd);
1343 end;
1344 Result:=false;
1345 end;
1346
TCodeToolManager.GetMainCodenull1347 function TCodeToolManager.GetMainCode(Code: TCodeBuffer): TCodeBuffer;
1348 var
1349 NewFile: TCodeBuffer;
1350 begin
1351 // find MainCode (= the start source, e.g. a unit/program/package source)
1352 Result:=Code;
1353 if Result=nil then exit;
1354 // if this is an include file, find the top level source
1355 while (Result.LastIncludedByFile<>'') do begin
1356 NewFile:=SourceCache.LoadFile(Result.LastIncludedByFile);
1357 if (NewFile=nil) then begin
1358 Result.LastIncludedByFile:='';
1359 break;
1360 end;
1361 Result:=NewFile;
1362 end;
1363 if (not FilenameHasSourceExt(Result.Filename)) then begin
1364 NewFile:=FindCodeOfMainUnitHint(Result);
1365 if NewFile<>nil then Result:=NewFile;
1366 end;
1367 CreateScanner(Result);
1368 end;
1369
GetIncludeCodeChainnull1370 function TCodeToolManager.GetIncludeCodeChain(Code: TCodeBuffer;
1371 RemoveFirstCodesWithoutTool: boolean; out ListOfCodeBuffer: TFPList): boolean;
1372 var
1373 OldCode: TCodeBuffer;
1374 NewCode: TCodeBuffer;
1375 begin
1376 // find MainCode (= the start source, e.g. a unit/program/package source)
1377 Result:=false;
1378 ListOfCodeBuffer:=nil;
1379 if Code=nil then exit;
1380
1381 Result:=true;
1382 ListOfCodeBuffer:=TFPList.Create;
1383 ListOfCodeBuffer.Add(Code);
1384
1385 // if this is an include file, find the top level source
1386 while (Code.LastIncludedByFile<>'') do begin
1387 NewCode:=SourceCache.LoadFile(Code.LastIncludedByFile);
1388 if NewCode=nil then begin
1389 NewCode.LastIncludedByFile:='';
1390 break;
1391 end;
1392 Code:=NewCode;
1393 ListOfCodeBuffer.Insert(0,Code);
1394 end;
1395
1396 if (not FilenameHasSourceExt(Code.Filename)) then begin
1397 OldCode:=Code;
1398 Code:=FindCodeOfMainUnitHint(OldCode);
1399 if Code<>OldCode then
1400 ListOfCodeBuffer.Insert(0,Code);
1401 end;
1402
1403 if RemoveFirstCodesWithoutTool then begin
1404 while ListOfCodeBuffer.Count>0 do begin
1405 Code:=TCodeBuffer(ListOfCodeBuffer[0]);
1406 if FindCodeToolForSource(Code)<>nil then break;
1407 ListOfCodeBuffer.Delete(0);
1408 end;
1409 if ListOfCodeBuffer.Count=0 then begin
1410 ListOfCodeBuffer.Free;
1411 ListOfCodeBuffer:=nil;
1412 Result:=false;
1413 exit;
1414 end;
1415 end;
1416 end;
1417
FindCodeOfMainUnitHintnull1418 function TCodeToolManager.FindCodeOfMainUnitHint(Code: TCodeBuffer
1419 ): TCodeBuffer;
1420 var
1421 MainUnitFilename: string;
1422 begin
1423 Result:=nil;
1424 if Code=nil then exit;
1425 //DebugLn('TCodeToolManager.FindCodeOfMainUnitHint ',Code.Filename);
1426 if not FindMainUnitHint(Code.Source,MainUnitFilename) then exit;
1427 if MainUnitFilename='' then exit;
1428 MainUnitFilename:=TrimFilename(MainUnitFilename);
1429 if (not FilenameIsAbsolute(MainUnitFilename))
1430 and (not Code.IsVirtual) then
1431 MainUnitFilename:=TrimFilename(ExtractFilePath(Code.Filename)+PathDelim
1432 +MainUnitFilename);
1433 //DebugLn('TCodeToolManager.FindCodeOfMainUnitHint B ');
1434 Result:=SourceCache.LoadFile(MainUnitFilename);
1435 end;
1436
1437 procedure TCodeToolManager.CreateScanner(Code: TCodeBuffer);
1438 begin
1439 if FilenameHasSourceExt(Code.Filename) and (Code.Scanner=nil) then begin
1440 // create a scanner for the unit/program
1441 Code.Scanner:=TLinkScanner.Create;
1442 Code.Scanner.OnGetInitValues:=@DoOnScannerGetInitValues;
1443 Code.Scanner.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
1444 Code.Scanner.OnGetGlobalChangeSteps:=@DoOnToolGetChangeSteps;
1445 Code.Scanner.OnProgress:=@DoOnScannerProgress;
1446 end;
1447 end;
1448
1449 procedure TCodeToolManager.ClearError;
1450 begin
1451 fErrorMsg:='';
1452 fErrorCode:=nil;
1453 fErrorLine:=-1;
1454 fErrorTopLine:=0;
1455 FErrorId:=0;
1456 FErrorMsg := '';
1457 FErrorDbgMsg := '';
1458 end;
1459
1460 procedure TCodeToolManager.ClearCurCodeTool;
1461 begin
1462 ClearError;
1463 FCurCodeTool:=nil;
1464 end;
1465
ApplyChangesnull1466 function TCodeToolManager.ApplyChanges: boolean;
1467 begin
1468 Result:=SourceChangeCache.Apply;
1469 end;
1470
TCodeToolManager.SetGlobalValuenull1471 function TCodeToolManager.SetGlobalValue(const VariableName,
1472 VariableValue: string): boolean;
1473 var
1474 OldValue: string;
1475 begin
1476 OldValue:=GlobalValues[VariableName];
1477 Result:=(OldValue<>VariableValue);
1478 if not Result then exit;
1479 GlobalValues[VariableName]:=VariableValue;
1480 DefineTree.ClearCache;
1481 end;
1482
TCodeToolManager.GetUnitPathForDirectorynull1483 function TCodeToolManager.GetUnitPathForDirectory(const Directory: string;
1484 UseCache: boolean): string;
1485 begin
1486 if UseCache then
1487 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitPath,true)
1488 else
1489 Result:=DefineTree.GetUnitPathForDirectory(Directory);
1490 end;
1491
TCodeToolManager.GetIncludePathForDirectorynull1492 function TCodeToolManager.GetIncludePathForDirectory(const Directory: string;
1493 UseCache: boolean): string;
1494 begin
1495 if UseCache then
1496 Result:=DirectoryCachePool.GetString(Directory,ctdcsIncludePath,true)
1497 else
1498 Result:=DefineTree.GetIncludePathForDirectory(Directory);
1499 end;
1500
GetSrcPathForDirectorynull1501 function TCodeToolManager.GetSrcPathForDirectory(const Directory: string;
1502 UseCache: boolean): string;
1503 begin
1504 if UseCache then
1505 Result:=DirectoryCachePool.GetString(Directory,ctdcsSrcPath,true)
1506 else
1507 Result:=DefineTree.GetSrcPathForDirectory(Directory);
1508 end;
1509
TCodeToolManager.GetCompleteSrcPathForDirectorynull1510 function TCodeToolManager.GetCompleteSrcPathForDirectory(
1511 const Directory: string; UseCache: boolean): string;
1512 // returns the SrcPath + UnitPath + any CompiledSrcPath
1513 var
1514 CurUnitPath: String;
1515 StartPos: Integer;
1516 EndPos: LongInt;
1517 CurSrcPath: String;
1518 CurUnitDir: String;
1519 CurCompiledSrcPath: String;
1520 begin
1521 if UseCache then
1522 Result:=DirectoryCachePool.GetString(Directory,ctdcsCompleteSrcPath,true)
1523 else begin
1524 CurUnitPath:='.;'+GetUnitPathForDirectory(Directory);
1525 CurSrcPath:=GetSrcPathForDirectory(Directory);
1526 // for every unit path, get the CompiledSrcPath
1527 StartPos:=1;
1528 while StartPos<=length(CurUnitPath) do begin
1529 EndPos:=StartPos;
1530 while (EndPos<=length(CurUnitPath)) and (CurUnitPath[EndPos]<>';') do
1531 inc(EndPos);
1532 if EndPos>StartPos then begin
1533 CurUnitDir:=TrimFilename(copy(CurUnitPath,StartPos,EndPos-StartPos));
1534 if not FilenameIsAbsolute(CurUnitDir) then
1535 CurUnitDir:=TrimFilename(AppendPathDelim(Directory)+CurUnitDir);
1536 CurCompiledSrcPath:=CreateAbsoluteSearchPath(
1537 GetCompiledSrcPathForDirectory(CurUnitDir),CurUnitDir);
1538 if CurCompiledSrcPath<>'' then
1539 CurSrcPath:=CurSrcPath+';'+CurCompiledSrcPath;
1540 end;
1541 StartPos:=EndPos+1;
1542 end;
1543 // combine unit, src and compiledsrc search path
1544 Result:=CurUnitPath+';'+CurSrcPath;
1545 // make it absolute, so the user need less string concatenations
1546 if FilenameIsAbsolute(Directory) then
1547 Result:=CreateAbsoluteSearchPath(Result,Directory);
1548 // trim the paths, remove doubles and empty paths
1549 Result:=MinimizeSearchPath(Result);
1550 end;
1551 end;
1552
GetPPUSrcPathForDirectorynull1553 function TCodeToolManager.GetPPUSrcPathForDirectory(const Directory: string
1554 ): string;
1555 begin
1556 Result:=DefineTree.GetPPUSrcPathForDirectory(Directory);
1557 end;
1558
TCodeToolManager.GetDCUSrcPathForDirectorynull1559 function TCodeToolManager.GetDCUSrcPathForDirectory(const Directory: string
1560 ): string;
1561 begin
1562 Result:=DefineTree.GetDCUSrcPathForDirectory(Directory);
1563 end;
1564
GetCompiledSrcPathForDirectorynull1565 function TCodeToolManager.GetCompiledSrcPathForDirectory(
1566 const Directory: string; UseCache: boolean): string;
1567 begin
1568 Result:=DefineTree.GetCompiledSrcPathForDirectory(Directory);
1569 end;
1570
TCodeToolManager.GetNestedCommentsFlagForFilenull1571 function TCodeToolManager.GetNestedCommentsFlagForFile(
1572 const Filename: string): boolean;
1573 var
1574 Directory: String;
1575 begin
1576 Result:=false;
1577 Directory:=ExtractFilePath(Filename);
1578 // check pascal compiler is FPC and mode is FPC or OBJFPC
1579 if GetPascalCompilerForDirectory(Directory)<>pcFPC then exit;
1580 if not (GetCompilerModeForDirectory(Directory) in [cmFPC,cmOBJFPC]) then exit;
1581 Result:=true;
1582 end;
1583
TCodeToolManager.GetPascalCompilerForDirectorynull1584 function TCodeToolManager.GetPascalCompilerForDirectory(const Directory: string
1585 ): TPascalCompiler;
1586 var
1587 Evaluator: TExpressionEvaluator;
1588 begin
1589 Result:=pcFPC;
1590 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1591 if Evaluator=nil then exit;
1592 Result:=TLinkScanner.GetPascalCompiler(Evaluator);
1593 end;
1594
GetCompilerModeForDirectorynull1595 function TCodeToolManager.GetCompilerModeForDirectory(const Directory: string
1596 ): TCompilerMode;
1597 var
1598 Evaluator: TExpressionEvaluator;
1599 cm: TCompilerMode;
1600 begin
1601 Result:=cmFPC;
1602 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1603 if Evaluator=nil then exit;
1604 for cm:=Succ(Low(TCompilerMode)) to High(TCompilerMode) do
1605 if Evaluator.IsDefined(CompilerModeVars[cm]) then
1606 Result:=cm;
1607 end;
1608
GetCompiledSrcExtForDirectorynull1609 function TCodeToolManager.GetCompiledSrcExtForDirectory(const Directory: string
1610 ): string;
1611 begin
1612 Result:='.ppu';
1613 end;
1614
FindUnitInUnitLinksnull1615 function TCodeToolManager.FindUnitInUnitLinks(const Directory, AUnitName: string
1616 ): string;
1617 begin
1618 Result:=DirectoryCachePool.FindUnitInUnitLinks(Directory,AUnitName);
1619 end;
1620
TCodeToolManager.GetUnitLinksForDirectorynull1621 function TCodeToolManager.GetUnitLinksForDirectory(const Directory: string;
1622 UseCache: boolean): string;
1623 var
1624 Evaluator: TExpressionEvaluator;
1625 begin
1626 if UseCache then begin
1627 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitLinks,true)
1628 end else begin
1629 Result:='';
1630 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1631 if Evaluator=nil then exit;
1632 Result:=Evaluator[UnitLinksMacroName];
1633 end;
1634 end;
1635
TCodeToolManager.FindUnitInUnitSetnull1636 function TCodeToolManager.FindUnitInUnitSet(const Directory, AUnitName: string
1637 ): string;
1638 begin
1639 Result:=DirectoryCachePool.FindUnitInUnitSet(Directory,AUnitName);
1640 end;
1641
GetUnitSetIDForDirectorynull1642 function TCodeToolManager.GetUnitSetIDForDirectory(const Directory: string;
1643 UseCache: boolean): string;
1644 var
1645 Evaluator: TExpressionEvaluator;
1646 begin
1647 if UseCache then begin
1648 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitSet,true)
1649 end else begin
1650 Result:='';
1651 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1652 if Evaluator=nil then exit;
1653 Result:=Evaluator[UnitSetMacroName];
1654 end;
1655 end;
1656
TCodeToolManager.GetUnitSetForDirectorynull1657 function TCodeToolManager.GetUnitSetForDirectory(const Directory: string
1658 ): TFPCUnitSetCache;
1659 var
1660 ID: String;
1661 Changed: boolean;
1662 begin
1663 Result:=nil;
1664 ID:=GetUnitSetIDForDirectory(Directory,true);
1665 if ID='' then exit;
1666 Changed:=false;
1667 Result:=CompilerDefinesCache.FindUnitSetWithID(ID,Changed,false);
1668 if Changed then Result:=nil;
1669 end;
1670
GetFPCUnitPathForDirectorynull1671 function TCodeToolManager.GetFPCUnitPathForDirectory(const Directory: string;
1672 UseCache: boolean): string;
1673 var
1674 Evaluator: TExpressionEvaluator;
1675 begin
1676 if UseCache then begin
1677 Result:=DirectoryCachePool.GetString(Directory,ctdcsFPCUnitPath,true)
1678 end else begin
1679 Result:='';
1680 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1681 if Evaluator=nil then exit;
1682 Result:=Evaluator[FPCUnitPathMacroName];
1683 end;
1684 end;
1685
1686 procedure TCodeToolManager.GetFPCVersionForDirectory(const Directory: string;
1687 out FPCVersion, FPCRelease, FPCPatch: integer);
1688 var
1689 Evaluator: TExpressionEvaluator;
1690 FPCFullVersion: LongInt;
1691 begin
1692 FPCVersion:=0;
1693 FPCRelease:=0;
1694 FPCPatch:=0;
1695 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1696 if Evaluator=nil then exit;
1697 FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0);
1698 FPCVersion:=FPCFullVersion div 10000;
1699 FPCRelease:=(FPCFullVersion div 100) mod 100;
1700 FPCPatch:=FPCFullVersion mod 100;
1701 end;
1702
GetPCVersionForDirectorynull1703 function TCodeToolManager.GetPCVersionForDirectory(const Directory: string
1704 ): integer;
1705 var
1706 Kind: TPascalCompiler;
1707 begin
1708 Result:=GetPCVersionForDirectory(Directory,Kind);
1709 if Kind=pcFPC then ;
1710 end;
1711
GetPCVersionForDirectorynull1712 function TCodeToolManager.GetPCVersionForDirectory(const Directory: string; out
1713 Kind: TPascalCompiler): integer;
1714 var
1715 Evaluator: TExpressionEvaluator;
1716 s: String;
1717 begin
1718 Result:=0;
1719 Kind:=pcFPC;
1720 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1721 if Evaluator=nil then
1722 exit;
1723 s:=Evaluator['FPC_FULLVERSION'];
1724 if s<>'' then
1725 exit(StrToIntDef(s,0));
1726 s:=Evaluator['PAS2JS_FULLVERSION'];
1727 if s<>'' then begin
1728 Kind:=pcPas2js;
1729 exit(StrToIntDef(s,0));
1730 end;
1731 end;
1732
TCodeToolManager.GetNamespacesForDirectorynull1733 function TCodeToolManager.GetNamespacesForDirectory(const Directory: string;
1734 UseCache: boolean): string;
1735 var
1736 Evaluator: TExpressionEvaluator;
1737 FPCFullVersion: LongInt;
1738 UnitSet: TFPCUnitSetCache;
1739 begin
1740 if UseCache then begin
1741 Result:=DirectoryCachePool.GetString(Directory,ctdcsNamespaces,true)
1742 end else begin
1743 Result:='';
1744 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1745 if Evaluator=nil then exit;
1746 if Evaluator.IsDefined('PAS2JS') then
1747 Result:=Evaluator[NamespacesMacroName]
1748 else begin
1749 FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0);
1750 if FPCFullVersion>=30101 then
1751 Result:=Evaluator[NamespacesMacroName];
1752 end;
1753 // add default unit scopes from compiler cfg
1754 UnitSet:=GetUnitSetForDirectory(Directory);
1755 if UnitSet<>nil then
1756 Result:=MergeWithDelimiter(Result,UnitSet.GetUnitScopes,';');
1757 end;
1758 end;
1759
1760 procedure TCodeToolManager.FreeListOfPCodeXYPosition(var List: TFPList);
1761 begin
1762 CodeCache.FreeListOfPCodeXYPosition(List);
1763 List:=nil;
1764 end;
1765
1766 procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
1767 begin
1768 CodeCache.FreeTreeOfPCodeXYPosition(Tree);
1769 Tree:=nil;
1770 end;
1771
CreateTreeOfPCodeXYPositionnull1772 function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree;
1773 begin
1774 Result:=CodeCache.CreateTreeOfPCodeXYPosition;
1775 end;
1776
1777 procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
1778 DestTree: TAVLTree; ClearList, CreateCopies: boolean);
1779 begin
1780 CodeCache.AddListToTreeOfPCodeXYPosition(SrcList,DestTree,ClearList,CreateCopies);
1781 end;
1782
Explorenull1783 function TCodeToolManager.Explore(Code: TCodeBuffer;
1784 out ACodeTool: TCodeTool; WithStatements: boolean; OnlyInterface: boolean
1785 ): boolean;
1786 begin
1787 Result:=false;
1788 ACodeTool:=nil;
1789 try
1790 if InitCurCodeTool(Code) then begin
1791 ACodeTool:=FCurCodeTool;
1792 FCurCodeTool.Explore(WithStatements,OnlyInterface);
1793 Result:=true;
1794 end;
1795 except
1796 on e: Exception do Result:=HandleException(e);
1797 end;
1798 end;
1799
InitCurCodeToolnull1800 function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
1801 var MainCode: TCodeBuffer;
1802 begin
1803 Result:=false;
1804 ClearCurCodeTool;
1805 MainCode:=GetMainCode(Code);
1806 if MainCode=nil then begin
1807 ClearError;
1808 FErrorLine:=1;
1809 FErrorColumn:=1;
1810 fErrorCode:=Code;
1811 if Code = nil then
1812 begin
1813 fErrorMsg:='TCodeToolManager.InitCurCodeTool Code=nil'
1814 end
1815 else begin
1816 fErrorMsg:='unit of include file is not known (hint: open and explore unit first)';
1817 end;
1818 exit;
1819 end;
1820 if MainCode.Scanner=nil then begin
1821 FErrorMsg:=Format(ctsNoScannerFound,[MainCode.Filename]);
1822 exit;
1823 end;
1824 FCurCodeTool:=TCodeTool(GetCodeToolForSource(MainCode,false,true));
1825 FCurCodeTool.ErrorPosition.Code:=nil;
1826 {$IFDEF CTDEBUG}
1827 DebugLn('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
1828 {$ENDIF}
1829 Result:=(FCurCodeTool.Scanner<>nil);
1830 if not Result then begin
1831 fErrorCode:=MainCode;
1832 fErrorMsg:=ctsNoScannerAvailable;
1833 end;
1834 end;
1835
TCodeToolManager.InitResourceToolnull1836 function TCodeToolManager.InitResourceTool: boolean;
1837 begin
1838 ClearError;
1839 Result:=true;
1840 end;
1841
1842 procedure TCodeToolManager.ClearPositions;
1843 begin
1844 if Positions=nil then
1845 Positions:=TCodeXYPositions.Create
1846 else
1847 Positions.Clear;
1848 end;
1849
HandleExceptionnull1850 function TCodeToolManager.HandleException(AnException: Exception): boolean;
1851 var
1852 ErrorSrcTool: TCustomCodeTool;
1853 DirtyPos: Integer;
1854 ErrorDirTool: TCompilerDirectivesTree;
1855 begin
1856 ClearError;
1857 fErrorMsg:=AnException.Message;
1858 if (AnException is ELinkScannerError) then begin
1859 // link scanner error
1860 FErrorId:=ELinkScannerError(AnException).Id;
1861 if AnException is ELinkScannerConsistency then
1862 DumpExceptionBackTrace;
1863 DirtyPos:=0;
1864 if AnException is ELinkScannerEditError then begin
1865 fErrorCode:=TCodeBuffer(ELinkScannerEditError(AnException).Buffer);
1866 if fErrorCode<>nil then
1867 DirtyPos:=ELinkScannerEditError(AnException).BufferPos;
1868 end else begin
1869 fErrorCode:=TCodeBuffer(ELinkScannerError(AnException).Sender.Code);
1870 DirtyPos:=ELinkScannerError(AnException).Sender.SrcPos;
1871 end;
1872 if (fErrorCode<>nil) and (DirtyPos>0) then begin
1873 fErrorCode.AbsoluteToLineCol(DirtyPos,fErrorLine,fErrorColumn);
1874 end;
1875 end else if (AnException is ECodeToolError) then begin
1876 // codetool error
1877 ErrorSrcTool:=ECodeToolError(AnException).Sender;
1878 FErrorId:=ECodeToolError(AnException).Id;
1879 if ErrorSrcTool.ErrorNicePosition.Code<>nil then begin
1880 fErrorCode:=ErrorSrcTool.ErrorNicePosition.Code;
1881 fErrorColumn:=ErrorSrcTool.ErrorNicePosition.X;
1882 fErrorLine:=ErrorSrcTool.ErrorNicePosition.Y;
1883 end else begin
1884 fErrorCode:=ErrorSrcTool.ErrorPosition.Code;
1885 fErrorColumn:=ErrorSrcTool.ErrorPosition.X;
1886 fErrorLine:=ErrorSrcTool.ErrorPosition.Y;
1887 end;
1888 end else if (AnException is ECDirectiveParserException) then begin
1889 // Compiler directive parser error
1890 FErrorId:=ECDirectiveParserException(AnException).Id;
1891 ErrorDirTool:=ECDirectiveParserException(AnException).Sender;
1892 fErrorCode:=ErrorDirTool.Code;
1893 end else if (AnException is ESourceChangeCacheError) then begin
1894 // SourceChangeCache error
1895 FErrorId:=ESourceChangeCacheError(AnException).Id;
1896 end else if (AnException is ECodeToolManagerError) then begin
1897 // CodeToolManager error
1898 FErrorId:=ECodeToolManagerError(AnException).Id;
1899 end else begin
1900 // unknown exception
1901 DumpExceptionBackTrace;
1902 FErrorMsg:=AnException.ClassName+': '+FErrorMsg;
1903 if FCurCodeTool<>nil then begin
1904 fErrorCode:=FCurCodeTool.ErrorPosition.Code;
1905 fErrorColumn:=FCurCodeTool.ErrorPosition.X;
1906 fErrorLine:=FCurCodeTool.ErrorPosition.Y;
1907 end;
1908 FErrorId:=20170421202914;
1909 end;
1910
1911 SourceChangeCache.Clear;
1912
1913 // adjust error topline
1914 AdjustErrorTopLine;
1915 // write error
1916 WriteError;
1917 // raise or catch
1918 if not FCatchExceptions then raise AnException;
1919 Result:=false;
1920 end;
1921
1922 procedure TCodeToolManager.AdjustErrorTopLine;
1923 begin
1924 // adjust error topline
1925 if (fErrorCode<>nil) and (fErrorTopLine<1) then begin
1926 fErrorTopLine:=fErrorLine;
1927 if (fErrorTopLine>0) and (JumpSingleLinePos>0) then begin
1928 dec(fErrorTopLine,VisibleEditorLines*JumpSingleLinePos div 100);
1929 if fErrorTopLine<1 then fErrorTopLine:=1;
1930 end;
1931 end;
1932 end;
1933
1934 procedure TCodeToolManager.WriteError;
1935 begin
1936 if FWriteExceptions then begin
1937 FErrorDbgMsg:='### TCodeToolManager.HandleException: ['+IntToStr(FErrorId)+'] "'+ErrorMessage+'"';
1938 if ErrorLine>0 then FErrorDbgMsg+=' at Line='+DbgS(ErrorLine);
1939 if ErrorColumn>0 then FErrorDbgMsg+=' Col='+DbgS(ErrorColumn);
1940 if ErrorCode<>nil then FErrorDbgMsg+=' in "'+ErrorCode.Filename+'"';
1941 Debugln(FErrorDbgMsg);
1942 {$IFDEF CTDEBUG}
1943 WriteDebugReport(true,false,false,false,false,false);
1944 {$ENDIF}
1945 end;
1946 end;
1947
TCodeToolManager.CheckSyntaxnull1948 function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
1949 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
1950 out ErrorMsg: string): boolean;
1951 // returns true on syntax correct
1952 var
1953 ACodeTool: TCodeTool;
1954 begin
1955 Result:=Explore(Code,ACodeTool,true);
1956 if ACodeTool=nil then ;
1957 NewCode:=ErrorCode;
1958 NewX:=ErrorColumn;
1959 NewY:=ErrorLine;
1960 NewTopLine:=ErrorTopLine;
1961 ErrorMsg:=ErrorMessage;
1962 end;
1963
ExploreDirectivesnull1964 function TCodeToolManager.ExploreDirectives(Code: TCodeBuffer; out
1965 ADirectivesTool: TDirectivesTool): boolean;
1966 begin
1967 Result:=false;
1968 ADirectivesTool:=nil;
1969 try
1970 if InitCurDirectivesTool(Code) then begin
1971 ADirectivesTool:=FCurDirectivesTool;
1972 FCurDirectivesTool.Parse;
1973 Result:=true;
1974 end;
1975 except
1976 on e: Exception do Result:=HandleException(e);
1977 end;
1978 end;
1979
ExploreUnitDirectivesnull1980 function TCodeToolManager.ExploreUnitDirectives(Code: TCodeBuffer; out
1981 aScanner: TLinkScanner): boolean;
1982 begin
1983 Result:=false;
1984 if not InitCurCodeTool(Code) then exit;
1985 {$IFDEF CTDEBUG}
1986 DebugLn('TCodeToolManager.ExploreUnitDirectives A ',dbgs(FCurCodeTool.Scanner<>nil));
1987 {$ENDIF}
1988 try
1989 aScanner:=FCurCodeTool.Scanner;
1990 if not aScanner.StoreDirectives then
1991 aScanner.DemandStoreDirectives;
1992 aScanner.Scan(lsrEnd,true);
1993 Result:=true;
1994 except
1995 on e: Exception do Result:=HandleException(e);
1996 end;
1997 {$IFDEF CTDEBUG}
1998 DebugLn('TCodeToolManager.ExploreUnitDirectives END ');
1999 {$ENDIF}
2000 end;
2001
TCodeToolManager.JumpToMethodnull2002 function TCodeToolManager.JumpToMethod(Code: TCodeBuffer; X, Y: integer; out
2003 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
2004 BlockBottomLine: integer; out RevertableJump: boolean): boolean;
2005 var
2006 CursorPos: TCodeXYPosition;
2007 NewPos: TCodeXYPosition;
2008 begin
2009 Result:=false;
2010 {$IFDEF CTDEBUG}
2011 DebugLn('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2012 {$ENDIF}
2013 if not InitCurCodeTool(Code) then exit;
2014 CursorPos.X:=X;
2015 CursorPos.Y:=Y;
2016 CursorPos.Code:=Code;
2017 {$IFDEF CTDEBUG}
2018 DebugLn('TCodeToolManager.JumpToMethod B ',dbgs(FCurCodeTool.Scanner<>nil));
2019 {$ENDIF}
2020 try
2021 Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine,
2022 BlockTopLine,BlockBottomLine,RevertableJump);
2023 if Result then begin
2024 NewX:=NewPos.X;
2025 NewY:=NewPos.Y;
2026 NewCode:=NewPos.Code;
2027 end;
2028 except
2029 on e: Exception do Result:=HandleException(e);
2030 end;
2031 {$IFDEF CTDEBUG}
2032 DebugLn('TCodeToolManager.JumpToMethod END ');
2033 {$ENDIF}
2034 end;
2035
FindProcDeclarationnull2036 function TCodeToolManager.FindProcDeclaration(Code: TCodeBuffer;
2037 CleanDef: string; out Tool: TCodeTool; out Node: TCodeTreeNode;
2038 Attr: TProcHeadAttributes): boolean;
2039 var
2040 Paths: TStringList;
2041 begin
2042 Result:=false;
2043 {$IFDEF CTDEBUG}
2044 DebugLn(['TCodeToolManager.FindProcDeclaration A ',Code.Filename,' CleanDef=',CleanDef]);
2045 {$ENDIF}
2046 Tool:=nil;
2047 Node:=nil;
2048 if not InitCurCodeTool(Code) then exit;
2049 Tool:=FCurCodeTool;
2050 Paths:=TStringList.Create;
2051 try
2052 Paths.Add(CleanDef);
2053 try
2054 FCurCodeTool.BuildTree(lsrInitializationStart);
2055 Node:=FCurCodeTool.FindSubProcPath(Paths,Attr,false);
2056 Result:=Node<>nil;
2057 except
2058 on e: Exception do Result:=HandleException(e);
2059 end;
2060 finally
2061 Paths.Free;
2062 end;
2063 {$IFDEF CTDEBUG}
2064 DebugLn('TCodeToolManager.FindProcDeclaration END ');
2065 {$ENDIF}
2066 end;
2067
FindDeclarationnull2068 function TCodeToolManager.FindDeclaration(Code: TCodeBuffer; X, Y: integer; out
2069 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
2070 BlockBottomLine: integer; Flags: TFindSmartFlags): boolean;
2071 var
2072 CursorPos: TCodeXYPosition;
2073 NewPos: TCodeXYPosition;
2074 NewTool: TFindDeclarationTool;
2075 NewNode: TCodeTreeNode;
2076 begin
2077 Result:=false;
2078 {$IFDEF CTDEBUG}
2079 DebugLn(['TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y]);
2080 {$ENDIF}
2081 if not InitCurCodeTool(Code) then begin
2082 {$IFDEF VerboseFindDeclarationFail}
2083 debugln(['TCodeToolManager.FindDeclaration InitCurCodeTool failed']);
2084 {$ENDIF}
2085 exit;
2086 end;
2087 CursorPos.X:=X;
2088 CursorPos.Y:=Y;
2089 CursorPos.Code:=Code;
2090 {$IFDEF CTDEBUG}
2091 DebugLn('TCodeToolManager.FindDeclaration B ',dbgs(FCurCodeTool.Scanner<>nil));
2092 {$ENDIF}
2093 try
2094 {$IFDEF DoNotHandleFindDeclException}
2095 DebugLn('TCodeToolManager.FindDeclaration NOT HANDLING EXCEPTIONS');
2096 RaiseUnhandableExceptions:=true;
2097 {$ENDIF}
2098 Result:=FCurCodeTool.FindDeclaration(CursorPos,Flags,NewTool,NewNode,
2099 NewPos,NewTopLine,BlockTopLine,BlockBottomLine);
2100 if Result then begin
2101 NewX:=NewPos.X;
2102 NewY:=NewPos.Y;
2103 NewCode:=NewPos.Code;
2104 if (NewTool=nil) and (NewNode<>nil) then ;
2105 {$IFDEF CTDEBUG}
2106 debugln(['TCodeToolManager.FindDeclaration ',Dbgs(NewPos)]);
2107 {$ENDIF}
2108 end;
2109 {$IFDEF DoNotHandleFindDeclException}
2110 finally
2111 RaiseUnhandableExceptions:=false;
2112 end;
2113 {$ELSE}
2114 except
2115 on e: Exception do begin
2116 Result:=HandleException(e);
2117 {$IFDEF VerboseFindDeclarationFail}
2118 if not Result then
2119 debugln(['TCodeToolManager.FindDeclaration Exception=',e.Message]);
2120 {$ENDIF}
2121 end;
2122 end;
2123 {$ENDIF}
2124 {$IFDEF VerboseFindDeclarationFail}
2125 if not Result then begin
2126 debugln(['TCodeToolManager.FindDeclaration FAILED at ',dbgs(CursorPos)]);
2127 end;
2128 {$ENDIF}
2129 {$IFDEF CTDEBUG}
2130 DebugLn('TCodeToolManager.FindDeclaration END ');
2131 {$ENDIF}
2132 end;
2133
FindDeclarationOfIdentifiernull2134 function TCodeToolManager.FindDeclarationOfIdentifier(Code: TCodeBuffer;
2135 X,Y: integer; Identifier: PChar; out NewCode: TCodeBuffer; out NewX, NewY,
2136 NewTopLine: integer): boolean;
2137 var
2138 CursorPos: TCodeXYPosition;
2139 NewPos: TCodeXYPosition;
2140 begin
2141 Result:=false;
2142 {$IFDEF CTDEBUG}
2143 DebugLn(['TCodeToolManager.FindDeclarationOfIdentifier A ',Code.Filename,' x=',x,' y=',y,' Identifier=',GetIdentifier(Identifier)]);
2144 {$ENDIF}
2145 if not InitCurCodeTool(Code) then exit;
2146 CursorPos.X:=X;
2147 CursorPos.Y:=Y;
2148 CursorPos.Code:=Code;
2149 {$IFDEF CTDEBUG}
2150 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier B ',dbgs(FCurCodeTool.Scanner<>nil));
2151 {$ENDIF}
2152 try
2153 {$IFDEF DoNotHandleFindDeclException}
2154 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier NOT HANDLING EXCEPTIONS');
2155 RaiseUnhandableExceptions:=true;
2156 {$ENDIF}
2157 Result:=FCurCodeTool.FindDeclarationOfIdentifier(CursorPos,Identifier,NewPos,NewTopLine);
2158 if Result then begin
2159 NewX:=NewPos.X;
2160 NewY:=NewPos.Y;
2161 NewCode:=NewPos.Code;
2162 end;
2163 {$IFDEF DoNotHandleFindDeclException}
2164 finally
2165 RaiseUnhandableExceptions:=false;
2166 end;
2167 {$ELSE}
2168 except
2169 on e: Exception do Result:=HandleException(e);
2170 end;
2171 {$ENDIF}
2172 {$IFDEF CTDEBUG}
2173 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier END ');
2174 {$ENDIF}
2175 end;
2176
FindSmartHintnull2177 function TCodeToolManager.FindSmartHint(Code: TCodeBuffer; X, Y: integer;
2178 Flags: TFindSmartFlags): string;
2179 var
2180 CursorPos: TCodeXYPosition;
2181 begin
2182 Result:='';
2183 {$IFDEF CTDEBUG}
2184 DebugLn('TCodeToolManager.FindSmartHint A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2185 {$ENDIF}
2186 if not InitCurCodeTool(Code) then exit;
2187 CursorPos.X:=X;
2188 CursorPos.Y:=Y;
2189 CursorPos.Code:=Code;
2190 {$IFDEF CTDEBUG}
2191 DebugLn('TCodeToolManager.FindSmartHint B ',dbgs(FCurCodeTool.Scanner<>nil));
2192 {$ENDIF}
2193 try
2194 Result:=FCurCodeTool.FindSmartHint(CursorPos,Flags);
2195 except
2196 on e: Exception do HandleException(e);
2197 end;
2198 {$IFDEF CTDEBUG}
2199 DebugLn('TCodeToolManager.FindSmartHint END ');
2200 {$ENDIF}
2201 end;
2202
FindDeclarationInInterfacenull2203 function TCodeToolManager.FindDeclarationInInterface(Code: TCodeBuffer;
2204 const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY,
2205 NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
2206 var
2207 NewPos: TCodeXYPosition;
2208 begin
2209 Result:=false;
2210 {$IFDEF CTDEBUG}
2211 DebugLn('TCodeToolManager.FindDeclarationInInterface A ',Code.Filename,' Identifier=',Identifier);
2212 {$ENDIF}
2213 if not InitCurCodeTool(Code) then exit;
2214 {$IFDEF CTDEBUG}
2215 DebugLn('TCodeToolManager.FindDeclarationInInterface B ',dbgs(FCurCodeTool.Scanner<>nil));
2216 {$ENDIF}
2217 try
2218 Result:=FCurCodeTool.FindDeclarationInInterface(Identifier,NewPos,
2219 NewTopLine,BlockTopLine,BlockBottomLine);
2220 if Result then begin
2221 NewX:=NewPos.X;
2222 NewY:=NewPos.Y;
2223 NewCode:=NewPos.Code;
2224 end;
2225 except
2226 on e: Exception do HandleException(e);
2227 end;
2228 {$IFDEF CTDEBUG}
2229 DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
2230 {$ENDIF}
2231 end;
2232
FindDeclarationInInterfacenull2233 function TCodeToolManager.FindDeclarationInInterface(Code: TCodeBuffer;
2234 const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY,
2235 NewTopLine: integer): boolean;
2236 var
2237 BlockTopLine, BlockBottomLine: integer;
2238 begin
2239 Result := FindDeclarationInInterface(Code, Identifier, NewCode, NewX, NewY, NewTopLine,
2240 BlockTopLine, BlockBottomLine);
2241 end;
2242
TCodeToolManager.FindDeclarationWithMainUsesSectionnull2243 function TCodeToolManager.FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
2244 const Identifier: string; out NewCode: TCodeBuffer;
2245 out NewX, NewY, NewTopLine: integer): Boolean;
2246 var
2247 NewPos: TCodeXYPosition;
2248 begin
2249 Result:=false;
2250 {$IFDEF CTDEBUG}
2251 DebugLn('TCodeToolManager.FindDeclarationWithMainUsesSection A ',Code.Filename,' Identifier=',Identifier);
2252 {$ENDIF}
2253 if not InitCurCodeTool(Code) then exit;
2254 try
2255 Result:=FCurCodeTool.FindDeclarationWithMainUsesSection(Identifier,NewPos,
2256 NewTopLine);
2257 if Result then begin
2258 NewX:=NewPos.X;
2259 NewY:=NewPos.Y;
2260 NewCode:=NewPos.Code;
2261 end;
2262 except
2263 on e: Exception do HandleException(e);
2264 end;
2265 {$IFDEF CTDEBUG}
2266 DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
2267 {$ENDIF}
2268 end;
2269
FindDeclarationAndOverloadnull2270 function TCodeToolManager.FindDeclarationAndOverload(Code: TCodeBuffer; X,
2271 Y: integer; out ListOfPCodeXYPosition: TFPList;
2272 Flags: TFindDeclarationListFlags): boolean;
2273 var
2274 CursorPos: TCodeXYPosition;
2275 begin
2276 Result:=false;
2277 {$IFDEF CTDEBUG}
2278 DebugLn('TCodeToolManager.FindDeclarationAndOverload A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2279 {$ENDIF}
2280 ListOfPCodeXYPosition:=nil;
2281 if not InitCurCodeTool(Code) then exit;
2282 CursorPos.X:=X;
2283 CursorPos.Y:=Y;
2284 CursorPos.Code:=Code;
2285 {$IFDEF CTDEBUG}
2286 DebugLn('TCodeToolManager.FindDeclarationAndOverload B ',dbgs(FCurCodeTool.Scanner<>nil));
2287 {$ENDIF}
2288 try
2289 Result:=FCurCodeTool.FindDeclarationAndOverload(CursorPos,
2290 ListOfPCodeXYPosition,Flags);
2291 except
2292 on e: Exception do Result:=HandleException(e);
2293 end;
2294 {$IFDEF CTDEBUG}
2295 DebugLn('TCodeToolManager.FindDeclarationAndOverload END ');
2296 {$ENDIF}
2297 end;
2298
TCodeToolManager.FindMainDeclarationnull2299 function TCodeToolManager.FindMainDeclaration(Code: TCodeBuffer; X, Y: integer;
2300 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
2301 var
2302 CursorPos: TCodeXYPosition;
2303 NewPos: TCodeXYPosition;
2304 begin
2305 Result:=false;
2306 {$IFDEF CTDEBUG}
2307 DebugLn('TCodeToolManager.FindMainDeclaration A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2308 {$ENDIF}
2309 if not InitCurCodeTool(Code) then exit;
2310 CursorPos.X:=X;
2311 CursorPos.Y:=Y;
2312 CursorPos.Code:=Code;
2313 try
2314 Result:=FCurCodeTool.FindMainDeclaration(CursorPos,NewPos,NewTopLine);
2315 if Result then begin
2316 NewX:=NewPos.X;
2317 NewY:=NewPos.Y;
2318 NewCode:=NewPos.Code;
2319 end;
2320 except
2321 on e: Exception do Result:=HandleException(e);
2322 end;
2323 {$IFDEF CTDEBUG}
2324 DebugLn('TCodeToolManager.FindMainDeclaration END ');
2325 {$ENDIF}
2326 end;
2327
FindDeclarationOfPropertyPathnull2328 function TCodeToolManager.FindDeclarationOfPropertyPath(Code: TCodeBuffer;
2329 const PropertyPath: string; out NewCode: TCodeBuffer; out NewX, NewY,
2330 NewTopLine: integer): Boolean;
2331 var
2332 NewPos: TCodeXYPosition;
2333 begin
2334 Result:=false;
2335 {$IFDEF CTDEBUG}
2336 DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath A ',Code.Filename,' Path="',PropertyPath,'"');
2337 {$ENDIF}
2338 if not InitCurCodeTool(Code) then exit;
2339 try
2340 Result:=FCurCodeTool.FindDeclarationOfPropertyPath(PropertyPath,
2341 NewPos,NewTopLine);
2342 if Result then begin
2343 NewX:=NewPos.X;
2344 NewY:=NewPos.Y;
2345 NewCode:=NewPos.Code;
2346 end;
2347 except
2348 on e: Exception do Result:=HandleException(e);
2349 end;
2350 {$IFDEF CTDEBUG}
2351 DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath END ');
2352 {$ENDIF}
2353 end;
2354
TCodeToolManager.FindFileAtCursornull2355 function TCodeToolManager.FindFileAtCursor(Code: TCodeBuffer; X, Y: integer;
2356 out Found: TFindFileAtCursorFlag; out FoundFilename: string;
2357 Allowed: TFindFileAtCursorFlags; StartPos: PCodeXYPosition): boolean;
2358 var
2359 CursorPos: TCodeXYPosition;
2360 begin
2361 Result:=false;
2362 {$IFDEF CTDEBUG}
2363 DebugLn('TCodeToolManager.FindFileAtCursor A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2364 {$ENDIF}
2365 if not InitCurCodeTool(Code) then exit;
2366 CursorPos.X:=X;
2367 CursorPos.Y:=Y;
2368 CursorPos.Code:=Code;
2369 try
2370 Result:=FCurCodeTool.FindFileAtCursor(CursorPos,Found,FoundFilename,
2371 Allowed,StartPos);
2372 except
2373 on e: Exception do HandleException(e);
2374 end;
2375 {$IFDEF CTDEBUG}
2376 DebugLn('TCodeToolManager.FindFileAtCursor END ');
2377 {$ENDIF}
2378 end;
2379
FindCodeContextnull2380 function TCodeToolManager.FindCodeContext(Code: TCodeBuffer; X, Y: integer; out
2381 CodeContexts: TCodeContextInfo): boolean;
2382 var
2383 CursorPos: TCodeXYPosition;
2384 begin
2385 Result:=false;
2386 CodeContexts:=nil;
2387 {$IFDEF CTDEBUG}
2388 DebugLn('TCodeToolManager.FindCodeContext A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2389 {$ENDIF}
2390 if not InitCurCodeTool(Code) then exit;
2391 CursorPos.X:=X;
2392 CursorPos.Y:=Y;
2393 CursorPos.Code:=Code;
2394 try
2395 Result:=FCurCodeTool.FindCodeContext(CursorPos,CodeContexts);
2396 except
2397 on e: Exception do HandleException(e);
2398 end;
2399 {$IFDEF CTDEBUG}
2400 DebugLn('TCodeToolManager.FindCodeContext END ');
2401 {$ENDIF}
2402 end;
2403
TCodeToolManager.ExtractProcedureHeadernull2404 function TCodeToolManager.ExtractProcedureHeader(Code: TCodeBuffer; X,
2405 Y: integer; Attributes: TProcHeadAttributes; out ProcHead: string): boolean;
2406 var
2407 CursorPos: TCodeXYPosition;
2408 begin
2409 Result:=false;
2410 {$IFDEF CTDEBUG}
2411 DebugLn('TCodeToolManager.ExtractProcedureHeader A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2412 {$ENDIF}
2413 if not InitCurCodeTool(Code) then exit;
2414 CursorPos.X:=X;
2415 CursorPos.Y:=Y;
2416 CursorPos.Code:=Code;
2417 try
2418 Result:=FCurCodeTool.ExtractProcedureHeader(CursorPos,Attributes,ProcHead);
2419 except
2420 on e: Exception do HandleException(e);
2421 end;
2422 {$IFDEF CTDEBUG}
2423 DebugLn('TCodeToolManager.ExtractProcedureHeader END ');
2424 {$ENDIF}
2425 end;
2426
HasInterfaceRegisterProcnull2427 function TCodeToolManager.HasInterfaceRegisterProc(Code: TCodeBuffer;
2428 out HasRegisterProc: boolean): boolean;
2429 begin
2430 Result:=false;
2431 HasRegisterProc:=false;
2432 {$IFDEF CTDEBUG}
2433 DebugLn('TCodeToolManager.HasInterfaceRegisterProc A ',Code.Filename);
2434 {$ENDIF}
2435 if not InitCurCodeTool(Code) then exit;
2436 try
2437 Result:=FCurCodeTool.HasInterfaceRegisterProc(HasRegisterProc);
2438 except
2439 on e: Exception do Result:=HandleException(e);
2440 end;
2441 end;
2442
GatherUnitNamesnull2443 function TCodeToolManager.GatherUnitNames(Code: TCodeBuffer): Boolean;
2444 var
2445 CursorPos: TCodeXYPosition;
2446 begin
2447 Result := False;
2448 if not InitCurCodeTool(Code) then exit;
2449 if IdentifierList<>nil then IdentifierList.Clear;
2450 CursorPos.X := 0;
2451 CursorPos.Y := 0;
2452 CursorPos.Code := Code;
2453 try
2454 Result := FCurCodeTool.GatherAvailableUnitNames(CursorPos, IdentifierList);
2455 except
2456 on e: Exception do HandleException(e);
2457 end;
2458 end;
2459
GetApplicationScaledStatementnull2460 function TCodeToolManager.GetApplicationScaledStatement(Code: TCodeBuffer;
2461 var AScaled: Boolean): boolean;
2462 var
2463 StartPos, BooleanConstStartPos, EndPos: integer;
2464 begin
2465 Result:=false;
2466 {$IFDEF CTDEBUG}
2467 DebugLn('TCodeToolManager.GetApplicationScaledStatement A ',Code.Filename);
2468 {$ENDIF}
2469 if not InitCurCodeTool(Code) then exit;
2470 try
2471 Result:=FCurCodeTool.FindApplicationScaledStatement(StartPos,
2472 BooleanConstStartPos,EndPos);
2473
2474 Result:=FCurCodeTool.GetApplicationScaledStatement(BooleanConstStartPos,
2475 EndPos,AScaled);
2476 except
2477 on e: Exception do Result:=HandleException(e);
2478 end;
2479 end;
2480
GatherIdentifiersnull2481 function TCodeToolManager.GatherIdentifiers(Code: TCodeBuffer; X, Y: integer
2482 ): boolean;
2483 var
2484 CursorPos: TCodeXYPosition;
2485 begin
2486 Result:=false;
2487 {$IFDEF CTDEBUG}
2488 DebugLn('TCodeToolManager.GatherIdentifiers A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2489 {$ENDIF}
2490 if not InitCurCodeTool(Code) then exit;
2491 if IdentifierList<>nil then IdentifierList.Clear;
2492 CursorPos.X:=X;
2493 CursorPos.Y:=Y;
2494 CursorPos.Code:=Code;
2495 {$IFDEF CTDEBUG}
2496 DebugLn('TCodeToolManager.GatherIdentifiers B ',dbgs(FCurCodeTool.Scanner<>nil));
2497 {$ENDIF}
2498 try
2499 FIdentifierListUpdating:=true;
2500 try
2501 Result:=FCurCodeTool.GatherIdentifiers(CursorPos,IdentifierList);
2502 finally
2503 FIdentifierListUpdating:=false;
2504 end;
2505 except
2506 on e: Exception do HandleException(e);
2507 end;
2508 {$IFDEF CTDEBUG}
2509 DebugLn('TCodeToolManager.GatherIdentifiers END ');
2510 {$ENDIF}
2511 end;
2512
TCodeToolManager.GetIdentifierAtnull2513 function TCodeToolManager.GetIdentifierAt(Code: TCodeBuffer; X, Y: integer; out
2514 Identifier: string): boolean;
2515 var
2516 CleanPos: integer;
2517 begin
2518 Result:=false;
2519 {$IFDEF CTDEBUG}
2520 DebugLn('TCodeToolManager.GetIdentifierAt A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2521 {$ENDIF}
2522 Code.LineColToPosition(Y,X,CleanPos);
2523 if (CleanPos>0) and (CleanPos<=Code.SourceLength) then begin
2524 Identifier:=GetIdentifier(@Code.Source[CleanPos]);
2525 Result:=true;
2526 end else begin
2527 Identifier:='';
2528 Result:=false;
2529 end;
2530 end;
2531
IdentItemCheckHasChildsnull2532 function TCodeToolManager.IdentItemCheckHasChilds(IdentItem: TIdentifierListItem
2533 ): boolean;
2534 begin
2535 Result:=false;
2536 {$IFDEF CTDEBUG}
2537 DebugLn('TCodeToolManager.IdentItemCheckHasChilds A ');
2538 {$ENDIF}
2539 try
2540 IdentItem.CheckHasChilds;
2541 Result:=true;
2542 except
2543 on e: Exception do HandleException(e);
2544 end;
2545 end;
2546
FindAbstractMethodsnull2547 function TCodeToolManager.FindAbstractMethods(Code: TCodeBuffer; X, Y: integer;
2548 out ListOfPCodeXYPosition: TFPList; SkipAbstractsInStartClass: boolean): boolean;
2549 var
2550 CursorPos: TCodeXYPosition;
2551 begin
2552 {$IFDEF CTDEBUG}
2553 DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
2554 {$ENDIF}
2555 Result:=false;
2556 ListOfPCodeXYPosition:=nil;
2557 if not InitCurCodeTool(Code) then exit;
2558 CursorPos.X:=X;
2559 CursorPos.Y:=Y;
2560 CursorPos.Code:=Code;
2561 try
2562 Result:=FCurCodeTool.FindAbstractMethods(CursorPos,ListOfPCodeXYPosition,
2563 SkipAbstractsInStartClass);
2564 except
2565 on e: Exception do Result:=HandleException(e);
2566 end;
2567 end;
2568
TCodeToolManager.GetValuesOfCaseVariablenull2569 function TCodeToolManager.GetValuesOfCaseVariable(Code: TCodeBuffer; X,
2570 Y: integer; List: TStrings; WithTypeDefIfScoped: boolean): boolean;
2571 var
2572 CursorPos: TCodeXYPosition;
2573 begin
2574 {$IFDEF CTDEBUG}
2575 DebugLn('TCodeToolManager.GetValuesOfCaseVariable A ',Code.Filename);
2576 {$ENDIF}
2577 Result:=false;
2578 if not InitCurCodeTool(Code) then exit;
2579 CursorPos.X:=X;
2580 CursorPos.Y:=Y;
2581 CursorPos.Code:=Code;
2582 try
2583 Result:=FCurCodeTool.GetValuesOfCaseVariable(CursorPos,List,WithTypeDefIfScoped);
2584 except
2585 on e: Exception do Result:=HandleException(e);
2586 end;
2587 end;
2588
GatherOverloadsnull2589 function TCodeToolManager.GatherOverloads(Code: TCodeBuffer; X, Y: integer; out
2590 Graph: TDeclarationOverloadsGraph): boolean;
2591 var
2592 NewCode: TCodeBuffer;
2593 NewX, NewY, NewTopLine: integer;
2594 begin
2595 {$IFDEF CTDEBUG}
2596 DebugLn('TCodeToolManager.GatherOverloads A ',Code.Filename);
2597 {$ENDIF}
2598 Result:=false;
2599 Graph:=nil;
2600 if not FindMainDeclaration(Code,X,Y,NewCode,NewX,NewY,NewTopLine)
2601 then begin
2602 DebugLn('TCodeToolManager.GatherOverloads unable to FindMainDeclaration ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2603 exit;
2604 end;
2605 if NewTopLine=0 then ;
2606 if not InitCurCodeTool(Code) then exit;
2607 try
2608 Graph:=TDeclarationOverloadsGraph.Create;
2609 Graph.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
2610 Result:=Graph.Init(NewCode,NewX,NewY);
2611 except
2612 on e: Exception do Result:=HandleException(e);
2613 end;
2614 end;
2615
TCodeToolManager.FindReferencesnull2616 function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X,
2617 Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
2618 var ListOfPCodeXYPosition: TFPList; var Cache: TFindIdentifierReferenceCache
2619 ): boolean;
2620 var
2621 CursorPos: TCodeXYPosition;
2622 NewTopLine: integer;
2623 ImplementationNode: TCodeTreeNode;
2624 begin
2625 Result:=false;
2626 {$IFDEF CTDEBUG}
2627 if Cache=nil then
2628 DebugLn('TCodeToolManager.FindReferences A ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y),' SearchInCode=',SearchInCode.Filename)
2629 else
2630 debugln(['TCodeToolManager.FindReferences A SearchInCode=',SearchInCode.Filename]);
2631 {$ENDIF}
2632 ListOfPCodeXYPosition:=nil;
2633 if Cache=nil then
2634 Cache:=TFindIdentifierReferenceCache.Create;
2635 if (Cache.SourcesChangeStep=SourceCache.ChangeStamp)
2636 and (Cache.SourcesChangeStep<>CTInvalidChangeStamp64)
2637 and (Cache.FilesChangeStep=FileStateCache.TimeStamp)
2638 and (Cache.FilesChangeStep<>CTInvalidChangeStamp64)
2639 and (Cache.InitValuesChangeStep=DefineTree.ChangeStep)
2640 and (Cache.InitValuesChangeStep<>CTInvalidChangeStamp)
2641 and (Cache.IdentifierCode=IdentifierCode) and (Cache.X=X) and (Cache.Y=Y)
2642 then begin
2643 //debugln(['TCodeToolManager.FindReferences cache valid']);
2644 // all sources and values are the same => use cache
2645 Result:=true;
2646 end else begin
2647 //debugln(['TCodeToolManager.FindReferences cache not valid']);
2648 {debugln(['TCodeToolManager.FindReferences IdentifierCode=',Cache.IdentifierCode=IdentifierCode,
2649 ' X=',Cache.X=X,' Y=',Cache.Y=Y,
2650 ' SourcesChangeStep=',Cache.SourcesChangeStep=SourceCache.ChangeStamp,',',Cache.SourcesChangeStep=CTInvalidChangeStamp64,
2651 ' FilesChangeStep=',Cache.FilesChangeStep=FileStateCache.TimeStamp,',',Cache.FilesChangeStep=CTInvalidChangeStamp64,
2652 ' InitValuesChangeStep=',Cache.InitValuesChangeStep=DefineTree.ChangeStep,',',Cache.InitValuesChangeStep=CTInvalidChangeStamp,
2653 '']);}
2654 Cache.Clear;
2655 Cache.IdentifierCode:=IdentifierCode;
2656 Cache.X:=X;
2657 Cache.Y:=Y;
2658 Cache.SourcesChangeStep:=SourceCache.ChangeStamp;
2659 Cache.FilesChangeStep:=FileStateCache.TimeStamp;
2660 Cache.InitValuesChangeStep:=DefineTree.ChangeStep;
2661
2662 if not InitCurCodeTool(IdentifierCode) then exit;
2663 CursorPos.X:=X;
2664 CursorPos.Y:=Y;
2665 CursorPos.Code:=IdentifierCode;
2666 try
2667 Result:=FCurCodeTool.FindDeclaration(CursorPos,[fsfFindMainDeclaration],
2668 Cache.NewTool,Cache.NewNode,Cache.NewPos,NewTopLine);
2669 except
2670 on e: Exception do HandleException(e);
2671 end;
2672 if not Result then begin
2673 debugln(['TCodeToolManager.FindReferences FCurCodeTool.FindDeclaration failed']);
2674 exit;
2675 end;
2676 // check if scope can be limited
2677 if Cache.NewTool<>nil then begin
2678 Cache.IsPrivate:=(Cache.NewTool.GetSourceType in [ctnLibrary,ctnProgram]);
2679 if not Cache.IsPrivate then begin
2680 ImplementationNode:=Cache.NewTool.FindImplementationNode;
2681 if (ImplementationNode<>nil)
2682 and (Cache.NewNode.StartPos>=ImplementationNode.StartPos) then
2683 Cache.IsPrivate:=true;
2684 end;
2685 if not Cache.IsPrivate then begin
2686 if (Cache.NewNode.GetNodeOfTypes([ctnParameterList,ctnClassPrivate])<>nil) then
2687 Cache.IsPrivate:=true;
2688 end;
2689 end;
2690 end;
2691 if (not Result) or (Cache.NewNode=nil) then begin
2692 DebugLn('TCodeToolManager.FindReferences unable to FindDeclaration ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y));
2693 exit;
2694 end;
2695 Result:=true;
2696 if NewTopLine=0 then ;
2697 if not InitCurCodeTool(SearchInCode) then exit;
2698 if Cache.IsPrivate and (FCurCodeTool<>Cache.NewTool) then begin
2699 //debugln(['TCodeToolManager.FindReferences identifier is not reachable from this unit => skipping search']);
2700 exit(true);
2701 end;
2702
2703 CursorPos:=Cache.NewPos;
2704 {$IFDEF CTDEBUG}
2705 DebugLn('TCodeToolManager.FindReferences Searching ',dbgs(FCurCodeTool.Scanner<>nil),' for reference to x=',dbgs(CursorPos.X),' y=',dbgs(CursorPos.Y),' ',CursorPos.Code.Filename);
2706 {$ENDIF}
2707 try
2708 Result:=FCurCodeTool.FindReferences(CursorPos,SkipComments,
2709 ListOfPCodeXYPosition);
2710 except
2711 on e: Exception do HandleException(e);
2712 end;
2713 {$IFDEF CTDEBUG}
2714 DebugLn(['TCodeToolManager.FindReferences END ',Result]);
2715 {$ENDIF}
2716 end;
2717
FindUnitReferencesnull2718 function TCodeToolManager.FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
2719 SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
2720 // finds unit name of UnitCode in unit of TargetCode
2721 begin
2722 Result:=false;
2723 {$IFDEF CTDEBUG}
2724 DebugLn('TCodeToolManager.FindUnitReferences A ',UnitCode.Filename,' Target=',TargetCode.Filename);
2725 {$ENDIF}
2726 ListOfPCodeXYPosition:=nil;
2727 if not InitCurCodeTool(TargetCode) then exit;
2728 try
2729 Result:=FCurCodeTool.FindUnitReferences(UnitCode,SkipComments,
2730 ListOfPCodeXYPosition);
2731 except
2732 on e: Exception do HandleException(e);
2733 end;
2734 {$IFDEF CTDEBUG}
2735 DebugLn('TCodeToolManager.FindUnitReferences END ');
2736 {$ENDIF}
2737 end;
2738
FindUsedUnitReferencesnull2739 function TCodeToolManager.FindUsedUnitReferences(Code: TCodeBuffer; X,
2740 Y: integer; SkipComments: boolean; out UsedUnitFilename: string;
2741 var ListOfPCodeXYPosition: TFPList): boolean;
2742 // finds in unit of Code all references of the unit at the uses clause at X,Y
2743 var
2744 CursorPos: TCodeXYPosition;
2745 begin
2746 Result:=false;
2747 {$IFDEF CTDEBUG}
2748 DebugLn('TCodeToolManager.FindUsedUnitReferences A ',Code.Filename,' X=',X,' Y=',Y,' SkipComments=',SkipComments);
2749 {$ENDIF}
2750 ListOfPCodeXYPosition:=nil;
2751 if not InitCurCodeTool(Code) then exit;
2752 CursorPos.X:=X;
2753 CursorPos.Y:=Y;
2754 CursorPos.Code:=Code;
2755 try
2756 FCurCodeTool.FindUsedUnitReferences(CursorPos,SkipComments,UsedUnitFilename,
2757 ListOfPCodeXYPosition);
2758 Result:=true;
2759 except
2760 on e: Exception do HandleException(e);
2761 end;
2762 {$IFDEF CTDEBUG}
2763 DebugLn('TCodeToolManager.FindUnitReferences END ');
2764 {$ENDIF}
2765 end;
2766
RenameIdentifiernull2767 function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
2768 const OldIdentifier, NewIdentifier: string; DeclarationCode: TCodeBuffer;
2769 DeclarationCaretXY: PPoint): boolean;
2770 var
2771 ANode, ANode2: TAVLTreeNode;
2772 CurCodePos, LastCodePos: PCodeXYPosition;
2773 IdentStartPos: integer;
2774 IdentLen, IdentLenDiff: Integer;
2775 SameLineCount: Integer;
2776 i: Integer;
2777 Code: TCodeBuffer;
2778 begin
2779 Result:=false;
2780 {$IFDEF CTDEBUG}
2781 DebugLn('TCodeToolManager.RenameIdentifier A Old=',OldIdentifier,' New=',NewIdentifier,' ',dbgs(TreeOfPCodeXYPosition<>nil));
2782 {$ENDIF}
2783 if TreeOfPCodeXYPosition=nil then begin
2784 Result:=true;
2785 exit;
2786 end;
2787 if not IsValidIdent(NewIdentifier) then exit;
2788
2789 ClearCurCodeTool;
2790 SourceChangeCache.Clear;
2791 CurCodePos := nil;
2792 LastCodePos := nil;
2793 SameLineCount := 0;
2794 IdentLen:=length(OldIdentifier);
2795 IdentLenDiff := length(NewIdentifier) - IdentLen;
2796 if DeclarationCode = nil then
2797 DeclarationCaretXY := nil;;
2798 if DeclarationCaretXY = nil then
2799 DeclarationCode := nil;;
2800
2801 // the tree is sorted for descending line code positions
2802 // -> go from end of source to start of source, so that replacing does not
2803 // change any CodeXYPosition not yet processed
2804 ANode:=TreeOfPCodeXYPosition.FindLowest;
2805 while ANode<>nil do begin
2806 // next position
2807 CurCodePos:=PCodeXYPosition(ANode.Data);
2808 Code:=CurCodePos^.Code;
2809 Code.LineColToPosition(CurCodePos^.Y,CurCodePos^.X,IdentStartPos);
2810 DebugLn('TCodeToolManager.RenameIdentifier File ',Code.Filename,' Line=',dbgs(CurCodePos^.Y),' Col=',dbgs(CurCodePos^.X),' Identifier=',GetIdentifier(@Code.Source[IdentStartPos]));
2811 // search absolute position in source
2812 if IdentStartPos<1 then begin
2813 SetError(20170421203205,Code, CurCodePos^.Y, CurCodePos^.X, ctsPositionNotInSource);
2814 exit;
2815 end;
2816 // check if old identifier is there
2817 if CompareIdentifiers(@Code.Source[IdentStartPos],PChar(Pointer(OldIdentifier)))<>0
2818 then begin
2819 debugln(['TCodeToolManager.RenameIdentifier CONSISTENCY ERROR ',Dbgs(CurCodePos^),' ']);
2820 SetError(20170421203210,CurCodePos^.Code,CurCodePos^.Y,CurCodePos^.X,
2821 Format(ctsStrExpectedButAtomFound,[OldIdentifier,
2822 GetIdentifier(@Code.Source[IdentStartPos])])
2823 );
2824 exit;
2825 end;
2826 // change if needed
2827 if CompareIdentifiersCaseSensitive(@Code.Source[IdentStartPos],
2828 PChar(Pointer(NewIdentifier)))<>0
2829 then begin
2830 DebugLn('TCodeToolManager.RenameIdentifier Change ');
2831 SourceChangeCache.ReplaceEx(gtNone,gtNone,1,1,Code,
2832 IdentStartPos,IdentStartPos+IdentLen,NewIdentifier);
2833
2834 if (DeclarationCode = Code) and (CurCodePos^.Y = DeclarationCaretXY^.Y) and
2835 (CurCodePos^.X < DeclarationCaretXY^.X)
2836 then
2837 DeclarationCaretXY^.X := DeclarationCaretXY^.X + IdentLenDiff;
2838
2839 if (LastCodePos <> nil) and (CurCodePos^.Y = LastCodePos^.Y) and
2840 (CurCodePos^.Code = LastCodePos^.Code)
2841 then
2842 inc(SameLineCount);
2843
2844 end else begin
2845 DebugLn('TCodeToolManager.RenameIdentifier KEPT ',GetIdentifier(@Code.Source[IdentStartPos]));
2846 end;
2847
2848 LastCodePos := CurCodePos;
2849 ANode2 := ANode;
2850 ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
2851
2852 if (ANode = nil) or (PCodeXYPosition(ANode.Data)^.Code <> LastCodePos^.Code) or
2853 (PCodeXYPosition(ANode.Data)^.Y <> LastCodePos^.Y)
2854 then begin
2855 if (SameLineCount > 0) then begin
2856 for i := 1 to SameLineCount do begin
2857 ANode2 := TreeOfPCodeXYPosition.FindPrecessor(ANode2);
2858 PCodeXYPosition(ANode2.Data)^.X := PCodeXYPosition(ANode2.Data)^.X + i * IdentLenDiff;
2859 end;
2860 end;
2861 SameLineCount := 0;
2862 end;
2863 end;
2864 // apply
2865 DebugLn('TCodeToolManager.RenameIdentifier Apply');
2866 if not SourceChangeCache.Apply then exit;
2867
2868 //DebugLn('TCodeToolManager.RenameIdentifier Success');
2869 Result:=true;
2870 {$IFDEF CTDEBUG}
2871 DebugLn('TCodeToolManager.RenameIdentifier END ');
2872 {$ENDIF}
2873 end;
2874
ReplaceWordnull2875 function TCodeToolManager.ReplaceWord(Code: TCodeBuffer; const OldWord,
2876 NewWord: string; ChangeStrings: boolean): boolean;
2877 begin
2878 Result:=false;
2879 {$IFDEF CTDEBUG}
2880 DebugLn('TCodeToolManager.ReplaceWord A ',Code.Filename,' OldWord="',OldWord,'" NewWord="',NewWord,'"');
2881 {$ENDIF}
2882 if not InitCurCodeTool(Code) then exit;
2883 try
2884 Result:=FCurCodeTool.ReplaceWord(OldWord, NewWord, ChangeStrings,
2885 SourceChangeCache);
2886 except
2887 on e: Exception do HandleException(e);
2888 end;
2889 end;
2890
RemoveIdentifierDefinitionnull2891 function TCodeToolManager.RemoveIdentifierDefinition(Code: TCodeBuffer; X,
2892 Y: integer): boolean;
2893 var
2894 CursorPos: TCodeXYPosition;
2895 begin
2896 Result:=false;
2897 {$IFDEF CTDEBUG}
2898 DebugLn(['TCodeToolManager.RemoveIdentifierDefinition A ',Code.Filename,' X=',X,' Y=',Y]);
2899 {$ENDIF}
2900 if not InitCurCodeTool(Code) then exit;
2901 CursorPos.X:=X;
2902 CursorPos.Y:=Y;
2903 CursorPos.Code:=Code;
2904 try
2905 Result:=FCurCodeTool.RemoveIdentifierDefinition(CursorPos,SourceChangeCache);
2906 except
2907 on e: Exception do HandleException(e);
2908 end;
2909 end;
2910
TCodeToolManager.RemoveWithBlocknull2911 function TCodeToolManager.RemoveWithBlock(Code: TCodeBuffer; X, Y: integer
2912 ): boolean;
2913 var
2914 CursorPos: TCodeXYPosition;
2915 begin
2916 Result:=false;
2917 {$IFDEF CTDEBUG}
2918 DebugLn(['TCodeToolManager.RemoveWithBlock A ',Code.Filename,' X=',X,' Y=',Y]);
2919 {$ENDIF}
2920 if not InitCurCodeTool(Code) then exit;
2921 CursorPos.X:=X;
2922 CursorPos.Y:=Y;
2923 CursorPos.Code:=Code;
2924 try
2925 Result:=FCurCodeTool.RemoveWithBlock(CursorPos,SourceChangeCache);
2926 except
2927 on e: Exception do HandleException(e);
2928 end;
2929 end;
2930
TCodeToolManager.AddWithBlocknull2931 function TCodeToolManager.AddWithBlock(Code: TCodeBuffer; X1, Y1, X2,
2932 Y2: integer; const WithExpr: string; Candidates: TStrings): boolean;
2933 var
2934 StartPos, EndPos: TCodeXYPosition;
2935 begin
2936 Result:=false;
2937 {$IFDEF CTDEBUG}
2938 DebugLn(['TCodeToolManager.AddWithBlock A ',Code.Filename,' X1=',X1,' Y1=',Y1,' X2=',X2,' Y2=',Y2,' WithExpr="',WithExpr,'"']);
2939 {$ENDIF}
2940 if not InitCurCodeTool(Code) then exit;
2941 StartPos.X:=X1;
2942 StartPos.Y:=Y1;
2943 StartPos.Code:=Code;
2944 EndPos.X:=X2;
2945 EndPos.Y:=Y2;
2946 EndPos.Code:=Code;
2947 try
2948 Result:=FCurCodeTool.AddWithBlock(StartPos,EndPos,WithExpr,Candidates,
2949 SourceChangeCache);
2950 except
2951 on e: Exception do HandleException(e);
2952 end;
2953 end;
2954
TCodeToolManager.ChangeParamListnull2955 function TCodeToolManager.ChangeParamList(Code: TCodeBuffer;
2956 Changes: TObjectList; var ProcPos: TCodeXYPosition;
2957 TreeOfPCodeXYPosition: TAVLTree): boolean;
2958 begin
2959 Result:=false;
2960 {$IFDEF CTDEBUG}
2961 DebugLn('TCodeToolManager.ChangeParamList A ',Code.Filename);
2962 {$ENDIF}
2963 if not InitCurCodeTool(Code) then exit;
2964 try
2965 Result:=FCurCodeTool.ChangeParamList(Changes,ProcPos,TreeOfPCodeXYPosition,
2966 SourceChangeCache);
2967 except
2968 on e: Exception do HandleException(e);
2969 end;
2970 end;
2971
GatherResourceStringSectionsnull2972 function TCodeToolManager.GatherResourceStringSections(Code: TCodeBuffer;
2973 X, Y: integer; CodePositions: TCodeXYPositions): boolean;
2974 var
2975 CursorPos: TCodeXYPosition;
2976 begin
2977 Result:=false;
2978 {$IFDEF CTDEBUG}
2979 DebugLn('TCodeToolManager.GatherResourceStringSections A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2980 {$ENDIF}
2981 if not InitCurCodeTool(Code) then exit;
2982 CursorPos.X:=X;
2983 CursorPos.Y:=Y;
2984 CursorPos.Code:=Code;
2985 if CodePositions=nil then begin
2986 ClearPositions;
2987 CodePositions:=Positions;
2988 end;
2989 try
2990 Result:=FCurCodeTool.GatherResourceStringSections(CursorPos,CodePositions);
2991 except
2992 on e: Exception do HandleException(e);
2993 end;
2994 end;
2995
IdentifierExistsInResourceStringSectionnull2996 function TCodeToolManager.IdentifierExistsInResourceStringSection(
2997 Code: TCodeBuffer; X, Y: integer; const ResStrIdentifier: string): boolean;
2998 var
2999 CursorPos: TCodeXYPosition;
3000 begin
3001 Result:=false;
3002 {$IFDEF CTDEBUG}
3003 DebugLn('TCodeToolManager.IdentifierExistsInResourceStringSection A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
3004 {$ENDIF}
3005 if not InitCurCodeTool(Code) then exit;
3006 CursorPos.X:=X;
3007 CursorPos.Y:=Y;
3008 CursorPos.Code:=Code;
3009 try
3010 Result:=FCurCodeTool.IdentifierExistsInResourceStringSection(CursorPos,
3011 ResStrIdentifier);
3012 except
3013 on e: Exception do HandleException(e);
3014 end;
3015 end;
3016
TCodeToolManager.CreateIdentifierFromStringConstnull3017 function TCodeToolManager.CreateIdentifierFromStringConst(
3018 StartCode: TCodeBuffer; StartX, StartY: integer;
3019 EndCode: TCodeBuffer; EndX, EndY: integer;
3020 out Identifier: string; MaxLen: integer): boolean;
3021 var
3022 StartCursorPos, EndCursorPos: TCodeXYPosition;
3023 begin
3024 Result:=false;
3025 {$IFDEF CTDEBUG}
3026 DebugLn('TCodeToolManager.CreateIdentifierFromStringConst A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
3027 {$ENDIF}
3028 if not InitCurCodeTool(StartCode) then exit;
3029 StartCursorPos.X:=StartX;
3030 StartCursorPos.Y:=StartY;
3031 StartCursorPos.Code:=StartCode;
3032 EndCursorPos.X:=EndX;
3033 EndCursorPos.Y:=EndY;
3034 EndCursorPos.Code:=EndCode;
3035 Identifier:='';
3036 try
3037 Result:=FCurCodeTool.CreateIdentifierFromStringConst(
3038 StartCursorPos,EndCursorPos,Identifier,MaxLen);
3039 except
3040 on e: Exception do HandleException(e);
3041 end;
3042 end;
3043
TCodeToolManager.StringConstToFormatStringnull3044 function TCodeToolManager.StringConstToFormatString(
3045 StartCode: TCodeBuffer; StartX, StartY: integer;
3046 EndCode: TCodeBuffer; EndX, EndY: integer;
3047 out FormatStringConstant, FormatParameters: string;
3048 out StartInStringConst, EndInStringConst: boolean): boolean;
3049 var
3050 StartCursorPos, EndCursorPos: TCodeXYPosition;
3051 begin
3052 Result:=false;
3053 {$IFDEF CTDEBUG}
3054 DebugLn('TCodeToolManager.StringConstToFormatString A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
3055 {$ENDIF}
3056 if not InitCurCodeTool(StartCode) then exit;
3057 StartCursorPos.X:=StartX;
3058 StartCursorPos.Y:=StartY;
3059 StartCursorPos.Code:=StartCode;
3060 EndCursorPos.X:=EndX;
3061 EndCursorPos.Y:=EndY;
3062 EndCursorPos.Code:=EndCode;
3063 try
3064 Result:=FCurCodeTool.StringConstToFormatString(
3065 StartCursorPos,EndCursorPos,FormatStringConstant,FormatParameters,
3066 StartInStringConst,EndInStringConst);
3067 except
3068 on e: Exception do HandleException(e);
3069 end;
3070 end;
3071
TCodeToolManager.GatherResourceStringsWithValuenull3072 function TCodeToolManager.GatherResourceStringsWithValue(
3073 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
3074 const StringValue: string; CodePositions: TCodeXYPositions): boolean;
3075 var
3076 CursorPos: TCodeXYPosition;
3077 begin
3078 Result:=false;
3079 {$IFDEF CTDEBUG}
3080 DebugLn('TCodeToolManager.GatherResourceStringsWithValue A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
3081 {$ENDIF}
3082 if not InitCurCodeTool(SectionCode) then exit;
3083 CursorPos.X:=SectionX;
3084 CursorPos.Y:=SectionY;
3085 CursorPos.Code:=SectionCode;
3086 if CodePositions=nil then begin
3087 ClearPositions;
3088 CodePositions:=Positions;
3089 end;
3090 try
3091 Result:=FCurCodeTool.GatherResourceStringsWithValue(CursorPos,StringValue,
3092 CodePositions);
3093 except
3094 on e: Exception do HandleException(e);
3095 end;
3096 end;
3097
TCodeToolManager.AddResourcestringnull3098 function TCodeToolManager.AddResourcestring(
3099 CursorCode: TCodeBuffer; X,Y: integer;
3100 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
3101 const NewIdentifier, NewValue: string;
3102 InsertPolicy: TResourcestringInsertPolicy): boolean;
3103 var
3104 CursorPos, SectionPos, NearestPos: TCodeXYPosition;
3105 begin
3106 Result:=false;
3107 {$IFDEF CTDEBUG}
3108 DebugLn('TCodeToolManager.AddResourcestring A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
3109 {$ENDIF}
3110 if not InitCurCodeTool(SectionCode) then exit;
3111 SectionPos.X:=SectionX;
3112 SectionPos.Y:=SectionY;
3113 SectionPos.Code:=SectionCode;
3114 try
3115 NearestPos.Code:=nil;
3116 if InsertPolicy=rsipContext then begin
3117 CursorPos.X:=X;
3118 CursorPos.Y:=Y;
3119 CursorPos.Code:=CursorCode;
3120 Result:=FCurCodeTool.FindNearestResourceString(CursorPos, SectionPos,
3121 NearestPos);
3122 if not Result then exit;
3123 end;
3124 Result:=FCurCodeTool.AddResourcestring(SectionPos, NewIdentifier, NewValue,
3125 InsertPolicy,NearestPos,SourceChangeCache);
3126 except
3127 on e: Exception do HandleException(e);
3128 end;
3129 end;
3130
3131 procedure TCodeToolManager.ImproveStringConstantStart(const ACode: string;
3132 var StartPos: integer);
3133 begin
3134 BasicCodeTools.ImproveStringConstantStart(ACode,StartPos);
3135 end;
3136
3137 procedure TCodeToolManager.ImproveStringConstantEnd(const ACode: string;
3138 var EndPos: integer);
3139 begin
3140 BasicCodeTools.ImproveStringConstantEnd(ACode,EndPos);
3141 end;
3142
GetStringConstBoundsnull3143 function TCodeToolManager.GetStringConstBounds(Code: TCodeBuffer; X,
3144 Y: integer; out StartCode: TCodeBuffer; out StartX, StartY: integer; out
3145 EndCode: TCodeBuffer; out EndX, EndY: integer; ResolveComments: boolean
3146 ): boolean;
3147 var
3148 CursorPos, StartPos, EndPos: TCodeXYPosition;
3149 begin
3150 Result:=false;
3151 {$IFDEF CTDEBUG}
3152 DebugLn('TCodeToolManager.GetStringConstBounds A ',Code.Filename);
3153 {$ENDIF}
3154 if not InitCurCodeTool(Code) then exit;
3155 CursorPos.X:=X;
3156 CursorPos.Y:=Y;
3157 CursorPos.Code:=Code;
3158 try
3159 Result:=FCurCodeTool.GetStringConstBounds(CursorPos,StartPos,EndPos,
3160 ResolveComments);
3161 if Result then begin
3162 StartCode:=StartPos.Code;
3163 StartX:=StartPos.X;
3164 StartY:=StartPos.Y;
3165 EndCode:=EndPos.Code;
3166 EndX:=EndPos.X;
3167 EndY:=EndPos.Y;
3168 end;
3169 except
3170 on e: Exception do Result:=HandleException(e);
3171 end;
3172 end;
3173
InsertStatementsnull3174 function TCodeToolManager.InsertStatements(
3175 InsertPos: TInsertStatementPosDescription; const Statements: string): boolean;
3176 begin
3177 Result:=false;
3178 {$IFDEF CTDEBUG}
3179 DebugLn('TCodeToolManager.InsertStatements A ',Code.Filename,' Line=',Y,',Col=',X);
3180 {$ENDIF}
3181 if not InitCurCodeTool(InsertPos.CodeXYPos.Code) then exit;
3182 try
3183 Result:=FCurCodeTool.InsertStatements(InsertPos,Statements,SourceChangeCache);
3184 except
3185 on e: Exception do HandleException(e);
3186 end;
3187 end;
3188
AddProcModifiernull3189 function TCodeToolManager.AddProcModifier(Code: TCodeBuffer; X, Y: integer;
3190 const aModifier: string): boolean;
3191 var
3192 CursorPos: TCodeXYPosition;
3193 begin
3194 Result:=false;
3195 {$IFDEF CTDEBUG}
3196 DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename);
3197 {$ENDIF}
3198 if not InitCurCodeTool(Code) then exit;
3199 CursorPos.X:=X;
3200 CursorPos.Y:=Y;
3201 CursorPos.Code:=Code;
3202 try
3203 Result:=FCurCodeTool.AddProcModifier(CursorPos,aModifier,SourceChangeCache);
3204 except
3205 on e: Exception do HandleException(e);
3206 end;
3207 end;
3208
ExtractOperandnull3209 function TCodeToolManager.ExtractOperand(Code: TCodeBuffer; X, Y: integer; out
3210 Operand: string; WithPostTokens, WithAsOperator,
3211 WithoutTrailingPoints: boolean): boolean;
3212 var
3213 CursorPos: TCodeXYPosition;
3214 begin
3215 Result:=false;
3216 {$IFDEF CTDEBUG}
3217 DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename);
3218 {$ENDIF}
3219 Operand:='';
3220 if not InitCurCodeTool(Code) then exit;
3221 CursorPos.X:=X;
3222 CursorPos.Y:=Y;
3223 CursorPos.Code:=Code;
3224 try
3225 Result:=FCurCodeTool.ExtractOperand(CursorPos,Operand,
3226 WithPostTokens,WithAsOperator,WithoutTrailingPoints);
3227 except
3228 on e: Exception do HandleException(e);
3229 end;
3230 end;
3231
GetExpandedOperandnull3232 function TCodeToolManager.GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
3233 out Operand: string; ResolveProperty: Boolean): Boolean;
3234 var
3235 CursorPos: TCodeXYPosition;
3236 begin
3237 Result := False;
3238 Operand := '';
3239 if not InitCurCodeTool(Code) then Exit;
3240 CursorPos.X := X;
3241 CursorPos.Y := Y;
3242 CursorPos.Code := Code;
3243 try
3244 Result := FCurCodeTool.GetExpandedOperand(CursorPos, Operand, ResolveProperty);
3245 except
3246 on e: Exception do HandleException(e);
3247 end;
3248 end;
3249
TCodeToolManager.GuessMisplacedIfdefEndifnull3250 function TCodeToolManager.GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,
3251 Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
3252 ): boolean;
3253 var
3254 CursorPos: TCodeXYPosition;
3255 NewPos: TCodeXYPosition;
3256 begin
3257 Result:=false;
3258 {$IFDEF CTDEBUG}
3259 DebugLn('TCodeToolManager.GuessMisplacedIfdefEndif A ',Code.Filename);
3260 {$ENDIF}
3261 if not InitCurCodeTool(Code) then exit;
3262 CursorPos.X:=X;
3263 CursorPos.Y:=Y;
3264 CursorPos.Code:=Code;
3265 try
3266 Result:=FCurCodeTool.GuessMisplacedIfdefEndif(CursorPos,NewPos,NewTopLine);
3267 if Result then begin
3268 NewX:=NewPos.X;
3269 NewY:=NewPos.Y;
3270 NewCode:=NewPos.Code;
3271 end;
3272 except
3273 on e: Exception do Result:=HandleException(e);
3274 end;
3275 end;
3276
TCodeToolManager.FindEnclosingIncludeDirectivenull3277 function TCodeToolManager.FindEnclosingIncludeDirective(Code: TCodeBuffer; X,
3278 Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
3279 ): boolean;
3280 var
3281 CursorPos: TCodeXYPosition;
3282 NewPos: TCodeXYPosition;
3283 begin
3284 Result:=false;
3285 {$IFDEF CTDEBUG}
3286 DebugLn('TCodeToolManager.FindEnclosingIncludeDirective A ',Code.Filename);
3287 {$ENDIF}
3288 if not InitCurCodeTool(Code) then exit;
3289 CursorPos.X:=X;
3290 CursorPos.Y:=Y;
3291 CursorPos.Code:=Code;
3292 try
3293 Result:=FCurCodeTool.FindEnclosingIncludeDirective(CursorPos,
3294 NewPos,NewTopLine);
3295 if Result then begin
3296 NewX:=NewPos.X;
3297 NewY:=NewPos.Y;
3298 NewCode:=NewPos.Code;
3299 end;
3300 except
3301 on e: Exception do Result:=HandleException(e);
3302 end;
3303 end;
3304
TCodeToolManager.FindResourceDirectivenull3305 function TCodeToolManager.FindResourceDirective(Code: TCodeBuffer; StartX,
3306 StartY: integer;
3307 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
3308 const Filename: string; SearchInCleanSrc: boolean): boolean;
3309 var
3310 CursorPos: TCodeXYPosition;
3311 NewPos: TCodeXYPosition;
3312 p: integer;
3313 ADirectivesTool: TDirectivesTool;
3314 begin
3315 Result:=false;
3316 {$IFDEF CTDEBUG}
3317 DebugLn('TCodeToolManager.FindResourceDirective A ',Code.Filename);
3318 {$ENDIF}
3319 NewCode:=nil;
3320 NewX:=0;
3321 NewY:=0;
3322 NewTopLine:=0;
3323 if SearchInCleanSrc then begin
3324 if not InitCurCodeTool(Code) then exit;
3325 CursorPos.X:=StartX;
3326 CursorPos.Y:=StartY;
3327 CursorPos.Code:=Code;
3328 try
3329 Result:=FCurCodeTool.FindResourceDirective(CursorPos,NewPos,NewTopLine,
3330 Filename);
3331 if Result then begin
3332 NewX:=NewPos.X;
3333 NewY:=NewPos.Y;
3334 NewCode:=NewPos.Code;
3335 end;
3336 except
3337 on e: Exception do Result:=HandleException(e);
3338 end;
3339 end else begin
3340 try
3341 if not InitCurDirectivesTool(Code) then exit;
3342 ADirectivesTool:=FCurDirectivesTool;
3343 FCurDirectivesTool.Parse;
3344 Code.LineColToPosition(StartY,StartX,p);
3345 Result:=ADirectivesTool.NodeStartToCodePos(
3346 ADirectivesTool.FindResourceDirective(Filename,p),
3347 CursorPos);
3348 NewCode:=CursorPos.Code;
3349 NewX:=CursorPos.X;
3350 NewY:=CursorPos.Y;
3351 NewTopLine:=NewY;
3352 except
3353 on e: Exception do Result:=HandleException(e);
3354 end;
3355 end;
3356 end;
3357
TCodeToolManager.AddResourceDirectivenull3358 function TCodeToolManager.AddResourceDirective(Code: TCodeBuffer;
3359 const Filename: string; SearchInCleanSrc: boolean; const NewSrc: string
3360 ): boolean;
3361 var
3362 Tree: TCompilerDirectivesTree;
3363 Node: TCodeTreeNode;
3364 begin
3365 Result:=false;
3366 {$IFDEF CTDEBUG}
3367 DebugLn('TCodeToolManager.AddResourceDirective A ',Code.Filename,' Filename=',Filename);
3368 {$ENDIF}
3369 if SearchInCleanSrc then begin
3370 if not InitCurCodeTool(Code) then exit;
3371 try
3372 Result:=FCurCodeTool.AddResourceDirective(Filename,SourceChangeCache,NewSrc);
3373 except
3374 on e: Exception do Result:=HandleException(e);
3375 end;
3376 end else begin
3377 try
3378 Tree:=TCompilerDirectivesTree.Create;
3379 try
3380 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3381 Node:=Tree.FindResourceDirective(Filename);
3382 if Node=nil then
3383 Result:=AddResourceDirective(Code,Filename,true,NewSrc)
3384 else
3385 Result:=true;
3386 finally
3387 Tree.Free;
3388 end;
3389 except
3390 on e: Exception do Result:=HandleException(e);
3391 end;
3392 end;
3393 end;
3394
TCodeToolManager.FindIncludeDirectivenull3395 function TCodeToolManager.FindIncludeDirective(Code: TCodeBuffer; StartX,
3396 StartY: integer; out NewCode: TCodeBuffer; out NewX, NewY,
3397 NewTopLine: integer; const Filename: string; SearchInCleanSrc: boolean
3398 ): boolean;
3399 var
3400 CursorPos: TCodeXYPosition;
3401 NewPos: TCodeXYPosition;
3402 Tree: TCompilerDirectivesTree;
3403 p: integer;
3404 begin
3405 Result:=false;
3406 {$IFDEF CTDEBUG}
3407 DebugLn('TCodeToolManager.FindIncludeDirective A ',Code.Filename);
3408 {$ENDIF}
3409 NewCode:=nil;
3410 NewX:=0;
3411 NewY:=0;
3412 NewTopLine:=0;
3413 if SearchInCleanSrc then begin
3414 if not InitCurCodeTool(Code) then exit;
3415 CursorPos.X:=StartX;
3416 CursorPos.Y:=StartY;
3417 CursorPos.Code:=Code;
3418 try
3419 Result:=FCurCodeTool.FindIncludeDirective(CursorPos,NewPos,NewTopLine,
3420 Filename);
3421 if Result then begin
3422 NewX:=NewPos.X;
3423 NewY:=NewPos.Y;
3424 NewCode:=NewPos.Code;
3425 end;
3426 except
3427 on e: Exception do Result:=HandleException(e);
3428 end;
3429 end else begin
3430 try
3431 Tree:=TCompilerDirectivesTree.Create;
3432 try
3433 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3434 Code.LineColToPosition(StartY,StartX,p);
3435 Result:=Tree.NodeStartToCodePos(Tree.FindIncludeDirective(Filename,p),
3436 CursorPos);
3437 NewCode:=CursorPos.Code;
3438 NewX:=CursorPos.X;
3439 NewY:=CursorPos.Y;
3440 NewTopLine:=NewY;
3441 finally
3442 Tree.Free;
3443 end;
3444 except
3445 on e: Exception do Result:=HandleException(e);
3446 end;
3447 end;
3448 end;
3449
AddIncludeDirectiveForInitnull3450 function TCodeToolManager.AddIncludeDirectiveForInit(Code: TCodeBuffer;
3451 const Filename: string; const NewSrc: string): boolean;
3452 begin
3453 Result:=false;
3454 {$IFDEF CTDEBUG}
3455 DebugLn('TCodeToolManager.AddIncludeDirectiveForInit A ',Code.Filename,' Filename=',Filename);
3456 {$ENDIF}
3457 if not InitCurCodeTool(Code) then exit;
3458 try
3459 Result:=FCurCodeTool.AddIncludeDirectiveForInit(Filename,SourceChangeCache,NewSrc);
3460 except
3461 on e: Exception do Result:=HandleException(e);
3462 end;
3463 end;
3464
TCodeToolManager.AddUnitWarnDirectivenull3465 function TCodeToolManager.AddUnitWarnDirective(Code: TCodeBuffer; WarnID,
3466 Comment: string; TurnOn: boolean): boolean;
3467 begin
3468 Result:=false;
3469 {$IFDEF CTDEBUG}
3470 DebugLn(['TCodeToolManager.AddUnitWarnDirective A ',Code.Filename,' aParam="',aParam,'" TurnOn=',TurnOn]);
3471 {$ENDIF}
3472 if not InitCurCodeTool(Code) then exit;
3473 try
3474 Result:=FCurCodeTool.AddUnitWarnDirective(WarnID,Comment,TurnOn,SourceChangeCache);
3475 except
3476 on e: Exception do Result:=HandleException(e);
3477 end;
3478 end;
3479
TCodeToolManager.RemoveDirectivenull3480 function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX,
3481 NewY: integer; RemoveEmptyIFs: boolean): boolean;
3482 var
3483 Tree: TCompilerDirectivesTree;
3484 p: integer;
3485 Node: TCodeTreeNode;
3486 Changed: boolean;
3487 ParentNode: TCodeTreeNode;
3488 begin
3489 Result:=false;
3490 {$IFDEF CTDEBUG}
3491 DebugLn('TCodeToolManager.RemoveDirective A ',Code.Filename);
3492 {$ENDIF}
3493 try
3494 Code.LineColToPosition(NewY,NewX,p);
3495 if (p<1) or (p>Code.SourceLength) then exit;
3496 Tree:=TCompilerDirectivesTree.Create;
3497 try
3498 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3499 Node:=Tree.FindNodeAtPos(p);
3500 if Node=nil then exit;
3501 ParentNode:=Node.Parent;
3502 Changed:=false;
3503 Tree.DisableNode(Node,Changed,true);
3504 if RemoveEmptyIFs and (ParentNode<>nil) and Tree.NodeIsEmpty(ParentNode) then
3505 Tree.DisableNode(ParentNode,Changed,true);
3506 Result:=Changed;
3507 finally
3508 Tree.Free;
3509 end;
3510 except
3511 on e: Exception do Result:=HandleException(e);
3512 end;
3513 end;
3514
TCodeToolManager.FixIncludeFilenamesnull3515 function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
3516 Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;
3517
3518 procedure CreateErrorForMissingIncludeFile;
3519 var
3520 CodePos: PCodeXYPosition;
3521 begin
3522 ClearError;
3523 CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[0]);
3524 fErrorCode:=CodePos^.Code;
3525 fErrorLine:=CodePos^.Y;
3526 fErrorColumn:=CodePos^.X;
3527 FErrorId:=20170421202903;
3528 FErrorMsg:='missing include file';
3529 end;
3530
3531 var
3532 FoundIncludeFiles: TStrings;
3533 i: Integer;
3534 AFilename: string;
3535 ToFixIncludeFiles: TStringList;
3536 FixedIncludeFiles: TStringList;
3537 begin
3538 Result:=false;
3539 {$IFDEF CTDEBUG}
3540 DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=', DbgS(Recursive));
3541 {$ENDIF}
3542 MissingIncludeFilesCodeXYPos:=nil;
3543 if not InitCurCodeTool(Code) then exit;
3544 try
3545 FixedIncludeFiles:=nil;
3546 ToFixIncludeFiles:=TStringList.Create;
3547 try
3548 ToFixIncludeFiles.Add(Code.Filename);
3549 while ToFixIncludeFiles.Count>0 do begin
3550 // get next include file
3551 AFilename:=ToFixIncludeFiles[ToFixIncludeFiles.Count-1];
3552 ToFixIncludeFiles.Delete(ToFixIncludeFiles.Count-1);
3553 Code:=LoadFile(AFilename,false,false);
3554 if Code=nil then begin
3555 raise ECodeToolError.Create(FCurCodeTool,20170421202139,
3556 'unable to read file "'+AFilename+'"');
3557 end;
3558 // fix file
3559 FoundIncludeFiles:=nil;
3560 try
3561 Result:=FCurCodeTool.FixIncludeFilenames(Code,SourceChangeCache,
3562 FoundIncludeFiles,MissingIncludeFilesCodeXYPos);
3563 if (MissingIncludeFilesCodeXYPos<>nil)
3564 and (MissingIncludeFilesCodeXYPos.Count>0) then begin
3565 DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',dbgs(MissingIncludeFilesCodeXYPos.Count));
3566 Result:=false;
3567 CreateErrorForMissingIncludeFile;
3568 exit;
3569 end;
3570 if not Recursive then begin
3571 // check only main file -> stop
3572 exit;
3573 end;
3574 // remember, that the file has been fixed to avoid cycles
3575 if FixedIncludeFiles=nil then
3576 FixedIncludeFiles:=TStringList.Create;
3577 FixedIncludeFiles.Add(Code.Filename);
3578 // add new include files to stack
3579 if FoundIncludeFiles<>nil then begin
3580 for i:=0 to FoundIncludeFiles.Count-1 do begin
3581 AFilename:=FoundIncludeFiles[i];
3582 if ((FixedIncludeFiles=nil)
3583 or (FixedIncludeFiles.IndexOf(AFilename)<0))
3584 and (ToFixIncludeFiles.IndexOf(AFilename)<0) then begin
3585 ToFixIncludeFiles.Add(AFilename);
3586 end;
3587 end;
3588 end;
3589 //DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text);
3590 finally
3591 FoundIncludeFiles.Free;
3592 end;
3593 end;
3594 finally
3595 FixedIncludeFiles.Free;
3596 ToFixIncludeFiles.Free;
3597 end;
3598 except
3599 on e: Exception do Result:=HandleException(e);
3600 end;
3601 end;
3602
TCodeToolManager.FixMissingH2PasDirectivesnull3603 function TCodeToolManager.FixMissingH2PasDirectives(Code: TCodeBuffer;
3604 var Changed: boolean): boolean;
3605 begin
3606 Result:=false;
3607 try
3608 if InitCurDirectivesTool(Code) then begin
3609 FCurDirectivesTool.Parse;
3610 FCurDirectivesTool.FixMissingH2PasDirectives(Changed);
3611 Result:=true;
3612 end;
3613 except
3614 on e: Exception do Result:=HandleException(e);
3615 end;
3616 end;
3617
TCodeToolManager.ReduceCompilerDirectivesnull3618 function TCodeToolManager.ReduceCompilerDirectives(Code: TCodeBuffer;
3619 Undefines, Defines: TStrings; var Changed: boolean): boolean;
3620 begin
3621 Result:=false;
3622 try
3623 if InitCurDirectivesTool(Code) then begin
3624 FCurDirectivesTool.Parse;
3625 FCurDirectivesTool.ReduceCompilerDirectives(Undefines,Defines,Changed);
3626 Result:=true;
3627 end;
3628 except
3629 on e: Exception do Result:=HandleException(e);
3630 end;
3631 end;
3632
IsKeywordnull3633 function TCodeToolManager.IsKeyword(Code: TCodeBuffer; const KeyWord: string
3634 ): boolean;
3635 begin
3636 Result:=false;
3637 {$IFDEF CTDEBUG}
3638 DebugLn('TCodeToolManager.IsKeyword A ',Code.Filename,' Keyword=',KeyWord);
3639 {$ENDIF}
3640 if not InitCurCodeTool(Code) then exit;
3641 try
3642 Result:=FCurCodeTool.StringIsKeyWord(KeyWord);
3643 except
3644 on e: Exception do Result:=HandleException(e);
3645 end;
3646 end;
3647
ExtractCodeWithoutCommentsnull3648 function TCodeToolManager.ExtractCodeWithoutComments(Code: TCodeBuffer;
3649 KeepDirectives: boolean; KeepVerbosityDirectives: boolean): string;
3650 begin
3651 Result:=CleanCodeFromComments(Code.Source,
3652 GetNestedCommentsFlagForFile(Code.Filename),KeepDirectives,
3653 KeepVerbosityDirectives);
3654 end;
3655
TCodeToolManager.GetPasDocCommentsnull3656 function TCodeToolManager.GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
3657 out ListOfPCodeXYPosition: TFPList): boolean;
3658 var
3659 CursorPos: TCodeXYPosition;
3660 begin
3661 Result:=false;
3662 {$IFDEF CTDEBUG}
3663 DebugLn('TCodeToolManager.GetPasDocComments A ',Code.Filename);
3664 {$ENDIF}
3665 ListOfPCodeXYPosition:=nil;
3666 if not InitCurCodeTool(Code) then exit;
3667 CursorPos.X:=X;
3668 CursorPos.Y:=Y;
3669 CursorPos.Code:=Code;
3670 {$IFDEF CTDEBUG}
3671 DebugLn('TCodeToolManager.GetPasDocComments B ',dbgs(FCurCodeTool.Scanner<>nil));
3672 {$ENDIF}
3673 try
3674 Result:=FCurCodeTool.GetPasDocComments(CursorPos,true,ListOfPCodeXYPosition);
3675 except
3676 on e: Exception do Result:=HandleException(e);
3677 end;
3678 {$IFDEF CTDEBUG}
3679 DebugLn('TCodeToolManager.GetPasDocComments END ');
3680 {$ENDIF}
3681 end;
3682
TCodeToolManager.FindBlockCounterPartnull3683 function TCodeToolManager.FindBlockCounterPart(Code: TCodeBuffer;
3684 X, Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
3685 ): boolean;
3686 var
3687 CursorPos: TCodeXYPosition;
3688 NewPos: TCodeXYPosition;
3689 begin
3690 Result:=false;
3691 {$IFDEF CTDEBUG}
3692 DebugLn('TCodeToolManager.FindBlockCounterPart A ',Code.Filename);
3693 {$ENDIF}
3694 NewCode:=nil;
3695 if not InitCurCodeTool(Code) then exit;
3696 CursorPos.X:=X;
3697 CursorPos.Y:=Y;
3698 CursorPos.Code:=Code;
3699 {$IFDEF CTDEBUG}
3700 DebugLn('TCodeToolManager.FindBlockCounterPart B ',dbgs(FCurCodeTool.Scanner<>nil));
3701 {$ENDIF}
3702 try
3703 Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine);
3704 if Result then begin
3705 NewX:=NewPos.X;
3706 NewY:=NewPos.Y;
3707 NewCode:=NewPos.Code;
3708 end;
3709 except
3710 on e: Exception do Result:=HandleException(e);
3711 end;
3712 {$IFDEF CTDEBUG}
3713 DebugLn('TCodeToolManager.FindBlockCounterPart END ');
3714 {$ENDIF}
3715 end;
3716
TCodeToolManager.FindBlockStartnull3717 function TCodeToolManager.FindBlockStart(Code: TCodeBuffer; X, Y: integer; out
3718 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; SkipStart: boolean
3719 ): boolean;
3720 var
3721 CursorPos: TCodeXYPosition;
3722 NewPos: TCodeXYPosition;
3723 begin
3724 Result:=false;
3725 {$IFDEF CTDEBUG}
3726 DebugLn('TCodeToolManager.FindBlockStart A ',Code.Filename);
3727 {$ENDIF}
3728 if not InitCurCodeTool(Code) then exit;
3729 CursorPos.X:=X;
3730 CursorPos.Y:=Y;
3731 CursorPos.Code:=Code;
3732 {$IFDEF CTDEBUG}
3733 DebugLn('TCodeToolManager.FindBlockStart B ',dbgs(FCurCodeTool.Scanner<>nil));
3734 {$ENDIF}
3735 try
3736 Result:=FCurCodeTool.FindBlockStart(CursorPos,NewPos,NewTopLine,SkipStart);
3737 if Result then begin
3738 NewX:=NewPos.X;
3739 NewY:=NewPos.Y;
3740 NewCode:=NewPos.Code;
3741 end;
3742 except
3743 on e: Exception do Result:=HandleException(e);
3744 end;
3745 {$IFDEF CTDEBUG}
3746 DebugLn('TCodeToolManager.FindBlockStart END ');
3747 {$ENDIF}
3748 end;
3749
TCodeToolManager.GuessUnclosedBlocknull3750 function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
3751 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
3752 var
3753 CursorPos: TCodeXYPosition;
3754 NewPos: TCodeXYPosition;
3755 begin
3756 Result:=false;
3757 {$IFDEF CTDEBUG}
3758 DebugLn('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename);
3759 {$ENDIF}
3760 if not InitCurCodeTool(Code) then exit;
3761 CursorPos.X:=X;
3762 CursorPos.Y:=Y;
3763 CursorPos.Code:=Code;
3764 {$IFDEF CTDEBUG}
3765 DebugLn('TCodeToolManager.GuessUnclosedBlock B ',dbgs(FCurCodeTool.Scanner<>nil));
3766 {$ENDIF}
3767 try
3768 Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
3769 if Result then begin
3770 NewX:=NewPos.X;
3771 NewY:=NewPos.Y;
3772 NewCode:=NewPos.Code;
3773 end;
3774 except
3775 on e: Exception do Result:=HandleException(e);
3776 end;
3777 {$IFDEF CTDEBUG}
3778 DebugLn('TCodeToolManager.GuessUnclosedBlock END ');
3779 {$ENDIF}
3780 end;
3781
TCodeToolManager.CompleteBlocknull3782 function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
3783 OnlyIfCursorBlockIndented: boolean): boolean;
3784 var
3785 NewCode: TCodeBuffer;
3786 NewX, NewY, NewTopLine: integer;
3787 begin
3788 Result:=CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
3789 NewCode,NewX,NewY,NewTopLine);
3790 if (NewCode=nil) and (NewX<0) and (NewY<0) and (NewTopLine<1) then ;
3791 end;
3792
TCodeToolManager.CompleteBlocknull3793 function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
3794 OnlyIfCursorBlockIndented: boolean;
3795 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
3796 var
3797 CursorPos, NewPos: TCodeXYPosition;
3798 begin
3799 Result:=false;
3800 NewCode:=Code;
3801 NewX:=X;
3802 NewY:=Y;
3803 NewTopLine:=-1;
3804 {$IFDEF CTDEBUG}
3805 DebugLn('TCodeToolManager.CompleteBlock A ',Code.Filename,' x=',dbgs(X),' y=',dbgs(Y));
3806 {$ENDIF}
3807 if not InitCurCodeTool(Code) then exit;
3808 CursorPos.X:=X;
3809 CursorPos.Y:=Y;
3810 CursorPos.Code:=Code;
3811 try
3812 Result:=FCurCodeTool.CompleteBlock(CursorPos,SourceChangeCache,
3813 OnlyIfCursorBlockIndented,NewPos,NewTopLine);
3814 if Result then begin
3815 NewCode:=NewPos.Code;
3816 NewX:=NewPos.X;
3817 NewY:=NewPos.Y;
3818 end;
3819 except
3820 on e: Exception do HandleException(e);
3821 end;
3822 end;
3823
GetCompatiblePublishedMethodsnull3824 function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
3825 const AClassName: string; PropInstance: TPersistent; const PropName: string;
3826 const Proc: TGetStrProc): boolean;
3827 begin
3828 {$IFDEF CTDEBUG}
3829 DebugLn(['TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname,' Instance=',DbgSName(PropInstance),' PropName=',PropName]);
3830 {$ENDIF}
3831 Result:=false;
3832 if not InitCurCodeTool(Code) then exit;
3833 try
3834 Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,
3835 PropInstance,PropName,Proc);
3836 except
3837 on e: Exception do Result:=HandleException(e);
3838 end;
3839 end;
3840
GetCompatiblePublishedMethodsnull3841 function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
3842 const AClassName: string; TypeData: PTypeData; const Proc: TGetStrProc): boolean;
3843 begin
3844 {$IFDEF CTDEBUG}
3845 DebugLn('TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname);
3846 {$ENDIF}
3847 Result:=false;
3848 if not InitCurCodeTool(Code) then exit;
3849 try
3850 Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,TypeData,Proc);
3851 except
3852 on e: Exception do Result:=HandleException(e);
3853 end;
3854 end;
3855
PublishedMethodExistsnull3856 function TCodeToolManager.PublishedMethodExists(Code: TCodeBuffer;
3857 const AClassName, AMethodName: string; PropInstance: TPersistent;
3858 const PropName: string; out MethodIsCompatible, MethodIsPublished,
3859 IdentIsMethod: boolean): boolean;
3860 begin
3861 {$IFDEF CTDEBUG}
3862 DebugLn(['TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName,' Porperty=',DbgSName(PropInstance),'.',PropName]);
3863 {$ENDIF}
3864 Result:=InitCurCodeTool(Code);
3865 if not Result then exit;
3866 try
3867 Result:=FCurCodeTool.PublishedMethodExists(AClassName,
3868 AMethodName,PropInstance,PropName,
3869 MethodIsCompatible,MethodIsPublished,IdentIsMethod);
3870 except
3871 on e: Exception do Result:=HandleException(e);
3872 end;
3873 end;
3874
PublishedMethodExistsnull3875 function TCodeToolManager.PublishedMethodExists(Code:TCodeBuffer;
3876 const AClassName, AMethodName: string; TypeData: PTypeData;
3877 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean): boolean;
3878 begin
3879 {$IFDEF CTDEBUG}
3880 DebugLn('TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName);
3881 {$ENDIF}
3882 Result:=InitCurCodeTool(Code);
3883 if not Result then exit;
3884 try
3885 Result:=FCurCodeTool.PublishedMethodExists(AClassName,
3886 AMethodName,TypeData,
3887 MethodIsCompatible,MethodIsPublished,IdentIsMethod);
3888 except
3889 on e: Exception do Result:=HandleException(e);
3890 end;
3891 end;
3892
JumpToPublishedMethodBodynull3893 function TCodeToolManager.JumpToPublishedMethodBody(Code: TCodeBuffer;
3894 const AClassName, AMethodName: string; out NewCode: TCodeBuffer; out NewX,
3895 NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
3896 var NewPos: TCodeXYPosition;
3897 begin
3898 {$IFDEF CTDEBUG}
3899 DebugLn('TCodeToolManager.JumpToPublishedMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName);
3900 {$ENDIF}
3901 Result:=InitCurCodeTool(Code);
3902 if not Result then exit;
3903 try
3904 Result:=FCurCodeTool.JumpToPublishedMethodBody(AClassName,
3905 AMethodName,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,true);
3906 if Result then begin
3907 NewCode:=NewPos.Code;
3908 NewX:=NewPos.X;
3909 NewY:=NewPos.Y;
3910 end;
3911 except
3912 on e: Exception do Result:=HandleException(e);
3913 end;
3914 end;
3915
RenamePublishedMethodnull3916 function TCodeToolManager.RenamePublishedMethod(Code: TCodeBuffer;
3917 const AClassName, OldMethodName, NewMethodName: string): boolean;
3918 begin
3919 {$IFDEF CTDEBUG}
3920 DebugLn('TCodeToolManager.RenamePublishedMethod A');
3921 {$ENDIF}
3922 Result:=InitCurCodeTool(Code);
3923 if not Result then exit;
3924 try
3925 SourceChangeCache.Clear;
3926 Result:=FCurCodeTool.RenamePublishedMethod(AClassName,
3927 OldMethodName,NewMethodName,SourceChangeCache);
3928 except
3929 on e: Exception do Result:=HandleException(e);
3930 end;
3931 end;
3932
TCodeToolManager.CreatePublishedMethodnull3933 function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
3934 const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
3935 UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
3936 const APropertyPath: string; const CallAncestorMethod: string;
3937 AddOverride: boolean): boolean;
3938 begin
3939 {$IFDEF CTDEBUG}
3940 DebugLn('TCodeToolManager.CreatePublishedMethod A');
3941 {$ENDIF}
3942 Result:=InitCurCodeTool(Code);
3943 if not Result then exit;
3944 try
3945 SourceChangeCache.Clear;
3946 Result:=FCurCodeTool.CreateMethod(AClassName,
3947 NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
3948 SourceChangeCache,UseTypeInfoForParameters,pcsPublished,
3949 CallAncestorMethod,AddOverride);
3950 except
3951 on e: Exception do Result:=HandleException(e);
3952 end;
3953 end;
3954
TCodeToolManager.CreatePrivateMethodnull3955 function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer;
3956 const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
3957 UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
3958 const APropertyPath: string): boolean;
3959 begin
3960 {$IFDEF CTDEBUG}
3961 DebugLn('TCodeToolManager.CreatePrivateMethod A');
3962 {$ENDIF}
3963 Result:=InitCurCodeTool(Code);
3964 if not Result then exit;
3965 try
3966 SourceChangeCache.Clear;
3967 Result:=FCurCodeTool.CreateMethod(AClassName,
3968 NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
3969 SourceChangeCache,UseTypeInfoForParameters,pcsPrivate);
3970 except
3971 on e: Exception do Result:=HandleException(e);
3972 end;
3973 end;
3974
GetIDEDirectivesnull3975 function TCodeToolManager.GetIDEDirectives(Code: TCodeBuffer;
3976 DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter): boolean;
3977 begin
3978 {$IFDEF CTDEBUG}
3979 DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
3980 {$ENDIF}
3981 Result:=false;
3982 if not InitCurCodeTool(Code) then exit;
3983 try
3984 Result:=FCurCodeTool.GetIDEDirectives(DirectiveList,Filter);
3985 except
3986 on e: Exception do Result:=HandleException(e);
3987 end;
3988 end;
3989
SetIDEDirectivesnull3990 function TCodeToolManager.SetIDEDirectives(Code: TCodeBuffer;
3991 DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter): boolean;
3992 begin
3993 {$IFDEF CTDEBUG}
3994 DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
3995 {$ENDIF}
3996 Result:=false;
3997 if not InitCurCodeTool(Code) then exit;
3998 try
3999 Result:=FCurCodeTool.SetIDEDirectives(DirectiveList,SourceChangeCache,Filter);
4000 except
4001 on e: Exception do Result:=HandleException(e);
4002 end;
4003 end;
4004
JumpToLinkerIdentifiernull4005 function TCodeToolManager.JumpToLinkerIdentifier(Code: TCodeBuffer;
4006 const SourceFilename: string; SourceLine: integer;
4007 const MangledFunction, Identifier: string; out NewCode: TCodeBuffer; out
4008 NewX, NewY, NewTopLine: integer): boolean;
4009 var
4010 NewPos: TCodeXYPosition;
4011 begin
4012 {$IFDEF CTDEBUG}
4013 DebugLn('TCodeToolManager.JumpToLinkerIdentifier A ',Code.Filename);
4014 {$ENDIF}
4015 Result:=false;
4016 if not InitCurCodeTool(Code) then exit;
4017 try
4018 Result:=FCurCodeTool.FindJumpPointForLinkerPos(
Identifiernull4019 SourceFilename, SourceLine, MangledFunction, Identifier,
4020 NewPos,NewTopLine);
4021 if Result then begin
4022 NewX:=NewPos.X;
4023 NewY:=NewPos.Y;
4024 NewCode:=NewPos.Code;
4025 end;
4026 except
4027 on e: Exception do Result:=HandleException(e);
4028 end;
4029 end;
4030
FindFPCMangledIdentifiernull4031 function TCodeToolManager.FindFPCMangledIdentifier(GDBIdentifier: string; out
4032 aComplete: boolean; out aMessage: string;
4033 const OnFindSource: TOnFindFPCMangledSource; out NewCode: TCodeBuffer; out NewX,
4034 NewY, NewTopLine: integer): boolean;
4035 { Examples:
4036 compiler built-in
4037 fpc_raiseexception
4038 ??
4039 PASCALMAIN
4040 SYSTEM_FPC_SYSTEMMAIN$LONGINT$PPCHAR$PPCHAR
4041
4042 unit:
4043 procedure
4044 SYSUTILS_RUNERRORTOEXCEPT$LONGINT$POINTER$POINTER
4045 SYSTEM_HANDLEERRORADDRFRAME$LONGINT$POINTER$POINTER
4046 method
4047 EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$$TMODALRESULT
4048 EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$ANSISTRING$$TMODALRESULT
4049 ENVIRONMENTOPTS_TENVIRONMENTOPTIONS_$__LOAD$BOOLEAN
4050 MAIN_TMAINIDE_$__LOADGLOBALOPTIONS
4051 MAIN_TMAINIDE_$__CREATE$TCOMPONENT$$TMAINIDE
4052
4053 program:
4054 P$TESTPROJECT1_DOTEST
4055 P$TESTPROJECT1_DOTEST_SUBTEST
4056 P$TESTPROJECT1_DOTEST$CHAR_SUBTEST$LONGINT
4057 P$TESTSTACKTRACE1_TMAINCLASS_$_TSUBCLASS_$__RAISESOMETHING$ANSISTRING
4058 }
4059 var
4060 p: PChar;
4061 TheSrcName: string;
4062 Code: TCodeBuffer;
4063 CurIdentifier: string;
4064 Tool: TCodeTool;
4065 Node: TCodeTreeNode;
4066 SubNode: TCodeTreeNode;
4067 ClassNode: TCodeTreeNode;
4068 ProcNode: TCodeTreeNode;
4069 SectionNode: TCodeTreeNode;
4070 SrcFilename: string;
4071 NewPos: TCodeXYPosition;
4072
4073 procedure ReadIdentifier(out Identifier: string);
4074 var
4075 StartP: PChar;
4076 begin
4077 StartP:=p;
4078 while p^ in ['A'..'Z','0'..'9'] do inc(p);
4079 Identifier:=copy(GDBIdentifier,StartP-PChar(GDBIdentifier)+1,p-StartP);
4080 end;
4081
4082 procedure ReadParamList;
4083 begin
4084 if p^='$' then begin
4085 // parameter list => skip
4086 while (p^ in ['$','A'..'Z','0'..'9']) do inc(p);
4087 end;
4088 end;
4089
FindUnitnull4090 function FindUnit(TheUnitName: string; out aFilename: string): boolean;
4091 var
4092 InFilename: string;
4093 begin
4094 // search in main search path
4095 InFilename:='';
4096 aFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
4097 '',TheUnitName,InFilename,true);
4098 if aFilename='' then begin
4099 // user search
4100 if Assigned(OnFindSource) then
4101 OnFindSource(Self,ctnUnit,TheUnitName,aFilename)
4102 else if Assigned(OnFindFPCMangledSource) then
4103 OnFindFPCMangledSource(Self,ctnUnit,TheUnitName,aFilename)
4104 end;
4105 Result:=aFilename<>'';
4106 end;
4107
FindProgramnull4108 function FindProgram(TheSrcName: string; out aFilename: string): boolean;
4109 begin
4110 aFilename:='';
4111 // user search
4112 if Assigned(OnFindSource) then begin
4113 OnFindSource(Self,ctnProgram,TheSrcName,aFilename);
4114 end;
4115 Result:=aFilename<>'';
4116 end;
4117
4118 begin
4119 Result:=false;
4120 aComplete:=false;
4121 aMessage:='';
4122 NewCode:=nil;
4123 NewTopLine:=-1;
4124 NewX:=-1;
4125 NewY:=-1;
4126
4127 if GDBIdentifier='' then begin
4128 aMessage:='missing identifier';
4129 exit;
4130 end;
4131 p:=PChar(GDBIdentifier);
4132 if p^ in ['a'..'z'] then begin
4133 // lower case unit name means compiler built in function
aMessagenull4134 aMessage:='the function "'+GDBIdentifier+'" is a compiler special function without source';
4135 exit;
4136 end;
4137 TheSrcName:='';
4138 if p^ in ['A'..'Z'] then begin
4139 ReadIdentifier(TheSrcName);
4140 //debugln(['TCodeToolManager.FindGBDIdentifier first identifier=',TheSrcName,' ...']);
4141 if (TheSrcName='P') and (p^='$') then begin
4142 // P$programname
4143 inc(p);
4144 if IsIdentStartChar[p^] then
4145 ReadIdentifier(TheSrcName);
4146 //debugln(['TCodeToolManager.FindGBDIdentifier search source of program "',TheSrcName,'" ...']);
4147 if not FindProgram(TheSrcName,SrcFilename) then begin
4148 aMessage:='can''t find program "'+TheSrcName+'"';
4149 exit;
4150 end;
4151 end else if p^='_' then begin
4152 // a unit name
4153 // => search unit
4154 if not FindUnit(TheSrcName,SrcFilename) then begin
4155 aMessage:='can''t find unit '+TheSrcName;
4156 exit;
4157 end;
4158 end else if p^<>'_' then begin
4159 // only one uppercase identifier, e.g. PASCALMAIN
4160 aMessage:='compiler built in function "'+GDBIdentifier+'"';
4161 exit;
4162 end;
4163 // load unit source
4164 Code:=LoadFile(SrcFilename,true,false);
4165 if Code=nil then begin
4166 aMessage:='unable to read file "'+SrcFilename+'"';
4167 exit;
4168 end;
4169
4170 inc(p);
4171 if p^ in ['A'..'Z'] then begin
4172 ReadIdentifier(CurIdentifier);
4173 //debugln(['TCodeToolManager.FindGBDIdentifier Identifier="',CurIdentifier,'"']);
4174
4175 if not Explore(Code,Tool,false,true) then begin
4176 //debugln(['TCodeToolManager.FindGBDIdentifier parse error']);
4177 aMessage:=CodeToolBoss.ErrorMessage;
4178 exit;
4179 end;
4180
4181 ReadParamList;
4182
4183 Node:=nil;
4184 if Tool.GetSourceType=ctnUnit then begin
4185 // a unit => first search in interface, then in implementation
4186 SectionNode:=Tool.FindInterfaceNode;
4187 if SectionNode<>nil then begin
4188 Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
4189 end;
4190 if Node=nil then begin
4191 // search in implementation
4192 try
4193 Node:=Tool.FindDeclarationNodeInImplementation(CurIdentifier,true);
4194 except
4195 on E: Exception do begin
4196 HandleException(E);
4197 //debugln(['TCodeToolManager.FindGBDIdentifier FindDeclarationNodeInImplementation parse error in "',Code.Filename,'": ',E.Message]);
4198 aMessage:=ErrorMessage;
4199 exit;
4200 end;
4201 end;
4202 end;
4203 end else begin
4204 // not a unit, e.g. a program
4205 SectionNode:=Tool.Tree.Root;
4206 if SectionNode<>nil then begin
4207 Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
4208 end;
4209 end;
4210 if Node=nil then begin
4211 // identifier not found => use only SrcFilename
4212 //debugln(['TCodeToolManager.FindGBDIdentifier identifier "',CurIdentifier,'" not found in "',Code.Filename,'"']);
4213 aMessage:='identifier "'+CurIdentifier+'" not found in "'+Code.Filename+'"';
4214 exit;
4215 end;
4216
4217 repeat
4218 if (p^='_') and (p[1]='$') and (p[2]='_') and (p[3]='_') then begin
4219 // sub identifier is method or member
4220 inc(p,4);
4221 end else if (p^='_') and (p[1] in ['A'..'Z']) then begin
4222 // sub identifier is proc
4223 inc(p);
4224 end else
4225 break;
4226 if not (p^ in ['A'..'Z']) then begin
4227 break;
4228 end;
4229 // _$__identifier => sub identifier
4230 ReadIdentifier(CurIdentifier);
4231 ReadParamList;
4232 // find sub identifier
4233 SubNode:=Tool.FindSubDeclaration(CurIdentifier,Node);
4234 if SubNode=nil then begin
4235 //debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" not found']);
4236 break;
4237 end;
4238 //debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" found']);
4239 Node:=SubNode;
4240 until false;
4241
4242 if Node.Desc=ctnProcedure then begin
4243 // proc node => find body
4244 ClassNode:=Tool.FindClassOrInterfaceNode(Node);
4245 if ClassNode<>nil then begin
4246 try
4247 Tool.BuildTree(lsrInitializationStart);
4248 except
4249 on E: Exception do begin
4250 // ignore
4251 end;
4252 end;
4253 ProcNode:=Tool.FindCorrespondingProcNode(Node,[phpAddClassName]);
4254 if ProcNode<>nil then
4255 Node:=ProcNode;
4256 end;
4257 end;
4258
4259 aComplete:=p^ in [#0,#9,#10,#13,' '];
4260 Result:=Tool.JumpToCleanPos(Node.StartPos,-1,-1,NewPos,NewTopLine,false);
4261 NewCode:=NewPos.Code;
4262 NewX:=NewPos.X;
4263 NewY:=NewPos.Y;
4264 end;
4265 // unknown operator => use only SrcFilename
4266 //debugln(['TCodeToolManager.FindGBDIdentifier operator not yet supported: ',dbgstr(p^)]);
4267 aMessage:='operator not supported: '+dbgstr(p^);
4268 exit;
4269 end else begin
4270 // example: ??
4271 end;
4272
4273 aMessage:='unknown identifier "'+GDBIdentifier+'"';
4274 end;
4275
CompleteCodenull4276 function TCodeToolManager.CompleteCode(Code: TCodeBuffer; X, Y,
4277 TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine,
4278 BlockTopLine, BlockBottomLine: integer; Interactive: Boolean): boolean;
4279 var
4280 CursorPos: TCodeXYPosition;
4281 NewPos: TCodeXYPosition;
4282 begin
4283 {$IFDEF CTDEBUG}
4284 DebugLn('TCodeToolManager.CompleteCode A ',Code.Filename);
4285 {$ENDIF}
4286 Result:=false;
4287 NewX := 0;
4288 NewY := 0;
4289 NewTopLine := 0;
4290 NewCode := NIL;
4291 if not InitCurCodeTool(Code) then exit;
4292 CursorPos.X:=X;
4293 CursorPos.Y:=Y;
4294 CursorPos.Code:=Code;
4295 try
4296 Result:=FCurCodeTool.CompleteCode(CursorPos,TopLine,
4297 NewPos,NewTopLine, BlockTopLine, BlockBottomLine,SourceChangeCache,Interactive);
4298 if Result then begin
4299 NewX:=NewPos.X;
4300 NewY:=NewPos.Y;
4301 NewCode:=NewPos.Code;
4302 end;
4303 except
4304 on e: Exception do Result:=HandleException(e);
4305 end;
4306 end;
4307
CreateVariableForIdentifiernull4308 function TCodeToolManager.CreateVariableForIdentifier(Code: TCodeBuffer; X, Y,
4309 TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY,
4310 NewTopLine: integer; Interactive: Boolean): boolean;
4311 var
4312 CursorPos: TCodeXYPosition;
4313 NewPos: TCodeXYPosition;
4314 begin
4315 {$IFDEF CTDEBUG}
4316 DebugLn('TCodeToolManager.CreateVariableForIdentifier A ',Code.Filename);
4317 {$ENDIF}
4318 Result:=false;
4319 if not InitCurCodeTool(Code) then exit;
4320 CursorPos.X:=X;
4321 CursorPos.Y:=Y;
4322 CursorPos.Code:=Code;
4323 try
4324 Result:=FCurCodeTool.CreateVariableForIdentifier(CursorPos,TopLine,
4325 NewPos,NewTopLine,SourceChangeCache,Interactive);
4326 if Result then begin
4327 NewX:=NewPos.X;
4328 NewY:=NewPos.Y;
4329 NewCode:=NewPos.Code;
4330 end;
4331 except
4332 on e: Exception do Result:=HandleException(e);
4333 end;
4334 end;
4335
AddMethodsnull4336 function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y, TopLine: integer;
4337 ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean; out
4338 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
4339 BlockBottomLine: integer): boolean;
4340 var
4341 CursorPos, NewPos: TCodeXYPosition;
4342 begin
4343 {$IFDEF CTDEBUG}
4344 DebugLn('TCodeToolManager.AddMethods A ',Code.Filename);
4345 {$ENDIF}
4346 Result:=false;
4347 NewCode:=nil;
4348 if not InitCurCodeTool(Code) then exit;
4349 CursorPos.X:=X;
4350 CursorPos.Y:=Y;
4351 CursorPos.Code:=Code;
4352 try
4353 Result:=FCurCodeTool.AddMethods(CursorPos,TopLine,ListOfPCodeXYPosition,
4354 VirtualToOverride,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache);
4355 NewCode:=NewPos.Code;
4356 NewX:=NewPos.X;
4357 NewY:=NewPos.Y;
4358 except
4359 on e: Exception do Result:=HandleException(e);
4360 end;
4361 end;
4362
TCodeToolManager.GuessTypeOfIdentifiernull4363 function TCodeToolManager.GuessTypeOfIdentifier(Code: TCodeBuffer; X,
4364 Y: integer; out ItsAKeyword, IsSubIdentifier: boolean;
4365 out ExistingDefinition: TFindContext;
4366 out ListOfPFindContext: TFPList; out NewExprType: TExpressionType;
4367 out NewType: string): boolean;
4368 var
4369 CursorPos: TCodeXYPosition;
4370 begin
4371 {$IFDEF CTDEBUG}
4372 DebugLn(['TCodeToolManager.GuessTypeOfIdentifier A ',Code.Filename,' X=',X,' Y=',Y]);
4373 {$ENDIF}
4374 Result:=false;
4375 if not InitCurCodeTool(Code) then exit;
4376 CursorPos.X:=X;
4377 CursorPos.Y:=Y;
4378 CursorPos.Code:=Code;
4379 try
4380 Result:=FCurCodeTool.GuessTypeOfIdentifier(CursorPos,ItsAKeyword,
4381 IsSubIdentifier,ExistingDefinition,ListOfPFindContext,
4382 NewExprType,NewType);
4383 except
4384 on e: Exception do Result:=HandleException(e);
4385 end;
4386 end;
4387
GetPossibleInitsForVariablenull4388 function TCodeToolManager.GetPossibleInitsForVariable(Code: TCodeBuffer; X,
4389 Y: integer; out Statements: TStrings; out InsertPositions: TObjectList
4390 ): boolean;
4391 var
4392 CursorPos: TCodeXYPosition;
4393 begin
4394 {$IFDEF CTDEBUG}
4395 DebugLn(['TCodeToolManager.GetPossibleInitsForVariable A ',Code.Filename,' X=',X,' Y=',Y]);
4396 {$ENDIF}
4397 Result:=false;
4398 if not InitCurCodeTool(Code) then exit;
4399 CursorPos.Code:=Code;
4400 CursorPos.X:=X;
4401 CursorPos.Y:=Y;
4402 try
4403 Result:=FCurCodeTool.GetPossibleInitsForVariable(CursorPos,Statements,
4404 InsertPositions,SourceChangeCache);
4405 except
4406 on e: Exception do Result:=HandleException(e);
4407 end;
4408 end;
4409
TCodeToolManager.DeclareVariableNearBynull4410 function TCodeToolManager.DeclareVariableNearBy(Code: TCodeBuffer; X,
4411 Y: integer; const VariableName, NewType, NewUnitName: string;
4412 Visibility: TCodeTreeNodeDesc; LvlPosCode: TCodeBuffer; LvlPosX: integer;
4413 LvlPosY: integer): boolean;
4414 var
4415 CursorPos, LvlPos: TCodeXYPosition;
4416 begin
4417 {$IFDEF CTDEBUG}
4418 DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
4419 {$ENDIF}
4420 Result:=false;
4421 if not InitCurCodeTool(Code) then exit;
4422 CursorPos.Code:=Code;
4423 CursorPos.X:=X;
4424 CursorPos.Y:=Y;
4425 LvlPos.Code:=LvlPosCode;
4426 LvlPos.X:=LvlPosX;
4427 LvlPos.Y:=LvlPosY;
4428 try
4429 Result:=FCurCodeTool.DeclareVariableNearBy(CursorPos,VariableName,
4430 NewType,NewUnitName,Visibility,SourceChangeCache,LvlPos);
4431 except
4432 on e: Exception do Result:=HandleException(e);
4433 end;
4434 end;
4435
TCodeToolManager.DeclareVariableAtnull4436 function TCodeToolManager.DeclareVariableAt(Code: TCodeBuffer; X, Y: integer;
4437 const VariableName, NewType, NewUnitName: string): boolean;
4438 var
4439 CursorPos: TCodeXYPosition;
4440 begin
4441 {$IFDEF CTDEBUG}
4442 DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
4443 {$ENDIF}
4444 Result:=false;
4445 if not InitCurCodeTool(Code) then exit;
4446 CursorPos.Code:=Code;
4447 CursorPos.X:=X;
4448 CursorPos.Y:=Y;
4449 try
4450 Result:=FCurCodeTool.DeclareVariableAt(CursorPos,VariableName,
4451 NewType,NewUnitName,SourceChangeCache);
4452 except
4453 on e: Exception do Result:=HandleException(e);
4454 end;
4455 end;
4456
TCodeToolManager.FindRedefinitionsnull4457 function TCodeToolManager.FindRedefinitions(Code: TCodeBuffer; out
4458 TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
4459 begin
4460 {$IFDEF CTDEBUG}
4461 DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
4462 {$ENDIF}
4463 Result:=false;
4464 TreeOfCodeTreeNodeExt:=nil;
4465 if not InitCurCodeTool(Code) then exit;
4466 try
4467 Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,WithEnums);
4468 except
4469 on e: Exception do Result:=HandleException(e);
4470 end;
4471 end;
4472
RemoveRedefinitionsnull4473 function TCodeToolManager.RemoveRedefinitions(Code: TCodeBuffer;
4474 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4475 begin
4476 {$IFDEF CTDEBUG}
4477 DebugLn('TCodeToolManager.RemoveRedefinitions A ',Code.Filename);
4478 {$ENDIF}
4479 Result:=false;
4480 if not InitCurCodeTool(Code) then exit;
4481 try
4482 Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
4483 SourceChangeCache);
4484 except
4485 on e: Exception do Result:=HandleException(e);
4486 end;
4487 end;
4488
TCodeToolManager.RemoveAllRedefinitionsnull4489 function TCodeToolManager.RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
4490 var
4491 TreeOfCodeTreeNodeExt: TAVLTree;
4492 begin
4493 {$IFDEF CTDEBUG}
4494 DebugLn('TCodeToolManager.RemoveAllRedefinitions A ',Code.Filename);
4495 {$ENDIF}
4496 Result:=false;
4497 TreeOfCodeTreeNodeExt:=nil;
4498 try
4499 TreeOfCodeTreeNodeExt:=nil;
4500 if not InitCurCodeTool(Code) then exit;
4501 try
4502 Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,false);
4503 if not Result then exit;
4504 Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
4505 SourceChangeCache);
4506 except
4507 on e: Exception do Result:=HandleException(e);
4508 end;
4509 finally
4510 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4511 end;
4512 end;
4513
RemoveApplicationScaledStatementnull4514 function TCodeToolManager.RemoveApplicationScaledStatement(Code: TCodeBuffer
4515 ): boolean;
4516 begin
4517 Result:=false;
4518 {$IFDEF CTDEBUG}
4519 DebugLn('TCodeToolManager.RemoveApplicationScaledStatement A ',Code.Filename);
4520 {$ENDIF}
4521 if not InitCurCodeTool(Code) then exit;
4522 try
4523 Result:=FCurCodeTool.RemoveApplicationScaledStatement(SourceChangeCache);
4524 except
4525 on e: Exception do Result:=HandleException(e);
4526 end;
4527 end;
4528
FindAliasDefinitionsnull4529 function TCodeToolManager.FindAliasDefinitions(Code: TCodeBuffer; out
4530 TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
4531 begin
4532 {$IFDEF CTDEBUG}
4533 DebugLn('TCodeToolManager.FindAliasDefinitions A ',Code.Filename);
4534 {$ENDIF}
4535 Result:=false;
4536 TreeOfCodeTreeNodeExt:=nil;
4537 if not InitCurCodeTool(Code) then exit;
4538 try
4539 Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,
4540 OnlyWrongType);
4541 except
4542 on e: Exception do Result:=HandleException(e);
4543 end;
4544 end;
4545
FixAliasDefinitionsnull4546 function TCodeToolManager.FixAliasDefinitions(Code: TCodeBuffer;
4547 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4548 begin
4549 {$IFDEF CTDEBUG}
4550 DebugLn('TCodeToolManager.FixAliasDefinitions A ',Code.Filename);
4551 {$ENDIF}
4552 Result:=false;
4553 if not InitCurCodeTool(Code) then exit;
4554 try
4555 Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
4556 SourceChangeCache);
4557 except
4558 on e: Exception do Result:=HandleException(e);
4559 end;
4560 end;
4561
FixAllAliasDefinitionsnull4562 function TCodeToolManager.FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
4563 var
4564 TreeOfCodeTreeNodeExt: TAVLTree;
4565 begin
4566 {$IFDEF CTDEBUG}
4567 DebugLn('TCodeToolManager.FixAllAliasDefinitions A ',Code.Filename);
4568 {$ENDIF}
4569 Result:=false;
4570 TreeOfCodeTreeNodeExt:=nil;
4571 try
4572 TreeOfCodeTreeNodeExt:=nil;
4573 if not InitCurCodeTool(Code) then exit;
4574 try
4575 Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,true);
4576 if not Result then exit;
4577 Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
4578 SourceChangeCache);
4579 except
4580 on e: Exception do Result:=HandleException(e);
4581 end;
4582 finally
4583 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4584 end;
4585 end;
4586
TCodeToolManager.FindConstFunctionsnull4587 function TCodeToolManager.FindConstFunctions(Code: TCodeBuffer; out
4588 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4589 begin
4590 {$IFDEF CTDEBUG}
4591 DebugLn('TCodeToolManager.FindConstFunctions A ',Code.Filename);
4592 {$ENDIF}
4593 Result:=false;
4594 TreeOfCodeTreeNodeExt:=nil;
4595 if not InitCurCodeTool(Code) then exit;
4596 try
4597 Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
4598 except
4599 on e: Exception do Result:=HandleException(e);
4600 end;
4601 end;
4602
ReplaceConstFunctionsnull4603 function TCodeToolManager.ReplaceConstFunctions(Code: TCodeBuffer;
4604 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4605 begin
4606 {$IFDEF CTDEBUG}
4607 DebugLn('TCodeToolManager.ReplaceConstFunctions A ',Code.Filename);
4608 {$ENDIF}
4609 Result:=false;
4610 if not InitCurCodeTool(Code) then exit;
4611 try
4612 Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
4613 SourceChangeCache);
4614 except
4615 on e: Exception do Result:=HandleException(e);
4616 end;
4617 end;
4618
TCodeToolManager.ReplaceAllConstFunctionsnull4619 function TCodeToolManager.ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
4620 var
4621 TreeOfCodeTreeNodeExt: TAVLTree;
4622 begin
4623 {$IFDEF CTDEBUG}
4624 DebugLn('TCodeToolManager.ReplaceAllConstFunctions A ',Code.Filename);
4625 {$ENDIF}
4626 Result:=false;
4627 if not InitCurCodeTool(Code) then exit;
4628 try
4629 repeat
4630 TreeOfCodeTreeNodeExt:=nil;
4631 try
4632 Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
4633 if (not Result) or (TreeOfCodeTreeNodeExt=nil)
4634 or (TreeOfCodeTreeNodeExt.Count=0) then
4635 break;
4636 Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
4637 SourceChangeCache);
4638 finally
4639 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4640 end;
4641 until not Result;
4642 except
4643 on e: Exception do Result:=HandleException(e);
4644 end;
4645 end;
4646
TCodeToolManager.FindTypeCastFunctionsnull4647 function TCodeToolManager.FindTypeCastFunctions(Code: TCodeBuffer; out
4648 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4649 begin
4650 {$IFDEF CTDEBUG}
4651 DebugLn('TCodeToolManager.FindTypeCastFunctions A ',Code.Filename);
4652 {$ENDIF}
4653 Result:=false;
4654 TreeOfCodeTreeNodeExt:=nil;
4655 if not InitCurCodeTool(Code) then exit;
4656 try
4657 Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
4658 except
4659 on e: Exception do Result:=HandleException(e);
4660 end;
4661 end;
4662
ReplaceTypeCastFunctionsnull4663 function TCodeToolManager.ReplaceTypeCastFunctions(Code: TCodeBuffer;
4664 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4665 begin
4666 {$IFDEF CTDEBUG}
4667 DebugLn('TCodeToolManager.ReplaceTypeCastFunctions A ',Code.Filename);
4668 {$ENDIF}
4669 Result:=false;
4670 if not InitCurCodeTool(Code) then exit;
4671 try
4672 Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
4673 SourceChangeCache);
4674 except
4675 on e: Exception do Result:=HandleException(e);
4676 end;
4677 end;
4678
ReplaceAllTypeCastFunctionsnull4679 function TCodeToolManager.ReplaceAllTypeCastFunctions(Code: TCodeBuffer
4680 ): boolean;
4681 var
4682 TreeOfCodeTreeNodeExt: TAVLTree;
4683 begin
4684 {$IFDEF CTDEBUG}
4685 DebugLn('TCodeToolManager.ReplaceAllTypeCastFunctions A ',Code.Filename);
4686 {$ENDIF}
4687 Result:=false;
4688 if not InitCurCodeTool(Code) then exit;
4689 try
4690 repeat
4691 TreeOfCodeTreeNodeExt:=nil;
4692 try
4693 Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
4694 if (not Result) or (TreeOfCodeTreeNodeExt=nil)
4695 or (TreeOfCodeTreeNodeExt.Count=0) then
4696 break;
4697 Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
4698 SourceChangeCache);
4699 finally
4700 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4701 end;
4702 until not Result;
4703 except
4704 on e: Exception do Result:=HandleException(e);
4705 end;
4706 end;
4707
TCodeToolManager.FixForwardDefinitionsnull4708 function TCodeToolManager.FixForwardDefinitions(Code: TCodeBuffer): boolean;
4709 begin
4710 {$IFDEF CTDEBUG}
4711 DebugLn('TCodeToolManager.FixForwardDefinitions A ',Code.Filename);
4712 {$ENDIF}
4713 Result:=false;
4714 if not InitCurCodeTool(Code) then exit;
4715 try
4716 Result:=FCurCodeTool.FixForwardDefinitions(SourceChangeCache);
4717 except
4718 on e: Exception do Result:=HandleException(e);
4719 end;
4720 end;
4721
FindEmptyMethodsnull4722 function TCodeToolManager.FindEmptyMethods(Code: TCodeBuffer;
4723 const AClassName: string; X, Y: integer;
4724 const Sections: TPascalClassSections; ListOfPCodeXYPosition: TFPList;
4725 out AllEmpty: boolean): boolean;
4726 var
4727 CursorPos: TCodeXYPosition;
4728 begin
4729 {$IFDEF CTDEBUG}
4730 DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
4731 {$ENDIF}
4732 Result:=false;
4733 if not InitCurCodeTool(Code) then exit;
4734 CursorPos.X:=X;
4735 CursorPos.Y:=Y;
4736 CursorPos.Code:=Code;
4737 try
4738 Result:=FCurCodeTool.FindEmptyMethods(CursorPos,AClassName,Sections,
4739 ListOfPCodeXYPosition,AllEmpty);
4740 except
4741 on e: Exception do Result:=HandleException(e);
4742 end;
4743 end;
4744
RemoveEmptyMethodsnull4745 function TCodeToolManager.RemoveEmptyMethods(Code: TCodeBuffer;
4746 const AClassName: string; X,Y: integer;
4747 const Sections: TPascalClassSections; out AllRemoved: boolean;
4748 const Attr: TProcHeadAttributes; out RemovedProcHeads: TStrings): boolean;
4749 var
4750 CursorPos: TCodeXYPosition;
4751 begin
4752 {$IFDEF CTDEBUG}
4753 DebugLn('TCodeToolManager.RemoveEmptyMethods A ',Code.Filename);
4754 {$ENDIF}
4755 Result:=false;
4756 if not InitCurCodeTool(Code) then exit;
4757 CursorPos.X:=X;
4758 CursorPos.Y:=Y;
4759 CursorPos.Code:=Code;
4760 try
4761 Result:=FCurCodeTool.RemoveEmptyMethods(CursorPos,AClassName,Sections,
4762 SourceChangeCache,AllRemoved,Attr,RemovedProcHeads);
4763 except
4764 on e: Exception do Result:=HandleException(e);
4765 end;
4766 end;
4767
TCodeToolManager.FindUnusedUnitsnull4768 function TCodeToolManager.FindUnusedUnits(Code: TCodeBuffer; Units: TStrings
4769 ): boolean;
4770 begin
4771 {$IFDEF CTDEBUG}
4772 DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
4773 {$ENDIF}
4774 Result:=false;
4775 if not InitCurCodeTool(Code) then exit;
4776 try
4777 Result:=FCurCodeTool.FindUnusedUnits(Units);
4778 except
4779 on e: Exception do Result:=HandleException(e);
4780 end;
4781 end;
4782
InitClassCompletionnull4783 function TCodeToolManager.InitClassCompletion(Code: TCodeBuffer;
4784 const AClassName: string; out CodeTool: TCodeTool): boolean;
4785 begin
4786 {$IFDEF CTDEBUG}
4787 DebugLn('TCodeToolManager.InitClassCompletion A ',Code.Filename);
4788 {$ENDIF}
4789 Result:=false;
4790 CodeTool:=nil;
4791 if not InitCurCodeTool(Code) then exit;
4792 try
4793 Result:=FCurCodeTool.InitClassCompletion(AClassName,SourceChangeCache);
4794 CodeTool:=FCurCodeTool;
4795 except
4796 on e: Exception do Result:=HandleException(e);
4797 end;
4798 end;
4799
CheckExtractProcnull4800 function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
4801 EndPoint: TPoint; out MethodPossible, SubProcPossible,
4802 SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree;
4803 VarTree: TAVLTree): boolean;
4804 var
4805 StartPos, EndPos: TCodeXYPosition;
4806 begin
4807 {$IFDEF CTDEBUG}
4808 DebugLn('TCodeToolManager.CheckExtractProc A ',Code.Filename);
4809 {$ENDIF}
4810 Result:=false;
4811 if not InitCurCodeTool(Code) then exit;
4812 StartPos.X:=StartPoint.X;
4813 StartPos.Y:=StartPoint.Y;
4814 StartPos.Code:=Code;
4815 EndPos.X:=EndPoint.X;
4816 EndPos.Y:=EndPoint.Y;
4817 EndPos.Code:=Code;
4818 try
4819 Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
4820 SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,
4821 VarTree);
4822 except
4823 on e: Exception do Result:=HandleException(e);
4824 end;
4825 end;
4826
ExtractProcnull4827 function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint,
4828 EndPoint: TPoint; ProcType: TExtractProcType; const ProcName: string;
4829 IgnoreIdentifiers: TAVLTree; var NewCode: TCodeBuffer; var NewX, NewY,
4830 NewTopLine, BlockTopLine, BlockBottomLine: integer;
4831 FunctionResultVariableStartPos: integer): boolean;
4832 var
4833 StartPos, EndPos: TCodeXYPosition;
4834 NewPos: TCodeXYPosition;
4835 begin
4836 {$IFDEF CTDEBUG}
4837 DebugLn('TCodeToolManager.ExtractProc A ',Code.Filename);
4838 {$ENDIF}
4839 Result:=false;
4840 if not InitCurCodeTool(Code) then exit;
4841 StartPos.X:=StartPoint.X;
4842 StartPos.Y:=StartPoint.Y;
4843 StartPos.Code:=Code;
4844 EndPos.X:=EndPoint.X;
4845 EndPos.Y:=EndPoint.Y;
4846 EndPos.Code:=Code;
4847 try
4848 Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
4849 IgnoreIdentifiers,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache,
4850 FunctionResultVariableStartPos);
4851 if Result then begin
4852 NewX:=NewPos.X;
4853 NewY:=NewPos.Y;
4854 NewCode:=NewPos.Code;
4855 end;
4856 except
4857 on e: Exception do Result:=HandleException(e);
4858 end;
4859 end;
4860
FindAssignMethodnull4861 function TCodeToolManager.FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
4862 out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
4863 out AssignDeclNode: TCodeTreeNode; var MemberNodeExts: TAVLTree;
4864 out AssignBodyNode: TCodeTreeNode; out InheritedDeclContext: TFindContext;
4865 ProcName: string): boolean;
4866 var
4867 CodePos: TCodeXYPosition;
4868 begin
4869 {$IFDEF CTDEBUG}
4870 DebugLn('TCodeToolManager.FindAssignMethod A ',Code.Filename);
4871 {$ENDIF}
4872 Result:=false;
4873 AssignDeclNode:=nil;
4874 AssignBodyNode:=nil;
4875 if not InitCurCodeTool(Code) then exit;
4876 Tool:=FCurCodeTool;
4877 CodePos.X:=X;
4878 CodePos.Y:=Y;
4879 CodePos.Code:=Code;
4880 try
4881 Result:=FCurCodeTool.FindAssignMethod(CodePos,ClassNode,
4882 AssignDeclNode,MemberNodeExts,AssignBodyNode,
4883 InheritedDeclContext,ProcName);
4884 except
4885 on e: Exception do Result:=HandleException(e);
4886 end;
4887 end;
4888
GetSourceNamenull4889 function TCodeToolManager.GetSourceName(Code: TCodeBuffer;
4890 SearchMainCode: boolean): string;
4891 begin
4892 Result:='';
4893 if (Code=nil)
4894 or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
4895 {$IFDEF CTDEBUG}
4896 DebugLn('TCodeToolManager.GetSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
4897 {$ENDIF}
4898 {$IFDEF MEM_CHECK}
4899 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4900 {$ENDIF}
4901 if not InitCurCodeTool(Code) then exit;
4902 try
4903 Result:=FCurCodeTool.GetSourceName;
4904 except
4905 on e: Exception do begin
4906 Result:=FCurCodeTool.ExtractSourceName;
4907 HandleException(e);
4908 end;
4909 end;
4910 {$IFDEF CTDEBUG}
4911 DebugLn('TCodeToolManager.GetSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
4912 {$IFDEF MEM_CHECK}
4913 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4914 {$ENDIF}
4915 DebugLn('SourceName=',Result);
4916 {$ENDIF}
4917 end;
4918
TCodeToolManager.GetCachedSourceNamenull4919 function TCodeToolManager.GetCachedSourceName(Code: TCodeBuffer): string;
4920 begin
4921 Result:='';
4922 if (Code=nil)
4923 or (Code.LastIncludedByFile<>'') then exit;
4924 {$IFDEF CTDEBUG}
4925 DebugLn('TCodeToolManager.GetCachedSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
4926 {$ENDIF}
4927 {$IFDEF MEM_CHECK}
4928 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4929 {$ENDIF}
4930 if not InitCurCodeTool(Code) then exit;
4931 try
4932 Result:=FCurCodeTool.GetCachedSourceName;
4933 except
4934 on e: Exception do HandleException(e);
4935 end;
4936 {$IFDEF CTDEBUG}
4937 DebugLn('TCodeToolManager.GetCachedSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
4938 {$IFDEF MEM_CHECK}
4939 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4940 {$ENDIF}
4941 DebugLn('SourceName=',Result);
4942 {$ENDIF}
4943 end;
4944
TCodeToolManager.GetSourceTypenull4945 function TCodeToolManager.GetSourceType(Code: TCodeBuffer;
4946 SearchMainCode: boolean): string;
4947 begin
4948 Result:='';
4949 if (Code=nil)
4950 or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
4951 {$IFDEF CTDEBUG}
4952 DebugLn('TCodeToolManager.GetSourceType A ',Code.Filename,' ',dbgs(Code.SourceLength));
4953 {$ENDIF}
4954 if not InitCurCodeTool(Code) then exit;
4955 try
4956 // GetSourceType does not parse the code -> parse it with GetSourceName
4957 FCurCodeTool.GetSourceName;
4958 case FCurCodeTool.GetSourceType of
4959 ctnProgram: Result:='PROGRAM';
4960 ctnPackage: Result:='PACKAGE';
4961 ctnLibrary: Result:='LIBRARY';
4962 ctnUnit: Result:='UNIT';
4963 else
4964 Result:='';
4965 end;
4966 except
4967 on e: Exception do HandleException(e);
4968 end;
4969 {$IFDEF CTDEBUG}
4970 DebugLn('TCodeToolManager.GetSourceType END ',Code.Filename,',',dbgs(Code.SourceLength));
4971 {$IFDEF MEM_CHECK}
4972 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4973 {$ENDIF}
4974 DebugLn('SourceType=',Result);
4975 {$ENDIF}
4976 end;
4977
RenameSourcenull4978 function TCodeToolManager.RenameSource(Code: TCodeBuffer;
4979 const NewName: string): boolean;
4980 begin
4981 Result:=false;
4982 {$IFDEF CTDEBUG}
4983 DebugLn('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
4984 {$ENDIF}
4985 if not InitCurCodeTool(Code) then exit;
4986 try
4987 Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache);
4988 except
4989 on e: Exception do Result:=HandleException(e);
4990 end;
4991 end;
4992
TCodeToolManager.FindUnitInAllUsesSectionsnull4993 function TCodeToolManager.FindUnitInAllUsesSections(Code: TCodeBuffer;
4994 const AnUnitName: string; out NamePos, InPos: integer;
4995 const IgnoreMissingIncludeFiles: Boolean = False): boolean;
4996 var
4997 NameAtomPos, InAtomPos: TAtomPosition;
4998 OldIgnoreMissingIncludeFiles: Boolean;
4999 begin
5000 Result:=false;
5001 {$IFDEF CTDEBUG}
5002 DebugLn('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
5003 {$ENDIF}
5004 if not InitCurCodeTool(Code) then exit;
5005 {$IFDEF CTDEBUG}
5006 DebugLn('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' AUnitName=',AnUnitName);
5007 {$ENDIF}
5008 OldIgnoreMissingIncludeFiles := FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
5009 try
5010 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := IgnoreMissingIncludeFiles;
5011 Result:=FCurCodeTool.FindUnitInAllUsesSections(AnUnitName,
5012 NameAtomPos, InAtomPos);
5013 if Result then begin
5014 NamePos:=NameAtomPos.StartPos;
5015 InPos:=InAtomPos.StartPos;
5016 end;
5017 except
5018 on e: Exception do Result:=HandleException(e);
5019 end;
5020 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := OldIgnoreMissingIncludeFiles;
5021 end;
5022
TCodeToolManager.RenameUsedUnitnull5023 function TCodeToolManager.RenameUsedUnit(Code: TCodeBuffer;
5024 const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
5025 begin
5026 Result:=false;
5027 {$IFDEF CTDEBUG}
5028 DebugLn('TCodeToolManager.RenameUsedUnit A ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
5029 {$ENDIF}
5030 if not InitCurCodeTool(Code) then exit;
5031 try
5032 Result:=FCurCodeTool.RenameUsedUnit(OldUnitName,NewUnitName,
5033 NewUnitInFile,SourceChangeCache);
5034 except
5035 on e: Exception do Result:=HandleException(e);
5036 end;
5037 end;
5038
ReplaceUsedUnitsnull5039 function TCodeToolManager.ReplaceUsedUnits(Code: TCodeBuffer;
5040 UnitNamePairs: TStringToStringTree): boolean;
5041 begin
5042 Result:=false;
5043 {$IFDEF CTDEBUG}
5044 DebugLn('TCodeToolManager.ReplaceUsedUnits A ',Code.Filename);
5045 {$ENDIF}
5046 if not InitCurCodeTool(Code) then exit;
5047 try
5048 Result:=FCurCodeTool.ReplaceUsedUnits(UnitNamePairs,SourceChangeCache);
5049 except
5050 on e: Exception do Result:=HandleException(e);
5051 end;
5052 end;
5053
AddUnitToMainUsesSectionnull5054 function TCodeToolManager.AddUnitToMainUsesSection(Code: TCodeBuffer;
5055 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5056 CheckSpecialUnits: boolean = true): boolean;
5057 begin
5058 Result:=false;
5059 {$IFDEF CTDEBUG}
5060 DebugLn('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
5061 {$ENDIF}
5062 if not InitCurCodeTool(Code) then exit;
5063 try
5064 Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
5065 SourceChangeCache,AsLast,CheckSpecialUnits);
5066 except
5067 on e: Exception do Result:=HandleException(e);
5068 end;
5069 end;
5070
AddUnitToMainUsesSectionIfNeedednull5071 function TCodeToolManager.AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
5072 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5073 CheckSpecialUnits: boolean): boolean;
5074 var
5075 NamePos, InPos: TAtomPosition;
5076 begin
5077 Result:=false;
5078 {$IFDEF CTDEBUG}
5079 DebugLn('TCodeToolManager.AddUnitToMainUsesSectionIfNeeded A ',Code.Filename,' NewUnitName=',NewUnitName);
5080 {$ENDIF}
5081 if not InitCurCodeTool(Code) then exit;
5082 try
5083 if not FCurCodeTool.FindUnitInAllUsesSections(NewUnitName,NamePos,InPos) then
5084 Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
5085 SourceChangeCache,AsLast,CheckSpecialUnits);
5086 except
5087 on e: Exception do Result:=HandleException(e);
5088 end;
5089 end;
5090
AddUnitToImplementationUsesSectionnull5091 function TCodeToolManager.AddUnitToImplementationUsesSection(Code: TCodeBuffer;
5092 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5093 CheckSpecialUnits: boolean): boolean;
5094 begin
5095 Result:=false;
5096 {$IFDEF CTDEBUG}
5097 DebugLn('TCodeToolManager.AddUnitToImplementationUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
5098 {$ENDIF}
5099 if not InitCurCodeTool(Code) then exit;
5100 try
5101 Result:=FCurCodeTool.AddUnitToImplementationUsesSection(
5102 NewUnitName, NewUnitInFile,
5103 SourceChangeCache,AsLast,CheckSpecialUnits);
5104 except
5105 on e: Exception do Result:=HandleException(e);
5106 end;
5107 end;
5108
TCodeToolManager.RemoveUnitFromAllUsesSectionsnull5109 function TCodeToolManager.RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
5110 const AnUnitName: string): boolean;
5111 begin
5112 Result:=false;
5113 {$IFDEF CTDEBUG}
5114 DebugLn('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
5115 {$ENDIF}
5116 if not InitCurCodeTool(Code) then exit;
5117 try
5118 Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(AnUnitName,
5119 SourceChangeCache);
5120 except
5121 on e: Exception do Result:=HandleException(e);
5122 end;
5123 end;
5124
TCodeToolManager.FindUsedUnitFilesnull5125 function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
5126 var MainUsesSection: TStrings): boolean;
5127 begin
5128 Result:=false;
5129 {$IFDEF CTDEBUG}
5130 DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
5131 {$ENDIF}
5132 if not InitCurCodeTool(Code) then exit;
5133 try
5134 Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection);
5135 except
5136 on e: Exception do Result:=HandleException(e);
5137 end;
5138 end;
5139
TCodeToolManager.FindUsedUnitFilesnull5140 function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
5141 var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
5142 begin
5143 Result:=false;
5144 {$IFDEF CTDEBUG}
5145 DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
5146 {$ENDIF}
5147 if not InitCurCodeTool(Code) then exit;
5148 try
5149 Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection,
5150 ImplementationUsesSection);
5151 except
5152 on e: Exception do Result:=HandleException(e);
5153 end;
5154 end;
5155
FindUsedUnitNamesnull5156 function TCodeToolManager.FindUsedUnitNames(Code: TCodeBuffer;
5157 var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
5158 begin
5159 Result:=false;
5160 {$IFDEF CTDEBUG}
5161 DebugLn('TCodeToolManager.FindUsedUnitNames A ',Code.Filename);
5162 {$ENDIF}
5163 if not InitCurCodeTool(Code) then exit;
5164 try
5165 Result:=FCurCodeTool.FindUsedUnitNames(MainUsesSection,
5166 ImplementationUsesSection);
5167 except
5168 on e: Exception do Result:=HandleException(e);
5169 end;
5170 end;
5171
FindMissingUnitsnull5172 function TCodeToolManager.FindMissingUnits(Code: TCodeBuffer;
5173 var MissingUnits: TStrings; FixCase: boolean;
5174 SearchImplementation: boolean): boolean;
5175 begin
5176 Result:=false;
5177 {$IFDEF CTDEBUG}
5178 DebugLn('TCodeToolManager.FindMissingUnits A ',Code.Filename);
5179 {$ENDIF}
5180 if not InitCurCodeTool(Code) then exit;
5181 try
5182 Result:=FCurCodeTool.FindMissingUnits(MissingUnits,FixCase,
5183 SearchImplementation,SourceChangeCache);
5184 except
5185 on e: Exception do Result:=HandleException(e);
5186 end;
5187 end;
5188
FindDelphiProjectUnitsnull5189 function TCodeToolManager.FindDelphiProjectUnits(Code: TCodeBuffer;
5190 out FoundInUnits, MissingInUnits, NormalUnits: TStrings;
5191 IgnoreNormalUnits: boolean): boolean;
5192 begin
5193 Result:=false;
5194 {$IFDEF CTDEBUG}
5195 DebugLn('TCodeToolManager.FindDelphiProjectUnits A ',Code.Filename);
5196 {$ENDIF}
5197 if not InitCurCodeTool(Code) then exit;
5198 try
5199 Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits, MissingInUnits,
5200 NormalUnits, false, IgnoreNormalUnits);
5201 except
5202 on e: Exception do Result:=HandleException(e);
5203 end;
5204 end;
5205
TCodeToolManager.FindDelphiPackageUnitsnull5206 function TCodeToolManager.FindDelphiPackageUnits(Code: TCodeBuffer;
5207 var FoundInUnits, MissingInUnits, NormalUnits: TStrings;
5208 IgnoreNormalUnits: boolean): boolean;
5209 begin
5210 Result:=false;
5211 {$IFDEF CTDEBUG}
5212 DebugLn('TCodeToolManager.FindDelphiPackageUnits A ',Code.Filename);
5213 {$ENDIF}
5214 if not InitCurCodeTool(Code) then exit;
5215 try
5216 Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits,
5217 MissingInUnits,NormalUnits,true,IgnoreNormalUnits);
5218 except
5219 on e: Exception do Result:=HandleException(e);
5220 end;
5221 end;
5222
CommentUnitsInUsesSectionsnull5223 function TCodeToolManager.CommentUnitsInUsesSections(Code: TCodeBuffer;
5224 MissingUnits: TStrings): boolean;
5225 begin
5226 Result:=false;
5227 {$IFDEF CTDEBUG}
5228 DebugLn('TCodeToolManager.CommentUnitsInUsesSections A ',Code.Filename);
5229 {$ENDIF}
5230 if not InitCurCodeTool(Code) then exit;
5231 try
5232 Result:=FCurCodeTool.CommentUnitsInUsesSections(MissingUnits,
5233 SourceChangeCache);
5234 except
5235 on e: Exception do Result:=HandleException(e);
5236 end;
5237 end;
5238
TCodeToolManager.FindUnitCaseInsensitivenull5239 function TCodeToolManager.FindUnitCaseInsensitive(Code: TCodeBuffer;
5240 var AnUnitName, AnUnitInFilename: string): string;
5241 begin
5242 Result:='';
5243 {$IFDEF CTDEBUG}
5244 DebugLn('TCodeToolManager.FindUnitCaseInsensitive A ',Code.Filename,' AnUnitName="',AnUnitName,'"',' AnUnitInFilename="',AnUnitInFilename,'"');
5245 {$ENDIF}
5246 if not InitCurCodeTool(Code) then exit;
5247 try
5248 Result:=FCurCodeTool.FindUnitCaseInsensitive(AnUnitName,AnUnitInFilename);
5249 except
5250 on e: Exception do HandleException(e);
5251 end;
5252 end;
5253
FindUnitSourcenull5254 function TCodeToolManager.FindUnitSource(Code: TCodeBuffer; const AnUnitName,
5255 AnUnitInFilename: string): TCodeBuffer;
5256 begin
5257 Result:=nil;
5258 {$IFDEF CTDEBUG}
5259 DebugLn('TCodeToolManager.FindUnit A ',Code.Filename,' AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'"');
5260 {$ENDIF}
5261 if not InitCurCodeTool(Code) then exit;
5262 try
5263 Result:=FCurCodeTool.FindUnitSource(AnUnitName,AnUnitInFilename,false);
5264 except
5265 on e: Exception do HandleException(e);
5266 end;
5267 end;
5268
CreateUsesGraphnull5269 function TCodeToolManager.CreateUsesGraph: TUsesGraph;
5270 begin
5271 Result:=TUsesGraph.Create;
5272 Result.DirectoryCachePool:=DirectoryCachePool;
5273 Result.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
5274 Result.OnLoadFile:=@DoOnLoadFileForTool;
5275 end;
5276
FindLFMFileNamenull5277 function TCodeToolManager.FindLFMFileName(Code: TCodeBuffer): string;
5278 var LinkIndex: integer;
5279 CurCode: TCodeBuffer;
5280 Ext: string;
5281 begin
5282 Result:='';
5283 {$IFDEF CTDEBUG}
5284 DebugLn('TCodeToolManager.FindLFMFileName A ',Code.Filename);
5285 {$ENDIF}
5286 if not InitCurCodeTool(Code) then exit;
5287 try
5288 LinkIndex:=-1;
5289 CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5290 while (CurCode<>nil) do begin
5291 if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin
5292 Result:=CurCode.Filename;
5293 Ext:=ExtractFileExt(Result);
5294 Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm';
5295 exit;
5296 end;
5297 CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5298 end;
5299 except
5300 on e: Exception do HandleException(e);
5301 end;
5302 end;
5303
TCodeToolManager.CheckLFMnull5304 function TCodeToolManager.CheckLFM(UnitCode, LFMBuf: TCodeBuffer;
5305 out LFMTree: TLFMTree; RootMustBeClassInUnit, RootMustBeClassInIntf,
5306 ObjectsMustExist: boolean): boolean;
5307 begin
5308 Result:=false;
5309 {$IFDEF CTDEBUG}
5310 DebugLn('TCodeToolManager.CheckLFM A ',UnitCode.Filename,' ',LFMBuf.Filename);
5311 {$ENDIF}
5312 if not InitCurCodeTool(UnitCode) then exit;
5313 try
5314 Result:=FCurCodeTool.CheckLFM(LFMBuf,LFMTree,OnFindDefinePropertyForContext,
5315 RootMustBeClassInUnit,RootMustBeClassInIntf,ObjectsMustExist);
5316 except
5317 on e: Exception do HandleException(e);
5318 end;
5319 end;
5320
TCodeToolManager.FindNextResourceFilenull5321 function TCodeToolManager.FindNextResourceFile(Code: TCodeBuffer;
5322 var LinkIndex: integer): TCodeBuffer;
5323 begin
5324 Result:=nil;
5325 {$IFDEF CTDEBUG}
5326 DebugLn('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
5327 {$ENDIF}
5328 if not InitCurCodeTool(Code) then exit;
5329 try
5330 Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5331 except
5332 on e: Exception do HandleException(e);
5333 end;
5334 end;
5335
TCodeToolManager.AddLazarusResourceHeaderCommentnull5336 function TCodeToolManager.AddLazarusResourceHeaderComment(Code: TCodeBuffer;
5337 const CommentText: string): boolean;
5338 begin
5339 Result:=false;
5340 if not InitResourceTool then exit;
5341 {$IFDEF CTDEBUG}
5342 DebugLn('TCodeToolManager.AddLazarusResourceHeaderComment A ',Code.Filename,' CommentText=',CommentText);
5343 {$ENDIF}
5344 try
5345 Result:=GetResourceTool.AddLazarusResourceHeaderComment(Code,
5346 '{ '+CommentText+' }'+SourceChangeCache.BeautifyCodeOptions.LineEnd
5347 +SourceChangeCache.BeautifyCodeOptions.LineEnd);
5348 except
5349 on e: Exception do HandleException(e);
5350 end;
5351 end;
5352
TCodeToolManager.FindLazarusResourcenull5353 function TCodeToolManager.FindLazarusResource(Code: TCodeBuffer;
5354 const ResourceName: string): TAtomPosition;
5355 begin
5356 Result.StartPos:=-1;
5357 if not InitResourceTool then exit;
5358 {$IFDEF CTDEBUG}
5359 DebugLn('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
5360 {$ENDIF}
5361 try
5362 Result:=GetResourceTool.FindLazarusResource(Code,ResourceName,-1);
5363 except
5364 on e: Exception do HandleException(e);
5365 end;
5366 end;
5367
TCodeToolManager.AddLazarusResourcenull5368 function TCodeToolManager.AddLazarusResource(Code: TCodeBuffer;
5369 const ResourceName, ResourceData: string): boolean;
5370 begin
5371 Result:=false;
5372 {$IFDEF CTDEBUG}
5373 DebugLn('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',dbgs(length(ResourceData)));
5374 {$ENDIF}
5375 if not InitResourceTool then exit;
5376 {$IFDEF CTDEBUG}
5377 DebugLn('TCodeToolManager.AddLazarusResource B ');
5378 {$ENDIF}
5379 try
5380 Result:=GetResourceTool.AddLazarusResource(Code,ResourceName,ResourceData);
5381 except
5382 on e: Exception do Result:=HandleException(e);
5383 end;
5384 end;
5385
TCodeToolManager.RemoveLazarusResourcenull5386 function TCodeToolManager.RemoveLazarusResource(Code: TCodeBuffer;
5387 const ResourceName: string): boolean;
5388 begin
5389 Result:=false;
5390 {$IFDEF CTDEBUG}
5391 DebugLn('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
5392 {$ENDIF}
5393 if not InitResourceTool then exit;
5394 try
5395 Result:=GetResourceTool.RemoveLazarusResource(Code,ResourceName);
5396 except
5397 on e: Exception do Result:=HandleException(e);
5398 end;
5399 end;
5400
RenameMainIncludenull5401 function TCodeToolManager.RenameMainInclude(Code: TCodeBuffer;
5402 const NewFilename: string; KeepPath: boolean): boolean;
5403 var
5404 LinkIndex: integer;
5405 OldIgnoreMissingIncludeFiles: boolean;
5406 begin
5407 Result:=false;
5408 {$IFDEF CTDEBUG}
5409 DebugLn('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
5410 {$ENDIF}
5411 if not InitCurCodeTool(Code) then exit;
5412 try
5413 OldIgnoreMissingIncludeFiles:=
5414 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
5415 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=true;
5416 LinkIndex:=-1;
5417 if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
5418 Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
5419 SourceChangeCache);
5420 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=
5421 OldIgnoreMissingIncludeFiles;
5422 except
5423 on e: Exception do Result:=HandleException(e);
5424 end;
5425 end;
5426
RenameIncludeDirectivenull5427 function TCodeToolManager.RenameIncludeDirective(Code: TCodeBuffer;
5428 LinkIndex: integer; const NewFilename: string; KeepPath: boolean): boolean;
5429 begin
5430 Result:=false;
5431 {$IFDEF CTDEBUG}
5432 DebugLn('TCodeToolManager.RenameIncludeDirective A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
5433 {$ENDIF}
5434 if not InitCurCodeTool(Code) then exit;
5435 try
5436 Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
5437 SourceChangeCache);
5438 except
5439 on e: Exception do Result:=HandleException(e);
5440 end;
5441 end;
5442
5443 procedure TCodeToolManager.DefaultFindDefinePropertyForContext(Sender: TObject;
5444 const ClassContext, AncestorClassContext: TFindContext; LFMNode: TLFMTreeNode;
5445 const IdentName: string; var IsDefined: boolean);
5446 var
5447 PersistentClassName: String;
5448 AncestorClassName: String;
5449 begin
5450 if Assigned(OnFindDefineProperty) then begin
5451 PersistentClassName:=ClassContext.Tool.ExtractClassName(
5452 ClassContext.Node,false);
5453 AncestorClassName:='';
5454 if AncestorClassContext.Tool<>nil then
5455 AncestorClassName:=AncestorClassContext.Tool.ExtractClassName(
5456 AncestorClassContext.Node,false);
5457 OnFindDefineProperty(ClassContext.Tool,
5458 PersistentClassName,AncestorClassName,IdentName,
5459 IsDefined);
5460 end;
5461 end;
5462
TCodeToolManager.FindCreateFormStatementnull5463 function TCodeToolManager.FindCreateFormStatement(Code: TCodeBuffer;
5464 StartPos: integer;
5465 const AClassName, AVarName: string;
5466 out Position: integer): integer;
5467 // 0=found, -1=not found, 1=found, but wrong classname
5468 var PosAtom: TAtomPosition;
5469 begin
5470 Result:=-1;
5471 {$IFDEF CTDEBUG}
5472 DebugLn('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',dbgs(StartPos),' ',AClassName,':',AVarName);
5473 {$ENDIF}
5474 if not InitCurCodeTool(Code) then exit;
5475 try
5476 Result:=FCurCodeTool.FindCreateFormStatement(StartPos,AClassName,
5477 AVarName,PosAtom);
5478 if Result<>-1 then
5479 Position:=PosAtom.StartPos;
5480 except
5481 on e: Exception do HandleException(e);
5482 end;
5483 end;
5484
TCodeToolManager.AddCreateFormStatementnull5485 function TCodeToolManager.AddCreateFormStatement(Code: TCodeBuffer;
5486 const AClassName, AVarName: string): boolean;
5487 begin
5488 Result:=false;
5489 {$IFDEF CTDEBUG}
5490 DebugLn('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
5491 {$ENDIF}
5492 if not InitCurCodeTool(Code) then exit;
5493 try
5494 Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName,
5495 SourceChangeCache);
5496 except
5497 on e: Exception do Result:=HandleException(e);
5498 end;
5499 end;
5500
TCodeToolManager.RemoveCreateFormStatementnull5501 function TCodeToolManager.RemoveCreateFormStatement(Code: TCodeBuffer;
5502 const AVarName: string): boolean;
5503 begin
5504 Result:=false;
5505 {$IFDEF CTDEBUG}
5506 DebugLn('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
5507 {$ENDIF}
5508 if not InitCurCodeTool(Code) then exit;
5509 try
5510 Result:=FCurCodeTool.RemoveCreateFormStatement(AVarName,SourceChangeCache);
5511 except
5512 on e: Exception do Result:=HandleException(e);
5513 end;
5514 end;
5515
TCodeToolManager.ChangeCreateFormStatementnull5516 function TCodeToolManager.ChangeCreateFormStatement(Code: TCodeBuffer;
5517 const OldClassName, OldVarName: string; const NewClassName,
5518 NewVarName: string; OnlyIfExists: boolean): boolean;
5519 begin
5520 Result:=false;
5521 {$IFDEF CTDEBUG}
5522 DebugLn('TCodeToolManager.ChangeCreateFormStatement A ',Code.Filename,
5523 ' ',OldVarName+':',OldClassName,' -> ',NewVarName+':',NewClassName,
5524 ' OnlyIfExists=',dbgs(OnlyIfExists));
5525 {$ENDIF}
5526 if not InitCurCodeTool(Code) then exit;
5527 try
5528 Result:=FCurCodeTool.ChangeCreateFormStatement(-1,OldClassName,OldVarName,
5529 NewClassName,NewVarName,OnlyIfExists,
5530 SourceChangeCache);
5531 except
5532 on e: Exception do Result:=HandleException(e);
5533 end;
5534 end;
5535
ListAllCreateFormStatementsnull5536 function TCodeToolManager.ListAllCreateFormStatements(
5537 Code: TCodeBuffer): TStrings;
5538 begin
5539 Result:=nil;
5540 {$IFDEF CTDEBUG}
5541 DebugLn('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
5542 {$ENDIF}
5543 if not InitCurCodeTool(Code) then exit;
5544 try
5545 Result:=FCurCodeTool.ListAllCreateFormStatements;
5546 except
5547 on e: Exception do HandleException(e);
5548 end;
5549 end;
5550
SetAllCreateFromStatementsnull5551 function TCodeToolManager.SetAllCreateFromStatements(Code: TCodeBuffer;
5552 List: TStrings): boolean;
5553 begin
5554 Result:=false;
5555 {$IFDEF CTDEBUG}
5556 DebugLn('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
5557 {$ENDIF}
5558 if not InitCurCodeTool(Code) then exit;
5559 try
5560 Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
5561 except
5562 on e: Exception do Result:=HandleException(e);
5563 end;
5564 end;
5565
TCodeToolManager.SetApplicationScaledStatementnull5566 function TCodeToolManager.SetApplicationScaledStatement(Code: TCodeBuffer;
5567 const NewScaled: Boolean): boolean;
5568 begin
5569 Result:=false;
5570 {$IFDEF CTDEBUG}
5571 DebugLn('TCodeToolManager.SetApplicationScaledStatement A ',Code.Filename);
5572 {$ENDIF}
5573 if not InitCurCodeTool(Code) then exit;
5574 try
5575 Result:=FCurCodeTool.SetApplicationScaledStatement(NewScaled,
5576 SourceChangeCache);
5577 except
5578 on e: Exception do Result:=HandleException(e);
5579 end;
5580 end;
5581
TCodeToolManager.GetApplicationTitleStatementnull5582 function TCodeToolManager.GetApplicationTitleStatement(Code: TCodeBuffer;
5583 var Title: string): boolean;
5584 var
5585 StartPos, StringConstStartPos, EndPos: integer;
5586 begin
5587 Result:=false;
5588 {$IFDEF CTDEBUG}
5589 DebugLn('TCodeToolManager.GetApplicationTitleStatement A ',Code.Filename);
5590 {$ENDIF}
5591 if not InitCurCodeTool(Code) then exit;
5592 try
5593 Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos,
5594 StringConstStartPos,EndPos);
5595 if StartPos=0 then ;
5596 Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos,
5597 EndPos,Title);
5598 except
5599 on e: Exception do Result:=HandleException(e);
5600 end;
5601 end;
5602
TCodeToolManager.SetApplicationTitleStatementnull5603 function TCodeToolManager.SetApplicationTitleStatement(Code: TCodeBuffer;
5604 const NewTitle: string): boolean;
5605 begin
5606 Result:=false;
5607 {$IFDEF CTDEBUG}
5608 DebugLn('TCodeToolManager.SetApplicationTitleStatement A ',Code.Filename);
5609 {$ENDIF}
5610 if not InitCurCodeTool(Code) then exit;
5611 try
5612 Result:=FCurCodeTool.SetApplicationTitleStatement(NewTitle,
5613 SourceChangeCache);
5614 except
5615 on e: Exception do Result:=HandleException(e);
5616 end;
5617 end;
5618
RemoveApplicationTitleStatementnull5619 function TCodeToolManager.RemoveApplicationTitleStatement(Code: TCodeBuffer
5620 ): boolean;
5621 begin
5622 Result:=false;
5623 {$IFDEF CTDEBUG}
5624 DebugLn('TCodeToolManager.RemoveApplicationTitleStatement A ',Code.Filename);
5625 {$ENDIF}
5626 if not InitCurCodeTool(Code) then exit;
5627 try
5628 Result:=FCurCodeTool.RemoveApplicationTitleStatement(SourceChangeCache);
5629 except
5630 on e: Exception do Result:=HandleException(e);
5631 end;
5632 end;
5633
TCodeToolManager.RenameFormnull5634 function TCodeToolManager.RenameForm(Code: TCodeBuffer; const OldFormName,
5635 OldFormClassName: string; const NewFormName, NewFormClassName: string
5636 ): boolean;
5637 begin
5638 Result:=false;
5639 {$IFDEF CTDEBUG}
5640 DebugLn('TCodeToolManager.RenameForm A ',Code.Filename,
5641 ' OldFormName=',OldFormName,' OldFormClassName=',OldFormClassName,
5642 ' NewFormName=',NewFormName,' NewFormClassName=',NewFormClassName);
5643 {$ENDIF}
5644 if not InitCurCodeTool(Code) then exit;
5645 try
5646 Result:=FCurCodeTool.RenameForm(OldFormName,OldFormClassName,
5647 NewFormName,NewFormClassName,SourceChangeCache);
5648 except
5649 on e: Exception do Result:=HandleException(e);
5650 end;
5651 end;
5652
TCodeToolManager.FindFormAncestornull5653 function TCodeToolManager.FindFormAncestor(Code: TCodeBuffer;
5654 const FormClassName: string; var AncestorClassName: string;
5655 DirtySearch: boolean): boolean;
5656 begin
5657 Result:=false;
5658 {$IFDEF CTDEBUG}
5659 DebugLn('TCodeToolManager.FindFormAncestor A ',Code.Filename,' ',FormClassName);
5660 {$ENDIF}
5661 AncestorClassName:='';
5662 if not InitCurCodeTool(Code) then exit;
5663 try
5664 Result:=FCurCodeTool.FindFormAncestor(FormClassName,AncestorClassName);
5665 except
5666 on e: Exception do Result:=HandleException(e);
5667 end;
5668 if (not Result) and DirtySearch then begin
5669 AncestorClassName:=FindClassAncestorName(Code.Source,FormClassName);
5670 Result:=AncestorClassName<>'';
5671 end;
5672 end;
5673
CompleteComponentnull5674 function TCodeToolManager.CompleteComponent(Code: TCodeBuffer;
5675 AComponent, AncestorComponent: TComponent): boolean;
5676 begin
5677 Result:=false;
5678 {$IFDEF CTDEBUG}
5679 DebugLn('TCodeToolManager.CompleteComponent A ',Code.Filename,' ',AComponent.Name,':',AComponent.ClassName,' ',dbgsName(AncestorComponent));
5680 {$ENDIF}
5681 if not InitCurCodeTool(Code) then exit;
5682 try
5683 Result:=FCurCodeTool.CompleteComponent(AComponent,AncestorComponent,
5684 SourceChangeCache);
5685 except
5686 on e: Exception do Result:=HandleException(e);
5687 end;
5688 end;
5689
PublishedVariableExistsnull5690 function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
5691 const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
5692 begin
5693 Result:=false;
5694 {$IFDEF CTDEBUG}
5695 DebugLn('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
5696 {$ENDIF}
5697 if not InitCurCodeTool(Code) then exit;
5698 try
5699 Result:=FCurCodeTool.FindPublishedVariable(AClassName,
5700 AVarName,ErrorOnClassNotFound)<>nil;
5701 except
5702 on e: Exception do Result:=HandleException(e);
5703 end;
5704 end;
5705
AddPublishedVariablenull5706 function TCodeToolManager.AddPublishedVariable(Code: TCodeBuffer;
5707 const AClassName, VarName, VarType: string): boolean;
5708 begin
5709 Result:=false;
5710 {$IFDEF CTDEBUG}
5711 DebugLn('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
5712 {$ENDIF}
5713 if not InitCurCodeTool(Code) then exit;
5714 try
5715 Result:=FCurCodeTool.AddPublishedVariable(AClassName,
5716 VarName,VarType,SourceChangeCache);
5717 except
5718 on e: Exception do Result:=HandleException(e);
5719 end;
5720 end;
5721
TCodeToolManager.RemovePublishedVariablenull5722 function TCodeToolManager.RemovePublishedVariable(Code: TCodeBuffer;
5723 const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
5724 begin
5725 Result:=false;
5726 {$IFDEF CTDEBUG}
5727 DebugLn('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
5728 {$ENDIF}
5729 if not InitCurCodeTool(Code) then exit;
5730 try
5731 Result:=FCurCodeTool.RemovePublishedVariable(AClassName,
5732 AVarName,ErrorOnClassNotFound,SourceChangeCache);
5733 except
5734 on e: Exception do Result:=HandleException(e);
5735 end;
5736 end;
5737
TCodeToolManager.RenamePublishedVariablenull5738 function TCodeToolManager.RenamePublishedVariable(Code: TCodeBuffer;
5739 const AClassName, OldVariableName, NewVarName, VarType: shortstring;
5740 ErrorOnClassNotFound: boolean): boolean;
5741 begin
5742 Result:=false;
5743 {$IFDEF CTDEBUG}
5744 DebugLn('TCodeToolManager.RenamePublishedVariable A ',Code.Filename,' ',AClassName,' OldVar=',OldVariableName,' NewVar=',NewVarName);
5745 {$ENDIF}
5746 if not InitCurCodeTool(Code) then exit;
5747 try
5748 Result:=FCurCodeTool.RenamePublishedVariable(AClassName,
5749 OldVariableName,NewVarName,VarType,
5750 ErrorOnClassNotFound,SourceChangeCache);
5751 except
5752 on e: Exception do Result:=HandleException(e);
5753 end;
5754 end;
5755
RetypeClassVariablesnull5756 function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer;
5757 const AClassName: string; ListOfReTypes: TStringToStringTree;
5758 ErrorOnClassNotFound: boolean; SearchImplementationToo: boolean): boolean;
5759 begin
5760 Result:=false;
5761 {$IFDEF CTDEBUG}
5762 DebugLn('TCodeToolManager.RetypeClassVariables A ',Code.Filename,' ',AClassName);
5763 {$ENDIF}
5764 if not InitCurCodeTool(Code) then exit;
5765 try
5766 Result:=FCurCodeTool.RetypeClassVariables(AClassName,ListOfReTypes,
5767 ErrorOnClassNotFound,SourceChangeCache,SearchImplementationToo);
5768 except
5769 on e: Exception do Result:=HandleException(e);
5770 end;
5771 end;
5772
FindDanglingComponentEventsnull5773 function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
5774 const AClassName: string; RootComponent: TComponent;
5775 ExceptionOnClassNotFound, SearchInAncestors: boolean; out
5776 ListOfPInstancePropInfo: TFPList;
5777 const OverrideGetMethodName: TOnGetMethodname): boolean;
5778 begin
5779 Result:=false;
5780 {$IFDEF CTDEBUG}
5781 DebugLn('TCodeToolManager.FindDanglingComponentEvents A ',Code.Filename,' ',AClassName);
5782 {$ENDIF}
5783 ListOfPInstancePropInfo:=nil;
5784 if not InitCurCodeTool(Code) then exit;
5785 try
5786 Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent,
5787 ExceptionOnClassNotFound,SearchInAncestors,
5788 ListOfPInstancePropInfo,OverrideGetMethodName);
5789 except
5790 on e: Exception do Result:=HandleException(e);
5791 end;
5792 end;
5793
TCodeToolManager.ConvertDelphiToLazarusSourcenull5794 function TCodeToolManager.ConvertDelphiToLazarusSource(Code: TCodeBuffer;
5795 AddLRSCode: boolean): boolean;
5796 begin
5797 Result:=false;
5798 {$IFDEF CTDEBUG}
5799 DebugLn('TCodeToolManager.ConvertDelphiToLazarusSource A ',Code.Filename);
5800 {$ENDIF}
5801 if not InitCurCodeTool(Code) then exit;
5802 try
5803 Result:=FCurCodeTool.ConvertDelphiToLazarusSource(AddLRSCode,
5804 SourceChangeCache);
5805 except
5806 on e: Exception do Result:=HandleException(e);
5807 end;
5808 end;
5809
TCodeToolManager.DoOnFindUsedUnitnull5810 function TCodeToolManager.DoOnFindUsedUnit(SrcTool: TFindDeclarationTool;
5811 const TheUnitName, TheUnitInFilename: string): TCodeBuffer;
5812 begin
5813 if Assigned(OnSearchUsedUnit) then
5814 Result:=OnSearchUsedUnit(SrcTool.MainFilename,
5815 TheUnitName,TheUnitInFilename)
5816 else
5817 Result:=nil;
5818 end;
5819
5820 procedure TCodeToolManager.DoOnGatherUserIdentifiers(
5821 Sender: TIdentCompletionTool; const ContextFlags: TIdentifierListContextFlags
5822 );
5823 begin
5824 if Assigned(FOnGatherUserIdentifiers) then
5825 FOnGatherUserIdentifiers(Sender, ContextFlags);
5826 end;
5827
TCodeToolManager.DoOnGetSrcPathForCompiledUnitnull5828 function TCodeToolManager.DoOnGetSrcPathForCompiledUnit(Sender: TObject;
5829 const AFilename: string): string;
5830 begin
5831 if CompareFileExt(AFilename,'.ppu',false)=0 then
5832 Result:=GetPPUSrcPathForDirectory(ExtractFilePath(AFilename))
5833 else if CompareFileExt(AFilename,'.dcu',false)=0 then
5834 Result:=GetDCUSrcPathForDirectory(ExtractFilePath(AFilename))
5835 else
5836 Result:='';
5837 if Result='' then
5838 Result:=GetCompiledSrcPathForDirectory(ExtractFilePath(AFilename));
5839 end;
5840
DoOnInternalGetMethodNamenull5841 function TCodeToolManager.DoOnInternalGetMethodName(const AMethod: TMethod;
5842 CheckOwner: TObject): string;
5843 begin
5844 if Assigned(OnGetMethodName) then
5845 Result:=OnGetMethodName(AMethod,CheckOwner)
5846 else if (AMethod.Data=nil) or (AMethod.Code=nil) then
5847 Result:=''
5848 else if (CheckOwner<>nil) and (TObject(AMethod.Data)<>CheckOwner) then
5849 Result:=''
5850 else
5851 Result:=TObject(AMethod.Data).MethodName(AMethod.Code);
5852 end;
5853
TCodeToolManager.DoOnParserProgressnull5854 function TCodeToolManager.DoOnParserProgress(Tool: TCustomCodeTool): boolean;
5855 begin
5856 Result:=true;
5857 if not FAbortable then exit;
5858 if not Assigned(OnCheckAbort) then exit;
5859 Result:=not OnCheckAbort();
5860 end;
5861
5862 procedure TCodeToolManager.DoOnRescanFPCDirectoryCache(Sender: TObject);
5863 begin
5864 if Assigned(FOnRescanFPCDirectoryCache) then
5865 FOnRescanFPCDirectoryCache(Sender);
5866 end;
5867
5868 procedure TCodeToolManager.DoOnToolTreeChange(Tool: TCustomCodeTool;
5869 NodesDeleting: boolean);
5870 var
5871 i: Integer;
5872 begin
5873 CTIncreaseChangeStamp(FCodeNodeTreeChangeStep);
5874 if NodesDeleting then begin
5875 CTIncreaseChangeStamp(FCodeTreeNodesDeletedStep);
5876 // Note: IdentifierList nodes do not need to be cleared, because Node
5877 // is accessed via GetNode, which checks if nodes were deleted
5878 end;
5879 //debugln(['TCodeToolManager.OnToolTreeChange ',FHandlers[ctmOnToolTreeChanging].Count]);
5880 i:=FHandlers[ctmOnToolTreeChanging].Count;
5881 while FHandlers[ctmOnToolTreeChanging].NextDownIndex(i) do
5882 TOnToolTreeChanging(FHandlers[ctmOnToolTreeChanging][i])(Tool,NodesDeleting);
5883 end;
5884
DoOnScannerProgressnull5885 function TCodeToolManager.DoOnScannerProgress(Sender: TLinkScanner): boolean;
5886 begin
5887 Result:=true;
5888 if not FAbortable then exit;
5889 if not Assigned(OnCheckAbort) then exit;
5890 Result:=not OnCheckAbort();
5891 end;
5892
5893 procedure TCodeToolManager.DoOnFABGetNestedComments(Sender: TObject;
5894 Code: TCodeBuffer; out NestedComments: boolean);
5895 begin
5896 NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
5897 end;
5898
5899 procedure TCodeToolManager.DoOnFABGetExamples(Sender: TObject; Code: TCodeBuffer;
5900 Step: integer; var CodeBuffers: TFPList; var ExpandedFilenames: TStrings);
5901 begin
5902 if Assigned(OnGetIndenterExamples) then
5903 OnGetIndenterExamples(Sender,Code,Step,CodeBuffers,ExpandedFilenames);
5904 end;
5905
5906 procedure TCodeToolManager.DoOnLoadFileForTool(Sender: TObject;
5907 const ExpandedFilename: string; out Code: TCodeBuffer; var Abort: boolean);
5908 begin
5909 Code:=LoadFile(ExpandedFilename,true,false);
5910 end;
5911
TCodeToolManager.DoOnScannerGetInitValuesnull5912 function TCodeToolManager.DoOnScannerGetInitValues(Scanner: TLinkScanner;
5913 Code: Pointer; out AChangeStep: integer): TExpressionEvaluator;
5914 begin
5915 Result:=nil;
5916 AChangeStep:=DefineTree.ChangeStep;
5917 if Code=nil then exit;
5918 //DefineTree.WriteDebugReport;
5919 if not TCodeBuffer(Code).IsVirtual then
5920 Result:=DefineTree.GetDefinesForDirectory(
5921 ExtractFilePath(TCodeBuffer(Code).Filename),false)
5922 else
5923 Result:=DefineTree.GetDefinesForVirtualDirectory;
5924 if Assigned(OnScannerInit) then
5925 OnScannerInit(Self,Scanner);
5926 end;
5927
5928 procedure TCodeToolManager.DoOnDefineTreeReadValue(Sender: TObject;
5929 const VariableName: string; var Value: string; var Handled: boolean);
5930 begin
5931 Handled:=GlobalValues.IsDefined(VariableName);
5932 if Handled then
5933 Value:=GlobalValues[VariableName];
5934 //DebugLn('[TCodeToolManager.OnDefineTreeReadValue] Name="',VariableName,'" = "',Value,'"');
5935 end;
5936
5937 procedure TCodeToolManager.DoOnGlobalValuesChanged;
5938 begin
5939 DefineTree.ClearCache;
5940 end;
5941
5942 procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean);
5943 begin
5944 if NewValue=FCheckFilesOnDisk then exit;
5945 FCheckFilesOnDisk:=NewValue;
5946 if FCurCodeTool<>nil then
5947 FCurCodeTool.CheckFilesOnDisk:=NewValue;
5948 end;
5949
5950 procedure TCodeToolManager.SetCodeCompletionTemplateFileName(AValue: String);
5951 var
5952 OldValue: String;
5953 Code: TCodeBuffer;
5954 begin
5955 AValue:=CleanAndExpandFilename(AValue);
5956 if FCodeCompletionTemplateFileName=AValue then Exit;
5957 OldValue:=FCodeCompletionTemplateFileName;
5958 FCodeCompletionTemplateFileName:=AValue;
5959 if CompareFilenames(FCodeCompletionTemplateFileName,OldValue)=0 then exit;
5960 if (FCodeCompletionTemplateFileName<>'') then
5961 Code:=LoadFile(FCodeCompletionTemplateFileName,true,false)
5962 else
5963 Code:=nil;
5964 if Code<>nil then begin
5965 if CTTemplateExpander=nil then
5966 CTTemplateExpander:=TTemplateExpander.Create;
5967 CTTemplateExpander.Code:=Code;
5968 end else begin
5969 FreeAndNil(CTTemplateExpander);
5970 end;
5971 end;
5972
5973 procedure TCodeToolManager.SetCompleteProperties(const AValue: boolean);
5974 begin
5975 if CompleteProperties=AValue then exit;
5976 FCompleteProperties:=AValue;
5977 if FCurCodeTool<>nil then
5978 FCurCodeTool.CompleteProperties:=AValue;
5979 end;
5980
5981 procedure TCodeToolManager.SetIndentSize(NewValue: integer);
5982 begin
5983 if NewValue=FIndentSize then exit;
5984 FIndentSize:=NewValue;
5985 if FCurCodeTool<>nil then
5986 FCurCodeTool.IndentSize:=NewValue;
5987 SourceChangeCache.BeautifyCodeOptions.Indent:=NewValue;
5988 end;
5989
5990 procedure TCodeToolManager.SetTabWidth(const AValue: integer);
5991 begin
5992 if FTabWidth=AValue then exit;
5993 FTabWidth:=AValue;
5994 SourceChangeCache.BeautifyCodeOptions.TabWidth:=AValue;
5995 Indenter.DefaultTabWidth:=AValue;
5996 end;
5997
5998 procedure TCodeToolManager.SetUseTabs(AValue: boolean);
5999 begin
6000 if FUseTabs=AValue then Exit;
6001 FUseTabs:=AValue;
6002 SourceChangeCache.BeautifyCodeOptions.UseTabs:=UseTabs;
6003 end;
6004
6005 procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer);
6006 begin
6007 if NewValue=FVisibleEditorLines then exit;
6008 FVisibleEditorLines:=NewValue;
6009 if FCurCodeTool<>nil then
6010 FCurCodeTool.VisibleEditorLines:=NewValue;
6011 end;
6012
6013 procedure TCodeToolManager.SetJumpSingleLinePos(NewValue: integer);
6014 begin
6015 if NewValue=FJumpSingleLinePos then exit;
6016 FJumpSingleLinePos:=NewValue;
6017 if FCurCodeTool<>nil then
6018 FCurCodeTool.JumpSingleLinePos:=NewValue;
6019 end;
6020
6021 procedure TCodeToolManager.SetJumpCodeBlockPos(NewValue: integer);
6022 begin
6023 if NewValue=FJumpCodeBlockPos then exit;
6024 FJumpCodeBlockPos:=NewValue;
6025 if FCurCodeTool<>nil then
6026 FCurCodeTool.JumpCodeBlockPos:=NewValue;
6027 end;
6028
6029 procedure TCodeToolManager.SetSetPropertyVariableIsPrefix(aValue: Boolean);
6030 begin
6031 if FSetPropertyVariableIsPrefix = aValue then Exit;
6032 FSetPropertyVariableIsPrefix := aValue;
6033 end;
6034
6035 procedure TCodeToolManager.SetSetPropertyVariablename(AValue: string);
6036 begin
6037 if FSetPropertyVariablename=aValue then Exit;
6038 FSetPropertyVariablename:=aValue;
6039 end;
6040
6041 procedure TCodeToolManager.SetSetPropertyVariableUseConst(aValue: Boolean);
6042 begin
6043 if FSetPropertyVariableUseConst = aValue then Exit;
6044 FSetPropertyVariableUseConst := aValue;
6045 end;
6046
6047 procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean);
6048 begin
6049 if NewValue=FCursorBeyondEOL then exit;
6050 FCursorBeyondEOL:=NewValue;
6051 if FCurCodeTool<>nil then
6052 FCurCodeTool.CursorBeyondEOL:=NewValue;
6053 end;
6054
6055 procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean);
6056 begin
6057 IncreaseChangeStep;
6058 if Assigned(FOnBeforeApplyChanges) then
6059 FOnBeforeApplyChanges(Self,Abort);
6060 end;
6061
6062 procedure TCodeToolManager.AfterApplyingChanges;
6063 begin
6064 // clear all codetrees of changed buffers
6065 if FCurCodeTool<>nil then
6066 FCurCodeTool.Clear;
6067
6068 // user callback
6069 if Assigned(FOnAfterApplyChanges) then
6070 FOnAfterApplyChanges(Self);
6071 end;
6072
FindCodeToolForSourcenull6073 function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer
6074 ): TCustomCodeTool;
6075 var
6076 ANode: TAVLTreeNode;
6077 CurSrc, SearchedSrc: Pointer;
6078 begin
6079 ANode:=FPascalTools.Root;
6080 SearchedSrc:=Pointer(Code);
6081 while (ANode<>nil) do begin
6082 CurSrc:=Pointer(TCustomCodeTool(ANode.Data).Scanner.MainCode);
6083 if CurSrc>SearchedSrc then
6084 ANode:=ANode.Left
6085 else if CurSrc<SearchedSrc then
6086 ANode:=ANode.Right
6087 else begin
6088 Result:=TCustomCodeTool(ANode.Data);
6089 exit;
6090 end;
6091 end;
6092 Result:=nil;
6093 end;
6094
6095 procedure TCodeToolManager.SetError(Id: int64; Code: TCodeBuffer; Line,
6096 Column: integer; const TheMessage: string);
6097 begin
6098 FErrorId:=Id;
6099 FErrorMsg:=TheMessage;
6100 FErrorCode:=Code;
6101 FErrorLine:=Line;
6102 FErrorColumn:=Column;
6103 FErrorTopLine:=FErrorLine;
6104 AdjustErrorTopLine;
6105 WriteError;
6106 end;
6107
TCodeToolManager.GetCodeToolForSourcenull6108 function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
6109 GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
6110 // return a codetool for the source
6111 begin
6112 Result:=nil;
6113 if Code=nil then begin
6114 if ExceptionOnError then
6115 raise Exception.Create('TCodeToolManager.GetCodeToolForSource '
6116 +'internal error: Code=nil');
6117 exit;
6118 end;
6119 if GoToMainCode then
6120 Code:=GetMainCode(Code);
6121 Result:=FindCodeToolForSource(Code);
6122 if Result=nil then begin
6123 CreateScanner(Code);
6124 if Code.Scanner=nil then begin
6125 if ExceptionOnError then
6126 raise ECodeToolManagerError.CreateFmt(20170422131430,ctsNoScannerFound,[Code.Filename]);
6127 exit;
6128 end;
6129 Result:=TCodeTool.Create;
6130 Result.Scanner:=Code.Scanner;
6131 FPascalTools.Add(Result);
6132 TCodeTool(Result).Beautifier:=SourceChangeCache.BeautifyCodeOptions;
6133 TCodeTool(Result).OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
6134 TCodeTool(Result).OnGetDirectoryCache:=@DoOnGetDirectoryCache;
6135 TCodeTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
6136 TCodeTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
6137 TCodeTool(Result).OnGetMethodName:=@DoOnInternalGetMethodName;
6138 TCodeTool(Result).OnRescanFPCDirectoryCache:=@DoOnRescanFPCDirectoryCache;
6139 TCodeTool(Result).OnGatherUserIdentifiers:=@DoOnGatherUserIdentifiers;
6140 TCodeTool(Result).DirectoryCache:=
6141 DirectoryCachePool.GetCache(ExtractFilePath(Code.Filename),
6142 true,true);
6143 Result.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
6144 Result.OnTreeChange:=@DoOnToolTreeChange;
6145 TCodeTool(Result).OnParserProgress:=@DoOnParserProgress;
6146 end;
6147 with TCodeTool(Result) do begin
6148 AdjustTopLineDueToComment:=Self.AdjustTopLineDueToComment;
6149 AddInheritedCodeToOverrideMethod:=Self.AddInheritedCodeToOverrideMethod;
6150 CompleteProperties:=Self.CompleteProperties;
6151 SetPropertyVariablename:=Self.SetPropertyVariablename;
6152 SetPropertyVariableIsPrefix:=Self.SetPropertyVariableIsPrefix;
6153 SetPropertyVariableUseConst:=Self.SetPropertyVariableUseConst;
6154 end;
6155 Result.CheckFilesOnDisk:=FCheckFilesOnDisk;
6156 Result.IndentSize:=FIndentSize;
6157 Result.VisibleEditorLines:=FVisibleEditorLines;
6158 Result.JumpSingleLinePos:=FJumpSingleLinePos;
6159 Result.JumpCodeBlockPos:=FJumpCodeBlockPos;
6160 Result.CursorBeyondEOL:=FCursorBeyondEOL;
6161 end;
6162
FindDirectivesToolForSourcenull6163 function TCodeToolManager.FindDirectivesToolForSource(Code: TCodeBuffer
6164 ): TDirectivesTool;
6165 var
6166 ANode: TAVLTreeNode;
6167 CurSrc, SearchedSrc: Pointer;
6168 begin
6169 ANode:=FDirectivesTools.Root;
6170 SearchedSrc:=Pointer(Code);
6171 while (ANode<>nil) do begin
6172 CurSrc:=Pointer(TDirectivesTool(ANode.Data).Code);
6173 if CurSrc>SearchedSrc then
6174 ANode:=ANode.Left
6175 else if CurSrc<SearchedSrc then
6176 ANode:=ANode.Right
6177 else begin
6178 Result:=TDirectivesTool(ANode.Data);
6179 exit;
6180 end;
6181 end;
6182 Result:=nil;
6183 end;
6184
6185 procedure TCodeToolManager.ClearCurDirectivesTool;
6186 begin
6187 ClearError;
6188 FCurDirectivesTool:=nil;
6189 end;
6190
TCodeToolManager.InitCurDirectivesToolnull6191 function TCodeToolManager.InitCurDirectivesTool(Code: TCodeBuffer): boolean;
6192 begin
6193 Result:=false;
6194 ClearCurDirectivesTool;
6195 FCurDirectivesTool:=TDirectivesTool(GetDirectivesToolForSource(Code,true));
6196 {$IFDEF CTDEBUG}
6197 DebugLn('[TCodeToolManager.InitCurDirectivesTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
6198 {$ENDIF}
6199 Result:=true;
6200 end;
6201
TCodeToolManager.GetDirectivesToolForSourcenull6202 function TCodeToolManager.GetDirectivesToolForSource(Code: TCodeBuffer;
6203 ExceptionOnError: boolean): TCompilerDirectivesTree;
6204 begin
6205 if ExceptionOnError then ;
6206 Result:=FindDirectivesToolForSource(Code);
6207 if Result=nil then begin
6208 Result:=TDirectivesTool.Create;
6209 Result.Code:=Code;
6210 FDirectivesTools.Add(Result);
6211 end;
6212 Result.NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
6213 end;
6214
6215 procedure TCodeToolManager.SetAbortable(const AValue: boolean);
6216 begin
6217 if FAbortable=AValue then exit;
6218 FAbortable:=AValue;
6219 end;
6220
6221 procedure TCodeToolManager.SetAddInheritedCodeToOverrideMethod(
6222 const AValue: boolean);
6223 begin
6224 if FAddInheritedCodeToOverrideMethod=AValue then exit;
6225 FAddInheritedCodeToOverrideMethod:=AValue;
6226 if FCurCodeTool<>nil then
6227 FCurCodeTool.AddInheritedCodeToOverrideMethod:=AValue;
6228 end;
6229
DoOnGetCodeToolForBuffernull6230 function TCodeToolManager.DoOnGetCodeToolForBuffer(Sender: TObject;
6231 Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
6232 begin
6233 {$IFDEF CTDEBUG}
6234 DbgOut('[TCodeToolManager.OnGetCodeToolForBuffer]');
6235 if Sender is TCustomCodeTool then
6236 DbgOut(' Sender=',TCustomCodeTool(Sender).MainFilename);
6237 debugln(' Code=',Code.Filename);
6238 {$ENDIF}
6239 Result:=TFindDeclarationTool(GetCodeToolForSource(Code,GoToMainCode,true));
6240 end;
6241
TCodeToolManager.DoOnGetDirectoryCachenull6242 function TCodeToolManager.DoOnGetDirectoryCache(const ADirectory: string
6243 ): TCTDirectoryCache;
6244 begin
6245 Result:=DirectoryCachePool.GetCache(ADirectory,true,true);
6246 end;
6247
6248 procedure TCodeToolManager.ActivateWriteLock;
6249 begin
6250 if FWriteLockCount=0 then begin
6251 // start a new write lock
6252 if FWriteLockStep<>$7fffffff then
6253 inc(FWriteLockStep)
6254 else
6255 FWriteLockStep:=-$7fffffff;
6256 SourceCache.GlobalWriteLockIsSet:=true;
6257 SourceCache.GlobalWriteLockStep:=FWriteLockStep;
6258 end;
6259 inc(FWriteLockCount);
6260 {$IFDEF CTDEBUG}
6261 DebugLn('[TCodeToolManager.ActivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
6262 {$ENDIF}
6263 end;
6264
6265 procedure TCodeToolManager.DeactivateWriteLock;
6266 begin
6267 if FWriteLockCount>0 then begin
6268 dec(FWriteLockCount);
6269 if FWriteLockCount=0 then begin
6270 // end the write lock
6271 if FWriteLockStep<>$7fffffff then
6272 inc(FWriteLockStep)
6273 else
6274 FWriteLockStep:=-$7fffffff;
6275 SourceCache.GlobalWriteLockIsSet:=false;
6276 SourceCache.GlobalWriteLockStep:=FWriteLockStep;
6277 end;
6278 end;
6279 {$IFDEF CTDEBUG}
6280 DebugLn('[TCodeToolManager.DeactivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
6281 {$ENDIF}
6282 end;
6283
6284 procedure TCodeToolManager.IncreaseChangeStep;
6285 begin
6286 if FChangeStep<>High(Integer) then
6287 inc(FChangeStep)
6288 else
6289 FChangeStep:=Low(Integer);
6290 end;
6291
6292 procedure TCodeToolManager.GetCodeTreeNodesDeletedStep(out
6293 NodesDeletedStep: integer);
6294 begin
6295 NodesDeletedStep:=FCodeTreeNodesDeletedStep;
6296 end;
6297
6298 procedure TCodeToolManager.AddHandlerToolTreeChanging(
6299 const OnToolTreeChanging: TOnToolTreeChanging);
6300 begin
6301 AddHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
6302 end;
6303
6304 procedure TCodeToolManager.RemoveHandlerToolTreeChanging(
6305 const OnToolTreeChanging: TOnToolTreeChanging);
6306 begin
6307 RemoveHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
6308 end;
6309
GetResourceToolnull6310 function TCodeToolManager.GetResourceTool: TResourceCodeTool;
6311 begin
6312 if FResourceTool=nil then FResourceTool:=TResourceCodeTool.Create;
6313 Result:=FResourceTool;
6314 end;
6315
GetOwnerForCodeTreeNodenull6316 function TCodeToolManager.GetOwnerForCodeTreeNode(ANode: TCodeTreeNode
6317 ): TObject;
6318 var
6319 AToolNode: TAVLTreeNode;
6320 CurTool: TCustomCodeTool;
6321 RootCodeTreeNode: TCodeTreeNode;
6322 CurDirTool: TCompilerDirectivesTree;
6323 begin
6324 Result:=nil;
6325 if ANode=nil then exit;
6326 RootCodeTreeNode:=ANode.GetRoot;
6327
6328 // search in codetools
6329 AToolNode:=FPascalTools.FindLowest;
6330 while (AToolNode<>nil) do begin
6331 CurTool:=TCustomCodeTool(AToolNode.Data);
6332 if (CurTool.Tree<>nil) and (CurTool.Tree.Root=RootCodeTreeNode) then begin
6333 Result:=CurTool;
6334 exit;
6335 end;
6336 AToolNode:=FPascalTools.FindSuccessor(AToolNode);
6337 end;
6338
6339 // search in directivestools
6340 AToolNode:=FDirectivesTools.FindLowest;
6341 while (AToolNode<>nil) do begin
6342 CurDirTool:=TCompilerDirectivesTree(AToolNode.Data);
6343 if (CurDirTool.Tree<>nil) and (CurDirTool.Tree.Root=RootCodeTreeNode) then
6344 begin
6345 Result:=CurDirTool;
6346 exit;
6347 end;
6348 AToolNode:=FDirectivesTools.FindSuccessor(AToolNode);
6349 end;
6350 end;
6351
TCodeToolManager.DirectoryCachePoolGetStringnull6352 function TCodeToolManager.DirectoryCachePoolGetString(const ADirectory: string;
6353 const AStringType: TCTDirCacheString): string;
6354 begin
6355 case AStringType of
6356 ctdcsUnitPath: Result:=GetUnitPathForDirectory(ADirectory,false);
6357 ctdcsSrcPath: Result:=GetSrcPathForDirectory(ADirectory,false);
6358 ctdcsIncludePath: Result:=GetIncludePathForDirectory(ADirectory,false);
6359 ctdcsCompleteSrcPath: Result:=GetCompleteSrcPathForDirectory(ADirectory,false);
6360 ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false);
6361 ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false);
6362 ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false);
6363 ctdcsNamespaces: Result:=GetNamespacesForDirectory(ADirectory,false);
6364 else RaiseCatchableException('');
6365 end;
6366 end;
6367
TCodeToolManager.DirectoryCachePoolFindVirtualFilenull6368 function TCodeToolManager.DirectoryCachePoolFindVirtualFile(
6369 const Filename: string): string;
6370 var
6371 Code: TCodeBuffer;
6372 begin
6373 Result:='';
6374 if (Filename='') or (System.Pos(PathDelim,Filename)>0) then
6375 exit;
6376 Code:=FindFile(Filename);
6377 if Code<>nil then
6378 Result:=Code.Filename;
6379 end;
6380
DirectoryCachePoolGetUnitFromSetnull6381 function TCodeToolManager.DirectoryCachePoolGetUnitFromSet(const UnitSet,
6382 AnUnitName: string; SrcSearchRequiresPPU: boolean): string;
6383 var
6384 Changed: boolean;
6385 UnitSetCache: TFPCUnitSetCache;
6386 begin
6387 Result:='';
6388 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6389 if UnitSetCache=nil then begin
6390 debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6391 exit;
6392 end;
6393 if Changed then begin
6394 debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6395 exit;
6396 end;
6397 Result:=UnitSetCache.GetUnitSrcFile(AnUnitName,SrcSearchRequiresPPU);
6398 end;
6399
DirectoryCachePoolGetCompiledUnitFromSetnull6400 function TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet(
6401 const UnitSet, AnUnitName: string): string;
6402 var
6403 Changed: boolean;
6404 UnitSetCache: TFPCUnitSetCache;
6405 begin
6406 Result:='';
6407 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6408 if UnitSetCache=nil then begin
6409 debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6410 exit;
6411 end;
6412 if Changed then begin
6413 debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6414 exit;
6415 end;
6416 Result:=UnitSetCache.GetCompiledUnitFile(AnUnitName);
6417 end;
6418
6419 procedure TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet(
6420 const UnitSet: string; const Iterate: TCTOnIterateFile);
6421 var
6422 Changed: boolean;
6423 UnitSetCache: TFPCUnitSetCache;
6424 aConfigCache: TPCTargetConfigCache;
6425 Node: TAVLTreeNode;
6426 Item: PStringToStringItem;
6427 begin
6428 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6429 if UnitSetCache=nil then begin
6430 debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6431 exit;
6432 end;
6433 if Changed then begin
6434 debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6435 exit;
6436 end;
6437 aConfigCache:=UnitSetCache.GetConfigCache(false);
6438 if (aConfigCache=nil) or (aConfigCache.Units=nil) then exit;
6439 Node:=aConfigCache.Units.Tree.FindLowest;
6440 while Node<>nil do begin
6441 Item:=PStringToStringItem(Node.Data);
6442 Iterate(Item^.Value);
6443 Node:=aConfigCache.Units.Tree.FindSuccessor(Node);
6444 end;
6445 end;
6446
6447 procedure TCodeToolManager.AddHandler(HandlerType: TCodeToolManagerHandler;
6448 const Handler: TMethod);
6449 begin
6450 if Handler.Code=nil then RaiseCatchableException('TCodeToolManager.AddHandler');
6451 if FHandlers[HandlerType]=nil then
6452 FHandlers[HandlerType]:=TMethodList.Create;
6453 FHandlers[HandlerType].Add(Handler);
6454 end;
6455
6456 procedure TCodeToolManager.RemoveHandler(HandlerType: TCodeToolManagerHandler;
6457 const Handler: TMethod);
6458 begin
6459 FHandlers[HandlerType].Remove(Handler);
6460 end;
6461
6462 procedure TCodeToolManager.DoOnToolSetWriteLock(Lock: boolean);
6463 begin
6464 if Lock then ActivateWriteLock else DeactivateWriteLock;
6465 end;
6466
6467 procedure TCodeToolManager.DoOnToolGetChangeSteps(out SourcesChangeStep,
6468 FilesChangeStep: int64; out InitValuesChangeStep: integer);
6469 begin
6470 SourcesChangeStep:=SourceCache.ChangeStamp;
6471 FilesChangeStep:=FileStateCache.TimeStamp;
6472 InitValuesChangeStep:=DefineTree.ChangeStep;
6473 end;
6474
6475 procedure TCodeToolManager.ConsistencyCheck;
6476 begin
6477 if FCurCodeTool<>nil then begin
6478 FCurCodeTool.ConsistencyCheck;
6479 end;
6480 DefinePool.ConsistencyCheck;
6481 DefineTree.ConsistencyCheck;
6482 SourceCache.ConsistencyCheck;
6483 GlobalValues.ConsistencyCheck;
6484 SourceChangeCache.ConsistencyCheck;
6485 FPascalTools.ConsistencyCheck;
6486 FDirectivesTools.ConsistencyCheck;
6487 end;
6488
6489 procedure TCodeToolManager.WriteDebugReport(WriteTool,
6490 WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
6491 WriteMemStats: boolean);
6492 begin
6493 DebugLn('[TCodeToolManager.WriteDebugReport]');
6494 if FCurCodeTool<>nil then begin
6495 if WriteTool then begin
6496 FCurCodeTool.WriteDebugTreeReport;
6497 if FCurCodeTool.Scanner<>nil then
6498 FCurCodeTool.Scanner.WriteDebugReport;
6499 end;
6500 end;
6501 if WriteDefPool then
6502 DefinePool.WriteDebugReport
6503 else
6504 DefinePool.ConsistencyCheck;
6505 if WriteDefTree then
6506 DefineTree.WriteDebugReport
6507 else
6508 DefineTree.ConsistencyCheck;
6509 if WriteCache then
6510 SourceCache.WriteDebugReport
6511 else
6512 SourceCache.ConsistencyCheck;
6513 if WriteGlobalValues then
6514 GlobalValues.WriteDebugReport
6515 else
6516 GlobalValues.ConsistencyCheck;
6517 if WriteMemStats then WriteMemoryStats;
6518
6519 ConsistencyCheck;
6520 end;
6521
6522 procedure TCodeToolManager.WriteMemoryStats;
6523 var
6524 Node: TAVLTreeNode;
6525 ATool: TEventsCodeTool;
6526 Stats: TCTMemStats;
6527 begin
6528 DebugLn(['Memory stats: ']);
6529 Stats:=TCTMemStats.Create;
6530 // boss
6531 Stats.Add('Boss',
6532 PtrUInt(InstanceSize)
6533 +MemSizeString(FErrorMsg)
6534 +MemSizeString(FSetPropertyVariablename)
6535 +PtrUInt(SizeOf(FSetPropertyVariableIsPrefix))
6536 +PtrUInt(SizeOf(FSetPropertyVariableUseConst))
6537 +MemSizeString(FSourceExtensions)
6538 );
6539 if DefinePool<>nil then
6540 DefinePool.CalcMemSize(Stats);
6541 if DefineTree<>nil then
6542 DefineTree.CalcMemSize(Stats);
6543 if SourceCache<>nil then
6544 SourceCache.CalcMemSize(Stats);
6545 if SourceChangeCache<>nil then
6546 SourceChangeCache.CalcMemSize(Stats);
6547 if GlobalValues<>nil then
6548 Stats.Add('GlobalValues',GlobalValues.CalcMemSize);
6549 if DirectoryCachePool<>nil then
6550 DirectoryCachePool.CalcMemSize(Stats);
6551 if IdentifierList<>nil then
6552 Stats.Add('IdentifierList',IdentifierList.CalcMemSize);
6553 if IdentifierHistory<>nil then
6554 Stats.Add('IdentifierHistory',IdentifierHistory.CalcMemSize);
6555 if Positions<>nil then
6556 Stats.Add('Positions',Positions.CalcMemSize);
6557
6558 if FDirectivesTools<>nil then begin
6559 Stats.Add('FDirectivesTools.Count',FDirectivesTools.Count);
6560 // ToDo
6561 end;
6562 if FPascalTools<>nil then begin
6563 Stats.Add('PascalTools.Count',FPascalTools.Count);
6564 Stats.Add('PascalTools',PtrUInt(FPascalTools.Count)*SizeOf(Node));
6565 Node:=FPascalTools.FindLowest;
6566 while Node<>nil do begin
6567 ATool:=TCodeTool(Node.Data);
6568 ATool.CalcMemSize(Stats);
6569 Node:=FPascalTools.FindSuccessor(Node);
6570 end;
6571 end;
6572 Stats.Add('KeywordFuncLists.Global',KeywordFuncLists.CalcMemSize);
6573 Stats.Add('FileStateCache',FileStateCache.CalcMemSize);
6574 Stats.Add('GlobalIdentifierTree',GlobalIdentifierTree.CalcMemSize);
6575 Stats.WriteReport;
6576 Stats.Free;
6577 end;
6578
6579 //-----------------------------------------------------------------------------
6580
FindIncFileInCfgCachenull6581 function FindIncFileInCfgCache(const Name: string; out ExpFilename: string): boolean;
6582 var
6583 CfgCache: TPCTargetConfigCache;
6584 UnitSet: TFPCUnitSetCache;
6585 begin
6586 // search the include file in directories defines in fpc.cfg (by -Fi option)
6587 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
6588 if UnitSet<>nil then begin
6589 CfgCache:=UnitSet.GetConfigCache(false);
6590 Result:=Assigned(CfgCache) and Assigned(CfgCache.Includes)
6591 and CfgCache.Includes.GetString(Name,ExpFilename);
6592 end
6593 else
6594 Result:=False;
6595 end;
6596
6597 initialization
6598 CodeToolBoss:=TCodeToolManager.Create;
6599 OnFindOwnerOfCodeTreeNode:=@GetOwnerForCodeTreeNode;
6600 BasicCodeTools.FindIncFileInCfgCache:=@FindIncFileInCfgCache;
6601
6602
6603 finalization
6604 {$IFDEF CTDEBUG}
6605 DebugLn('codetoolmanager.pas - finalization');
6606 {$ENDIF}
6607 OnFindOwnerOfCodeTreeNode:=nil;
6608 CodeToolBoss.Free;
6609 CodeToolBoss:=nil;
6610 FreeAndNil(CTTemplateExpander);
6611 {$IFDEF CTDEBUG}
6612 DebugLn('codetoolmanager.pas - finalization finished');
6613 {$ENDIF}
6614
6615 end.
6616
6617