How to change a behavior of specific Project Manager's local menu item for the HTML documents?

Question

I'm in the process of reproducing Project Page Options IDE add-in¹. Particularly, this add-in replaces default behavior² of Open action in the Project Manager with its own behavior - to open a HTML page in the same internal browser which is used to display a Welcome Page. So, i want to do the same, but currently i failed to reach this menu.

I tried IOTAProjectManager interface, which facilitates an adding Project Manager's menu items³, but i learned what its notifiers are isolated from each other, so most probably this API is useless for my purpose. Also, i tried to hook into application-wide action processing. It gave me absolutely no results, probably action list(s) are not used there at all.

I guess, disposition above leave me no choice but to resort to a hacks, which makes hackish solutions really welcome here. So, any idea please?

---

¹ For more info about that see this Q.

² There are 3 relevant items: Open, Show Markup, Show Designer. Open defaults to Show Designer without an add-in.

³ In the fact, this API allows adding items on-the-fly, and it probably makes things even more complicated.

---

Context menus illustrated:

As TOndrej mentioned in comment below, behavior of Open menu item changed only for HTML document configured as "Project Page" in the corresponding dialog.

Answer 1

I think the original Project Page extension does it by installing an IDE Notifier (see TProjectPageNotifier below). I don't think it has anything to do with the Project Manager. It simply listens to notifications about files which are being opened in the IDE and if it's the project page it will open it in the embedded browser instead of the default HTML designer. Here's my attempt to reproduce this functionality for Delphi 2007.

1) package:

package projpageide;

{$R *.res}
// ... some compiler options snipped for brevity
{$DESCRIPTION '_Project Page Options'}
{$LIBSUFFIX '100'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  designide;

contains
  Projectpagecmds in 'Projectpagecmds.pas',
  ProjectPageOptionsDlg in 'ProjectPageOptionsDlg.pas';

end.

2) data module with an action and a menu item to add to 'Project' menu:

unit ProjectPageCmds;

interface

uses
  Windows,SysUtils, Classes, ActnList, Menus, Controls, Forms, Dialogs;

type
  TProjectPageCmds = class(TDataModule)
    ActionList1: TActionList;
    PopupMenu1: TPopupMenu;
    ProjectWelcomeOptions: TAction;
    ProjectWelcomeOptionsItem: TMenuItem;
    procedure ProjectWelcomeOptionsExecute(Sender: TObject);
    procedure ProjectWelcomeOptionsUpdate(Sender: TObject);
  private
  public
  end;

implementation

{$R *.dfm}

uses
  XMLIntf, Variants, ToolsApi,
  ProjectPageOptionsDlg;

type
  IURLModule = interface(IOTAModuleData)
  ['{9D215B02-6073-45DC-B007-1A2DBCE2D693}']
    function GetURL: string;
    procedure SetURL(const URL: string);
    property URL: string read GetURL write SetURL;
  end;
  TOpenNewURLModule = procedure(const URL: string; EditorForm: TCustomForm);

  TProjectPageNotifier = class(TNotifierObject, IOTAIDENotifier)
    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure AfterCompile(Succeeded: Boolean); overload;
  end;

const
  sWelcomePageFile = 'WelcomePageFile';
  sWelcomePageFolder = 'WelcomePageFolder';

var
  DataModule: TProjectPageCmds = nil;
  NotifierIndex: Integer = -1;

function FindURLModule: IURLModule;
var
  I: Integer;
begin
  Result := nil;
  with BorlandIDEServices as IOTAModuleServices do
    for I := 0 to ModuleCount - 1 do
      if Supports(Modules[I], IURLModule, Result) then
        Break;
end;

procedure OpenURL(const URL: string; UseExistingView: Boolean = True);
{$IFDEF VER220} // Delphi XE
const
  SStartPageIDE = 'startpageide150.bpl';
  SOpenNewURLModule = '@Urlmodule@OpenNewURLModule$qqrx20System@UnicodeStringp22Editorform@TEditWindow';
{$ENDIF}
{$IFDEF VER185} // Delphi 2007
const
  SStartPageIDE = 'startpageide100.bpl';
  SOpenNewURLModule = '@Urlmodule@OpenNewURLModule$qqrx17System@AnsiStringp22Editorform@TEditWindow';
{$ENDIF}
var
  Module: IURLModule;
  EditWindow: INTAEditWindow;
  Lib: HMODULE;
  OpenNewURLModule: TOpenNewURLModule;
