IDE: Improve ProcedureList. Issue #40197, patch by n7800.

This commit is contained in:
Juha 2023-04-07 10:03:32 +03:00
parent bb2d44c421
commit f54ee297ee
2 changed files with 212 additions and 217 deletions

View File

@ -7,12 +7,13 @@ object ProcedureListForm: TProcedureListForm
Caption = 'Procedure List - '
ClientHeight = 688
ClientWidth = 952
KeyPreview = True
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnKeyDown = FormKeyDown
OnResize = FormResize
OnShow = FormShow
Position = poScreenCenter
Position = poMainFormCenter
LCLVersion = '2.3.0.0'
object StatusBar: TStatusBar
Left = 0
@ -184,8 +185,6 @@ object ProcedureListForm: TProcedureListForm
BorderSpacing.Top = 6
BorderSpacing.Right = 6
OnChange = SomethingChange
OnKeyDown = edMethodsKeyDown
OnKeyPress = edMethodsKeyPress
TabOrder = 0
end
object cbObjects: TComboBox
@ -213,28 +212,41 @@ object ProcedureListForm: TProcedureListForm
Top = 73
Width = 952
Align = alClient
AutoFillColumns = True
ColCount = 4
Columns = <
item
SizePriority = 0
Title.Caption = ''
Width = 24
Width = 20
end
item
Title.Caption = 'Procedure'
Width = 200
end
Width = 762
end
item
SizePriority = 0
Title.Caption = 'Type'
end
Width = 110
end
item
SizePriority = 0
Title.Caption = 'Line'
Width = 60
end>
FixedCols = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goRowSelect, goThumbTracking, goSmoothScroll, goCellEllipsis]
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goThumbTracking, goSmoothScroll, goCellEllipsis]
TabOrder = 3
TabStop = False
OnDblClick = SGDblClick
OnDrawCell = SGDrawCell
OnMouseWheel = SGMouseWheel
OnSelectCell = SGSelectCell
ColWidths = (
20
762
110
60
)
end
end

View File

