On 09.09.2015 08:26, Juha Manninen wrote:
Now such code can be found in DesktopManager and MainBase units.
If somebody (maybe patspiper) creates an example application, we can
add it to examples directory.
Or should it be part of some already existing application?
Juha
I updated the "examples\codetools\jumptoimplementation\" example with a
drop-down-menu. See patch.
Ondrej
Index: examples/codetools/jumptoimplementation/codetoolsexample1.pas
===================================================================
--- examples/codetools/jumptoimplementation/codetoolsexample1.pas
(revision 49788)
+++ examples/codetools/jumptoimplementation/codetoolsexample1.pas
(working copy)
@@ -28,15 +28,29 @@
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 @@
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 @@
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,11 +107,22 @@
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,[]);
@@ -102,9 +129,45 @@
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.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
