mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 01:57:57 +02:00
Revert r50908 #2c80e0baa3, ProcedureList changes.
git-svn-id: trunk@51748 -
This commit is contained in:
juha
parent
56246bfac0
commit
598c69db04
@ -88,8 +88,7 @@ type
|
||||
nmiwCodeBrowser,
|
||||
nmiwIssueBrowser,
|
||||
nmiwJumpHistory,
|
||||
nmiwComponentList,
|
||||
nmiwProcedureList
|
||||
nmiwComponentList
|
||||
);
|
||||
|
||||
const
|
||||
@ -125,8 +124,7 @@ const
|
||||
'CodeBrowser',
|
||||
'IssueBrowser',
|
||||
'JumpHistory',
|
||||
'ComponentList',
|
||||
'ProcedureList'
|
||||
'ComponentList'
|
||||
);
|
||||
|
||||
type
|
||||
|
||||
22
ide/main.pp
22
ide/main.pp
@ -660,8 +660,6 @@ type
|
||||
procedure ShowDesignerForm(AForm: TCustomForm);
|
||||
procedure DoViewAnchorEditor(State: TIWGetFormState = iwgfShowOnTop);
|
||||
procedure DoViewTabOrderEditor(State: TIWGetFormState = iwgfShowOnTop);
|
||||
// ProcedureList
|
||||
procedure DoViewProcedureList(State: TIWGetFormState = iwgfShowOnTop);
|
||||
// editor and environment options
|
||||
procedure LoadDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions);
|
||||
procedure SaveDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions);
|
||||
@ -923,7 +921,8 @@ type
|
||||
|
||||
// message view
|
||||
function GetSelectedCompilerMessage: TMessageLine; override;
|
||||
function DoJumpToCompilerMessage(FocusEditor: boolean; Msg: TMessageLine = nil): boolean; override;
|
||||
function DoJumpToCompilerMessage(FocusEditor: boolean; Msg: TMessageLine = nil
|
||||
): boolean; override;
|
||||
procedure DoJumpToNextCompilerMessage(aMinUrgency: TMessageLineUrgency; DirectionDown: boolean); override;
|
||||
procedure DoShowMessagesView(BringToFront: boolean = true); override;
|
||||
|
||||
@ -3007,7 +3006,7 @@ end;
|
||||
|
||||
procedure TMainIDE.mnuSearchProcedureList(Sender: TObject);
|
||||
begin
|
||||
DoViewProcedureList;
|
||||
ProcedureList.ExecuteProcedureList(Sender);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuSetFreeBookmark(Sender: TObject);
|
||||
@ -3518,7 +3517,7 @@ procedure TMainIDE.DoViewAnchorEditor(State: TIWGetFormState);
|
||||
begin
|
||||
if AnchorDesigner=nil then
|
||||
IDEWindowCreators.CreateForm(AnchorDesigner,TAnchorDesigner,
|
||||
State=iwgfDisabled, LazarusIDE.OwningComponent)
|
||||
State=iwgfDisabled,LazarusIDE.OwningComponent)
|
||||
else if State=iwgfDisabled then
|
||||
AnchorDesigner.DisableAlign;
|
||||
if State>=iwgfShow then
|
||||
@ -3529,24 +3528,13 @@ procedure TMainIDE.DoViewTabOrderEditor(State: TIWGetFormState);
|
||||
begin
|
||||
if TabOrderDialog=nil then
|
||||
IDEWindowCreators.CreateForm(TabOrderDialog,TTabOrderDialog,
|
||||
State=iwgfDisabled, LazarusIDE.OwningComponent)
|
||||
State=iwgfDisabled,LazarusIDE.OwningComponent)
|
||||
else if State=iwgfDisabled then
|
||||
TabOrderDialog.DisableAlign;
|
||||
if State>=iwgfShow then
|
||||
IDEWindowCreators.ShowForm(TabOrderDialog,State=iwgfShowOnTop);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.DoViewProcedureList(State: TIWGetFormState);
|
||||
begin
|
||||
if ProcListView=nil then
|
||||
IDEWindowCreators.CreateForm(ProcListView,TProcedureListForm,
|
||||
State=iwgfDisabled, LazarusIDE.OwningComponent)
|
||||
else if State=iwgfDisabled then
|
||||
ProcListView.DisableAlign;
|
||||
if State>=iwgfShow then
|
||||
IDEWindowCreators.ShowForm(ProcListView, State=iwgfShowOnTop);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.SetToolStatus(const AValue: TIDEToolStatus);
|
||||
begin
|
||||
if ToolStatus=AValue then exit;
|
||||
|
||||
@ -1,24 +1,23 @@
|
||||
object ProcedureListForm: TProcedureListForm
|
||||
Left = 431
|
||||
Height = 489
|
||||
Left = 289
|
||||
Height = 688
|
||||
Top = 140
|
||||
Width = 816
|
||||
ActiveControl = FilterMethods
|
||||
Width = 952
|
||||
ActiveControl = cbObjects
|
||||
Caption = 'Procedure List - '
|
||||
ClientHeight = 489
|
||||
ClientWidth = 816
|
||||
OnClose = FormClose
|
||||
ClientHeight = 688
|
||||
ClientWidth = 952
|
||||
OnCreate = FormCreate
|
||||
OnKeyPress = FormKeyPress
|
||||
OnResize = FormResize
|
||||
OnShow = FormShow
|
||||
LCLVersion = '1.7'
|
||||
Visible = True
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object StatusBar: TStatusBar
|
||||
Left = 0
|
||||
Height = 21
|
||||
Top = 468
|
||||
Width = 816
|
||||
Height = 23
|
||||
Top = 665
|
||||
Width = 952
|
||||
Panels = <
|
||||
item
|
||||
Width = 400
|
||||
@ -32,14 +31,14 @@ object ProcedureListForm: TProcedureListForm
|
||||
Left = 0
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 816
|
||||
Width = 952
|
||||
Caption = 'TB'
|
||||
EdgeBorders = []
|
||||
TabOrder = 1
|
||||
object tbAbout: TToolButton
|
||||
Left = 85
|
||||
Left = 136
|
||||
Hint = 'About'
|
||||
Top = 0
|
||||
Top = 2
|
||||
Caption = 'tbAbout'
|
||||
ImageIndex = 9
|
||||
OnClick = tbAboutClick
|
||||
@ -47,17 +46,17 @@ object ProcedureListForm: TProcedureListForm
|
||||
ShowHint = True
|
||||
end
|
||||
object ToolButton2: TToolButton
|
||||
Left = 80
|
||||
Left = 131
|
||||
Height = 22
|
||||
Top = 0
|
||||
Top = 2
|
||||
Width = 5
|
||||
Caption = 'ToolButton2'
|
||||
Style = tbsDivider
|
||||
end
|
||||
object tbJumpTo: TToolButton
|
||||
Left = 57
|
||||
Left = 108
|
||||
Hint = 'Jump To Selection'
|
||||
Top = 0
|
||||
Top = 2
|
||||
Caption = 'Goto'
|
||||
ImageIndex = 5
|
||||
OnClick = LVDblClick
|
||||
@ -65,17 +64,49 @@ object ProcedureListForm: TProcedureListForm
|
||||
ShowHint = True
|
||||
end
|
||||
object ToolButton4: TToolButton
|
||||
Left = 52
|
||||
Left = 103
|
||||
Height = 22
|
||||
Top = 0
|
||||
Top = 2
|
||||
Width = 5
|
||||
Caption = 'ToolButton4'
|
||||
Style = tbsDivider
|
||||
end
|
||||
object tbFilterAny: TToolButton
|
||||
Left = 80
|
||||
Hint = 'Filter by matching any part of method'
|
||||
Top = 2
|
||||
Caption = 'tbFilterAny'
|
||||
Down = True
|
||||
Grouped = True
|
||||
ImageIndex = 8
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
Style = tbsCheck
|
||||
end
|
||||
object tbFilterStart: TToolButton
|
||||
Left = 57
|
||||
Hint = 'Filter by matching with start of method'
|
||||
Top = 2
|
||||
Caption = 'tbFilterStart'
|
||||
Grouped = True
|
||||
ImageIndex = 7
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
Style = tbsCheck
|
||||
end
|
||||
object ToolButton7: TToolButton
|
||||
Left = 52
|
||||
Height = 22
|
||||
Top = 2
|
||||
Width = 5
|
||||
Caption = 'ToolButton7'
|
||||
Style = tbsDivider
|
||||
Visible = False
|
||||
end
|
||||
object tbChangeFont: TToolButton
|
||||
Left = 29
|
||||
Hint = 'Change Font'
|
||||
Top = 0
|
||||
Top = 2
|
||||
Caption = 'tbChangeFont'
|
||||
ImageIndex = 4
|
||||
OnClick = tbChangeFontClick
|
||||
@ -86,7 +117,7 @@ object ProcedureListForm: TProcedureListForm
|
||||
object ToolButton9: TToolButton
|
||||
Left = 24
|
||||
Height = 22
|
||||
Top = 0
|
||||
Top = 2
|
||||
Width = 5
|
||||
Caption = 'ToolButton9'
|
||||
Style = tbsDivider
|
||||
@ -94,7 +125,7 @@ object ProcedureListForm: TProcedureListForm
|
||||
object tbCopy: TToolButton
|
||||
Left = 1
|
||||
Hint = 'Copy method name to the clipboard'
|
||||
Top = 0
|
||||
Top = 2
|
||||
Caption = 'tbCopy'
|
||||
ImageIndex = 6
|
||||
OnClick = tbCopyClick
|
||||
@ -104,75 +135,85 @@ object ProcedureListForm: TProcedureListForm
|
||||
end
|
||||
object pnlHeader: TPanel
|
||||
Left = 0
|
||||
Height = 41
|
||||
Height = 35
|
||||
Top = 26
|
||||
Width = 816
|
||||
Width = 952
|
||||
Align = alTop
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 41
|
||||
ClientWidth = 816
|
||||
ClientHeight = 35
|
||||
ClientWidth = 952
|
||||
ParentColor = False
|
||||
TabOrder = 2
|
||||
object lblSearch: TLabel
|
||||
AnchorSideTop.Control = pnlHeader
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 35
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Search'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblObjects: TLabel
|
||||
AnchorSideLeft.Control = FilterMethods
|
||||
AnchorSideLeft.Control = edMethods
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = pnlHeader
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 269
|
||||
Height = 17
|
||||
Top = 12
|
||||
Width = 49
|
||||
BorderSpacing.Left = 110
|
||||
Left = 581
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 40
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Objects'
|
||||
ParentColor = False
|
||||
end
|
||||
object edMethods: TEdit
|
||||
AnchorSideLeft.Control = lblSearch
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = pnlHeader
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = cbObjects
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 47
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 516
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
OnChange = edMethodsChange
|
||||
OnKeyDown = edMethodsKeyDown
|
||||
OnKeyPress = edMethodsKeyPress
|
||||
TabOrder = 0
|
||||
end
|
||||
object cbObjects: TComboBox
|
||||
AnchorSideLeft.Control = lblObjects
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = pnlHeader
|
||||
AnchorSideRight.Control = pnlHeader
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 324
|
||||
Height = 29
|
||||
Left = 627
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 486
|
||||
Width = 319
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 0
|
||||
ItemHeight = 15
|
||||
OnChange = cbObjectsChange
|
||||
Sorted = True
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
object FilterMethods: TListViewFilterEdit
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = pnlHeader
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = cbObjects
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 6
|
||||
Width = 147
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
MaxLength = 0
|
||||
TabOrder = 1
|
||||
FilteredListview = LV
|
||||
ByAllFields = True
|
||||
end
|
||||
end
|
||||
object LV: TListView
|
||||
Left = 0
|
||||
Height = 401
|
||||
Top = 67
|
||||
Width = 816
|
||||
Height = 604
|
||||
Top = 61
|
||||
Width = 952
|
||||
Align = alClient
|
||||
Columns = <
|
||||
item
|
||||
@ -186,7 +227,7 @@ object ProcedureListForm: TProcedureListForm
|
||||
end
|
||||
item
|
||||
Caption = 'Line'
|
||||
Width = 550
|
||||
Width = 238
|
||||
end>
|
||||
HideSelection = False
|
||||
Items.LazData = {
|
||||
|
||||
@ -36,25 +36,19 @@ unit ProcedureList;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
// FCL, LCL
|
||||
Classes, SysUtils,
|
||||
Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, LCLType, Clipbrd,
|
||||
// Codetools
|
||||
CodeTree, CodeToolManager, CodeCache, PascalParserTool, KeywordFuncLists, FileProcs,
|
||||
// IdeIntf
|
||||
IDEImagesIntf, SrcEditorIntf, IDEWindowIntf, LazIDEIntf, IDECommands,
|
||||
ListViewFilterEdit,
|
||||
// IDE
|
||||
IDEOptionDefs, LazarusIDEStrConsts;
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||
ExtCtrls, StdCtrls,
|
||||
CodeTree, CodeToolManager, CodeCache,
|
||||
IDEImagesIntf;
|
||||
|
||||
type
|
||||
{ TProcedureListForm }
|
||||
TProcedureListForm = class(TForm)
|
||||
cbObjects: TComboBox;
|
||||
FilterMethods: TListViewFilterEdit;
|
||||
edMethods: TEdit;
|
||||
lblObjects: TLabel;
|
||||
lblSearch: TLabel;
|
||||
LV: TListView;
|
||||
pnlHeader: TPanel;
|
||||
StatusBar: TStatusBar;
|
||||
@ -64,11 +58,16 @@ type
|
||||
ToolButton2: TToolButton;
|
||||
tbJumpTo: TToolButton;
|
||||
ToolButton4: TToolButton;
|
||||
tbFilterAny: TToolButton;
|
||||
tbFilterStart: TToolButton;
|
||||
ToolButton7: TToolButton;
|
||||
tbChangeFont: TToolButton;
|
||||
ToolButton9: TToolButton;
|
||||
procedure cbObjectsChange(Sender: TObject);
|
||||
procedure edMethodsChange(Sender: TObject);
|
||||
procedure edMethodsKeyDown(Sender: TObject; var Key: Word;
|
||||
{%H-}Shift: TShiftState);
|
||||
procedure edMethodsKeyPress(Sender: TObject; var Key: char);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormKeyPress(Sender: TObject; var Key: char);
|
||||
procedure FormResize(Sender: TObject);
|
||||
@ -87,10 +86,11 @@ type
|
||||
{ Move editors focus to selected method. }
|
||||
procedure JumpToSelection;
|
||||
{ Populates Listview based on selected Class and user entered filter. }
|
||||
procedure AddToListView(pCodeTool: TCodeTool; pNode: TCodeTreeNode);
|
||||
procedure PopulateListview;
|
||||
{ Populates only tho cbObjects combo with available classes. }
|
||||
procedure PopulateObjectsCombo;
|
||||
procedure AddToListView(pCodeTool: TCodeTool; pNode: TCodeTreeNode);
|
||||
function PassFilter(pSearchAll: boolean; pProcName, pSearchStr: string; pCodeTool: TCodeTool; pNode: TCodeTreeNode): boolean;
|
||||
public
|
||||
property MainFilename: string read FMainFilename;
|
||||
property Caret: TCodeXYPosition read FCaret;
|
||||
@ -98,70 +98,128 @@ type
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
ProcListView: TProcedureListForm = nil;
|
||||
|
||||
procedure ExecuteProcedureList(Sender: TObject);
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
SrcEditorIntf
|
||||
,PascalParserTool
|
||||
,KeywordFuncLists
|
||||
,LCLType
|
||||
,LazIDEIntf
|
||||
,IDECommands
|
||||
,Clipbrd
|
||||
,LazarusIDEStrConsts
|
||||
;
|
||||
|
||||
|
||||
const
|
||||
cAbout =
|
||||
'Procedure List (Lazarus addon)' + #10#10 +
|
||||
'Author: Graeme Geldenhuys (graemeg@gmail.com)' + #10 +
|
||||
'Inspired by: GExperts (www.gexperts.org)';
|
||||
|
||||
// ToDo: set a callback notification for source editor page change.
|
||||
|
||||
{ TProcedureListForm }
|
||||
|
||||
procedure TProcedureListForm.FormCreate(Sender: TObject);
|
||||
{ This is where it all starts. Gets called from Lazarus. }
|
||||
procedure ExecuteProcedureList(Sender: TObject);
|
||||
var
|
||||
frm: TProcedureListForm;
|
||||
begin
|
||||
Name:=NonModalIDEWindowNames[nmiwProcedureList];
|
||||
SetupGUI;
|
||||
// Very weird: populating Combobox here shows only unique entries, no duplicates.
|
||||
// Calling the same method in FormShow shows duplicates. Makes no sense ...
|
||||
//PopulateObjectsCombo;
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
if Assigned(Parent) then
|
||||
begin
|
||||
// Using a dock manager...
|
||||
CloseAction := caNone;
|
||||
// Copied from TComponentListForm.FormClose
|
||||
if Assigned(HostDockSite) and (HostDockSite.DockClientCount <= 1)
|
||||
and (HostDockSite is TCustomForm) and (HostDockSite.Parent = nil) then
|
||||
Assert(Sender<>nil); // removes compiler warning
|
||||
|
||||
frm := TProcedureListForm.Create(nil);
|
||||
try
|
||||
frm.ShowModal;
|
||||
if frm.ModalResult = mrOK then // we need to jump
|
||||
begin
|
||||
TCustomForm(HostDockSite).Close;
|
||||
LazarusIDE.DoOpenFileAndJumpToPos(frm.Caret.Code.Filename,
|
||||
Point(frm.Caret.X, frm.Caret.Y), frm.NewTopLine, -1,-1,
|
||||
[ofRegularFile,ofUseCache]);
|
||||
end;
|
||||
finally
|
||||
frm.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.FormShow(Sender: TObject);
|
||||
|
||||
{ Check, if the given string starts with this substring. Check ignores case. }
|
||||
function StrStartsWith(sStr, sSubstr: String): Boolean;
|
||||
begin
|
||||
if Assigned(SourceEditorManagerIntf.ActiveEditor) then
|
||||
FMainFilename := SourceEditorManagerIntf.ActiveEditor.Filename
|
||||
else
|
||||
FMainFilename := '';
|
||||
Caption := lisPListProcedureList + ' - ' + ExtractFileName(FMainFilename);
|
||||
PopulateObjectsCombo;
|
||||
PopulateListView;
|
||||
StatusBar.Panels[0].Text := self.MainFilename;
|
||||
FilterMethods.SetFocus; // ActiveControl gets lost sometimes.
|
||||
sStr := AnsiUpperCase(sStr);
|
||||
sSubstr := AnsiUpperCase(sSubstr);
|
||||
|
||||
Result := Pos(sSubstr, sStr) = 1;
|
||||
end;
|
||||
|
||||
|
||||
function StrContains(const SubStr, Str: string; CaseSensitive: Boolean): Boolean;
|
||||
begin
|
||||
if CaseSensitive then
|
||||
Result := Pos(SubStr, Str) > 0
|
||||
else
|
||||
Result := Pos(AnsiUpperCase(SubStr), AnsiUpperCase(Str)) > 0;
|
||||
end;
|
||||
|
||||
|
||||
function FilterFits(const SubStr, Str: string): boolean;
|
||||
var
|
||||
Src: PChar;
|
||||
PFilter: PChar;
|
||||
c: Char;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := SubStr='';
|
||||
if not Result then
|
||||
begin
|
||||
Src := PChar(Str);
|
||||
PFilter := PChar(SubStr);
|
||||
repeat
|
||||
c := Src^;
|
||||
if c <> #0 then
|
||||
begin
|
||||
if UpChars[Src^] = UpChars[PFilter^] then
|
||||
begin
|
||||
i := 1;
|
||||
while (UpChars[Src[i]] = UpChars[PFilter[i]]) and (PFilter[i] <> #0) do
|
||||
inc(i);
|
||||
if PFilter[i] = #0 then
|
||||
begin
|
||||
exit(true);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
exit(false);
|
||||
inc(Src);
|
||||
until false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TProcedureListForm }
|
||||
|
||||
procedure TProcedureListForm.FormResize(Sender: TObject);
|
||||
begin
|
||||
StatusBar.Panels[0].Width := self.ClientWidth - 105;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.FormShow(Sender: TObject);
|
||||
begin
|
||||
edMethods.SetFocus;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.LVDblClick(Sender: TObject);
|
||||
begin
|
||||
JumpToSelection;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.LVSelectItem(Sender: TObject; Item: TListItem;
|
||||
Selected: Boolean);
|
||||
begin
|
||||
@ -173,6 +231,7 @@ begin
|
||||
StatusBar.Panels[0].Text := Item.SubItems[4];
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.tbAboutClick(Sender: TObject);
|
||||
begin
|
||||
ShowMessage(cAbout);
|
||||
@ -183,21 +242,27 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.tbCopyClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(LV.Selected) then
|
||||
Clipboard.AsText := LV.Selected.SubItems[0];
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.SetupGUI;
|
||||
begin
|
||||
self.KeyPreview := True;
|
||||
self.Position := poScreenCenter;
|
||||
|
||||
// assign resource strings to Captions and Hints
|
||||
self.Caption := lisPListProcedureList;
|
||||
lblObjects.Caption := lisPListObjects;
|
||||
lblSearch.Caption := lisMenuSearch;
|
||||
tbAbout.Hint := lisMenuTemplateAbout;
|
||||
tbJumpTo.Hint := lisPListJumpToSelection;
|
||||
tbFilterAny.Hint := lisPListFilterAny;
|
||||
tbFilterStart.Hint := lisPListFilterStart;
|
||||
tbChangeFont.Hint := lisPListChangeFont;
|
||||
tbCopy.Hint := lisPListCopyMethodToClipboard;
|
||||
LV.Column[1].Caption := lisProcedure;
|
||||
@ -210,6 +275,8 @@ begin
|
||||
tbChangeFont.ImageIndex := IDEImages.LoadImage(16, 'item_font');
|
||||
tbAbout.ImageIndex := IDEImages.LoadImage(16, 'menu_information');
|
||||
tbJumpTo.ImageIndex := IDEImages.LoadImage(16, 'menu_goto_line');
|
||||
tbFilterAny.ImageIndex := IDEImages.LoadImage(16, 'item_filter');
|
||||
tbFilterStart.ImageIndex := IDEImages.LoadImage(16, 'item_filter');
|
||||
|
||||
LV.Column[0].Width := 20;
|
||||
LV.Column[1].Width := 300;
|
||||
@ -222,11 +289,14 @@ begin
|
||||
LV.SortType := stText;
|
||||
LV.HideSelection := False;
|
||||
|
||||
LV.Items.Clear;
|
||||
|
||||
cbObjects.Style := csDropDownList;
|
||||
cbObjects.Sorted := True;
|
||||
cbObjects.DropDownCount := 8;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.JumpToSelection;
|
||||
var
|
||||
lItem: TListItem;
|
||||
@ -254,46 +324,10 @@ begin
|
||||
if not ACodeTool.CleanPosToCaretAndTopLine(lStartPos, FCaret, FNewTopLine) then
|
||||
Exit; //==>
|
||||
|
||||
LazarusIDE.DoOpenFileAndJumpToPos(Caret.Code.Filename, Point(Caret.X, Caret.Y),
|
||||
NewTopLine, -1,-1, [ofRegularFile,ofUseCache]);
|
||||
Close;
|
||||
{ This should close the form }
|
||||
self.ModalResult := mrOK;
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.AddToListView(pCodeTool: TCodeTool; pNode: TCodeTreeNode);
|
||||
var
|
||||
Data: TStringArray;
|
||||
lNodeText: string;
|
||||
lCaret: TCodeXYPosition;
|
||||
begin
|
||||
SetLength(Data, 6); // Data[0] remains empty
|
||||
|
||||
{ procedure name }
|
||||
Data[1] := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithoutParamList, phpWithoutBrackets, phpWithoutSemicolon]);
|
||||
|
||||
{ type }
|
||||
lNodeText := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithStart, phpWithoutParamList, phpWithoutBrackets, phpWithoutSemicolon]);
|
||||
if Pos('procedure', lNodeText) > 0 then
|
||||
Data[2] := 'Procedure'
|
||||
else
|
||||
Data[2] := 'Function';
|
||||
|
||||
{ line number }
|
||||
if pCodeTool.CleanPosToCaret(pNode.StartPos, lCaret) then
|
||||
Data[3] := IntToStr(lCaret.Y);
|
||||
|
||||
{ start pos - used by JumpToSelected() }
|
||||
Data[4] := IntToStr(pNode.StartPos);
|
||||
|
||||
{ full procedure name used in statusbar }
|
||||
Data[5] := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithStart,phpWithVarModifiers,
|
||||
phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
|
||||
phpWithOfObject,phpWithCallingSpecs,phpWithProcModifiers]);
|
||||
|
||||
FilterMethods.Items.Add(Data);
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.PopulateListview;
|
||||
var
|
||||
@ -302,8 +336,9 @@ var
|
||||
lCodeTool: TCodeTool;
|
||||
lNode: TCodeTreeNode;
|
||||
begin
|
||||
LV.BeginUpdate;
|
||||
try
|
||||
FilterMethods.Items.Clear;
|
||||
LV.Items.Clear;
|
||||
{ get active source editor }
|
||||
lSrcEditor := SourceEditorManagerIntf.ActiveEditor;
|
||||
if lSrcEditor = nil then
|
||||
@ -314,7 +349,9 @@ begin
|
||||
CodeToolBoss.Explore(lCodeBuffer,lCodeTool,False);
|
||||
|
||||
{ copy the tree }
|
||||
if (lCodeTool = nil) or (lCodeTool.Tree = nil) or (lCodeTool.Tree.Root = nil) then
|
||||
if (lCodeTool = nil)
|
||||
or (lCodeTool.Tree = nil)
|
||||
or (lCodeTool.Tree.Root = nil) then
|
||||
Exit; //==>
|
||||
|
||||
if Assigned(lCodeTool.Tree) then
|
||||
@ -322,28 +359,33 @@ begin
|
||||
{ Find the starting point }
|
||||
lNode := lCodeTool.FindImplementationNode;
|
||||
if lNode = nil then
|
||||
begin
|
||||
{ fall back - guess we are working with a program unit }
|
||||
lNode := lCodeTool.Tree.Root;
|
||||
end;
|
||||
|
||||
{ populate the listview here }
|
||||
lNode := lNode.FirstChild;
|
||||
while lNode <> nil do
|
||||
begin
|
||||
if lNode.Desc = ctnProcedure then
|
||||
begin
|
||||
AddToListView(lCodeTool, lNode);
|
||||
end;
|
||||
lNode := lNode.NextBrother;
|
||||
end;
|
||||
end; { if }
|
||||
finally
|
||||
FilterMethods.InvalidateFilter;
|
||||
if LV.Items.Count > 0 then
|
||||
begin
|
||||
LV.Selected := LV.Items[0];
|
||||
LV.ItemFocused := LV.Items[0];
|
||||
end;
|
||||
LV.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.PopulateObjectsCombo;
|
||||
var
|
||||
lSrcEditor: TSourceEditorInterface;
|
||||
@ -369,27 +411,26 @@ begin
|
||||
Exit; //==>
|
||||
|
||||
{ copy the tree }
|
||||
{ Find the starting point }
|
||||
lNode := lCodeTool.FindImplementationNode;
|
||||
if lNode = nil then
|
||||
if Assigned(lCodeTool.Tree) 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
|
||||
{ Find the starting point }
|
||||
lNode := lCodeTool.FindImplementationNode;
|
||||
if lNode = nil then
|
||||
begin
|
||||
lNodeText := lCodeTool.ExtractClassNameOfProcNode(lNode);
|
||||
if lNodeText <> '' then
|
||||
{ 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
|
||||
DebugLn(['TProcedureListForm.PopulateObjectsCombo: Adding "', lNodeText, '" to combobox items.']);
|
||||
lNodeText := lCodeTool.ExtractClassNameOfProcNode(lNode);
|
||||
cbObjects.Items.Add(lNodeText);
|
||||
end;
|
||||
lNode := lNode.NextBrother;
|
||||
end;
|
||||
lNode := lNode.NextBrother;
|
||||
end;
|
||||
cbObjects.Sorted := true;
|
||||
cbObjects.Sorted := false;
|
||||
@ -402,35 +443,183 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.AddToListView(pCodeTool: TCodeTool; pNode: TCodeTreeNode);
|
||||
var
|
||||
lItem: TListItem;
|
||||
lNodeText: string;
|
||||
lType: string;
|
||||
lCaret: TCodeXYPosition;
|
||||
FSearchAll: boolean;
|
||||
begin
|
||||
FSearchAll := cbObjects.Text = lisPListAll;
|
||||
lNodeText := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithoutClassKeyword, phpWithoutParamList, phpWithoutBrackets,
|
||||
phpWithoutSemicolon, phpWithoutClassName]);
|
||||
|
||||
{ Must we add this pNode or not? }
|
||||
if not PassFilter(FSearchAll, lNodeText, edMethods.Text, pCodeTool, pNode) then
|
||||
Exit; //==>
|
||||
|
||||
{ Add new list item }
|
||||
lItem := LV.Items.Add;
|
||||
|
||||
{ procedure name }
|
||||
lNodeText := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithoutParamList, phpWithoutBrackets, phpWithoutSemicolon]);
|
||||
lItem.SubItems.Add(lNodeText);
|
||||
|
||||
{ type }
|
||||
lNodeText := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithStart, phpWithoutParamList, phpWithoutBrackets, phpWithoutSemicolon]);
|
||||
if Pos('procedure', lNodeText) > 0 then
|
||||
lType := 'Procedure'
|
||||
else
|
||||
lType := 'Function';
|
||||
lItem.SubItems.Add(lType);
|
||||
|
||||
{ line number }
|
||||
if pCodeTool.CleanPosToCaret(pNode.StartPos, lCaret) then
|
||||
lItem.SubItems.Add(IntToStr(lCaret.Y));
|
||||
|
||||
{ start pos - used by JumpToSelected() }
|
||||
lItem.SubItems.Add(IntToStr(pNode.StartPos));
|
||||
|
||||
{ full procedure name used in statusbar }
|
||||
lNodeText := pCodeTool.ExtractProcHead(pNode,
|
||||
[phpWithStart,phpWithVarModifiers,
|
||||
phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
|
||||
phpWithOfObject,phpWithCallingSpecs,phpWithProcModifiers]);
|
||||
lItem.SubItems.Add(lNodeText);
|
||||
end;
|
||||
|
||||
|
||||
{ Do we pass all the filter tests to continue? }
|
||||
function TProcedureListForm.PassFilter(pSearchAll: boolean;
|
||||
pProcName, pSearchStr: string; pCodeTool: TCodeTool; pNode: TCodeTreeNode
|
||||
): boolean;
|
||||
var
|
||||
lClass: string;
|
||||
|
||||
function ClassMatches: boolean;
|
||||
begin
|
||||
{ lets filter by class selection. }
|
||||
lClass := pCodeTool.ExtractClassNameOfProcNode(pNode);
|
||||
if cbObjects.Text = lisPListNone then
|
||||
Result := lClass = ''
|
||||
else
|
||||
Result := lClass = cbObjects.Text;
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
if (Length(pSearchStr) = 0) then // seach string is empty
|
||||
begin
|
||||
if pSearchAll then
|
||||
Result := True
|
||||
else
|
||||
Result := ClassMatches;
|
||||
end
|
||||
else if not pSearchAll and tbFilterStart.Down
|
||||
and SameText(pSearchStr, Copy(pProcName, 1, Length(pSearchStr))) then
|
||||
Result := True
|
||||
else if not pSearchAll and tbFilterAny.Down and ClassMatches
|
||||
and FilterFits(pSearchStr, pProcName) then
|
||||
Result := True
|
||||
else if pSearchAll and FilterFits(pSearchStr, pProcName) then
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.FormKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if Key = #27 then // Escape key
|
||||
begin
|
||||
Close;
|
||||
self.ModalResult := mrCancel;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.cbObjectsChange(Sender: TObject);
|
||||
|
||||
procedure TProcedureListForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// ToDo: populate based on the selected item
|
||||
PopulateListview;
|
||||
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;
|
||||
PopulateObjectsCombo;
|
||||
PopulateListView;
|
||||
StatusBar.Panels[0].Text := self.MainFilename;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.edMethodsKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
case Key of
|
||||
#13:
|
||||
begin
|
||||
Key := #0;
|
||||
JumpToSelection;
|
||||
Key := #0;
|
||||
end;
|
||||
#27:
|
||||
begin
|
||||
self.ModalResult := mrCancel;
|
||||
Key := #0;
|
||||
Close;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
procedure TProcedureListForm.edMethodsChange(Sender: TObject);
|
||||
begin
|
||||
PopulateListview;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.cbObjectsChange(Sender: TObject);
|
||||
begin
|
||||
PopulateListview;
|
||||
end;
|
||||
|
||||
|
||||
procedure TProcedureListForm.edMethodsKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if LV.Items.Count = 0 then
|
||||
Exit;
|
||||
|
||||
if Key = VK_Down then
|
||||
begin
|
||||
if (LV.Items.IndexOf(LV.ItemFocused) + 1) < LV.Items.Count then
|
||||
LV.ItemFocused := LV.Items[(LV.Items.IndexOf(LV.ItemFocused) + 1)];
|
||||
end
|
||||
else if Key = VK_Up then
|
||||
begin
|
||||
if (LV.Items.IndexOf(LV.ItemFocused) - 1) >= 0 then
|
||||
LV.ItemFocused := LV.Items[(LV.Items.IndexOf(LV.ItemFocused) - 1)];
|
||||
end
|
||||
else if Key = VK_Home then
|
||||
begin
|
||||
LV.ItemFocused := LV.Items[0];
|
||||
end
|
||||
else if Key = VK_End then
|
||||
begin
|
||||
LV.ItemFocused := LV.Items[LV.Items.Count - 1];
|
||||
end;
|
||||
|
||||
if LV.ItemFocused<>nil then
|
||||
begin
|
||||
LV.Selected := LV.ItemFocused;
|
||||
if Assigned(LV.Selected) then
|
||||
LV.Selected.MakeVisible(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user