begin
  EditWindow := nil;
  Module := nil;
  if UseExistingView then
    Module := FindURLModule;
  if Assigned(Module) then
  begin
    Module.URL := URL;
    (Module as IOTAModule).Show;
  end
  else
  begin
{$IFDEF VER220}
    EditWindow := (BorlandIDEServices as INTAEditorServices).TopEditWindow;
{$ENDIF}
{$IFDEF VER185}
    if Assigned((BorlandIDEServices as IOTAEditorServices).TopView) then
      EditWindow := (BorlandIDEServices as IOTAEditorServices).TopView.GetEditWindow;
{$ENDIF}
    if not Assigned(EditWindow) or not Assigned(EditWindow.Form) then
      Exit;
    Lib := GetModuleHandle(SStartPageIDE);
    if Lib = 0 then
      Exit;

    OpenNewURLModule := GetProcAddress(Lib, SOpenNewURLModule);
    if @OpenNewURLModule <> nil then
      OpenNewURLModule(URL, EditWindow.Form);
  end;
end;

function ReadOption(const Project: IOTAProject; const SectionName, AttrName: WideString): WideString;
var
  Node: IXMLNode;
begin
  Result := '';
  Node := (BorlandIDEServices as IOTAProjectFileStorage).GetProjectStorageNode(Project, SectionName, False);
  if Assigned(Node) and (Node.HasAttribute(AttrName)) then
    Result := Node.Attributes[AttrName];
end;

procedure WriteOption(const Project: IOTAProject; const SectionName, AttrName, Value: WideString);
var
  Node: IXMLNode;
begin
  Node := (BorlandIDEServices as IOTAProjectFileStorage).GetProjectStorageNode(Project, SectionName, False);
  if not Assigned(Node) then
    Node := (BorlandIDEServices as IOTAProjectFileStorage).AddNewSection(Project, SectionName, False);
  Node.Attributes[AttrName] := Value;
  Project.MarkModified;
end;

function GetCurrentProjectPageFileName: string;
var
  Project: IOTAProject;
begin
  Result := '';
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if Assigned(Project) then
    Result := ReadOption(Project, sWelcomePageFile, 'Path');
end;

procedure TProjectPageCmds.ProjectWelcomeOptionsExecute(Sender: TObject);
var
  Project: IOTAProject;
  Dlg: TDlgProjectPageOptions;
  I: Integer;
  ModuleInfo: IOTAModuleInfo;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if not Assigned(Project) then
    Exit;
  Dlg := TDlgProjectPageOptions.Create(nil);
  try
    for I := 0 to Project.GetModuleCount - 1 do
    begin
      ModuleInfo := Project.GetModule(I);
      if ModuleInfo.CustomId = 'HTMLTool' then
        Dlg.cmbWelcomePage.Items.Add(ExtractRelativePath(ExtractFilePath(Project.FileName), ModuleInfo.FileName));
    end;

    Dlg.cmbWelcomePage.Text := ReadOption(Project, sWelcomePageFile, 'Path');
    Dlg.edWelcomeFolder.Text := ReadOption(Project, sWelcomePageFolder, 'Path');

    if Dlg.ShowModal = mrOK then
    begin
      WriteOption(Project, sWelcomePageFile, 'Path', Dlg.cmbWelcomePage.Text);
      WriteOption(Project, sWelcomePageFolder, 'Path', Dlg.edWelcomeFolder.Text);
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TProjectPageCmds.ProjectWelcomeOptionsUpdate(Sender: TObject);
var
  Project: IOTAProject;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  with (Sender as TAction) do
  begin
    Enabled := Assigned(Project);
    Visible := Enabled;
  end;
end;

procedure TProjectPageNotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string;
  var Cancel: Boolean);
var
  Project: IOTAProject;
begin
  if (NotifyCode = ofnFileOpening) then
  begin
    Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
    if not Assigned(Project) then
      Exit;
    if SameText(ReadOption(Project, sWelcomePageFile, 'Path'), ExtractRelativePath(ExtractFilePath(Project.FileName), FileName)) then
    begin
      Cancel := True;
      OpenURL(FileName);
    end;
  end;
end;

procedure TProjectPageNotifier.AfterCompile(Succeeded: Boolean);
begin
  // do nothing
end;

procedure TProjectPageNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
  // do nothing
end;

procedure Initialize;
var
  NTAServices: INTAServices;
  Services: IOTAServices;
begin
  if not BorlandIDEServices.GetService(INTAServices, NTAServices) or not BorlandIDEServices.GetService(IOTAServices, Services) then
    Exit;

  DataModule := TProjectPageCmds.Create(nil);
  try
    NTAServices.AddActionMenu('ProjectDependenciesItem', DataModule.ProjectWelcomeOptions, DataModule.ProjectWelcomeOptionsItem);
    NotifierIndex := Services.AddNotifier(TProjectPageNotifier.Create);
  except
    FreeAndNil(DataModule);
    raise;
  end;
end;

procedure Finalize;
begin
  if NotifierIndex <> -1 then
    (BorlandIDEServices as IOTAServices).RemoveNotifier(NotifierIndex);
  FreeAndNil(DataModule);
