delphiidetoolsapi

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


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:

enter image description here enter image description here

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


Solution

  • 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.