diff --git a/ide/ideoptiondefs.pas b/ide/ideoptiondefs.pas index 36b2b30906..c6da778961 100644 --- a/ide/ideoptiondefs.pas +++ b/ide/ideoptiondefs.pas @@ -88,8 +88,7 @@ type nmiwCodeBrowser, nmiwIssueBrowser, nmiwJumpHistory, - nmiwComponentList, - nmiwProcedureList + nmiwComponentList ); const @@ -125,8 +124,7 @@ const 'CodeBrowser', 'IssueBrowser', 'JumpHistory', - 'ComponentList', - 'ProcedureList' + 'ComponentList' ); type diff --git a/ide/main.pp b/ide/main.pp index 9cd5d4ca22..f84266986a 100644 --- a/ide/main.pp +++ b/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; diff --git a/ide/procedurelist.lfm b/ide/procedurelist.lfm index cd0250daae..7d0eb1770c 100644 --- a/ide/procedurelist.lfm +++ b/ide/procedurelist.lfm @@ -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 = { diff --git a/ide/procedurelist.pas b/ide/procedurelist.pas index 63a6586fd3..0202372671 100644 --- a/ide/procedurelist.pas +++ b/ide/procedurelist.pas @@ -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.