@ -83,19 +83,14 @@ type
ToolButton7: TToolButton;
tbChangeFont: TToolButton;
ToolButton9: TToolButton;
procedure edMethodsKeyDown(Sender: TObject; var Key: Word;
{%H-}Shift: TShiftState);
procedure edMethodsKeyPress(Sender: TObject; var Key: char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: char);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SGDblClick(Sender: TObject);
procedure SGDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect;
{%H-}aState: TGridDrawState);
procedure SGMouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean);
procedure SGSelectCell(Sender: TObject; {%H-}aCol, aRow: Integer;
var {%H-}CanSelect: Boolean);
procedure SomethingChange(Sender: TObject);
@ -107,11 +102,12 @@ type
FNewTopLine: integer;
FImageIdxProcedure: Integer;
FImageIdxFunction: Integer;
function GetCodeTreeNode(out lCodeTool: TCodeTool): TCodeTreeNode;
{ Initialise GUI }
procedure SetupGUI;
{ Move editors focus to selected method. }
procedure JumpToSelection;
{ Populates Listview based on selected Class and user entered filter. }
{ Populates grid based on selected Class and user entered filter. }
procedure PopulateGrid;
{ Populates only tho cbObjects combo with available classes. }
procedure PopulateObjectsCombo;
@ -119,7 +115,6 @@ type
function PassFilter(pSearchAll: boolean; pProcName, pSearchStr: string; pCodeTool: TCodeTool; pNode: TCodeTreeNode): boolean;
procedure ClearGrid;
public
property MainFilename: string read FMainFilename;
property Caret: TCodeXYPosition read FCaret;
property NewTopLine: integer read FNewTopLine;
end;
@ -141,29 +136,26 @@ const
'Author: Graeme Geldenhuys (graemeg@gmail.com)' + #10 +
'Inspired by: GExperts (www.gexperts.org)';
{ This is where it all starts. Gets called from Lazarus. }
procedure ExecuteProcedureList(Sender: TObject);
var
frm: TProcedureListForm;
procedure ExecuteProcedureList({%H-}Sender: TObject);
begin
Assert(Sender<>nil); // removes compiler warning
frm := TProcedureListForm.Create(nil);
try
frm.ShowModal;
if frm.ModalResult = mrOK then // we need to jump
begin
LazarusIDE.DoOpenFileAndJumpToPos(frm.Caret.Code.Filename,
Point(frm.Caret.X, frm.Caret.Y), frm.NewTopLine, -1,-1,
[ofRegularFile,ofUseCache]);
with TProcedureListForm.Create(nil) do
try
if ShowModal = mrOK then
begin
LazarusIDE.DoOpenFileAndJumpToPos(
Caret.Code.Filename,
Point(Caret.X, Caret.Y),
NewTopLine,
-1, -1,
[ofRegularFile,ofUseCache]
);
end;
finally
Free;
end;
finally
frm.Free;
end;
end;
function FilterFits(const SubStr, Str: string): boolean;
var
Src: PChar;
@ -243,20 +235,15 @@ end;
procedure TProcedureListForm.FormCreate(Sender: TObject);
begin
SetupGUI;
if SourceEditorManagerIntf.ActiveEditor = nil then
begin
//SetupGUI makes the dialog look as it should, and is clears the listview
//thus preventing a crash when clicking on the LV
SetupGUI;
Exit; //==>
end;
FMainFilename := SourceEditorManagerIntf.ActiveEditor.Filename;
Caption := Caption + ExtractFileName(FMainFilename);
SetupGUI;
Caption := Caption + ' - ' + ExtractFileName(FMainFilename);
PopulateObjectsCombo;
PopulateGrid;
StatusBar.Panels[0].Text := self.MainFilename;
StatusBar.Panels[0].Text := FMainFilename;
tbFilterStart.Down := EnvironmentOptions.ProcedureListFilterStart;
IDEDialogLayoutList.ApplyLayout(Self, 950, 680);
end;
@ -268,6 +255,122 @@ begin
IDEDialogLayoutList.SaveLayout(self);
end;
procedure TProcedureListForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Shift = [] then
begin
{ Form }
if Key = VK_RETURN then
begin
JumpToSelection;
Key := 0;
end
else if Key = VK_ESCAPE then
begin
Key := 0;
ModalResult := mrCancel;
end
{ Arrows }
else if Key = VK_DOWN then
begin
if SG.Row < SG.FixedRows then // if (Row = -1) or (Row < FixedRows)
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.FixedRows;
end else begin
if (SG.Row + 1) < SG.RowCount then
SG.Row := SG.Row + 1;
end;
Key := 0;
end
else if Key = VK_UP then
begin
if SG.Row < SG.FixedRows then // if (Row = -1) or (Row < FixedRows)
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.RowCount - 1;
end else begin
if SG.Row > SG.FixedRows then
SG.Row := SG.Row - 1;
end;
Key := 0;
end
{ PageUp and PageDown }
else if Key = VK_NEXT then
begin
if SG.Row < SG.FixedRows then // if (Row = -1) or (Row < FixedRows)
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.FixedRows;
end else begin
SG.Row := Min(SG.RowCount - 1, SG.Row + (SG.VisibleRowCount - 1));
end;
Key := 0;
end
else if Key = VK_PRIOR then
begin
if SG.Row < SG.FixedRows then // if (Row = -1) or (Row < FixedRows)
begin
if SG.Row > SG.FixedRows then
SG.Row := SG.Row - 1;
end else begin
SG.Row := Max(SG.FixedRows, SG.Row - (SG.VisibleRowCount - 1));
end;
Key := 0;
end
{ Home and End }
else if Key = VK_HOME then
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.FixedRows;
Key := 0;
end
else if Key = VK_END then
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.RowCount - 1;
Key := 0;
end;
end; // if Shift = []
if Shift = [ssCtrl] then
begin
{ Scroll one line }
if Key = VK_DOWN then
begin
if SG.RowCount > SG.FixedRows then
SG.TopRow := Max(SG.FixedRows, Min(SG.RowCount - 1, SG.TopRow + 1));
Key := 0;
end
else if Key = VK_UP then
begin
if SG.RowCount > SG.FixedRows then
SG.TopRow := Max(SG.FixedRows, Min(SG.RowCount - 1, SG.TopRow - 1));
Key := 0;
end
{ Copy }
else if Key = VK_C then
begin
// copy the selected procedure only if no text is selected in edMethods
if edMethods.SelLength = 0 then
begin
tbCopyClick(Sender);
Key := 0;
end;
end;
end; // if Shift = [ssCtrl]
end;
procedure TProcedureListForm.FormResize(Sender: TObject);
begin
StatusBar.Panels[0].Width := self.ClientWidth - 105;
@ -288,15 +391,12 @@ procedure TProcedureListForm.SGDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
bmp: TBitmap;
grid: TStringGrid;
iconTop, imageIdx: Integer;
rowObj: TGridRowObject;
begin
grid := TStringGrid(Sender);
if (aCol = 0) and (aRow >= grid.FixedRows) then
if (aCol = SG_COLIDX_IMAGE) and (aRow >= SG.FixedRows) then
begin
rowObj := TGridRowObject(grid.Rows[aRow].Objects[0]);
rowObj := TGridRowObject(SG.Rows[aRow].Objects[0]);
if Assigned(rowObj) then
begin
imageIdx := rowObj.ImageIdx;
@ -305,7 +405,7 @@ begin
try
IDEImages.Images_16.GetBitmap(imageIdx, bmp);
iconTop := ((aRect.Bottom - aRect.Top) - bmp.Height) div 2 + aRect.Top;
grid.Canvas.Draw(aRect.Left,iconTop, bmp);
SG.Canvas.Draw(aRect.Left,iconTop, bmp);
finally
bmp.Free;
end;
@ -313,16 +413,6 @@ begin
end;
end;
procedure TProcedureListForm.SGMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
NLines: integer;
begin
NLines := -WheelDelta * 3 div 120;
SG.TopRow := Max(SG.FixedRows, Min(SG.RowCount - 1, SG.TopRow + NLines));
Handled := True;
end;
procedure TProcedureListForm.SGSelectCell(Sender: TObject; aCol, aRow: Integer;
var CanSelect: Boolean);
var
@ -337,9 +427,6 @@ end;
procedure TProcedureListForm.SetupGUI;
begin
self.KeyPreview := True;
self.Position := poScreenCenter;
// assign resource strings to Captions and Hints
self.Caption := lisPListProcedureList;
lblObjects.Caption := lisPListObjects;
@ -363,20 +450,10 @@ begin
tbFilterAny.ImageIndex := IDEImages.LoadImage('filter_any_place');
tbFilterStart.ImageIndex := IDEImages.LoadImage('filter_from_begin');
SG.Columns[SG_COLIDX_IMAGE].Width := 20;
SG.Columns[SG_COLIDX_PROCEDURE].Width := 300;
SG.Columns[SG_COLIDX_TYPE].Width := 110;
SG.Columns[SG_COLIDX_LINE].Width := 60;
FImageIdxProcedure := IDEImages.LoadImage('cc_procedure');
FImageIdxFunction := IDEImages.LoadImage('cc_function');;
cbObjects.Style := csDropDownList;
cbObjects.Sorted := True;
cbObjects.DropDownCount := 8;
end;
procedure TProcedureListForm.JumpToSelection;
var
CodeBuffer: TCodeBuffer;
@ -393,7 +470,7 @@ begin
if lRowObject.NodeStartPos < 0 then
Exit;
CodeBuffer := CodeToolBoss.LoadFile(MainFilename,false,false);
CodeBuffer := CodeToolBoss.LoadFile(FMainFilename,false,false);
if CodeBuffer = nil then
Exit; //==>
@ -409,43 +486,16 @@ begin
self.ModalResult := mrOK;
end;
procedure TProcedureListForm.PopulateGrid;
var
lSrcEditor: TSourceEditorInterface;
lCodeBuffer: TCodeBuffer;
lCodeTool: TCodeTool;
lNode: TCodeTreeNode;
begin
SG.BeginUpdate;
try
ClearGrid;
{ get active source editor }
lSrcEditor := SourceEditorManagerIntf.ActiveEditor;
if lSrcEditor = nil then
Exit; //==>
lCodeBuffer := lSrcEditor.CodeToolsBuffer as TCodeBuffer;
{ parse source }
CodeToolBoss.Explore(lCodeBuffer,lCodeTool,False);
{ copy the tree }
if (lCodeTool = nil)
or (lCodeTool.Tree = nil)
or (lCodeTool.Tree.Root = nil) then
Exit; //==>
{ Find the starting point }
lNode := lCodeTool.FindImplementationNode;
if lNode = nil then
begin
{ fall back - guess we are working with a program or there is a syntax error }
lNode := lCodeTool.Tree.Root;
end;
{ populate the listview here }
lNode := lNode.FirstChild;
lNode := GetCodeTreeNode(lCodeTool);
if lCodeTool = nil then exit;;
while lNode <> nil do
begin
if lNode.Desc = ctnProcedure then
@ -455,7 +505,7 @@ begin
lNode := lNode.Next;
end;
finally
if SG.RowCount > 0 then
if SG.RowCount > SG.FixedRows then
begin
SG.Row := SG.FixedRows;
end;
@ -463,65 +513,36 @@ begin
end;
end;
procedure TProcedureListForm.PopulateObjectsCombo;
var
lSrcEditor: TSourceEditorInterface;
lCodeBuffer: TCodeBuffer;
lCodeTool: TCodeTool;
lNode: TCodeTreeNode;
lNodeText: string;
begin
cbObjects.Items.Clear;
try
{ get active source editor }
lSrcEditor := SourceEditorManagerIntf.ActiveEditor;
if lSrcEditor = nil then
Exit; //==>
lCodeBuffer := lSrcEditor.CodeToolsBuffer as TCodeBuffer;
{ parse source }
CodeToolBoss.Explore(lCodeBuffer,lCodeTool,False);
if (lCodeTool = nil)
or (lCodeTool.Tree = nil)
or (lCodeTool.Tree.Root = nil) then
Exit; //==>
{ copy the tree }
if Assigned(lCodeTool.Tree) then
lNode := GetCodeTreeNode(lCodeTool);
if lCodeTool = nil then exit;;
while lNode <> nil do
begin
{ Find the starting point }
lNode := lCodeTool.FindImplementationNode;
if lNode = nil then
if lNode.Desc = ctnProcedure then
begin
{ fall back - guess we are working with a program unit }
lNode := lCodeTool.Tree.Root;
end;
{ populate the Combobox here! }
lNode := lNode.FirstChild;
while lNode <> nil do
begin
if lNode.Desc = ctnProcedure then
begin
lNodeText := lCodeTool.ExtractClassNameOfProcNode(lNode);
lNodeText := lCodeTool.ExtractClassNameOfProcNode(lNode);
if lNodeText <> '' then
cbObjects.Items.Add(lNodeText);
end;
lNode := lNode.NextBrother;
end;
lNode := lNode.NextBrother;
end;
cbObjects.Sorted := true;
finally
cbObjects.Sorted := false;
cbObjects.Items.Insert(0, lisPListAll);
cbObjects.Items.Insert(1, lisPListNone);
finally
cbObjects.ItemIndex := 0; // select <All> as the default
if (cbObjects.Items.Count > 0) and (cbObjects.Text = '') then // some widgetsets have issues here so we do this
cbObjects.Text := cbObjects.Items[0];
if (cbObjects.Items.Count > 0) and (cbObjects.Text = '') then
cbObjects.Text := cbObjects.Items[0]; // some widgetsets have issues so we do this
end;
end;
procedure TProcedureListForm.AddToGrid(pCodeTool: TCodeTool; pNode: TCodeTreeNode);
var
lNodeText: string;
@ -531,7 +552,7 @@ var
lRowObject: TGridRowObject;
lRowIdx: Integer;
begin
FSearchAll := cbObjects.Text = lisPListAll;
FSearchAll := cbObjects.ItemIndex = 0; // lisPListAll
if FSearchAll and tbFilterAny.Down then
begin
@ -589,7 +610,6 @@ begin
end;
{ Do we pass all the filter tests to continue? }
function TProcedureListForm.PassFilter(pSearchAll: boolean;
pProcName, pSearchStr: string; pCodeTool: TCodeTool; pNode: TCodeTreeNode
@ -601,7 +621,7 @@ var
begin
{ lets filter by class selection. }
lClass := pCodeTool.ExtractClassNameOfProcNode(pNode);
if cbObjects.Text = lisPListNone then
if cbObjects.ItemIndex = 1 then // lisPListNone
Result := lClass = ''
else
Result := lClass = cbObjects.Text;
@ -619,13 +639,13 @@ begin
end
else
if not pSearchAll and tbFilterStart.Down then
Result := ClassMatches and LazStartsStr(pSearchStr, pProcName)
Result := ClassMatches and LazStartsText(pSearchStr, pProcName)
else
if not pSearchAll and tbFilterAny.Down then
Result := ClassMatches and FilterFits(pSearchStr, pProcName)
else
if pSearchAll and tbFilterStart.Down then
Result := LazStartsStr(pSearchStr, pProcName)
Result := LazStartsText(pSearchStr, pProcName)
else
if pSearchAll then
Result := FilterFits(pSearchStr, pProcName);
@ -641,73 +661,6 @@ begin
SG.RowCount := SG.FixedRows;
end;
procedure TProcedureListForm.FormKeyPress(Sender: TObject; var Key: char);
begin
if Key = #27 then // Escape key
begin
self.ModalResult := mrCancel;
end;
end;
procedure TProcedureListForm.edMethodsKeyPress(Sender: TObject; var Key: char);
begin
case Key of
#13:
begin
JumpToSelection;
Key := #0;
end;
#27:
begin
self.ModalResult := mrCancel;
Key := #0;
end;
end;
end;
procedure TProcedureListForm.edMethodsKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if SG.RowCount <= SG.FixedRows then
Exit;
if Key = VK_DOWN then
begin
if SG.Row < (SG.RowCount - 1) then
SG.Row := SG.Row + 1;
Key := 0;
end
else if Key = VK_Up then
begin
if SG.Row > SG.FixedRows then
SG.Row := SG.Row - 1;
Key := 0;
end
else if Key = VK_Home then
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.FixedRows;
Key := 0;
end
else if Key = VK_End then
begin
if SG.RowCount > SG.FixedRows then
SG.Row := SG.RowCount - 1;
Key := 0;
end
else if Key = VK_PRIOR then
begin
SG.Row := Max(SG.FixedRows, SG.Row - (SG.VisibleRowCount - 1));
Key := 0;
end
else if Key = VK_NEXT then
begin
SG.Row := Min(SG.RowCount - 1, SG.Row + (SG.VisibleRowCount - 1));
Key := 0;
end;
end;
procedure TProcedureListForm.SomethingChange(Sender: TObject);
begin
PopulateGrid;
@ -720,8 +673,38 @@ end;
procedure TProcedureListForm.tbCopyClick(Sender: TObject);
begin
if SG.Row > 0 then
Clipboard.AsText := SG.Cells[SG_COLIDX_PROCEDURE,SG.Row];
if SG.Row >= SG.FixedRows then
Clipboard.AsText := SG.Cells[SG_COLIDX_PROCEDURE, SG.Row];
end;
function TProcedureListForm.GetCodeTreeNode(out lCodeTool: TCodeTool): TCodeTreeNode;
var
lCodeBuffer: TCodeBuffer;
begin
result := nil;
{ get active source editor }
if SourceEditorManagerIntf.ActiveEditor = nil then exit;
lCodeBuffer := SourceEditorManagerIntf.ActiveEditor.CodeToolsBuffer as TCodeBuffer;
if lCodeBuffer = nil then exit;
{ parse source }
CodeToolBoss.Explore(lCodeBuffer, lCodeTool, False);
if lCodeTool = nil then exit;
if lCodeTool.Tree = nil then exit;
if lCodeTool.Tree.Root = nil then exit;
{ Find the starting point }
result := lCodeTool.FindImplementationNode;
if result = nil then
begin
{ fall back - guess we are working with a program or there is a syntax error }
result := lCodeTool.Tree.Root;
end;
result := result.FirstChild;
end;
end.