Delphi OTAPI AddMenuCreatorNotifier deprecated, what is the replacement? - delphi

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