paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 01:56:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Codetools: Extend JumpToImplementation example with a tool button and drop-down-menu. By Ondrej Pokorny.

Browse Source 
git-svn-id: trunk@49799 -
This commit is contained in:
juha 2015-09-09 16:47:32 +00:00
parent f228ab12a3
commit eb8f5528e5
1 changed files with 70 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
examples/codetools/jumptoimplementation/codetoolsexample1.pas
View File

@ -28,15 +28,29 @@ interface
uses
Classes, SysUtils, MenuIntf, LazIDEIntf, Controls, SrcEditorIntf,
CodeToolManager, CodeTree, CodeCache, CustomCodeTool, IDECommands,
LCLType;
LCLType, Menus, ComCtrls;
type
TJumpToSectionDemoToolButton = class(TIDEToolButton)
private
procedure JumpToInterface(Sender: TObject);
procedure JumpToImplementation(Sender: TObject);
public
procedure DoOnAdded; override;
end;
TKeyWordType = (kwInterface, kwImplementation);
procedure JumpIDEToKeyword(KeywordType: TKeyWordType);
procedure JumpIDEToImplementationKeyword(Sender: TObject);
procedure JumpIDEToInterfaceKeyword(Sender: TObject);
procedure Register;
implementation
procedure JumpIDEToImplementationKeyword(Sender: TObject);
procedure JumpIDEToKeyword(KeywordType: TKeyWordType);
var
SrcEditor: TSourceEditorInterface;
CodeBuffer: TCodeBuffer;
@ -47,15 +61,14 @@ var
NewTopLine: Integer;
Ok: Boolean;
begin
if Sender=nil then ;
// commit editor changes to codetools
if not LazarusIDE.BeginCodeTools then exit;
// get active source editor
SrcEditor:=SourceEditorManagerIntf.ActiveEditor;
if SrcEditor=nil then exit;
CodeBuffer:=SrcEditor.CodeToolsBuffer as TCodeBuffer;
Ok:=false;
try
// init codetool for the source
@ -64,7 +77,10 @@ begin
if CurCodeTool is TCodeTool then begin
// search imlementation node
Tool:=TCodeTool(CurCodeTool);
Node:=Tool.FindImplementationNode;
case KeywordType of
kwInterface: Node:=Tool.FindInterfaceNode;
kwImplementation: Node:=Tool.FindImplementationNode;
end;
if Node<>nil then begin
// convert text position to editor postion
NewTopLine:=0;
@ -91,19 +107,66 @@ begin
LazarusIDE.DoJumpToCodeToolBossError;
end;
procedure JumpIDEToImplementationKeyword(Sender: TObject);
begin
JumpIDEToKeyword(kwImplementation);
end;
procedure JumpIDEToInterfaceKeyword(Sender: TObject);
begin
JumpIDEToKeyword(kwInterface);
end;
procedure Register;
var
Key: TIDEShortCut;
Cat: TIDECommandCategory;
CmdMyTool: TIDECommand;
xMenuCmd: TIDEMenuCommand;
begin
// register IDE shortcut and menu item
Key := IDEShortCut(VK_UNKNOWN,[],VK_UNKNOWN,[]);
Cat:=IDECommandList.FindCategoryByName(CommandCategoryCodeTools);
CmdMyTool := RegisterIDECommand(Cat,'JumpToImplementationDemo', 'Jump to implementation keyword (demo)', Key, nil, @JumpIDEToImplementationKeyword);
RegisterIDEMenuCommand(itmCodeToolSearches,'JumpToImplementationDemo',
xMenuCmd := RegisterIDEMenuCommand(itmCodeToolSearches,'JumpToImplementationDemo',
'Jump to implementation keyword (demo)',nil,@JumpIDEToImplementationKeyword, CmdMyTool);
xMenuCmd.ToolButtonClass := TJumpToSectionDemoToolButton;
end;
{ TJumpToSectionDemoToolButton }
procedure TJumpToSectionDemoToolButton.DoOnAdded;
var
xItem: TMenuItem;
begin
inherited DoOnAdded;
if DropdownMenu = nil then
begin
DropdownMenu := TPopupMenu.Create(Self);
Style := tbsDropDown;
end;
xItem := TMenuItem.Create(DropdownMenu);
DropdownMenu.Items.Add(xItem);
xItem.Caption := 'Jump to interface keyword';
xItem.OnClick := @JumpToInterface;
xItem := TMenuItem.Create(DropdownMenu);
DropdownMenu.Items.Add(xItem);
xItem.Caption := 'Jump to implementation keyword';
xItem.OnClick := @JumpToImplementation;
end;
procedure TJumpToSectionDemoToolButton.JumpToImplementation(Sender: TObject);
begin
JumpIDEToImplementationKeyword(Sender);
end;
procedure TJumpToSectionDemoToolButton.JumpToInterface(Sender: TObject);
begin
JumpIDEToInterfaceKeyword(Sender);
end;
end.