mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-23 20:43:32 +02:00
457 lines
14 KiB
ObjectPascal
457 lines
14 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
/***************************************************************************
|
|
codeexplorer.pas
|
|
----------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit CodeExplorer;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
|
|
ComCtrls,
|
|
CodeToolManager, CodeAtom, CodeCache, CodeTree, PascalParserTool,
|
|
EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts, InputHistory, IDEProcs,
|
|
Menus;
|
|
|
|
type
|
|
TCodeExplorerView = class;
|
|
|
|
TOnGetCodeTree =
|
|
procedure(Sender: TObject; var ACodeTool: TCodeTool) of object;
|
|
TOnJumpToCode = procedure(Sender: TObject; const Filename: string;
|
|
const Caret: TPoint; TopLine: integer) of object;
|
|
|
|
TCodeExplorerViewFlag = (
|
|
cevRefreshNeeded,
|
|
cevRefresing
|
|
);
|
|
TCodeExplorerViewFlags = set of TCodeExplorerViewFlag;
|
|
|
|
TCodeExplorerView = class(TForm)
|
|
Imagelist1: TIMAGELIST;
|
|
JumpToMenuitem: TMENUITEM;
|
|
RefreshMenuitem: TMENUITEM;
|
|
TreePopupmenu: TPOPUPMENU;
|
|
RefreshButton: TBUTTON;
|
|
OptionsButton: TBUTTON;
|
|
CodeTreeview: TTREEVIEW;
|
|
procedure CodeExplorerViewCLOSE(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure CodeExplorerViewCREATE(Sender: TObject);
|
|
procedure CodeExplorerViewRESIZE(Sender: TObject);
|
|
procedure CodeTreeviewDBLCLICK(Sender: TObject);
|
|
procedure CodeTreeviewDELETION(Sender: TObject; Node: TTreeNode);
|
|
procedure JumpToMenuitemCLICK(Sender: TObject);
|
|
procedure RefreshButtonCLICK(Sender: TObject);
|
|
procedure RefreshMenuitemCLICK(Sender: TObject);
|
|
private
|
|
FMainFilename: string;
|
|
FFlags: TCodeExplorerViewFlags;
|
|
FOnGetCodeTree: TOnGetCodeTree;
|
|
FOnJumpToCode: TOnJumpToCode;
|
|
FUpdateCount: integer;
|
|
ImgIDDefault: integer;
|
|
ImgIDProgram: Integer;
|
|
ImgIDUnit: Integer;
|
|
ImgIDInterfaceSection: Integer;
|
|
ImgIDImplementation: Integer;
|
|
ImgIDInitialization: Integer;
|
|
ImgIDFinalization: Integer;
|
|
ImgIDTypeSection: Integer;
|
|
ImgIDType: Integer;
|
|
ImgIDVarSection: Integer;
|
|
ImgIDVariable: Integer;
|
|
ImgIDConstSection: Integer;
|
|
ImgIDConst: Integer;
|
|
ImgIDClass: Integer;
|
|
ImgIDProc: Integer;
|
|
ImgIDProperty: Integer;
|
|
function GetNodeDescription(ACodeTool: TCodeTool;
|
|
CodeNode: TCodeTreeNode): string;
|
|
function GetNodeImage(CodeNode: TCodeTreeNode): integer;
|
|
procedure CreateNodes(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode;
|
|
ParentViewNode, InFrontViewNode: TTreeNode; CreateSiblings: boolean);
|
|
public
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
procedure Refresh;
|
|
procedure JumpToSelection;
|
|
property OnGetCodeTree: TOnGetCodeTree read FOnGetCodeTree
|
|
write FOnGetCodeTree;
|
|
property OnJumpToCode: TOnJumpToCode read FOnJumpToCode write FOnJumpToCode;
|
|
property MainFilename: string read FMainFilename;
|
|
end;
|
|
|
|
var
|
|
CodeExplorerView: TCodeExplorerView;
|
|
|
|
implementation
|
|
|
|
type
|
|
TViewNodeData = class
|
|
public
|
|
Desc: TCodeTreeNodeDesc;
|
|
SubDesc: TCodeTreeNodeSubDesc;
|
|
StartPos, EndPos: integer;
|
|
constructor Create(CodeNode: TCodeTreeNode);
|
|
end;
|
|
|
|
{ TViewNodeData }
|
|
|
|
constructor TViewNodeData.Create(CodeNode: TCodeTreeNode);
|
|
begin
|
|
Desc:=CodeNode.Desc;
|
|
SubDesc:=CodeNode.SubDesc;
|
|
StartPos:=CodeNode.StartPos;
|
|
EndPos:=CodeNode.EndPos;
|
|
end;
|
|
|
|
{ TCodeExplorerView }
|
|
|
|
procedure TCodeExplorerView.CodeExplorerViewCREATE(Sender: TObject);
|
|
|
|
procedure AddResImg(ImgList: TImageList; const ResName: string);
|
|
var Pixmap: TPixmap;
|
|
begin
|
|
Pixmap:=TPixmap.Create;
|
|
if LazarusResources.Find(ResName)=nil then
|
|
writeln('TCodeExplorerView.CodeExplorerViewCREATE: ',
|
|
' WARNING: icon not found: "',ResName,'"');
|
|
Pixmap.LoadFromLazarusResource(ResName);
|
|
ImgList.Add(Pixmap,nil)
|
|
end;
|
|
|
|
begin
|
|
Name:=NonModalIDEWindowNames[nmiwCodeExplorerName];
|
|
Caption := lisMenuViewCodeExplorer;
|
|
EnvironmentOptions.IDEWindowLayoutList.Apply(Self,Name);
|
|
|
|
RefreshButton.Caption:=dlgUnitDepRefresh;
|
|
OptionsButton.Caption:=dlgFROpts;
|
|
|
|
ImgIDDefault:=0;
|
|
AddResImg(Imagelist1,'ce_default');
|
|
ImgIDProgram:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_program');
|
|
ImgIDUnit:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_unit');
|
|
ImgIDInterfaceSection:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_interface');
|
|
ImgIDImplementation:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_implementation');
|
|
ImgIDInitialization:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_initialization');
|
|
ImgIDFinalization:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_finalization');
|
|
ImgIDTypeSection:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_type');
|
|
ImgIDType:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_type');
|
|
ImgIDVarSection:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_variable');
|
|
ImgIDVariable:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_variable');
|
|
ImgIDConstSection:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_const');
|
|
ImgIDConst:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_const');
|
|
ImgIDClass:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_class');
|
|
ImgIDProc:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_procedure');
|
|
ImgIDProperty:=Imagelist1.Count;
|
|
AddResImg(Imagelist1,'ce_property');
|
|
end;
|
|
|
|
procedure TCodeExplorerView.CodeExplorerViewRESIZE(Sender: TObject);
|
|
var
|
|
y: Integer;
|
|
begin
|
|
RefreshButton.Width:=ClientWidth div 2;
|
|
with OptionsButton do
|
|
SetBounds(RefreshButton.Width,Top,
|
|
Parent.ClientWidth-RefreshButton.Width,Height);
|
|
y:=RefreshButton.Top+RefreshButton.Height;
|
|
with CodeTreeview do
|
|
SetBounds(0,y,Parent.ClientWidth,Parent.ClientHeight-y);
|
|
end;
|
|
|
|
procedure TCodeExplorerView.CodeTreeviewDBLCLICK(Sender: TObject);
|
|
begin
|
|
JumpToSelection;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.CodeTreeviewDELETION(Sender: TObject;
|
|
Node: TTreeNode);
|
|
begin
|
|
if Node.Data<>nil then
|
|
TViewNodeData(Node.Data).Free;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.CodeExplorerViewCLOSE(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
EnvironmentOptions.IDEWindowLayoutList.ItemByForm(Self).GetCurrentPosition;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.JumpToMenuitemCLICK(Sender: TObject);
|
|
begin
|
|
JumpToSelection;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.RefreshButtonCLICK(Sender: TObject);
|
|
begin
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.RefreshMenuitemCLICK(Sender: TObject);
|
|
begin
|
|
Refresh;
|
|
end;
|
|
|
|
function TCodeExplorerView.GetNodeDescription(ACodeTool: TCodeTool;
|
|
CodeNode: TCodeTreeNode): string;
|
|
begin
|
|
case CodeNode.Desc of
|
|
|
|
ctnUnit, ctnProgram, ctnLibrary, ctnPackage:
|
|
Result:=CodeNode.DescAsString+' '+ACodeTool.ExtractSourceName;
|
|
|
|
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition:
|
|
Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
|
|
|
|
ctnClass:
|
|
Result:='('+ACodeTool.ExtractClassInheritance(CodeNode,[])+')';
|
|
|
|
ctnEnumIdentifier:
|
|
Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
|
|
|
|
ctnProcedure:
|
|
Result:=ACodeTool.ExtractProcHead(CodeNode,
|
|
[phpWithStart,phpWithVarModifiers,
|
|
phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
|
|
phpWithOfObject,phpWithCallingSpecs]);
|
|
|
|
ctnProperty:
|
|
Result:='property '+ACodeTool.ExtractPropName(CodeNode,false);
|
|
|
|
else
|
|
Result:=CodeNode.DescAsString;
|
|
end;
|
|
end;
|
|
|
|
function TCodeExplorerView.GetNodeImage(CodeNode: TCodeTreeNode): integer;
|
|
begin
|
|
case CodeNode.Desc of
|
|
ctnProgram,ctnLibrary,ctnPackage:
|
|
Result:=ImgIDProgram;
|
|
ctnUnit:
|
|
Result:=ImgIDUnit;
|
|
ctnInterface:
|
|
Result:=ImgIDInterfaceSection;
|
|
ctnImplementation:
|
|
Result:=ImgIDImplementation;
|
|
ctnInitialization:
|
|
Result:=ImgIDInitialization;
|
|
ctnFinalization:
|
|
Result:=ImgIDFinalization;
|
|
ctnTypeSection:
|
|
Result:=ImgIDTypeSection;
|
|
ctnTypeDefinition:
|
|
Result:=ImgIDType;
|
|
ctnVarSection:
|
|
Result:=ImgIDVarSection;
|
|
ctnVarDefinition:
|
|
Result:=ImgIDVariable;
|
|
ctnConstSection,ctnResStrSection:
|
|
Result:=ImgIDConstSection;
|
|
ctnConstDefinition:
|
|
Result:=ImgIDConst;
|
|
ctnClass:
|
|
Result:=ImgIDClass;
|
|
ctnProcedure:
|
|
Result:=ImgIDProc;
|
|
ctnProperty:
|
|
Result:=ImgIDProperty;
|
|
else
|
|
Result:=ImgIDDefault;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.CreateNodes(ACodeTool: TCodeTool;
|
|
CodeNode: TCodeTreeNode;
|
|
ParentViewNode, InFrontViewNode: TTreeNode; CreateSiblings: boolean);
|
|
var
|
|
NodeData: TViewNodeData;
|
|
NodeText: String;
|
|
ViewNode: TTreeNode;
|
|
NodeImageIndex: Integer;
|
|
ShowNode: Boolean;
|
|
ShowChilds: Boolean;
|
|
begin
|
|
if CodeNode=nil then exit;
|
|
|
|
ShowNode:=true;
|
|
ShowChilds:=true;
|
|
|
|
// don't show statements
|
|
if (CodeNode.Desc in AllPascalStatements+[ctnParameterList]) then exit;
|
|
// don't show parameter lists
|
|
if (CodeNode.Desc in [ctnProcedureHead]) then begin
|
|
ShowNode:=false;
|
|
ShowChilds:=false;
|
|
end;
|
|
// don't show forward class definitions
|
|
if (CodeNode.Desc=ctnTypeDefinition)
|
|
and (CodeNode.FirstChild<>nil) and (CodeNode.FirstChild.Desc=ctnClass)
|
|
and ((CodeNode.FirstChild.SubDesc and ctnsForwardDeclaration)>0) then begin
|
|
ShowNode:=false;
|
|
ShowChilds:=false;
|
|
end;
|
|
|
|
// don't show keyword nodes
|
|
if CodeNode.Desc in [ctnIdentifier,ctnRangedArrayType,
|
|
ctnOpenArrayType,ctnOfConstType,ctnRangeType,ctnTypeType,ctnFileType,
|
|
ctnVariantType]
|
|
then
|
|
ShowNode:=false;
|
|
|
|
if ShowNode then begin
|
|
NodeData:=TViewNodeData.Create(CodeNode);
|
|
NodeText:=GetNodeDescription(ACodeTool,CodeNode);
|
|
NodeImageIndex:=GetNodeImage(CodeNode);
|
|
if InFrontViewNode<>nil then
|
|
ViewNode:=CodeTreeview.Items.InsertObjectBehind(
|
|
InFrontViewNode,NodeText,NodeData)
|
|
else if ParentViewNode<>nil then
|
|
ViewNode:=CodeTreeview.Items.AddChildObject(
|
|
ParentViewNode,NodeText,NodeData)
|
|
else
|
|
ViewNode:=CodeTreeview.Items.AddObject(nil,NodeText,NodeData);
|
|
ViewNode.ImageIndex:=NodeImageIndex;
|
|
ViewNode.SelectedIndex:=NodeImageIndex;
|
|
if ShowChilds then
|
|
CreateNodes(ACodeTool,CodeNode.FirstChild,ViewNode,nil,true);
|
|
if CreateSiblings then
|
|
CreateNodes(ACodeTool,CodeNode.NextBrother,ParentViewNode,ViewNode,true);
|
|
end else begin
|
|
if ShowChilds then
|
|
CreateNodes(ACodeTool,CodeNode.FirstChild,ParentViewNode,nil,true);
|
|
if CreateSiblings then
|
|
CreateNodes(ACodeTool,CodeNode.NextBrother,ParentViewNode,InFrontViewNode,
|
|
true);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.BeginUpdate;
|
|
begin
|
|
inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TCodeExplorerView.EndUpdate;
|
|
begin
|
|
if FUpdateCount<=0 then
|
|
RaiseException('TCodeExplorerView.EndUpdate');
|
|
dec(FUpdateCount);
|
|
if FUpdateCount=0 then begin
|
|
if cevRefreshNeeded in FFlags then Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeExplorerView.Refresh;
|
|
var
|
|
OldExpanded: TTreeNodeExpandedState;
|
|
ACodeTool: TCodeTool;
|
|
begin
|
|
if FUpdateCount>0 then begin
|
|
Include(FFlags,cevRefreshNeeded);
|
|
exit;
|
|
end;
|
|
Exclude(FFlags,cevRefreshNeeded);
|
|
|
|
Include(FFlags,cevRefresing);
|
|
|
|
// get the codetool with the updated codetree
|
|
ACodeTool:=nil;
|
|
if Assigned(OnGetCodeTree) then
|
|
OnGetCodeTree(Self,ACodeTool);
|
|
|
|
// start updating the CodeTreeView
|
|
CodeTreeview.BeginUpdate;
|
|
OldExpanded:=TTreeNodeExpandedState.Create(CodeTreeView);
|
|
|
|
if (ACodeTool=nil) or (ACodeTool.Tree=nil) or (ACodeTool.Tree.Root=nil) then
|
|
begin
|
|
CodeTreeview.Items.Clear;
|
|
FMainFilename:='';
|
|
end else begin
|
|
FMainFilename:=ACodeTool.MainFilename;
|
|
CodeTreeview.Items.Clear;
|
|
CreateNodes(ACodeTool,ACodeTool.Tree.Root,nil,nil,true);
|
|
end;
|
|
|
|
// restore old expanded state
|
|
OldExpanded.Apply(CodeTreeView);
|
|
OldExpanded.Free;
|
|
CodeTreeview.EndUpdate;
|
|
|
|
Exclude(FFlags,cevRefresing);
|
|
end;
|
|
|
|
procedure TCodeExplorerView.JumpToSelection;
|
|
var
|
|
CurItem: TTreeNode;
|
|
CurNode: TViewNodeData;
|
|
Caret: TCodeXYPosition;
|
|
NewTopLine: integer;
|
|
CodeBuffer: TCodeBuffer;
|
|
ACodeTool: TCodeTool;
|
|
begin
|
|
CurItem:=CodeTreeview.Selected;
|
|
if CurItem=nil then exit;
|
|
CurNode:=TViewNodeData(CurItem.Data);
|
|
if CurNode.StartPos<1 then exit;
|
|
|
|
CodeBuffer:=CodeToolBoss.FindFile(MainFilename);
|
|
if CodeBuffer=nil then exit;
|
|
ACodeTool:=nil;
|
|
CodeToolBoss.Explore(CodeBuffer,ACodeTool,false);
|
|
if ACodeTool=nil then exit;
|
|
if not ACodeTool.CleanPosToCaretAndTopLine(CurNode.StartPos,Caret,NewTopLine)
|
|
then exit;
|
|
|
|
if Assigned(OnJumpToCode) then
|
|
OnJumpToCode(Self,Caret.Code.Filename,Point(Caret.X,Caret.Y),NewTopLine);
|
|
end;
|
|
|
|
initialization
|
|
{$I codeexplorer.lrs}
|
|
CodeExplorerView:=nil;
|
|
|
|
end.
|
|
|