end;

initialization
  Initialize;

finalization
  Finalize;

end.

3) the data module's dfm:

object ProjectPageCmds: TProjectPageCmds
  OldCreateOrder = False
  Left = 218
  Top = 81
  Height = 150
  Width = 215
  object ActionList1: TActionList
    Left = 32
    Top = 8
    object ProjectWelcomeOptions: TAction
      Category = 'Project'
      Caption = 'Pro&ject Page Options...'
      HelpContext = 3146
      OnExecute = ProjectWelcomeOptionsExecute
      OnUpdate = ProjectWelcomeOptionsUpdate
    end
  end
  object PopupMenu1: TPopupMenu
    Left = 96
    Top = 8
    object ProjectWelcomeOptionsItem: TMenuItem
      Action = ProjectWelcomeOptions
    end
  end
end

4) project page options dialog:

unit ProjectPageOptionsDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TDlgProjectPageOptions = class(TForm)
    bpCancel: TButton;
    bpHelp: TButton;
    bpOK: TButton;
    cmbWelcomePage: TComboBox;
    edWelcomeFolder: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure bpOKClick(Sender: TObject);
    procedure bpHelpClick(Sender: TObject);
  private
    procedure Validate;
  public
  end;

implementation

{$R *.dfm}

uses
  ShLwApi, ToolsApi;

resourcestring
  sProjectPageDoesNotExist = 'Project page ''%s'' does not exist';
  sProjectFolderDoesNotExist = 'Project folder ''%s'' does not exist';

function CanonicalizePath(const S: string): string;
var
  P: array[0..MAX_PATH] of Char;
begin
  Win32Check(PathCanonicalize(P, PChar(S)));
  Result := P;
end;

procedure TDlgProjectPageOptions.Validate;
var
  Project: IOTAProject;
  WelcomePagePath, WelcomeFolderPath: string;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if not Assigned(Project) then
    Exit;

  if cmbWelcomePage.Text <> '' then
  begin
    WelcomePagePath := CanonicalizePath(ExtractFilePath(Project.FileName) + cmbWelcomePage.Text);
    if not FileExists(WelcomePagePath) then
    begin
      ModalResult := mrNone;
      raise Exception.CreateFmt(sProjectPageDoesNotExist, [WelcomePagePath]);
    end;
  end;
  if edWelcomeFolder.Text <> '' then
  begin
    WelcomeFolderPath := CanonicalizePath(ExtractFilePath(Project.FileName) + edWelcomeFolder.Text);
    if not FileExists(WelcomeFolderPath) then
    begin
      ModalResult := mrNone;
      raise Exception.CreateFmt(sProjectFolderDoesNotExist, [WelcomeFolderPath]);
    end;
  end;

  ModalResult := mrOK;
end;

procedure TDlgProjectPageOptions.bpHelpClick(Sender: TObject);
begin
  Application.HelpContext(Self.HelpContext);
end;

procedure TDlgProjectPageOptions.bpOKClick(Sender: TObject);
begin
  Validate;
end;

end.

5) the dialog's dfm:

object DlgProjectPageOptions: TDlgProjectPageOptions
  Left = 295
  Top = 168
  HelpContext = 3146
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'Project Page Options'
  ClientHeight = 156
  ClientWidth = 304
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  DesignSize = (
    304
    156)
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 6
    Width = 65
    Height = 13
    Caption = '&Project page:'
    FocusControl = cmbWelcomePage
  end
  object Label2: TLabel
    Left = 8
    Top = 62
    Width = 80
    Height = 13
    Caption = '&Resource folder:'
    FocusControl = edWelcomeFolder
  end
  object edWelcomeFolder: TEdit
    Left = 8
    Top = 81
    Width = 288
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 1
  end
  object bpOK: TButton
    Left = 59
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'OK'
    Default = True
    ModalResult = 1
    TabOrder = 2
    OnClick = bpOKClick
  end
  object bpCancel: TButton
    Left = 140
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 3
  end
  object bpHelp: TButton
    Left = 221
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Help'
    TabOrder = 4
    OnClick = bpHelpClick
  end
  object cmbWelcomePage: TComboBox
    Left = 8
    Top = 25
    Width = 288
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    ItemHeight = 13
    TabOrder = 0
    Text = 'cmbWelcomePage'
  end
end

However, I don't know what effect the "Resource Folder" has. The option can be stored in and read from the .dproj file, it's also checked that it exists but I don't know how the original extension uses the folder path. If you find out please let me know, I'll include it in the code.

Also, part of this code is copied from my answer to another question of yours, which I compiled (and briefly tested) in Delphi 2007 and Delphi XE. This code was only compiled and briefly tested in Delphi 2007.

Hope this helps as a starting point, at least.