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
409 {$IFDEF GuessMisplacedIfdef}
GuessMisplacedIfdefEndifnull410 function GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,Y: integer;
411 out NewCode: TCodeBuffer;
412 out NewX, NewY, NewTopLine: integer): boolean;
413 {$ENDIF}
414 // find include directive of include file at position X,Y
FindEnclosingIncludeDirectivenull415 function FindEnclosingIncludeDirective(Code: TCodeBuffer; X,Y: integer;
416 out NewCode: TCodeBuffer;
417 out NewX, NewY, NewTopLine: integer): boolean;
FindResourceDirectivenull418 function FindResourceDirective(Code: TCodeBuffer; StartX, StartY: integer;
419 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
420 const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
AddResourceDirectivenull421 function AddResourceDirective(Code: TCodeBuffer; const Filename: string;
422 SearchInCleanSrc: boolean = true; const NewSrc: string = ''): boolean;
FindIncludeDirectivenull423 function FindIncludeDirective(Code: TCodeBuffer; StartX, StartY: integer;
424 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
425 const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
AddIncludeDirectiveForInitnull426 function AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string;
427 const NewSrc: string = ''): boolean;
AddUnitWarnDirectivenull428 function AddUnitWarnDirective(Code: TCodeBuffer; WarnID, Comment: string;
429 TurnOn: boolean): boolean;
RemoveDirectivenull430 function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer;
431 RemoveEmptyIFs: boolean): boolean;
FixIncludeFilenamesnull432 function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
433 out MissingIncludeFilesCodeXYPos: TFPList): boolean;
FixMissingH2PasDirectivesnull434 function FixMissingH2PasDirectives(Code: TCodeBuffer;
435 var Changed: boolean): boolean;
ReduceCompilerDirectivesnull436 function ReduceCompilerDirectives(Code: TCodeBuffer;
437 Undefines, Defines: TStrings; var Changed: boolean): boolean;
438
439 // keywords and comments
IsKeywordnull440 function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean;
ExtractCodeWithoutCommentsnull441 function ExtractCodeWithoutComments(Code: TCodeBuffer;
442 KeepDirectives: boolean = false;
443 KeepVerbosityDirectives: boolean = false): string;
GetPasDocCommentsnull444 function GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
445 out ListOfPCodeXYPosition: TFPList): boolean;
446
447 // blocks (e.g. begin..end, case..end, try..finally..end, repeat..until)
FindBlockCounterPartnull448 function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
449 out NewCode: TCodeBuffer;
450 out NewX, NewY, NewTopLine: integer;
451 IncludeCloseToken: Boolean = false): boolean;
FindBlockStartnull452 function FindBlockStart(Code: TCodeBuffer; X,Y: integer;
453 out NewCode: TCodeBuffer;
454 out NewX, NewY, NewTopLine: integer;
455 SkipStart: boolean = false): boolean;
GuessUnclosedBlocknull456 function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer;
457 out NewCode: TCodeBuffer;
458 out NewX, NewY, NewTopLine: integer): boolean;
CompleteBlocknull459 function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
460 OnlyIfCursorBlockIndented: boolean): boolean;
CompleteBlocknull461 function CompleteBlock(Code: TCodeBuffer; X,Y: integer;
462 OnlyIfCursorBlockIndented: boolean;
463 out NewCode: TCodeBuffer;
464 out NewX, NewY, NewTopLine: integer): boolean;
465
466 // method jumping
JumpToMethodnull467 function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
468 out NewCode: TCodeBuffer;
469 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
470 out RevertableJump: boolean): boolean;
FindProcDeclarationnull471 function FindProcDeclaration(Code: TCodeBuffer; CleanDef: string;
472 out Tool: TCodeTool; out Node: TCodeTreeNode;
473 Attr: TProcHeadAttributes = [phpWithoutSemicolon]): boolean;
474
475 // find declaration
FindDeclarationnull476 function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
477 out NewCode: TCodeBuffer;
478 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
479 Flags: TFindSmartFlags = DefaultFindSmartFlags): boolean;
FindDeclarationOfIdentifiernull480 function FindDeclarationOfIdentifier(Code: TCodeBuffer; X,Y: integer;
481 Identifier: PChar;
482 out NewCode: TCodeBuffer;
483 out NewX, NewY, NewTopLine: integer): boolean;
FindSmartHintnull484 function FindSmartHint(Code: TCodeBuffer; X,Y: integer;
485 Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
FindDeclarationInInterfacenull486 function FindDeclarationInInterface(Code: TCodeBuffer;
487 const Identifier: string; out NewCode: TCodeBuffer;
488 out NewX, NewY, NewTopLine: integer): boolean;
FindDeclarationInInterfacenull489 function FindDeclarationInInterface(Code: TCodeBuffer;
490 const Identifier: string; out NewCode: TCodeBuffer;
491 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
FindDeclarationWithMainUsesSectionnull492 function FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
493 const Identifier: string;
494 out NewCode: TCodeBuffer;
495 out NewX, NewY, NewTopLine: integer): Boolean;
FindDeclarationAndOverloadnull496 function FindDeclarationAndOverload(Code: TCodeBuffer; X,Y: integer;
497 out ListOfPCodeXYPosition: TFPList;
498 Flags: TFindDeclarationListFlags): boolean;
FindMainDeclarationnull499 function FindMainDeclaration(Code: TCodeBuffer; X,Y: integer;
500 out NewCode: TCodeBuffer;
501 out NewX, NewY, NewTopLine: integer): boolean;
FindDeclarationOfPropertyPathnull502 function FindDeclarationOfPropertyPath(Code: TCodeBuffer;
503 const PropertyPath: string; out NewCode: TCodeBuffer;
504 out NewX, NewY, NewTopLine: integer): Boolean;
FindFileAtCursornull505 function FindFileAtCursor(Code: TCodeBuffer; X,Y: integer;
506 out Found: TFindFileAtCursorFlag; out FoundFilename: string;
507 Allowed: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed;
508 StartPos: PCodeXYPosition = nil): boolean;
509
510 // get code context (aka parameter hints)
FindCodeContextnull511 function FindCodeContext(Code: TCodeBuffer; X,Y: integer;
512 out CodeContexts: TCodeContextInfo): boolean;
ExtractProcedureHeadernull513 function ExtractProcedureHeader(Code: TCodeBuffer; X,Y: integer;
514 Attributes: TProcHeadAttributes; out ProcHead: string): boolean;
HasInterfaceRegisterProcnull515 function HasInterfaceRegisterProc(Code: TCodeBuffer): boolean;
516
517 // gather identifiers (i.e. all visible)
GatherUnitNamesnull518 function GatherUnitNames(Code: TCodeBuffer): Boolean;
GatherIdentifiersnull519 function GatherIdentifiers(Code: TCodeBuffer; X,Y: integer): boolean;
GetIdentifierAtnull520 function GetIdentifierAt(Code: TCodeBuffer; X,Y: integer;
521 out Identifier: string): boolean;
IdentItemCheckHasChildsnull522 function IdentItemCheckHasChilds(IdentItem: TIdentifierListItem): boolean;
FindAbstractMethodsnull523 function FindAbstractMethods(Code: TCodeBuffer; X,Y: integer;
524 out ListOfPCodeXYPosition: TFPList;
525 SkipAbstractsInStartClass: boolean = false): boolean;
GetValuesOfCaseVariablenull526 function GetValuesOfCaseVariable(Code: TCodeBuffer; X,Y: integer;
527 List: TStrings; WithTypeDefIfScoped: boolean = true): boolean;
GatherOverloadsnull528 function GatherOverloads(Code: TCodeBuffer; X,Y: integer;
529 out Graph: TDeclarationOverloadsGraph): boolean;
530
531 // find references, rename identifier, remove identifier
FindReferencesnull532 function FindReferences(IdentifierCode: TCodeBuffer;
533 X, Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
534 var ListOfPCodeXYPosition: TFPList;
535 var Cache: TFindIdentifierReferenceCache // you must free Cache
536 ): boolean;
FindUnitReferencesnull537 function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
538 SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
FindUsedUnitReferencesnull539 function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
540 SkipComments: boolean; out UsedUnitFilename: string;
541 var ListOfPCodeXYPosition: TFPList): boolean;
FindReferencesInFilesnull542 function FindReferencesInFiles(Files: TStringList;
543 DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
544 SearchInComments: boolean;
545 var TreeOfPCodeXYPosition: TAVLTree): boolean;
RenameIdentifiernull546 function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
547 const OldIdentifier, NewIdentifier: string;
548 DeclarationCode: TCodeBuffer = nil; DeclarationCaretXY: PPoint = nil): boolean;
ReplaceWordnull549 function ReplaceWord(Code: TCodeBuffer; const OldWord, NewWord: string;
550 ChangeStrings: boolean): boolean;
RemoveIdentifierDefinitionnull551 function RemoveIdentifierDefinition(Code: TCodeBuffer; X, Y: integer
552 ): boolean; // e.g. remove the variable definition at X,Y
RemoveWithBlocknull553 function RemoveWithBlock(Code: TCodeBuffer; X, Y: integer): boolean;
AddWithBlocknull554 function AddWithBlock(Code: TCodeBuffer; X1, Y1, X2, Y2: integer;
555 const WithExpr: string; // if empty: collect Candidates
556 Candidates: TStrings): boolean;
ChangeParamListnull557 function ChangeParamList(Code: TCodeBuffer;
558 Changes: TObjectList; // list of TChangeParamListItem
559 var ProcPos: TCodeXYPosition; // if it is in this unit the proc declaration is changed and this position is cleared
560 TreeOfPCodeXYPosition: TAVLTree // positions in this unit are processed and removed from the tree
561 ): boolean;
562
563 // resourcestring sections
GatherResourceStringSectionsnull564 function GatherResourceStringSections(
565 Code: TCodeBuffer; X,Y: integer;
566 CodePositions: TCodeXYPositions): boolean;
IdentifierExistsInResourceStringSectionnull567 function IdentifierExistsInResourceStringSection(Code: TCodeBuffer;
568 X,Y: integer; const ResStrIdentifier: string): boolean;
CreateIdentifierFromStringConstnull569 function CreateIdentifierFromStringConst(
570 StartCode: TCodeBuffer; StartX, StartY: integer;
571 EndCode: TCodeBuffer; EndX, EndY: integer;
572 out Identifier: string; MaxLen: integer): boolean;
StringConstToFormatStringnull573 function StringConstToFormatString(
574 StartCode: TCodeBuffer; StartX, StartY: integer;
575 EndCode: TCodeBuffer; EndX, EndY: integer;
576 out FormatStringConstant, FormatParameters: string;
577 out StartInStringConst, EndInStringConst: boolean): boolean;
GatherResourceStringsWithValuenull578 function GatherResourceStringsWithValue(SectionCode: TCodeBuffer;
579 SectionX, SectionY: integer; const StringValue: string;
580 CodePositions: TCodeXYPositions): boolean;
AddResourcestringnull581 function AddResourcestring(CursorCode: TCodeBuffer; X,Y: integer;
582 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
583 const NewIdentifier, NewValue: string;
584 InsertPolicy: TResourcestringInsertPolicy): boolean;
585
586 // expressions
GetStringConstBoundsnull587 function GetStringConstBounds(Code: TCodeBuffer; X,Y: integer;
588 out StartCode: TCodeBuffer; out StartX, StartY: integer;
589 out EndCode: TCodeBuffer; out EndX, EndY: integer;
590 ResolveComments: boolean): boolean;
591 procedure ImproveStringConstantStart(const ACode: string; var StartPos: integer);
592 procedure ImproveStringConstantEnd(const ACode: string; var EndPos: integer);
ExtractOperandnull593 function ExtractOperand(Code: TCodeBuffer; X,Y: integer;
594 out Operand: string; WithPostTokens, WithAsOperator,
595 WithoutTrailingPoints: boolean): boolean;
GetExpandedOperandnull596 function GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
597 out Operand: string; ResolveProperty: Boolean): Boolean;
598
599 // code completion = auto class completion, auto forward proc completion,
600 // (local) var assignment completion, event assignment completion
CompleteCodenull601 function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
602 out NewCode: TCodeBuffer;
603 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;Interactive: Boolean): boolean;
CreateVariableForIdentifiernull604 function CreateVariableForIdentifier(Code: TCodeBuffer; X,Y,TopLine: integer;
605 out NewCode: TCodeBuffer;
606 out NewX, NewY, NewTopLine: integer; Interactive: Boolean): boolean;
AddMethodsnull607 function AddMethods(Code: TCodeBuffer; X,Y, TopLine: integer;
608 ListOfPCodeXYPosition: TFPList;
609 const VirtualToOverride: boolean;
610 out NewCode: TCodeBuffer;
611 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
GuessTypeOfIdentifiernull612 function GuessTypeOfIdentifier(Code: TCodeBuffer; X,Y: integer;
613 out ItsAKeyword, IsSubIdentifier: boolean;
614 out ExistingDefinition: TFindContext; // next existing definition
615 out ListOfPFindContext: TFPList; // possible classes
616 out NewExprType: TExpressionType; out NewType: string): boolean; // false = not at an identifier or syntax error
GetPossibleInitsForVariablenull617 function GetPossibleInitsForVariable(Code: TCodeBuffer; X,Y: integer;
618 out Statements: TStrings; out InsertPositions: TObjectList // e.g. [use unit1, unit2;]i:=0;
619 ): boolean;
DeclareVariableNearBynull620 function DeclareVariableNearBy(Code: TCodeBuffer; X,Y: integer;
621 const VariableName, NewType, NewUnitName: string;
622 Visibility: TCodeTreeNodeDesc;
623 LvlPosCode: TCodeBuffer = nil; LvlPosX: integer = 0; LvlPosY: integer = 0
624 ): boolean;
DeclareVariableAtnull625 function DeclareVariableAt(Code: TCodeBuffer; X,Y: integer;
626 const VariableName, NewType, NewUnitName: string): boolean;
627
628 // simplifications
FindRedefinitionsnull629 function FindRedefinitions(Code: TCodeBuffer;
630 out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
RemoveRedefinitionsnull631 function RemoveRedefinitions(Code: TCodeBuffer;
632 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
RemoveAllRedefinitionsnull633 function RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
FindAliasDefinitionsnull634 function FindAliasDefinitions(Code: TCodeBuffer;
635 out TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
FixAliasDefinitionsnull636 function FixAliasDefinitions(Code: TCodeBuffer;
637 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
FixAllAliasDefinitionsnull638 function FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
FindConstFunctionsnull639 function FindConstFunctions(Code: TCodeBuffer;
640 out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceConstFunctionsnull641 function ReplaceConstFunctions(Code: TCodeBuffer;
642 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceAllConstFunctionsnull643 function ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
FindTypeCastFunctionsnull644 function FindTypeCastFunctions(Code: TCodeBuffer;
645 out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceTypeCastFunctionsnull646 function ReplaceTypeCastFunctions(Code: TCodeBuffer;
647 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceAllTypeCastFunctionsnull648 function ReplaceAllTypeCastFunctions(Code: TCodeBuffer): boolean;
FixForwardDefinitionsnull649 function FixForwardDefinitions(Code: TCodeBuffer): boolean;
FindEmptyMethodsnull650 function FindEmptyMethods(Code: TCodeBuffer;
651 const AClassName: string; // can be ''
652 X,Y: integer;
653 const Sections: TPascalClassSections;
654 ListOfPCodeXYPosition: TFPList;
655 out AllEmpty: boolean): boolean;
RemoveEmptyMethodsnull656 function RemoveEmptyMethods(Code: TCodeBuffer;
657 const AClassName: string; X,Y: integer;
658 const Sections: TPascalClassSections;
659 out AllRemoved: boolean;
660 const Attr: TProcHeadAttributes;
661 out RemovedProcHeads: TStrings): boolean;
662
663 // custom class completion
InitClassCompletionnull664 function InitClassCompletion(Code: TCodeBuffer;
665 const AClassName: string; out CodeTool: TCodeTool): boolean;
666
667 // insert/replace
InsertStatementsnull668 function InsertStatements(InsertPos: TInsertStatementPosDescription;
669 const Statements: string): boolean;
670
671 // alter proc
AddProcModifiernull672 function AddProcModifier(Code: TCodeBuffer; X, Y: integer;
673 const aModifier: string): boolean;
674
675 // extract proc (creates a new procedure from code in selection)
676 function CheckExtractProc(Code: TCodeBuffer;
677 const StartPoint, EndPoint: TPoint;
678 out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean;
679 out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
680 VarTree: TAVLTree = nil // tree of TExtractedProcVariable
681 ): boolean;
ExtractProcnull682 function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint;
683 ProcType: TExtractProcType; const ProcName: string;
684 IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
685 var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
686 FunctionResultVariableStartPos: integer = 0
687 ): boolean;
688
689 // 'Assign' method
FindAssignMethodnull690 function FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
691 out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
692 out AssignDeclNode: TCodeTreeNode;
693 var MemberNodeExts: TAVLTree; // tree of TCodeTreeNodeExtension, Node=var or property, Data=write property
694 out AssignBodyNode: TCodeTreeNode;
695 out InheritedDeclContext: TFindContext;
696 ProcName: string = '' // default: Assign
697 ): boolean;
698
699 // source name e.g. 'unit AUnitName;'
GetSourceNamenull700 function GetSourceName(Code: TCodeBuffer; SearchMainCode: boolean): string;
GetCachedSourceNamenull701 function GetCachedSourceName(Code: TCodeBuffer): string;
RenameSourcenull702 function RenameSource(Code: TCodeBuffer; const NewName: string): boolean;
GetSourceTypenull703 function GetSourceType(Code: TCodeBuffer; SearchMainCode: boolean): string;
704
705 // uses sections
FindUnitInAllUsesSectionsnull706 function FindUnitInAllUsesSections(Code: TCodeBuffer;
707 const AnUnitName: string; out NamePos, InPos: integer;
708 const IgnoreMissingIncludeFiles: Boolean = False): boolean;
RenameUsedUnitnull709 function RenameUsedUnit(Code: TCodeBuffer;
710 const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
ReplaceUsedUnitsnull711 function ReplaceUsedUnits(Code: TCodeBuffer;
712 UnitNamePairs: TStringToStringTree): boolean;
AddUnitToMainUsesSectionnull713 function AddUnitToMainUsesSection(Code: TCodeBuffer;
714 const NewUnitName, NewUnitInFile: string;
715 const Flags: TAddUsesFlags = []): boolean; overload;
AddUnitToMainUsesSectionnull716 function AddUnitToMainUsesSection(Code: TCodeBuffer;
717 const NewUnitName, NewUnitInFile: string;
718 AsLast: boolean; CheckSpecialUnits: boolean = true): boolean; overload; deprecated;
AddUnitToMainUsesSectionIfNeedednull719 function AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
720 const NewUnitName, NewUnitInFile: string;
721 const Flags: TAddUsesFlags = []): boolean;
AddUnitToMainUsesSectionIfNeedednull722 function AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
723 const NewUnitName, NewUnitInFile: string;
724 AsLast: boolean; CheckSpecialUnits: boolean = true): boolean; overload; deprecated;
AddUnitToImplementationUsesSectionnull725 function AddUnitToImplementationUsesSection(Code: TCodeBuffer;
726 const NewUnitName, NewUnitInFile: string;
727 const Flags: TAddUsesFlags = []): boolean;
AddUnitToImplementationUsesSectionnull728 function AddUnitToImplementationUsesSection(Code: TCodeBuffer;
729 const NewUnitName, NewUnitInFile: string;
730 AsLast: boolean; CheckSpecialUnits: boolean = true): boolean; overload; deprecated;
RemoveUnitFromAllUsesSectionsnull731 function RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
732 const AnUnitName: string): boolean;
FindUsedUnitFilesnull733 function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection: TStrings
734 ): boolean; // only main uses section, if unit not found, returns "unitname" or "unitname in 'filename'"
FindUsedUnitFilesnull735 function FindUsedUnitFiles(Code: TCodeBuffer; var MainUsesSection,
736 ImplementationUsesSection: TStrings): boolean;
FindUsedUnitNamesnull737 function FindUsedUnitNames(Code: TCodeBuffer; var MainUsesSection,
738 ImplementationUsesSection: TStrings): boolean; // ignoring 'in'
FindMissingUnitsnull739 function FindMissingUnits(Code: TCodeBuffer; var MissingUnits: TStrings;
740 FixCase: boolean = false; SearchImplementation: boolean = true): boolean;
FindDelphiProjectUnitsnull741 function FindDelphiProjectUnits(Code: TCodeBuffer;
742 out FoundInUnits, MissingInUnits, NormalUnits: TStrings;
743 IgnoreNormalUnits: boolean = false): boolean;
FindDelphiPackageUnitsnull744 function FindDelphiPackageUnits(Code: TCodeBuffer;
745 var FoundInUnits, MissingInUnits, NormalUnits: TStrings;
746 IgnoreNormalUnits: boolean = false): boolean;
CommentUnitsInUsesSectionsnull747 function CommentUnitsInUsesSections(Code: TCodeBuffer;
748 MissingUnits: TStrings): boolean;
FindUnitCaseInsensitivenull749 function FindUnitCaseInsensitive(Code: TCodeBuffer;
750 var AnUnitName, AnUnitInFilename: string): string;
FindUnitSourcenull751 function FindUnitSource(Code: TCodeBuffer;
752 const AnUnitName, AnUnitInFilename: string): TCodeBuffer;
CreateUsesGraphnull753 function CreateUsesGraph: TUsesGraph;
FindUnusedUnitsnull754 function FindUnusedUnits(Code: TCodeBuffer; Units: TStrings): boolean;
755
756 // resources
757 property OnFindDefinePropertyForContext: TOnFindDefinePropertyForContext
758 read FOnFindDefinePropertyForContext
759 write FOnFindDefinePropertyForContext;
760 property OnFindDefineProperty: TOnFindDefineProperty
761 read FOnFindDefineProperty
762 write FOnFindDefineProperty;
FindLFMFileNamenull763 function FindLFMFileName(Code: TCodeBuffer): string;
CheckLFMnull764 function CheckLFM(UnitCode, LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
765 RootMustBeClassInUnit, RootMustBeClassInIntf,
766 ObjectsMustExist: boolean): boolean;
FindNextResourceFilenull767 function FindNextResourceFile(Code: TCodeBuffer;
768 var LinkIndex: integer): TCodeBuffer;
AddLazarusResourceHeaderCommentnull769 function AddLazarusResourceHeaderComment(Code: TCodeBuffer;
770 const CommentText: string): boolean;
FindLazarusResourcenull771 function FindLazarusResource(Code: TCodeBuffer;
772 const ResourceName: string): TAtomPosition;
AddLazarusResourcenull773 function AddLazarusResource(Code: TCodeBuffer;
774 const ResourceName, ResourceData: string): boolean;
RemoveLazarusResourcenull775 function RemoveLazarusResource(Code: TCodeBuffer;
776 const ResourceName: string): boolean;
RenameMainIncludenull777 function RenameMainInclude(Code: TCodeBuffer; const NewFilename: string;
778 KeepPath: boolean): boolean;
RenameIncludeDirectivenull779 function RenameIncludeDirective(Code: TCodeBuffer; LinkIndex: integer;
780 const NewFilename: string; KeepPath: boolean): boolean;// in cleaned source
781 procedure DefaultFindDefinePropertyForContext(Sender: TObject;
782 const ClassContext, AncestorClassContext: TFindContext;
783 {%H-}LFMNode: TLFMTreeNode;
784 const IdentName: string; var IsDefined: boolean);
785
786 // Delphi to Lazarus conversion
ConvertDelphiToLazarusSourcenull787 function ConvertDelphiToLazarusSource(Code: TCodeBuffer;
788 AddLRSCode: boolean): boolean;
789
790 // Application.Createform(ClassName,VarName) statements in program source
FindCreateFormStatementnull791 function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
792 const AClassName, AVarName: string;
793 out Position: integer): integer; // 0=found, -1=not found, 1=found, but wrong classname
AddCreateFormStatementnull794 function AddCreateFormStatement(Code: TCodeBuffer;
795 const AClassName, AVarName: string): boolean;
RemoveCreateFormStatementnull796 function RemoveCreateFormStatement(Code: TCodeBuffer;
797 const AVarName: string): boolean;
ChangeCreateFormStatementnull798 function ChangeCreateFormStatement(Code: TCodeBuffer;
799 const OldClassName, OldVarName: string;
800 const NewClassName, NewVarName: string;
801 OnlyIfExists: boolean): boolean;
ListAllCreateFormStatementsnull802 function ListAllCreateFormStatements(Code: TCodeBuffer): TStrings;
SetAllCreateFromStatementsnull803 function SetAllCreateFromStatements(Code: TCodeBuffer;
804 List: TStrings): boolean;
805
806 // Application.Title:= statements in program source
GetApplicationTitleStatementnull807 function GetApplicationTitleStatement(Code: TCodeBuffer;
808 var Title: string): boolean;
SetApplicationTitleStatementnull809 function SetApplicationTitleStatement(Code: TCodeBuffer;
810 const NewTitle: string): boolean;
RemoveApplicationTitleStatementnull811 function RemoveApplicationTitleStatement(Code: TCodeBuffer): boolean;
812
813 // Application.Scaled:= statements in program source
GetApplicationScaledStatementnull814 function GetApplicationScaledStatement(Code: TCodeBuffer;
815 var AScaled: Boolean): boolean;
SetApplicationScaledStatementnull816 function SetApplicationScaledStatement(Code: TCodeBuffer;
817 const NewScaled: Boolean): boolean;
RemoveApplicationScaledStatementnull818 function RemoveApplicationScaledStatement(Code: TCodeBuffer): boolean;
819
820 // forms
821 // Hint: to find the class use FindDeclarationInInterface
RenameFormnull822 function RenameForm(Code: TCodeBuffer;
823 const OldFormName, OldFormClassName: string;
824 const NewFormName, NewFormClassName: string): boolean;
FindFormAncestornull825 function FindFormAncestor(Code: TCodeBuffer; const FormClassName: string;
826 out AncestorClassName: string; DirtySearch: boolean): boolean;
827
828 // form components
CompleteComponentnull829 function CompleteComponent(Code: TCodeBuffer;
830 AComponent, AncestorComponent: TComponent): boolean;
PublishedVariableExistsnull831 function PublishedVariableExists(Code: TCodeBuffer;
832 const AClassName, AVarName: string;
833 ErrorOnClassNotFound: boolean): boolean;
AddPublishedVariablenull834 function AddPublishedVariable(Code: TCodeBuffer;
835 const AClassName,VarName, VarType: string): boolean;
RemovePublishedVariablenull836 function RemovePublishedVariable(Code: TCodeBuffer;
837 const AClassName, AVarName: string;
838 ErrorOnClassNotFound: boolean): boolean;
RenamePublishedVariablenull839 function RenamePublishedVariable(Code: TCodeBuffer;
840 const AClassName, OldVariableName, NewVarName,
841 VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
RetypeClassVariablesnull842 function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string;
843 ListOfReTypes: TStringToStringTree;
844 ErrorOnClassNotFound: boolean;
845 SearchImplementationToo: boolean = false): boolean;
FindDanglingComponentEventsnull846 function FindDanglingComponentEvents(Code: TCodeBuffer;
847 const AClassName: string;
848 RootComponent: TComponent; ExceptionOnClassNotFound,
849 SearchInAncestors: boolean;
850 out ListOfPInstancePropInfo: TFPList;
851 const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
852
853 // utilities for the object inspector
GetCompatiblePublishedMethodsnull854 function GetCompatiblePublishedMethods(Code: TCodeBuffer;
855 const AClassName: string;
856 PropInstance: TPersistent; const PropName: string;
857 const Proc: TGetStrProc): boolean;
GetCompatiblePublishedMethodsnull858 function GetCompatiblePublishedMethods(Code: TCodeBuffer;
859 const AClassName: string; TypeData: PTypeData;
860 const Proc: TGetStrProc): boolean;
PublishedMethodExistsnull861 function PublishedMethodExists(Code:TCodeBuffer;
862 const AClassName, AMethodName: string;
863 PropInstance: TPersistent; const PropName: string;
864 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
865 ): boolean;
PublishedMethodExistsnull866 function PublishedMethodExists(Code:TCodeBuffer; const AClassName,
867 AMethodName: string; TypeData: PTypeData;
868 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
869 ): boolean;
JumpToPublishedMethodBodynull870 function JumpToPublishedMethodBody(Code: TCodeBuffer;
871 const AClassName, AMethodName: string;
872 out NewCode: TCodeBuffer;
873 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
RenamePublishedMethodnull874 function RenamePublishedMethod(Code: TCodeBuffer;
875 const AClassName, OldMethodName,
876 NewMethodName: string): boolean;
CreatePublishedMethodnull877 function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
878 NewMethodName: string; ATypeInfo: PTypeInfo;
879 UseTypeInfoForParameters: boolean = false;
880 const APropertyUnitName: string = ''; const APropertyPath: string = '';
881 const CallAncestorMethod: string = ''; AddOverride: boolean = false
882 ): boolean;
883
884 // private class parts
CreatePrivateMethodnull885 function CreatePrivateMethod(Code: TCodeBuffer; const AClassName,
886 NewMethodName: string; ATypeInfo: PTypeInfo;
887 UseTypeInfoForParameters: boolean = false;
888 const APropertyUnitName: string = '';
889 const APropertyPath: string = ''): boolean;
890
891 // IDE % directives
GetIDEDirectivesnull892 function GetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings;
893 const Filter: TOnIDEDirectiveFilter = nil): boolean;
SetIDEDirectivesnull894 function SetIDEDirectives(Code: TCodeBuffer; DirectiveList: TStrings;
895 const Filter: TOnIDEDirectiveFilter = nil): boolean;
896
897 // linker jumping
JumpToLinkerIdentifiernull898 function JumpToLinkerIdentifier(Code: TCodeBuffer;
899 const SourceFilename: string; SourceLine: integer;
900 const MangledFunction, Identifier: string;
901 out NewCode: TCodeBuffer;
902 out NewX, NewY, NewTopLine: integer): boolean;
903
904 // gdb stacktraces
FindFPCMangledIdentifiernull905 function FindFPCMangledIdentifier(GDBIdentifier: string; out aComplete: boolean;
906 out aMessage: string; const OnFindSource: TOnFindFPCMangledSource;
907 out NewCode: TCodeBuffer;
908 out NewX, NewY, NewTopLine: integer): boolean;
909 property OnFindFPCMangledSource: TOnFindFPCMangledSource
910 read FOnFindFPCMangledSource write FOnFindFPCMangledSource;
911
912 // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
913
914 procedure ConsistencyCheck;
915 procedure WriteDebugReport(WriteTool,
916 WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
917 WriteMemStats: boolean);
918 procedure WriteMemoryStats;
919 end;
920
921
922 var CodeToolBoss: TCodeToolManager;
923
924
CreateDefinesForFPCModenull925 function CreateDefinesForFPCMode(const Name: string;
926 CompilerMode: TCompilerMode): TDefineTemplate;
927
928
929 implementation
930
931
CompareCodeToolMainSourcesnull932 function CompareCodeToolMainSources(Data1, Data2: Pointer): integer;
933 var
934 Src1, Src2: Pointer;
935 begin
936 Src1:=TCustomCodeTool(Data1).Scanner.MainCode;
937 Src2:=TCustomCodeTool(Data2).Scanner.MainCode;
938 if Src1<Src2 then
939 Result:=-1
940 else if Src1>Src2 then
941 Result:=+1
942 else
943 Result:=0;
944 end;
945
CompareDirectivesTreeSourcesnull946 function CompareDirectivesTreeSources(Data1, Data2: Pointer): integer;
947 var
948 Src1, Src2: Pointer;
949 begin
950 Src1:=TCompilerDirectivesTree(Data1).Code;
951 Src2:=TCompilerDirectivesTree(Data2).Code;
952 if Src1<Src2 then
953 Result:=-1
954 else if Src1>Src2 then
955 Result:=+1
956 else
957 Result:=0;
958 end;
959
GetOwnerForCodeTreeNodenull960 function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject;
961 begin
962 Result:=CodeToolBoss.GetOwnerForCodeTreeNode(ANode);
963 end;
964
965 procedure DumpExceptionBackTrace;
966 var
967 FrameCount: integer;
968 Frames: PPointer;
969 FrameNumber:Integer;
970 begin
971 DebugLn('Codetools Stack trace:');
972 DebugLn(BackTraceStrFunc(ExceptAddr));
973 FrameCount:=ExceptFrameCount;
974 Frames:=ExceptFrames;
975 for FrameNumber := 0 to FrameCount-1 do
976 DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
977 end;
978
CreateDefinesForFPCModenull979 function CreateDefinesForFPCMode(const Name: string; CompilerMode: TCompilerMode
980 ): TDefineTemplate;
981 var
982 cm: TCompilerMode;
983 NewMode: String;
984 begin
985 Result:=TDefineTemplate.Create(Name,'set FPC compiler mode',
986 '','',da_Block);
987 for cm:=Low(TCompilerMode) to High(TCompilerMode) do begin
988 Result.AddChild(TDefineTemplate.Create(CompilerModeVars[cm],
989 CompilerModeVars[cm],CompilerModeVars[cm],'',da_Undefine));
990 end;
991 NewMode:=CompilerModeVars[CompilerMode];
992 Result.AddChild(TDefineTemplate.Create(NewMode,
993 NewMode,NewMode,'1',da_Define));
994 end;
995
996 { ECodeToolManagerError }
997
998 constructor ECodeToolManagerError.Create(TheID: int64; const Msg: string);
999 begin
1000 Id:=TheID;
1001 inherited Create(Msg);
1002 end;
1003
1004 constructor ECodeToolManagerError.CreateFmt(TheID: int64; const Msg: string;
1005 const Args: array of const);
1006 begin
1007 Id:=TheID;
1008 inherited CreateFmt(Msg,Args);
1009 end;
1010
1011 { TCodeToolManager }
1012
1013 // inline
GetBeautifiernull1014 function TCodeToolManager.GetBeautifier: TBeautifyCodeOptions;
1015 begin
1016 Result:=SourceChangeCache.BeautifyCodeOptions;
1017 end;
1018
1019 constructor TCodeToolManager.Create;
1020 begin
1021 inherited Create;
1022 FCheckFilesOnDisk:=true;
1023 FOnFindDefinePropertyForContext:=@DefaultFindDefinePropertyForContext;
1024 DirectoryCachePool:=TCTDirectoryCachePool.Create;
1025 DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString;
1026 DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile;
1027 DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet;
1028 DirectoryCachePool.OnGetCompiledUnitFromSet:=@DirectoryCachePoolGetCompiledUnitFromSet;
1029 DirectoryCachePool.OnIterateFPCUnitsFromSet:=@DirectoryCachePoolIterateFPCUnitsFromSet;
1030 DefineTree:=TDefineTree.Create;
1031 DefineTree.OnReadValue:=@DoOnDefineTreeReadValue;
1032 DefinePool:=TDefinePool.Create;
1033 SourceCache:=TCodeCache.Create;
1034 SourceCache.DirectoryCachePool:=DirectoryCachePool;
1035 if DefaultConfigCodeCache=nil then
1036 DefaultConfigCodeCache:=SourceCache;
1037 SourceChangeCache:=TSourceChangeCache.Create;
1038 SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
1039 SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
1040 Indenter:=TFullyAutomaticBeautifier.Create;
1041 Indenter.OnGetNestedComments:=@DoOnFABGetNestedComments;
1042 Indenter.OnGetExamples:=@DoOnFABGetExamples;
1043 Indenter.OnLoadFile:=@DoOnLoadFileForTool;
1044 GlobalValues:=TExpressionEvaluator.Create;
1045 OnFileExistsCached:=@DirectoryCachePool.FileExists;
1046 OnFileAgeCached:=@DirectoryCachePool.FileAge;
1047 DefineTree.DirectoryCachePool:=DirectoryCachePool;
1048 CompilerDefinesCache:=TCompilerDefinesCache.Create(nil);
1049 PPUCache:=TPPUTools.Create;
1050 FAddInheritedCodeToOverrideMethod:=true;
1051 FAdjustTopLineDueToComment:=true;
1052 FCatchExceptions:=true;
1053
1054 FCompleteProperties:=true;
1055 FSetPropertyVariablename:='AValue';
1056 FSetPropertyVariableIsPrefix := false;
1057 FSetPropertyVariableUseConst := false;
1058 FAddInheritedCodeToOverrideMethod := true;
1059
1060 FCursorBeyondEOL:=true;
1061 FIndentSize:=2;
1062 FJumpSingleLinePos:=50;
1063 FJumpSingleLinePos:=0;
1064 FSourceExtensions:='.pp;.pas;.p;.lpr;.lpk;.dpr;.dpk';
1065 FVisibleEditorLines:=20;
1066 FWriteExceptions:=true;
1067 FPascalTools:=TAVLTree.Create(@CompareCodeToolMainSources);
1068 FDirectivesTools:=TAVLTree.Create(@CompareDirectivesTreeSources);
1069 IdentifierList:=TIdentifierList.Create;
1070 IdentifierHistory:=TIdentifierHistoryList.Create;
1071 IdentifierList.History:=IdentifierHistory;
1072 DefaultLFMTrees:=TLFMTrees.Create;
1073 end;
1074
1075 destructor TCodeToolManager.Destroy;
1076 var
1077 e: TCodeToolManagerHandler;
1078 begin
1079 {$IFDEF CTDEBUG}
1080 DebugLn('[TCodeToolManager.Destroy] A');
1081 {$ENDIF}
1082 FreeAndNil(GlobalValues);
1083 {$IFDEF CTDEBUG}
1084 DebugLn('[TCodeToolManager.Destroy] B');
1085 {$ENDIF}
1086 FreeAndNil(DefaultLFMTrees);
1087 FreeAndNil(Positions);
1088 FreeAndNil(IdentifierHistory);
1089 FreeAndNil(IdentifierList);
1090 FPascalTools.FreeAndClear;
1091 FreeAndNil(FPascalTools);
1092 FDirectivesTools.FreeAndClear;
1093 FreeAndNil(FDirectivesTools);
1094 FreeAndNil(PPUCache);
1095 FreeAndNil(FResourceTool);
1096 {$IFDEF CTDEBUG}
1097 DebugLn('[TCodeToolManager.Destroy] C');
1098 {$ENDIF}
1099 FreeAndNil(DefineTree);
1100 FreeAndNil(DefinePool);
1101 {$IFDEF CTDEBUG}
1102 DebugLn('[TCodeToolManager.Destroy] D');
1103 {$ENDIF}
1104 FreeAndNil(Indenter);
1105 FreeAndNil(SourceChangeCache);
1106 {$IFDEF CTDEBUG}
1107 DebugLn('[TCodeToolManager.Destroy] E');
1108 {$ENDIF}
1109 if DefaultConfigCodeCache=SourceCache then
1110 DefaultConfigCodeCache:=nil;
1111 FreeAndNil(SourceCache);
1112 if OnFileExistsCached=@DirectoryCachePool.FileExists then
1113 OnFileExistsCached:=nil;
1114 if OnFileAgeCached=@DirectoryCachePool.FileAge then
1115 OnFileAgeCached:=nil;
1116 FreeAndNil(DirectoryCachePool);
1117 FreeAndNil(CompilerDefinesCache);
1118 for e:=low(FHandlers) to high(FHandlers) do
1119 FreeAndNil(FHandlers[e]);
1120 {$IFDEF CTDEBUG}
1121 DebugLn('[TCodeToolManager.Destroy] F');
1122 {$ENDIF}
1123 inherited Destroy;
1124 {$IFDEF CTDEBUG}
1125 DebugLn('[TCodeToolManager.Destroy] END');
1126 {$ENDIF}
1127 {$IFDEF MEM_CHECK}
1128 CheckHeap('TCodeToolManager.Destroy END');
1129 {$ENDIF}
1130 end;
1131
1132 procedure TCodeToolManager.Init(Config: TCodeToolsOptions);
1133 var
1134 FPCDefines: TDefineTemplate;
1135 FPCSrcDefines: TDefineTemplate;
1136 LazarusSrcDefines: TDefineTemplate;
1137 CurFPCOptions: String;
1138 UnitSetCache: TFPCUnitSetCache;
1139 //CfgCache: TPCTargetConfigCache;
1140
1141 procedure AddFPCOption(s: string);
1142 begin
1143 if s='' then exit;
1144 if CurFPCOptions<>'' then
1145 CurFPCOptions:=CurFPCOptions+' ';
1146 CurFPCOptions:=CurFPCOptions+s;
1147 end;
1148
1149 begin
1150 // set global values
1151 with GlobalValues do begin
1152 Variables[ExternalMacroStart+'LazarusSrcDir']:=Config.LazarusSrcDir;
1153 Variables[ExternalMacroStart+'FPCSrcDir']:=Config.FPCSrcDir;
1154 Variables[ExternalMacroStart+'LCLWidgetType']:=Config.LCLWidgetType;
1155 Variables[ExternalMacroStart+'ProjectDir']:=Config.ProjectDir;
1156 end;
1157
1158 CompilerDefinesCache.ConfigCaches.Assign(Config.ConfigCaches);
1159 CompilerDefinesCache.SourceCaches.Assign(Config.SourceCaches);
1160 CompilerDefinesCache.TestFilename:=Config.TestPascalFile;
1161 if CompilerDefinesCache.TestFilename='' then
1162 CompilerDefinesCache.TestFilename:=GetTempFilename('fpctest.pas','');
1163
1164 UnitSetCache:=CompilerDefinesCache.FindUnitSet(Config.FPCPath,
1165 Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
1166 true);
1167 // parse compiler settings, fpc sources
1168 UnitSetCache.Init;
1169 //CfgCache:=UnitSetCache.GetConfigCache(false);
1170 //if CfgCache.TargetOS<>CfgCache.RealTargetOS then
1171 // debugln(['TCodeToolManager.Init TargetOS=',CfgCache.TargetOS,' RealTargetOS=',CfgCache.RealTargetOS]);
1172 //if CfgCache.TargetCPU<>CfgCache.RealTargetCPU then
1173 // debugln(['TCodeToolManager.Init TargetCPU=',CfgCache.TargetCPU,' RealTargetCPU=',CfgCache.RealTargetCPU]);
1174
1175 // save
1176 Config.ConfigCaches.Assign(CompilerDefinesCache.ConfigCaches);
1177 Config.SourceCaches.Assign(CompilerDefinesCache.SourceCaches);
1178
1179 // create template for FPC settings
1180 FPCDefines:=CreateFPCTemplate(UnitSetCache,nil);
1181 DefineTree.Add(FPCDefines);
1182
1183 // create template for FPC source directory
1184 FPCSrcDefines:=CreateFPCSourceTemplate(UnitSetCache,nil);
1185 DefineTree.Add(FPCSrcDefines);
1186
1187 // create template for lazarus source directory
1188 LazarusSrcDefines:=DefinePool.CreateLazarusSrcTemplate('$(#LazarusSrcDir)',
1189 '$(#LCLWidgetType)',Config.LazarusSrcOptions,nil);
1190 DefineTree.Add(LazarusSrcDefines);
1191
1192 // create template for LCL project
1193 DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
1194 '$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil));
1195
1196 //debugln(['TCodeToolManager.Init defines: ',DefineTree.GetDefinesForVirtualDirectory.AsString]);
1197 //debugln(['TCodeToolManager.Init inc path rtl/system: ',GetIncludePathForDirectory(UnitSetCache.FPCSourceDirectory+'/rtl/bsd')]);
1198 end;
1199
1200 procedure TCodeToolManager.SimpleInit(const ConfigFilename: string);
1201 var
1202 Options: TCodeToolsOptions;
1203 begin
1204 // setup the Options
1205 Options:=TCodeToolsOptions.Create;
1206 try
1207 // To not parse the FPC sources every time, the options are saved to a file.
1208 DebugLn(['TCodeToolManager.SimpleInit Config=',ConfigFilename]);
1209 if FileExistsUTF8(ConfigFilename) then
1210 Options.LoadFromFile(ConfigFilename);
1211 // use environment variables
1212 Options.InitWithEnvironmentVariables;
1213 // apply defaults
1214 if Options.FPCSrcDir='' then
1215 Options.FPCSrcDir:=ExpandFileNameUTF8('~/freepascal/fpc');
1216 if Options.LazarusSrcDir='' then
1217 Options.LazarusSrcDir:=ExpandFileNameUTF8('~/pascal/lazarus');
1218 DebugLn(['TCodeToolManager.SimpleInit PP=',Options.FPCPath,' FPCDIR=',Options.FPCSrcDir,' LAZARUSDIR=',Options.LazarusSrcDir,' FPCTARGET=',Options.TargetOS]);
1219 // init the codetools
1220 if not Options.UnitLinkListValid then
1221 debugln('Scanning FPC sources may take a while ...');
1222 Init(Options);
1223
1224 // save the options and the FPC unit links results.
1225 Options.SaveToFile(ConfigFilename);
1226 finally
1227 Options.Free;
1228 end;
1229 end;
1230
1231 procedure TCodeToolManager.BeginUpdate;
1232 begin
1233 SourceChangeCache.BeginUpdate;
1234 end;
1235
TCodeToolManager.EndUpdatenull1236 function TCodeToolManager.EndUpdate: boolean;
1237 begin
1238 Result:=SourceChangeCache.EndUpdate;
1239 end;
1240
TCodeToolManager.GatherExternalChangesnull1241 function TCodeToolManager.GatherExternalChanges: boolean;
1242 var
1243 Abort: Boolean;
1244 begin
1245 Result:=true;
1246 if Assigned(OnGatherExternalChanges) then begin
1247 Abort:=false;
1248 OnGatherExternalChanges(Self,Abort);
1249 Result:=not Abort;
1250 end;
1251 end;
1252
FindFilenull1253 function TCodeToolManager.FindFile(const ExpandedFilename: string): TCodeBuffer;
1254 begin
1255 Result:=SourceCache.FindFile(ExpandedFilename);
1256 end;
1257
TCodeToolManager.LoadFilenull1258 function TCodeToolManager.LoadFile(const ExpandedFilename: string;
1259 UpdateFromDisk, Revert: boolean): TCodeBuffer;
1260 begin
1261 {$IFDEF CTDEBUG}
1262 DebugLn('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',dbgs(UpdateFromDisk),' Revert=',dbgs(Revert));
1263 {$ENDIF}
1264 if (not UpdateFromDisk) and (not Revert) then begin
1265 Result:=SourceCache.FindFile(ExpandedFilename);
1266 if (Result<>nil) and (not Result.IsDeleted) then exit;
1267 end;
1268 Result:=SourceCache.LoadFile(ExpandedFilename);
1269 if Result<>nil then begin
1270 if Revert then begin
1271 if not Result.Revert then
1272 Result:=nil;
1273 end else if UpdateFromDisk and Result.AutoRevertFromDisk
1274 and Result.FileNeedsUpdate then begin
1275 //debugln(['TCodeToolManager.LoadFile ',ExpandedFilename,' AutoRevert=',Result.AutoRevertFromDisk,' Modified=',Result.Modified,' NeedLoad=',Result.FileNeedsUpdate]);
1276 Result.Reload;
1277 end;
1278 end;
1279 end;
1280
CreateFilenull1281 function TCodeToolManager.CreateFile(const AFilename: string): TCodeBuffer;
1282 begin
1283 Result:=SourceCache.CreateFile(AFilename);
1284 DirectoryCachePool.IncreaseFileTimeStamp;
1285 {$IFDEF CTDEBUG}
1286 DebugLn('****** TCodeToolManager.CreateFile "',AFilename,'" ',dbgs(Result<>nil));
1287 {$ENDIF}
1288 end;
1289
CreateTempFilenull1290 function TCodeToolManager.CreateTempFile(const AFilename: string): TCodeBuffer;
1291 var
1292 i: Integer;
1293 TempFilename: string;
1294 CurName: String;
1295 CurExt: String;
1296 begin
1297 TempFilename:=VirtualTempDir+PathDelim+AFilename;
1298 Result:=FindFile(TempFilename);
1299 if (Result<>nil) and (Result.ReferenceCount=0) then exit;
1300 CurName:=ExtractFileNameOnly(AFilename);
1301 CurExt:=ExtractFileExt(AFilename);
1302 i:=1;
1303 repeat
1304 TempFilename:=VirtualTempDir+PathDelim+CurName+IntToStr(i)+CurExt;
1305 Result:=FindFile(TempFilename);
1306 if (Result<>nil) and (Result.ReferenceCount=0) then exit;
1307 inc(i);
1308 until Result=nil;
1309 Result:=SourceCache.CreateFile(TempFilename);
1310 Result.IncrementRefCount;
1311 end;
1312
1313 procedure TCodeToolManager.ReleaseTempFile(Buffer: TCodeBuffer);
1314 begin
1315 Buffer.ReleaseRefCount;
1316 end;
1317
SaveBufferAsnull1318 function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
1319 const ExpandedFilename: string; out NewBuffer: TCodeBuffer): boolean;
1320 begin
1321 Result:=SourceCache.SaveBufferAs(OldBuffer,ExpandedFilename,NewBuffer);
1322 end;
1323
FilenameHasSourceExtnull1324 function TCodeToolManager.FilenameHasSourceExt(
1325 const AFilename: string): boolean;
1326 var i, CurExtStart, CurExtEnd, ExtStart, ExtLen: integer;
1327 begin
1328 ExtStart:=length(AFilename);
1329 while (ExtStart>0) and (AFilename[ExtStart]<>'.')
1330 and (AFilename[ExtStart]<>PathDelim) do
1331 dec(ExtStart);
1332 if (ExtStart<1) or (AFilename[ExtStart]<>'.') then begin
1333 Result:=false;
1334 exit;
1335 end;
1336 ExtLen:=length(AFilename)-ExtStart+1;
1337 CurExtStart:=1;
1338 CurExtEnd:=CurExtStart;
1339 while CurExtEnd<=length(FSourceExtensions)+1 do begin
1340 if (CurExtEnd>length(FSourceExtensions))
1341 or (FSourceExtensions[CurExtEnd] in [':',';']) then begin
1342 // compare current extension with filename-extension
1343 if ExtLen=CurExtEnd-CurExtStart then begin
1344 i:=0;
1345 while (i<ExtLen)
1346 and (UpChars[AFilename[i+ExtStart]]
1347 =UpChars[FSourceExtensions[CurExtStart+i]]) do
1348 inc(i);
1349 if i=ExtLen then begin
1350 Result:=true;
1351 exit;
1352 end;
1353 end;
1354 inc(CurExtEnd);
1355 CurExtStart:=CurExtEnd;
1356 end else
1357 inc(CurExtEnd);
1358 end;
1359 Result:=false;
1360 end;
1361
TCodeToolManager.GetMainCodenull1362 function TCodeToolManager.GetMainCode(Code: TCodeBuffer): TCodeBuffer;
1363 var
1364 NewFile: TCodeBuffer;
1365 begin
1366 // find MainCode (= the start source, e.g. a unit/program/package source)
1367 Result:=Code;
1368 if Result=nil then exit;
1369 // if this is an include file, find the top level source
1370 while (Result.LastIncludedByFile<>'') do begin
1371 NewFile:=SourceCache.LoadFile(Result.LastIncludedByFile);
1372 if (NewFile=nil) then begin
1373 Result.LastIncludedByFile:='';
1374 break;
1375 end;
1376 Result:=NewFile;
1377 end;
1378 if (not FilenameHasSourceExt(Result.Filename)) then begin
1379 NewFile:=FindCodeOfMainUnitHint(Result);
1380 if NewFile<>nil then Result:=NewFile;
1381 end;
1382 CreateScanner(Result);
1383 end;
1384
GetIncludeCodeChainnull1385 function TCodeToolManager.GetIncludeCodeChain(Code: TCodeBuffer;
1386 RemoveFirstCodesWithoutTool: boolean; out ListOfCodeBuffer: TFPList): boolean;
1387 var
1388 OldCode: TCodeBuffer;
1389 NewCode: TCodeBuffer;
1390 begin
1391 // find MainCode (= the start source, e.g. a unit/program/package source)
1392 Result:=false;
1393 ListOfCodeBuffer:=nil;
1394 if Code=nil then exit;
1395
1396 Result:=true;
1397 ListOfCodeBuffer:=TFPList.Create;
1398 ListOfCodeBuffer.Add(Code);
1399
1400 // if this is an include file, find the top level source
1401 while (Code.LastIncludedByFile<>'') do begin
1402 NewCode:=SourceCache.LoadFile(Code.LastIncludedByFile);
1403 if NewCode=nil then begin
1404 NewCode.LastIncludedByFile:='';
1405 break;
1406 end;
1407 Code:=NewCode;
1408 ListOfCodeBuffer.Insert(0,Code);
1409 end;
1410
1411 if (not FilenameHasSourceExt(Code.Filename)) then begin
1412 OldCode:=Code;
1413 Code:=FindCodeOfMainUnitHint(OldCode);
1414 if Code<>OldCode then
1415 ListOfCodeBuffer.Insert(0,Code);
1416 end;
1417
1418 if RemoveFirstCodesWithoutTool then begin
1419 while ListOfCodeBuffer.Count>0 do begin
1420 Code:=TCodeBuffer(ListOfCodeBuffer[0]);
1421 if FindCodeToolForSource(Code)<>nil then break;
1422 ListOfCodeBuffer.Delete(0);
1423 end;
1424 if ListOfCodeBuffer.Count=0 then begin
1425 ListOfCodeBuffer.Free;
1426 ListOfCodeBuffer:=nil;
1427 Result:=false;
1428 exit;
1429 end;
1430 end;
1431 end;
1432
FindCodeOfMainUnitHintnull1433 function TCodeToolManager.FindCodeOfMainUnitHint(Code: TCodeBuffer
1434 ): TCodeBuffer;
1435 var
1436 MainUnitFilename: string;
1437 begin
1438 Result:=nil;
1439 if Code=nil then exit;
1440 //DebugLn('TCodeToolManager.FindCodeOfMainUnitHint ',Code.Filename);
1441 if not FindMainUnitHint(Code.Source,MainUnitFilename) then exit;
1442 if MainUnitFilename='' then exit;
1443 MainUnitFilename:=TrimFilename(MainUnitFilename);
1444 if (not FilenameIsAbsolute(MainUnitFilename))
1445 and (not Code.IsVirtual) then
1446 MainUnitFilename:=TrimFilename(ExtractFilePath(Code.Filename)+PathDelim
1447 +MainUnitFilename);
1448 //DebugLn('TCodeToolManager.FindCodeOfMainUnitHint B ');
1449 Result:=SourceCache.LoadFile(MainUnitFilename);
1450 end;
1451
1452 procedure TCodeToolManager.CreateScanner(Code: TCodeBuffer);
1453 begin
1454 if FilenameHasSourceExt(Code.Filename) and (Code.Scanner=nil) then begin
1455 // create a scanner for the unit/program
1456 Code.Scanner:=TLinkScanner.Create;
1457 Code.Scanner.OnGetInitValues:=@DoOnScannerGetInitValues;
1458 Code.Scanner.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
1459 Code.Scanner.OnGetGlobalChangeSteps:=@DoOnToolGetChangeSteps;
1460 Code.Scanner.OnProgress:=@DoOnScannerProgress;
1461 end;
1462 end;
1463
1464 procedure TCodeToolManager.ClearError;
1465 begin
1466 fErrorMsg:='';
1467 fErrorCode:=nil;
1468 fErrorLine:=-1;
1469 fErrorTopLine:=0;
1470 FErrorId:=0;
1471 FErrorMsg := '';
1472 FErrorDbgMsg := '';
1473 end;
1474
1475 procedure TCodeToolManager.ClearCurCodeTool;
1476 begin
1477 ClearError;
1478 FCurCodeTool:=nil;
1479 end;
1480
ApplyChangesnull1481 function TCodeToolManager.ApplyChanges: boolean;
1482 begin
1483 Result:=SourceChangeCache.Apply;
1484 end;
1485
TCodeToolManager.SetGlobalValuenull1486 function TCodeToolManager.SetGlobalValue(const VariableName,
1487 VariableValue: string): boolean;
1488 var
1489 OldValue: string;
1490 begin
1491 OldValue:=GlobalValues[VariableName];
1492 Result:=(OldValue<>VariableValue);
1493 if not Result then exit;
1494 GlobalValues[VariableName]:=VariableValue;
1495 DefineTree.ClearCache;
1496 end;
1497
TCodeToolManager.GetUnitPathForDirectorynull1498 function TCodeToolManager.GetUnitPathForDirectory(const Directory: string;
1499 UseCache: boolean): string;
1500 begin
1501 if UseCache then
1502 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitPath,true)
1503 else
1504 Result:=DefineTree.GetUnitPathForDirectory(Directory);
1505 end;
1506
TCodeToolManager.GetIncludePathForDirectorynull1507 function TCodeToolManager.GetIncludePathForDirectory(const Directory: string;
1508 UseCache: boolean): string;
1509 begin
1510 if UseCache then
1511 Result:=DirectoryCachePool.GetString(Directory,ctdcsIncludePath,true)
1512 else
1513 Result:=DefineTree.GetIncludePathForDirectory(Directory);
1514 end;
1515
GetSrcPathForDirectorynull1516 function TCodeToolManager.GetSrcPathForDirectory(const Directory: string;
1517 UseCache: boolean): string;
1518 begin
1519 if UseCache then
1520 Result:=DirectoryCachePool.GetString(Directory,ctdcsSrcPath,true)
1521 else
1522 Result:=DefineTree.GetSrcPathForDirectory(Directory);
1523 end;
1524
TCodeToolManager.GetCompleteSrcPathForDirectorynull1525 function TCodeToolManager.GetCompleteSrcPathForDirectory(
1526 const Directory: string; UseCache: boolean): string;
1527 // returns the SrcPath + UnitPath + any CompiledSrcPath
1528 var
1529 CurUnitPath: String;
1530 StartPos: Integer;
1531 EndPos: LongInt;
1532 CurSrcPath: String;
1533 CurUnitDir: String;
1534 CurCompiledSrcPath: String;
1535 begin
1536 if UseCache then
1537 Result:=DirectoryCachePool.GetString(Directory,ctdcsCompleteSrcPath,true)
1538 else begin
1539 CurUnitPath:='.;'+GetUnitPathForDirectory(Directory);
1540 CurSrcPath:=GetSrcPathForDirectory(Directory);
1541 // for every unit path, get the CompiledSrcPath
1542 StartPos:=1;
1543 while StartPos<=length(CurUnitPath) do begin
1544 EndPos:=StartPos;
1545 while (EndPos<=length(CurUnitPath)) and (CurUnitPath[EndPos]<>';') do
1546 inc(EndPos);
1547 if EndPos>StartPos then begin
1548 CurUnitDir:=TrimFilename(copy(CurUnitPath,StartPos,EndPos-StartPos));
1549 if not FilenameIsAbsolute(CurUnitDir) then
1550 CurUnitDir:=TrimFilename(AppendPathDelim(Directory)+CurUnitDir);
1551 CurCompiledSrcPath:=CreateAbsoluteSearchPath(
1552 GetCompiledSrcPathForDirectory(CurUnitDir),CurUnitDir);
1553 if CurCompiledSrcPath<>'' then
1554 CurSrcPath:=CurSrcPath+';'+CurCompiledSrcPath;
1555 end;
1556 StartPos:=EndPos+1;
1557 end;
1558 // combine unit, src and compiledsrc search path
1559 Result:=CurUnitPath+';'+CurSrcPath;
1560 // make it absolute, so the user need less string concatenations
1561 if FilenameIsAbsolute(Directory) then
1562 Result:=CreateAbsoluteSearchPath(Result,Directory);
1563 // trim the paths, remove doubles and empty paths
1564 Result:=MinimizeSearchPath(Result);
1565 end;
1566 end;
1567
GetPPUSrcPathForDirectorynull1568 function TCodeToolManager.GetPPUSrcPathForDirectory(const Directory: string
1569 ): string;
1570 begin
1571 Result:=DefineTree.GetPPUSrcPathForDirectory(Directory);
1572 end;
1573
TCodeToolManager.GetDCUSrcPathForDirectorynull1574 function TCodeToolManager.GetDCUSrcPathForDirectory(const Directory: string
1575 ): string;
1576 begin
1577 Result:=DefineTree.GetDCUSrcPathForDirectory(Directory);
1578 end;
1579
GetCompiledSrcPathForDirectorynull1580 function TCodeToolManager.GetCompiledSrcPathForDirectory(
1581 const Directory: string; UseCache: boolean): string;
1582 begin
1583 Result:=DefineTree.GetCompiledSrcPathForDirectory(Directory);
1584 end;
1585
TCodeToolManager.GetNestedCommentsFlagForFilenull1586 function TCodeToolManager.GetNestedCommentsFlagForFile(
1587 const Filename: string): boolean;
1588 var
1589 Directory: String;
1590 begin
1591 Result:=false;
1592 Directory:=ExtractFilePath(Filename);
1593 // check pascal compiler is FPC and mode is FPC or OBJFPC
1594 if GetPascalCompilerForDirectory(Directory)<>pcFPC then exit;
1595 if not (GetCompilerModeForDirectory(Directory) in [cmFPC,cmOBJFPC]) then exit;
1596 Result:=true;
1597 end;
1598
TCodeToolManager.GetPascalCompilerForDirectorynull1599 function TCodeToolManager.GetPascalCompilerForDirectory(const Directory: string
1600 ): TPascalCompiler;
1601 var
1602 Evaluator: TExpressionEvaluator;
1603 begin
1604 Result:=pcFPC;
1605 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1606 if Evaluator=nil then exit;
1607 Result:=TLinkScanner.GetPascalCompiler(Evaluator);
1608 end;
1609
GetCompilerModeForDirectorynull1610 function TCodeToolManager.GetCompilerModeForDirectory(const Directory: string
1611 ): TCompilerMode;
1612 var
1613 Evaluator: TExpressionEvaluator;
1614 cm: TCompilerMode;
1615 begin
1616 Result:=cmFPC;
1617 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1618 if Evaluator=nil then exit;
1619 for cm:=Succ(Low(TCompilerMode)) to High(TCompilerMode) do
1620 if Evaluator.IsDefined(CompilerModeVars[cm]) then
1621 Result:=cm;
1622 end;
1623
GetCompiledSrcExtForDirectorynull1624 function TCodeToolManager.GetCompiledSrcExtForDirectory(const Directory: string
1625 ): string;
1626 begin
1627 Result:='.ppu';
1628 end;
1629
FindUnitInUnitLinksnull1630 function TCodeToolManager.FindUnitInUnitLinks(const Directory, AUnitName: string
1631 ): string;
1632 begin
1633 Result:=DirectoryCachePool.FindUnitInUnitLinks(Directory,AUnitName);
1634 end;
1635
TCodeToolManager.GetUnitLinksForDirectorynull1636 function TCodeToolManager.GetUnitLinksForDirectory(const Directory: string;
1637 UseCache: boolean): string;
1638 var
1639 Evaluator: TExpressionEvaluator;
1640 begin
1641 if UseCache then begin
1642 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitLinks,true)
1643 end else begin
1644 Result:='';
1645 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1646 if Evaluator=nil then exit;
1647 Result:=Evaluator[UnitLinksMacroName];
1648 end;
1649 end;
1650
TCodeToolManager.FindUnitInUnitSetnull1651 function TCodeToolManager.FindUnitInUnitSet(const Directory, AUnitName: string
1652 ): string;
1653 begin
1654 Result:=DirectoryCachePool.FindUnitInUnitSet(Directory,AUnitName);
1655 end;
1656
GetUnitSetIDForDirectorynull1657 function TCodeToolManager.GetUnitSetIDForDirectory(const Directory: string;
1658 UseCache: boolean): string;
1659 var
1660 Evaluator: TExpressionEvaluator;
1661 begin
1662 if UseCache then begin
1663 Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitSet,true)
1664 end else begin
1665 Result:='';
1666 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1667 if Evaluator=nil then exit;
1668 Result:=Evaluator[UnitSetMacroName];
1669 end;
1670 end;
1671
TCodeToolManager.GetUnitSetForDirectorynull1672 function TCodeToolManager.GetUnitSetForDirectory(const Directory: string
1673 ): TFPCUnitSetCache;
1674 var
1675 ID: String;
1676 Changed: boolean;
1677 begin
1678 Result:=nil;
1679 ID:=GetUnitSetIDForDirectory(Directory,true);
1680 if ID='' then exit;
1681 Changed:=false;
1682 Result:=CompilerDefinesCache.FindUnitSetWithID(ID,Changed,false);
1683 if Changed then Result:=nil;
1684 end;
1685
GetFPCUnitPathForDirectorynull1686 function TCodeToolManager.GetFPCUnitPathForDirectory(const Directory: string;
1687 UseCache: boolean): string;
1688 var
1689 Evaluator: TExpressionEvaluator;
1690 begin
1691 if UseCache then begin
1692 Result:=DirectoryCachePool.GetString(Directory,ctdcsFPCUnitPath,true)
1693 end else begin
1694 Result:='';
1695 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1696 if Evaluator=nil then exit;
1697 Result:=Evaluator[FPCUnitPathMacroName];
1698 end;
1699 end;
1700
1701 procedure TCodeToolManager.GetFPCVersionForDirectory(const Directory: string;
1702 out FPCVersion, FPCRelease, FPCPatch: integer);
1703 var
1704 Evaluator: TExpressionEvaluator;
1705 FPCFullVersion: LongInt;
1706 begin
1707 FPCVersion:=0;
1708 FPCRelease:=0;
1709 FPCPatch:=0;
1710 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1711 if Evaluator=nil then exit;
1712 FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0);
1713 FPCVersion:=FPCFullVersion div 10000;
1714 FPCRelease:=(FPCFullVersion div 100) mod 100;
1715 FPCPatch:=FPCFullVersion mod 100;
1716 end;
1717
GetPCVersionForDirectorynull1718 function TCodeToolManager.GetPCVersionForDirectory(const Directory: string
1719 ): integer;
1720 var
1721 Kind: TPascalCompiler;
1722 begin
1723 Result:=GetPCVersionForDirectory(Directory,Kind);
1724 if Kind=pcFPC then ;
1725 end;
1726
GetPCVersionForDirectorynull1727 function TCodeToolManager.GetPCVersionForDirectory(const Directory: string; out
1728 Kind: TPascalCompiler): integer;
1729 var
1730 Evaluator: TExpressionEvaluator;
1731 s: String;
1732 begin
1733 Result:=0;
1734 Kind:=pcFPC;
1735 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1736 if Evaluator=nil then
1737 exit;
1738 s:=Evaluator['FPC_FULLVERSION'];
1739 if s<>'' then
1740 exit(StrToIntDef(s,0));
1741 s:=Evaluator['PAS2JS_FULLVERSION'];
1742 if s<>'' then begin
1743 Kind:=pcPas2js;
1744 exit(StrToIntDef(s,0));
1745 end;
1746 end;
1747
TCodeToolManager.GetNamespacesForDirectorynull1748 function TCodeToolManager.GetNamespacesForDirectory(const Directory: string;
1749 UseCache: boolean): string;
1750 var
1751 Evaluator: TExpressionEvaluator;
1752 FPCFullVersion: LongInt;
1753 UnitSet: TFPCUnitSetCache;
1754 begin
1755 if UseCache then begin
1756 Result:=DirectoryCachePool.GetString(Directory,ctdcsNamespaces,true)
1757 end else begin
1758 Result:='';
1759 Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true);
1760 if Evaluator=nil then exit;
1761 if Evaluator.IsDefined('PAS2JS') then
1762 Result:=Evaluator[NamespacesMacroName]
1763 else begin
1764 FPCFullVersion:=StrToIntDef(Evaluator['FPC_FULLVERSION'],0);
1765 if FPCFullVersion>=30101 then
1766 Result:=Evaluator[NamespacesMacroName];
1767 end;
1768 // add default unit scopes from compiler cfg
1769 UnitSet:=GetUnitSetForDirectory(Directory);
1770 if UnitSet<>nil then
1771 Result:=MergeWithDelimiter(Result,UnitSet.GetUnitScopes,';');
1772 end;
1773 end;
1774
1775 procedure TCodeToolManager.FreeListOfPCodeXYPosition(var List: TFPList);
1776 begin
1777 CodeCache.FreeListOfPCodeXYPosition(List);
1778 List:=nil;
1779 end;
1780
1781 procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
1782 begin
1783 CodeCache.FreeTreeOfPCodeXYPosition(Tree);
1784 Tree:=nil;
1785 end;
1786
CreateTreeOfPCodeXYPositionnull1787 function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree;
1788 begin
1789 Result:=CodeCache.CreateTreeOfPCodeXYPosition;
1790 end;
1791
1792 procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
1793 DestTree: TAVLTree; ClearList, CreateCopies: boolean);
1794 begin
1795 CodeCache.AddListToTreeOfPCodeXYPosition(SrcList,DestTree,ClearList,CreateCopies);
1796 end;
1797
Explorenull1798 function TCodeToolManager.Explore(Code: TCodeBuffer;
1799 out ACodeTool: TCodeTool; WithStatements: boolean; OnlyInterface: boolean
1800 ): boolean;
1801 begin
1802 Result:=false;
1803 ACodeTool:=nil;
1804 try
1805 if InitCurCodeTool(Code) then begin
1806 ACodeTool:=FCurCodeTool;
1807 FCurCodeTool.Explore(WithStatements,OnlyInterface);
1808 Result:=true;
1809 end;
1810 except
1811 on e: Exception do Result:=HandleException(e);
1812 end;
1813 end;
1814
InitCurCodeToolnull1815 function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
1816 var MainCode: TCodeBuffer;
1817 begin
1818 Result:=false;
1819 ClearCurCodeTool;
1820 MainCode:=GetMainCode(Code);
1821 if MainCode=nil then begin
1822 ClearError;
1823 FErrorLine:=1;
1824 FErrorColumn:=1;
1825 fErrorCode:=Code;
1826 if Code = nil then
1827 begin
1828 fErrorMsg:='TCodeToolManager.InitCurCodeTool Code=nil'
1829 end
1830 else begin
1831 fErrorMsg:='unit of include file is not known (hint: open and explore unit first)';
1832 end;
1833 exit;
1834 end;
1835 if MainCode.Scanner=nil then begin
1836 FErrorMsg:=Format(ctsNoScannerFound,[MainCode.Filename]);
1837 exit;
1838 end;
1839 FCurCodeTool:=TCodeTool(GetCodeToolForSource(MainCode,false,true));
1840 FCurCodeTool.ErrorPosition.Code:=nil;
1841 {$IFDEF CTDEBUG}
1842 DebugLn('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
1843 {$ENDIF}
1844 Result:=(FCurCodeTool.Scanner<>nil);
1845 if not Result then begin
1846 fErrorCode:=MainCode;
1847 fErrorMsg:=ctsNoScannerAvailable;
1848 end;
1849 end;
1850
TCodeToolManager.InitResourceToolnull1851 function TCodeToolManager.InitResourceTool: boolean;
1852 begin
1853 ClearError;
1854 Result:=true;
1855 end;
1856
1857 procedure TCodeToolManager.ClearPositions;
1858 begin
1859 if Positions=nil then
1860 Positions:=TCodeXYPositions.Create
1861 else
1862 Positions.Clear;
1863 end;
1864
HandleExceptionnull1865 function TCodeToolManager.HandleException(AnException: Exception): boolean;
1866 var
1867 ErrorSrcTool: TCustomCodeTool;
1868 DirtyPos: Integer;
1869 ErrorDirTool: TCompilerDirectivesTree;
1870 begin
1871 ClearError;
1872 fErrorMsg:=AnException.Message;
1873 if (AnException is ELinkScannerError) then begin
1874 // link scanner error
1875 FErrorId:=ELinkScannerError(AnException).Id;
1876 if AnException is ELinkScannerConsistency then
1877 DumpExceptionBackTrace;
1878 DirtyPos:=0;
1879 if AnException is ELinkScannerEditError then begin
1880 fErrorCode:=TCodeBuffer(ELinkScannerEditError(AnException).Buffer);
1881 if fErrorCode<>nil then
1882 DirtyPos:=ELinkScannerEditError(AnException).BufferPos;
1883 end else begin
1884 fErrorCode:=TCodeBuffer(ELinkScannerError(AnException).Sender.Code);
1885 DirtyPos:=ELinkScannerError(AnException).Sender.SrcPos;
1886 end;
1887 if (fErrorCode<>nil) and (DirtyPos>0) then begin
1888 fErrorCode.AbsoluteToLineCol(DirtyPos,fErrorLine,fErrorColumn);
1889 end;
1890 end else if (AnException is ECodeToolError) then begin
1891 // codetool error
1892 ErrorSrcTool:=ECodeToolError(AnException).Sender;
1893 FErrorId:=ECodeToolError(AnException).Id;
1894 if ErrorSrcTool.ErrorNicePosition.Code<>nil then begin
1895 fErrorCode:=ErrorSrcTool.ErrorNicePosition.Code;
1896 fErrorColumn:=ErrorSrcTool.ErrorNicePosition.X;
1897 fErrorLine:=ErrorSrcTool.ErrorNicePosition.Y;
1898 end else begin
1899 fErrorCode:=ErrorSrcTool.ErrorPosition.Code;
1900 fErrorColumn:=ErrorSrcTool.ErrorPosition.X;
1901 fErrorLine:=ErrorSrcTool.ErrorPosition.Y;
1902 end;
1903 end else if (AnException is ECDirectiveParserException) then begin
1904 // Compiler directive parser error
1905 FErrorId:=ECDirectiveParserException(AnException).Id;
1906 ErrorDirTool:=ECDirectiveParserException(AnException).Sender;
1907 fErrorCode:=ErrorDirTool.Code;
1908 end else if (AnException is ESourceChangeCacheError) then begin
1909 // SourceChangeCache error
1910 FErrorId:=ESourceChangeCacheError(AnException).Id;
1911 end else if (AnException is ECodeToolManagerError) then begin
1912 // CodeToolManager error
1913 FErrorId:=ECodeToolManagerError(AnException).Id;
1914 end else begin
1915 // unknown exception
1916 DumpExceptionBackTrace;
1917 FErrorMsg:=AnException.ClassName+': '+FErrorMsg;
1918 if FCurCodeTool<>nil then begin
1919 fErrorCode:=FCurCodeTool.ErrorPosition.Code;
1920 fErrorColumn:=FCurCodeTool.ErrorPosition.X;
1921 fErrorLine:=FCurCodeTool.ErrorPosition.Y;
1922 end;
1923 FErrorId:=20170421202914;
1924 end;
1925
1926 SourceChangeCache.Clear;
1927
1928 // adjust error topline
1929 AdjustErrorTopLine;
1930 // write error
1931 WriteError;
1932 // raise or catch
1933 if not FCatchExceptions then raise AnException;
1934 Result:=false;
1935 end;
1936
1937 procedure TCodeToolManager.AdjustErrorTopLine;
1938 begin
1939 // adjust error topline
1940 if (fErrorCode<>nil) and (fErrorTopLine<1) then begin
1941 fErrorTopLine:=fErrorLine;
1942 if (fErrorTopLine>0) and (JumpSingleLinePos>0) then begin
1943 dec(fErrorTopLine,VisibleEditorLines*JumpSingleLinePos div 100);
1944 if fErrorTopLine<1 then fErrorTopLine:=1;
1945 end;
1946 end;
1947 end;
1948
1949 procedure TCodeToolManager.WriteError;
1950 begin
1951 if FWriteExceptions then begin
1952 FErrorDbgMsg:='### TCodeToolManager.HandleException: ['+IntToStr(FErrorId)+'] "'+ErrorMessage+'"';
1953 if ErrorLine>0 then FErrorDbgMsg+=' at Line='+DbgS(ErrorLine);
1954 if ErrorColumn>0 then FErrorDbgMsg+=' Col='+DbgS(ErrorColumn);
1955 if ErrorCode<>nil then FErrorDbgMsg+=' in "'+ErrorCode.Filename+'"';
1956 Debugln(FErrorDbgMsg);
1957 {$IFDEF CTDEBUG}
1958 WriteDebugReport(true,false,false,false,false,false);
1959 {$ENDIF}
1960 end;
1961 end;
1962
TCodeToolManager.CheckSyntaxnull1963 function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
1964 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
1965 out ErrorMsg: string): boolean;
1966 // returns true on syntax correct
1967 var
1968 ACodeTool: TCodeTool;
1969 begin
1970 Result:=Explore(Code,ACodeTool,true);
1971 if ACodeTool=nil then ;
1972 NewCode:=ErrorCode;
1973 NewX:=ErrorColumn;
1974 NewY:=ErrorLine;
1975 NewTopLine:=ErrorTopLine;
1976 ErrorMsg:=ErrorMessage;
1977 end;
1978
ExploreDirectivesnull1979 function TCodeToolManager.ExploreDirectives(Code: TCodeBuffer; out
1980 ADirectivesTool: TDirectivesTool): boolean;
1981 begin
1982 Result:=false;
1983 ADirectivesTool:=nil;
1984 try
1985 if InitCurDirectivesTool(Code) then begin
1986 ADirectivesTool:=FCurDirectivesTool;
1987 FCurDirectivesTool.Parse;
1988 Result:=true;
1989 end;
1990 except
1991 on e: Exception do Result:=HandleException(e);
1992 end;
1993 end;
1994
ExploreUnitDirectivesnull1995 function TCodeToolManager.ExploreUnitDirectives(Code: TCodeBuffer; out
1996 aScanner: TLinkScanner): boolean;
1997 begin
1998 Result:=false;
1999 if not InitCurCodeTool(Code) then exit;
2000 {$IFDEF CTDEBUG}
2001 DebugLn('TCodeToolManager.ExploreUnitDirectives A ',dbgs(FCurCodeTool.Scanner<>nil));
2002 {$ENDIF}
2003 try
2004 aScanner:=FCurCodeTool.Scanner;
2005 if not aScanner.StoreDirectives then
2006 aScanner.DemandStoreDirectives;
2007 aScanner.Scan(lsrEnd,true);
2008 Result:=true;
2009 except
2010 on e: Exception do Result:=HandleException(e);
2011 end;
2012 {$IFDEF CTDEBUG}
2013 DebugLn('TCodeToolManager.ExploreUnitDirectives END ');
2014 {$ENDIF}
2015 end;
2016
TCodeToolManager.JumpToMethodnull2017 function TCodeToolManager.JumpToMethod(Code: TCodeBuffer; X, Y: integer; out
2018 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
2019 BlockBottomLine: integer; out RevertableJump: boolean): boolean;
2020 var
2021 CursorPos: TCodeXYPosition;
2022 NewPos: TCodeXYPosition;
2023 begin
2024 Result:=false;
2025 {$IFDEF CTDEBUG}
2026 DebugLn('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2027 {$ENDIF}
2028 if not InitCurCodeTool(Code) then exit;
2029 CursorPos.X:=X;
2030 CursorPos.Y:=Y;
2031 CursorPos.Code:=Code;
2032 {$IFDEF CTDEBUG}
2033 DebugLn('TCodeToolManager.JumpToMethod B ',dbgs(FCurCodeTool.Scanner<>nil));
2034 {$ENDIF}
2035 try
2036 Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine,
2037 BlockTopLine,BlockBottomLine,RevertableJump);
2038 if Result then begin
2039 NewX:=NewPos.X;
2040 NewY:=NewPos.Y;
2041 NewCode:=NewPos.Code;
2042 end;
2043 except
2044 on e: Exception do Result:=HandleException(e);
2045 end;
2046 {$IFDEF CTDEBUG}
2047 DebugLn('TCodeToolManager.JumpToMethod END ');
2048 {$ENDIF}
2049 end;
2050
FindProcDeclarationnull2051 function TCodeToolManager.FindProcDeclaration(Code: TCodeBuffer;
2052 CleanDef: string; out Tool: TCodeTool; out Node: TCodeTreeNode;
2053 Attr: TProcHeadAttributes): boolean;
2054 var
2055 Paths: TStringList;
2056 begin
2057 Result:=false;
2058 {$IFDEF CTDEBUG}
2059 DebugLn(['TCodeToolManager.FindProcDeclaration A ',Code.Filename,' CleanDef=',CleanDef]);
2060 {$ENDIF}
2061 Tool:=nil;
2062 Node:=nil;
2063 if not InitCurCodeTool(Code) then exit;
2064 Tool:=FCurCodeTool;
2065 Paths:=TStringList.Create;
2066 try
2067 Paths.Add(CleanDef);
2068 try
2069 FCurCodeTool.BuildTree(lsrInitializationStart);
2070 Node:=FCurCodeTool.FindSubProcPath(Paths,Attr,false);
2071 Result:=Node<>nil;
2072 except
2073 on e: Exception do Result:=HandleException(e);
2074 end;
2075 finally
2076 Paths.Free;
2077 end;
2078 {$IFDEF CTDEBUG}
2079 DebugLn('TCodeToolManager.FindProcDeclaration END ');
2080 {$ENDIF}
2081 end;
2082
FindDeclarationnull2083 function TCodeToolManager.FindDeclaration(Code: TCodeBuffer; X, Y: integer; out
2084 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
2085 BlockBottomLine: integer; Flags: TFindSmartFlags): boolean;
2086 var
2087 CursorPos: TCodeXYPosition;
2088 NewPos: TCodeXYPosition;
2089 NewTool: TFindDeclarationTool;
2090 NewNode: TCodeTreeNode;
2091 begin
2092 Result:=false;
2093 {$IFDEF CTDEBUG}
2094 DebugLn(['TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y]);
2095 {$ENDIF}
2096 if not InitCurCodeTool(Code) then begin
2097 {$IFDEF VerboseFindDeclarationFail}
2098 debugln(['TCodeToolManager.FindDeclaration InitCurCodeTool failed']);
2099 {$ENDIF}
2100 exit;
2101 end;
2102 CursorPos.X:=X;
2103 CursorPos.Y:=Y;
2104 CursorPos.Code:=Code;
2105 {$IFDEF CTDEBUG}
2106 DebugLn('TCodeToolManager.FindDeclaration B ',dbgs(FCurCodeTool.Scanner<>nil));
2107 {$ENDIF}
2108 try
2109 {$IFDEF DoNotHandleFindDeclException}
2110 DebugLn('TCodeToolManager.FindDeclaration NOT HANDLING EXCEPTIONS');
2111 RaiseUnhandableExceptions:=true;
2112 {$ENDIF}
2113 Result:=FCurCodeTool.FindDeclaration(CursorPos,Flags,NewTool,NewNode,
2114 NewPos,NewTopLine,BlockTopLine,BlockBottomLine);
2115 if Result then begin
2116 NewX:=NewPos.X;
2117 NewY:=NewPos.Y;
2118 NewCode:=NewPos.Code;
2119 if (NewTool=nil) and (NewNode<>nil) then ;
2120 {$IFDEF CTDEBUG}
2121 debugln(['TCodeToolManager.FindDeclaration ',Dbgs(NewPos)]);
2122 {$ENDIF}
2123 end;
2124 {$IFDEF DoNotHandleFindDeclException}
2125 finally
2126 RaiseUnhandableExceptions:=false;
2127 end;
2128 {$ELSE}
2129 except
2130 on e: Exception do begin
2131 Result:=HandleException(e);
2132 {$IFDEF VerboseFindDeclarationFail}
2133 if not Result then
2134 debugln(['TCodeToolManager.FindDeclaration Exception=',e.Message]);
2135 {$ENDIF}
2136 end;
2137 end;
2138 {$ENDIF}
2139 {$IFDEF VerboseFindDeclarationFail}
2140 if not Result then begin
2141 debugln(['TCodeToolManager.FindDeclaration FAILED at ',dbgs(CursorPos)]);
2142 end;
2143 {$ENDIF}
2144 {$IFDEF CTDEBUG}
2145 DebugLn('TCodeToolManager.FindDeclaration END ');
2146 {$ENDIF}
2147 end;
2148
FindDeclarationOfIdentifiernull2149 function TCodeToolManager.FindDeclarationOfIdentifier(Code: TCodeBuffer;
2150 X,Y: integer; Identifier: PChar; out NewCode: TCodeBuffer; out NewX, NewY,
2151 NewTopLine: integer): boolean;
2152 var
2153 CursorPos: TCodeXYPosition;
2154 NewPos: TCodeXYPosition;
2155 begin
2156 Result:=false;
2157 {$IFDEF CTDEBUG}
2158 DebugLn(['TCodeToolManager.FindDeclarationOfIdentifier A ',Code.Filename,' x=',x,' y=',y,' Identifier=',GetIdentifier(Identifier)]);
2159 {$ENDIF}
2160 if not InitCurCodeTool(Code) then exit;
2161 CursorPos.X:=X;
2162 CursorPos.Y:=Y;
2163 CursorPos.Code:=Code;
2164 {$IFDEF CTDEBUG}
2165 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier B ',dbgs(FCurCodeTool.Scanner<>nil));
2166 {$ENDIF}
2167 try
2168 {$IFDEF DoNotHandleFindDeclException}
2169 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier NOT HANDLING EXCEPTIONS');
2170 RaiseUnhandableExceptions:=true;
2171 {$ENDIF}
2172 Result:=FCurCodeTool.FindDeclarationOfIdentifier(CursorPos,Identifier,NewPos,NewTopLine);
2173 if Result then begin
2174 NewX:=NewPos.X;
2175 NewY:=NewPos.Y;
2176 NewCode:=NewPos.Code;
2177 end;
2178 {$IFDEF DoNotHandleFindDeclException}
2179 finally
2180 RaiseUnhandableExceptions:=false;
2181 end;
2182 {$ELSE}
2183 except
2184 on e: Exception do Result:=HandleException(e);
2185 end;
2186 {$ENDIF}
2187 {$IFDEF CTDEBUG}
2188 DebugLn('TCodeToolManager.FindDeclarationOfIdentifier END ');
2189 {$ENDIF}
2190 end;
2191
FindSmartHintnull2192 function TCodeToolManager.FindSmartHint(Code: TCodeBuffer; X, Y: integer;
2193 Flags: TFindSmartFlags): string;
2194 var
2195 CursorPos: TCodeXYPosition;
2196 begin
2197 Result:='';
2198 {$IFDEF CTDEBUG}
2199 DebugLn('TCodeToolManager.FindSmartHint A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2200 {$ENDIF}
2201 if not InitCurCodeTool(Code) then exit;
2202 CursorPos.X:=X;
2203 CursorPos.Y:=Y;
2204 CursorPos.Code:=Code;
2205 {$IFDEF CTDEBUG}
2206 DebugLn('TCodeToolManager.FindSmartHint B ',dbgs(FCurCodeTool.Scanner<>nil));
2207 {$ENDIF}
2208 try
2209 Result:=FCurCodeTool.FindSmartHint(CursorPos,Flags);
2210 except
2211 on e: Exception do HandleException(e);
2212 end;
2213 {$IFDEF CTDEBUG}
2214 DebugLn('TCodeToolManager.FindSmartHint END ');
2215 {$ENDIF}
2216 end;
2217
FindDeclarationInInterfacenull2218 function TCodeToolManager.FindDeclarationInInterface(Code: TCodeBuffer;
2219 const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY,
2220 NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
2221 var
2222 NewPos: TCodeXYPosition;
2223 begin
2224 Result:=false;
2225 {$IFDEF CTDEBUG}
2226 DebugLn('TCodeToolManager.FindDeclarationInInterface A ',Code.Filename,' Identifier=',Identifier);
2227 {$ENDIF}
2228 if not InitCurCodeTool(Code) then exit;
2229 {$IFDEF CTDEBUG}
2230 DebugLn('TCodeToolManager.FindDeclarationInInterface B ',dbgs(FCurCodeTool.Scanner<>nil));
2231 {$ENDIF}
2232 try
2233 Result:=FCurCodeTool.FindDeclarationInInterface(Identifier,NewPos,
2234 NewTopLine,BlockTopLine,BlockBottomLine);
2235 if Result then begin
2236 NewX:=NewPos.X;
2237 NewY:=NewPos.Y;
2238 NewCode:=NewPos.Code;
2239 end;
2240 except
2241 on e: Exception do HandleException(e);
2242 end;
2243 {$IFDEF CTDEBUG}
2244 DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
2245 {$ENDIF}
2246 end;
2247
FindDeclarationInInterfacenull2248 function TCodeToolManager.FindDeclarationInInterface(Code: TCodeBuffer;
2249 const Identifier: string; out NewCode: TCodeBuffer; out NewX, NewY,
2250 NewTopLine: integer): boolean;
2251 var
2252 BlockTopLine, BlockBottomLine: integer;
2253 begin
2254 Result := FindDeclarationInInterface(Code, Identifier, NewCode, NewX, NewY, NewTopLine,
2255 BlockTopLine, BlockBottomLine);
2256 end;
2257
TCodeToolManager.FindDeclarationWithMainUsesSectionnull2258 function TCodeToolManager.FindDeclarationWithMainUsesSection(Code: TCodeBuffer;
2259 const Identifier: string; out NewCode: TCodeBuffer;
2260 out NewX, NewY, NewTopLine: integer): Boolean;
2261 var
2262 NewPos: TCodeXYPosition;
2263 begin
2264 Result:=false;
2265 {$IFDEF CTDEBUG}
2266 DebugLn('TCodeToolManager.FindDeclarationWithMainUsesSection A ',Code.Filename,' Identifier=',Identifier);
2267 {$ENDIF}
2268 if not InitCurCodeTool(Code) then exit;
2269 try
2270 Result:=FCurCodeTool.FindDeclarationWithMainUsesSection(Identifier,NewPos,
2271 NewTopLine);
2272 if Result then begin
2273 NewX:=NewPos.X;
2274 NewY:=NewPos.Y;
2275 NewCode:=NewPos.Code;
2276 end;
2277 except
2278 on e: Exception do HandleException(e);
2279 end;
2280 {$IFDEF CTDEBUG}
2281 DebugLn('TCodeToolManager.FindDeclarationInInterface END ');
2282 {$ENDIF}
2283 end;
2284
FindDeclarationAndOverloadnull2285 function TCodeToolManager.FindDeclarationAndOverload(Code: TCodeBuffer; X,
2286 Y: integer; out ListOfPCodeXYPosition: TFPList;
2287 Flags: TFindDeclarationListFlags): boolean;
2288 var
2289 CursorPos: TCodeXYPosition;
2290 begin
2291 Result:=false;
2292 {$IFDEF CTDEBUG}
2293 DebugLn('TCodeToolManager.FindDeclarationAndOverload A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2294 {$ENDIF}
2295 ListOfPCodeXYPosition:=nil;
2296 if not InitCurCodeTool(Code) then exit;
2297 CursorPos.X:=X;
2298 CursorPos.Y:=Y;
2299 CursorPos.Code:=Code;
2300 {$IFDEF CTDEBUG}
2301 DebugLn('TCodeToolManager.FindDeclarationAndOverload B ',dbgs(FCurCodeTool.Scanner<>nil));
2302 {$ENDIF}
2303 try
2304 Result:=FCurCodeTool.FindDeclarationAndOverload(CursorPos,
2305 ListOfPCodeXYPosition,Flags);
2306 except
2307 on e: Exception do Result:=HandleException(e);
2308 end;
2309 {$IFDEF CTDEBUG}
2310 DebugLn('TCodeToolManager.FindDeclarationAndOverload END ');
2311 {$ENDIF}
2312 end;
2313
TCodeToolManager.FindMainDeclarationnull2314 function TCodeToolManager.FindMainDeclaration(Code: TCodeBuffer; X, Y: integer;
2315 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
2316 var
2317 CursorPos: TCodeXYPosition;
2318 NewPos: TCodeXYPosition;
2319 begin
2320 Result:=false;
2321 {$IFDEF CTDEBUG}
2322 DebugLn('TCodeToolManager.FindMainDeclaration A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2323 {$ENDIF}
2324 if not InitCurCodeTool(Code) then exit;
2325 CursorPos.X:=X;
2326 CursorPos.Y:=Y;
2327 CursorPos.Code:=Code;
2328 try
2329 Result:=FCurCodeTool.FindMainDeclaration(CursorPos,NewPos,NewTopLine);
2330 if Result then begin
2331 NewX:=NewPos.X;
2332 NewY:=NewPos.Y;
2333 NewCode:=NewPos.Code;
2334 end;
2335 except
2336 on e: Exception do Result:=HandleException(e);
2337 end;
2338 {$IFDEF CTDEBUG}
2339 DebugLn('TCodeToolManager.FindMainDeclaration END ');
2340 {$ENDIF}
2341 end;
2342
FindDeclarationOfPropertyPathnull2343 function TCodeToolManager.FindDeclarationOfPropertyPath(Code: TCodeBuffer;
2344 const PropertyPath: string; out NewCode: TCodeBuffer; out NewX, NewY,
2345 NewTopLine: integer): Boolean;
2346 var
2347 NewPos: TCodeXYPosition;
2348 begin
2349 Result:=false;
2350 {$IFDEF CTDEBUG}
2351 DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath A ',Code.Filename,' Path="',PropertyPath,'"');
2352 {$ENDIF}
2353 if not InitCurCodeTool(Code) then exit;
2354 try
2355 Result:=FCurCodeTool.FindDeclarationOfPropertyPath(PropertyPath,
2356 NewPos,NewTopLine);
2357 if Result then begin
2358 NewX:=NewPos.X;
2359 NewY:=NewPos.Y;
2360 NewCode:=NewPos.Code;
2361 end;
2362 except
2363 on e: Exception do Result:=HandleException(e);
2364 end;
2365 {$IFDEF CTDEBUG}
2366 DebugLn('TCodeToolManager.FindDeclarationOfPropertyPath END ');
2367 {$ENDIF}
2368 end;
2369
TCodeToolManager.FindFileAtCursornull2370 function TCodeToolManager.FindFileAtCursor(Code: TCodeBuffer; X, Y: integer;
2371 out Found: TFindFileAtCursorFlag; out FoundFilename: string;
2372 Allowed: TFindFileAtCursorFlags; StartPos: PCodeXYPosition): boolean;
2373 var
2374 CursorPos: TCodeXYPosition;
2375 begin
2376 Result:=false;
2377 {$IFDEF CTDEBUG}
2378 DebugLn('TCodeToolManager.FindFileAtCursor A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2379 {$ENDIF}
2380 if not InitCurCodeTool(Code) then exit;
2381 CursorPos.X:=X;
2382 CursorPos.Y:=Y;
2383 CursorPos.Code:=Code;
2384 try
2385 Result:=FCurCodeTool.FindFileAtCursor(CursorPos,Found,FoundFilename,
2386 Allowed,StartPos);
2387 except
2388 on e: Exception do HandleException(e);
2389 end;
2390 {$IFDEF CTDEBUG}
2391 DebugLn('TCodeToolManager.FindFileAtCursor END ');
2392 {$ENDIF}
2393 end;
2394
FindCodeContextnull2395 function TCodeToolManager.FindCodeContext(Code: TCodeBuffer; X, Y: integer; out
2396 CodeContexts: TCodeContextInfo): boolean;
2397 var
2398 CursorPos: TCodeXYPosition;
2399 begin
2400 Result:=false;
2401 CodeContexts:=nil;
2402 {$IFDEF CTDEBUG}
2403 DebugLn('TCodeToolManager.FindCodeContext A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2404 {$ENDIF}
2405 if not InitCurCodeTool(Code) then exit;
2406 CursorPos.X:=X;
2407 CursorPos.Y:=Y;
2408 CursorPos.Code:=Code;
2409 try
2410 Result:=FCurCodeTool.FindCodeContext(CursorPos,CodeContexts);
2411 except
2412 on e: Exception do HandleException(e);
2413 end;
2414 {$IFDEF CTDEBUG}
2415 DebugLn('TCodeToolManager.FindCodeContext END ');
2416 {$ENDIF}
2417 end;
2418
TCodeToolManager.ExtractProcedureHeadernull2419 function TCodeToolManager.ExtractProcedureHeader(Code: TCodeBuffer; X,
2420 Y: integer; Attributes: TProcHeadAttributes; out ProcHead: string): boolean;
2421 var
2422 CursorPos: TCodeXYPosition;
2423 begin
2424 Result:=false;
2425 {$IFDEF CTDEBUG}
2426 DebugLn('TCodeToolManager.ExtractProcedureHeader A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2427 {$ENDIF}
2428 if not InitCurCodeTool(Code) then exit;
2429 CursorPos.X:=X;
2430 CursorPos.Y:=Y;
2431 CursorPos.Code:=Code;
2432 try
2433 Result:=FCurCodeTool.ExtractProcedureHeader(CursorPos,Attributes,ProcHead);
2434 except
2435 on e: Exception do HandleException(e);
2436 end;
2437 {$IFDEF CTDEBUG}
2438 DebugLn('TCodeToolManager.ExtractProcedureHeader END ');
2439 {$ENDIF}
2440 end;
2441
HasInterfaceRegisterProcnull2442 function TCodeToolManager.HasInterfaceRegisterProc(Code: TCodeBuffer): boolean;
2443 begin
2444 Result:=false;
2445 {$IFDEF CTDEBUG}
2446 DebugLn('TCodeToolManager.HasInterfaceRegisterProc A ',Code.Filename);
2447 {$ENDIF}
2448 if not InitCurCodeTool(Code) then exit;
2449 try
2450 Result:=FCurCodeTool.HasInterfaceRegisterProc;
2451 except
2452 on e: Exception do Result:=HandleException(e);
2453 end;
2454 end;
2455
GatherUnitNamesnull2456 function TCodeToolManager.GatherUnitNames(Code: TCodeBuffer): Boolean;
2457 var
2458 CursorPos: TCodeXYPosition;
2459 begin
2460 Result := False;
2461 if not InitCurCodeTool(Code) then exit;
2462 if IdentifierList<>nil then IdentifierList.Clear;
2463 CursorPos.X := 0;
2464 CursorPos.Y := 0;
2465 CursorPos.Code := Code;
2466 try
2467 Result := FCurCodeTool.GatherAvailableUnitNames(CursorPos, IdentifierList);
2468 except
2469 on e: Exception do HandleException(e);
2470 end;
2471 end;
2472
GetApplicationScaledStatementnull2473 function TCodeToolManager.GetApplicationScaledStatement(Code: TCodeBuffer;
2474 var AScaled: Boolean): boolean;
2475 var
2476 StartPos, BooleanConstStartPos, EndPos: integer;
2477 begin
2478 Result:=false;
2479 {$IFDEF CTDEBUG}
2480 DebugLn('TCodeToolManager.GetApplicationScaledStatement A ',Code.Filename);
2481 {$ENDIF}
2482 if not InitCurCodeTool(Code) then exit;
2483 try
2484 Result:=FCurCodeTool.FindApplicationScaledStatement(StartPos,
2485 BooleanConstStartPos,EndPos);
2486
2487 Result:=FCurCodeTool.GetApplicationScaledStatement(BooleanConstStartPos,
2488 EndPos,AScaled);
2489 except
2490 on e: Exception do Result:=HandleException(e);
2491 end;
2492 end;
2493
GatherIdentifiersnull2494 function TCodeToolManager.GatherIdentifiers(Code: TCodeBuffer; X, Y: integer
2495 ): boolean;
2496 var
2497 CursorPos: TCodeXYPosition;
2498 begin
2499 Result:=false;
2500 {$IFDEF CTDEBUG}
2501 DebugLn('TCodeToolManager.GatherIdentifiers A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2502 {$ENDIF}
2503 if not InitCurCodeTool(Code) then exit;
2504 if IdentifierList<>nil then IdentifierList.Clear;
2505 CursorPos.X:=X;
2506 CursorPos.Y:=Y;
2507 CursorPos.Code:=Code;
2508 {$IFDEF CTDEBUG}
2509 DebugLn('TCodeToolManager.GatherIdentifiers B ',dbgs(FCurCodeTool.Scanner<>nil));
2510 {$ENDIF}
2511 try
2512 FIdentifierListUpdating:=true;
2513 try
2514 Result:=FCurCodeTool.GatherIdentifiers(CursorPos,IdentifierList);
2515 finally
2516 FIdentifierListUpdating:=false;
2517 end;
2518 except
2519 on e: Exception do HandleException(e);
2520 end;
2521 {$IFDEF CTDEBUG}
2522 DebugLn('TCodeToolManager.GatherIdentifiers END ');
2523 {$ENDIF}
2524 end;
2525
TCodeToolManager.GetIdentifierAtnull2526 function TCodeToolManager.GetIdentifierAt(Code: TCodeBuffer; X, Y: integer; out
2527 Identifier: string): boolean;
2528 var
2529 CleanPos: integer;
2530 begin
2531 Result:=false;
2532 {$IFDEF CTDEBUG}
2533 DebugLn('TCodeToolManager.GetIdentifierAt A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2534 {$ENDIF}
2535 Code.LineColToPosition(Y,X,CleanPos);
2536 if (CleanPos>0) and (CleanPos<=Code.SourceLength) then begin
2537 Identifier:=GetIdentifier(@Code.Source[CleanPos]);
2538 Result:=true;
2539 end else begin
2540 Identifier:='';
2541 Result:=false;
2542 end;
2543 end;
2544
IdentItemCheckHasChildsnull2545 function TCodeToolManager.IdentItemCheckHasChilds(IdentItem: TIdentifierListItem
2546 ): boolean;
2547 begin
2548 Result:=false;
2549 {$IFDEF CTDEBUG}
2550 DebugLn('TCodeToolManager.IdentItemCheckHasChilds A ');
2551 {$ENDIF}
2552 try
2553 IdentItem.CheckHasChilds;
2554 Result:=true;
2555 except
2556 on e: Exception do HandleException(e);
2557 end;
2558 end;
2559
FindAbstractMethodsnull2560 function TCodeToolManager.FindAbstractMethods(Code: TCodeBuffer; X, Y: integer;
2561 out ListOfPCodeXYPosition: TFPList; SkipAbstractsInStartClass: boolean): boolean;
2562 var
2563 CursorPos: TCodeXYPosition;
2564 begin
2565 {$IFDEF CTDEBUG}
2566 DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
2567 {$ENDIF}
2568 Result:=false;
2569 ListOfPCodeXYPosition:=nil;
2570 if not InitCurCodeTool(Code) then exit;
2571 CursorPos.X:=X;
2572 CursorPos.Y:=Y;
2573 CursorPos.Code:=Code;
2574 try
2575 Result:=FCurCodeTool.FindAbstractMethods(CursorPos,ListOfPCodeXYPosition,
2576 SkipAbstractsInStartClass);
2577 except
2578 on e: Exception do Result:=HandleException(e);
2579 end;
2580 end;
2581
TCodeToolManager.GetValuesOfCaseVariablenull2582 function TCodeToolManager.GetValuesOfCaseVariable(Code: TCodeBuffer; X,
2583 Y: integer; List: TStrings; WithTypeDefIfScoped: boolean): boolean;
2584 var
2585 CursorPos: TCodeXYPosition;
2586 begin
2587 {$IFDEF CTDEBUG}
2588 DebugLn('TCodeToolManager.GetValuesOfCaseVariable A ',Code.Filename);
2589 {$ENDIF}
2590 Result:=false;
2591 if not InitCurCodeTool(Code) then exit;
2592 CursorPos.X:=X;
2593 CursorPos.Y:=Y;
2594 CursorPos.Code:=Code;
2595 try
2596 Result:=FCurCodeTool.GetValuesOfCaseVariable(CursorPos,List,WithTypeDefIfScoped);
2597 except
2598 on e: Exception do Result:=HandleException(e);
2599 end;
2600 end;
2601
GatherOverloadsnull2602 function TCodeToolManager.GatherOverloads(Code: TCodeBuffer; X, Y: integer; out
2603 Graph: TDeclarationOverloadsGraph): boolean;
2604 var
2605 NewCode: TCodeBuffer;
2606 NewX, NewY, NewTopLine: integer;
2607 begin
2608 {$IFDEF CTDEBUG}
2609 DebugLn('TCodeToolManager.GatherOverloads A ',Code.Filename);
2610 {$ENDIF}
2611 Result:=false;
2612 Graph:=nil;
2613 if not FindMainDeclaration(Code,X,Y,NewCode,NewX,NewY,NewTopLine)
2614 then begin
2615 DebugLn('TCodeToolManager.GatherOverloads unable to FindMainDeclaration ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
2616 exit;
2617 end;
2618 if NewTopLine=0 then ;
2619 if not InitCurCodeTool(Code) then exit;
2620 try
2621 Graph:=TDeclarationOverloadsGraph.Create;
2622 Graph.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
2623 Result:=Graph.Init(NewCode,NewX,NewY);
2624 except
2625 on e: Exception do Result:=HandleException(e);
2626 end;
2627 end;
2628
TCodeToolManager.FindReferencesnull2629 function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X,
2630 Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
2631 var ListOfPCodeXYPosition: TFPList; var Cache: TFindIdentifierReferenceCache
2632 ): boolean;
2633 var
2634 CursorPos: TCodeXYPosition;
2635 NewTopLine: integer;
2636 ImplementationNode: TCodeTreeNode;
2637 begin
2638 Result:=false;
2639 {$IFDEF CTDEBUG}
2640 if Cache=nil then
2641 DebugLn('TCodeToolManager.FindReferences A ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y),' SearchInCode=',SearchInCode.Filename)
2642 else
2643 debugln(['TCodeToolManager.FindReferences A SearchInCode=',SearchInCode.Filename]);
2644 {$ENDIF}
2645 ListOfPCodeXYPosition:=nil;
2646 if Cache=nil then
2647 Cache:=TFindIdentifierReferenceCache.Create;
2648 if (Cache.SourcesChangeStep=SourceCache.ChangeStamp)
2649 and (Cache.SourcesChangeStep<>CTInvalidChangeStamp64)
2650 and (Cache.FilesChangeStep=FileStateCache.TimeStamp)
2651 and (Cache.FilesChangeStep<>CTInvalidChangeStamp64)
2652 and (Cache.InitValuesChangeStep=DefineTree.ChangeStep)
2653 and (Cache.InitValuesChangeStep<>CTInvalidChangeStamp)
2654 and (Cache.IdentifierCode=IdentifierCode) and (Cache.X=X) and (Cache.Y=Y)
2655 then begin
2656 //debugln(['TCodeToolManager.FindReferences cache valid']);
2657 // all sources and values are the same => use cache
2658 Result:=true;
2659 end else begin
2660 //debugln(['TCodeToolManager.FindReferences cache not valid']);
2661 //debugln(['TCodeToolManager.FindReferences IdentifierCode=',Cache.IdentifierCode=IdentifierCode,
2662 // ' X=',Cache.X=X,' Y=',Cache.Y=Y,
2663 // ' SourcesChangeStep=',Cache.SourcesChangeStep=SourceCache.ChangeStamp,',',Cache.SourcesChangeStep=CTInvalidChangeStamp64,
2664 // ' FilesChangeStep=',Cache.FilesChangeStep=FileStateCache.TimeStamp,',',Cache.FilesChangeStep=CTInvalidChangeStamp64,
2665 // ' InitValuesChangeStep=',Cache.InitValuesChangeStep=DefineTree.ChangeStep,',',Cache.InitValuesChangeStep=CTInvalidChangeStamp,
2666 // '']);
2667 Cache.Clear;
2668 Cache.IdentifierCode:=IdentifierCode;
2669 Cache.X:=X;
2670 Cache.Y:=Y;
2671 Cache.SourcesChangeStep:=SourceCache.ChangeStamp;
2672 Cache.FilesChangeStep:=FileStateCache.TimeStamp;
2673 Cache.InitValuesChangeStep:=DefineTree.ChangeStep;
2674
2675 if not InitCurCodeTool(IdentifierCode) then exit;
2676 CursorPos.X:=X;
2677 CursorPos.Y:=Y;
2678 CursorPos.Code:=IdentifierCode;
2679 try
2680 Result:=FCurCodeTool.FindDeclaration(CursorPos,[fsfFindMainDeclaration,fsfSearchSourceName],
2681 Cache.NewTool,Cache.NewNode,Cache.NewPos,NewTopLine);
2682 except
2683 on e: Exception do HandleException(e);
2684 end;
2685 if not Result then begin
2686 debugln(['TCodeToolManager.FindReferences FCurCodeTool.FindDeclaration failed']);
2687 exit;
2688 end;
2689 // check if scope can be limited
2690 if Cache.NewTool<>nil then begin
2691 Cache.IsPrivate:=(Cache.NewTool.GetSourceType in [ctnLibrary,ctnProgram]);
2692 if not Cache.IsPrivate then begin
2693 ImplementationNode:=Cache.NewTool.FindImplementationNode;
2694 if (ImplementationNode<>nil)
2695 and (Cache.NewNode.StartPos>=ImplementationNode.StartPos) then
2696 Cache.IsPrivate:=true;
2697 end;
2698 if not Cache.IsPrivate then begin
2699 if (Cache.NewNode.GetNodeOfTypes([ctnParameterList,ctnClassPrivate])<>nil) then
2700 Cache.IsPrivate:=true;
2701 end;
2702 end;
2703 end;
2704 if (not Result) or (Cache.NewNode=nil) then begin
2705 DebugLn('TCodeToolManager.FindReferences unable to FindDeclaration ',IdentifierCode.Filename,' x=',dbgs(x),' y=',dbgs(y));
2706 exit;
2707 end;
2708 Result:=true;
2709 if NewTopLine=0 then ;
2710 if not InitCurCodeTool(SearchInCode) then exit;
2711 if Cache.IsPrivate and (FCurCodeTool<>Cache.NewTool) then begin
2712 {$IFDEF VerboseFindReferences}
2713 debugln(['TCodeToolManager.FindReferences identifier is not reachable from this unit => skipping search']);
2714 {$ENDIF}
2715 exit(true);
2716 end;
2717
2718 CursorPos:=Cache.NewPos;
2719 {$IF defined(CTDEBUG) or defined(VerboseFindReferences)}
2720 DebugLn('TCodeToolManager.FindReferences Searching ',dbgs(FCurCodeTool.Scanner<>nil),' for reference to x=',dbgs(CursorPos.X),' y=',dbgs(CursorPos.Y),' ',CursorPos.Code.Filename);
2721 {$ENDIF}
2722 try
2723 Result:=FCurCodeTool.FindReferences(CursorPos,SkipComments,
2724 ListOfPCodeXYPosition);
2725 except
2726 on e: Exception do HandleException(e);
2727 end;
2728 {$IFDEF CTDEBUG}
2729 DebugLn(['TCodeToolManager.FindReferences END ',Result]);
2730 {$ENDIF}
2731 end;
2732
FindUnitReferencesnull2733 function TCodeToolManager.FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
2734 SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
2735 // finds unit name of UnitCode in unit of TargetCode
2736 begin
2737 Result:=false;
2738 {$IFDEF CTDEBUG}
2739 DebugLn('TCodeToolManager.FindUnitReferences A ',UnitCode.Filename,' Target=',TargetCode.Filename);
2740 {$ENDIF}
2741 ListOfPCodeXYPosition:=nil;
2742 if not InitCurCodeTool(TargetCode) then exit;
2743 try
2744 Result:=FCurCodeTool.FindUnitReferences(UnitCode,SkipComments,
2745 ListOfPCodeXYPosition);
2746 except
2747 on e: Exception do HandleException(e);
2748 end;
2749 {$IFDEF CTDEBUG}
2750 DebugLn('TCodeToolManager.FindUnitReferences END ');
2751 {$ENDIF}
2752 end;
2753
FindUsedUnitReferencesnull2754 function TCodeToolManager.FindUsedUnitReferences(Code: TCodeBuffer; X,
2755 Y: integer; SkipComments: boolean; out UsedUnitFilename: string;
2756 var ListOfPCodeXYPosition: TFPList): boolean;
2757 // finds in unit of Code all references of the unit at the uses clause at X,Y
2758 var
2759 CursorPos: TCodeXYPosition;
2760 begin
2761 Result:=false;
2762 {$IFDEF CTDEBUG}
2763 DebugLn('TCodeToolManager.FindUsedUnitReferences A ',Code.Filename,' X=',X,' Y=',Y,' SkipComments=',SkipComments);
2764 {$ENDIF}
2765 ListOfPCodeXYPosition:=nil;
2766 if not InitCurCodeTool(Code) then exit;
2767 CursorPos.X:=X;
2768 CursorPos.Y:=Y;
2769 CursorPos.Code:=Code;
2770 try
2771 FCurCodeTool.FindUsedUnitReferences(CursorPos,SkipComments,UsedUnitFilename,
2772 ListOfPCodeXYPosition);
2773 Result:=true;
2774 except
2775 on e: Exception do HandleException(e);
2776 end;
2777 {$IFDEF CTDEBUG}
2778 DebugLn('TCodeToolManager.FindUnitReferences END ');
2779 {$ENDIF}
2780 end;
2781
TCodeToolManager.FindReferencesInFilesnull2782 function TCodeToolManager.FindReferencesInFiles(Files: TStringList;
2783 DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
2784 SearchInComments: boolean; var TreeOfPCodeXYPosition: TAVLTree): boolean;
2785 var
2786 i, j: Integer;
2787 Code: TCodeBuffer;
2788 ListOfPCodeXYPosition: TFPList;
2789 Cache: TFindIdentifierReferenceCache;
2790 Filename: String;
2791 begin
2792 Result:=false;
2793 ListOfPCodeXYPosition:=nil;
2794 TreeOfPCodeXYPosition:=nil;
2795 Cache:=nil;
2796 try
2797 // search in every file
2798 for i:=0 to Files.Count-1 do begin
2799 Filename:=Files[i];
2800 if ExtractFileNameOnly(Filename)='' then
2801 continue; // invalid filename
2802 //debugln(['TCodeToolManager.FindReferencesInFiles ',Filename]);
2803 j:=i-1;
2804 while (j>=0) and (CompareFilenames(Filename,Files[j])<>0) do dec(j);
2805 if j>=0 then continue; // skip duplicate
2806
2807 Code:=LoadFile(Filename,true,false);
2808 if Code=nil then begin
2809 debugln('TCodeToolManager.FindReferencesInFiles unable to load "',Filename,'"');
2810 exit;
2811 end;
2812
2813 // search references
2814 FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
2815 if not FindReferences(
2816 DeclarationCode,DeclarationCaretXY.X,DeclarationCaretXY.Y,
2817 Code, not SearchInComments, ListOfPCodeXYPosition, Cache) then
2818 begin
2819 debugln('TCodeToolManager.FindReferencesInFiles unable to FindReferences in "',Code.Filename,'"');
2820 exit;
2821 end;
2822 //debugln('TCodeToolManager.FindReferencesInFiles FindReferences in "',Code.Filename,'" ',dbgs(ListOfPCodeXYPosition<>nil));
2823
2824 // add to tree
2825 if ListOfPCodeXYPosition<>nil then begin
2826 if TreeOfPCodeXYPosition=nil then
2827 TreeOfPCodeXYPosition:=CreateTreeOfPCodeXYPosition;
2828 AddListToTreeOfPCodeXYPosition(ListOfPCodeXYPosition,
2829 TreeOfPCodeXYPosition,true,false);
2830 end;
2831 end;
2832
2833 Result:=true;
2834 finally
2835 CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
2836 if not Result then
2837 CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
2838 Cache.Free;
2839 end;
2840 end;
2841
RenameIdentifiernull2842 function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
2843 const OldIdentifier, NewIdentifier: string; DeclarationCode: TCodeBuffer;
2844 DeclarationCaretXY: PPoint): boolean;
2845 var
2846 ANode, ANode2: TAVLTreeNode;
2847 CurCodePos, LastCodePos: PCodeXYPosition;
2848 IdentStartPos: integer;
2849 IdentLen, IdentLenDiff: Integer;
2850 SameLineCount: Integer;
2851 i: Integer;
2852 Code: TCodeBuffer;
2853 begin
2854 Result:=false;
2855 {$IFDEF CTDEBUG}
2856 DebugLn('TCodeToolManager.RenameIdentifier A Old=',OldIdentifier,' New=',NewIdentifier,' ',dbgs(TreeOfPCodeXYPosition<>nil));
2857 {$ENDIF}
2858 if TreeOfPCodeXYPosition=nil then begin
2859 Result:=true;
2860 exit;
2861 end;
2862 if not LazIsValidIdent(NewIdentifier,True,True) then exit;
2863
2864 ClearCurCodeTool;
2865 SourceChangeCache.Clear;
2866 CurCodePos := nil;
2867 LastCodePos := nil;
2868 SameLineCount := 0;
2869 IdentLen:=length(OldIdentifier);
2870 IdentLenDiff := length(NewIdentifier) - IdentLen;
2871 if DeclarationCode = nil then
2872 DeclarationCaretXY := nil;;
2873 if DeclarationCaretXY = nil then
2874 DeclarationCode := nil;;
2875
2876 // the tree is sorted for descending line code positions
2877 // -> go from end of source to start of source, so that replacing does not
2878 // change any CodeXYPosition not yet processed
2879 ANode:=TreeOfPCodeXYPosition.FindLowest;
2880 while ANode<>nil do begin
2881 // next position
2882 CurCodePos:=PCodeXYPosition(ANode.Data);
2883 Code:=CurCodePos^.Code;
2884 Code.LineColToPosition(CurCodePos^.Y,CurCodePos^.X,IdentStartPos);
2885 DebugLn('TCodeToolManager.RenameIdentifier File ',Code.Filename,' Line=',dbgs(CurCodePos^.Y),' Col=',dbgs(CurCodePos^.X),' Identifier=',GetIdentifier(@Code.Source[IdentStartPos]));
2886 // search absolute position in source
2887 if IdentStartPos<1 then begin
2888 SetError(20170421203205,Code, CurCodePos^.Y, CurCodePos^.X, ctsPositionNotInSource);
2889 exit;
2890 end;
2891 // check if old identifier is there
2892 if CompareIdentifiers(@Code.Source[IdentStartPos],PChar(Pointer(OldIdentifier)))<>0
2893 then begin
2894 debugln(['TCodeToolManager.RenameIdentifier CONSISTENCY ERROR ',Dbgs(CurCodePos^),' ']);
2895 SetError(20170421203210,CurCodePos^.Code,CurCodePos^.Y,CurCodePos^.X,
2896 Format(ctsStrExpectedButAtomFound,[OldIdentifier,
2897 GetIdentifier(@Code.Source[IdentStartPos])])
2898 );
2899 exit;
2900 end;
2901 // change if needed
2902 if CompareIdentifiersCaseSensitive(@Code.Source[IdentStartPos],
2903 PChar(Pointer(NewIdentifier)))<>0
2904 then begin
2905 DebugLn('TCodeToolManager.RenameIdentifier Change ');
2906 SourceChangeCache.ReplaceEx(gtNone,gtNone,1,1,Code,
2907 IdentStartPos,IdentStartPos+IdentLen,NewIdentifier);
2908
2909 if (DeclarationCode = Code) and (CurCodePos^.Y = DeclarationCaretXY^.Y) and
2910 (CurCodePos^.X < DeclarationCaretXY^.X)
2911 then
2912 DeclarationCaretXY^.X := DeclarationCaretXY^.X + IdentLenDiff;
2913
2914 if (LastCodePos <> nil) and (CurCodePos^.Y = LastCodePos^.Y) and
2915 (CurCodePos^.Code = LastCodePos^.Code)
2916 then
2917 inc(SameLineCount);
2918
2919 end else begin
2920 DebugLn('TCodeToolManager.RenameIdentifier KEPT ',GetIdentifier(@Code.Source[IdentStartPos]));
2921 end;
2922
2923 LastCodePos := CurCodePos;
2924 ANode2 := ANode;
2925 ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
2926
2927 if (ANode = nil) or (PCodeXYPosition(ANode.Data)^.Code <> LastCodePos^.Code) or
2928 (PCodeXYPosition(ANode.Data)^.Y <> LastCodePos^.Y)
2929 then begin
2930 if (SameLineCount > 0) then begin
2931 for i := 1 to SameLineCount do begin
2932 ANode2 := TreeOfPCodeXYPosition.FindPrecessor(ANode2);
2933 PCodeXYPosition(ANode2.Data)^.X := PCodeXYPosition(ANode2.Data)^.X + i * IdentLenDiff;
2934 end;
2935 end;
2936 SameLineCount := 0;
2937 end;
2938 end;
2939 // apply
2940 DebugLn('TCodeToolManager.RenameIdentifier Apply');
2941 if not SourceChangeCache.Apply then exit;
2942
2943 //DebugLn('TCodeToolManager.RenameIdentifier Success');
2944 Result:=true;
2945 {$IFDEF CTDEBUG}
2946 DebugLn('TCodeToolManager.RenameIdentifier END ');
2947 {$ENDIF}
2948 end;
2949
ReplaceWordnull2950 function TCodeToolManager.ReplaceWord(Code: TCodeBuffer; const OldWord,
2951 NewWord: string; ChangeStrings: boolean): boolean;
2952 begin
2953 Result:=false;
2954 {$IFDEF CTDEBUG}
2955 DebugLn('TCodeToolManager.ReplaceWord A ',Code.Filename,' OldWord="',OldWord,'" NewWord="',NewWord,'"');
2956 {$ENDIF}
2957 if not InitCurCodeTool(Code) then exit;
2958 try
2959 Result:=FCurCodeTool.ReplaceWord(OldWord, NewWord, ChangeStrings,
2960 SourceChangeCache);
2961 except
2962 on e: Exception do HandleException(e);
2963 end;
2964 end;
2965
RemoveIdentifierDefinitionnull2966 function TCodeToolManager.RemoveIdentifierDefinition(Code: TCodeBuffer; X,
2967 Y: integer): boolean;
2968 var
2969 CursorPos: TCodeXYPosition;
2970 begin
2971 Result:=false;
2972 {$IFDEF CTDEBUG}
2973 DebugLn(['TCodeToolManager.RemoveIdentifierDefinition A ',Code.Filename,' X=',X,' Y=',Y]);
2974 {$ENDIF}
2975 if not InitCurCodeTool(Code) then exit;
2976 CursorPos.X:=X;
2977 CursorPos.Y:=Y;
2978 CursorPos.Code:=Code;
2979 try
2980 Result:=FCurCodeTool.RemoveIdentifierDefinition(CursorPos,SourceChangeCache);
2981 except
2982 on e: Exception do HandleException(e);
2983 end;
2984 end;
2985
TCodeToolManager.RemoveWithBlocknull2986 function TCodeToolManager.RemoveWithBlock(Code: TCodeBuffer; X, Y: integer
2987 ): boolean;
2988 var
2989 CursorPos: TCodeXYPosition;
2990 begin
2991 Result:=false;
2992 {$IFDEF CTDEBUG}
2993 DebugLn(['TCodeToolManager.RemoveWithBlock A ',Code.Filename,' X=',X,' Y=',Y]);
2994 {$ENDIF}
2995 if not InitCurCodeTool(Code) then exit;
2996 CursorPos.X:=X;
2997 CursorPos.Y:=Y;
2998 CursorPos.Code:=Code;
2999 try
3000 Result:=FCurCodeTool.RemoveWithBlock(CursorPos,SourceChangeCache);
3001 except
3002 on e: Exception do HandleException(e);
3003 end;
3004 end;
3005
TCodeToolManager.AddWithBlocknull3006 function TCodeToolManager.AddWithBlock(Code: TCodeBuffer; X1, Y1, X2,
3007 Y2: integer; const WithExpr: string; Candidates: TStrings): boolean;
3008 var
3009 StartPos, EndPos: TCodeXYPosition;
3010 begin
3011 Result:=false;
3012 {$IFDEF CTDEBUG}
3013 DebugLn(['TCodeToolManager.AddWithBlock A ',Code.Filename,' X1=',X1,' Y1=',Y1,' X2=',X2,' Y2=',Y2,' WithExpr="',WithExpr,'"']);
3014 {$ENDIF}
3015 if not InitCurCodeTool(Code) then exit;
3016 StartPos.X:=X1;
3017 StartPos.Y:=Y1;
3018 StartPos.Code:=Code;
3019 EndPos.X:=X2;
3020 EndPos.Y:=Y2;
3021 EndPos.Code:=Code;
3022 try
3023 Result:=FCurCodeTool.AddWithBlock(StartPos,EndPos,WithExpr,Candidates,
3024 SourceChangeCache);
3025 except
3026 on e: Exception do HandleException(e);
3027 end;
3028 end;
3029
TCodeToolManager.ChangeParamListnull3030 function TCodeToolManager.ChangeParamList(Code: TCodeBuffer;
3031 Changes: TObjectList; var ProcPos: TCodeXYPosition;
3032 TreeOfPCodeXYPosition: TAVLTree): boolean;
3033 begin
3034 Result:=false;
3035 {$IFDEF CTDEBUG}
3036 DebugLn('TCodeToolManager.ChangeParamList A ',Code.Filename);
3037 {$ENDIF}
3038 if not InitCurCodeTool(Code) then exit;
3039 try
3040 Result:=FCurCodeTool.ChangeParamList(Changes,ProcPos,TreeOfPCodeXYPosition,
3041 SourceChangeCache);
3042 except
3043 on e: Exception do HandleException(e);
3044 end;
3045 end;
3046
GatherResourceStringSectionsnull3047 function TCodeToolManager.GatherResourceStringSections(Code: TCodeBuffer;
3048 X, Y: integer; CodePositions: TCodeXYPositions): boolean;
3049 var
3050 CursorPos: TCodeXYPosition;
3051 begin
3052 Result:=false;
3053 {$IFDEF CTDEBUG}
3054 DebugLn('TCodeToolManager.GatherResourceStringSections A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
3055 {$ENDIF}
3056 if not InitCurCodeTool(Code) then exit;
3057 CursorPos.X:=X;
3058 CursorPos.Y:=Y;
3059 CursorPos.Code:=Code;
3060 if CodePositions=nil then begin
3061 ClearPositions;
3062 CodePositions:=Positions;
3063 end;
3064 try
3065 Result:=FCurCodeTool.GatherResourceStringSections(CursorPos,CodePositions);
3066 except
3067 on e: Exception do HandleException(e);
3068 end;
3069 end;
3070
IdentifierExistsInResourceStringSectionnull3071 function TCodeToolManager.IdentifierExistsInResourceStringSection(
3072 Code: TCodeBuffer; X, Y: integer; const ResStrIdentifier: string): boolean;
3073 var
3074 CursorPos: TCodeXYPosition;
3075 begin
3076 Result:=false;
3077 {$IFDEF CTDEBUG}
3078 DebugLn('TCodeToolManager.IdentifierExistsInResourceStringSection A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
3079 {$ENDIF}
3080 if not InitCurCodeTool(Code) then exit;
3081 CursorPos.X:=X;
3082 CursorPos.Y:=Y;
3083 CursorPos.Code:=Code;
3084 try
3085 Result:=FCurCodeTool.IdentifierExistsInResourceStringSection(CursorPos,
3086 ResStrIdentifier);
3087 except
3088 on e: Exception do HandleException(e);
3089 end;
3090 end;
3091
TCodeToolManager.CreateIdentifierFromStringConstnull3092 function TCodeToolManager.CreateIdentifierFromStringConst(
3093 StartCode: TCodeBuffer; StartX, StartY: integer;
3094 EndCode: TCodeBuffer; EndX, EndY: integer;
3095 out Identifier: string; MaxLen: integer): boolean;
3096 var
3097 StartCursorPos, EndCursorPos: TCodeXYPosition;
3098 begin
3099 Result:=false;
3100 {$IFDEF CTDEBUG}
3101 DebugLn('TCodeToolManager.CreateIdentifierFromStringConst A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
3102 {$ENDIF}
3103 if not InitCurCodeTool(StartCode) then exit;
3104 StartCursorPos.X:=StartX;
3105 StartCursorPos.Y:=StartY;
3106 StartCursorPos.Code:=StartCode;
3107 EndCursorPos.X:=EndX;
3108 EndCursorPos.Y:=EndY;
3109 EndCursorPos.Code:=EndCode;
3110 Identifier:='';
3111 try
3112 Result:=FCurCodeTool.CreateIdentifierFromStringConst(
3113 StartCursorPos,EndCursorPos,Identifier,MaxLen);
3114 except
3115 on e: Exception do HandleException(e);
3116 end;
3117 end;
3118
TCodeToolManager.StringConstToFormatStringnull3119 function TCodeToolManager.StringConstToFormatString(
3120 StartCode: TCodeBuffer; StartX, StartY: integer;
3121 EndCode: TCodeBuffer; EndX, EndY: integer;
3122 out FormatStringConstant, FormatParameters: string;
3123 out StartInStringConst, EndInStringConst: boolean): boolean;
3124 var
3125 StartCursorPos, EndCursorPos: TCodeXYPosition;
3126 begin
3127 Result:=false;
3128 {$IFDEF CTDEBUG}
3129 DebugLn('TCodeToolManager.StringConstToFormatString A ',StartCode.Filename,' x=',dbgs(StartX),' y=',dbgs(StartY));
3130 {$ENDIF}
3131 if not InitCurCodeTool(StartCode) then exit;
3132 StartCursorPos.X:=StartX;
3133 StartCursorPos.Y:=StartY;
3134 StartCursorPos.Code:=StartCode;
3135 EndCursorPos.X:=EndX;
3136 EndCursorPos.Y:=EndY;
3137 EndCursorPos.Code:=EndCode;
3138 try
3139 Result:=FCurCodeTool.StringConstToFormatString(
3140 StartCursorPos,EndCursorPos,FormatStringConstant,FormatParameters,
3141 StartInStringConst,EndInStringConst);
3142 except
3143 on e: Exception do HandleException(e);
3144 end;
3145 end;
3146
TCodeToolManager.GatherResourceStringsWithValuenull3147 function TCodeToolManager.GatherResourceStringsWithValue(
3148 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
3149 const StringValue: string; CodePositions: TCodeXYPositions): boolean;
3150 var
3151 CursorPos: TCodeXYPosition;
3152 begin
3153 Result:=false;
3154 {$IFDEF CTDEBUG}
3155 DebugLn('TCodeToolManager.GatherResourceStringsWithValue A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
3156 {$ENDIF}
3157 if not InitCurCodeTool(SectionCode) then exit;
3158 CursorPos.X:=SectionX;
3159 CursorPos.Y:=SectionY;
3160 CursorPos.Code:=SectionCode;
3161 if CodePositions=nil then begin
3162 ClearPositions;
3163 CodePositions:=Positions;
3164 end;
3165 try
3166 Result:=FCurCodeTool.GatherResourceStringsWithValue(CursorPos,StringValue,
3167 CodePositions);
3168 except
3169 on e: Exception do HandleException(e);
3170 end;
3171 end;
3172
TCodeToolManager.AddResourcestringnull3173 function TCodeToolManager.AddResourcestring(
3174 CursorCode: TCodeBuffer; X,Y: integer;
3175 SectionCode: TCodeBuffer; SectionX, SectionY: integer;
3176 const NewIdentifier, NewValue: string;
3177 InsertPolicy: TResourcestringInsertPolicy): boolean;
3178 var
3179 CursorPos, SectionPos, NearestPos: TCodeXYPosition;
3180 begin
3181 Result:=false;
3182 {$IFDEF CTDEBUG}
3183 DebugLn('TCodeToolManager.AddResourcestring A ',SectionCode.Filename,' x=',dbgs(SectionX),' y=',dbgs(SectionY));
3184 {$ENDIF}
3185 if not InitCurCodeTool(SectionCode) then exit;
3186 SectionPos.X:=SectionX;
3187 SectionPos.Y:=SectionY;
3188 SectionPos.Code:=SectionCode;
3189 try
3190 NearestPos.Code:=nil;
3191 if InsertPolicy=rsipContext then begin
3192 CursorPos.X:=X;
3193 CursorPos.Y:=Y;
3194 CursorPos.Code:=CursorCode;
3195 Result:=FCurCodeTool.FindNearestResourceString(CursorPos, SectionPos,
3196 NearestPos);
3197 if not Result then exit;
3198 end;
3199 Result:=FCurCodeTool.AddResourcestring(SectionPos, NewIdentifier, NewValue,
3200 InsertPolicy,NearestPos,SourceChangeCache);
3201 except
3202 on e: Exception do HandleException(e);
3203 end;
3204 end;
3205
3206 procedure TCodeToolManager.ImproveStringConstantStart(const ACode: string;
3207 var StartPos: integer);
3208 begin
3209 BasicCodeTools.ImproveStringConstantStart(ACode,StartPos);
3210 end;
3211
3212 procedure TCodeToolManager.ImproveStringConstantEnd(const ACode: string;
3213 var EndPos: integer);
3214 begin
3215 BasicCodeTools.ImproveStringConstantEnd(ACode,EndPos);
3216 end;
3217
GetStringConstBoundsnull3218 function TCodeToolManager.GetStringConstBounds(Code: TCodeBuffer; X,
3219 Y: integer; out StartCode: TCodeBuffer; out StartX, StartY: integer; out
3220 EndCode: TCodeBuffer; out EndX, EndY: integer; ResolveComments: boolean
3221 ): boolean;
3222 var
3223 CursorPos, StartPos, EndPos: TCodeXYPosition;
3224 begin
3225 Result:=false;
3226 {$IFDEF CTDEBUG}
3227 DebugLn('TCodeToolManager.GetStringConstBounds A ',Code.Filename);
3228 {$ENDIF}
3229 if not InitCurCodeTool(Code) then exit;
3230 CursorPos.X:=X;
3231 CursorPos.Y:=Y;
3232 CursorPos.Code:=Code;
3233 try
3234 Result:=FCurCodeTool.GetStringConstBounds(CursorPos,StartPos,EndPos,
3235 ResolveComments);
3236 if Result then begin
3237 StartCode:=StartPos.Code;
3238 StartX:=StartPos.X;
3239 StartY:=StartPos.Y;
3240 EndCode:=EndPos.Code;
3241 EndX:=EndPos.X;
3242 EndY:=EndPos.Y;
3243 end;
3244 except
3245 on e: Exception do Result:=HandleException(e);
3246 end;
3247 end;
3248
InsertStatementsnull3249 function TCodeToolManager.InsertStatements(
3250 InsertPos: TInsertStatementPosDescription; const Statements: string): boolean;
3251 begin
3252 Result:=false;
3253 {$IFDEF CTDEBUG}
3254 DebugLn('TCodeToolManager.InsertStatements A ',Code.Filename,' Line=',Y,',Col=',X);
3255 {$ENDIF}
3256 if not InitCurCodeTool(InsertPos.CodeXYPos.Code) then exit;
3257 try
3258 Result:=FCurCodeTool.InsertStatements(InsertPos,Statements,SourceChangeCache);
3259 except
3260 on e: Exception do HandleException(e);
3261 end;
3262 end;
3263
AddProcModifiernull3264 function TCodeToolManager.AddProcModifier(Code: TCodeBuffer; X, Y: integer;
3265 const aModifier: string): boolean;
3266 var
3267 CursorPos: TCodeXYPosition;
3268 begin
3269 Result:=false;
3270 {$IFDEF CTDEBUG}
3271 DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename);
3272 {$ENDIF}
3273 if not InitCurCodeTool(Code) then exit;
3274 CursorPos.X:=X;
3275 CursorPos.Y:=Y;
3276 CursorPos.Code:=Code;
3277 try
3278 Result:=FCurCodeTool.AddProcModifier(CursorPos,aModifier,SourceChangeCache);
3279 except
3280 on e: Exception do HandleException(e);
3281 end;
3282 end;
3283
ExtractOperandnull3284 function TCodeToolManager.ExtractOperand(Code: TCodeBuffer; X, Y: integer; out
3285 Operand: string; WithPostTokens, WithAsOperator,
3286 WithoutTrailingPoints: boolean): boolean;
3287 var
3288 CursorPos: TCodeXYPosition;
3289 begin
3290 Result:=false;
3291 {$IFDEF CTDEBUG}
3292 DebugLn('TCodeToolManager.ExtractOperand A ',Code.Filename);
3293 {$ENDIF}
3294 Operand:='';
3295 if not InitCurCodeTool(Code) then exit;
3296 CursorPos.X:=X;
3297 CursorPos.Y:=Y;
3298 CursorPos.Code:=Code;
3299 try
3300 Result:=FCurCodeTool.ExtractOperand(CursorPos,Operand,
3301 WithPostTokens,WithAsOperator,WithoutTrailingPoints);
3302 except
3303 on e: Exception do HandleException(e);
3304 end;
3305 end;
3306
GetExpandedOperandnull3307 function TCodeToolManager.GetExpandedOperand(Code: TCodeBuffer; X, Y: Integer;
3308 out Operand: string; ResolveProperty: Boolean): Boolean;
3309 var
3310 CursorPos: TCodeXYPosition;
3311 begin
3312 Result := False;
3313 Operand := '';
3314 if not InitCurCodeTool(Code) then Exit;
3315 CursorPos.X := X;
3316 CursorPos.Y := Y;
3317 CursorPos.Code := Code;
3318 try
3319 Result := FCurCodeTool.GetExpandedOperand(CursorPos, Operand, ResolveProperty);
3320 except
3321 on e: Exception do HandleException(e);
3322 end;
3323 end;
3324
3325 {$IFDEF GuessMisplacedIfdef}
TCodeToolManager.GuessMisplacedIfdefEndifnull3326 function TCodeToolManager.GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,
3327 Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
3328 ): boolean;
3329 var
3330 CursorPos: TCodeXYPosition;
3331 NewPos: TCodeXYPosition;
3332 begin
3333 Result:=false;
3334 {$IFDEF CTDEBUG}
3335 DebugLn('TCodeToolManager.GuessMisplacedIfdefEndif A ',Code.Filename);
3336 {$ENDIF}
3337 if not InitCurCodeTool(Code) then exit;
3338 CursorPos.X:=X;
3339 CursorPos.Y:=Y;
3340 CursorPos.Code:=Code;
3341 try
3342 Result:=FCurCodeTool.GuessMisplacedIfdefEndif(CursorPos,NewPos,NewTopLine);
3343 if Result then begin
3344 NewX:=NewPos.X;
3345 NewY:=NewPos.Y;
3346 NewCode:=NewPos.Code;
3347 end;
3348 except
3349 on e: Exception do Result:=HandleException(e);
3350 end;
3351 end;
3352 {$ENDIF}
3353
TCodeToolManager.FindEnclosingIncludeDirectivenull3354 function TCodeToolManager.FindEnclosingIncludeDirective(Code: TCodeBuffer; X,
3355 Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer
3356 ): boolean;
3357 var
3358 CursorPos: TCodeXYPosition;
3359 NewPos: TCodeXYPosition;
3360 begin
3361 Result:=false;
3362 {$IFDEF CTDEBUG}
3363 DebugLn('TCodeToolManager.FindEnclosingIncludeDirective A ',Code.Filename);
3364 {$ENDIF}
3365 if not InitCurCodeTool(Code) then exit;
3366 CursorPos.X:=X;
3367 CursorPos.Y:=Y;
3368 CursorPos.Code:=Code;
3369 try
3370 Result:=FCurCodeTool.FindEnclosingIncludeDirective(CursorPos,
3371 NewPos,NewTopLine);
3372 if Result then begin
3373 NewX:=NewPos.X;
3374 NewY:=NewPos.Y;
3375 NewCode:=NewPos.Code;
3376 end;
3377 except
3378 on e: Exception do Result:=HandleException(e);
3379 end;
3380 end;
3381
TCodeToolManager.FindResourceDirectivenull3382 function TCodeToolManager.FindResourceDirective(Code: TCodeBuffer; StartX,
3383 StartY: integer;
3384 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
3385 const Filename: string; SearchInCleanSrc: boolean): boolean;
3386 var
3387 CursorPos: TCodeXYPosition;
3388 NewPos: TCodeXYPosition;
3389 p: integer;
3390 ADirectivesTool: TDirectivesTool;
3391 begin
3392 Result:=false;
3393 {$IFDEF CTDEBUG}
3394 DebugLn('TCodeToolManager.FindResourceDirective A ',Code.Filename);
3395 {$ENDIF}
3396 NewCode:=nil;
3397 NewX:=0;
3398 NewY:=0;
3399 NewTopLine:=0;
3400 if SearchInCleanSrc then begin
3401 if not InitCurCodeTool(Code) then exit;
3402 CursorPos.X:=StartX;
3403 CursorPos.Y:=StartY;
3404 CursorPos.Code:=Code;
3405 try
3406 Result:=FCurCodeTool.FindResourceDirective(CursorPos,NewPos,NewTopLine,
3407 Filename);
3408 if Result then begin
3409 NewX:=NewPos.X;
3410 NewY:=NewPos.Y;
3411 NewCode:=NewPos.Code;
3412 end;
3413 except
3414 on e: Exception do Result:=HandleException(e);
3415 end;
3416 end else begin
3417 try
3418 if not InitCurDirectivesTool(Code) then exit;
3419 ADirectivesTool:=FCurDirectivesTool;
3420 FCurDirectivesTool.Parse;
3421 Code.LineColToPosition(StartY,StartX,p);
3422 Result:=ADirectivesTool.NodeStartToCodePos(
3423 ADirectivesTool.FindResourceDirective(Filename,p),
3424 CursorPos);
3425 NewCode:=CursorPos.Code;
3426 NewX:=CursorPos.X;
3427 NewY:=CursorPos.Y;
3428 NewTopLine:=NewY;
3429 except
3430 on e: Exception do Result:=HandleException(e);
3431 end;
3432 end;
3433 end;
3434
TCodeToolManager.AddResourceDirectivenull3435 function TCodeToolManager.AddResourceDirective(Code: TCodeBuffer;
3436 const Filename: string; SearchInCleanSrc: boolean; const NewSrc: string
3437 ): boolean;
3438 var
3439 Tree: TCompilerDirectivesTree;
3440 Node: TCodeTreeNode;
3441 begin
3442 Result:=false;
3443 {$IFDEF CTDEBUG}
3444 DebugLn('TCodeToolManager.AddResourceDirective A ',Code.Filename,' Filename=',Filename);
3445 {$ENDIF}
3446 if SearchInCleanSrc then begin
3447 if not InitCurCodeTool(Code) then exit;
3448 try
3449 Result:=FCurCodeTool.AddResourceDirective(Filename,SourceChangeCache,NewSrc);
3450 except
3451 on e: Exception do Result:=HandleException(e);
3452 end;
3453 end else begin
3454 try
3455 Tree:=TCompilerDirectivesTree.Create;
3456 try
3457 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3458 Node:=Tree.FindResourceDirective(Filename);
3459 if Node=nil then
3460 Result:=AddResourceDirective(Code,Filename,true,NewSrc)
3461 else
3462 Result:=true;
3463 finally
3464 Tree.Free;
3465 end;
3466 except
3467 on e: Exception do Result:=HandleException(e);
3468 end;
3469 end;
3470 end;
3471
TCodeToolManager.FindIncludeDirectivenull3472 function TCodeToolManager.FindIncludeDirective(Code: TCodeBuffer; StartX,
3473 StartY: integer; out NewCode: TCodeBuffer; out NewX, NewY,
3474 NewTopLine: integer; const Filename: string; SearchInCleanSrc: boolean
3475 ): boolean;
3476 var
3477 CursorPos: TCodeXYPosition;
3478 NewPos: TCodeXYPosition;
3479 Tree: TCompilerDirectivesTree;
3480 p: integer;
3481 begin
3482 Result:=false;
3483 {$IFDEF CTDEBUG}
3484 DebugLn('TCodeToolManager.FindIncludeDirective A ',Code.Filename);
3485 {$ENDIF}
3486 NewCode:=nil;
3487 NewX:=0;
3488 NewY:=0;
3489 NewTopLine:=0;
3490 if SearchInCleanSrc then begin
3491 if not InitCurCodeTool(Code) then exit;
3492 CursorPos.X:=StartX;
3493 CursorPos.Y:=StartY;
3494 CursorPos.Code:=Code;
3495 try
3496 Result:=FCurCodeTool.FindIncludeDirective(CursorPos,NewPos,NewTopLine,
3497 Filename);
3498 if Result then begin
3499 NewX:=NewPos.X;
3500 NewY:=NewPos.Y;
3501 NewCode:=NewPos.Code;
3502 end;
3503 except
3504 on e: Exception do Result:=HandleException(e);
3505 end;
3506 end else begin
3507 try
3508 Tree:=TCompilerDirectivesTree.Create;
3509 try
3510 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3511 Code.LineColToPosition(StartY,StartX,p);
3512 Result:=Tree.NodeStartToCodePos(Tree.FindIncludeDirective(Filename,p),
3513 CursorPos);
3514 NewCode:=CursorPos.Code;
3515 NewX:=CursorPos.X;
3516 NewY:=CursorPos.Y;
3517 NewTopLine:=NewY;
3518 finally
3519 Tree.Free;
3520 end;
3521 except
3522 on e: Exception do Result:=HandleException(e);
3523 end;
3524 end;
3525 end;
3526
AddIncludeDirectiveForInitnull3527 function TCodeToolManager.AddIncludeDirectiveForInit(Code: TCodeBuffer;
3528 const Filename: string; const NewSrc: string): boolean;
3529 begin
3530 Result:=false;
3531 {$IFDEF CTDEBUG}
3532 DebugLn('TCodeToolManager.AddIncludeDirectiveForInit A ',Code.Filename,' Filename=',Filename);
3533 {$ENDIF}
3534 if not InitCurCodeTool(Code) then exit;
3535 try
3536 Result:=FCurCodeTool.AddIncludeDirectiveForInit(Filename,SourceChangeCache,NewSrc);
3537 except
3538 on e: Exception do Result:=HandleException(e);
3539 end;
3540 end;
3541
TCodeToolManager.AddUnitWarnDirectivenull3542 function TCodeToolManager.AddUnitWarnDirective(Code: TCodeBuffer; WarnID,
3543 Comment: string; TurnOn: boolean): boolean;
3544 begin
3545 Result:=false;
3546 {$IFDEF CTDEBUG}
3547 DebugLn(['TCodeToolManager.AddUnitWarnDirective A ',Code.Filename,' aParam="',aParam,'" TurnOn=',TurnOn]);
3548 {$ENDIF}
3549 if not InitCurCodeTool(Code) then exit;
3550 try
3551 Result:=FCurCodeTool.AddUnitWarnDirective(WarnID,Comment,TurnOn,SourceChangeCache);
3552 except
3553 on e: Exception do Result:=HandleException(e);
3554 end;
3555 end;
3556
TCodeToolManager.RemoveDirectivenull3557 function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX,
3558 NewY: integer; RemoveEmptyIFs: boolean): boolean;
3559 var
3560 Tree: TCompilerDirectivesTree;
3561 p: integer;
3562 Node: TCodeTreeNode;
3563 Changed: boolean;
3564 ParentNode: TCodeTreeNode;
3565 begin
3566 Result:=false;
3567 {$IFDEF CTDEBUG}
3568 DebugLn('TCodeToolManager.RemoveDirective A ',Code.Filename);
3569 {$ENDIF}
3570 try
3571 Code.LineColToPosition(NewY,NewX,p);
3572 if (p<1) or (p>Code.SourceLength) then exit;
3573 Tree:=TCompilerDirectivesTree.Create;
3574 try
3575 Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
3576 Node:=Tree.FindNodeAtPos(p);
3577 if Node=nil then exit;
3578 ParentNode:=Node.Parent;
3579 Changed:=false;
3580 Tree.DisableNode(Node,Changed,true);
3581 if RemoveEmptyIFs and (ParentNode<>nil) and Tree.NodeIsEmpty(ParentNode) then
3582 Tree.DisableNode(ParentNode,Changed,true);
3583 Result:=Changed;
3584 finally
3585 Tree.Free;
3586 end;
3587 except
3588 on e: Exception do Result:=HandleException(e);
3589 end;
3590 end;
3591
TCodeToolManager.FixIncludeFilenamesnull3592 function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
3593 Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;
3594
3595 procedure CreateErrorForMissingIncludeFile;
3596 var
3597 CodePos: PCodeXYPosition;
3598 begin
3599 ClearError;
3600 CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[0]);
3601 fErrorCode:=CodePos^.Code;
3602 fErrorLine:=CodePos^.Y;
3603 fErrorColumn:=CodePos^.X;
3604 FErrorId:=20170421202903;
3605 FErrorMsg:='missing include file';
3606 end;
3607
3608 var
3609 FoundIncludeFiles: TStrings;
3610 i: Integer;
3611 AFilename: string;
3612 ToFixIncludeFiles: TStringList;
3613 FixedIncludeFiles: TStringList;
3614 begin
3615 Result:=false;
3616 {$IFDEF CTDEBUG}
3617 DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=', DbgS(Recursive));
3618 {$ENDIF}
3619 MissingIncludeFilesCodeXYPos:=nil;
3620 if not InitCurCodeTool(Code) then exit;
3621 try
3622 FixedIncludeFiles:=nil;
3623 ToFixIncludeFiles:=TStringList.Create;
3624 try
3625 ToFixIncludeFiles.Add(Code.Filename);
3626 while ToFixIncludeFiles.Count>0 do begin
3627 // get next include file
3628 AFilename:=ToFixIncludeFiles[ToFixIncludeFiles.Count-1];
3629 ToFixIncludeFiles.Delete(ToFixIncludeFiles.Count-1);
3630 Code:=LoadFile(AFilename,false,false);
3631 if Code=nil then begin
3632 raise ECodeToolError.Create(FCurCodeTool,20170421202139,
3633 'unable to read file "'+AFilename+'"');
3634 end;
3635 // fix file
3636 FoundIncludeFiles:=nil;
3637 try
3638 Result:=FCurCodeTool.FixIncludeFilenames(Code,SourceChangeCache,
3639 FoundIncludeFiles,MissingIncludeFilesCodeXYPos);
3640 if (MissingIncludeFilesCodeXYPos<>nil)
3641 and (MissingIncludeFilesCodeXYPos.Count>0) then begin
3642 DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',dbgs(MissingIncludeFilesCodeXYPos.Count));
3643 Result:=false;
3644 CreateErrorForMissingIncludeFile;
3645 exit;
3646 end;
3647 if not Recursive then begin
3648 // check only main file -> stop
3649 exit;
3650 end;
3651 // remember, that the file has been fixed to avoid cycles
3652 if FixedIncludeFiles=nil then
3653 FixedIncludeFiles:=TStringList.Create;
3654 FixedIncludeFiles.Add(Code.Filename);
3655 // add new include files to stack
3656 if FoundIncludeFiles<>nil then begin
3657 for i:=0 to FoundIncludeFiles.Count-1 do begin
3658 AFilename:=FoundIncludeFiles[i];
3659 if ((FixedIncludeFiles=nil)
3660 or (FixedIncludeFiles.IndexOf(AFilename)<0))
3661 and (ToFixIncludeFiles.IndexOf(AFilename)<0) then begin
3662 ToFixIncludeFiles.Add(AFilename);
3663 end;
3664 end;
3665 end;
3666 //DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text);
3667 finally
3668 FoundIncludeFiles.Free;
3669 end;
3670 end;
3671 finally
3672 FixedIncludeFiles.Free;
3673 ToFixIncludeFiles.Free;
3674 end;
3675 except
3676 on e: Exception do Result:=HandleException(e);
3677 end;
3678 end;
3679
TCodeToolManager.FixMissingH2PasDirectivesnull3680 function TCodeToolManager.FixMissingH2PasDirectives(Code: TCodeBuffer;
3681 var Changed: boolean): boolean;
3682 begin
3683 Result:=false;
3684 try
3685 if InitCurDirectivesTool(Code) then begin
3686 FCurDirectivesTool.Parse;
3687 FCurDirectivesTool.FixMissingH2PasDirectives(Changed);
3688 Result:=true;
3689 end;
3690 except
3691 on e: Exception do Result:=HandleException(e);
3692 end;
3693 end;
3694
TCodeToolManager.ReduceCompilerDirectivesnull3695 function TCodeToolManager.ReduceCompilerDirectives(Code: TCodeBuffer;
3696 Undefines, Defines: TStrings; var Changed: boolean): boolean;
3697 begin
3698 Result:=false;
3699 try
3700 if InitCurDirectivesTool(Code) then begin
3701 FCurDirectivesTool.Parse;
3702 FCurDirectivesTool.ReduceCompilerDirectives(Undefines,Defines,Changed);
3703 Result:=true;
3704 end;
3705 except
3706 on e: Exception do Result:=HandleException(e);
3707 end;
3708 end;
3709
IsKeywordnull3710 function TCodeToolManager.IsKeyword(Code: TCodeBuffer; const KeyWord: string
3711 ): boolean;
3712 begin
3713 Result:=false;
3714 {$IFDEF CTDEBUG}
3715 DebugLn('TCodeToolManager.IsKeyword A ',Code.Filename,' Keyword=',KeyWord);
3716 {$ENDIF}
3717 if not InitCurCodeTool(Code) then exit;
3718 try
3719 Result:=FCurCodeTool.StringIsKeyWord(KeyWord);
3720 except
3721 on e: Exception do Result:=HandleException(e);
3722 end;
3723 end;
3724
ExtractCodeWithoutCommentsnull3725 function TCodeToolManager.ExtractCodeWithoutComments(Code: TCodeBuffer;
3726 KeepDirectives: boolean; KeepVerbosityDirectives: boolean): string;
3727 begin
3728 Result:=CleanCodeFromComments(Code.Source,
3729 GetNestedCommentsFlagForFile(Code.Filename),KeepDirectives,
3730 KeepVerbosityDirectives);
3731 end;
3732
TCodeToolManager.GetPasDocCommentsnull3733 function TCodeToolManager.GetPasDocComments(Code: TCodeBuffer; X, Y: integer;
3734 out ListOfPCodeXYPosition: TFPList): boolean;
3735 var
3736 CursorPos: TCodeXYPosition;
3737 begin
3738 Result:=false;
3739 {$IFDEF CTDEBUG}
3740 DebugLn('TCodeToolManager.GetPasDocComments A ',Code.Filename);
3741 {$ENDIF}
3742 ListOfPCodeXYPosition:=nil;
3743 if not InitCurCodeTool(Code) then exit;
3744 CursorPos.X:=X;
3745 CursorPos.Y:=Y;
3746 CursorPos.Code:=Code;
3747 {$IFDEF CTDEBUG}
3748 DebugLn('TCodeToolManager.GetPasDocComments B ',dbgs(FCurCodeTool.Scanner<>nil));
3749 {$ENDIF}
3750 try
3751 Result:=FCurCodeTool.GetPasDocComments(CursorPos,true,ListOfPCodeXYPosition);
3752 except
3753 on e: Exception do Result:=HandleException(e);
3754 end;
3755 {$IFDEF CTDEBUG}
3756 DebugLn('TCodeToolManager.GetPasDocComments END ');
3757 {$ENDIF}
3758 end;
3759
TCodeToolManager.FindBlockCounterPartnull3760 function TCodeToolManager.FindBlockCounterPart(Code: TCodeBuffer; X,
3761 Y: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
3762 IncludeCloseToken: Boolean): boolean;
3763 var
3764 CursorPos: TCodeXYPosition;
3765 NewPos: TCodeXYPosition;
3766 begin
3767 Result:=false;
3768 {$IFDEF CTDEBUG}
3769 DebugLn('TCodeToolManager.FindBlockCounterPart A ',Code.Filename);
3770 {$ENDIF}
3771 NewCode:=nil;
3772 if not InitCurCodeTool(Code) then exit;
3773 CursorPos.X:=X;
3774 CursorPos.Y:=Y;
3775 CursorPos.Code:=Code;
3776 {$IFDEF CTDEBUG}
3777 DebugLn('TCodeToolManager.FindBlockCounterPart B ',dbgs(FCurCodeTool.Scanner<>nil));
3778 {$ENDIF}
3779 try
3780 Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine,IncludeCloseToken);
3781 if Result then begin
3782 NewX:=NewPos.X;
3783 NewY:=NewPos.Y;
3784 NewCode:=NewPos.Code;
3785 end;
3786 except
3787 on e: Exception do Result:=HandleException(e);
3788 end;
3789 {$IFDEF CTDEBUG}
3790 DebugLn('TCodeToolManager.FindBlockCounterPart END ');
3791 {$ENDIF}
3792 end;
3793
TCodeToolManager.FindBlockStartnull3794 function TCodeToolManager.FindBlockStart(Code: TCodeBuffer; X, Y: integer; out
3795 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; SkipStart: boolean
3796 ): boolean;
3797 var
3798 CursorPos: TCodeXYPosition;
3799 NewPos: TCodeXYPosition;
3800 begin
3801 Result:=false;
3802 {$IFDEF CTDEBUG}
3803 DebugLn('TCodeToolManager.FindBlockStart A ',Code.Filename);
3804 {$ENDIF}
3805 if not InitCurCodeTool(Code) then exit;
3806 CursorPos.X:=X;
3807 CursorPos.Y:=Y;
3808 CursorPos.Code:=Code;
3809 {$IFDEF CTDEBUG}
3810 DebugLn('TCodeToolManager.FindBlockStart B ',dbgs(FCurCodeTool.Scanner<>nil));
3811 {$ENDIF}
3812 try
3813 Result:=FCurCodeTool.FindBlockStart(CursorPos,NewPos,NewTopLine,SkipStart);
3814 if Result then begin
3815 NewX:=NewPos.X;
3816 NewY:=NewPos.Y;
3817 NewCode:=NewPos.Code;
3818 end;
3819 except
3820 on e: Exception do Result:=HandleException(e);
3821 end;
3822 {$IFDEF CTDEBUG}
3823 DebugLn('TCodeToolManager.FindBlockStart END ');
3824 {$ENDIF}
3825 end;
3826
TCodeToolManager.GuessUnclosedBlocknull3827 function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
3828 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
3829 var
3830 CursorPos: TCodeXYPosition;
3831 NewPos: TCodeXYPosition;
3832 begin
3833 Result:=false;
3834 {$IFDEF CTDEBUG}
3835 DebugLn('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename);
3836 {$ENDIF}
3837 if not InitCurCodeTool(Code) then exit;
3838 CursorPos.X:=X;
3839 CursorPos.Y:=Y;
3840 CursorPos.Code:=Code;
3841 {$IFDEF CTDEBUG}
3842 DebugLn('TCodeToolManager.GuessUnclosedBlock B ',dbgs(FCurCodeTool.Scanner<>nil));
3843 {$ENDIF}
3844 try
3845 Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
3846 if Result then begin
3847 NewX:=NewPos.X;
3848 NewY:=NewPos.Y;
3849 NewCode:=NewPos.Code;
3850 end;
3851 except
3852 on e: Exception do Result:=HandleException(e);
3853 end;
3854 {$IFDEF CTDEBUG}
3855 DebugLn('TCodeToolManager.GuessUnclosedBlock END ');
3856 {$ENDIF}
3857 end;
3858
TCodeToolManager.CompleteBlocknull3859 function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
3860 OnlyIfCursorBlockIndented: boolean): boolean;
3861 var
3862 NewCode: TCodeBuffer;
3863 NewX, NewY, NewTopLine: integer;
3864 begin
3865 Result:=CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
3866 NewCode,NewX,NewY,NewTopLine);
3867 if (NewCode=nil) and (NewX<0) and (NewY<0) and (NewTopLine<1) then ;
3868 end;
3869
TCodeToolManager.CompleteBlocknull3870 function TCodeToolManager.CompleteBlock(Code: TCodeBuffer; X, Y: integer;
3871 OnlyIfCursorBlockIndented: boolean;
3872 out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
3873 var
3874 CursorPos, NewPos: TCodeXYPosition;
3875 begin
3876 Result:=false;
3877 NewCode:=Code;
3878 NewX:=X;
3879 NewY:=Y;
3880 NewTopLine:=-1;
3881 {$IFDEF CTDEBUG}
3882 DebugLn('TCodeToolManager.CompleteBlock A ',Code.Filename,' x=',dbgs(X),' y=',dbgs(Y));
3883 {$ENDIF}
3884 if not InitCurCodeTool(Code) then exit;
3885 CursorPos.X:=X;
3886 CursorPos.Y:=Y;
3887 CursorPos.Code:=Code;
3888 try
3889 Result:=FCurCodeTool.CompleteBlock(CursorPos,SourceChangeCache,
3890 OnlyIfCursorBlockIndented,NewPos,NewTopLine);
3891 if Result then begin
3892 NewCode:=NewPos.Code;
3893 NewX:=NewPos.X;
3894 NewY:=NewPos.Y;
3895 end;
3896 except
3897 on e: Exception do HandleException(e);
3898 end;
3899 end;
3900
GetCompatiblePublishedMethodsnull3901 function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
3902 const AClassName: string; PropInstance: TPersistent; const PropName: string;
3903 const Proc: TGetStrProc): boolean;
3904 begin
3905 {$IFDEF CTDEBUG}
3906 DebugLn(['TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname,' Instance=',DbgSName(PropInstance),' PropName=',PropName]);
3907 {$ENDIF}
3908 Result:=false;
3909 if not InitCurCodeTool(Code) then exit;
3910 try
3911 Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,
3912 PropInstance,PropName,Proc);
3913 except
3914 on e: Exception do Result:=HandleException(e);
3915 end;
3916 end;
3917
GetCompatiblePublishedMethodsnull3918 function TCodeToolManager.GetCompatiblePublishedMethods(Code: TCodeBuffer;
3919 const AClassName: string; TypeData: PTypeData; const Proc: TGetStrProc): boolean;
3920 begin
3921 {$IFDEF CTDEBUG}
3922 DebugLn('TCodeToolManager.GetCompatiblePublishedMethods A ',Code.Filename,' Classname=',AClassname);
3923 {$ENDIF}
3924 Result:=false;
3925 if not InitCurCodeTool(Code) then exit;
3926 try
3927 Result:=FCurCodeTool.GetCompatiblePublishedMethods(AClassName,TypeData,Proc);
3928 except
3929 on e: Exception do Result:=HandleException(e);
3930 end;
3931 end;
3932
PublishedMethodExistsnull3933 function TCodeToolManager.PublishedMethodExists(Code: TCodeBuffer;
3934 const AClassName, AMethodName: string; PropInstance: TPersistent;
3935 const PropName: string; out MethodIsCompatible, MethodIsPublished,
3936 IdentIsMethod: boolean): boolean;
3937 begin
3938 {$IFDEF CTDEBUG}
3939 DebugLn(['TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName,' Porperty=',DbgSName(PropInstance),'.',PropName]);
3940 {$ENDIF}
3941 Result:=InitCurCodeTool(Code);
3942 if not Result then exit;
3943 try
3944 Result:=FCurCodeTool.PublishedMethodExists(AClassName,
3945 AMethodName,PropInstance,PropName,
3946 MethodIsCompatible,MethodIsPublished,IdentIsMethod);
3947 except
3948 on e: Exception do Result:=HandleException(e);
3949 end;
3950 end;
3951
PublishedMethodExistsnull3952 function TCodeToolManager.PublishedMethodExists(Code:TCodeBuffer;
3953 const AClassName, AMethodName: string; TypeData: PTypeData;
3954 out MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean): boolean;
3955 begin
3956 {$IFDEF CTDEBUG}
3957 DebugLn('TCodeToolManager.PublishedMethodExists A ',Code.Filename,' ',AClassName,':',AMethodName);
3958 {$ENDIF}
3959 Result:=InitCurCodeTool(Code);
3960 if not Result then exit;
3961 try
3962 Result:=FCurCodeTool.PublishedMethodExists(AClassName,
3963 AMethodName,TypeData,
3964 MethodIsCompatible,MethodIsPublished,IdentIsMethod);
3965 except
3966 on e: Exception do Result:=HandleException(e);
3967 end;
3968 end;
3969
JumpToPublishedMethodBodynull3970 function TCodeToolManager.JumpToPublishedMethodBody(Code: TCodeBuffer;
3971 const AClassName, AMethodName: string; out NewCode: TCodeBuffer; out NewX,
3972 NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
3973 var NewPos: TCodeXYPosition;
3974 begin
3975 {$IFDEF CTDEBUG}
3976 DebugLn('TCodeToolManager.JumpToPublishedMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName);
3977 {$ENDIF}
3978 Result:=InitCurCodeTool(Code);
3979 if not Result then exit;
3980 try
3981 Result:=FCurCodeTool.JumpToPublishedMethodBody(AClassName,
3982 AMethodName,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,true);
3983 if Result then begin
3984 NewCode:=NewPos.Code;
3985 NewX:=NewPos.X;
3986 NewY:=NewPos.Y;
3987 end;
3988 except
3989 on e: Exception do Result:=HandleException(e);
3990 end;
3991 end;
3992
RenamePublishedMethodnull3993 function TCodeToolManager.RenamePublishedMethod(Code: TCodeBuffer;
3994 const AClassName, OldMethodName, NewMethodName: string): boolean;
3995 begin
3996 {$IFDEF CTDEBUG}
3997 DebugLn('TCodeToolManager.RenamePublishedMethod A');
3998 {$ENDIF}
3999 Result:=InitCurCodeTool(Code);
4000 if not Result then exit;
4001 try
4002 SourceChangeCache.Clear;
4003 Result:=FCurCodeTool.RenamePublishedMethod(AClassName,
4004 OldMethodName,NewMethodName,SourceChangeCache);
4005 except
4006 on e: Exception do Result:=HandleException(e);
4007 end;
4008 end;
4009
TCodeToolManager.CreatePublishedMethodnull4010 function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
4011 const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
4012 UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
4013 const APropertyPath: string; const CallAncestorMethod: string;
4014 AddOverride: boolean): boolean;
4015 begin
4016 {$IFDEF CTDEBUG}
4017 DebugLn('TCodeToolManager.CreatePublishedMethod A');
4018 {$ENDIF}
4019 Result:=InitCurCodeTool(Code);
4020 if not Result then exit;
4021 try
4022 SourceChangeCache.Clear;
4023 Result:=FCurCodeTool.CreateMethod(AClassName,
4024 NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
4025 SourceChangeCache,UseTypeInfoForParameters,pcsPublished,
4026 CallAncestorMethod,AddOverride);
4027 except
4028 on e: Exception do Result:=HandleException(e);
4029 end;
4030 end;
4031
TCodeToolManager.CreatePrivateMethodnull4032 function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer;
4033 const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
4034 UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
4035 const APropertyPath: string): boolean;
4036 begin
4037 {$IFDEF CTDEBUG}
4038 DebugLn('TCodeToolManager.CreatePrivateMethod A');
4039 {$ENDIF}
4040 Result:=InitCurCodeTool(Code);
4041 if not Result then exit;
4042 try
4043 SourceChangeCache.Clear;
4044 Result:=FCurCodeTool.CreateMethod(AClassName,
4045 NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
4046 SourceChangeCache,UseTypeInfoForParameters,pcsPrivate);
4047 except
4048 on e: Exception do Result:=HandleException(e);
4049 end;
4050 end;
4051
GetIDEDirectivesnull4052 function TCodeToolManager.GetIDEDirectives(Code: TCodeBuffer;
4053 DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter): boolean;
4054 begin
4055 {$IFDEF CTDEBUG}
4056 DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
4057 {$ENDIF}
4058 Result:=false;
4059 if not InitCurCodeTool(Code) then exit;
4060 try
4061 Result:=FCurCodeTool.GetIDEDirectives(DirectiveList,Filter);
4062 except
4063 on e: Exception do Result:=HandleException(e);
4064 end;
4065 end;
4066
SetIDEDirectivesnull4067 function TCodeToolManager.SetIDEDirectives(Code: TCodeBuffer;
4068 DirectiveList: TStrings; const Filter: TOnIDEDirectiveFilter): boolean;
4069 begin
4070 {$IFDEF CTDEBUG}
4071 DebugLn('TCodeToolManager.GetIDEDirectives A ',Code.Filename);
4072 {$ENDIF}
4073 Result:=false;
4074 if not InitCurCodeTool(Code) then exit;
4075 try
4076 Result:=FCurCodeTool.SetIDEDirectives(DirectiveList,SourceChangeCache,Filter);
4077 except
4078 on e: Exception do Result:=HandleException(e);
4079 end;
4080 end;
4081
JumpToLinkerIdentifiernull4082 function TCodeToolManager.JumpToLinkerIdentifier(Code: TCodeBuffer;
4083 const SourceFilename: string; SourceLine: integer;
4084 const MangledFunction, Identifier: string; out NewCode: TCodeBuffer; out
4085 NewX, NewY, NewTopLine: integer): boolean;
4086 var
4087 NewPos: TCodeXYPosition;
4088 begin
4089 {$IFDEF CTDEBUG}
4090 DebugLn('TCodeToolManager.JumpToLinkerIdentifier A ',Code.Filename);
4091 {$ENDIF}
4092 Result:=false;
4093 if not InitCurCodeTool(Code) then exit;
4094 try
4095 Result:=FCurCodeTool.FindJumpPointForLinkerPos(
Identifiernull4096 SourceFilename, SourceLine, MangledFunction, Identifier,
4097 NewPos,NewTopLine);
4098 if Result then begin
4099 NewX:=NewPos.X;
4100 NewY:=NewPos.Y;
4101 NewCode:=NewPos.Code;
4102 end;
4103 except
4104 on e: Exception do Result:=HandleException(e);
4105 end;
4106 end;
4107
FindFPCMangledIdentifiernull4108 function TCodeToolManager.FindFPCMangledIdentifier(GDBIdentifier: string; out
4109 aComplete: boolean; out aMessage: string;
4110 const OnFindSource: TOnFindFPCMangledSource; out NewCode: TCodeBuffer; out NewX,
4111 NewY, NewTopLine: integer): boolean;
4112 { Examples:
4113 compiler built-in
4114 fpc_raiseexception
4115 ??
4116 PASCALMAIN
4117 SYSTEM_FPC_SYSTEMMAIN$LONGINT$PPCHAR$PPCHAR
4118
4119 unit:
4120 procedure
4121 SYSUTILS_RUNERRORTOEXCEPT$LONGINT$POINTER$POINTER
4122 SYSTEM_HANDLEERRORADDRFRAME$LONGINT$POINTER$POINTER
4123 method
4124 EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$$TMODALRESULT
4125 EXTTOOLEDITDLG_TEXTERNALTOOLMENUITEMS_$__LOAD$TCONFIGSTORAGE$ANSISTRING$$TMODALRESULT
4126 ENVIRONMENTOPTS_TENVIRONMENTOPTIONS_$__LOAD$BOOLEAN
4127 MAIN_TMAINIDE_$__LOADGLOBALOPTIONS
4128 MAIN_TMAINIDE_$__CREATE$TCOMPONENT$$TMAINIDE
4129
4130 program:
4131 P$TESTPROJECT1_DOTEST
4132 P$TESTPROJECT1_DOTEST_SUBTEST
4133 P$TESTPROJECT1_DOTEST$CHAR_SUBTEST$LONGINT
4134 P$TESTSTACKTRACE1_TMAINCLASS_$_TSUBCLASS_$__RAISESOMETHING$ANSISTRING
4135 }
4136 var
4137 p: PChar;
4138 TheSrcName: string;
4139 Code: TCodeBuffer;
4140 CurIdentifier: string;
4141 Tool: TCodeTool;
4142 Node: TCodeTreeNode;
4143 SubNode: TCodeTreeNode;
4144 ClassNode: TCodeTreeNode;
4145 ProcNode: TCodeTreeNode;
4146 SectionNode: TCodeTreeNode;
4147 SrcFilename: string;
4148 NewPos: TCodeXYPosition;
4149
4150 procedure ReadIdentifier(out Identifier: string);
4151 var
4152 StartP: PChar;
4153 begin
4154 StartP:=p;
4155 while p^ in ['A'..'Z','0'..'9'] do inc(p);
4156 Identifier:=copy(GDBIdentifier,StartP-PChar(GDBIdentifier)+1,p-StartP);
4157 end;
4158
4159 procedure ReadParamList;
4160 begin
4161 if p^='$' then begin
4162 // parameter list => skip
4163 while (p^ in ['$','A'..'Z','0'..'9']) do inc(p);
4164 end;
4165 end;
4166
FindUnitnull4167 function FindUnit(TheUnitName: string; out aFilename: string): boolean;
4168 var
4169 InFilename: string;
4170 begin
4171 // search in main search path
4172 InFilename:='';
4173 aFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
4174 '',TheUnitName,InFilename,true);
4175 if aFilename='' then begin
4176 // user search
4177 if Assigned(OnFindSource) then
4178 OnFindSource(Self,ctnUnit,TheUnitName,aFilename)
4179 else if Assigned(OnFindFPCMangledSource) then
4180 OnFindFPCMangledSource(Self,ctnUnit,TheUnitName,aFilename)
4181 end;
4182 Result:=aFilename<>'';
4183 end;
4184
FindProgramnull4185 function FindProgram(TheSrcName: string; out aFilename: string): boolean;
4186 begin
4187 aFilename:='';
4188 // user search
4189 if Assigned(OnFindSource) then begin
4190 OnFindSource(Self,ctnProgram,TheSrcName,aFilename);
4191 end;
4192 Result:=aFilename<>'';
4193 end;
4194
4195 begin
4196 Result:=false;
4197 aComplete:=false;
4198 aMessage:='';
4199 NewCode:=nil;
4200 NewTopLine:=-1;
4201 NewX:=-1;
4202 NewY:=-1;
4203
4204 if GDBIdentifier='' then begin
4205 aMessage:='missing identifier';
4206 exit;
4207 end;
4208 p:=PChar(GDBIdentifier);
4209 if p^ in ['a'..'z'] then begin
4210 // lower case unit name means compiler built in function
aMessagenull4211 aMessage:='the function "'+GDBIdentifier+'" is a compiler special function without source';
4212 exit;
4213 end;
4214 TheSrcName:='';
4215 if p^ in ['A'..'Z'] then begin
4216 ReadIdentifier(TheSrcName);
4217 //debugln(['TCodeToolManager.FindGBDIdentifier first identifier=',TheSrcName,' ...']);
4218 if (TheSrcName='P') and (p^='$') then begin
4219 // P$programname
4220 inc(p);
4221 if IsIdentStartChar[p^] then
4222 ReadIdentifier(TheSrcName);
4223 //debugln(['TCodeToolManager.FindGBDIdentifier search source of program "',TheSrcName,'" ...']);
4224 if not FindProgram(TheSrcName,SrcFilename) then begin
4225 aMessage:='can''t find program "'+TheSrcName+'"';
4226 exit;
4227 end;
4228 end else if p^='_' then begin
4229 // a unit name
4230 // => search unit
4231 if not FindUnit(TheSrcName,SrcFilename) then begin
4232 aMessage:='can''t find unit '+TheSrcName;
4233 exit;
4234 end;
4235 end else if p^<>'_' then begin
4236 // only one uppercase identifier, e.g. PASCALMAIN
4237 aMessage:='compiler built in function "'+GDBIdentifier+'"';
4238 exit;
4239 end;
4240 // load unit source
4241 Code:=LoadFile(SrcFilename,true,false);
4242 if Code=nil then begin
4243 aMessage:='unable to read file "'+SrcFilename+'"';
4244 exit;
4245 end;
4246
4247 inc(p);
4248 if p^ in ['A'..'Z'] then begin
4249 ReadIdentifier(CurIdentifier);
4250 //debugln(['TCodeToolManager.FindGBDIdentifier Identifier="',CurIdentifier,'"']);
4251
4252 if not Explore(Code,Tool,false,true) then begin
4253 //debugln(['TCodeToolManager.FindGBDIdentifier parse error']);
4254 aMessage:=CodeToolBoss.ErrorMessage;
4255 exit;
4256 end;
4257
4258 ReadParamList;
4259
4260 Node:=nil;
4261 if Tool.GetSourceType=ctnUnit then begin
4262 // a unit => first search in interface, then in implementation
4263 SectionNode:=Tool.FindInterfaceNode;
4264 if SectionNode<>nil then begin
4265 Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
4266 end;
4267 if Node=nil then begin
4268 // search in implementation
4269 try
4270 Node:=Tool.FindDeclarationNodeInImplementation(CurIdentifier,true);
4271 except
4272 on E: Exception do begin
4273 HandleException(E);
4274 //debugln(['TCodeToolManager.FindGBDIdentifier FindDeclarationNodeInImplementation parse error in "',Code.Filename,'": ',E.Message]);
4275 aMessage:=ErrorMessage;
4276 exit;
4277 end;
4278 end;
4279 end;
4280 end else begin
4281 // not a unit, e.g. a program
4282 SectionNode:=Tool.Tree.Root;
4283 if SectionNode<>nil then begin
4284 Node:=Tool.FindSubDeclaration(CurIdentifier,SectionNode);
4285 end;
4286 end;
4287 if Node=nil then begin
4288 // identifier not found => use only SrcFilename
4289 //debugln(['TCodeToolManager.FindGBDIdentifier identifier "',CurIdentifier,'" not found in "',Code.Filename,'"']);
4290 aMessage:='identifier "'+CurIdentifier+'" not found in "'+Code.Filename+'"';
4291 exit;
4292 end;
4293
4294 repeat
4295 if (p^='_') and (p[1]='$') and (p[2]='_') and (p[3]='_') then begin
4296 // sub identifier is method or member
4297 inc(p,4);
4298 end else if (p^='_') and (p[1] in ['A'..'Z']) then begin
4299 // sub identifier is proc
4300 inc(p);
4301 end else
4302 break;
4303 if not (p^ in ['A'..'Z']) then begin
4304 break;
4305 end;
4306 // _$__identifier => sub identifier
4307 ReadIdentifier(CurIdentifier);
4308 ReadParamList;
4309 // find sub identifier
4310 SubNode:=Tool.FindSubDeclaration(CurIdentifier,Node);
4311 if SubNode=nil then begin
4312 //debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" not found']);
4313 break;
4314 end;
4315 //debugln(['TCodeToolManager.FindGBDIdentifier SubIdentifier="',CurIdentifier,'" found']);
4316 Node:=SubNode;
4317 until false;
4318
4319 if Node.Desc=ctnProcedure then begin
4320 // proc node => find body
4321 ClassNode:=Tool.FindClassOrInterfaceNode(Node);
4322 if ClassNode<>nil then begin
4323 try
4324 Tool.BuildTree(lsrInitializationStart);
4325 except
4326 on E: Exception do begin
4327 // ignore
4328 end;
4329 end;
4330 ProcNode:=Tool.FindCorrespondingProcNode(Node,[phpAddClassName]);
4331 if ProcNode<>nil then
4332 Node:=ProcNode;
4333 end;
4334 end;
4335
4336 aComplete:=p^ in [#0,#9,#10,#13,' '];
4337 Result:=Tool.JumpToCleanPos(Node.StartPos,-1,-1,NewPos,NewTopLine,false);
4338 NewCode:=NewPos.Code;
4339 NewX:=NewPos.X;
4340 NewY:=NewPos.Y;
4341 end;
4342 // unknown operator => use only SrcFilename
4343 //debugln(['TCodeToolManager.FindGBDIdentifier operator not yet supported: ',dbgstr(p^)]);
4344 aMessage:='operator not supported: '+dbgstr(p^);
4345 exit;
4346 end else begin
4347 // example: ??
4348 end;
4349
4350 aMessage:='unknown identifier "'+GDBIdentifier+'"';
4351 end;
4352
CompleteCodenull4353 function TCodeToolManager.CompleteCode(Code: TCodeBuffer; X, Y,
4354 TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine,
4355 BlockTopLine, BlockBottomLine: integer; Interactive: Boolean): boolean;
4356 var
4357 CursorPos: TCodeXYPosition;
4358 NewPos: TCodeXYPosition;
4359 begin
4360 {$IFDEF CTDEBUG}
4361 DebugLn('TCodeToolManager.CompleteCode A ',Code.Filename);
4362 {$ENDIF}
4363 Result:=false;
4364 NewX := 0;
4365 NewY := 0;
4366 NewTopLine := 0;
4367 NewCode := NIL;
4368 if not InitCurCodeTool(Code) then exit;
4369 CursorPos.X:=X;
4370 CursorPos.Y:=Y;
4371 CursorPos.Code:=Code;
4372 try
4373 Result:=FCurCodeTool.CompleteCode(CursorPos,TopLine,
4374 NewPos,NewTopLine, BlockTopLine, BlockBottomLine,SourceChangeCache,Interactive);
4375 if Result then begin
4376 NewX:=NewPos.X;
4377 NewY:=NewPos.Y;
4378 NewCode:=NewPos.Code;
4379 end;
4380 except
4381 on e: Exception do Result:=HandleException(e);
4382 end;
4383 end;
4384
CreateVariableForIdentifiernull4385 function TCodeToolManager.CreateVariableForIdentifier(Code: TCodeBuffer; X, Y,
4386 TopLine: integer; out NewCode: TCodeBuffer; out NewX, NewY,
4387 NewTopLine: integer; Interactive: Boolean): boolean;
4388 var
4389 CursorPos: TCodeXYPosition;
4390 NewPos: TCodeXYPosition;
4391 begin
4392 {$IFDEF CTDEBUG}
4393 DebugLn('TCodeToolManager.CreateVariableForIdentifier A ',Code.Filename);
4394 {$ENDIF}
4395 Result:=false;
4396 if not InitCurCodeTool(Code) then exit;
4397 CursorPos.X:=X;
4398 CursorPos.Y:=Y;
4399 CursorPos.Code:=Code;
4400 try
4401 Result:=FCurCodeTool.CreateVariableForIdentifier(CursorPos,TopLine,
4402 NewPos,NewTopLine,SourceChangeCache,Interactive);
4403 if Result then begin
4404 NewX:=NewPos.X;
4405 NewY:=NewPos.Y;
4406 NewCode:=NewPos.Code;
4407 end;
4408 except
4409 on e: Exception do Result:=HandleException(e);
4410 end;
4411 end;
4412
AddMethodsnull4413 function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y, TopLine: integer;
4414 ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean; out
4415 NewCode: TCodeBuffer; out NewX, NewY, NewTopLine, BlockTopLine,
4416 BlockBottomLine: integer): boolean;
4417 var
4418 CursorPos, NewPos: TCodeXYPosition;
4419 begin
4420 {$IFDEF CTDEBUG}
4421 DebugLn('TCodeToolManager.AddMethods A ',Code.Filename);
4422 {$ENDIF}
4423 Result:=false;
4424 NewCode:=nil;
4425 if not InitCurCodeTool(Code) then exit;
4426 CursorPos.X:=X;
4427 CursorPos.Y:=Y;
4428 CursorPos.Code:=Code;
4429 try
4430 Result:=FCurCodeTool.AddMethods(CursorPos,TopLine,ListOfPCodeXYPosition,
4431 VirtualToOverride,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache);
4432 NewCode:=NewPos.Code;
4433 NewX:=NewPos.X;
4434 NewY:=NewPos.Y;
4435 except
4436 on e: Exception do Result:=HandleException(e);
4437 end;
4438 end;
4439
TCodeToolManager.GuessTypeOfIdentifiernull4440 function TCodeToolManager.GuessTypeOfIdentifier(Code: TCodeBuffer; X,
4441 Y: integer; out ItsAKeyword, IsSubIdentifier: boolean;
4442 out ExistingDefinition: TFindContext;
4443 out ListOfPFindContext: TFPList; out NewExprType: TExpressionType;
4444 out NewType: string): boolean;
4445 var
4446 CursorPos: TCodeXYPosition;
4447 begin
4448 {$IFDEF CTDEBUG}
4449 DebugLn(['TCodeToolManager.GuessTypeOfIdentifier A ',Code.Filename,' X=',X,' Y=',Y]);
4450 {$ENDIF}
4451 Result:=false;
4452 if not InitCurCodeTool(Code) then exit;
4453 CursorPos.X:=X;
4454 CursorPos.Y:=Y;
4455 CursorPos.Code:=Code;
4456 try
4457 Result:=FCurCodeTool.GuessTypeOfIdentifier(CursorPos,ItsAKeyword,
4458 IsSubIdentifier,ExistingDefinition,ListOfPFindContext,
4459 NewExprType,NewType);
4460 except
4461 on e: Exception do Result:=HandleException(e);
4462 end;
4463 end;
4464
GetPossibleInitsForVariablenull4465 function TCodeToolManager.GetPossibleInitsForVariable(Code: TCodeBuffer; X,
4466 Y: integer; out Statements: TStrings; out InsertPositions: TObjectList
4467 ): boolean;
4468 var
4469 CursorPos: TCodeXYPosition;
4470 begin
4471 {$IFDEF CTDEBUG}
4472 DebugLn(['TCodeToolManager.GetPossibleInitsForVariable A ',Code.Filename,' X=',X,' Y=',Y]);
4473 {$ENDIF}
4474 Result:=false;
4475 if not InitCurCodeTool(Code) then exit;
4476 CursorPos.Code:=Code;
4477 CursorPos.X:=X;
4478 CursorPos.Y:=Y;
4479 try
4480 Result:=FCurCodeTool.GetPossibleInitsForVariable(CursorPos,Statements,
4481 InsertPositions,SourceChangeCache);
4482 except
4483 on e: Exception do Result:=HandleException(e);
4484 end;
4485 end;
4486
TCodeToolManager.DeclareVariableNearBynull4487 function TCodeToolManager.DeclareVariableNearBy(Code: TCodeBuffer; X,
4488 Y: integer; const VariableName, NewType, NewUnitName: string;
4489 Visibility: TCodeTreeNodeDesc; LvlPosCode: TCodeBuffer; LvlPosX: integer;
4490 LvlPosY: integer): boolean;
4491 var
4492 CursorPos, LvlPos: TCodeXYPosition;
4493 begin
4494 {$IFDEF CTDEBUG}
4495 DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
4496 {$ENDIF}
4497 Result:=false;
4498 if not InitCurCodeTool(Code) then exit;
4499 CursorPos.Code:=Code;
4500 CursorPos.X:=X;
4501 CursorPos.Y:=Y;
4502 LvlPos.Code:=LvlPosCode;
4503 LvlPos.X:=LvlPosX;
4504 LvlPos.Y:=LvlPosY;
4505 try
4506 Result:=FCurCodeTool.DeclareVariableNearBy(CursorPos,VariableName,
4507 NewType,NewUnitName,Visibility,SourceChangeCache,LvlPos);
4508 except
4509 on e: Exception do Result:=HandleException(e);
4510 end;
4511 end;
4512
TCodeToolManager.DeclareVariableAtnull4513 function TCodeToolManager.DeclareVariableAt(Code: TCodeBuffer; X, Y: integer;
4514 const VariableName, NewType, NewUnitName: string): boolean;
4515 var
4516 CursorPos: TCodeXYPosition;
4517 begin
4518 {$IFDEF CTDEBUG}
4519 DebugLn(['TCodeToolManager.DeclareVariableNearBy A ',Code.Filename,' X=',X,' Y=',Y]);
4520 {$ENDIF}
4521 Result:=false;
4522 if not InitCurCodeTool(Code) then exit;
4523 CursorPos.Code:=Code;
4524 CursorPos.X:=X;
4525 CursorPos.Y:=Y;
4526 try
4527 Result:=FCurCodeTool.DeclareVariableAt(CursorPos,VariableName,
4528 NewType,NewUnitName,SourceChangeCache);
4529 except
4530 on e: Exception do Result:=HandleException(e);
4531 end;
4532 end;
4533
TCodeToolManager.FindRedefinitionsnull4534 function TCodeToolManager.FindRedefinitions(Code: TCodeBuffer; out
4535 TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
4536 begin
4537 {$IFDEF CTDEBUG}
4538 DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
4539 {$ENDIF}
4540 Result:=false;
4541 TreeOfCodeTreeNodeExt:=nil;
4542 if not InitCurCodeTool(Code) then exit;
4543 try
4544 Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,WithEnums);
4545 except
4546 on e: Exception do Result:=HandleException(e);
4547 end;
4548 end;
4549
RemoveRedefinitionsnull4550 function TCodeToolManager.RemoveRedefinitions(Code: TCodeBuffer;
4551 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4552 begin
4553 {$IFDEF CTDEBUG}
4554 DebugLn('TCodeToolManager.RemoveRedefinitions A ',Code.Filename);
4555 {$ENDIF}
4556 Result:=false;
4557 if not InitCurCodeTool(Code) then exit;
4558 try
4559 Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
4560 SourceChangeCache);
4561 except
4562 on e: Exception do Result:=HandleException(e);
4563 end;
4564 end;
4565
TCodeToolManager.RemoveAllRedefinitionsnull4566 function TCodeToolManager.RemoveAllRedefinitions(Code: TCodeBuffer): boolean;
4567 var
4568 TreeOfCodeTreeNodeExt: TAVLTree;
4569 begin
4570 {$IFDEF CTDEBUG}
4571 DebugLn('TCodeToolManager.RemoveAllRedefinitions A ',Code.Filename);
4572 {$ENDIF}
4573 Result:=false;
4574 TreeOfCodeTreeNodeExt:=nil;
4575 try
4576 TreeOfCodeTreeNodeExt:=nil;
4577 if not InitCurCodeTool(Code) then exit;
4578 try
4579 Result:=FCurCodeTool.FindRedefinitions(TreeOfCodeTreeNodeExt,false);
4580 if not Result then exit;
4581 Result:=FCurCodeTool.RemoveRedefinitions(TreeOfCodeTreeNodeExt,
4582 SourceChangeCache);
4583 except
4584 on e: Exception do Result:=HandleException(e);
4585 end;
4586 finally
4587 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4588 end;
4589 end;
4590
RemoveApplicationScaledStatementnull4591 function TCodeToolManager.RemoveApplicationScaledStatement(Code: TCodeBuffer
4592 ): boolean;
4593 begin
4594 Result:=false;
4595 {$IFDEF CTDEBUG}
4596 DebugLn('TCodeToolManager.RemoveApplicationScaledStatement A ',Code.Filename);
4597 {$ENDIF}
4598 if not InitCurCodeTool(Code) then exit;
4599 try
4600 Result:=FCurCodeTool.RemoveApplicationScaledStatement(SourceChangeCache);
4601 except
4602 on e: Exception do Result:=HandleException(e);
4603 end;
4604 end;
4605
FindAliasDefinitionsnull4606 function TCodeToolManager.FindAliasDefinitions(Code: TCodeBuffer; out
4607 TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
4608 begin
4609 {$IFDEF CTDEBUG}
4610 DebugLn('TCodeToolManager.FindAliasDefinitions A ',Code.Filename);
4611 {$ENDIF}
4612 Result:=false;
4613 TreeOfCodeTreeNodeExt:=nil;
4614 if not InitCurCodeTool(Code) then exit;
4615 try
4616 Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,
4617 OnlyWrongType);
4618 except
4619 on e: Exception do Result:=HandleException(e);
4620 end;
4621 end;
4622
FixAliasDefinitionsnull4623 function TCodeToolManager.FixAliasDefinitions(Code: TCodeBuffer;
4624 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4625 begin
4626 {$IFDEF CTDEBUG}
4627 DebugLn('TCodeToolManager.FixAliasDefinitions A ',Code.Filename);
4628 {$ENDIF}
4629 Result:=false;
4630 if not InitCurCodeTool(Code) then exit;
4631 try
4632 Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
4633 SourceChangeCache);
4634 except
4635 on e: Exception do Result:=HandleException(e);
4636 end;
4637 end;
4638
FixAllAliasDefinitionsnull4639 function TCodeToolManager.FixAllAliasDefinitions(Code: TCodeBuffer): boolean;
4640 var
4641 TreeOfCodeTreeNodeExt: TAVLTree;
4642 begin
4643 {$IFDEF CTDEBUG}
4644 DebugLn('TCodeToolManager.FixAllAliasDefinitions A ',Code.Filename);
4645 {$ENDIF}
4646 Result:=false;
4647 TreeOfCodeTreeNodeExt:=nil;
4648 try
4649 TreeOfCodeTreeNodeExt:=nil;
4650 if not InitCurCodeTool(Code) then exit;
4651 try
4652 Result:=FCurCodeTool.FindAliasDefinitions(TreeOfCodeTreeNodeExt,true);
4653 if not Result then exit;
4654 Result:=FCurCodeTool.FixAliasDefinitions(TreeOfCodeTreeNodeExt,
4655 SourceChangeCache);
4656 except
4657 on e: Exception do Result:=HandleException(e);
4658 end;
4659 finally
4660 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4661 end;
4662 end;
4663
TCodeToolManager.FindConstFunctionsnull4664 function TCodeToolManager.FindConstFunctions(Code: TCodeBuffer; out
4665 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4666 begin
4667 {$IFDEF CTDEBUG}
4668 DebugLn('TCodeToolManager.FindConstFunctions A ',Code.Filename);
4669 {$ENDIF}
4670 Result:=false;
4671 TreeOfCodeTreeNodeExt:=nil;
4672 if not InitCurCodeTool(Code) then exit;
4673 try
4674 Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
4675 except
4676 on e: Exception do Result:=HandleException(e);
4677 end;
4678 end;
4679
ReplaceConstFunctionsnull4680 function TCodeToolManager.ReplaceConstFunctions(Code: TCodeBuffer;
4681 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4682 begin
4683 {$IFDEF CTDEBUG}
4684 DebugLn('TCodeToolManager.ReplaceConstFunctions A ',Code.Filename);
4685 {$ENDIF}
4686 Result:=false;
4687 if not InitCurCodeTool(Code) then exit;
4688 try
4689 Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
4690 SourceChangeCache);
4691 except
4692 on e: Exception do Result:=HandleException(e);
4693 end;
4694 end;
4695
TCodeToolManager.ReplaceAllConstFunctionsnull4696 function TCodeToolManager.ReplaceAllConstFunctions(Code: TCodeBuffer): boolean;
4697 var
4698 TreeOfCodeTreeNodeExt: TAVLTree;
4699 begin
4700 {$IFDEF CTDEBUG}
4701 DebugLn('TCodeToolManager.ReplaceAllConstFunctions A ',Code.Filename);
4702 {$ENDIF}
4703 Result:=false;
4704 if not InitCurCodeTool(Code) then exit;
4705 try
4706 repeat
4707 TreeOfCodeTreeNodeExt:=nil;
4708 try
4709 Result:=FCurCodeTool.FindConstFunctions(TreeOfCodeTreeNodeExt);
4710 if (not Result) or (TreeOfCodeTreeNodeExt=nil)
4711 or (TreeOfCodeTreeNodeExt.Count=0) then
4712 break;
4713 Result:=FCurCodeTool.ReplaceConstFunctions(TreeOfCodeTreeNodeExt,
4714 SourceChangeCache);
4715 finally
4716 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4717 end;
4718 until not Result;
4719 except
4720 on e: Exception do Result:=HandleException(e);
4721 end;
4722 end;
4723
TCodeToolManager.FindTypeCastFunctionsnull4724 function TCodeToolManager.FindTypeCastFunctions(Code: TCodeBuffer; out
4725 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4726 begin
4727 {$IFDEF CTDEBUG}
4728 DebugLn('TCodeToolManager.FindTypeCastFunctions A ',Code.Filename);
4729 {$ENDIF}
4730 Result:=false;
4731 TreeOfCodeTreeNodeExt:=nil;
4732 if not InitCurCodeTool(Code) then exit;
4733 try
4734 Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
4735 except
4736 on e: Exception do Result:=HandleException(e);
4737 end;
4738 end;
4739
ReplaceTypeCastFunctionsnull4740 function TCodeToolManager.ReplaceTypeCastFunctions(Code: TCodeBuffer;
4741 TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4742 begin
4743 {$IFDEF CTDEBUG}
4744 DebugLn('TCodeToolManager.ReplaceTypeCastFunctions A ',Code.Filename);
4745 {$ENDIF}
4746 Result:=false;
4747 if not InitCurCodeTool(Code) then exit;
4748 try
4749 Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
4750 SourceChangeCache);
4751 except
4752 on e: Exception do Result:=HandleException(e);
4753 end;
4754 end;
4755
ReplaceAllTypeCastFunctionsnull4756 function TCodeToolManager.ReplaceAllTypeCastFunctions(Code: TCodeBuffer
4757 ): boolean;
4758 var
4759 TreeOfCodeTreeNodeExt: TAVLTree;
4760 begin
4761 {$IFDEF CTDEBUG}
4762 DebugLn('TCodeToolManager.ReplaceAllTypeCastFunctions A ',Code.Filename);
4763 {$ENDIF}
4764 Result:=false;
4765 if not InitCurCodeTool(Code) then exit;
4766 try
4767 repeat
4768 TreeOfCodeTreeNodeExt:=nil;
4769 try
4770 Result:=FCurCodeTool.FindTypeCastFunctions(TreeOfCodeTreeNodeExt);
4771 if (not Result) or (TreeOfCodeTreeNodeExt=nil)
4772 or (TreeOfCodeTreeNodeExt.Count=0) then
4773 break;
4774 Result:=FCurCodeTool.ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt,
4775 SourceChangeCache);
4776 finally
4777 DisposeAVLTree(TreeOfCodeTreeNodeExt);
4778 end;
4779 until not Result;
4780 except
4781 on e: Exception do Result:=HandleException(e);
4782 end;
4783 end;
4784
TCodeToolManager.FixForwardDefinitionsnull4785 function TCodeToolManager.FixForwardDefinitions(Code: TCodeBuffer): boolean;
4786 begin
4787 {$IFDEF CTDEBUG}
4788 DebugLn('TCodeToolManager.FixForwardDefinitions A ',Code.Filename);
4789 {$ENDIF}
4790 Result:=false;
4791 if not InitCurCodeTool(Code) then exit;
4792 try
4793 Result:=FCurCodeTool.FixForwardDefinitions(SourceChangeCache);
4794 except
4795 on e: Exception do Result:=HandleException(e);
4796 end;
4797 end;
4798
FindEmptyMethodsnull4799 function TCodeToolManager.FindEmptyMethods(Code: TCodeBuffer;
4800 const AClassName: string; X, Y: integer;
4801 const Sections: TPascalClassSections; ListOfPCodeXYPosition: TFPList;
4802 out AllEmpty: boolean): boolean;
4803 var
4804 CursorPos: TCodeXYPosition;
4805 begin
4806 {$IFDEF CTDEBUG}
4807 DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
4808 {$ENDIF}
4809 Result:=false;
4810 if not InitCurCodeTool(Code) then exit;
4811 CursorPos.X:=X;
4812 CursorPos.Y:=Y;
4813 CursorPos.Code:=Code;
4814 try
4815 Result:=FCurCodeTool.FindEmptyMethods(CursorPos,AClassName,Sections,
4816 ListOfPCodeXYPosition,AllEmpty);
4817 except
4818 on e: Exception do Result:=HandleException(e);
4819 end;
4820 end;
4821
RemoveEmptyMethodsnull4822 function TCodeToolManager.RemoveEmptyMethods(Code: TCodeBuffer;
4823 const AClassName: string; X,Y: integer;
4824 const Sections: TPascalClassSections; out AllRemoved: boolean;
4825 const Attr: TProcHeadAttributes; out RemovedProcHeads: TStrings): boolean;
4826 var
4827 CursorPos: TCodeXYPosition;
4828 begin
4829 {$IFDEF CTDEBUG}
4830 DebugLn('TCodeToolManager.RemoveEmptyMethods A ',Code.Filename);
4831 {$ENDIF}
4832 Result:=false;
4833 if not InitCurCodeTool(Code) then exit;
4834 CursorPos.X:=X;
4835 CursorPos.Y:=Y;
4836 CursorPos.Code:=Code;
4837 try
4838 Result:=FCurCodeTool.RemoveEmptyMethods(CursorPos,AClassName,Sections,
4839 SourceChangeCache,AllRemoved,Attr,RemovedProcHeads);
4840 except
4841 on e: Exception do Result:=HandleException(e);
4842 end;
4843 end;
4844
TCodeToolManager.FindUnusedUnitsnull4845 function TCodeToolManager.FindUnusedUnits(Code: TCodeBuffer; Units: TStrings
4846 ): boolean;
4847 begin
4848 {$IFDEF CTDEBUG}
4849 DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
4850 {$ENDIF}
4851 Result:=false;
4852 if not InitCurCodeTool(Code) then exit;
4853 try
4854 Result:=FCurCodeTool.FindUnusedUnits(Units);
4855 except
4856 on e: Exception do Result:=HandleException(e);
4857 end;
4858 end;
4859
InitClassCompletionnull4860 function TCodeToolManager.InitClassCompletion(Code: TCodeBuffer;
4861 const AClassName: string; out CodeTool: TCodeTool): boolean;
4862 begin
4863 {$IFDEF CTDEBUG}
4864 DebugLn('TCodeToolManager.InitClassCompletion A ',Code.Filename);
4865 {$ENDIF}
4866 Result:=false;
4867 CodeTool:=nil;
4868 if not InitCurCodeTool(Code) then exit;
4869 try
4870 Result:=FCurCodeTool.InitClassCompletion(AClassName,SourceChangeCache);
4871 CodeTool:=FCurCodeTool;
4872 except
4873 on e: Exception do Result:=HandleException(e);
4874 end;
4875 end;
4876
CheckExtractProcnull4877 function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
4878 EndPoint: TPoint; out MethodPossible, SubProcPossible,
4879 SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree;
4880 VarTree: TAVLTree): boolean;
4881 var
4882 StartPos, EndPos: TCodeXYPosition;
4883 begin
4884 {$IFDEF CTDEBUG}
4885 DebugLn('TCodeToolManager.CheckExtractProc A ',Code.Filename);
4886 {$ENDIF}
4887 Result:=false;
4888 if not InitCurCodeTool(Code) then exit;
4889 StartPos.X:=StartPoint.X;
4890 StartPos.Y:=StartPoint.Y;
4891 StartPos.Code:=Code;
4892 EndPos.X:=EndPoint.X;
4893 EndPos.Y:=EndPoint.Y;
4894 EndPos.Code:=Code;
4895 try
4896 Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
4897 SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,
4898 VarTree);
4899 except
4900 on e: Exception do Result:=HandleException(e);
4901 end;
4902 end;
4903
ExtractProcnull4904 function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint,
4905 EndPoint: TPoint; ProcType: TExtractProcType; const ProcName: string;
4906 IgnoreIdentifiers: TAVLTree; var NewCode: TCodeBuffer; var NewX, NewY,
4907 NewTopLine, BlockTopLine, BlockBottomLine: integer;
4908 FunctionResultVariableStartPos: integer): boolean;
4909 var
4910 StartPos, EndPos: TCodeXYPosition;
4911 NewPos: TCodeXYPosition;
4912 begin
4913 {$IFDEF CTDEBUG}
4914 DebugLn('TCodeToolManager.ExtractProc A ',Code.Filename);
4915 {$ENDIF}
4916 Result:=false;
4917 if not InitCurCodeTool(Code) then exit;
4918 StartPos.X:=StartPoint.X;
4919 StartPos.Y:=StartPoint.Y;
4920 StartPos.Code:=Code;
4921 EndPos.X:=EndPoint.X;
4922 EndPos.Y:=EndPoint.Y;
4923 EndPos.Code:=Code;
4924 try
4925 Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
4926 IgnoreIdentifiers,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache,
4927 FunctionResultVariableStartPos);
4928 if Result then begin
4929 NewX:=NewPos.X;
4930 NewY:=NewPos.Y;
4931 NewCode:=NewPos.Code;
4932 end;
4933 except
4934 on e: Exception do Result:=HandleException(e);
4935 end;
4936 end;
4937
FindAssignMethodnull4938 function TCodeToolManager.FindAssignMethod(Code: TCodeBuffer; X, Y: integer;
4939 out Tool: TCodeTool; out ClassNode: TCodeTreeNode;
4940 out AssignDeclNode: TCodeTreeNode; var MemberNodeExts: TAVLTree;
4941 out AssignBodyNode: TCodeTreeNode; out InheritedDeclContext: TFindContext;
4942 ProcName: string): boolean;
4943 var
4944 CodePos: TCodeXYPosition;
4945 begin
4946 {$IFDEF CTDEBUG}
4947 DebugLn('TCodeToolManager.FindAssignMethod A ',Code.Filename);
4948 {$ENDIF}
4949 Result:=false;
4950 AssignDeclNode:=nil;
4951 AssignBodyNode:=nil;
4952 if not InitCurCodeTool(Code) then exit;
4953 Tool:=FCurCodeTool;
4954 CodePos.X:=X;
4955 CodePos.Y:=Y;
4956 CodePos.Code:=Code;
4957 try
4958 Result:=FCurCodeTool.FindAssignMethod(CodePos,ClassNode,
4959 AssignDeclNode,MemberNodeExts,AssignBodyNode,
4960 InheritedDeclContext,ProcName);
4961 except
4962 on e: Exception do Result:=HandleException(e);
4963 end;
4964 end;
4965
GetSourceNamenull4966 function TCodeToolManager.GetSourceName(Code: TCodeBuffer;
4967 SearchMainCode: boolean): string;
4968 begin
4969 Result:='';
4970 if (Code=nil)
4971 or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
4972 {$IFDEF CTDEBUG}
4973 DebugLn('TCodeToolManager.GetSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
4974 {$ENDIF}
4975 {$IFDEF MEM_CHECK}
4976 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4977 {$ENDIF}
4978 if not InitCurCodeTool(Code) then exit;
4979 try
4980 Result:=FCurCodeTool.GetSourceName;
4981 except
4982 on e: Exception do begin
4983 Result:=FCurCodeTool.ExtractSourceName;
4984 HandleException(e);
4985 end;
4986 end;
4987 {$IFDEF CTDEBUG}
4988 DebugLn('TCodeToolManager.GetSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
4989 {$IFDEF MEM_CHECK}
4990 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
4991 {$ENDIF}
4992 DebugLn('SourceName=',Result);
4993 {$ENDIF}
4994 end;
4995
TCodeToolManager.GetCachedSourceNamenull4996 function TCodeToolManager.GetCachedSourceName(Code: TCodeBuffer): string;
4997 begin
4998 Result:='';
4999 if (Code=nil)
5000 or (Code.LastIncludedByFile<>'') then exit;
5001 {$IFDEF CTDEBUG}
5002 DebugLn('TCodeToolManager.GetCachedSourceName A ',Code.Filename,' ',dbgs(Code.SourceLength));
5003 {$ENDIF}
5004 {$IFDEF MEM_CHECK}
5005 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
5006 {$ENDIF}
5007 if not InitCurCodeTool(Code) then exit;
5008 try
5009 Result:=FCurCodeTool.GetCachedSourceName;
5010 except
5011 on e: Exception do HandleException(e);
5012 end;
5013 {$IFDEF CTDEBUG}
5014 DebugLn('TCodeToolManager.GetCachedSourceName B ',Code.Filename,' ',dbgs(Code.SourceLength));
5015 {$IFDEF MEM_CHECK}
5016 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
5017 {$ENDIF}
5018 DebugLn('SourceName=',Result);
5019 {$ENDIF}
5020 end;
5021
TCodeToolManager.GetSourceTypenull5022 function TCodeToolManager.GetSourceType(Code: TCodeBuffer;
5023 SearchMainCode: boolean): string;
5024 begin
5025 Result:='';
5026 if (Code=nil)
5027 or ((not SearchMainCode) and (Code.LastIncludedByFile<>'')) then exit;
5028 {$IFDEF CTDEBUG}
5029 DebugLn('TCodeToolManager.GetSourceType A ',Code.Filename,' ',dbgs(Code.SourceLength));
5030 {$ENDIF}
5031 if not InitCurCodeTool(Code) then exit;
5032 try
5033 // GetSourceType does not parse the code -> parse it with GetSourceName
5034 FCurCodeTool.GetSourceName;
5035 case FCurCodeTool.GetSourceType of
5036 ctnProgram: Result:='PROGRAM';
5037 ctnPackage: Result:='PACKAGE';
5038 ctnLibrary: Result:='LIBRARY';
5039 ctnUnit: Result:='UNIT';
5040 else
5041 Result:='';
5042 end;
5043 except
5044 on e: Exception do HandleException(e);
5045 end;
5046 {$IFDEF CTDEBUG}
5047 DebugLn('TCodeToolManager.GetSourceType END ',Code.Filename,',',dbgs(Code.SourceLength));
5048 {$IFDEF MEM_CHECK}
5049 CheckHeap(IntToStr(MemCheck_GetMem_Cnt));
5050 {$ENDIF}
5051 DebugLn('SourceType=',Result);
5052 {$ENDIF}
5053 end;
5054
RenameSourcenull5055 function TCodeToolManager.RenameSource(Code: TCodeBuffer;
5056 const NewName: string): boolean;
5057 begin
5058 Result:=false;
5059 {$IFDEF CTDEBUG}
5060 DebugLn('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
5061 {$ENDIF}
5062 if not InitCurCodeTool(Code) then exit;
5063 try
5064 Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache);
5065 except
5066 on e: Exception do Result:=HandleException(e);
5067 end;
5068 end;
5069
TCodeToolManager.FindUnitInAllUsesSectionsnull5070 function TCodeToolManager.FindUnitInAllUsesSections(Code: TCodeBuffer;
5071 const AnUnitName: string; out NamePos, InPos: integer;
5072 const IgnoreMissingIncludeFiles: Boolean = False): boolean;
5073 var
5074 NameAtomPos, InAtomPos: TAtomPosition;
5075 OldIgnoreMissingIncludeFiles: Boolean;
5076 begin
5077 Result:=false;
5078 {$IFDEF CTDEBUG}
5079 DebugLn('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
5080 {$ENDIF}
5081 if not InitCurCodeTool(Code) then exit;
5082 {$IFDEF CTDEBUG}
5083 DebugLn('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' AUnitName=',AnUnitName);
5084 {$ENDIF}
5085 OldIgnoreMissingIncludeFiles := FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
5086 try
5087 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := IgnoreMissingIncludeFiles;
5088 Result:=FCurCodeTool.FindUnitInAllUsesSections(AnUnitName,
5089 NameAtomPos, InAtomPos);
5090 if Result then begin
5091 NamePos:=NameAtomPos.StartPos;
5092 InPos:=InAtomPos.StartPos;
5093 end;
5094 except
5095 on e: Exception do Result:=HandleException(e);
5096 end;
5097 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles := OldIgnoreMissingIncludeFiles;
5098 end;
5099
TCodeToolManager.RenameUsedUnitnull5100 function TCodeToolManager.RenameUsedUnit(Code: TCodeBuffer;
5101 const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
5102 begin
5103 Result:=false;
5104 {$IFDEF CTDEBUG}
5105 DebugLn('TCodeToolManager.RenameUsedUnit A ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
5106 {$ENDIF}
5107 if not InitCurCodeTool(Code) then exit;
5108 try
5109 Result:=FCurCodeTool.RenameUsedUnit(OldUnitName,NewUnitName,
5110 NewUnitInFile,SourceChangeCache);
5111 except
5112 on e: Exception do Result:=HandleException(e);
5113 end;
5114 end;
5115
ReplaceUsedUnitsnull5116 function TCodeToolManager.ReplaceUsedUnits(Code: TCodeBuffer;
5117 UnitNamePairs: TStringToStringTree): boolean;
5118 begin
5119 Result:=false;
5120 {$IFDEF CTDEBUG}
5121 DebugLn('TCodeToolManager.ReplaceUsedUnits A ',Code.Filename);
5122 {$ENDIF}
5123 if not InitCurCodeTool(Code) then exit;
5124 try
5125 Result:=FCurCodeTool.ReplaceUsedUnits(UnitNamePairs,SourceChangeCache);
5126 except
5127 on e: Exception do Result:=HandleException(e);
5128 end;
5129 end;
5130
AddUnitToMainUsesSectionnull5131 function TCodeToolManager.AddUnitToMainUsesSection(Code: TCodeBuffer;
5132 const NewUnitName, NewUnitInFile: string; const Flags: TAddUsesFlags
5133 ): boolean;
5134 begin
5135 Result:=false;
5136 {$IFDEF CTDEBUG}
5137 DebugLn('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
5138 {$ENDIF}
5139 if not InitCurCodeTool(Code) then exit;
5140 try
5141 Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
5142 SourceChangeCache,Flags);
5143 except
5144 on e: Exception do Result:=HandleException(e);
5145 end;
5146 end;
5147
AddUnitToMainUsesSectionnull5148 function TCodeToolManager.AddUnitToMainUsesSection(Code: TCodeBuffer;
5149 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5150 CheckSpecialUnits: boolean = true): boolean;
5151 var
5152 Flags: TAddUsesFlags;
5153 begin
5154 Flags:=[];
5155 if AsLast then Include(Flags,aufLast);
5156 if not CheckSpecialUnits then Include(Flags,aufNotCheckSpecialUnit);
5157 Result:=AddUnitToMainUsesSection(Code,NewUnitName,NewUnitInFile,Flags);
5158 end;
5159
AddUnitToMainUsesSectionIfNeedednull5160 function TCodeToolManager.AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
5161 const NewUnitName, NewUnitInFile: string; const Flags: TAddUsesFlags
5162 ): boolean;
5163 var
5164 NamePos, InPos: TAtomPosition;
5165 begin
5166 Result:=false;
5167 {$IFDEF CTDEBUG}
5168 DebugLn('TCodeToolManager.AddUnitToMainUsesSectionIfNeeded A ',Code.Filename,' NewUnitName=',NewUnitName);
5169 {$ENDIF}
5170 if not InitCurCodeTool(Code) then exit;
5171 try
5172 if not FCurCodeTool.FindUnitInAllUsesSections(NewUnitName,NamePos,InPos) then
5173 Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
5174 SourceChangeCache,Flags);
5175 except
5176 on e: Exception do Result:=HandleException(e);
5177 end;
5178 end;
5179
AddUnitToMainUsesSectionIfNeedednull5180 function TCodeToolManager.AddUnitToMainUsesSectionIfNeeded(Code: TCodeBuffer;
5181 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5182 CheckSpecialUnits: boolean): boolean;
5183 var
5184 Flags: TAddUsesFlags;
5185 begin
5186 Flags:=[];
5187 if AsLast then Include(Flags,aufLast);
5188 if not CheckSpecialUnits then Include(Flags,aufNotCheckSpecialUnit);
5189 Result:=AddUnitToMainUsesSectionIfNeeded(Code,NewUnitName,NewUnitInFile,Flags);
5190 end;
5191
AddUnitToImplementationUsesSectionnull5192 function TCodeToolManager.AddUnitToImplementationUsesSection(Code: TCodeBuffer;
5193 const NewUnitName, NewUnitInFile: string; const Flags: TAddUsesFlags
5194 ): boolean;
5195 begin
5196 Result:=false;
5197 {$IFDEF CTDEBUG}
5198 DebugLn('TCodeToolManager.AddUnitToImplementationUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
5199 {$ENDIF}
5200 if not InitCurCodeTool(Code) then exit;
5201 try
5202 Result:=FCurCodeTool.AddUnitToImplementationUsesSection(
5203 NewUnitName, NewUnitInFile,
5204 SourceChangeCache,Flags);
5205 except
5206 on e: Exception do Result:=HandleException(e);
5207 end;
5208 end;
5209
AddUnitToImplementationUsesSectionnull5210 function TCodeToolManager.AddUnitToImplementationUsesSection(Code: TCodeBuffer;
5211 const NewUnitName, NewUnitInFile: string; AsLast: boolean;
5212 CheckSpecialUnits: boolean): boolean;
5213 var
5214 Flags: TAddUsesFlags;
5215 begin
5216 Flags:=[];
5217 if AsLast then Include(Flags,aufLast);
5218 if not CheckSpecialUnits then Include(Flags,aufNotCheckSpecialUnit);
5219 Result:=AddUnitToImplementationUsesSection(Code,NewUnitName,NewUnitInFile,Flags);
5220 end;
5221
TCodeToolManager.RemoveUnitFromAllUsesSectionsnull5222 function TCodeToolManager.RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
5223 const AnUnitName: string): boolean;
5224 begin
5225 Result:=false;
5226 {$IFDEF CTDEBUG}
5227 DebugLn('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' AUnitName=',AnUnitName);
5228 {$ENDIF}
5229 if not InitCurCodeTool(Code) then exit;
5230 try
5231 Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(AnUnitName,
5232 SourceChangeCache);
5233 except
5234 on e: Exception do Result:=HandleException(e);
5235 end;
5236 end;
5237
TCodeToolManager.FindUsedUnitFilesnull5238 function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
5239 var MainUsesSection: TStrings): boolean;
5240 begin
5241 Result:=false;
5242 {$IFDEF CTDEBUG}
5243 DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
5244 {$ENDIF}
5245 if not InitCurCodeTool(Code) then exit;
5246 try
5247 Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection);
5248 except
5249 on e: Exception do Result:=HandleException(e);
5250 end;
5251 end;
5252
TCodeToolManager.FindUsedUnitFilesnull5253 function TCodeToolManager.FindUsedUnitFiles(Code: TCodeBuffer;
5254 var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
5255 begin
5256 Result:=false;
5257 {$IFDEF CTDEBUG}
5258 DebugLn('TCodeToolManager.FindUsedUnitFiles A ',Code.Filename);
5259 {$ENDIF}
5260 if not InitCurCodeTool(Code) then exit;
5261 try
5262 Result:=FCurCodeTool.FindUsedUnitFiles(MainUsesSection,
5263 ImplementationUsesSection);
5264 except
5265 on e: Exception do Result:=HandleException(e);
5266 end;
5267 end;
5268
FindUsedUnitNamesnull5269 function TCodeToolManager.FindUsedUnitNames(Code: TCodeBuffer;
5270 var MainUsesSection, ImplementationUsesSection: TStrings): boolean;
5271 begin
5272 Result:=false;
5273 {$IFDEF CTDEBUG}
5274 DebugLn('TCodeToolManager.FindUsedUnitNames A ',Code.Filename);
5275 {$ENDIF}
5276 if not InitCurCodeTool(Code) then exit;
5277 try
5278 Result:=FCurCodeTool.FindUsedUnitNames(MainUsesSection,
5279 ImplementationUsesSection);
5280 except
5281 on e: Exception do Result:=HandleException(e);
5282 end;
5283 end;
5284
FindMissingUnitsnull5285 function TCodeToolManager.FindMissingUnits(Code: TCodeBuffer;
5286 var MissingUnits: TStrings; FixCase: boolean;
5287 SearchImplementation: boolean): boolean;
5288 begin
5289 Result:=false;
5290 {$IFDEF CTDEBUG}
5291 DebugLn('TCodeToolManager.FindMissingUnits A ',Code.Filename);
5292 {$ENDIF}
5293 if not InitCurCodeTool(Code) then exit;
5294 try
5295 Result:=FCurCodeTool.FindMissingUnits(MissingUnits,FixCase,
5296 SearchImplementation,SourceChangeCache);
5297 except
5298 on e: Exception do Result:=HandleException(e);
5299 end;
5300 end;
5301
FindDelphiProjectUnitsnull5302 function TCodeToolManager.FindDelphiProjectUnits(Code: TCodeBuffer;
5303 out FoundInUnits, MissingInUnits, NormalUnits: TStrings;
5304 IgnoreNormalUnits: boolean): boolean;
5305 begin
5306 Result:=false;
5307 {$IFDEF CTDEBUG}
5308 DebugLn('TCodeToolManager.FindDelphiProjectUnits A ',Code.Filename);
5309 {$ENDIF}
5310 if not InitCurCodeTool(Code) then exit;
5311 try
5312 Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits, MissingInUnits,
5313 NormalUnits, false, IgnoreNormalUnits);
5314 except
5315 on e: Exception do Result:=HandleException(e);
5316 end;
5317 end;
5318
TCodeToolManager.FindDelphiPackageUnitsnull5319 function TCodeToolManager.FindDelphiPackageUnits(Code: TCodeBuffer;
5320 var FoundInUnits, MissingInUnits, NormalUnits: TStrings;
5321 IgnoreNormalUnits: boolean): boolean;
5322 begin
5323 Result:=false;
5324 {$IFDEF CTDEBUG}
5325 DebugLn('TCodeToolManager.FindDelphiPackageUnits A ',Code.Filename);
5326 {$ENDIF}
5327 if not InitCurCodeTool(Code) then exit;
5328 try
5329 Result:=FCurCodeTool.FindDelphiProjectUnits(FoundInUnits,
5330 MissingInUnits,NormalUnits,true,IgnoreNormalUnits);
5331 except
5332 on e: Exception do Result:=HandleException(e);
5333 end;
5334 end;
5335
CommentUnitsInUsesSectionsnull5336 function TCodeToolManager.CommentUnitsInUsesSections(Code: TCodeBuffer;
5337 MissingUnits: TStrings): boolean;
5338 begin
5339 Result:=false;
5340 {$IFDEF CTDEBUG}
5341 DebugLn('TCodeToolManager.CommentUnitsInUsesSections A ',Code.Filename);
5342 {$ENDIF}
5343 if not InitCurCodeTool(Code) then exit;
5344 try
5345 Result:=FCurCodeTool.CommentUnitsInUsesSections(MissingUnits,
5346 SourceChangeCache);
5347 except
5348 on e: Exception do Result:=HandleException(e);
5349 end;
5350 end;
5351
TCodeToolManager.FindUnitCaseInsensitivenull5352 function TCodeToolManager.FindUnitCaseInsensitive(Code: TCodeBuffer;
5353 var AnUnitName, AnUnitInFilename: string): string;
5354 begin
5355 Result:='';
5356 {$IFDEF CTDEBUG}
5357 DebugLn('TCodeToolManager.FindUnitCaseInsensitive A ',Code.Filename,' AnUnitName="',AnUnitName,'"',' AnUnitInFilename="',AnUnitInFilename,'"');
5358 {$ENDIF}
5359 if not InitCurCodeTool(Code) then exit;
5360 try
5361 Result:=FCurCodeTool.FindUnitCaseInsensitive(AnUnitName,AnUnitInFilename);
5362 except
5363 on e: Exception do HandleException(e);
5364 end;
5365 end;
5366
FindUnitSourcenull5367 function TCodeToolManager.FindUnitSource(Code: TCodeBuffer; const AnUnitName,
5368 AnUnitInFilename: string): TCodeBuffer;
5369 begin
5370 Result:=nil;
5371 {$IFDEF CTDEBUG}
5372 DebugLn('TCodeToolManager.FindUnit A ',Code.Filename,' AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'"');
5373 {$ENDIF}
5374 if not InitCurCodeTool(Code) then exit;
5375 try
5376 Result:=FCurCodeTool.FindUnitSource(AnUnitName,AnUnitInFilename,false);
5377 except
5378 on e: Exception do HandleException(e);
5379 end;
5380 end;
5381
CreateUsesGraphnull5382 function TCodeToolManager.CreateUsesGraph: TUsesGraph;
5383 begin
5384 Result:=TUsesGraph.Create;
5385 Result.DirectoryCachePool:=DirectoryCachePool;
5386 Result.OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
5387 Result.OnLoadFile:=@DoOnLoadFileForTool;
5388 end;
5389
FindLFMFileNamenull5390 function TCodeToolManager.FindLFMFileName(Code: TCodeBuffer): string;
5391 var LinkIndex: integer;
5392 CurCode: TCodeBuffer;
5393 Ext: string;
5394 begin
5395 Result:='';
5396 {$IFDEF CTDEBUG}
5397 DebugLn('TCodeToolManager.FindLFMFileName A ',Code.Filename);
5398 {$ENDIF}
5399 if not InitCurCodeTool(Code) then exit;
5400 try
5401 LinkIndex:=-1;
5402 CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5403 while (CurCode<>nil) do begin
5404 if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin
5405 Result:=CurCode.Filename;
5406 Ext:=ExtractFileExt(Result);
5407 Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm';
5408 exit;
5409 end;
5410 CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5411 end;
5412 except
5413 on e: Exception do HandleException(e);
5414 end;
5415 end;
5416
TCodeToolManager.CheckLFMnull5417 function TCodeToolManager.CheckLFM(UnitCode, LFMBuf: TCodeBuffer;
5418 out LFMTree: TLFMTree; RootMustBeClassInUnit, RootMustBeClassInIntf,
5419 ObjectsMustExist: boolean): boolean;
5420 begin
5421 Result:=false;
5422 {$IFDEF CTDEBUG}
5423 DebugLn('TCodeToolManager.CheckLFM A ',UnitCode.Filename,' ',LFMBuf.Filename);
5424 {$ENDIF}
5425 if not InitCurCodeTool(UnitCode) then exit;
5426 try
5427 Result:=FCurCodeTool.CheckLFM(LFMBuf,LFMTree,OnFindDefinePropertyForContext,
5428 RootMustBeClassInUnit,RootMustBeClassInIntf,ObjectsMustExist);
5429 except
5430 on e: Exception do HandleException(e);
5431 end;
5432 end;
5433
TCodeToolManager.FindNextResourceFilenull5434 function TCodeToolManager.FindNextResourceFile(Code: TCodeBuffer;
5435 var LinkIndex: integer): TCodeBuffer;
5436 begin
5437 Result:=nil;
5438 {$IFDEF CTDEBUG}
5439 DebugLn('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
5440 {$ENDIF}
5441 if not InitCurCodeTool(Code) then exit;
5442 try
5443 Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
5444 except
5445 on e: Exception do HandleException(e);
5446 end;
5447 end;
5448
TCodeToolManager.AddLazarusResourceHeaderCommentnull5449 function TCodeToolManager.AddLazarusResourceHeaderComment(Code: TCodeBuffer;
5450 const CommentText: string): boolean;
5451 begin
5452 Result:=false;
5453 if not InitResourceTool then exit;
5454 {$IFDEF CTDEBUG}
5455 DebugLn('TCodeToolManager.AddLazarusResourceHeaderComment A ',Code.Filename,' CommentText=',CommentText);
5456 {$ENDIF}
5457 try
5458 Result:=GetResourceTool.AddLazarusResourceHeaderComment(Code,
5459 '{ '+CommentText+' }'+SourceChangeCache.BeautifyCodeOptions.LineEnd
5460 +SourceChangeCache.BeautifyCodeOptions.LineEnd);
5461 except
5462 on e: Exception do HandleException(e);
5463 end;
5464 end;
5465
TCodeToolManager.FindLazarusResourcenull5466 function TCodeToolManager.FindLazarusResource(Code: TCodeBuffer;
5467 const ResourceName: string): TAtomPosition;
5468 begin
5469 Result.StartPos:=-1;
5470 if not InitResourceTool then exit;
5471 {$IFDEF CTDEBUG}
5472 DebugLn('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
5473 {$ENDIF}
5474 try
5475 Result:=GetResourceTool.FindLazarusResource(Code,ResourceName,-1);
5476 except
5477 on e: Exception do HandleException(e);
5478 end;
5479 end;
5480
TCodeToolManager.AddLazarusResourcenull5481 function TCodeToolManager.AddLazarusResource(Code: TCodeBuffer;
5482 const ResourceName, ResourceData: string): boolean;
5483 begin
5484 Result:=false;
5485 {$IFDEF CTDEBUG}
5486 DebugLn('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',dbgs(length(ResourceData)));
5487 {$ENDIF}
5488 if not InitResourceTool then exit;
5489 {$IFDEF CTDEBUG}
5490 DebugLn('TCodeToolManager.AddLazarusResource B ');
5491 {$ENDIF}
5492 try
5493 Result:=GetResourceTool.AddLazarusResource(Code,ResourceName,ResourceData);
5494 except
5495 on e: Exception do Result:=HandleException(e);
5496 end;
5497 end;
5498
TCodeToolManager.RemoveLazarusResourcenull5499 function TCodeToolManager.RemoveLazarusResource(Code: TCodeBuffer;
5500 const ResourceName: string): boolean;
5501 begin
5502 Result:=false;
5503 {$IFDEF CTDEBUG}
5504 DebugLn('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
5505 {$ENDIF}
5506 if not InitResourceTool then exit;
5507 try
5508 Result:=GetResourceTool.RemoveLazarusResource(Code,ResourceName);
5509 except
5510 on e: Exception do Result:=HandleException(e);
5511 end;
5512 end;
5513
RenameMainIncludenull5514 function TCodeToolManager.RenameMainInclude(Code: TCodeBuffer;
5515 const NewFilename: string; KeepPath: boolean): boolean;
5516 var
5517 LinkIndex: integer;
5518 OldIgnoreMissingIncludeFiles: boolean;
5519 begin
5520 Result:=false;
5521 {$IFDEF CTDEBUG}
5522 DebugLn('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
5523 {$ENDIF}
5524 if not InitCurCodeTool(Code) then exit;
5525 try
5526 OldIgnoreMissingIncludeFiles:=
5527 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles;
5528 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=true;
5529 LinkIndex:=-1;
5530 if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
5531 Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
5532 SourceChangeCache);
5533 FCurCodeTool.Scanner.IgnoreMissingIncludeFiles:=
5534 OldIgnoreMissingIncludeFiles;
5535 except
5536 on e: Exception do Result:=HandleException(e);
5537 end;
5538 end;
5539
RenameIncludeDirectivenull5540 function TCodeToolManager.RenameIncludeDirective(Code: TCodeBuffer;
5541 LinkIndex: integer; const NewFilename: string; KeepPath: boolean): boolean;
5542 begin
5543 Result:=false;
5544 {$IFDEF CTDEBUG}
5545 DebugLn('TCodeToolManager.RenameIncludeDirective A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',dbgs(KeepPath));
5546 {$ENDIF}
5547 if not InitCurCodeTool(Code) then exit;
5548 try
5549 Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
5550 SourceChangeCache);
5551 except
5552 on e: Exception do Result:=HandleException(e);
5553 end;
5554 end;
5555
5556 procedure TCodeToolManager.DefaultFindDefinePropertyForContext(Sender: TObject;
5557 const ClassContext, AncestorClassContext: TFindContext; LFMNode: TLFMTreeNode;
5558 const IdentName: string; var IsDefined: boolean);
5559 var
5560 PersistentClassName: String;
5561 AncestorClassName: String;
5562 begin
5563 if Assigned(OnFindDefineProperty) then begin
5564 PersistentClassName:=ClassContext.Tool.ExtractClassName(
5565 ClassContext.Node,false);
5566 AncestorClassName:='';
5567 if AncestorClassContext.Tool<>nil then
5568 AncestorClassName:=AncestorClassContext.Tool.ExtractClassName(
5569 AncestorClassContext.Node,false);
5570 OnFindDefineProperty(ClassContext.Tool,
5571 PersistentClassName,AncestorClassName,IdentName,
5572 IsDefined);
5573 end;
5574 end;
5575
TCodeToolManager.FindCreateFormStatementnull5576 function TCodeToolManager.FindCreateFormStatement(Code: TCodeBuffer;
5577 StartPos: integer;
5578 const AClassName, AVarName: string;
5579 out Position: integer): integer;
5580 // 0=found, -1=not found, 1=found, but wrong classname
5581 var PosAtom: TAtomPosition;
5582 begin
5583 Result:=-1;
5584 {$IFDEF CTDEBUG}
5585 DebugLn('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',dbgs(StartPos),' ',AClassName,':',AVarName);
5586 {$ENDIF}
5587 if not InitCurCodeTool(Code) then exit;
5588 try
5589 Result:=FCurCodeTool.FindCreateFormStatement(StartPos,AClassName,
5590 AVarName,PosAtom);
5591 if Result<>-1 then
5592 Position:=PosAtom.StartPos;
5593 except
5594 on e: Exception do HandleException(e);
5595 end;
5596 end;
5597
TCodeToolManager.AddCreateFormStatementnull5598 function TCodeToolManager.AddCreateFormStatement(Code: TCodeBuffer;
5599 const AClassName, AVarName: string): boolean;
5600 begin
5601 Result:=false;
5602 {$IFDEF CTDEBUG}
5603 DebugLn('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
5604 {$ENDIF}
5605 if not InitCurCodeTool(Code) then exit;
5606 try
5607 Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName,
5608 SourceChangeCache);
5609 except
5610 on e: Exception do Result:=HandleException(e);
5611 end;
5612 end;
5613
TCodeToolManager.RemoveCreateFormStatementnull5614 function TCodeToolManager.RemoveCreateFormStatement(Code: TCodeBuffer;
5615 const AVarName: string): boolean;
5616 begin
5617 Result:=false;
5618 {$IFDEF CTDEBUG}
5619 DebugLn('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
5620 {$ENDIF}
5621 if not InitCurCodeTool(Code) then exit;
5622 try
5623 Result:=FCurCodeTool.RemoveCreateFormStatement(AVarName,SourceChangeCache);
5624 except
5625 on e: Exception do Result:=HandleException(e);
5626 end;
5627 end;
5628
TCodeToolManager.ChangeCreateFormStatementnull5629 function TCodeToolManager.ChangeCreateFormStatement(Code: TCodeBuffer;
5630 const OldClassName, OldVarName: string; const NewClassName,
5631 NewVarName: string; OnlyIfExists: boolean): boolean;
5632 begin
5633 Result:=false;
5634 {$IFDEF CTDEBUG}
5635 DebugLn('TCodeToolManager.ChangeCreateFormStatement A ',Code.Filename,
5636 ' ',OldVarName+':',OldClassName,' -> ',NewVarName+':',NewClassName,
5637 ' OnlyIfExists=',dbgs(OnlyIfExists));
5638 {$ENDIF}
5639 if not InitCurCodeTool(Code) then exit;
5640 try
5641 Result:=FCurCodeTool.ChangeCreateFormStatement(-1,OldClassName,OldVarName,
5642 NewClassName,NewVarName,OnlyIfExists,
5643 SourceChangeCache);
5644 except
5645 on e: Exception do Result:=HandleException(e);
5646 end;
5647 end;
5648
ListAllCreateFormStatementsnull5649 function TCodeToolManager.ListAllCreateFormStatements(
5650 Code: TCodeBuffer): TStrings;
5651 begin
5652 Result:=nil;
5653 {$IFDEF CTDEBUG}
5654 DebugLn('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
5655 {$ENDIF}
5656 if not InitCurCodeTool(Code) then exit;
5657 try
5658 Result:=FCurCodeTool.ListAllCreateFormStatements;
5659 except
5660 on e: Exception do HandleException(e);
5661 end;
5662 end;
5663
SetAllCreateFromStatementsnull5664 function TCodeToolManager.SetAllCreateFromStatements(Code: TCodeBuffer;
5665 List: TStrings): boolean;
5666 begin
5667 Result:=false;
5668 {$IFDEF CTDEBUG}
5669 DebugLn('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
5670 {$ENDIF}
5671 if not InitCurCodeTool(Code) then exit;
5672 try
5673 Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
5674 except
5675 on e: Exception do Result:=HandleException(e);
5676 end;
5677 end;
5678
TCodeToolManager.SetApplicationScaledStatementnull5679 function TCodeToolManager.SetApplicationScaledStatement(Code: TCodeBuffer;
5680 const NewScaled: Boolean): boolean;
5681 begin
5682 Result:=false;
5683 {$IFDEF CTDEBUG}
5684 DebugLn('TCodeToolManager.SetApplicationScaledStatement A ',Code.Filename);
5685 {$ENDIF}
5686 if not InitCurCodeTool(Code) then exit;
5687 try
5688 Result:=FCurCodeTool.SetApplicationScaledStatement(NewScaled,
5689 SourceChangeCache);
5690 except
5691 on e: Exception do Result:=HandleException(e);
5692 end;
5693 end;
5694
TCodeToolManager.GetApplicationTitleStatementnull5695 function TCodeToolManager.GetApplicationTitleStatement(Code: TCodeBuffer;
5696 var Title: string): boolean;
5697 var
5698 StartPos, StringConstStartPos, EndPos: integer;
5699 begin
5700 Result:=false;
5701 {$IFDEF CTDEBUG}
5702 DebugLn('TCodeToolManager.GetApplicationTitleStatement A ',Code.Filename);
5703 {$ENDIF}
5704 if not InitCurCodeTool(Code) then exit;
5705 try
5706 Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos,
5707 StringConstStartPos,EndPos);
5708 if StartPos=0 then ;
5709 Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos,
5710 EndPos,Title);
5711 except
5712 on e: Exception do Result:=HandleException(e);
5713 end;
5714 end;
5715
TCodeToolManager.SetApplicationTitleStatementnull5716 function TCodeToolManager.SetApplicationTitleStatement(Code: TCodeBuffer;
5717 const NewTitle: string): boolean;
5718 begin
5719 Result:=false;
5720 {$IFDEF CTDEBUG}
5721 DebugLn('TCodeToolManager.SetApplicationTitleStatement A ',Code.Filename);
5722 {$ENDIF}
5723 if not InitCurCodeTool(Code) then exit;
5724 try
5725 Result:=FCurCodeTool.SetApplicationTitleStatement(NewTitle,
5726 SourceChangeCache);
5727 except
5728 on e: Exception do Result:=HandleException(e);
5729 end;
5730 end;
5731
RemoveApplicationTitleStatementnull5732 function TCodeToolManager.RemoveApplicationTitleStatement(Code: TCodeBuffer
5733 ): boolean;
5734 begin
5735 Result:=false;
5736 {$IFDEF CTDEBUG}
5737 DebugLn('TCodeToolManager.RemoveApplicationTitleStatement A ',Code.Filename);
5738 {$ENDIF}
5739 if not InitCurCodeTool(Code) then exit;
5740 try
5741 Result:=FCurCodeTool.RemoveApplicationTitleStatement(SourceChangeCache);
5742 except
5743 on e: Exception do Result:=HandleException(e);
5744 end;
5745 end;
5746
TCodeToolManager.RenameFormnull5747 function TCodeToolManager.RenameForm(Code: TCodeBuffer; const OldFormName,
5748 OldFormClassName: string; const NewFormName, NewFormClassName: string
5749 ): boolean;
5750 begin
5751 Result:=false;
5752 {$IFDEF CTDEBUG}
5753 DebugLn('TCodeToolManager.RenameForm A ',Code.Filename,
5754 ' OldFormName=',OldFormName,' OldFormClassName=',OldFormClassName,
5755 ' NewFormName=',NewFormName,' NewFormClassName=',NewFormClassName);
5756 {$ENDIF}
5757 if not InitCurCodeTool(Code) then exit;
5758 try
5759 Result:=FCurCodeTool.RenameForm(OldFormName,OldFormClassName,
5760 NewFormName,NewFormClassName,SourceChangeCache);
5761 except
5762 on e: Exception do Result:=HandleException(e);
5763 end;
5764 end;
5765
TCodeToolManager.FindFormAncestornull5766 function TCodeToolManager.FindFormAncestor(Code: TCodeBuffer;
5767 const FormClassName: string; out AncestorClassName: string;
5768 DirtySearch: boolean): boolean;
5769 begin
5770 Result:=false;
5771 {$IFDEF CTDEBUG}
5772 DebugLn('TCodeToolManager.FindFormAncestor A ',Code.Filename,' ',FormClassName);
5773 {$ENDIF}
5774 AncestorClassName:='';
5775 if not InitCurCodeTool(Code) then exit;
5776 try
5777 Result:=FCurCodeTool.FindFormAncestor(FormClassName,AncestorClassName);
5778 except
5779 on e: Exception do Result:=HandleException(e);
5780 end;
5781 if (not Result) and DirtySearch then begin
5782 AncestorClassName:=FindClassAncestorName(Code.Source,FormClassName);
5783 Result:=AncestorClassName<>'';
5784 end;
5785 end;
5786
CompleteComponentnull5787 function TCodeToolManager.CompleteComponent(Code: TCodeBuffer;
5788 AComponent, AncestorComponent: TComponent): boolean;
5789 begin
5790 Result:=false;
5791 {$IFDEF CTDEBUG}
5792 DebugLn('TCodeToolManager.CompleteComponent A ',Code.Filename,' ',AComponent.Name,':',AComponent.ClassName,' ',dbgsName(AncestorComponent));
5793 {$ENDIF}
5794 if not InitCurCodeTool(Code) then exit;
5795 try
5796 Result:=FCurCodeTool.CompleteComponent(AComponent,AncestorComponent,
5797 SourceChangeCache);
5798 except
5799 on e: Exception do Result:=HandleException(e);
5800 end;
5801 end;
5802
PublishedVariableExistsnull5803 function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
5804 const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
5805 begin
5806 Result:=false;
5807 {$IFDEF CTDEBUG}
5808 DebugLn('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
5809 {$ENDIF}
5810 if not InitCurCodeTool(Code) then exit;
5811 try
5812 Result:=FCurCodeTool.FindPublishedVariable(AClassName,
5813 AVarName,ErrorOnClassNotFound)<>nil;
5814 except
5815 on e: Exception do Result:=HandleException(e);
5816 end;
5817 end;
5818
AddPublishedVariablenull5819 function TCodeToolManager.AddPublishedVariable(Code: TCodeBuffer;
5820 const AClassName, VarName, VarType: string): boolean;
5821 begin
5822 Result:=false;
5823 {$IFDEF CTDEBUG}
5824 DebugLn('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
5825 {$ENDIF}
5826 if not InitCurCodeTool(Code) then exit;
5827 try
5828 Result:=FCurCodeTool.AddPublishedVariable(AClassName,
5829 VarName,VarType,SourceChangeCache);
5830 except
5831 on e: Exception do Result:=HandleException(e);
5832 end;
5833 end;
5834
TCodeToolManager.RemovePublishedVariablenull5835 function TCodeToolManager.RemovePublishedVariable(Code: TCodeBuffer;
5836 const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
5837 begin
5838 Result:=false;
5839 {$IFDEF CTDEBUG}
5840 DebugLn('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
5841 {$ENDIF}
5842 if not InitCurCodeTool(Code) then exit;
5843 try
5844 Result:=FCurCodeTool.RemovePublishedVariable(AClassName,
5845 AVarName,ErrorOnClassNotFound,SourceChangeCache);
5846 except
5847 on e: Exception do Result:=HandleException(e);
5848 end;
5849 end;
5850
TCodeToolManager.RenamePublishedVariablenull5851 function TCodeToolManager.RenamePublishedVariable(Code: TCodeBuffer;
5852 const AClassName, OldVariableName, NewVarName, VarType: shortstring;
5853 ErrorOnClassNotFound: boolean): boolean;
5854 begin
5855 Result:=false;
5856 {$IFDEF CTDEBUG}
5857 DebugLn('TCodeToolManager.RenamePublishedVariable A ',Code.Filename,' ',AClassName,' OldVar=',OldVariableName,' NewVar=',NewVarName);
5858 {$ENDIF}
5859 if not InitCurCodeTool(Code) then exit;
5860 try
5861 Result:=FCurCodeTool.RenamePublishedVariable(AClassName,
5862 OldVariableName,NewVarName,VarType,
5863 ErrorOnClassNotFound,SourceChangeCache);
5864 except
5865 on e: Exception do Result:=HandleException(e);
5866 end;
5867 end;
5868
RetypeClassVariablesnull5869 function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer;
5870 const AClassName: string; ListOfReTypes: TStringToStringTree;
5871 ErrorOnClassNotFound: boolean; SearchImplementationToo: boolean): boolean;
5872 begin
5873 Result:=false;
5874 {$IFDEF CTDEBUG}
5875 DebugLn('TCodeToolManager.RetypeClassVariables A ',Code.Filename,' ',AClassName);
5876 {$ENDIF}
5877 if not InitCurCodeTool(Code) then exit;
5878 try
5879 Result:=FCurCodeTool.RetypeClassVariables(AClassName,ListOfReTypes,
5880 ErrorOnClassNotFound,SourceChangeCache,SearchImplementationToo);
5881 except
5882 on e: Exception do Result:=HandleException(e);
5883 end;
5884 end;
5885
FindDanglingComponentEventsnull5886 function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
5887 const AClassName: string; RootComponent: TComponent;
5888 ExceptionOnClassNotFound, SearchInAncestors: boolean; out
5889 ListOfPInstancePropInfo: TFPList;
5890 const OverrideGetMethodName: TOnGetMethodname): boolean;
5891 begin
5892 Result:=false;
5893 {$IFDEF CTDEBUG}
5894 DebugLn('TCodeToolManager.FindDanglingComponentEvents A ',Code.Filename,' ',AClassName);
5895 {$ENDIF}
5896 ListOfPInstancePropInfo:=nil;
5897 if not InitCurCodeTool(Code) then exit;
5898 try
5899 Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent,
5900 ExceptionOnClassNotFound,SearchInAncestors,
5901 ListOfPInstancePropInfo,OverrideGetMethodName);
5902 except
5903 on e: Exception do Result:=HandleException(e);
5904 end;
5905 end;
5906
TCodeToolManager.ConvertDelphiToLazarusSourcenull5907 function TCodeToolManager.ConvertDelphiToLazarusSource(Code: TCodeBuffer;
5908 AddLRSCode: boolean): boolean;
5909 begin
5910 Result:=false;
5911 {$IFDEF CTDEBUG}
5912 DebugLn('TCodeToolManager.ConvertDelphiToLazarusSource A ',Code.Filename);
5913 {$ENDIF}
5914 if not InitCurCodeTool(Code) then exit;
5915 try
5916 Result:=FCurCodeTool.ConvertDelphiToLazarusSource(AddLRSCode,
5917 SourceChangeCache);
5918 except
5919 on e: Exception do Result:=HandleException(e);
5920 end;
5921 end;
5922
TCodeToolManager.DoOnFindUsedUnitnull5923 function TCodeToolManager.DoOnFindUsedUnit(SrcTool: TFindDeclarationTool;
5924 const TheUnitName, TheUnitInFilename: string): TCodeBuffer;
5925 begin
5926 if Assigned(OnSearchUsedUnit) then
5927 Result:=OnSearchUsedUnit(SrcTool.MainFilename,
5928 TheUnitName,TheUnitInFilename)
5929 else
5930 Result:=nil;
5931 end;
5932
5933 procedure TCodeToolManager.DoOnGatherUserIdentifiers(
5934 Sender: TIdentCompletionTool; const ContextFlags: TIdentifierListContextFlags);
5935 begin
5936 if Assigned(FOnGatherUserIdentifiers) then
5937 FOnGatherUserIdentifiers(Sender, ContextFlags);
5938 end;
5939
TCodeToolManager.DoOnGetSrcPathForCompiledUnitnull5940 function TCodeToolManager.DoOnGetSrcPathForCompiledUnit(Sender: TObject;
5941 const AFilename: string): string;
5942 begin
5943 if FilenameExtIs(AFilename,'ppu',true) then
5944 Result:=GetPPUSrcPathForDirectory(ExtractFilePath(AFilename))
5945 else if FilenameExtIs(AFilename,'dcu') then
5946 Result:=GetDCUSrcPathForDirectory(ExtractFilePath(AFilename))
5947 else
5948 Result:='';
5949 if Result='' then
5950 Result:=GetCompiledSrcPathForDirectory(ExtractFilePath(AFilename));
5951 end;
5952
DoOnInternalGetMethodNamenull5953 function TCodeToolManager.DoOnInternalGetMethodName(const AMethod: TMethod;
5954 CheckOwner: TObject): string;
5955 begin
5956 if Assigned(OnGetMethodName) then
5957 Result:=OnGetMethodName(AMethod,CheckOwner)
5958 else if (AMethod.Data=nil) or (AMethod.Code=nil) then
5959 Result:=''
5960 else if (CheckOwner<>nil) and (TObject(AMethod.Data)<>CheckOwner) then
5961 Result:=''
5962 else
5963 Result:=TObject(AMethod.Data).MethodName(AMethod.Code);
5964 end;
5965
TCodeToolManager.DoOnParserProgressnull5966 function TCodeToolManager.DoOnParserProgress(Tool: TCustomCodeTool): boolean;
5967 begin
5968 Result:=true;
5969 if not FAbortable then exit;
5970 if not Assigned(OnCheckAbort) then exit;
5971 Result:=not OnCheckAbort();
5972 end;
5973
5974 procedure TCodeToolManager.DoOnRescanFPCDirectoryCache(Sender: TObject);
5975 begin
5976 if Assigned(FOnRescanFPCDirectoryCache) then
5977 FOnRescanFPCDirectoryCache(Sender);
5978 end;
5979
5980 procedure TCodeToolManager.DoOnToolTreeChange(Tool: TCustomCodeTool;
5981 NodesDeleting: boolean);
5982 var
5983 i: Integer;
5984 begin
5985 CTIncreaseChangeStamp(FCodeNodeTreeChangeStep);
5986 if NodesDeleting then begin
5987 CTIncreaseChangeStamp(FCodeTreeNodesDeletedStep);
5988 // Note: IdentifierList nodes do not need to be cleared, because Node
5989 // is accessed via GetNode, which checks if nodes were deleted
5990 end;
5991 //debugln(['TCodeToolManager.OnToolTreeChange ',FHandlers[ctmOnToolTreeChanging].Count]);
5992 i:=FHandlers[ctmOnToolTreeChanging].Count;
5993 while FHandlers[ctmOnToolTreeChanging].NextDownIndex(i) do
5994 TOnToolTreeChanging(FHandlers[ctmOnToolTreeChanging][i])(Tool,NodesDeleting);
5995 end;
5996
DoOnScannerProgressnull5997 function TCodeToolManager.DoOnScannerProgress(Sender: TLinkScanner): boolean;
5998 begin
5999 Result:=true;
6000 if not FAbortable then exit;
6001 if not Assigned(OnCheckAbort) then exit;
6002 Result:=not OnCheckAbort();
6003 end;
6004
6005 procedure TCodeToolManager.DoOnFABGetNestedComments(Sender: TObject;
6006 Code: TCodeBuffer; out NestedComments: boolean);
6007 begin
6008 NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
6009 end;
6010
6011 procedure TCodeToolManager.DoOnFABGetExamples(Sender: TObject; Code: TCodeBuffer;
6012 Step: integer; var CodeBuffers: TFPList; var ExpandedFilenames: TStrings);
6013 begin
6014 if Assigned(OnGetIndenterExamples) then
6015 OnGetIndenterExamples(Sender,Code,Step,CodeBuffers,ExpandedFilenames);
6016 end;
6017
6018 procedure TCodeToolManager.DoOnLoadFileForTool(Sender: TObject;
6019 const ExpandedFilename: string; out Code: TCodeBuffer; var Abort: boolean);
6020 begin
6021 Code:=LoadFile(ExpandedFilename,true,false);
6022 end;
6023
TCodeToolManager.DoOnScannerGetInitValuesnull6024 function TCodeToolManager.DoOnScannerGetInitValues(Scanner: TLinkScanner;
6025 Code: Pointer; out AChangeStep: integer): TExpressionEvaluator;
6026 begin
6027 Result:=nil;
6028 AChangeStep:=DefineTree.ChangeStep;
6029 if Code=nil then exit;
6030 //DefineTree.WriteDebugReport;
6031 if not TCodeBuffer(Code).IsVirtual then
6032 Result:=DefineTree.GetDefinesForDirectory(
6033 ExtractFilePath(TCodeBuffer(Code).Filename),false)
6034 else
6035 Result:=DefineTree.GetDefinesForVirtualDirectory;
6036 if Assigned(OnScannerInit) then
6037 OnScannerInit(Self,Scanner);
6038 end;
6039
6040 procedure TCodeToolManager.DoOnDefineTreeReadValue(Sender: TObject;
6041 const VariableName: string; var Value: string; var Handled: boolean);
6042 begin
6043 Handled:=GlobalValues.IsDefined(VariableName);
6044 if Handled then
6045 Value:=GlobalValues[VariableName];
6046 //DebugLn('[TCodeToolManager.OnDefineTreeReadValue] Name="',VariableName,'" = "',Value,'"');
6047 end;
6048
6049 procedure TCodeToolManager.DoOnGlobalValuesChanged;
6050 begin
6051 DefineTree.ClearCache;
6052 end;
6053
6054 procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean);
6055 begin
6056 if NewValue=FCheckFilesOnDisk then exit;
6057 FCheckFilesOnDisk:=NewValue;
6058 if FCurCodeTool<>nil then
6059 FCurCodeTool.CheckFilesOnDisk:=NewValue;
6060 end;
6061
6062 procedure TCodeToolManager.SetCodeCompletionTemplateFileName(AValue: String);
6063 var
6064 OldValue: String;
6065 Code: TCodeBuffer;
6066 begin
6067 AValue:=CleanAndExpandFilename(AValue);
6068 if FCodeCompletionTemplateFileName=AValue then Exit;
6069 OldValue:=FCodeCompletionTemplateFileName;
6070 FCodeCompletionTemplateFileName:=AValue;
6071 if CompareFilenames(FCodeCompletionTemplateFileName,OldValue)=0 then exit;
6072 if (FCodeCompletionTemplateFileName<>'') then
6073 Code:=LoadFile(FCodeCompletionTemplateFileName,true,false)
6074 else
6075 Code:=nil;
6076 if Code<>nil then begin
6077 if CTTemplateExpander=nil then
6078 CTTemplateExpander:=TTemplateExpander.Create;
6079 CTTemplateExpander.Code:=Code;
6080 end else begin
6081 FreeAndNil(CTTemplateExpander);
6082 end;
6083 end;
6084
6085 procedure TCodeToolManager.SetCompleteProperties(const AValue: boolean);
6086 begin
6087 if CompleteProperties=AValue then exit;
6088 FCompleteProperties:=AValue;
6089 if FCurCodeTool<>nil then
6090 FCurCodeTool.CompleteProperties:=AValue;
6091 end;
6092
6093 procedure TCodeToolManager.SetIndentSize(NewValue: integer);
6094 begin
6095 if NewValue=FIndentSize then exit;
6096 FIndentSize:=NewValue;
6097 if FCurCodeTool<>nil then
6098 FCurCodeTool.IndentSize:=NewValue;
6099 SourceChangeCache.BeautifyCodeOptions.Indent:=NewValue;
6100 end;
6101
6102 procedure TCodeToolManager.SetTabWidth(const AValue: integer);
6103 begin
6104 if FTabWidth=AValue then exit;
6105 FTabWidth:=AValue;
6106 SourceChangeCache.BeautifyCodeOptions.TabWidth:=AValue;
6107 Indenter.DefaultTabWidth:=AValue;
6108 end;
6109
6110 procedure TCodeToolManager.SetUseTabs(AValue: boolean);
6111 begin
6112 if FUseTabs=AValue then Exit;
6113 FUseTabs:=AValue;
6114 SourceChangeCache.BeautifyCodeOptions.UseTabs:=UseTabs;
6115 end;
6116
6117 procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer);
6118 begin
6119 if NewValue=FVisibleEditorLines then exit;
6120 FVisibleEditorLines:=NewValue;
6121 if FCurCodeTool<>nil then
6122 FCurCodeTool.VisibleEditorLines:=NewValue;
6123 end;
6124
6125 procedure TCodeToolManager.SetJumpSingleLinePos(NewValue: integer);
6126 begin
6127 if NewValue=FJumpSingleLinePos then exit;
6128 FJumpSingleLinePos:=NewValue;
6129 if FCurCodeTool<>nil then
6130 FCurCodeTool.JumpSingleLinePos:=NewValue;
6131 end;
6132
6133 procedure TCodeToolManager.SetJumpCodeBlockPos(NewValue: integer);
6134 begin
6135 if NewValue=FJumpCodeBlockPos then exit;
6136 FJumpCodeBlockPos:=NewValue;
6137 if FCurCodeTool<>nil then
6138 FCurCodeTool.JumpCodeBlockPos:=NewValue;
6139 end;
6140
6141 procedure TCodeToolManager.SetSetPropertyVariableIsPrefix(aValue: Boolean);
6142 begin
6143 if FSetPropertyVariableIsPrefix = aValue then Exit;
6144 FSetPropertyVariableIsPrefix := aValue;
6145 end;
6146
6147 procedure TCodeToolManager.SetSetPropertyVariablename(AValue: string);
6148 begin
6149 if FSetPropertyVariablename=aValue then Exit;
6150 FSetPropertyVariablename:=aValue;
6151 end;
6152
6153 procedure TCodeToolManager.SetSetPropertyVariableUseConst(aValue: Boolean);
6154 begin
6155 if FSetPropertyVariableUseConst = aValue then Exit;
6156 FSetPropertyVariableUseConst := aValue;
6157 end;
6158
6159 procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean);
6160 begin
6161 if NewValue=FCursorBeyondEOL then exit;
6162 FCursorBeyondEOL:=NewValue;
6163 if FCurCodeTool<>nil then
6164 FCurCodeTool.CursorBeyondEOL:=NewValue;
6165 end;
6166
6167 procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean);
6168 begin
6169 IncreaseChangeStep;
6170 if Assigned(FOnBeforeApplyChanges) then
6171 FOnBeforeApplyChanges(Self,Abort);
6172 end;
6173
6174 procedure TCodeToolManager.AfterApplyingChanges;
6175 begin
6176 // clear all codetrees of changed buffers
6177 if FCurCodeTool<>nil then
6178 FCurCodeTool.Clear;
6179
6180 // user callback
6181 if Assigned(FOnAfterApplyChanges) then
6182 FOnAfterApplyChanges(Self);
6183 end;
6184
FindCodeToolForSourcenull6185 function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer
6186 ): TCustomCodeTool;
6187 var
6188 ANode: TAVLTreeNode;
6189 CurSrc, SearchedSrc: Pointer;
6190 begin
6191 ANode:=FPascalTools.Root;
6192 SearchedSrc:=Pointer(Code);
6193 while (ANode<>nil) do begin
6194 CurSrc:=Pointer(TCustomCodeTool(ANode.Data).Scanner.MainCode);
6195 if CurSrc>SearchedSrc then
6196 ANode:=ANode.Left
6197 else if CurSrc<SearchedSrc then
6198 ANode:=ANode.Right
6199 else begin
6200 Result:=TCustomCodeTool(ANode.Data);
6201 exit;
6202 end;
6203 end;
6204 Result:=nil;
6205 end;
6206
6207 procedure TCodeToolManager.SetError(Id: int64; Code: TCodeBuffer; Line,
6208 Column: integer; const TheMessage: string);
6209 begin
6210 FErrorId:=Id;
6211 FErrorMsg:=TheMessage;
6212 FErrorCode:=Code;
6213 FErrorLine:=Line;
6214 FErrorColumn:=Column;
6215 FErrorTopLine:=FErrorLine;
6216 AdjustErrorTopLine;
6217 WriteError;
6218 end;
6219
TCodeToolManager.GetCodeToolForSourcenull6220 function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
6221 GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
6222 // return a codetool for the source
6223 begin
6224 Result:=nil;
6225 if Code=nil then begin
6226 if ExceptionOnError then
6227 raise Exception.Create('TCodeToolManager.GetCodeToolForSource '
6228 +'internal error: Code=nil');
6229 exit;
6230 end;
6231 if GoToMainCode then
6232 Code:=GetMainCode(Code);
6233 Result:=FindCodeToolForSource(Code);
6234 if Result=nil then begin
6235 CreateScanner(Code);
6236 if Code.Scanner=nil then begin
6237 if ExceptionOnError then
6238 raise ECodeToolManagerError.CreateFmt(20170422131430,ctsNoScannerFound,[Code.Filename]);
6239 exit;
6240 end;
6241 Result:=TCodeTool.Create;
6242 Result.Scanner:=Code.Scanner;
6243 FPascalTools.Add(Result);
6244 TCodeTool(Result).Beautifier:=SourceChangeCache.BeautifyCodeOptions;
6245 TCodeTool(Result).OnGetCodeToolForBuffer:=@DoOnGetCodeToolForBuffer;
6246 TCodeTool(Result).OnGetDirectoryCache:=@DoOnGetDirectoryCache;
6247 TCodeTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
6248 TCodeTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
6249 TCodeTool(Result).OnGetMethodName:=@DoOnInternalGetMethodName;
6250 TCodeTool(Result).OnRescanFPCDirectoryCache:=@DoOnRescanFPCDirectoryCache;
6251 TCodeTool(Result).OnGatherUserIdentifiers:=@DoOnGatherUserIdentifiers;
6252 TCodeTool(Result).DirectoryCache:=
6253 DirectoryCachePool.GetCache(ExtractFilePath(Code.Filename),
6254 true,true);
6255 Result.OnSetGlobalWriteLock:=@DoOnToolSetWriteLock;
6256 Result.OnTreeChange:=@DoOnToolTreeChange;
6257 TCodeTool(Result).OnParserProgress:=@DoOnParserProgress;
6258 end;
6259 with TCodeTool(Result) do begin
6260 AdjustTopLineDueToComment:=Self.AdjustTopLineDueToComment;
6261 AddInheritedCodeToOverrideMethod:=Self.AddInheritedCodeToOverrideMethod;
6262 CompleteProperties:=Self.CompleteProperties;
6263 SetPropertyVariablename:=Self.SetPropertyVariablename;
6264 SetPropertyVariableIsPrefix:=Self.SetPropertyVariableIsPrefix;
6265 SetPropertyVariableUseConst:=Self.SetPropertyVariableUseConst;
6266 end;
6267 Result.CheckFilesOnDisk:=FCheckFilesOnDisk;
6268 Result.IndentSize:=FIndentSize;
6269 Result.VisibleEditorLines:=FVisibleEditorLines;
6270 Result.JumpSingleLinePos:=FJumpSingleLinePos;
6271 Result.JumpCodeBlockPos:=FJumpCodeBlockPos;
6272 Result.CursorBeyondEOL:=FCursorBeyondEOL;
6273 end;
6274
FindDirectivesToolForSourcenull6275 function TCodeToolManager.FindDirectivesToolForSource(Code: TCodeBuffer
6276 ): TDirectivesTool;
6277 var
6278 ANode: TAVLTreeNode;
6279 CurSrc, SearchedSrc: Pointer;
6280 begin
6281 ANode:=FDirectivesTools.Root;
6282 SearchedSrc:=Pointer(Code);
6283 while (ANode<>nil) do begin
6284 CurSrc:=Pointer(TDirectivesTool(ANode.Data).Code);
6285 if CurSrc>SearchedSrc then
6286 ANode:=ANode.Left
6287 else if CurSrc<SearchedSrc then
6288 ANode:=ANode.Right
6289 else begin
6290 Result:=TDirectivesTool(ANode.Data);
6291 exit;
6292 end;
6293 end;
6294 Result:=nil;
6295 end;
6296
6297 procedure TCodeToolManager.ClearCurDirectivesTool;
6298 begin
6299 ClearError;
6300 FCurDirectivesTool:=nil;
6301 end;
6302
TCodeToolManager.InitCurDirectivesToolnull6303 function TCodeToolManager.InitCurDirectivesTool(Code: TCodeBuffer): boolean;
6304 begin
6305 Result:=false;
6306 ClearCurDirectivesTool;
6307 FCurDirectivesTool:=TDirectivesTool(GetDirectivesToolForSource(Code,true));
6308 {$IFDEF CTDEBUG}
6309 DebugLn('[TCodeToolManager.InitCurDirectivesTool] ',Code.Filename,' ',dbgs(Code.SourceLength));
6310 {$ENDIF}
6311 Result:=true;
6312 end;
6313
TCodeToolManager.GetDirectivesToolForSourcenull6314 function TCodeToolManager.GetDirectivesToolForSource(Code: TCodeBuffer;
6315 ExceptionOnError: boolean): TCompilerDirectivesTree;
6316 begin
6317 if ExceptionOnError then ;
6318 Result:=FindDirectivesToolForSource(Code);
6319 if Result=nil then begin
6320 Result:=TDirectivesTool.Create;
6321 Result.Code:=Code;
6322 FDirectivesTools.Add(Result);
6323 end;
6324 Result.NestedComments:=GetNestedCommentsFlagForFile(Code.Filename);
6325 end;
6326
6327 procedure TCodeToolManager.SetAbortable(const AValue: boolean);
6328 begin
6329 if FAbortable=AValue then exit;
6330 FAbortable:=AValue;
6331 end;
6332
6333 procedure TCodeToolManager.SetAddInheritedCodeToOverrideMethod(
6334 const AValue: boolean);
6335 begin
6336 if FAddInheritedCodeToOverrideMethod=AValue then exit;
6337 FAddInheritedCodeToOverrideMethod:=AValue;
6338 if FCurCodeTool<>nil then
6339 FCurCodeTool.AddInheritedCodeToOverrideMethod:=AValue;
6340 end;
6341
DoOnGetCodeToolForBuffernull6342 function TCodeToolManager.DoOnGetCodeToolForBuffer(Sender: TObject;
6343 Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
6344 begin
6345 {$IFDEF CTDEBUG}
6346 DbgOut('[TCodeToolManager.OnGetCodeToolForBuffer]');
6347 if Sender is TCustomCodeTool then
6348 DbgOut(' Sender=',TCustomCodeTool(Sender).MainFilename);
6349 debugln(' Code=',Code.Filename);
6350 {$ENDIF}
6351 Result:=TFindDeclarationTool(GetCodeToolForSource(Code,GoToMainCode,true));
6352 end;
6353
TCodeToolManager.DoOnGetDirectoryCachenull6354 function TCodeToolManager.DoOnGetDirectoryCache(const ADirectory: string
6355 ): TCTDirectoryCache;
6356 begin
6357 Result:=DirectoryCachePool.GetCache(ADirectory,true,true);
6358 end;
6359
6360 procedure TCodeToolManager.ActivateWriteLock;
6361 begin
6362 if FWriteLockCount=0 then begin
6363 // start a new write lock
6364 if FWriteLockStep<>$7fffffff then
6365 inc(FWriteLockStep)
6366 else
6367 FWriteLockStep:=-$7fffffff;
6368 SourceCache.GlobalWriteLockIsSet:=true;
6369 SourceCache.GlobalWriteLockStep:=FWriteLockStep;
6370 end;
6371 inc(FWriteLockCount);
6372 {$IFDEF CTDEBUG}
6373 DebugLn('[TCodeToolManager.ActivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
6374 {$ENDIF}
6375 end;
6376
6377 procedure TCodeToolManager.DeactivateWriteLock;
6378 begin
6379 if FWriteLockCount>0 then begin
6380 dec(FWriteLockCount);
6381 if FWriteLockCount=0 then begin
6382 // end the write lock
6383 if FWriteLockStep<>$7fffffff then
6384 inc(FWriteLockStep)
6385 else
6386 FWriteLockStep:=-$7fffffff;
6387 SourceCache.GlobalWriteLockIsSet:=false;
6388 SourceCache.GlobalWriteLockStep:=FWriteLockStep;
6389 end;
6390 end;
6391 {$IFDEF CTDEBUG}
6392 DebugLn('[TCodeToolManager.DeactivateWriteLock] FWriteLockCount=',dbgs(FWriteLockCount),' FWriteLockStep=',dbgs(FWriteLockStep));
6393 {$ENDIF}
6394 end;
6395
6396 procedure TCodeToolManager.IncreaseChangeStep;
6397 begin
6398 if FChangeStep<>High(Integer) then
6399 inc(FChangeStep)
6400 else
6401 FChangeStep:=Low(Integer);
6402 end;
6403
6404 procedure TCodeToolManager.GetCodeTreeNodesDeletedStep(out
6405 NodesDeletedStep: integer);
6406 begin
6407 NodesDeletedStep:=FCodeTreeNodesDeletedStep;
6408 end;
6409
6410 procedure TCodeToolManager.AddHandlerToolTreeChanging(
6411 const OnToolTreeChanging: TOnToolTreeChanging);
6412 begin
6413 AddHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
6414 end;
6415
6416 procedure TCodeToolManager.RemoveHandlerToolTreeChanging(
6417 const OnToolTreeChanging: TOnToolTreeChanging);
6418 begin
6419 RemoveHandler(ctmOnToolTreeChanging,TMethod(OnToolTreeChanging));
6420 end;
6421
GetResourceToolnull6422 function TCodeToolManager.GetResourceTool: TResourceCodeTool;
6423 begin
6424 if FResourceTool=nil then FResourceTool:=TResourceCodeTool.Create;
6425 Result:=FResourceTool;
6426 end;
6427
GetOwnerForCodeTreeNodenull6428 function TCodeToolManager.GetOwnerForCodeTreeNode(ANode: TCodeTreeNode
6429 ): TObject;
6430 var
6431 AToolNode: TAVLTreeNode;
6432 CurTool: TCustomCodeTool;
6433 RootCodeTreeNode: TCodeTreeNode;
6434 CurDirTool: TCompilerDirectivesTree;
6435 begin
6436 Result:=nil;
6437 if ANode=nil then exit;
6438 RootCodeTreeNode:=ANode.GetRoot;
6439
6440 // search in codetools
6441 AToolNode:=FPascalTools.FindLowest;
6442 while (AToolNode<>nil) do begin
6443 CurTool:=TCustomCodeTool(AToolNode.Data);
6444 if (CurTool.Tree<>nil) and (CurTool.Tree.Root=RootCodeTreeNode) then begin
6445 Result:=CurTool;
6446 exit;
6447 end;
6448 AToolNode:=FPascalTools.FindSuccessor(AToolNode);
6449 end;
6450
6451 // search in directivestools
6452 AToolNode:=FDirectivesTools.FindLowest;
6453 while (AToolNode<>nil) do begin
6454 CurDirTool:=TCompilerDirectivesTree(AToolNode.Data);
6455 if (CurDirTool.Tree<>nil) and (CurDirTool.Tree.Root=RootCodeTreeNode) then
6456 begin
6457 Result:=CurDirTool;
6458 exit;
6459 end;
6460 AToolNode:=FDirectivesTools.FindSuccessor(AToolNode);
6461 end;
6462 end;
6463
TCodeToolManager.DirectoryCachePoolGetStringnull6464 function TCodeToolManager.DirectoryCachePoolGetString(const ADirectory: string;
6465 const AStringType: TCTDirCacheString): string;
6466 begin
6467 case AStringType of
6468 ctdcsUnitPath: Result:=GetUnitPathForDirectory(ADirectory,false);
6469 ctdcsSrcPath: Result:=GetSrcPathForDirectory(ADirectory,false);
6470 ctdcsIncludePath: Result:=GetIncludePathForDirectory(ADirectory,false);
6471 ctdcsCompleteSrcPath: Result:=GetCompleteSrcPathForDirectory(ADirectory,false);
6472 ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false);
6473 ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false);
6474 ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false);
6475 ctdcsNamespaces: Result:=GetNamespacesForDirectory(ADirectory,false);
6476 else RaiseCatchableException('');
6477 end;
6478 end;
6479
TCodeToolManager.DirectoryCachePoolFindVirtualFilenull6480 function TCodeToolManager.DirectoryCachePoolFindVirtualFile(
6481 const Filename: string): string;
6482 var
6483 Code: TCodeBuffer;
6484 begin
6485 Result:='';
6486 if (Filename='') or (System.Pos(PathDelim,Filename)>0) then
6487 exit;
6488 Code:=FindFile(Filename);
6489 if Code<>nil then
6490 Result:=Code.Filename;
6491 end;
6492
DirectoryCachePoolGetUnitFromSetnull6493 function TCodeToolManager.DirectoryCachePoolGetUnitFromSet(const UnitSet,
6494 AnUnitName: string; SrcSearchRequiresPPU: boolean): string;
6495 var
6496 Changed: boolean;
6497 UnitSetCache: TFPCUnitSetCache;
6498 begin
6499 Result:='';
6500 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6501 if UnitSetCache=nil then begin
6502 debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6503 exit;
6504 end;
6505 if Changed then begin
6506 debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6507 exit;
6508 end;
6509 Result:=UnitSetCache.GetUnitSrcFile(AnUnitName,SrcSearchRequiresPPU);
6510 end;
6511
DirectoryCachePoolGetCompiledUnitFromSetnull6512 function TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet(
6513 const UnitSet, AnUnitName: string): string;
6514 var
6515 Changed: boolean;
6516 UnitSetCache: TFPCUnitSetCache;
6517 begin
6518 Result:='';
6519 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6520 if UnitSetCache=nil then begin
6521 debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6522 exit;
6523 end;
6524 if Changed then begin
6525 debugln(['TCodeToolManager.DirectoryCachePoolGetCompiledUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6526 exit;
6527 end;
6528 Result:=UnitSetCache.GetCompiledUnitFile(AnUnitName);
6529 end;
6530
6531 procedure TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet(
6532 const UnitSet: string; const Iterate: TCTOnIterateFile);
6533 var
6534 Changed: boolean;
6535 UnitSetCache: TFPCUnitSetCache;
6536 aConfigCache: TPCTargetConfigCache;
6537 Node: TAVLTreeNode;
6538 Item: PStringToStringItem;
6539 begin
6540 UnitSetCache:=CompilerDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
6541 if UnitSetCache=nil then begin
6542 debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
6543 exit;
6544 end;
6545 if Changed then begin
6546 debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
6547 exit;
6548 end;
6549 aConfigCache:=UnitSetCache.GetConfigCache(false);
6550 if (aConfigCache=nil) or (aConfigCache.Units=nil) then exit;
6551 Node:=aConfigCache.Units.Tree.FindLowest;
6552 while Node<>nil do begin
6553 Item:=PStringToStringItem(Node.Data);
6554 Iterate(Item^.Value);
6555 Node:=aConfigCache.Units.Tree.FindSuccessor(Node);
6556 end;
6557 end;
6558
6559 procedure TCodeToolManager.AddHandler(HandlerType: TCodeToolManagerHandler;
6560 const Handler: TMethod);
6561 begin
6562 if Handler.Code=nil then RaiseCatchableException('TCodeToolManager.AddHandler');
6563 if FHandlers[HandlerType]=nil then
6564 FHandlers[HandlerType]:=TMethodList.Create;
6565 FHandlers[HandlerType].Add(Handler);
6566 end;
6567
6568 procedure TCodeToolManager.RemoveHandler(HandlerType: TCodeToolManagerHandler;
6569 const Handler: TMethod);
6570 begin
6571 FHandlers[HandlerType].Remove(Handler);
6572 end;
6573
6574 procedure TCodeToolManager.DoOnToolSetWriteLock(Lock: boolean);
6575 begin
6576 if Lock then ActivateWriteLock else DeactivateWriteLock;
6577 end;
6578
6579 procedure TCodeToolManager.DoOnToolGetChangeSteps(out SourcesChangeStep,
6580 FilesChangeStep: int64; out InitValuesChangeStep: integer);
6581 begin
6582 SourcesChangeStep:=SourceCache.ChangeStamp;
6583 FilesChangeStep:=FileStateCache.TimeStamp;
6584 InitValuesChangeStep:=DefineTree.ChangeStep;
6585 end;
6586
6587 procedure TCodeToolManager.ConsistencyCheck;
6588 begin
6589 if FCurCodeTool<>nil then begin
6590 FCurCodeTool.ConsistencyCheck;
6591 end;
6592 DefinePool.ConsistencyCheck;
6593 DefineTree.ConsistencyCheck;
6594 SourceCache.ConsistencyCheck;
6595 GlobalValues.ConsistencyCheck;
6596 SourceChangeCache.ConsistencyCheck;
6597 FPascalTools.ConsistencyCheck;
6598 FDirectivesTools.ConsistencyCheck;
6599 end;
6600
6601 procedure TCodeToolManager.WriteDebugReport(WriteTool,
6602 WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues,
6603 WriteMemStats: boolean);
6604 begin
6605 DebugLn('[TCodeToolManager.WriteDebugReport]');
6606 if FCurCodeTool<>nil then begin
6607 if WriteTool then begin
6608 FCurCodeTool.WriteDebugTreeReport;
6609 if FCurCodeTool.Scanner<>nil then
6610 FCurCodeTool.Scanner.WriteDebugReport;
6611 end;
6612 end;
6613 if WriteDefPool then
6614 DefinePool.WriteDebugReport
6615 else
6616 DefinePool.ConsistencyCheck;
6617 if WriteDefTree then
6618 DefineTree.WriteDebugReport
6619 else
6620 DefineTree.ConsistencyCheck;
6621 if WriteCache then
6622 SourceCache.WriteDebugReport
6623 else
6624 SourceCache.ConsistencyCheck;
6625 if WriteGlobalValues then
6626 GlobalValues.WriteDebugReport
6627 else
6628 GlobalValues.ConsistencyCheck;
6629 if WriteMemStats then WriteMemoryStats;
6630
6631 ConsistencyCheck;
6632 end;
6633
6634 procedure TCodeToolManager.WriteMemoryStats;
6635 var
6636 Node: TAVLTreeNode;
6637 ATool: TEventsCodeTool;
6638 Stats: TCTMemStats;
6639 begin
6640 DebugLn(['Memory stats: ']);
6641 Stats:=TCTMemStats.Create;
6642 // boss
6643 Stats.Add('Boss',
6644 PtrUInt(InstanceSize)
6645 +MemSizeString(FErrorMsg)
6646 +MemSizeString(FSetPropertyVariablename)
6647 +PtrUInt(SizeOf(FSetPropertyVariableIsPrefix))
6648 +PtrUInt(SizeOf(FSetPropertyVariableUseConst))
6649 +MemSizeString(FSourceExtensions)
6650 );
6651 if DefinePool<>nil then
6652 DefinePool.CalcMemSize(Stats);
6653 if DefineTree<>nil then
6654 DefineTree.CalcMemSize(Stats);
6655 if SourceCache<>nil then
6656 SourceCache.CalcMemSize(Stats);
6657 if SourceChangeCache<>nil then
6658 SourceChangeCache.CalcMemSize(Stats);
6659 if GlobalValues<>nil then
6660 Stats.Add('GlobalValues',GlobalValues.CalcMemSize);
6661 if DirectoryCachePool<>nil then
6662 DirectoryCachePool.CalcMemSize(Stats);
6663 if IdentifierList<>nil then
6664 Stats.Add('IdentifierList',IdentifierList.CalcMemSize);
6665 if IdentifierHistory<>nil then
6666 Stats.Add('IdentifierHistory',IdentifierHistory.CalcMemSize);
6667 if Positions<>nil then
6668 Stats.Add('Positions',Positions.CalcMemSize);
6669
6670 if FDirectivesTools<>nil then begin
6671 Stats.Add('FDirectivesTools.Count',FDirectivesTools.Count);
6672 // ToDo
6673 end;
6674 if FPascalTools<>nil then begin
6675 Stats.Add('PascalTools.Count',FPascalTools.Count);
6676 Stats.Add('PascalTools',PtrUInt(FPascalTools.Count)*SizeOf(Node));
6677 Node:=FPascalTools.FindLowest;
6678 while Node<>nil do begin
6679 ATool:=TCodeTool(Node.Data);
6680 ATool.CalcMemSize(Stats);
6681 Node:=FPascalTools.FindSuccessor(Node);
6682 end;
6683 end;
6684 Stats.Add('KeywordFuncLists.Global',KeywordFuncLists.CalcMemSize);
6685 Stats.Add('FileStateCache',FileStateCache.CalcMemSize);
6686 Stats.Add('GlobalIdentifierTree',GlobalIdentifierTree.CalcMemSize);
6687 Stats.WriteReport;
6688 Stats.Free;
6689 end;
6690
6691 //-----------------------------------------------------------------------------
6692
FindIncFileInCfgCachenull6693 function FindIncFileInCfgCache(const Name: string; out ExpFilename: string): boolean;
6694 var
6695 CfgCache: TPCTargetConfigCache;
6696 UnitSet: TFPCUnitSetCache;
6697 begin
6698 // search the include file in directories defines in fpc.cfg (by -Fi option)
6699 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
6700 if UnitSet<>nil then begin
6701 CfgCache:=UnitSet.GetConfigCache(false);
6702 Result:=Assigned(CfgCache) and Assigned(CfgCache.Includes)
6703 and CfgCache.Includes.GetString(Name,ExpFilename);
6704 end
6705 else
6706 Result:=False;
6707 end;
6708
6709 initialization
6710 CodeToolBoss:=TCodeToolManager.Create;
6711 OnFindOwnerOfCodeTreeNode:=@GetOwnerForCodeTreeNode;
6712 BasicCodeTools.FindIncFileInCfgCache:=@FindIncFileInCfgCache;
6713
6714
6715 finalization
6716 {$IFDEF CTDEBUG}
6717 DebugLn('codetoolmanager.pas - finalization');
6718 {$ENDIF}
6719 OnFindOwnerOfCodeTreeNode:=nil;
6720 CodeToolBoss.Free;
6721 CodeToolBoss:=nil;
6722 FreeAndNil(CTTemplateExpander);
6723 {$IFDEF CTDEBUG}
6724 DebugLn('codetoolmanager.pas - finalization finished');
6725 {$ENDIF}
6726
6727 end.
6728
6729