Delphi OTAPI AddMenuCreatorNotifier deprecated, what is the replacement?

Question

I am following the CodeCentral article on how to extend the project menu in Delphi IDE, using IOTAProjectManager.

The sample wizard code on code-central does this:

procedure Register;
begin
  FNotifierIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuCreatorNotifier(TMyContextMenu.Create); // deprecated.
end;

What is the new technique to register a context menu such as the project menu one? Note that this was deprecated without even making it onto the docwiki.

Screenshot of desired result:

Update: I could not find any up to date tutorials including code. There is a PDF whitepaper on Embarcadero's website but the code samples from that whitepaper by Bruno Fierens are not anywhere on the web. I made an answer below with a working example, which is on bitbucket, you can download the zip below.

Answer 1

If you look at the source code in $(BDS)\Source\ToolsAPI\ToolsAPI.pas, the declaration of IOTAProjectManager.AddMenuCreatorNotifier() says:

This function is deprecated -- use AddMenuItemCreatorNotifier instead

And also, the declaration of INTAProjectMenuCreatorNotifier says:

This notifier is deprecated. Use IOTAProjectMenuItemCreatorNotifier instead. It supports adding menu items for multi-selected items in the Project Manager.

Here are the relevant declarations and descriptions. Note the comments:

type
  ...
  { This notifier is deprecated. Use IOTAProjectMenuItemCreatorNotifier instead.
    It supports adding menu items for multi-selected items in the Project Manager. }
  INTAProjectMenuCreatorNotifier = interface(IOTANotifier)
    ['{8209348C-2114-439C-AD4E-BFB7049A636A}']
    { The result will be inserted into the project manager local menu. Menu
      may have child menus. }
    function AddMenu(const Ident: string): TMenuItem;
    { Return True if you wish to install a project manager menu item for this
      ident.  In cases where the project manager node is a file Ident will be
      a fully qualified file name. }
    function CanHandle(const Ident: string): Boolean;
  end;

  IOTAProjectMenuItemCreatorNotifier = interface(IOTANotifier)
    ['{CFEE5A57-2B04-4CD6-968E-1CBF8BF96522}']
    { For each menu item you wish to add to the project manager for the given
      list of idents, add an IOTAProjectManagerMenu to the ProjectManagerMenuList.
      An example of a value for IdentList is sFileContainer and the name of the
      file, look above in this file for other constants. }
    procedure AddMenu(const Project: IOTAProject; const IdentList: TStrings;
      const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
  end;

  IOTAProjectManager = interface(IInterface)
    ['{B142EF92-0A91-4614-A72A-CE46F9C88B7B}']
    { This function is deprecated -- use AddMenuItemCreatorNotifier instead }
    function AddMenuCreatorNotifier(const Notifier: INTAProjectMenuCreatorNotifier): Integer; deprecated;
    { Adds a menu notifier, which allows you to customize the local menu of the
      project manager }
    function AddMenuItemCreatorNotifier(const Notifier: IOTAProjectMenuItemCreatorNotifier): Integer;
    ...
    { This function is deprecated -- use RemoveMenuItemCreatorNotifier instead }
    procedure RemoveMenuCreatorNotifier(Index: Integer); deprecated;
    { Removes a previously added menu notifier }
    procedure RemoveMenuItemCreatorNotifier(Index: Integer);
  end;

  ...

  { This is meant to be an abstract interface that describes a menu context that
    can be passed to an IOTALocalMenu-descendant's Execute method. }
  IOTAMenuContext = interface(IInterface)
    ['{378F0D38-ED5F-4128-B7D6-9D423FC1502F}']
    { Returns the identifier for this context }
    function GetIdent: string;
    { Returns the verb for this context }
    function GetVerb: string;

    property Ident: string read GetIdent;
    property Verb: string read GetVerb;
  end;

  { This is meant to be an abstract interface that describes a local menu item
    in an IDE view.  Specific views that can have their local menus customized
    will provide a descendant interface to be used for that view }
  IOTALocalMenu = interface(IOTANotifier)
    ['{83ECCBDF-939D-4F8D-B96D-A0C67ACC86EA}']
    { Returns the Caption to be used for this menu item }
    function GetCaption: string;
    { Returns the Checked state to be used for this menu item }
    function GetChecked: Boolean;
    { Returns the Enabled state to be used for this menu item }
    function GetEnabled: Boolean;
    { Returns the help context to be used for this menu item }
    function GetHelpContext: Integer;
    { Returns the Name for this menu item.  If blank, a name will be generated }
    function GetName: string;
    { Returns the parent menu for this menu item }
    function GetParent: string;
    { Returns the position of this menu item within the menu }
    function GetPosition: Integer;
    { Returns the verb associated with this menu item }
    function GetVerb: string;
    { Sets the Caption of the menu item to the specified value }
    procedure SetCaption(const Value: string);
    { Sets the Checked state of the menu item to the specified value }
    procedure SetChecked(Value: Boolean);
    { Sets the Enabled  state of the menu item to the specified value }
    procedure SetEnabled(Value: Boolean);
    { Sets the help context of the menu item to the specified value }
    procedure SetHelpContext(Value: Integer);
    { Sets the Name of the menu item to the specified value }
    procedure SetName(const Value: string);
    { Sets the Parent of the menu item to the specified value }
    procedure SetParent(const Value: string);
    { Sets the position of the menu item to the specified value }
    procedure SetPosition(Value: Integer);
    { Sets the verb associated with the menu item to the specified value }
    procedure SetVerb(const Value: string);

    property Caption: string read GetCaption write SetCaption;
    property Checked: Boolean read GetChecked write SetChecked;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property HelpContext: Integer read GetHelpContext write SetHelpContext;
    property Name: string read GetName write SetName;
    property Parent: string read GetParent write SetParent;
    property Position: Integer read GetPosition write SetPosition;
    property Verb: string read GetVerb write SetVerb;
  end;

  { This is the context used for Project Manager local menu items.  The list
  passed to IOTAProjectManagerMenu.Execute will be a list of these interfaces }
  IOTAProjectMenuContext = interface(IOTAMenuContext)
    ['{ECEC33FD-837A-46DC-A0AD-1FFEBEEA23AF}']
    { Returns the project associated with the menu item }
    function GetProject: IOTAProject;

    property Project: IOTAProject read GetProject;
  end;

  { This is a Project Manager specific local menu item }
  IOTAProjectManagerMenu = interface(IOTALocalMenu)
    ['{5E3B2F18-306E-4922-9067-3F71843C51FA}']
    { Indicates whether or not this menu item supports multi-selected items }
    function GetIsMultiSelectable: Boolean;
    { Sets this menu item's multi-selected state }
    procedure SetIsMultiSelectable(Value: Boolean);
    { Execute is called when the menu item is selected.  MenuContextList is a
      list of IOTAProjectMenuContext.  Each item in the list represents an item
      in the project manager that is selected }
    procedure Execute(const MenuContextList: IInterfaceList); overload;
    { PreExecute is called before the Execute method.  MenuContextList is a list
      of IOTAProjectMenuContext.  Each item in the list represents an item in
      the project manager that is selected }
    function PreExecute(const MenuContextList: IInterfaceList): Boolean;
    { PostExecute is called after the Execute method.  MenuContextList is a list
      of IOTAProjectMenuContext.  Each item in the list represents an item in
      the project manager that is selected }
    function PostExecute(const MenuContextList: IInterfaceList): Boolean;

    property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
  end;

Answer 2

Remy's answer is correct, but I'm providing this answer because I have written a little unit to do Project Menu (context menu) integration, and as well, as a bonus, this demo also shows main menu and IDE insight.

The code snippet in my answer covers how to actually write the code which is in several layers of classes, one of which must implement IOTAProjectMenuItemCreatorNotifier interface.

The demo on bitbucket actually does several things that are useful:

• As this question asks, it puts a custom item in the project right click context menu.
• It also registers a global keyboard shortcut (hotkey).
• It also makes the same action visible in the IDE insight search.
• It also adds a menu to the main menu.

Handling the interfaces that Remy's answer discusses is non-trivial, so I have made a working example.

unit HelloExpertContextMenu;

// Example of a Project Right Click (Context) menu for Delphi 10 Seattle
// using OTAPI. Must be provided an action list full of actions with valid
// unique names.
//
// Register menu:
//
// Similar code would work in RAD Studio 2010 and newer, but not in older
// Delphi versions.

interface

uses Classes,
  SysUtils,
  Generics.Collections,
  Vcl.ActnList,
  ToolsAPI,
  Menus,
  Windows,
  Messages;
type


  TProjectManagerMenu = class(TNotifierObject, IOTANotifier, IOTAProjectMenuItemCreatorNotifier)
  private
    FActionList: TActionList; // reference only.
    FProject: IOTAProject; // Reference valid ONLY during MenuExecute
    FNotifierIndex: Integer;
    FFault:Boolean; // nicer than raising inside the IDE.
    { IOTAProjectMenuItemCreatorNotifier }
    procedure AddMenu(const Project: IOTAProject; const Ident: TStrings;
      const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);

  protected
    procedure ExecuteVerb(const Verb:string);

  public
    procedure InstallMenu;



    constructor Create(ActionList:TActionList);
    procedure MenuExecute(const MenuContextList: IInterfaceList);

    property Project: IOTAProject read FProject; // Reference valid ONLY during MenuExecute

    property Fault: Boolean read FFault; // InstallMenu fail.
  end;


 TOTAActionMenu = class(TInterfacedObject, IOTANotifier, IOTALocalMenu)
  private
    FAction:TAction;
    FParent: string;
    FPosition: Integer;
  public
    { IOTANotifier }
    procedure AfterSave;
    procedure BeforeSave;
    procedure Destroyed;
    procedure Modified;
  public


    { IOTALocalMenu }
    function GetCaption: string;
    function GetChecked: Boolean;
    function GetEnabled: Boolean;
    function GetHelpContext: Integer;
    function GetName: string;
    function GetParent: string;
    function GetPosition: Integer;
    function GetVerb: string;
    procedure SetChecked(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetHelpContext(Value: Integer);
    procedure SetName(const Value: string);
    procedure SetParent(const Value: string);
    procedure SetPosition(Value: Integer);
    procedure SetVerb(const Value: string);
    procedure SetCaption(const Value: string);

    property Action: TAction read FAction write FAction; // MUST NOT BE NIL!
    property Caption: string read GetCaption write SetCaption;
    property Checked: Boolean read GetChecked write SetChecked;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property HelpContext: Integer read GetHelpContext write SetHelpContext;
    property Name: string read GetName write SetName;
    property Parent: string read GetParent write SetParent;
    property Position: Integer read GetPosition write SetPosition;
    property Verb: string read GetVerb write SetVerb;
  end;

  TProjectManagerMenuExecuteEvent = procedure (const MenuContextList: IInterfaceList) of object;

  TOTAProjectManagerActionMenu = class(TOTAActionMenu, IOTANotifier, IOTALocalMenu, IOTAProjectManagerMenu)
  private
    FIsMultiSelectable: Boolean;
  public
    { IOTAProjectManagerMenu }
    function GetIsMultiSelectable: Boolean;
    procedure SetIsMultiSelectable(Value: Boolean);
    procedure Execute(const MenuContextList: IInterfaceList); overload;
    function PreExecute(const MenuContextList: IInterfaceList): Boolean;
    function PostExecute(const MenuContextList: IInterfaceList): Boolean;
    property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
  end;

implementation



constructor TProjectManagerMenu.Create(ActionList:TActionList);
begin
  inherited Create;
  FActionList := ActionList;
end;

procedure TProjectManagerMenu.ExecuteVerb(const Verb: string);
var
 AnAction: TAction;
begin
  if Assigned(FActionList) then
  begin
    AnAction := FActionList.FindComponent(Verb) as TAction;
    if Assigned(AnAction) then
        AnAction.Execute();

  end;

end;

procedure TProjectManagerMenu.InstallMenu;
var
  OTAProjectManager: IOTAProjectManager;
begin
  if Supports(BorlandIDEServices, IOTAProjectManager, OTAProjectManager) then
    FNotifierIndex := OTAProjectManager.AddMenuItemCreatorNotifier(Self)
  else
    FFault := True;

end;

procedure TProjectManagerMenu.AddMenu(const Project: IOTAProject; const Ident: TStrings;
  const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
var
  AMenu: TOTAProjectManagerActionMenu;
  Action:TAction;
  n:Integer;
begin
  if (not IsMultiSelect) and Assigned(Project) and (Ident.IndexOf(sProjectContainer) <> -1) then
  begin


    for n := 0 to FActionList.ActionCount-1 do
    begin
      Action := FActionList.Actions[n] as TAction;
      if Action.Name ='' then
        Action.Name := 'HelloExpertContextMenuAction'+IntToStr(n+1);
      AMenu := TOTAProjectManagerActionMenu.Create;
      AMenu.Action := Action;
      if AMenu.Caption='' then
        AMenu.Caption := 'Menu Item Text Missing'+IntToStr(n);
      AMenu.IsMultiSelectable := True;
      AMenu.Position := pmmpUserBuild;
      ProjectManagerMenuList.Add(AMenu);
    end;
  end;
end;

procedure TProjectManagerMenu.MenuExecute(const MenuContextList: IInterfaceList);
var
  Index: Integer;
  MenuContext: IOTAProjectMenuContext;
  Verb: string;
begin
  try
    for Index := 0 to MenuContextList.Count - 1 do
    begin
      MenuContext := MenuContextList.Items[Index] as IOTAProjectMenuContext;
      FProject := MenuContext.Project;
      try
          Verb := MenuContext.Verb;
          ExecuteVerb(Verb);
      finally
        FProject := nil;
      end;
    end;
  except
    on E:Exception do
    begin
      OutputDebugString(PChar(E.Message));
    end;
  end;
end;

procedure TOTAActionMenu.AfterSave;
begin

end;

procedure TOTAActionMenu.BeforeSave;
begin

end;

procedure TOTAActionMenu.Destroyed;
begin

end;

procedure TOTAActionMenu.Modified;
begin

end;

function TOTAActionMenu.GetCaption: string;
begin
  Result := FAction.Caption;
end;

function TOTAActionMenu.GetChecked: Boolean;
begin
  Result := FAction.Checked;
end;

function TOTAActionMenu.GetEnabled: Boolean;
begin
  Result := FAction.Enabled;
end;

function TOTAActionMenu.GetHelpContext: Integer;
begin
  Result := FAction.HelpContext;
end;

function TOTAActionMenu.GetName: string;
begin
  Result := FAction.Name;
end;

function TOTAActionMenu.GetParent: string;
begin
  Result := FParent;
end;

function TOTAActionMenu.GetPosition: Integer;
begin
  Result := FPosition;
end;

function TOTAActionMenu.GetVerb: string;
begin
  Result := FAction.Name; // Name is also Verb
end;



procedure TOTAActionMenu.SetCaption(const Value: string);
begin
  FAction.Caption := Value;
end;

procedure TOTAActionMenu.SetChecked(Value: Boolean);
begin
  FAction.Checked := Value;
end;

procedure TOTAActionMenu.SetEnabled(Value: Boolean);
begin
  FAction.Enabled := Value;
end;

procedure TOTAActionMenu.SetHelpContext(Value: Integer);
begin
  FAction.HelpContext := Value;
end;

procedure TOTAActionMenu.SetName(const Value: string);
begin
  FAction.Name := Value;
end;

procedure TOTAActionMenu.SetParent(const Value: string);
begin
  FParent := Value;
end;

procedure TOTAActionMenu.SetPosition(Value: Integer);
begin
  FPosition := Value;
end;

procedure TOTAActionMenu.SetVerb(const Value: string);
begin
  FAction.Name := Value; // NAME == VERB!
end;

//=== { TOTAProjectManagerActionMenu } ==========================================

function TOTAProjectManagerActionMenu.GetIsMultiSelectable: Boolean;
begin
  Result := FIsMultiSelectable;
end;

procedure TOTAProjectManagerActionMenu.SetIsMultiSelectable(Value: Boolean);
begin
  FIsMultiSelectable := Value;
end;

procedure TOTAProjectManagerActionMenu.Execute(const MenuContextList: IInterfaceList);
begin
  if Assigned(FAction) then
  begin
     FAction.Execute;
  end;
end;

function TOTAProjectManagerActionMenu.PreExecute(const MenuContextList: IInterfaceList): Boolean;
begin
  Result := True;
end;

function TOTAProjectManagerActionMenu.PostExecute(const MenuContextList: IInterfaceList): Boolean;
begin
  Result := True;
end;
end.

complete working example on bitbucket at https://bitbucket.org/wpostma/helloworldexpert