[Lazarus] IDE CoolBar issue

[Ondrej Pokorny]

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
-------------- next part --------------
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, at 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.