1 {
2 /***************************************************************************
3 codeexplorer.pas
4 ----------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Abstract:
28 Window showing the current source as tree structure.
29 Normally it shows the codetools nodes of the current unit in the
30 source editor. If an include file is open, the corresponding unit is shown.
31 }
32 unit CodeExplorer;
33
34 {$mode objfpc}{$H+}
35
36 interface
37
38 {$I ide.inc}
39
40 uses
41 // RTL+FCL
42 Classes, SysUtils, types, Laz_AVL_Tree,
43 // LazUtils
44 LazStringUtils, LazLoggerBase,
45 // LCL
46 LCLProc, LCLType, Forms, Controls, Dialogs, Buttons, ComCtrls, Menus, StdCtrls, ExtCtrls,
47 // CodeTools
48 FileProcs, BasicCodeTools, CustomCodeTool, CodeToolManager, CodeAtom,
49 CodeCache, CodeTree, KeywordFuncLists, FindDeclarationTool, DirectivesTree,
50 PascalParserTool,
51 // IDEIntf
52 LazIDEIntf, IDECommands, MenuIntf, SrcEditorIntf, IDEDialogs, IDEImagesIntf,
53 // IDE
54 LazarusIDEStrConsts, IDEOptionDefs, CodeExplOpts;
55
56 type
57 TCodeExplorerView = class;
58
59 TOnGetDirectivesTree =
60 procedure(Sender: TObject; var ADirectivesTool: TDirectivesTool) of object;
61 TOnJumpToCode = procedure(Sender: TObject; const Filename: string;
62 const Caret: TPoint; TopLine: integer) of object;
63
64 TCodeExplorerViewFlag = (
65 cevCodeRefreshNeeded,
66 cevDirectivesRefreshNeeded,
67 cevRefreshing,
68 cevCheckOnIdle // check if a refresh is needed on next idle
69 );
70 TCodeExplorerViewFlags = set of TCodeExplorerViewFlag;
71
72 TCodeObsStackItemType = (
73 cositNone,
74 cositBegin,
75 cositRepeat,
76 cositTry,
77 cositFinally,
78 cositExcept,
79 cositCase,
80 cositCaseElse,
81 cositRoundBracketOpen,
82 cositEdgedBracketOpen
83 );
84 TCodeObsStackItem = record
85 StartPos: integer;
86 Typ: TCodeObsStackItemType;
87 StatementStartPos: integer;
88 end;
89 TCodeObsStack = ^TCodeObsStackItem;
90
91 { TCodeObserverStatementState }
92
93 TCodeObserverStatementState = class
94 private
GetStatementStartPosnull95 function GetStatementStartPos: integer;
96 procedure SetStatementStartPos(const AValue: integer);
97 public
98 Stack: TCodeObsStack;
99 StackPtr: integer;
100 StackCapacity: integer;
101 IgnoreConstLevel: integer;
102 TopLvlStatementStartPos: integer;
103 destructor Destroy; override;
104 procedure Clear;
105 procedure Reset;
106 procedure Push(Typ: TCodeObsStackItemType; StartPos: integer);
Popnull107 function Pop: TCodeObsStackItemType;
108 procedure PopAll;
TopTypenull109 function TopType: TCodeObsStackItemType;
110 property StatementStartPos: integer read GetStatementStartPos write SetStatementStartPos;
111 end;
112
113 { TCodeExplorerView }
114
115 TCodeExplorerView = class(TForm)
116 CodeFilterEdit: TEdit;
117 CodePage: TTabSheet;
118 CodeTreeview: TTreeView;
119 DirectivesFilterEdit: TEdit;
120 DirectivesPage: TTabSheet;
121 DirectivesTreeView: TTreeView;
122 IdleTimer1: TIdleTimer;
123 Imagelist1: TImageList;
124 MainNotebook: TPageControl;
125 MenuItem1: TMenuItem;
126 CodeTreeviewButtonPanel: TPanel;
127 CodeOptionsSpeedButton: TSpeedButton;
128 CodeRefreshSpeedButton: TSpeedButton;
129 CodeModeSpeedButton: TSpeedButton;
130 DirOptionsSpeedButton: TSpeedButton;
131 DirRefreshSpeedButton: TSpeedButton;
132 TreePopupmenu: TPopupMenu;
133 procedure CodeExplorerViewCreate(Sender: TObject);
134 procedure CodeExplorerViewDestroy(Sender: TObject);
135 procedure CodeFilterEditChange(Sender: TObject);
136 procedure CodeTreeviewMouseDown(Sender: TObject; Button: TMouseButton;
137 {%H-}Shift: TShiftState; X, Y: Integer);
138 procedure DirectivesFilterEditChange(Sender: TObject);
139 procedure DirRefreshSpeedButtonClick(Sender: TObject);
140 procedure FilterEditEnter(Sender: TObject);
141 procedure FormActivate(Sender: TObject);
142 procedure IdleTimer1Timer(Sender: TObject);
143 procedure JumpToMenuItemClick(Sender: TObject);
144 procedure JumpToImplementationMenuItemClick(Sender: TObject);
145 procedure CloseIDEHandler(Sender: TObject);
146 procedure ShowSrcEditPosMenuItemClick(Sender: TObject);
147 procedure MainNotebookPageChanged(Sender: TObject);
148 procedure CodeModeSpeedButtonClick(Sender: TObject);
149 procedure CodeRefreshSpeedButtonClick(Sender: TObject);
150 procedure OptionsSpeedButtonClick(Sender: TObject);
151 procedure RefreshMenuItemClick(Sender: TObject);
152 procedure RenameMenuItemClick(Sender: TObject);
153 procedure TreePopupmenuPopup(Sender: TObject);
154 procedure TreeviewDblClick(Sender: TObject);
155 procedure TreeviewDeletion(Sender: TObject; Node: TTreeNode);
156 procedure TreeviewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
157 procedure UserInputHandler(Sender: TObject; {%H-}Msg: Cardinal);
158 private
159 fCategoryNodes: array[TCodeExplorerCategory] of TTreeNode;
160 FCodeFilename: string;
161 FCodeCmd1, FCodeCmd2, FCodeCmd3: TIDECommand;
162 FDirectivesFilename: string;
163 FFlags: TCodeExplorerViewFlags;
164 FLastCodeChangeStep: integer;
165 FLastCodeFilter: string;
166 fLastCodeOptionsChangeStep: integer;
167 FLastCodeValid: boolean;
168 FLastCodeXY: TPoint;
169 FLastCode: TCodeBuffer;
170 FLastDirectivesChangeStep: integer;
171 FLastDirectivesFilter: string;
172 FLastMode: TCodeExplorerMode;
173 FMode: TCodeExplorerMode;
174 fObserverCatNodes: array[TCEObserverCategory] of TTreeNode;
175 fObserverCatOverflow: array[TCEObserverCategory] of boolean;
176 fObserverNode: TTreeNode;
177 fSurroundingNode: TTreeNode;
178 FOnGetDirectivesTree: TOnGetDirectivesTree;
179 FOnJumpToCode: TOnJumpToCode;
180 FOnShowOptions: TNotifyEvent;
181 fSortCodeTool: TCodeTool;
182 fLastCodeTool: TCodeTool;
183 fCodeSortedForStartPos: TAvlTree;// tree of TTreeNode sorted for TViewNodeData(Node.Data).StartPos, secondary EndPos
184 fNodesWithPath: TAvlTree; // tree of TViewNodeData sorted for Path and Params
185 FUpdateCount: integer;
186 ImgIDClass: Integer;
187 ImgIDClassInterface: Integer;
188 ImgIDRecord: Integer;
189 ImgIDEnum: Integer;
190 ImgIDHelper: Integer;
191 ImgIDConst: Integer;
192 ImgIDSection: Integer;
193 ImgIDDefault: integer;
194 ImgIDFinalization: Integer;
195 ImgIDImplementation: Integer;
196 ImgIDInitialization: Integer;
197 ImgIDInterface: Integer;
198 ImgIDProcedure: Integer;
Integernull199 ImgIDFunction: Integer;
200 ImgIDConstructor: Integer;
201 ImgIDDestructor: Integer;
202 ImgIDProgram: Integer;
203 ImgIDProperty: Integer;
204 ImgIDPropertyReadOnly: Integer;
205 ImgIDType: Integer;
206 ImgIDUnit: Integer;
207 ImgIDVariable: Integer;
208 ImgIDHint: Integer;
209 ImgIDLabel: Integer;
210 procedure AssignAllImages;
211 procedure ClearCodeTreeView;
212 procedure ClearDirectivesTreeView;
GetCodeFilternull213 function GetCodeFilter: string;
GetCurrentPagenull214 function GetCurrentPage: TCodeExplorerPage;
GetDirectivesFilternull215 function GetDirectivesFilter: string;
GetCodeNodeDescriptionnull216 function GetCodeNodeDescription(ACodeTool: TCodeTool;
217 CodeNode: TCodeTreeNode): string;
GetDirectiveNodeDescriptionnull218 function GetDirectiveNodeDescription(ADirectivesTool: TDirectivesTool;
219 Node: TCodeTreeNode): string;
GetCodeNodeImagenull220 function GetCodeNodeImage(Tool: TFindDeclarationTool;
221 CodeNode: TCodeTreeNode): integer;
GetDirectiveNodeImagenull222 function GetDirectiveNodeImage(CodeNode: TCodeTreeNode): integer;
223 procedure CreateIdentifierNodes(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode;
224 ParentViewNode: TTreeNode);
GetCTNodePathnull225 function GetCTNodePath(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode): string;
226 procedure CreateNodePath(ACodeTool: TCodeTool; aNodeData: TObject);
227 procedure AddImplementationNode(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode);
228 procedure CreateDirectiveNodes(ADirectivesTool: TDirectivesTool;
229 CodeNode: TCodeTreeNode; ParentViewNode: TTreeNode);
230 procedure CreateObservations(Tool: TCodeTool);
CreateObserverNodenull231 function CreateObserverNode(Tool: TCodeTool; f: TCEObserverCategory): TTreeNode;
232 procedure CreateObserverNodesForStatement(Tool: TCodeTool;
233 CodeNode: TCodeTreeNode; StartPos, EndPos: integer;
234 ObserverState: TCodeObserverStatementState);
235 procedure FindObserverTodos(Tool: TCodeTool);
236 procedure CreateSurrounding(Tool: TCodeTool);
237 procedure DeleteTVNode(TVNode: TTreeNode);
238 procedure SetCodeFilter(const AValue: string);
239 procedure SetCurrentPage(const AValue: TCodeExplorerPage);
240 procedure SetDirectivesFilter(const AValue: string);
241 procedure SetMode(AMode: TCodeExplorerMode);
242 procedure UpdateMode;
243 procedure UpdateCaption;
OnExpandedStateGetNodeTextnull244 function OnExpandedStateGetNodeText(Node: TTreeNode): string;
245 procedure ApplyCodeFilter;
246 procedure ApplyDirectivesFilter;
CompareCodeNodesnull247 function CompareCodeNodes(Node1, Node2: TTreeNode): integer;
FilterNodenull248 function FilterNode(ANode: TTreeNode; const TheFilter: string;
249 KeepTopLevel: Boolean): boolean;
250 public
251 procedure BeginUpdate;
252 procedure EndUpdate;
253 procedure CheckOnIdle;
254 procedure KeyDown(var Key: Word; Shift: TShiftState); override;
255 procedure Refresh(OnlyVisible: boolean);
256 procedure RefreshCode(OnlyVisible: boolean);
257 procedure RefreshDirectives(OnlyVisible: boolean);
258 procedure ClearCTNodes(ATreeView: TTreeView);// remove temporary references
JumpToSelectionnull259 function JumpToSelection(ToImplementation: boolean = false): boolean; // jump in source editor
SelectSourceEditorNodenull260 function SelectSourceEditorNode: boolean;
SelectCodePositionnull261 function SelectCodePosition(CodeBuf: TCodeBuffer; X, Y: integer): boolean; // select deepest node
FindCodeTVNodeAtCleanPosnull262 function FindCodeTVNodeAtCleanPos(CleanPos: integer): TTreeNode;
263 procedure BuildCodeSortedForStartPos;
264 procedure CurrentCodeBufferChanged;
265 procedure CodeFilterChanged;
266 procedure DirectivesFilterChanged;
FilterFitsnull267 function FilterFits(const NodeText, TheFilter: string): boolean; virtual;
GetCurrentTreeViewnull268 function GetCurrentTreeView: TCustomTreeView;
269 public
270 property OnGetDirectivesTree: TOnGetDirectivesTree read FOnGetDirectivesTree
271 write FOnGetDirectivesTree;
272 property OnJumpToCode: TOnJumpToCode read FOnJumpToCode write FOnJumpToCode;
273 property OnShowOptions: TNotifyEvent read FOnShowOptions write FOnShowOptions;
274 property Mode: TCodeExplorerMode read FMode write SetMode;
275 property CodeFilename: string read FCodeFilename;
276 property CodeFilter: string read GetCodeFilter write SetCodeFilter;
277 property DirectivesFilename: string read FDirectivesFilename;
278 property DirectivesFilter: string read GetDirectivesFilter
279 write SetDirectivesFilter;
280 property CurrentPage: TCodeExplorerPage read GetCurrentPage
281 write SetCurrentPage;
282 end;
283
284 const
285 CodeExplorerMenuRootName = 'Code Explorer';
286 CodeObserverMaxNodes = 50;
287
288 var
289 CodeExplorerView: TCodeExplorerView = nil;
290 CEJumpToIDEMenuCommand: TIDEMenuCommand;
291 CEJumpToImplementationIDEMenuCommand: TIDEMenuCommand;
292 CEShowSrcEditPosIDEMenuCommand: TIDEMenuCommand;
293 CERefreshIDEMenuCommand: TIDEMenuCommand;
294 CERenameIDEMenuCommand: TIDEMenuCommand;
295
296 procedure RegisterStandardCodeExplorerMenuItems;
297
GetToDoCommentnull298 function GetToDoComment(const Src: string;
299 CommentStartPos, CommentEndPos: integer;
300 out MagicStartPos, TextStartPos, TextEndPos: integer): boolean;
301
302 implementation
303
304 {$R *.lfm}
305
306 type
307
308 { TViewNodeData }
309
310 TViewNodeData = class
311 public
312 CTNode: TCodeTreeNode; // only valid during update, at other times it is nil
313 Desc: TCodeTreeNodeDesc;
314 SubDesc: TCodeTreeNodeSubDesc;
315 StartPos, EndPos: integer;
316 Path: string;
317 Params: string;
318 ImplementationNode: TViewNodeData;
319 SortChildren: boolean; // sort for TVNode text (optional) and StartPos, EndPos
320 constructor Create(CodeNode: TCodeTreeNode; SortTheChildren: boolean = true);
321 destructor Destroy; override;
322 procedure CreateParams(ACodeTool: TCodeTool);
323 end;
324
CompareViewNodeDataStartPosnull325 function CompareViewNodeDataStartPos(Node1, Node2: TTreeNode): integer;
326 var
327 NodeData1: TViewNodeData;
328 NodeData2: TViewNodeData;
329 begin
330 NodeData1:=TViewNodeData(Node1.Data);
331 NodeData2:=TViewNodeData(Node2.Data);
332 if NodeData1.StartPos>NodeData2.StartPos then
333 Result:=1
334 else if NodeData1.StartPos<NodeData2.StartPos then
335 Result:=-1
336 else if NodeData1.EndPos>NodeData2.EndPos then
337 Result:=1
338 else if NodeData1.EndPos<NodeData2.EndPos then
339 Result:=-1
340 else
341 Result:=0;
342 end;
343
CompareStartPosWithViewNodeDatanull344 function CompareStartPosWithViewNodeData(Key: PInteger; Node: TTreeNode): integer;
345 var
346 NodeData: TViewNodeData;
347 begin
348 NodeData:=TViewNodeData(Node.Data);
349 if Key^ > NodeData.StartPos then
350 Result:=1
351 else if Key^ < NodeData.StartPos then
352 Result:=-1
353 else
354 Result:=0;
355 end;
356
CompareViewNodePathsAndParamsnull357 function CompareViewNodePathsAndParams(NodeData1, NodeData2: Pointer): integer;
358 var
359 Node1: TViewNodeData absolute NodeData1;
360 Node2: TViewNodeData absolute NodeData2;
361 begin
362 Result:=SysUtils.CompareText(Node1.Path,Node2.Path);
363 if Result<>0 then exit;
364 Result:=SysUtils.CompareText(Node1.Params,Node2.Params);
365 end;
366
CompareViewNodePathsnull367 function CompareViewNodePaths(NodeData1, NodeData2: Pointer): integer;
368 var
369 Node1: TViewNodeData absolute NodeData1;
370 Node2: TViewNodeData absolute NodeData2;
371 begin
372 Result:=SysUtils.CompareText(Node1.Path,Node2.Path);
373 end;
374
375 procedure RegisterStandardCodeExplorerMenuItems;
376 var
377 Path: String;
378 begin
379 CodeExplorerMenuRoot:=RegisterIDEMenuRoot(CodeExplorerMenuRootName);
380 Path:=CodeExplorerMenuRoot.Name;
381 CEJumpToIDEMenuCommand:=RegisterIDEMenuCommand(Path, 'Jump to', lisMenuJumpTo);
382 CEJumpToImplementationIDEMenuCommand:=RegisterIDEMenuCommand(Path,
383 'Jump to implementation', lisMenuJumpToImplementation);
384 CEShowSrcEditPosIDEMenuCommand:=RegisterIDEMenuCommand(Path, 'Show position of source editor',
385 lisShowPositionOfSourceEditor);
386 CERefreshIDEMenuCommand:=RegisterIDEMenuCommand(Path, 'Refresh', dlgUnitDepRefresh);
387 CERenameIDEMenuCommand:=RegisterIDEMenuCommand(Path, 'Rename', lisRename);
388 end;
389
GetToDoCommentnull390 function GetToDoComment(const Src: string; CommentStartPos,
391 CommentEndPos: integer; out MagicStartPos, TextStartPos, TextEndPos: integer
392 ): boolean;
393 var
394 StartPos: Integer;
395 EndPos: Integer;
396 p: Integer;
397 begin
398 if CommentStartPos<1 then exit(false);
399 if CommentEndPos-CommentStartPos<5 then exit(false);
400 if Src[CommentStartPos]='/' then begin
401 StartPos:=CommentStartPos+2;
402 EndPos:=CommentEndPos;
403 end else if (Src[CommentStartPos]='{') then begin
404 StartPos:=CommentStartPos+1;
405 EndPos:=CommentEndPos-1;
406 end else if (CommentStartPos<length(Src)) and (Src[CommentStartPos]='(')
407 and (Src[CommentStartPos+1]='*') then begin
408 StartPos:=CommentStartPos+2;
409 EndPos:=CommentEndPos-2;
410 end else
411 exit(false);
412 while (StartPos<EndPos) and (Src[StartPos]=' ') do inc(StartPos);
413 MagicStartPos:=StartPos;
414 if Src[StartPos]='#' then inc(StartPos);
415 if CompareIdentifiers('todo',@Src[StartPos])<>0 then exit(false);
416 // this is a ToDo
417 p:=StartPos+length('todo');
418 TextStartPos:=p;
419 while (TextStartPos<EndPos) and (Src[TextStartPos]<>':') do inc(TextStartPos);
420 if Src[TextStartPos]=':' then
421 inc(TextStartPos) // a todo with colon syntax
422 else
423 TextStartPos:=p; // a todo without syntax
424 while (TextStartPos<EndPos) and (Src[TextStartPos]=' ') do inc(TextStartPos);
425 TextEndPos:=EndPos;
426 while (TextEndPos>TextStartPos) and (Src[TextEndPos-1]=' ') do dec(TextEndPos);
427 Result:=true;
428 end;
429
430 { TViewNodeData }
431
432 constructor TViewNodeData.Create(CodeNode: TCodeTreeNode;
433 SortTheChildren: boolean);
434 begin
435 CTNode:=CodeNode;
436 Desc:=CodeNode.Desc;
437 SubDesc:=CodeNode.SubDesc;
438 StartPos:=CodeNode.StartPos;
439 EndPos:=CodeNode.EndPos;
440 SortChildren:=SortTheChildren;
441 end;
442
443 destructor TViewNodeData.Destroy;
444 begin
445 FreeAndNil(ImplementationNode);
446 inherited Destroy;
447 end;
448
449 procedure TViewNodeData.CreateParams(ACodeTool: TCodeTool);
450 begin
451 if Params<>'' then exit;
452 if CTNode.Desc=ctnProcedure then begin
453 try
454 Params:=ACodeTool.ExtractProcHead(CTNode,
455 [phpWithoutClassKeyword,phpWithoutClassName,phpWithoutName,phpWithoutSemicolon]);
456 except
457 on E: ECodeToolError do ; // ignore syntax errors
458 end;
459 end;
460 if Params='' then
461 Params:=' ';
462 end;
463
464 { TCodeExplorerView }
465
466 procedure TCodeExplorerView.CodeExplorerViewCreate(Sender: TObject);
467 begin
468 FMode := CodeExplorerOptions.Mode;
469 UpdateMode;
470
471 Name:=NonModalIDEWindowNames[nmiwCodeExplorer];
472 UpdateCaption;
473
474 case CodeExplorerOptions.Page of
475 cepDirectives: MainNotebook.ActivePage:=DirectivesPage;
476 else MainNotebook.ActivePage:=CodePage;
477 end;
478
479 CodePage.Caption:=lisCode;
480 CodeRefreshSpeedButton.Hint:=dlgUnitDepRefresh;
481 CodeOptionsSpeedButton.Hint:=lisOptions;
482 CodeFilterEdit.Text:='';
483 DirectivesPage.Caption:=lisDirectives;
484 DirectivesFilterEdit.Text:='';
485 DirRefreshSpeedButton.Hint:=dlgUnitDepRefresh;
486 DirOptionsSpeedButton.Hint:=lisOptions;
487 CodeFilterEdit.TextHint:=lisCEFilter;
488 DirectivesFilterEdit.TextHint:=lisCEFilter;
489
490 AssignAllImages;
491 // assign the root TMenuItem to the registered menu root.
492 // This will automatically create all registered items
493 CodeExplorerMenuRoot.MenuItem:=TreePopupMenu.Items;
494 //CodeExplorerMenuRoot.Items.WriteDebugReport(' ');
495
496 CEJumpToIDEMenuCommand.OnClick:=@JumpToMenuItemClick;
497 CEJumpToImplementationIDEMenuCommand.OnClick:=@JumpToImplementationMenuItemClick;
498 CEShowSrcEditPosIDEMenuCommand.OnClick:=@ShowSrcEditPosMenuItemClick;
499 CERefreshIDEMenuCommand.OnClick:=@RefreshMenuItemClick;
500 CERenameIDEMenuCommand.OnClick:=@RenameMenuItemClick;
501
502 fNodesWithPath:=TAvlTree.Create(@CompareViewNodePathsAndParams);
503
504 Application.AddOnUserInputHandler(@UserInputHandler);
505 LazarusIDE.AddHandlerOnIDEClose(@CloseIDEHandler);
506 end;
507
508 procedure TCodeExplorerView.CodeExplorerViewDestroy(Sender: TObject);
509 begin
510 //debugln('TCodeExplorerView.CodeExplorerViewDestroy');
511 fLastCodeTool:=nil;
512 FreeAndNil(fNodesWithPath);
513 FreeAndNil(fCodeSortedForStartPos);
514 if CodeExplorerView=Self then
515 CodeExplorerView:=nil;
516 end;
517
518 procedure TCodeExplorerView.CodeFilterEditChange(Sender: TObject);
519 begin
520 CodeFilterChanged;
521 end;
522
523 procedure TCodeExplorerView.CodeTreeviewMouseDown(Sender: TObject;
524 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
525 var
526 Node: TTreeNode;
527 begin
528 if Button=mbMiddle then begin
529 Node:=CodeTreeview.GetNodeAt(X,Y);
530 Node.Selected:=true;
531 JumpToSelection(true);
532 end;
533 end;
534
535 procedure TCodeExplorerView.DirectivesFilterEditChange(Sender: TObject);
536 begin
537 DirectivesFilterChanged;
538 end;
539
540 procedure TCodeExplorerView.DirRefreshSpeedButtonClick(Sender: TObject);
541 begin
542 FLastDirectivesChangeStep:=CTInvalidChangeStamp;
543 RefreshDirectives(true);
544 end;
545
546 procedure TCodeExplorerView.FilterEditEnter(Sender: TObject);
547 begin
548 (Sender as TEdit).SelectAll;
549 end;
550
551 procedure TCodeExplorerView.FormActivate(Sender: TObject);
552 begin
553 //DebugLn(['TCodeExplorerView.FormActivate!']);
554 FCodeCmd1:=IDECommandList.FindIDECommand(ecFindDeclaration);
555 FCodeCmd2:=IDECommandList.FindIDECommand(ecFindProcedureDefinition);
556 FCodeCmd3:=IDECommandList.FindIDECommand(ecFindProcedureMethod);
557 end;
558
559 procedure TCodeExplorerView.IdleTimer1Timer(Sender: TObject);
560 begin
561 if not (cevCheckOnIdle in FFlags) then exit;
562 if (Screen.ActiveCustomForm<>nil)
563 and (fsModal in Screen.ActiveCustomForm.FormState) then
564 begin
565 // do not update while a modal form is shown, except for clear
566 if SourceEditorManagerIntf=nil then exit;
567 if SourceEditorManagerIntf.SourceEditorCount=0 then
568 begin
569 Exclude(FFlags,cevCheckOnIdle);
570 FLastCodeValid:=false;
571 ClearCodeTreeView;
572 FDirectivesFilename:='';
573 ClearDirectivesTreeView;
574 end;
575 exit;
576 end;
577 if not IsVisible then exit;
578 Exclude(FFlags,cevCheckOnIdle);
579 case CurrentPage of
580 cepNone: ;
581 cepCode: if (CurrentPage<>cepCode) or CodeTreeview.Focused then exit;
582 cepDirectives: if (CurrentPage<>cepDirectives) or DirectivesTreeView.Focused then exit;
583 end;
584 Refresh(true);
585 end;
586
587 procedure TCodeExplorerView.JumpToMenuItemClick(Sender: TObject);
588 begin
589 JumpToSelection(false);
590 end;
591
592 procedure TCodeExplorerView.JumpToImplementationMenuItemClick(Sender: TObject);
593 begin
594 JumpToSelection(true);
595 end;
596
597 procedure TCodeExplorerView.CloseIDEHandler(Sender: TObject);
598 begin
599 CodeExplorerOptions.Save;
600 end;
601
602 procedure TCodeExplorerView.ShowSrcEditPosMenuItemClick(Sender: TObject);
603 begin
604 SelectSourceEditorNode;
605 end;
606
607 procedure TCodeExplorerView.MainNotebookPageChanged(Sender: TObject);
608 begin
609 if MainNotebook.ActivePage=DirectivesPage then
610 CodeExplorerOptions.Page:=cepDirectives
611 else
612 CodeExplorerOptions.Page:=cepCode;
613 Refresh(true);
614 end;
615
616 procedure TCodeExplorerView.CodeModeSpeedButtonClick(Sender: TObject);
617 begin
618 // Let's Invert Mode of Exibition
619 if Mode = cemCategory then
620 SetMode(cemSource)
621 else
622 SetMode(cemCategory);
623 end;
624
625 procedure TCodeExplorerView.CodeRefreshSpeedButtonClick(Sender: TObject);
626 begin
627 FLastCodeChangeStep:=CTInvalidChangeStamp;
628 RefreshCode(true);
629 end;
630
631 procedure TCodeExplorerView.OptionsSpeedButtonClick(Sender: TObject);
632 begin
633 if Assigned(FOnShowOptions) then
634 begin
635 OnShowOptions(Self);
636 Refresh(True);
637 end;
638 end;
639
640 procedure TCodeExplorerView.RefreshMenuItemClick(Sender: TObject);
641 begin
642 FLastCodeChangeStep:=CTInvalidChangeStamp;
643 FLastDirectivesChangeStep:=CTInvalidChangeStamp;
644 Refresh(true);
645 end;
646
647 procedure TCodeExplorerView.RenameMenuItemClick(Sender: TObject);
648 begin
649 if not JumpToSelection then begin
650 IDEMessageDialog(lisCCOErrorCaption, lisTreeNeedsRefresh, mtError, [mbOk]);
651 Refresh(true);
652 exit;
653 end;
654 ExecuteIDECommand(SourceEditorManagerIntf.ActiveSourceWindow, ecRenameIdentifier);
655 end;
656
657 procedure TCodeExplorerView.TreePopupmenuPopup(Sender: TObject);
658 var
659 CurTreeView: TCustomTreeView;
660 CurItem: TTreeNode;
661 CanRename: boolean;
662 CurNode: TViewNodeData;
663 HasImplementation: Boolean;
664 begin
665 CanRename:=false;
666 HasImplementation:=false;
667 CurTreeView:=GetCurrentTreeView;
668 if CurTreeView<>nil then begin
669 if tvoAllowMultiselect in CurTreeView.Options then
670 CurItem:=CurTreeView.GetFirstMultiSelected
671 else
672 CurItem:=CurTreeView.Selected;
673 if CurItem<>nil then begin
674 CurNode:=TViewNodeData(CurItem.Data);
675 if CurNode.StartPos>0 then begin
676 case CurrentPage of
677 cepCode:
678 if (CurNode.Desc in AllIdentifierDefinitions+[ctnProcedure,ctnProperty])
679 and (CurItem.GetNextMultiSelected=nil) then
680 CanRename:=true;
681 cepDirectives:
682 ;
683 end;
684 end;
685 if (CurNode.ImplementationNode<>nil)
686 and (CurNode.ImplementationNode.StartPos>0) then
687 HasImplementation:=true;
688 end;
689 end;
690 CERenameIDEMenuCommand.Visible:=CanRename;
691 CEJumpToImplementationIDEMenuCommand.Visible:=HasImplementation;
692 //DebugLn(['TCodeExplorerView.TreePopupmenuPopup ',CERenameIDEMenuCommand.Visible]);
693 end;
694
695 procedure TCodeExplorerView.TreeviewDblClick(Sender: TObject);
696 begin
697 JumpToSelection;
698 end;
699
700 procedure TCodeExplorerView.TreeviewDeletion(Sender: TObject; Node: TTreeNode);
701 begin
702 if Node.Data<>nil then
703 TObject(Node.Data).Free;
704 end;
705
706 procedure TCodeExplorerView.TreeviewKeyDown(Sender: TObject; var Key: Word;
707 Shift: TShiftState);
708 begin
709 if (Key=VK_RETURN) and (Shift=[])
710 or ((Key=FCodeCmd1.ShortcutA.Key1) and (Shift=FCodeCmd1.ShortcutA.Shift1))
711 or ((Key=FCodeCmd1.ShortcutB.Key1) and (Shift=FCodeCmd1.ShortcutB.Shift1))
712 or ((Key=FCodeCmd2.ShortcutA.Key1) and (Shift=FCodeCmd2.ShortcutA.Shift1))
713 or ((Key=FCodeCmd2.ShortcutB.Key1) and (Shift=FCodeCmd2.ShortcutB.Shift1))
714 or ((Key=FCodeCmd3.ShortcutA.Key1) and (Shift=FCodeCmd3.ShortcutA.Shift1))
715 or ((Key=FCodeCmd3.ShortcutB.Key1) and (Shift=FCodeCmd3.ShortcutB.Shift1))
716 then begin
717 JumpToSelection;
718 Key:=0;
719 end;
720 end;
721
722 procedure TCodeExplorerView.UserInputHandler(Sender: TObject; Msg: Cardinal);
723 begin
724 if CodeExplorerOptions.Refresh=cerOnIdle then
725 CheckOnIdle;
726 end;
727
728 procedure TCodeExplorerView.AssignAllImages;
729 begin
730 IDEImages.AssignImage(CodeRefreshSpeedButton, 'laz_refresh');
731 IDEImages.AssignImage(CodeOptionsSpeedButton, 'menu_environment_options');
732 IDEImages.AssignImage(DirRefreshSpeedButton, 'laz_refresh');
733 IDEImages.AssignImage(DirOptionsSpeedButton, 'menu_environment_options');
734
735 CodeTreeview.Images := IDEImages.Images_16;
736 ImgIDDefault := IDEImages.GetImageIndex('ce_default');
737 ImgIDProgram := IDEImages.GetImageIndex('ce_program');
738 ImgIDUnit := IDEImages.GetImageIndex('cc_unit');
739 ImgIDInterface := IDEImages.GetImageIndex('ce_interface');
740 ImgIDImplementation := IDEImages.GetImageIndex('ce_implementation');
741 ImgIDInitialization := IDEImages.GetImageIndex('ce_initialization');
742 ImgIDFinalization := IDEImages.GetImageIndex('ce_finalization');
743 ImgIDType := IDEImages.GetImageIndex('cc_type');
744 ImgIDVariable := IDEImages.GetImageIndex('cc_variable');
745 ImgIDConst := IDEImages.GetImageIndex('cc_constant');
746 ImgIDClass := IDEImages.GetImageIndex('cc_class');
747 ImgIDClassInterface := IDEImages.GetImageIndex('ce_classinterface');
748 ImgIDHelper := IDEImages.GetImageIndex('ce_helper');
749 ImgIDRecord := IDEImages.GetImageIndex('cc_record');
750 ImgIDEnum := IDEImages.GetImageIndex('cc_enum');
751 ImgIDProcedure := IDEImages.GetImageIndex('cc_procedure');
752 ImgIDFunction := IDEImages.GetImageIndex('cc_function');
753 ImgIDConstructor := IDEImages.GetImageIndex('cc_constructor');
754 ImgIDDestructor := IDEImages.GetImageIndex('cc_destructor');
755 ImgIDLabel := IDEImages.GetImageIndex('cc_label');
756 ImgIDProperty := IDEImages.GetImageIndex('cc_property');
757 ImgIDPropertyReadOnly := IDEImages.GetImageIndex('cc_property_ro');
758 // sections
759 ImgIDSection := IDEImages.GetImageIndex('ce_section');
760 ImgIDHint := IDEImages.GetImageIndex('state_hint');
761 end;
762
GetCodeNodeDescriptionnull763 function TCodeExplorerView.GetCodeNodeDescription(ACodeTool: TCodeTool;
764 CodeNode: TCodeTreeNode): string;
765 var
766 ClassIdentNode, HelperForNode, InhNode: TCodeTreeNode;
767 begin
768 Result:='?';
769 try
770 case CodeNode.Desc of
771 ctnUnit, ctnProgram, ctnLibrary, ctnPackage:
772 Result:=CodeNode.DescAsString+' '+ACodeTool.ExtractSourceName;
773 ctnTypeSection:
774 Result:='Type';
775 ctnVarSection:
776 Result:='Var';
777 ctnConstSection:
778 Result:='Const';
779 ctnLabelSection:
780 Result:='Label';
781 ctnResStrSection:
782 Result:='Resourcestring';
783 ctnVarDefinition, ctnConstDefinition, ctnEnumIdentifier, ctnLabel:
784 Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
785 ctnUseUnit:
786 Result:=ACodeTool.ExtractDottedIdentifier(CodeNode.StartPos);
787 ctnTypeDefinition:
788 begin
789 Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
790 ClassIdentNode := CodeNode.FirstChild;
791 if Assigned(ClassIdentNode) then
792 begin
793 if ClassIdentNode.Desc in [ctnClassHelper, ctnRecordHelper, ctnTypeHelper] then
794 HelperForNode := ACodeTool.FindHelperForNode(ClassIdentNode)
795 else
796 HelperForNode := nil;
797 InhNode:=ACodeTool.FindInheritanceNode(ClassIdentNode);
798 if InhNode<>nil then
799 Result:=Result+ACodeTool.ExtractNode(InhNode,[]);
800 if HelperForNode<>nil then
801 Result:=Result+' '+ACodeTool.ExtractNode(HelperForNode,[]);
802 end;
803 end;
804 ctnGenericType:
805 Result:=ACodeTool.ExtractDefinitionName(CodeNode);
806 ctnClass,ctnObject,ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,
807 ctnClassInterface,ctnCPPClass:
808 Result:='('+ACodeTool.ExtractClassInheritance(CodeNode,[])+')';
809 ctnProcedure:
810 Result:=ACodeTool.ExtractProcHead(CodeNode,
811 [// phpWithStart is no needed because there are icons
812 phpWithVarModifiers,
813 phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
814 phpWithOfObject]);
815 ctnProcedureHead:
816 Result:='Procedure Header';
817 ctnProperty:
818 Result:=ACodeTool.ExtractPropName(CodeNode,false); // property keyword is not needed because there are icons
819 ctnInterface:
820 Result:='Interface';
821 ctnBeginBlock:
822 Result:='Begin block';
823 ctnAsmBlock:
824 Result:='Asm block';
825 else
826 Result:=CodeNode.DescAsString;
827 end;
828 except
829 on E: ECodeToolError do
830 Result:=''; // ignore syntax errors
831 end;
832 end;
833
GetDirectiveNodeDescriptionnull834 function TCodeExplorerView.GetDirectiveNodeDescription(
835 ADirectivesTool: TDirectivesTool; Node: TCodeTreeNode): string;
836 begin
837 Result:=ADirectivesTool.GetDirective(Node);
838 end;
839
GetCodeFilternull840 function TCodeExplorerView.GetCodeFilter: string;
841 begin
842 Result:=CodeFilterEdit.Text;
843 end;
844
845 procedure TCodeExplorerView.ClearCodeTreeView;
846 var
847 f: TCEObserverCategory;
848 c: TCodeExplorerCategory;
849 begin
850 for c:=low(TCodeExplorerCategory) to high(TCodeExplorerCategory) do
851 fCategoryNodes[c]:=nil;
852 fObserverNode:=nil;
853 for f:=low(TCEObserverCategory) to high(TCEObserverCategory) do
854 fObserverCatNodes[f]:=nil;
855 fSurroundingNode:=nil;
856 CodeTreeview.Items.Clear;
857 end;
858
859 procedure TCodeExplorerView.ClearDirectivesTreeView;
860 begin
861 DirectivesTreeView.Items.Clear;
862 end;
863
GetCurrentPagenull864 function TCodeExplorerView.GetCurrentPage: TCodeExplorerPage;
865 begin
866 if MainNotebook.ActivePage=CodePage then
867 Result:=cepCode
868 else if MainNotebook.ActivePage=DirectivesPage then
869 Result:=cepDirectives
870 else
871 Result:=cepNone;
872 end;
873
GetDirectivesFilternull874 function TCodeExplorerView.GetDirectivesFilter: string;
875 begin
876 Result:=DirectivesFilterEdit.Text;
877 end;
878
GetCodeNodeImagenull879 function TCodeExplorerView.GetCodeNodeImage(Tool: TFindDeclarationTool;
880 CodeNode: TCodeTreeNode): integer;
881 begin
882 case CodeNode.Desc of
883 ctnProgram,ctnLibrary,ctnPackage: Result:=ImgIDProgram;
884 ctnUnit: Result:=ImgIDUnit;
885 ctnInterface: Result:=ImgIDInterface;
886 ctnImplementation: Result:=ImgIDImplementation;
887 ctnInitialization: Result:=ImgIDInitialization;
888 ctnFinalization: Result:=ImgIDFinalization;
889 ctnTypeSection: Result:=ImgIDSection;
890 ctnTypeDefinition:
891 begin
892 if (CodeNode.FirstChild <> nil) then
893 case CodeNode.FirstChild.Desc of
894 ctnClassInterface,ctnDispinterface,ctnObjCProtocol:
895 Result := ImgIDClassInterface;
896 ctnClass,ctnObjCClass,ctnObjCCategory,ctnCPPClass:
897 Result := ImgIDClass;
898 ctnObject,ctnRecordType:
899 Result := ImgIDRecord;
900 ctnEnumerationType,ctnEnumIdentifier:
901 Result:=ImgIDEnum;
902 ctnClassHelper,ctnRecordHelper,ctnTypeHelper:
903 Result := ImgIDHelper;
904 else
905 Result := ImgIDType;
906 end
907 else
908 Result := ImgIDType;
909 end;
910 ctnVarSection: Result:=ImgIDSection;
911 ctnVarDefinition: Result:=ImgIDVariable;
912 ctnConstSection,ctnResStrSection: Result:=ImgIDSection;
913 ctnConstDefinition: Result:=ImgIDConst;
914 ctnClassInterface,ctnDispinterface,ctnObjCProtocol:
915 Result := ImgIDClassInterface;
916 ctnClass,ctnObject,
917 ctnObjCClass,ctnObjCCategory,ctnCPPClass:
918 Result:=ImgIDClass;
919 ctnRecordType: Result:=ImgIDRecord;
920 ctnEnumerationType,ctnEnumIdentifier:
921 Result:=ImgIDEnum;
922 ctnClassHelper,ctnRecordHelper,ctnTypeHelper:
923 Result:=ImgIDHelper;
924 ctnProcedure:
925 if Tool.NodeIsConstructor(CodeNode) then
926 Result:=ImgIDConstructor
927 else
928 if Tool.NodeIsDestructor(CodeNode) then
929 Result:=ImgIDDestructor
930 else
931 if Tool.NodeIsFunction(CodeNode) then
932 Result:=ImgIDFunction
933 else
934 Result:=ImgIDProcedure;
935 ctnProperty: Result:=ImgIDProperty;
936 ctnUsesSection: Result:=ImgIDSection;
937 ctnUseUnit: Result:=ImgIDUnit;
938 ctnLabelSection: Result:=ImgIDSection;
939 ctnLabel: Result:=ImgIDLabel;
940 else
941 Result:=ImgIDDefault;
942 end;
943 end;
944
GetDirectiveNodeImagenull945 function TCodeExplorerView.GetDirectiveNodeImage(CodeNode: TCodeTreeNode): integer;
946 begin
947 case CodeNode.SubDesc of
948 cdnsInclude: Result:=ImgIDSection;
949 else
950 case CodeNode.Desc of
951 cdnIf: Result:=ImgIDSection;
952 cdnElseIf: Result:=ImgIDSection;
953 cdnElse: Result:=ImgIDSection;
954 cdnEnd: Result:=ImgIDSection;
955 cdnDefine: Result:=ImgIDConst;
956 else
957 Result:=ImgIDDefault;
958 end;
959 end;
960 end;
961
962 procedure TCodeExplorerView.CreateIdentifierNodes(ACodeTool: TCodeTool;
963 CodeNode: TCodeTreeNode; ParentViewNode: TTreeNode);
964 var
965 NodeData: TViewNodeData;
966 NodeText: String;
967 ViewNode, CurParentViewNode, InFrontViewNode: TTreeNode;
968 NodeImageIndex: Integer;
969 ShowNode: Boolean;
970 ShowChilds: Boolean;
971 Category: TCodeExplorerCategory;
972 begin
973 InFrontViewNode:=nil;
974 while CodeNode<>nil do begin
975 ShowNode:=true;
976 ShowChilds:=true;
977 CurParentViewNode:=ParentViewNode;
978
979 // don't show statements
980 if (CodeNode.Desc in AllPascalStatements+[ctnParameterList]-
981 [ctnInitialization,ctnFinalization]) then begin
982 ShowNode:=false;
983 ShowChilds:=false;
984 end;
985 // don't show parameter lists
986 if (CodeNode.Desc in [ctnProcedureHead]) then begin
987 ShowNode:=false;
988 ShowChilds:=false;
989 end;
990 // don't show forward class definitions
991 if (CodeNode.Desc=ctnTypeDefinition)
992 and (CodeNode.FirstChild<>nil)
993 and (CodeNode.FirstChild.Desc in AllClasses)
994 and ((CodeNode.FirstChild.SubDesc and ctnsForwardDeclaration)>0) then begin
995 ShowNode:=false;
996 ShowChilds:=false;
997 end;
998 // don't show class node (the type node is already shown)
999 if (CodeNode.Desc in AllClasses) then begin
1000 ShowNode:=false;
1001 end;
1002
1003 //don't show child nodes of ctnUseUnit
1004 if (CodeNode.Desc=ctnUseUnit)
1005 then begin
1006 ShowChilds:=false;
1007 end;
1008
1009 // don't show subs
1010 if CodeNode.Desc in [ctnConstant,ctnIdentifier,ctnRangedArrayType,
1011 ctnOpenArrayType,ctnOfConstType,ctnRangeType,ctnTypeType,ctnFileType,
1012 ctnVariantType,ctnSetType,ctnProcedureType]
1013 then begin
1014 ShowNode:=false;
1015 ShowChilds:=false;
1016 end;
1017
1018 // show enums, but not the brackets
1019 if CodeNode.Desc=ctnEnumerationType then
1020 ShowNode:=false;
1021
1022 // don't show end node and class modification nodes
1023 if CodeNode.Desc in [ctnEndPoint,ctnClassInheritance,ctnHelperFor,
1024 ctnClassAbstract,ctnClassExternal,ctnClassSealed]
1025 then
1026 ShowNode:=false;
1027
1028 // don't show class visibility section nodes
1029 if (CodeNode.Desc in AllClassSections) then
1030 ShowNode:=false;
1031
1032 if Mode=cemCategory then begin
1033 // don't show method bodies
1034 if (CodeNode.Desc=ctnProcedure)
1035 and (ACodeTool.NodeIsMethodBody(CodeNode)) then begin
1036 ShowNode:=false;
1037 ShowChilds:=false;
1038 end;
1039
1040 // don't show single hint modifiers
1041 if (CodeNode.Desc = ctnHintModifier) and (CurParentViewNode = nil) then
1042 begin
1043 ShowNode:=false;
1044 ShowChilds:=false;
1045 end;
1046
1047 // category mode: put nodes in categories
1048 Category:=cecNone;
1049 if ShowNode
1050 and ((CodeNode.Parent=nil)
1051 or (CodeNode.Parent.Desc in AllCodeSections)
1052 or (CodeNode.Parent.Parent=nil)
1053 or (CodeNode.Parent.Parent.Desc in AllCodeSections)) then
1054 begin
1055 // top level definition
1056 case CodeNode.Desc of
1057 ctnUseUnit: Category:=cecUses;
1058 ctnTypeDefinition,ctnGenericType: Category:=cecTypes;
1059 ctnVarDefinition: Category:=cecVariables;
1060 ctnConstDefinition,ctnEnumIdentifier: Category:=cecConstants;
1061 ctnProcedure: Category:=cecProcedures;
1062 ctnProperty: Category:=cecProperties;
1063 end;
1064 if Category<>cecNone then begin
1065 ShowNode:=Category in CodeExplorerOptions.Categories;
1066 if ShowNode then begin
1067 if fCategoryNodes[Category]=nil then begin
1068 // create treenode for new category
1069 NodeData:=TViewNodeData.Create(CodeNode.Parent);
1070 NodeText:=CodeExplorerLocalizedString(Category);
1071 NodeImageIndex:=GetCodeNodeImage(ACodeTool,CodeNode.Parent);
1072 fCategoryNodes[Category]:=CodeTreeview.Items.AddChildObject(nil,
1073 NodeText,NodeData);
1074 fCategoryNodes[Category].ImageIndex:=NodeImageIndex;
1075 fCategoryNodes[Category].SelectedIndex:=NodeImageIndex;
1076 end;
1077 if (CurParentViewNode=nil) then
1078 CurParentViewNode:=fCategoryNodes[Category];
1079 InFrontViewNode:=nil;
1080 end;
1081 end else begin
1082 ShowNode:=false;
1083 end;
1084 end else begin
1085 // not a top level node
1086 end;
1087 //DebugLn(['TCodeExplorerView.CreateIdentifierNodes ',CodeNode.DescAsString,' ShowNode=',ShowNode,' ShowChilds=',ShowChilds]);
1088 end;
1089
1090 if ShowNode then begin
1091 // add a node to the TTreeView
1092 NodeData:=TViewNodeData.Create(CodeNode);
1093 CreateNodePath(ACodeTool,NodeData);
1094 NodeText:=GetCodeNodeDescription(ACodeTool,CodeNode);
1095 NodeImageIndex:=GetCodeNodeImage(ACodeTool,CodeNode);
1096 //if NodeText='TCodeExplorerView' then
1097 // debugln(['TCodeExplorerView.CreateIdentifierNodes CodeNode=',CodeNode.DescAsString,' NodeText="',NodeText,'" Category=',dbgs(Category),' InFrontViewNode=',InFrontViewNode<>nil,' CurParentViewNode=',CurParentViewNode<>nil]);
1098 if InFrontViewNode<>nil then
1099 ViewNode:=CodeTreeview.Items.InsertObjectBehind(InFrontViewNode,NodeText,NodeData)
1100 else if CurParentViewNode<>nil then
1101 ViewNode:=CodeTreeview.Items.AddChildObject(CurParentViewNode,NodeText,NodeData)
1102 else
1103 ViewNode:=CodeTreeview.Items.AddObject(nil,NodeText,NodeData);
1104 ViewNode.ImageIndex:=NodeImageIndex;
1105 ViewNode.SelectedIndex:=NodeImageIndex;
1106 InFrontViewNode:=ViewNode;
1107 end else begin
1108 // do not add a node to the TTreeView
1109 ViewNode:=CurParentViewNode;
1110 AddImplementationNode(ACodeTool,CodeNode);
1111 end;
1112 if ShowChilds then
1113 CreateIdentifierNodes(ACodeTool,CodeNode.FirstChild,ViewNode);
1114 CodeNode:=CodeNode.NextBrother;
1115 end;
1116 end;
1117
1118 procedure TCodeExplorerView.CreateDirectiveNodes(ADirectivesTool: TDirectivesTool;
1119 CodeNode: TCodeTreeNode; ParentViewNode: TTreeNode);
1120 var
1121 NodeData: TViewNodeData;
1122 NodeText: String;
1123 ViewNode, InFrontViewNode: TTreeNode;
1124 NodeImageIndex: Integer;
1125 ShowNode: Boolean;
1126 ShowChilds: Boolean;
1127 begin
1128 InFrontViewNode:=nil;
1129 while CodeNode<>nil do begin
1130 ShowNode:=true;
1131 ShowChilds:=true;
1132
1133 // do not show root node
1134 if CodeNode.Desc=cdnRoot then begin
1135 ShowNode:=false;
1136 end;
1137
1138 ViewNode:=ParentViewNode;
1139 if ShowNode then begin
1140 NodeData:=TViewNodeData.Create(CodeNode,false);
1141 NodeText:=GetDirectiveNodeDescription(ADirectivesTool,CodeNode);
1142 NodeImageIndex:=GetDirectiveNodeImage(CodeNode);
1143 if InFrontViewNode<>nil then
1144 ViewNode:=DirectivesTreeView.Items.InsertObjectBehind(
1145 InFrontViewNode,NodeText,NodeData)
1146 else if ParentViewNode<>nil then
1147 ViewNode:=DirectivesTreeView.Items.AddChildObject(
1148 ParentViewNode,NodeText,NodeData)
1149 else
1150 ViewNode:=DirectivesTreeView.Items.AddObject(nil,NodeText,NodeData);
1151 ViewNode.ImageIndex:=NodeImageIndex;
1152 ViewNode.SelectedIndex:=NodeImageIndex;
1153 InFrontViewNode:=ViewNode;
1154 end;
1155 if ShowChilds then
1156 CreateDirectiveNodes(ADirectivesTool,CodeNode.FirstChild,ViewNode);
1157 CodeNode:=CodeNode.NextBrother;
1158 end;
1159 end;
1160
1161 procedure TCodeExplorerView.CreateObservations(Tool: TCodeTool);
1162
1163 function AddCodeNode(f: TCEObserverCategory; CodeNode: TCodeTreeNode): TTreeNode;
1164 var
1165 Data: TViewNodeData;
1166 ObsTVNode: TTreeNode;
1167 NodeText: String;
1168 NodeImageIndCex: LongInt;
1169 begin
1170 ObsTVNode:=CreateObserverNode(Tool,f);
1171 if ObsTVNode.Count>=CodeObserverMaxNodes then
1172 begin
1173 fObserverCatOverflow[f]:=true;
1174 exit(nil);
1175 end;
1176 Data:=TViewNodeData.Create(CodeNode);
1177 NodeText:=GetCodeNodeDescription(Tool,CodeNode);
1178 NodeImageIndCex:=GetCodeNodeImage(Tool,CodeNode);
1179 Result:=CodeTreeview.Items.AddChild(ObsTVNode,NodeText);
1180 Result.Data:=Data;
1181 Result.Text:=NodeText;
1182 Result.ImageIndex:=NodeImageIndCex;
1183 Result.SelectedIndex:=NodeImageIndCex;
1184 end;
1185
1186 procedure CheckUnsortedClassMembers(ParentCodeNode: TCodeTreeNode);
1187 var
1188 LastNode: TCodeTreeNode;
1189 LastIdentifier: string;
1190
1191 function NodeSorted(CodeNode: TCodeTreeNode): boolean;
1192 var
1193 p: PChar;
1194 Identifier: String;
1195 begin
1196 Result:=true;
1197 if (LastNode<>nil)
1198 //and (not CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.MixMethodsAndProperties)
1199 and (CodeNode.Desc<>LastNode.Desc) then begin
1200 // sort variables then methods and properties
1201 if (LastNode.Desc in [ctnProperty,ctnProcedure])
1202 and not (CodeNode.Desc in [ctnProperty,ctnProcedure])
1203 then begin
1204 Result:=false;
1205 end;
1206 if (LastNode.Desc in [ctnProperty])
1207 and (CodeNode.Desc in [ctnProcedure])
1208 and (not CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.MixMethodsAndProperties)
1209 then
1210 Result:=false;
1211 end;
1212 p:=Tool.GetNodeIdentifier(CodeNode);
1213 if p<>nil then
1214 Identifier:=GetIdentifier(p)
1215 else
1216 Identifier:='';
1217 if Result and (LastIdentifier<>'') and (Identifier<>'')
1218 and (CodeNode.Desc=LastNode.Desc) then begin
1219 // compare identifiers
1220 if CompareIdentifiers(PChar(Identifier),PChar(LastIdentifier))>0 then
1221 begin
1222 Result:=false;
1223 end;
1224 end;
1225 if not Result then begin
1226 AddCodeNode(cefcUnsortedClassMembers,CodeNode);
1227 end;
1228 LastNode:=CodeNode;
1229 LastIdentifier:=Identifier;
1230 end;
1231
1232 var
1233 CodeNode: TCodeTreeNode;
1234 begin
1235 CodeNode:=ParentCodeNode.FirstChild;
1236 LastNode:=nil;
1237 while CodeNode<>nil do begin
1238 if CodeNode.Desc in AllIdentifierDefinitions then begin
1239 if not NodeSorted(CodeNode) then exit;
1240 // skip all variables in a group (e.g. Next,Prev:TNode)
1241 while CodeNode.FirstChild=nil do begin
1242 CodeNode:=CodeNode.NextBrother;
1243 if CodeNode=nil then exit;
1244 end;
1245 end else if CodeNode.Desc in [ctnProperty,ctnProcedure] then
1246 begin
1247 if not NodeSorted(CodeNode) then exit;
1248 end;
1249 CodeNode:=CodeNode.NextBrother;
1250 end;
1251 end;
1252
1253 var
1254 CodeNode: TCodeTreeNode;
1255 LineCnt: LongInt;
1256 i: integer;
1257 f: TCEObserverCategory;
1258 ObserverCats: TCEObserverCategories;
1259 ProcNode: TCodeTreeNode;
1260 ObsState: TCodeObserverStatementState;
1261 TVNode: TTreeNode;
1262 begin
1263 CodeNode:=Tool.Tree.Root;
1264 ObserverCats:=CodeExplorerOptions.ObserverCategories;
1265 ObsState:=TCodeObserverStatementState.Create;
1266 try
1267 while CodeNode<>nil do begin
1268 case CodeNode.Desc of
1269
1270 ctnBeginBlock:
1271 begin
1272 if (CodeNode.SubDesc and ctnsNeedJITParsing)<>0 then
1273 begin
1274 try
1275 Tool.BuildSubTreeForBeginBlock(CodeNode);
1276 except
1277 end;
1278 end;
1279 if (cefcLongProcs in ObserverCats)
1280 and (CodeNode.Parent.Desc=ctnProcedure) then begin
1281 LineCnt:=LineEndCount(Tool.Src,CodeNode.StartPos,CodeNode.EndPos,i);
1282 if LineCnt>=CodeExplorerOptions.LongProcLineCount then
1283 begin
1284 ProcNode:=CodeNode.Parent;
1285 TVNode:=AddCodeNode(cefcLongProcs,ProcNode);
1286 if Assigned(TVNode) then
1287 TVNode.Text:=TVNode.Text+' ['+IntToStr(LineCnt)+']';
1288 end;
1289 end;
1290 if (cefcEmptyProcs in ObserverCats)
1291 and (CodeNode.Parent.Desc=ctnProcedure) then
1292 begin
1293 Tool.MoveCursorToCleanPos(CodeNode.StartPos);
1294 Tool.ReadNextAtom;// read begin
1295 Tool.ReadNextAtom;
1296 if Tool.CurPos.Flag=cafEnd then begin
1297 // no code, maybe comments and directives (hidden code)
1298 ProcNode:=CodeNode.Parent;
1299 AddCodeNode(cefcEmptyProcs,ProcNode);
1300 end;
1301 end;
1302 if not CodeNode.HasParentOfType(ctnBeginBlock) then
1303 begin
1304 CreateObserverNodesForStatement(Tool,CodeNode,
1305 CodeNode.StartPos,CodeNode.EndPos,ObsState);
1306 end;
1307 if (cefcEmptyBlocks in ObserverCats)
1308 and CodeIsOnlySpace(Tool.Src,CodeNode.StartPos+length('begin'),
1309 CodeNode.EndPos-length('end')-1)
1310 then begin
1311 AddCodeNode(cefcEmptyBlocks,CodeNode);
1312 end;
1313 end;
1314
1315 ctnAsmBlock:
1316 begin
1317 if (cefcEmptyBlocks in ObserverCats)
1318 and CodeIsOnlySpace(Tool.Src,CodeNode.StartPos+length('asm'),
1319 CodeNode.EndPos-length('end')-1)
1320 then begin
1321 AddCodeNode(cefcEmptyBlocks,CodeNode);
1322 end;
1323 end;
1324
1325 ctnProcedure:
1326 begin
1327 if (cefcNestedProcs in ObserverCats) then
1328 begin
1329 i:=0;
1330 ProcNode:=CodeNode.FirstChild;
1331 while ProcNode<>nil do begin
1332 if ProcNode.Desc=ctnProcedure then
1333 inc(i);
1334 ProcNode:=ProcNode.NextBrother;
1335 end;
1336 if i>=CodeExplorerOptions.NestedProcCount then begin
1337 AddCodeNode(cefcNestedProcs,CodeNode);
1338 end;
1339 end;
1340 end;
1341
1342 ctnParameterList:
1343 begin
1344 if (cefcLongParamLists in ObserverCats)
1345 and (CodeNode.HasParentOfType(ctnInterface))
1346 and (CodeNode.ChildCount>CodeExplorerOptions.LongParamListCount) then
1347 begin
1348 if (CodeNode.Parent.Desc=ctnProcedureHead)
1349 and (CodeNode.Parent.Parent.Desc=ctnProcedure) then
1350 begin
1351 ProcNode:=CodeNode.Parent.Parent;
1352 AddCodeNode(cefcLongParamLists,ProcNode);
1353 end;
1354 end;
1355 end;
1356
1357 ctnProperty:
1358 begin
1359 if (cefcPublishedPropWithoutDefault in ObserverCats)
1360 and (CodeNode.Parent.Desc=ctnClassPublished) then
1361 begin
1362 if (not Tool.PropertyHasSpecifier(CodeNode,'default',false))
1363 and (Tool.PropertyHasSpecifier(CodeNode,'read',false))
1364 and (Tool.PropertyHasSpecifier(CodeNode,'write',false))
1365 then
1366 AddCodeNode(cefcPublishedPropWithoutDefault,CodeNode);
1367 end;
1368 end;
1369
1370 ctnClassClassVar..ctnClassPublished:
1371 begin
1372 if (cefcUnsortedClassVisibility in ObserverCats)
1373 and (CodeNode.PriorBrother<>nil)
1374 and (CodeNode.PriorBrother.Desc in AllClassBaseSections)
1375 and (CodeNode.PriorBrother.Desc>CodeNode.Desc)
1376 then begin
1377 if (CodeNode.PriorBrother.Desc=ctnClassPublished)
1378 and ((CodeNode.PriorBrother.PriorBrother=nil)
1379 or (not (CodeNode.PriorBrother.PriorBrother.Desc in AllClassBaseSections)))
1380 then begin
1381 // the first section can be published
1382 end else begin
1383 // the prior section was more visible
1384 AddCodeNode(cefcUnsortedClassVisibility,CodeNode);
1385 end;
1386 end;
1387 if (cefcUnsortedClassMembers in ObserverCats)
1388 then
1389 CheckUnsortedClassMembers(CodeNode);
1390 if (cefcEmptyClassSections in ObserverCats)
1391 and (CodeNode.FirstChild=nil) then
1392 begin
1393 if (CodeNode.Desc=ctnClassPublished)
1394 and ((CodeNode.PriorBrother=nil)
1395 or (not (CodeNode.PriorBrother.Desc in AllClassBaseSections)))
1396 then begin
1397 // the first section can be empty
1398 end else begin
1399 // empty class section
1400 AddCodeNode(cefcEmptyClassSections,CodeNode);
1401 end;
1402 end;
1403 end;
1404
1405 end;
1406 CodeNode:=CodeNode.Next;
1407 end;
1408
1409 if cefcToDos in ObserverCats then
1410 FindObserverTodos(Tool);
1411 finally
1412 ObsState.Free;
1413 end;
1414
1415 // add numbers
1416 for f:=low(TCEObserverCategory) to high(TCEObserverCategory) do
1417 begin
1418 if fObserverCatNodes[f]=nil then continue;
1419 if fObserverCatOverflow[f] then
1420 fObserverCatNodes[f].Text:=
1421 fObserverCatNodes[f].Text+' ('+IntToStr(fObserverCatNodes[f].Count)+'+)'
1422 else
1423 fObserverCatNodes[f].Text:=
1424 fObserverCatNodes[f].Text+' ('+IntToStr(fObserverCatNodes[f].Count)+')';
1425 end;
1426 end;
1427
CreateObserverNodenull1428 function TCodeExplorerView.CreateObserverNode(Tool: TCodeTool;
1429 f: TCEObserverCategory): TTreeNode;
1430 var
1431 Data: TViewNodeData;
1432 begin
1433 if fObserverCatNodes[f] = nil then
1434 begin
1435 if fObserverNode = nil then
1436 begin
1437 fObserverNode:=CodeTreeview.Items.Add(nil, lisCodeObserver);
1438 Data:=TViewNodeData.Create(Tool.Tree.Root);
1439 Data.Desc:=ctnNone;
1440 Data.StartPos:=Tool.SrcLen;
1441 fObserverNode.Data:=Data;
1442 fObserverNode.ImageIndex:=ImgIDSection;
1443 fObserverNode.SelectedIndex:=ImgIDSection;
1444 end;
1445 fObserverCatNodes[f]:=CodeTreeview.Items.AddChild(fObserverNode,
1446 CodeExplorerLocalizedString(f));
1447 Data:=TViewNodeData.Create(Tool.Tree.Root);
1448 Data.Desc:=ctnNone;
1449 Data.StartPos:=Tool.SrcLen;
1450 fObserverCatNodes[f].Data:=Data;
1451 fObserverCatNodes[f].ImageIndex:=ImgIDHint;
1452 fObserverCatNodes[f].SelectedIndex:=ImgIDHint;
1453 end;
1454 Result:=fObserverCatNodes[f];
1455 end;
1456
1457 procedure TCodeExplorerView.CreateObserverNodesForStatement(Tool: TCodeTool;
1458 CodeNode: TCodeTreeNode;
1459 StartPos, EndPos: integer; ObserverState: TCodeObserverStatementState);
1460 var
1461 Data: TViewNodeData;
1462 ObsTVNode: TTreeNode;
1463 NodeText: String;
1464 NodeImageIndex: LongInt;
1465 TVNode: TTreeNode;
1466 ProcNode: TCodeTreeNode;
1467 OldPos: LongInt;
1468 CurAtom, Last1Atom, Last2Atom: TCommonAtomFlag;
1469 FuncName: string;
1470 Atom: TAtomPosition;
1471 c1: Char;
1472 Typ: TCodeObsStackItemType;
1473 CheckWrongIndentation: boolean;
1474 FindUnnamedConstants: boolean;
1475
1476 procedure CheckSubStatement(CanBeEqual: boolean);
1477 var
1478 StatementStartPos: Integer;
1479 LastIndent: LongInt;
1480 Indent: LongInt;
1481 NeedUndo: Boolean;
1482 LastPos: LongInt;
1483 begin
1484 //DebugLn(['CheckSubStatement START=',Tool.GetAtom,' ',CheckWrongIndentation,' ',ObserverState.StatementStartPos,' ',dbgstr(copy(Tool.Src,ObserverState.StatementStartPos,15))]);
1485 if not CheckWrongIndentation then exit;
1486 StatementStartPos:=ObserverState.StatementStartPos;
1487 if StatementStartPos<1 then exit;
1488 LastPos:=Tool.CurPos.StartPos;
1489 Tool.ReadNextAtom;
1490 if PositionsInSameLine(Tool.Src,LastPos,Tool.CurPos.StartPos) then exit;
1491 NeedUndo:=true;
1492 //DebugLn(['CheckSubStatement NEXT=',Tool.GetAtom,' NotSameLine=',not PositionsInSameLine(Tool.Src,StatementStartPos,Tool.CurPos.StartPos),' ',dbgstr(copy(Tool.Src,Tool.CurPos.StartPos,15))]);
1493 if (Tool.CurPos.Flag<>cafNone)
1494 and (not PositionsInSameLine(Tool.Src,StatementStartPos,Tool.CurPos.StartPos))
1495 then begin
1496 LastIndent:=GetLineIndent(Tool.Src,StatementStartPos);
1497 Indent:=GetLineIndent(Tool.Src,Tool.CurPos.StartPos);
1498 //DebugLn(['CheckSubStatement OTHER LINE ',Tool.GetAtom,' ',LastIndent,' ',Indent]);
1499 if (Indent<LastIndent)
1500 or ((Indent=LastIndent) and (not CanBeEqual) and (not Tool.UpAtomIs('BEGIN')))
1501 then begin
1502 //DebugLn(['CheckSubStatement START=',CheckWrongIndentation,' ',ObserverState.StatementStartPos,' ',dbgstr(copy(Tool.Src,ObserverState.StatementStartPos,15))]);
1503 //DebugLn(['CheckSubStatement NEXT=',Tool.GetAtom,' NotSameLine=',not PositionsInSameLine(Tool.Src,StatementStartPos,Tool.CurPos.StartPos),' ',dbgstr(copy(Tool.Src,Tool.CurPos.StartPos,15))]);
1504 //DebugLn(['CheckSubStatement OTHER LINE LastIndent=',LastIndent,' Indent=',Indent]);
1505 // add wrong indentation
1506 ObsTVNode:=CreateObserverNode(Tool,cefcWrongIndentation);
1507 if ObsTVNode.Count>=CodeObserverMaxNodes then
1508 begin
1509 fObserverCatOverflow[cefcWrongIndentation]:=true;
1510 end else begin
1511 Data:=TViewNodeData.Create(CodeNode);
1512 Data.Desc:=ctnConstant;
1513 Data.SubDesc:=ctnsNone;
1514 Data.StartPos:=Tool.CurPos.StartPos;
1515 Data.EndPos:=Tool.CurPos.EndPos;
1516 NodeText:=Tool.GetAtom;
1517 // add some context information
1518 Tool.UndoReadNextAtom;
1519 NeedUndo:=false;
1520 ProcNode:=CodeNode;
1521 while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do
1522 ProcNode:=ProcNode.Parent;
1523 if ProcNode<>nil then begin
1524 OldPos:=Tool.CurPos.EndPos;
1525 NodeText:=Format(lisCEIn, [NodeText, Tool.ExtractProcName(ProcNode, [
1526 phpWithoutClassName])]);
1527 Tool.MoveCursorToCleanPos(OldPos);
1528 end;
1529 NodeImageIndex:=ImgIDConst;
1530 TVNode:=CodeTreeview.Items.AddChild(ObsTVNode,NodeText);
1531 TVNode.Data:=Data;
1532 TVNode.Text:=NodeText;
1533 TVNode.ImageIndex:=NodeImageIndex;
1534 TVNode.SelectedIndex:=NodeImageIndex;
1535 end;
1536 end;
1537 end;
1538 if NeedUndo then
1539 Tool.UndoReadNextAtom;
1540 end;
1541
1542 begin
1543 if EndPos>Tool.SrcLen then EndPos:=Tool.SrcLen+1;
1544 if (StartPos<1) or (StartPos>=EndPos) then exit;
1545 CheckWrongIndentation:=cefcWrongIndentation in CodeExplorerOptions.ObserverCategories;
1546 FindUnnamedConstants:=cefcUnnamedConsts in CodeExplorerOptions.ObserverCategories;
1547 if (not FindUnnamedConstants) and (not CheckWrongIndentation) then exit;
1548 Tool.MoveCursorToCleanPos(StartPos);
1549 Last1Atom:=cafNone;
1550 Last2Atom:=cafNone;
1551 ObserverState.Reset;
1552 while Tool.CurPos.StartPos<EndPos do begin
1553 CurAtom:=cafNone;
1554 if ObserverState.StatementStartPos<1 then
1555 begin
1556 // start of statement
1557 ObserverState.StatementStartPos:=Tool.CurPos.StartPos;
1558 end;
1559
1560 c1:=Tool.Src[Tool.CurPos.StartPos];
1561 case c1 of
1562 ';':
1563 begin
1564 // end of statement
1565 ObserverState.StatementStartPos:=0;
1566 end;
1567
1568 '''','#','0'..'9','$','%':
1569 begin
1570 // a constant
1571 if not FindUnnamedConstants then begin
1572 // ignore
1573 end else if (ObserverState.IgnoreConstLevel>=0)
1574 and (ObserverState.IgnoreConstLevel>=ObserverState.StackPtr)
1575 then begin
1576 // ignore range
1577 end else if Tool.AtomIsEmptyStringConstant then begin
1578 // ignore empty string constant ''
1579 end else if Tool.AtomIsCharConstant
1580 and (not CodeExplorerOptions.ObserveCharConst) then
1581 begin
1582 // ignore char constants
1583 end else if CodeExplorerOptions.COIgnoreConstant(@Tool.Src[Tool.CurPos.StartPos])
1584 then begin
1585 // ignore user defined constants
1586 end else begin
1587 // add constant
1588 ObsTVNode:=CreateObserverNode(Tool,cefcUnnamedConsts);
1589 if ObsTVNode.Count>=CodeObserverMaxNodes then
1590 begin
1591 fObserverCatOverflow[cefcUnnamedConsts]:=true;
1592 break;
1593 end else begin
1594 Data:=TViewNodeData.Create(CodeNode);
1595 Data.Desc:=ctnConstant;
1596 Data.SubDesc:=ctnsNone;
1597 Data.StartPos:=Tool.CurPos.StartPos;
1598 Data.EndPos:=Tool.CurPos.EndPos;
1599 NodeText:=Tool.GetAtom;
1600 // add some context information
1601 ProcNode:=CodeNode;
1602 while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do
1603 ProcNode:=ProcNode.Parent;
1604 if ProcNode<>nil then begin
1605 OldPos:=Tool.CurPos.EndPos;
1606 NodeText:=Format(lisCEIn, [NodeText, Tool.ExtractProcName(ProcNode, [
1607 phpWithoutClassName])]);
1608 Tool.MoveCursorToCleanPos(OldPos);
1609 end;
1610 NodeImageIndex:=ImgIDConst;
1611 TVNode:=CodeTreeview.Items.AddChild(ObsTVNode,NodeText);
1612 TVNode.Data:=Data;
1613 TVNode.Text:=NodeText;
1614 TVNode.ImageIndex:=NodeImageIndex;
1615 TVNode.SelectedIndex:=NodeImageIndex;
1616 end;
1617 end;
1618 end;
1619
1620 '.':
1621 CurAtom:=cafPoint;
1622
1623 '(','[':
1624 begin
1625 if c1='(' then
1626 ObserverState.Push(cositRoundBracketOpen,Tool.CurPos.StartPos)
1627 else
1628 ObserverState.Push(cositEdgedBracketOpen,Tool.CurPos.StartPos);
1629 if (Last1Atom=cafWord)
1630 and (ObserverState.IgnoreConstLevel<0) then
1631 begin
1632 Atom:=Tool.LastAtoms.GetPriorAtom;
1633 FuncName:=copy(Tool.Src,Atom.StartPos,Atom.EndPos-Atom.StartPos);
1634 if Last2Atom=cafPoint then
1635 FuncName:='.'+FuncName;
1636 if CodeExplorerOptions.COIgnoreConstInFunc(FuncName) then
1637 begin
1638 // skip this function call
1639 ObserverState.IgnoreConstLevel:=ObserverState.StackPtr;
1640 end;
1641 end;
1642 end;
1643
1644 ')',']':
1645 begin
1646 while ObserverState.StackPtr>0 do
1647 begin
1648 Typ:=ObserverState.TopType;
1649 if Typ in [cositRoundBracketOpen,cositEdgedBracketOpen]
1650 then begin
1651 ObserverState.Pop;
1652 // normally brackets must match () []
1653 // but during editing often the brackets don't match
1654 // for example [( ]
1655 // skip silently
1656 if (Typ=cositRoundBracketOpen)=(c1='(') then break;
1657 end else begin
1658 // missing bracket close
1659 break;
1660 end;
1661 end;
1662 end;
1663
1664 ':':
1665 ObserverState.StatementStartPos:=-1;
1666
1667 '_','a'..'z','A'..'Z':
1668 begin
1669 CurAtom:=cafWord;
1670 if Tool.UpAtomIs('END') then
1671 begin
1672 while ObserverState.StackPtr>0 do
1673 begin
1674 Typ:=ObserverState.Pop;
1675 if Typ in [cositBegin,cositFinally,cositExcept,cositCase,cositCaseElse]
1676 then
1677 break;
1678 end;
1679 ObserverState.StatementStartPos:=-1;
1680 end
1681 else if Tool.UpAtomIs('BEGIN') then
1682 ObserverState.Push(cositBegin,Tool.CurPos.StartPos)
1683 else if Tool.UpAtomIs('REPEAT') then
1684 ObserverState.Push(cositRepeat,Tool.CurPos.StartPos)
1685 else if Tool.UpAtomIs('TRY') then
1686 ObserverState.Push(cositTry,Tool.CurPos.StartPos)
1687 else if Tool.UpAtomIs('FINALLY') or Tool.UpAtomIs('EXCEPT') then
1688 begin
1689 while ObserverState.StackPtr>0 do
1690 begin
1691 Typ:=ObserverState.Pop;
1692 if Typ=cositTry then
1693 break;
1694 end;
1695 ObserverState.StatementStartPos:=-1;
1696 if Tool.UpAtomIs('FINALLY') then
1697 ObserverState.Push(cositFinally,Tool.CurPos.StartPos)
1698 else
1699 ObserverState.Push(cositExcept,Tool.CurPos.StartPos);
1700 end
1701 else if Tool.UpAtomIs('CASE') then
1702 begin
1703 ObserverState.Push(cositCase,Tool.CurPos.StartPos);
1704 ObserverState.StatementStartPos:=Tool.CurPos.StartPos;
1705 end
1706 else if Tool.UpAtomIs('ELSE') then
1707 begin
1708 if ObserverState.TopType=cositCase then
1709 begin
1710 ObserverState.Pop;
1711 ObserverState.Push(cositCaseElse,Tool.CurPos.StartPos);
1712 end;
1713 ObserverState.StatementStartPos:=-1;
1714 CheckSubStatement(false);
1715 end
1716 else if Tool.UpAtomIs('DO') or Tool.UpAtomIs('THEN') then
1717 CheckSubStatement(false)
1718 else if Tool.UpAtomIs('OF') then
1719 CheckSubStatement(true);
1720 end;
1721 end;
1722 // read next atom
1723 Last2Atom:=Last1Atom;
1724 Last1Atom:=CurAtom;
1725 Tool.ReadNextAtom;
1726 end;
1727 end;
1728
1729 procedure TCodeExplorerView.FindObserverTodos(Tool: TCodeTool);
1730 var
1731 Src: String;
1732 p: Integer;
1733 CommentEndPos: LongInt;
1734 MagicStartPos: integer;
1735 TextStartPos: integer;
1736 TextEndPos: integer;
1737 l: Integer;
1738 SrcLen: Integer;
1739 Data: TViewNodeData;
1740 ObsTVNode: TTreeNode;
1741 NodeText: String;
1742 NodeImageIndCex: LongInt;
1743 TVNode: TTreeNode;
1744 begin
1745 Src:=Tool.Src;
1746 SrcLen:=length(Src);
1747 p:=1;
1748 repeat
1749 p:=FindNextComment(Src,p);
1750 if p>SrcLen then break;
1751 CommentEndPos:=FindCommentEnd(Src,p,Tool.Scanner.NestedComments);
1752 if GetToDoComment(Src,p,CommentEndPos,MagicStartPos,TextStartPos,TextEndPos)
1753 then begin
1754 // add todo
1755 ObsTVNode:=CreateObserverNode(Tool,cefcToDos);
1756 if fObserverNode.Count>=CodeObserverMaxNodes then begin
1757 fObserverCatOverflow[cefcToDos]:=true;
1758 break;
1759 end else begin
1760 Data:=TViewNodeData.Create(Tool.Tree.Root,false);
1761 Data.Desc:=ctnConstant;
1762 Data.SubDesc:=ctnsNone;
1763 Data.StartPos:=p;
1764 Data.EndPos:=MagicStartPos;
1765 l:=TextEndPos-TextStartPos;
1766 if l>20 then l:=20;
1767 NodeText:=TrimCodeSpace(copy(Src,TextStartPos,l));
1768 NodeImageIndCex:=ImgIDConst;
1769 TVNode:=CodeTreeview.Items.AddChild(ObsTVNode,NodeText);
1770 TVNode.Data:=Data;
1771 TVNode.Text:=NodeText;
1772 TVNode.ImageIndex:=NodeImageIndCex;
1773 TVNode.SelectedIndex:=NodeImageIndCex;
1774 end;
1775 end;
1776 p:=CommentEndPos;
1777 until p>SrcLen;
1778 end;
1779
1780 procedure TCodeExplorerView.CreateSurrounding(Tool: TCodeTool);
1781
CTNodeIsEnclosingnull1782 function CTNodeIsEnclosing(CTNode: TCodeTreeNode; p: integer): boolean;
1783 var
1784 NextCTNode: TCodeTreeNode;
1785 begin
1786 Result:=false;
1787 if (p<CTNode.StartPos) or (p>CTNode.EndPos) then exit;
1788 if (p=CTNode.EndPos) then begin
1789 NextCTNode:=CTNode.NextSkipChilds;
1790 if (NextCTNode<>nil) and (NextCTNode.StartPos<=p) then exit;
1791 end;
1792 Result:=true;
1793 end;
1794
1795 procedure CreateSubNodes(ParentTVNode: TTreeNode; CTNode: TCodeTreeNode;
1796 p: integer);
1797 var
1798 ChildCTNode: TCodeTreeNode;
1799 ChildData: TViewNodeData;
1800 ChildTVNode: TTreeNode;
1801 AddChilds: Boolean;
1802 Add: Boolean;
1803 CurParentTVNode: TTreeNode;
1804 begin
1805 ChildCTNode:=CTNode.FirstChild;
1806 while ChildCTNode<>nil do
1807 begin
1808 AddChilds:=false;
1809 Add:=false;
1810 if CTNodeIsEnclosing(ChildCTNode,p) then begin
1811 AddChilds:=true;
1812 Add:=true;
1813 if ChildCTNode.Desc in AllClasses then
1814 Add:=false;
1815 end else if (CTNode.Desc=ctnProcedure)
1816 and (ChildCTNode.Desc<>ctnProcedureHead) then begin
1817 Add:=true
1818 end;
1819
1820 CurParentTVNode:=ParentTVNode;
1821 if Add then
1822 begin
1823 ChildData:=TViewNodeData.Create(ChildCTNode,false);
1824 ChildTVNode:=CodeTreeview.Items.AddChildObject(
1825 ParentTVNode,GetCodeNodeDescription(Tool,ChildCTNode),ChildData);
1826 ChildTVNode.ImageIndex:=GetCodeNodeImage(Tool,ChildCTNode);
1827 ChildTVNode.SelectedIndex:=ChildTVNode.ImageIndex;
1828 CurParentTVNode:=ChildTVNode;
1829 end else
1830 ChildTVNode:=nil;
1831 if AddChilds then
1832 begin
1833 CreateSubNodes(CurParentTVNode,ChildCTNode,p);
1834 if ChildTVNode<>nil then
1835 ChildTVNode.Expanded:=true;
1836 end;
1837 ChildCTNode:=ChildCTNode.NextBrother;
1838 end;
1839 end;
1840
1841 var
1842 CodeNode: TCodeTreeNode;
1843 Data: TViewNodeData;
1844 TVNode: TTreeNode;
1845 CurPos: TCodeXYPosition;
1846 p: integer;
1847 begin
1848 if fSurroundingNode = nil then
1849 begin
1850 fSurroundingNode:=CodeTreeview.Items.Add(nil, lisCESurrounding);
1851 Data:=TViewNodeData.Create(Tool.Tree.Root,false);
1852 Data.Desc:=ctnNone;
1853 Data.StartPos:=Tool.SrcLen;
1854 fSurroundingNode.Data:=Data;
1855 fSurroundingNode.ImageIndex:=ImgIDSection;
1856 fSurroundingNode.SelectedIndex:=ImgIDSection;
1857 end;
1858
1859 CurPos.Code:=FLastCode;
1860 CurPos.X:=FLastCodeXY.X;
1861 CurPos.Y:=FLastCodeXY.Y;
1862 fLastCodeTool.CaretToCleanPos(CurPos,p);
1863
1864 // add all top lvl sections
1865 CodeNode:=Tool.Tree.Root;
1866 while CodeNode<>nil do begin
1867 Data:=TViewNodeData.Create(CodeNode,false);
1868 TVNode:=CodeTreeview.Items.AddChildObject(
1869 fSurroundingNode,GetCodeNodeDescription(Tool,CodeNode),Data);
1870 TVNode.ImageIndex:=GetCodeNodeImage(Tool,CodeNode);
1871 TVNode.SelectedIndex:=TVNode.ImageIndex;
1872 if CTNodeIsEnclosing(CodeNode,p) then
1873 CreateSubNodes(TVNode,CodeNode,p);
1874 TVNode.Expanded:=true;
1875
1876 CodeNode:=CodeNode.NextBrother;
1877 end;
1878 fSurroundingNode.Expanded:=true;
1879 end;
1880
1881 procedure TCodeExplorerView.DeleteTVNode(TVNode: TTreeNode);
1882 var
1883 c: TCodeExplorerCategory;
1884 oc: TCEObserverCategory;
1885 begin
1886 if TVNode=nil then exit;
1887 if TVNode.Data<>nil then begin
1888 if (TObject(TVNode.Data) is TViewNodeData) and (fCodeSortedForStartPos<>nil)
1889 then
1890 fCodeSortedForStartPos.Remove(TVNode);
1891 TObject(TVNode.Data).Free;
1892 TVNode.Data:=nil;
1893 end;
1894 if TVNode.Parent=nil then begin
1895 if TVNode=fObserverNode then
1896 fObserverNode:=nil
1897 else if TVNode=fSurroundingNode then
1898 fSurroundingNode:=nil
1899 else begin
1900 for c:=low(fCategoryNodes) to high(fCategoryNodes) do
1901 if fCategoryNodes[c]=TVNode then
1902 fCategoryNodes[c]:=nil;
1903 end;
1904 end else if TVNode=fObserverNode then begin
1905 for oc:=low(fObserverCatNodes) to high(fObserverCatNodes) do
1906 if fObserverCatNodes[oc]=TVNode then
1907 fObserverCatNodes[oc]:=nil;
1908 end;
1909 TVNode.Delete;
1910 end;
1911
1912 procedure TCodeExplorerView.SetCodeFilter(const AValue: string);
1913 begin
1914 if CodeFilter=AValue then exit;
1915 CodeFilterEdit.Text:=AValue;
1916 CodeFilterChanged;
1917 end;
1918
1919 procedure TCodeExplorerView.SetCurrentPage(const AValue: TCodeExplorerPage);
1920 begin
1921 case AValue of
1922 cepCode: MainNotebook.ActivePage:=CodePage;
1923 cepDirectives: MainNotebook.ActivePage:=DirectivesPage;
1924 end;
1925 end;
1926
1927 procedure TCodeExplorerView.SetDirectivesFilter(const AValue: string);
1928 begin
1929 if DirectivesFilter=AValue then exit;
1930 DirectivesFilterEdit.Text:=AValue;
1931 DirectivesFilterChanged;
1932 end;
1933
1934 procedure TCodeExplorerView.SetMode(AMode: TCodeExplorerMode);
1935 begin
1936 if FMode=AMode then exit;
1937 FMode:=AMode;
1938 UpdateMode;
1939 end;
1940
1941 procedure TCodeExplorerView.UpdateMode;
1942 begin
1943 if FMode=cemCategory
1944 then begin
1945 IDEImages.AssignImage(CodeModeSpeedButton, 'show_category');
1946 CodeModeSpeedButton.Hint:=lisCEModeShowSourceNodes;
1947 end
1948 else begin
1949 IDEImages.AssignImage(CodeModeSpeedButton, 'show_source');
1950 CodeModeSpeedButton.Hint:=lisCEModeShowCategories;
1951 end;
1952 Refresh(true);
1953 end;
1954
1955 procedure TCodeExplorerView.UpdateCaption;
1956 var
1957 s: String;
1958 begin
1959 s:=lisMenuViewCodeExplorer;
1960 if (CodeExplorerOptions.Refresh=cerManual) and (FCodeFilename<>'') then
1961 s+=' - ' + ExtractFileName(FCodeFilename);
1962 Caption:=s;
1963 end;
1964
OnExpandedStateGetNodeTextnull1965 function TCodeExplorerView.OnExpandedStateGetNodeText(Node: TTreeNode): string;
1966 var
1967 p: Integer;
1968 begin
1969 Result:=Node.Text;
1970 if Result='' then exit;
1971 p:=length(Result);
1972 if Result[p]=')' then begin
1973 dec(p);
1974 while (p>1) and (Result[p] in ['+','0'..'9']) do dec(p);
1975 if (p>1) and (Result[p]='(') then begin
1976 repeat
1977 dec(p);
1978 until (p=0) or (Result[p]<>' ');
1979 SetLength(Result,p);
1980 end;
1981 end;
1982 end;
1983
1984 procedure TCodeExplorerView.KeyDown(var Key: Word; Shift: TShiftState);
1985 begin
1986 inherited KeyDown(Key, Shift);
1987 ExecuteIDEShortCut(Self,Key,Shift,nil);
1988 end;
1989
1990 procedure TCodeExplorerView.ApplyCodeFilter;
1991 var
1992 ANode, NextNode: TTreeNode;
1993 TheFilter: String;
1994 begin
1995 TheFilter:=GetCodeFilter;
1996 //DebugLn(['TCodeExplorerView.ApplyCodeFilter ====================="',TheFilter,'"']);
1997 FLastCodeFilter:=TheFilter;
1998 CodeTreeview.BeginUpdate;
1999 ANode:=CodeTreeview.Items.GetFirstNode;
2000 while ANode<>nil do begin
2001 NextNode:=ANode.GetNextSibling;
2002 FilterNode(ANode,TheFilter,True);
2003 ANode:=NextNode;
2004 end;
2005 CodeTreeview.EndUpdate;
2006 end;
2007
2008 procedure TCodeExplorerView.ApplyDirectivesFilter;
2009 var
2010 ANode, NextNode: TTreeNode;
2011 TheFilter: String;
2012 begin
2013 TheFilter:=GetDirectivesFilter;
2014 //DebugLn(['TCodeExplorerView.ApplyDirectivesFilter ====================="',TheFilter,'"']);
2015 FLastDirectivesFilter:=TheFilter;
2016 DirectivesTreeView.BeginUpdate;
2017 //DirectivesTreeView.Options:=DirectivesTreeView.Options+[tvoAllowMultiselect];
2018 ANode:=DirectivesTreeView.Items.GetFirstNode;
2019 while ANode<>nil do begin
2020 NextNode:=ANode.GetNextSibling;
2021 FilterNode(ANode,TheFilter,False);
2022 ANode:=NextNode;
2023 end;
2024 DirectivesTreeView.EndUpdate;
2025 end;
2026
2027 procedure TCodeExplorerView.BeginUpdate;
2028 begin
2029 inc(FUpdateCount);
2030 end;
2031
2032 procedure TCodeExplorerView.EndUpdate;
2033 var
2034 CurPage: TCodeExplorerPage;
2035 begin
2036 if FUpdateCount<=0 then
2037 RaiseGDBException('TCodeExplorerView.EndUpdate');
2038 dec(FUpdateCount);
2039 if FUpdateCount=0 then begin
2040 CurPage:=CurrentPage;
2041 if (CurPage=cepCode) and (cevCodeRefreshNeeded in FFlags) then
2042 RefreshCode(true);
2043 if (CurPage=cepDirectives) and (cevDirectivesRefreshNeeded in FFlags) then
2044 RefreshDirectives(true);
2045 end;
2046 end;
2047
2048 procedure TCodeExplorerView.CheckOnIdle;
2049 begin
2050 Include(FFlags,cevCheckOnIdle);
2051 end;
2052
2053 procedure TCodeExplorerView.Refresh(OnlyVisible: boolean);
2054 begin
2055 Exclude(FFlags,cevCheckOnIdle);
2056 //debugln(['TCodeExplorerView.Refresh ']);
2057 RefreshCode(OnlyVisible);
2058 RefreshDirectives(OnlyVisible);
2059 end;
2060
2061 procedure TCodeExplorerView.RefreshCode(OnlyVisible: boolean);
2062
2063 procedure AutoExpandNodes;
2064 var
2065 TVNode: TTreeNode;
2066 Data: TViewNodeData;
2067 ShowInterfaceImplementation: Boolean;
2068 begin
2069 ShowInterfaceImplementation:=(Mode <> cemCategory)
2070 or (not (cecSurrounding in CodeExplorerOptions.Categories));
2071 if not ShowInterfaceImplementation then exit;
2072 TVNode:=CodeTreeview.Items.GetFirstNode;
2073 while TVNode<>nil do begin
2074 Data:=TViewNodeData(TVNode.Data);
2075 if Data.Desc in [ctnInterface,ctnImplementation] then begin
2076 // auto expand interface and implementation nodes
2077 TVNode.Expanded:=true;
2078 end;
2079 TVNode:=TVNode.GetNext;
2080 end;
2081 end;
2082
2083 procedure DeleteDuplicates(ACodeTool: TCodeTool);
2084
IsForwardnull2085 function IsForward(Data: TViewNodeData): boolean;
2086 begin
2087 if Data.Desc=ctnProcedure then
2088 begin
2089 if (Data.CTNode.Parent<>nil) and (Data.CTNode.Parent.Desc=ctnInterface)
2090 then
2091 exit(true);
2092 if ACodeTool.NodeIsForwardProc(Data.CTNode) then
2093 exit(true);
2094 end;
2095 Result:=false;
2096 end;
2097
2098 var
2099 TVNode: TTreeNode;
2100 NextTVNode: TTreeNode;
2101 Data: TViewNodeData;
2102 NextData: TViewNodeData;
2103 DeleteNode: Boolean;
2104 DeleteNextNode: Boolean;
2105 begin
2106 TVNode:=CodeTreeview.Items.GetFirstNode;
2107 while TVNode<>nil do begin
2108 NextTVNode:=TVNode.GetNext;
2109 if NextTVNode=nil then break;
2110 if (TVNode.Parent<>nil) and (NextTVNode.Parent=TVNode.Parent) then
2111 begin
2112 DeleteNode:=false;
2113 DeleteNextNode:=false;
2114 if (CompareTextIgnoringSpace(TVNode.Text,NextTVNode.Text,false)=0) then
2115 begin
2116 Data:=TViewNodeData(TVNode.Data);
2117 NextData:=TViewNodeData(NextTVNode.Data);
2118 if IsForward(Data) then
2119 DeleteNode:=true;
2120 if IsForward(NextData) then
2121 DeleteNextNode:=true;
2122 end;
2123 if DeleteNextNode then begin
2124 DeleteTVNode(NextTVNode);
2125 NextTVNode:=TVNode;
2126 end else if DeleteNode then begin
2127 NextTVNode:=TVNode.GetNextSkipChildren;
2128 DeleteTVNode(TVNode);
2129 end;
2130 end;
2131 TVNode:=NextTVNode;
2132 end;
2133 end;
2134
2135 var
2136 OldExpanded: TTreeNodeExpandedState;
2137 ACodeTool: TCodeTool;
2138 SrcEdit: TSourceEditorInterface;
2139 Filename: String;
2140 Code: TCodeBuffer;
2141 NewXY: TPoint;
2142 OnlyXYChanged: Boolean;
2143 CurFollowNode: Boolean;
2144 TVNode: TTreeNode;
2145 TheFilter: String;
2146 begin
2147 if (FUpdateCount>0)
2148 or (OnlyVisible and ((CurrentPage<>cepCode) or (not IsVisible))) then begin
2149 Include(FFlags,cevCodeRefreshNeeded);
2150 exit;
2151 end;
2152 Exclude(FFlags,cevCodeRefreshNeeded);
2153 fLastCodeTool:=nil;
2154 OldExpanded:=nil;
2155 try
2156 Include(FFlags,cevRefreshing);
2157
2158 // get the current editor
2159 if not LazarusIDE.BeginCodeTools then exit;
2160 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2161 if SrcEdit=nil then exit;
2162 // get the codetool for the current editor
2163 Filename:=SrcEdit.FileName;
2164 Code:=CodeToolBoss.FindFile(Filename);
2165 if Code=nil then exit;
2166 ACodeTool:=nil;
2167 // ToDo: check if something changed (file stamp, codebuffer stamp, defines stamp)
2168 CodeToolBoss.Explore(Code,ACodeTool,false);
2169 if ACodeTool=nil then exit;
2170
2171 fLastCodeTool:=ACodeTool;
2172 FLastCode:=Code;
2173
2174 // check for changes in the codetool
2175 TheFilter:=GetCodeFilter;
2176 OnlyXYChanged:=false;
2177 if (ACodeTool=nil) then begin
2178 if (FCodeFilename='') then begin
2179 // still no tool
2180 exit;
2181 end;
2182 //debugln(['TCodeExplorerView.RefreshCode no tool']);
2183 end else begin
2184 if CompareText(FLastCodeFilter,TheFilter)<>0 then begin
2185 // debugln(['TCodeExplorerView.RefreshCode filter changed']);
2186 end else if not FLastCodeValid then begin
2187 //debugln(['TCodeExplorerView.RefreshCode last code not valid'])
2188 end else if ACodeTool.MainFilename<>FCodeFilename then begin
2189 //debugln(['TCodeExplorerView.RefreshCode File changed ',ACodeTool.MainFilename,' ',FCodeFilename])
2190 end else if (ACodeTool.Scanner=nil) then begin
2191 //debugln(['TCodeExplorerView.RefreshCode Scanner=nil'])
2192 end else if (ACodeTool.Scanner.ChangeStep<>FLastCodeChangeStep) then begin
2193 //debugln(['TCodeExplorerView.RefreshCode Scanner changed ',ACodeTool.Scanner.ChangeStep,' ',FLastCodeChangeStep])
2194 end else if (Mode<>FLastMode) then begin
2195 //debugln(['TCodeExplorerView.RefreshCode Mode changed ',ord(Mode),' ',ord(FLastMode)])
2196 end else if (fLastCodeOptionsChangeStep<>CodeExplorerOptions.ChangeStep) then begin
2197 //debugln(['TCodeExplorerView.RefreshCode Options changed ',fLastCodeOptionsChangeStep,' ',CodeExplorerOptions.ChangeStep])
2198 end else begin
2199 // still the same source and options
2200 OnlyXYChanged:=true;
2201 if not CodeExplorerOptions.FollowCursor then
2202 exit;
2203 NewXY:=SrcEdit.CursorTextXY;
2204 //debugln(['TCodeExplorerView.RefreshCode ',dbgs(NewXY),' ',dbgs(FLastCodeXY)]);
2205 if ComparePoints(NewXY,FLastCodeXY)=0 then begin
2206 // still the same cursor position
2207 exit;
2208 end;
2209 FLastCodeXY:=NewXY;
2210 end;
2211 end;
2212
2213 if OnlyXYChanged then begin
2214 SelectCodePosition(Code,FLastCodeXY.X,FLastCodeXY.Y);
2215 end else begin
2216
2217 FLastCodeValid:=true;
2218 FLastMode:=Mode;
2219 fLastCodeOptionsChangeStep:=CodeExplorerOptions.ChangeStep;
2220 FLastCodeXY:=SrcEdit.CursorTextXY;
2221 FLastCodeFilter:=TheFilter;
2222 // remember the codetools ChangeStep
2223 if ACodeTool<>nil then begin
2224 FCodeFilename:=ACodeTool.MainFilename;
2225 if ACodeTool.Scanner<>nil then
2226 FLastCodeChangeStep:=ACodeTool.Scanner.ChangeStep;
2227 end else
2228 FCodeFilename:='';
2229
2230 if fCodeSortedForStartPos<>nil then
2231 fCodeSortedForStartPos.Clear;
2232 fNodesWithPath.Clear;
2233
2234 //DebugLn(['TCodeExplorerView.RefreshCode ',FCodeFilename]);
2235
2236 CurFollowNode:=CodeExplorerOptions.FollowCursor and (not Active);
2237
2238 // start updating the CodeTreeView
2239 CodeTreeview.BeginUpdate;
2240 if not CurFollowNode then
2241 OldExpanded:=TTreeNodeExpandedState.Create(CodeTreeView,@OnExpandedStateGetNodeText);
2242
2243 ClearCodeTreeView;
2244
2245 if (ACodeTool<>nil) and (ACodeTool.Tree<>nil) and (ACodeTool.Tree.Root<>nil)
2246 then begin
2247 CreateIdentifierNodes(ACodeTool,ACodeTool.Tree.Root,nil);
2248 if (Mode = cemCategory) then
2249 begin
2250 if (cecCodeObserver in CodeExplorerOptions.Categories) then
2251 CreateObservations(ACodeTool);
2252 if (cecSurrounding in CodeExplorerOptions.Categories) then
2253 CreateSurrounding(ACodeTool);
2254 end;
2255 end;
2256
2257 // sort nodes
2258 fSortCodeTool:=ACodeTool;
2259 TVNode:=CodeTreeview.Items.GetFirstNode;
2260 while TVNode<>nil do begin
2261 if (TVNode.GetFirstChild<>nil)
2262 and (TObject(TVNode.Data) is TViewNodeData)
2263 and TViewNodeData(TVNode.Data).SortChildren then begin
2264 TVNode.CustomSort(@CompareCodeNodes);
2265 end;
2266 TVNode:=TVNode.GetNext;
2267 end;
2268
2269 DeleteDuplicates(ACodeTool);
2270
2271 // restore old expanded state
2272 if not CurFollowNode then
2273 AutoExpandNodes;
2274
2275 BuildCodeSortedForStartPos;
2276 // clear references to the TCodeTreeNode to avoid dangling pointers
2277 ClearCTNodes(CodeTreeview);
2278
2279 ApplyCodeFilter;
2280
2281 if OldExpanded<>nil then
2282 OldExpanded.Apply(CodeTreeView,false);
2283
2284 if CurFollowNode then
2285 SelectCodePosition(Code,FLastCodeXY.X,FLastCodeXY.Y);
2286
2287 CodeTreeview.EndUpdate;
2288 end;
2289 UpdateCaption;
2290 if HostDockSite <> nil then
2291 HostDockSite.UpdateDockCaption();
2292 finally
2293 Exclude(FFlags,cevRefreshing);
2294 OldExpanded.Free;
2295 end;
2296 end;
2297
2298 procedure TCodeExplorerView.RefreshDirectives(OnlyVisible: boolean);
2299 var
2300 ADirectivesTool: TDirectivesTool;
2301 OldExpanded: TTreeNodeExpandedState;
2302 begin
2303 if (FUpdateCount>0)
2304 or (OnlyVisible and ((CurrentPage<>cepDirectives) or (not IsVisible))) then
2305 begin
2306 Include(FFlags,cevDirectivesRefreshNeeded);
2307 exit;
2308 end;
2309 Exclude(FFlags,cevDirectivesRefreshNeeded);
2310
2311 try
2312 Include(FFlags,cevRefreshing);
2313
2314 // get the directivestool with the updated tree
2315 ADirectivesTool:=nil;
2316 if Assigned(OnGetDirectivesTree) then
2317 OnGetDirectivesTree(Self,ADirectivesTool);
2318
2319 // check for changes in the codetools
2320 if (ADirectivesTool=nil) then begin
2321 if (FDirectivesFilename='') then begin
2322 // still no tool
2323 exit;
2324 end;
2325 end else begin
2326 if (ADirectivesTool.Code.Filename=FDirectivesFilename)
2327 and (ADirectivesTool.ChangeStep=FLastDirectivesChangeStep) then begin
2328 // still the same source
2329 exit;
2330 end;
2331 end;
2332
2333 // remember the codetools ChangeStep
2334 if ADirectivesTool<>nil then begin
2335 FDirectivesFilename:=ADirectivesTool.Code.Filename;
2336 FLastDirectivesChangeStep:=ADirectivesTool.ChangeStep;
2337 end else
2338 FDirectivesFilename:='';
2339
2340 //DebugLn(['TCodeExplorerView.RefreshDirectives ',FDirectivesFilename]);
2341
2342 // start updating the DirectivesTreeView
2343 DirectivesTreeView.BeginUpdate;
2344 OldExpanded:=TTreeNodeExpandedState.Create(DirectivesTreeView);
2345
2346 ClearDirectivesTreeView;
2347 if (ADirectivesTool<>nil) and (ADirectivesTool.Tree<>nil)
2348 and (ADirectivesTool.Tree.Root<>nil) then
2349 begin
2350 CreateDirectiveNodes(ADirectivesTool,ADirectivesTool.Tree.Root,nil);
2351 end;
2352
2353 // restore old expanded state
2354 OldExpanded.Apply(DirectivesTreeView);
2355 OldExpanded.Free;
2356 ClearCTNodes(DirectivesTreeView);
2357
2358 ApplyDirectivesFilter;
2359
2360 DirectivesTreeView.EndUpdate;
2361
2362 finally
2363 Exclude(FFlags,cevRefreshing);
2364 end;
2365 end;
2366
2367 procedure TCodeExplorerView.ClearCTNodes(ATreeView: TTreeView);
2368 var
2369 TVNode: TTreeNode;
2370 NodeData: TViewNodeData;
2371 begin
2372 TVNode:=ATreeView.Items.GetFirstNode;
2373 while TVNode<>nil do begin
2374 NodeData:=TViewNodeData(TVNode.Data);
2375 NodeData.CTNode:=nil;
2376 TVNode:=TVNode.GetNext;
2377 end;
2378 end;
2379
TCodeExplorerView.JumpToSelectionnull2380 function TCodeExplorerView.JumpToSelection(ToImplementation: boolean): boolean;
2381 var
2382 CurItem: TTreeNode;
2383 CurNode: TViewNodeData;
2384 Caret: TCodeXYPosition;
2385 NewTopLine: integer;
2386 CodeBuffer: TCodeBuffer;
2387 ACodeTool: TCodeTool;
2388 CurTreeView: TCustomTreeView;
2389 SrcEdit: TSourceEditorInterface;
2390 NewNode: TCodeTreeNode;
2391 p: LongInt;
2392 begin
2393 Result:=false;
2394 CurTreeView:=GetCurrentTreeView;
2395 if CurTreeView=nil then exit;
2396 if tvoAllowMultiselect in CurTreeView.Options then
2397 CurItem:=CurTreeView.GetFirstMultiSelected
2398 else
2399 CurItem:=CurTreeView.Selected;
2400 if CurItem=nil then exit;
2401 CurNode:=TViewNodeData(CurItem.Data);
2402 if ToImplementation then begin
2403 CurNode:=CurNode.ImplementationNode;
2404 if CurNode=nil then exit;
2405 end;
2406 if CurNode.StartPos<1 then exit;
2407 CodeBuffer:=nil;
2408 case CurrentPage of
2409 cepCode:
2410 begin
2411 CodeBuffer:=CodeToolBoss.LoadFile(CodeFilename,false,false);
2412 if CodeBuffer=nil then exit;
2413 ACodeTool:=nil;
2414 CodeToolBoss.Explore(CodeBuffer,ACodeTool,false);
2415 if ACodeTool=nil then exit;
2416 p:=CurNode.StartPos;
2417 NewNode:=ACodeTool.FindDeepestNodeAtPos(p,false);
2418 if NewNode<>nil then begin
2419 if (NewNode.Desc=ctnProcedure)
2420 and (NewNode.FirstChild<>nil)
2421 and (NewNode.FirstChild.Desc=ctnProcedureHead)
2422 and (NewNode.FirstChild.StartPos>p) then
2423 p:=NewNode.FirstChild.StartPos;
2424 if NewNode.Desc=ctnProperty then begin
2425 if ACodeTool.MoveCursorToPropName(NewNode) then
2426 p:=ACodeTool.CurPos.StartPos;
2427 end;
2428 end;
2429 if not ACodeTool.CleanPosToCaretAndTopLine(p,Caret,NewTopLine)
2430 then exit;
2431 end;
2432 cepDirectives:
2433 begin
2434 CodeBuffer:=CodeToolBoss.LoadFile(DirectivesFilename,false,false);
2435 if CodeBuffer=nil then exit;
2436 CodeBuffer.AbsoluteToLineCol(CurNode.StartPos,Caret.Y,Caret.X);
2437 if Caret.Y<1 then exit;
2438 Caret.Code:=CodeBuffer;
2439 NewTopLine:=Caret.Y-(CodeToolBoss.VisibleEditorLines div 2);
2440 if NewTopLine<1 then NewTopLine:=1;
2441 end;
2442 else
2443 exit;
2444 end;
2445 if Assigned(OnJumpToCode) then
2446 OnJumpToCode(Self,Caret.Code.Filename,Point(Caret.X,Caret.Y),NewTopLine);
2447 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2448 //DebugLn(['TCodeExplorerView.JumpToSelection ',SrcEdit.FileName,' ',dbgs(SrcEdit.CursorTextXY),' X=',Caret.X,' Y=',Caret.Y]);
2449 // check if jump was successful
2450 if (SrcEdit.CodeToolsBuffer<>CodeBuffer)
2451 or (SrcEdit.CursorTextXY.X<>Caret.X) or (SrcEdit.CursorTextXY.Y<>Caret.Y) then
2452 exit;
2453 Result:=true;
2454 end;
2455
SelectSourceEditorNodenull2456 function TCodeExplorerView.SelectSourceEditorNode: boolean;
2457 var
2458 SrcEdit: TSourceEditorInterface;
2459 xy: TPoint;
2460 begin
2461 Result:=false;
2462 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2463 if SrcEdit=nil then exit;
2464 xy:=SrcEdit.CursorTextXY;
2465 Result:=SelectCodePosition(TCodeBuffer(SrcEdit.CodeToolsBuffer),xy.x,xy.y);
2466 end;
2467
SelectCodePositionnull2468 function TCodeExplorerView.SelectCodePosition(CodeBuf: TCodeBuffer; X,
2469 Y: integer): boolean;
2470 var
2471 CodePos: TCodeXYPosition;
2472 CleanPos: integer;
2473 TVNode: TTreeNode;
2474 begin
2475 Result:=false;
2476 if CurrentPage=cepCode then begin
2477 if FLastCodeValid and (fLastCodeTool<>nil) then begin
2478 CodePos:=CodeXYPosition(X,Y,CodeBuf);
2479 CodeBuf.LineColToPosition(Y,X,CleanPos);
2480 //debugln(['TCodeExplorerView.SelectCodePosition Code ',ExtractFileName(CodeBuf.Filename),' y=',y,' x=',x,' CleanPos=',CleanPos,' ',dbgstr(copy(CodeBuf.Source,CleanPos-20,20)),'|',dbgstr(copy(CodeBuf.Source,CleanPos,20))]);
2481 if fLastCodeTool.CaretToCleanPos(CodePos,CleanPos)<>0 then exit;
2482 //debugln(['TCodeExplorerView.SelectCodePosition CleanSrc ',ExtractFileName(CodeBuf.Filename),' y=',y,' x=',x,' Tool=',ExtractFileName(fLastCodeTool.MainFilename),' ',dbgstr(copy(fLastCodeTool.Src,CleanPos-20,20)),'|',dbgstr(copy(fLastCodeTool.Src,CleanPos,20))]);
2483 TVNode:=FindCodeTVNodeAtCleanPos(CleanPos);
2484 if TVNode=nil then exit;
2485 //debugln(['TCodeExplorerView.SelectCodePosition ',TVNode.Text]);
2486 CodeTreeview.BeginUpdate;
2487 CodeTreeview.Options:=CodeTreeview.Options-[tvoAllowMultiselect];
2488 if not TVNode.IsVisible then begin
2489 // collapse all other and expand only this
2490 CodeTreeview.FullCollapse;
2491 CodeTreeview.Selected:=TVNode;
2492 //debugln(['TCodeExplorerView.SelectCodePosition ',TVNode.Text]);
2493 end else begin
2494 CodeTreeview.Selected:=TVNode;
2495 //debugln(['TCodeExplorerView.SelectCodePosition ',TVNode.Text]);
2496 end;
2497 //debugln(['TCodeExplorerView.SelectCodePosition TVNode=',TVNode.Text,' Selected=',CodeTreeview.Selected=TVNode]);
2498 CodeTreeview.EndUpdate;
2499 Result:=true;
2500 end;
2501 end;
2502 end;
2503
TCodeExplorerView.FindCodeTVNodeAtCleanPosnull2504 function TCodeExplorerView.FindCodeTVNodeAtCleanPos(CleanPos: integer): TTreeNode;
2505 // find TTreeNode in CodeTreeView containing the codetools clean position
2506 // if there are several nodes, the one with the shortest range (EndPos-StartPos)
2507 // is returned.
2508 var
2509 Best: TTreeNode;
2510 BestStartPos, BestEndPos: integer;
2511
2512 procedure Check(TVNode: TTreeNode; NodeData: TViewNodeData);
2513 begin
2514 if NodeData=nil then exit;
2515 if (NodeData.StartPos>CleanPos) or (NodeData.EndPos<CleanPos) then exit;
2516 //debugln(['FindCodeTVNodeAtCleanPos.Check TVNode="',TVNode.Text,'" NodeData="',dbgstr(copy(fLastCodeTool.Src,NodeData.StartPos,40)),'"']);
2517 if (Best<>nil) then begin
2518 if (BestEndPos=CleanPos) and (NodeData.EndPos>CleanPos) then begin
2519 // for example a,|b then b is better
2520 end else if BestEndPos-BestStartPos > NodeData.EndPos-NodeData.StartPos then begin
2521 // smaller range is better
2522 end else
2523 exit;
2524 end;
2525 Best:=TVNode;
2526 BestStartPos:=NodeData.StartPos;
2527 BestEndPos:=NodeData.EndPos;
2528 end;
2529
2530 var
2531 AVLNode: TAvlTreeNode;
2532 Node: TTreeNode;
2533 NodeData: TViewNodeData;
2534 begin
2535 Result:=nil;
2536 if (fLastCodeTool=nil) or (not FLastCodeValid) or (CodeTreeview=nil)
2537 or (fCodeSortedForStartPos=nil) then exit;
2538
2539 // find nearest node in tree
2540 Best:=nil;
2541 BestStartPos:=0;
2542 BestEndPos:=0;
2543 AVLNode:=fCodeSortedForStartPos.FindLowest;
2544 while AVLNode<>nil do begin
2545 Node:=TTreeNode(AVLNode.Data);
2546 NodeData:=TViewNodeData(Node.Data);
2547 //debugln(['TCodeExplorerView.FindCodeTVNodeAtCleanPos Node ',NodeData.StartPos,'-',NodeData.EndPos,' ',Node.Text,' ',CleanPos]);
2548 Check(Node,NodeData);
2549 Check(Node,NodeData.ImplementationNode);
2550 AVLNode:=fCodeSortedForStartPos.FindSuccessor(AVLNode);
2551 end;
2552 Result:=Best;
2553 end;
2554
2555 procedure TCodeExplorerView.BuildCodeSortedForStartPos;
2556 var
2557 TVNode: TTreeNode;
2558 NodeData: TViewNodeData;
2559 begin
2560 if fCodeSortedForStartPos<>nil then
2561 fCodeSortedForStartPos.Clear;
2562 if (CodeTreeview=nil) then exit;
2563 TVNode:=CodeTreeview.Items.GetFirstNode;
2564 while TVNode<>nil do begin
2565 if TVNode.Parent=nil then begin
2566 if (TVNode=fObserverNode) or (TVNode=fSurroundingNode) then break;
2567 end;
2568 NodeData:=TViewNodeData(TVNode.Data);
2569 if (NodeData<>nil) and (NodeData.StartPos>0)
2570 and (NodeData.EndPos>=NodeData.StartPos) then begin
2571 if fCodeSortedForStartPos=nil then
2572 fCodeSortedForStartPos:=TAvlTree.Create(TListSortCompare(@CompareViewNodeDataStartPos));
2573 fCodeSortedForStartPos.Add(TVNode);
2574 end;
2575 TVNode:=TVNode.GetNext;
2576 end;
2577 end;
2578
2579 procedure TCodeExplorerView.CurrentCodeBufferChanged;
2580 begin
2581 if CodeExplorerOptions.Refresh=cerSwitchEditorPage then
2582 CheckOnIdle;
2583 end;
2584
2585 procedure TCodeExplorerView.CodeFilterChanged;
2586 var
2587 TheFilter: String;
2588 begin
2589 TheFilter:=GetCodeFilter;
2590 if FLastCodeFilter=TheFilter then exit;
2591 if (FUpdateCount>0) or (CurrentPage<>cepCode) then begin
2592 Include(FFlags,cevCodeRefreshNeeded);
2593 exit;
2594 end;
2595 if (FLastCodeFilter='') or (PosI(FLastCodeFilter,TheFilter)>0)
2596 then begin
2597 // longer filter => just delete nodes
2598 ApplyCodeFilter;
2599 end else begin
2600 CheckOnIdle;
2601 end;
2602 end;
2603
2604 procedure TCodeExplorerView.DirectivesFilterChanged;
2605 var
2606 TheFilter: String;
2607 begin
2608 TheFilter:=DirectivesFilterEdit.Text;
2609 if FLastDirectivesFilter=TheFilter then exit;
2610 if (FUpdateCount>0) or (CurrentPage<>cepDirectives) then begin
2611 Include(FFlags,cevDirectivesRefreshNeeded);
2612 exit;
2613 end;
2614 FLastDirectivesChangeStep:=CTInvalidChangeStamp;
2615 RefreshDirectives(False);
2616 end;
2617
FilterNodenull2618 function TCodeExplorerView.FilterNode(ANode: TTreeNode;
2619 const TheFilter: string; KeepTopLevel: Boolean): boolean;
2620 // Return True if ANode passes the filter. Delete nodes which do not pass.
2621 // Filter recursively all subnodes.
2622 var
2623 ChildNode, NextNode: TTreeNode;
2624 ChildPass, ChildrenPassed: Boolean;
2625 begin
2626 if ANode=nil then exit(false);
2627 ChildNode:=ANode.GetFirstChild;
2628 ChildrenPassed:=false;
2629 while ChildNode<>nil do begin
2630 NextNode:=ChildNode.GetNextSibling;
2631 ChildPass:=FilterNode(ChildNode,TheFilter,KeepTopLevel);
2632 ChildrenPassed:=ChildrenPassed or ChildPass;
2633 ChildNode:=NextNode;
2634 end;
2635 Result:=((ANode.Parent=nil) and KeepTopLevel)
2636 or ChildrenPassed or FilterFits(ANode.Text,TheFilter);
2637 //DebugLn(['TCodeExplorerView.FilterNode "',ANode.Text,'" Parent=',ANode.Parent,
2638 // ' Child=',ANode.GetFirstChild,' Filter=',FilterFits(ANode.Text,TheFilter),' Result=',Result]);
2639 if Result then begin
2640 if ChildrenPassed and (TheFilter<>'') then
2641 ANode.Expanded:=True;
2642 end
2643 else
2644 DeleteTVNode(ANode);
2645 end;
2646
FilterFitsnull2647 function TCodeExplorerView.FilterFits(const NodeText, TheFilter: string): boolean;
2648 var
2649 Src: PChar;
2650 PFilter: PChar;
2651 c: Char;
2652 i: Integer;
2653 begin
2654 Result:=false;
2655 if TheFilter='' then
2656 Result:=true
2657 else if NodeText<>'' then begin
2658 Src:=PChar(NodeText);
2659 PFilter:=PChar(TheFilter);
2660 repeat
2661 c:=Src^;
2662 if c<>#0 then begin
2663 if UpChars[Src^]=UpChars[PFilter^] then begin
2664 i:=1;
2665 while (UpChars[Src[i]]=UpChars[PFilter[i]]) and (PFilter[i]<>#0) do
2666 inc(i);
2667 if PFilter[i]=#0 then begin
2668 //DebugLn(['TCodeExplorerView.FilterFits Fits "',NodeText,'" "',TheFilter,'"']);
2669 exit(true);
2670 end;
2671 end;
2672 end else
2673 exit(false);
2674 inc(Src);
2675 until false;
2676 end;
2677 end;
2678
GetCurrentTreeViewnull2679 function TCodeExplorerView.GetCurrentTreeView: TCustomTreeView;
2680 begin
2681 case CurrentPage of
2682 cepCode: Result:=CodeTreeview;
2683 cepDirectives: Result:=DirectivesTreeView;
2684 else Result:=nil;
2685 end;
2686 end;
2687
TCodeExplorerView.GetCTNodePathnull2688 function TCodeExplorerView.GetCTNodePath(ACodeTool: TCodeTool;
2689 CodeNode: TCodeTreeNode): string;
2690 var
2691 CurName: String;
2692 begin
2693 Result:='';
2694 try
2695 while CodeNode<>nil do begin
2696 CurName:='';
2697 case CodeNode.Desc of
2698
2699 ctnTypeDefinition,
2700 ctnVarDefinition,
2701 ctnConstDefinition,
2702 ctnEnumIdentifier:
2703 CurName:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
2704
2705 ctnUseUnit:
2706 CurName:=ACodeTool.ExtractDottedIdentifier(CodeNode.StartPos);
2707
2708 ctnGenericType:
2709 CurName:=ACodeTool.ExtractDefinitionName(CodeNode);
2710
2711 ctnProcedure:
2712 CurName:=ACodeTool.ExtractProcName(CodeNode,[]);
2713
2714 ctnProperty:
2715 CurName:=ACodeTool.ExtractPropName(CodeNode,false); // property keyword is not needed because there are icons
2716
2717 end;
2718 if CurName<>'' then begin
2719 if Result<>'' then Result:='.'+Result;
2720 Result:=CurName+Result;
2721 end;
2722 CodeNode:=CodeNode.Parent;
2723 end;
2724 except
2725 on E: ECodeToolError do
2726 Result:=''; // ignore syntax errors
2727 end;
2728 end;
2729
2730 procedure TCodeExplorerView.CreateNodePath(ACodeTool: TCodeTool;
2731 aNodeData: TObject);
2732 var
2733 NodeData: TViewNodeData absolute aNodeData;
2734 AVLNode: TAvlTreeNode;
2735 begin
2736 if NodeData.CTNode.Desc=ctnProcedure then
2737 NodeData.Path:=GetCTNodePath(ACodeTool,NodeData.CTNode);
2738 if NodeData.Path='' then exit;
2739 AVLNode:=fNodesWithPath.FindKey(NodeData,@CompareViewNodePaths);
2740 if AVLNode=nil then begin
2741 // unique path
2742 fNodesWithPath.Add(NodeData);
2743 exit;
2744 end;
2745 // there is already a node with this path
2746 // => add params to distinguish overloads
2747 NodeData.CreateParams(ACodeTool);
2748 TViewNodeData(AVLNode.Data).CreateParams(ACodeTool);
2749 fNodesWithPath.Add(NodeData);
2750 end;
2751
2752 procedure TCodeExplorerView.AddImplementationNode(ACodeTool: TCodeTool;
2753 CodeNode: TCodeTreeNode);
2754 var
2755 NodeData: TViewNodeData;
2756 AVLNode: TAvlTreeNode;
2757 DeclData: TViewNodeData;
2758 begin
2759 if (CodeNode.Desc=ctnProcedure)
2760 and ((ctnsForwardDeclaration and CodeNode.SubDesc)=0) then begin
2761 NodeData:=TViewNodeData.Create(CodeNode);
2762 try
2763 NodeData.Path:=GetCTNodePath(ACodeTool,NodeData.CTNode);
2764 if NodeData.Path='' then exit;
2765 //debugln(['TCodeExplorerView.AddImplementationNode Proc=',NodeData.Path]);
2766 AVLNode:=fNodesWithPath.FindKey(NodeData,@CompareViewNodePaths);
2767 if (AVLNode=nil) or (TViewNodeData(AVLNode.Data).ImplementationNode<>nil)
2768 then begin
2769 // there is no declaration, or there is already an implementation
2770 // => ignore
2771 exit;
2772 end;
2773 DeclData:=TViewNodeData(AVLNode.Data);
2774 if (DeclData.Params<>'') then begin
2775 // there are several nodes with this Path
2776 NodeData.CreateParams(ACodeTool);
2777 AVLNode:=fNodesWithPath.Find(NodeData);
2778 if (AVLNode=nil) or (TViewNodeData(AVLNode.Data).ImplementationNode<>nil)
2779 then begin
2780 // there is no declaration, or there is already an implementation
2781 // => ignore
2782 exit;
2783 end;
2784 DeclData:=TViewNodeData(AVLNode.Data);
2785 end;
2786 // implementation found
2787 //debugln(['TCodeExplorerView.AddImplementationNode implementation found: ',NodeData.Path,'(',NodeData.Params,')']);
2788 NodeData.Desc:=CodeNode.Desc;
2789 NodeData.SubDesc:=CodeNode.SubDesc;
2790 NodeData.StartPos:=CodeNode.StartPos;
2791 NodeData.EndPos:=CodeNode.EndPos;
2792 DeclData.ImplementationNode:=NodeData;
2793 NodeData:=nil;
2794 finally
2795 NodeData.Free;
2796 end;
2797 end;
2798 end;
2799
TCodeExplorerView.CompareCodeNodesnull2800 function TCodeExplorerView.CompareCodeNodes(Node1, Node2: TTreeNode): integer;
2801 const
2802 SortDesc = AllIdentifierDefinitions+[ctnProcedure,ctnProperty];
2803
DescToLvlnull2804 function DescToLvl(Desc: TCodeTreeNodeDesc): integer;
2805 begin
2806 case Desc of
2807 ctnTypeSection,
2808 ctnTypeDefinition,ctnGenericType:
2809 Result:=1;
2810 ctnConstSection,ctnConstDefinition:
2811 Result:=2;
2812 ctnVarSection,ctnClassClassVar,ctnResStrSection,ctnLabelSection,
2813 ctnVarDefinition:
2814 Result:=3;
2815 ctnInterface,ctnImplementation,ctnProgram,ctnPackage,ctnLibrary,
2816 ctnProcedure:
2817 Result:=4;
2818 ctnProperty:
2819 Result:=5;
2820 ctnUsesSection:
2821 Result:=6;
2822
2823 // class sections
2824 ctnClassGUID,
2825 ctnClassPrivate,
2826 ctnClassProtected,
2827 ctnClassPublic,
2828 ctnClassPublished : Result:=Desc-ctnClassGUID;
2829
2830 else Result:=10000;
2831 end;
2832 end;
2833
2834 var
2835 Data1: TViewNodeData;
2836 Data2: TViewNodeData;
2837 begin
2838 Data1:=TViewNodeData(Node1.Data);
2839 Data2:=TViewNodeData(Node2.Data);
2840 if (Mode=cemCategory) then begin
2841 if Data1.Desc<>Data2.Desc then begin
2842 Result:=DescToLvl(Data1.Desc)-DescToLvl(Data2.Desc);
2843 if Result<>0 then exit;
2844 end;
2845 if (Data1.Desc in SortDesc)
2846 and (Data2.Desc in SortDesc) then begin
2847 Result:=SysUtils.CompareText(Node1.Text,Node2.Text);
2848 if Result<>0 then exit;
2849 end;
2850 if (Data1.Desc=ctnConstant) and (Data2.Desc=ctnConstant)
2851 and (fSortCodeTool<>nil) then begin
2852 //if GetAtomLength(@fSortCodeTool.Src[Data1.StartPos])>50 then
2853 // DebugLn(['TCodeExplorerView.CompareCodeNodes ',GetAtomString(@fSortCodeTool.Src[Data1.StartPos],fSortCodeTool.Scanner.NestedComments),' ',round(Now*8640000) mod 10000]);
2854 //Result:=-CompareAtom(@fSortCodeTool.Src[Data1.StartPos],
2855 // @fSortCodeTool.Src[Data2.StartPos]);
2856 //if Result<>0 then exit;
2857 end;
2858 end;
2859 if Data1.StartPos<Data2.StartPos then
2860 Result:=-1
2861 else if Data1.StartPos>Data2.StartPos then
2862 Result:=1
2863 else
2864 Result:=0;
2865 end;
2866
2867 { TCodeObserverStatementState }
2868
GetStatementStartPosnull2869 function TCodeObserverStatementState.GetStatementStartPos: integer;
2870 begin
2871 if StackPtr=0 then
2872 Result:=TopLvlStatementStartPos
2873 else
2874 Result:=Stack[StackPtr-1].StatementStartPos;
2875 end;
2876
2877 procedure TCodeObserverStatementState.SetStatementStartPos(const AValue: integer);
2878 begin
2879 if StackPtr=0 then
2880 TopLvlStatementStartPos:=AValue
2881 else
2882 Stack[StackPtr-1].StatementStartPos:=AValue;
2883 end;
2884
2885 destructor TCodeObserverStatementState.Destroy;
2886 begin
2887 Clear;
2888 inherited Destroy;
2889 end;
2890
2891 procedure TCodeObserverStatementState.Clear;
2892 begin
2893 ReAllocMem(Stack,0);
2894 StackCapacity:=0;
2895 StackPtr:=0;
2896 end;
2897
2898 procedure TCodeObserverStatementState.Reset;
2899 begin
2900 PopAll;
2901 TopLvlStatementStartPos:=0;
2902 IgnoreConstLevel:=-1;
2903 end;
2904
2905 procedure TCodeObserverStatementState.Push(Typ: TCodeObsStackItemType;
2906 StartPos: integer);
2907 begin
2908 if StackPtr=StackCapacity then
2909 begin
2910 StackCapacity:=StackCapacity*2+10;
2911 ReAllocMem(Stack,SizeOf(TCodeObsStackItem)*StackCapacity);
2912 end;
2913 Stack[StackPtr].Typ:=Typ;
2914 Stack[StackPtr].StartPos:=StartPos;
2915 Stack[StackPtr].StatementStartPos:=0;
2916 inc(StackPtr);
2917 end;
2918
Popnull2919 function TCodeObserverStatementState.Pop: TCodeObsStackItemType;
2920 begin
2921 if StackPtr=0 then
2922 RaiseGDBException('inconsistency');
2923 dec(StackPtr);
2924 Result:=Stack[StackPtr].Typ;
2925 if IgnoreConstLevel>StackPtr then
2926 IgnoreConstLevel:=-1;
2927 end;
2928
2929 procedure TCodeObserverStatementState.PopAll;
2930 begin
2931 StackPtr:=0;
2932 end;
2933
TopTypenull2934 function TCodeObserverStatementState.TopType: TCodeObsStackItemType;
2935 begin
2936 if StackPtr>0 then
2937 Result:=Stack[StackPtr-1].Typ
2938 else
2939 Result:=cositNone;
2940 end;
2941
2942 end.
2943
2944