Source

Notepad++PluginLazarus / NotepadPPPluginPackage / nppplugin.pas

{
    This file is part of DBGP Plugin for Notepad++
    Copyright (C) 2007  Damjan Zobo Cvetko
    Converted from Delphi to Lazarus in 2012 by
    Ludo Brands and Reinier Olislagers

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along
    with this program; if not, write to the Free Software Foundation, Inc.,
    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
}

unit nppplugin;

{$MODE Delphi}

interface

uses
  LCLIntf, LCLType, SciSupport,
  SysUtils, Dialogs,Classes,Forms, Windows,
  NPPTypes;

type
  { TNppPlugin }
  TNppPlugin = class(TObject)
  private
    FuncArray  : array of _TFuncItem;
    FNppData   : TNppData;
    FPluginName: nppString;

    property NppData: TNppData read FNppData;

    // hooks
    procedure DoNppnToolbarModification;
    procedure DoNppnShutdown; virtual;

  protected
    function GetPluginsConfigDir: string;
    function GetSourceFilenameNoPath: string;
    function GetSourceFilename: string;

    // Many functions require NPP character set translation to ansi string
    function GetString(const pMsg: UInt; const pSize: integer = 1000): ansistring;

    // Add a new menu function to the plugin
    procedure AddFunction(Name: nppstring; const Func: PFUNCPLUGINCMD = nil; const ShortcutKey: char = #0; const Shift: TShiftState = []);
    procedure SetToolbarIcon(out pToolbarIcon: TToolbarIcons); virtual;

  public
    constructor Create; reintroduce; virtual;
    destructor Destroy; override;
    procedure BeforeDestruction; override;

    function CmdIdFromDlgId(DlgId: Integer): Integer;
    function SendToNpp(Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
    function SendWToNpp(Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
    function SendToNppScintilla(Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
    function isMessageForPlugin(const pWnd: HWND): boolean;


    // needed for DLL export... wrappers are in the main dll source
    procedure SetInfo(pNppData: TNppData); virtual;
    function  GetName: nppPChar;
    function  GetFuncsArray(var FuncsCount: Integer): Pointer;
    procedure BeNotified(sn: PSCNotification);
    procedure MessageProc(var Msg: TMessage); virtual;

    // df
    function DoOpen(filename: String): boolean; overload;
    function DoOpen(filename: String; Line: Integer): boolean; overload;
    procedure GetFileLine(var filename: String; var Line: Integer);
    function GetWord: string;

    property PluginName: nppString read FPluginName write FPluginName;
  end;

  TNPPPLuginClass = class of TNppPlugin;

  // Global functions to set up the plugin
  procedure NPPInitialize(const pPluginClass: TNPPPLuginClass);
  function  GetNPPPluginInstance: TNPPPlugin;
  procedure DLLEntryPoint(dwReason: DWord);

  // DLL exported functions so use cdecl and export.
  procedure setInfo(NppData: TNppData); cdecl; export;
  function  getName(): nppPchar; cdecl; export;
  function  getFuncsArray(var nFuncs:integer):Pointer;cdecl; export;
  procedure beNotified(sn: PSCNotification); cdecl; export;
  function  messageProc(msg: Integer; _wParam: WPARAM; _lParam: LPARAM): LRESULT; cdecl; export;
  {$IFDEF NPPUNICODE}
  function  isUnicode : Boolean; cdecl; export;
  {$ENDIF}

implementation

// Handle to the plugin instance ('singleton')
var
  NPPPluginInstance: TNPPPlugin;

function GetNPPPluginInstance: TNPPPlugin;
begin
  result := NPPPluginInstance;
end;

procedure NPPInitialize(const pPluginClass: TNPPPLuginClass);
begin
  Dll_Process_Detach_Hook:= @DLLEntryPoint;
  NPPPluginInstance := pPluginClass.Create;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end;

procedure setInfo(NppData: TNppData); cdecl; export;
begin
  NPPPluginInstance.SetInfo(NppData);
end;

function getName(): nppPchar; cdecl; export;
begin
  Result := NPPPluginInstance.GetName;
end;

function getFuncsArray(var nFuncs:integer):Pointer;cdecl; export;
begin
  Result := NPPPluginInstance.GetFuncsArray(nFuncs);
end;

procedure beNotified(sn: PSCNotification); cdecl; export;
begin
  NPPPluginInstance.BeNotified(sn);
end;

function messageProc(msg: Integer; _wParam: WPARAM; _lParam: LPARAM): LRESULT; cdecl; export;
var xmsg:TMessage;
begin
  xmsg.Msg := msg;
  xmsg.WParam := _wParam;
  xmsg.LParam := _lParam;
  xmsg.Result := 0;
  NPPPluginInstance.MessageProc(xmsg);
  Result := xmsg.Result;
end;

{$IFDEF NPPUNICODE}
function isUnicode : Boolean; cdecl; export;
begin
  Result := true;
end;
{$ENDIF}

procedure DLLEntryPoint(dwReason: DWord);
begin
  case dwReason of
  DLL_PROCESS_ATTACH:
  begin
    // create the main object
    //Npp := TDbgpNppPlugin.Create;
  end;
  DLL_PROCESS_DETACH:
  begin
    NPPPluginInstance.Destroy;
  end;
  //DLL_THREAD_ATTACH: MessageBeep(0);
  //DLL_THREAD_DETACH: MessageBeep(0);
  end;
end;


{ TNppPlugin }

{ This is hacking for troubble...
  We need to unset the Application handler so that the forms
  don't get berserk and start throwing OS error 1004.
  This happens because the main NPP HWND is already lost when the
  DLL_PROCESS_DETACH gets called, and the form tries to allocate a new
  handler for sending the "close" windows message...
}
procedure TNppPlugin.BeforeDestruction;
begin
  //Application.Handle := 0;
  Application.Terminate;
  inherited;
end;

constructor TNppPlugin.Create;
begin
  inherited;
  PluginName := '<unknown>';
end;

destructor TNppPlugin.Destroy;
var i: Integer;
begin
  for i := 0 to Length(FuncArray)-1 do
    if assigned(FuncArray[i].ShortcutKey) then
      Dispose(FuncArray[i].ShortcutKey);
  inherited;
end;

function TNppPlugin.SendToNpp(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  result := SendMessage(NppData.NppHandle, Msg, wParam, lParam);
end;

function TNppPlugin.SendWToNpp(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  result := SendMessageW(NppData.NppHandle, Msg, wParam, lParam);
end;

function TNppPlugin.SendToNppScintilla(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  result := SendMessage(NppData.ScintillaMainHandle, Msg, wParam, lParam);
end;

function TNppPlugin.isMessageForPlugin(const pWnd: HWND): boolean;
begin
  result := pWnd = NppData.NppHandle;
end;

procedure TNppPlugin.AddFunction(Name: nppString; const Func: PFUNCPLUGINCMD; const ShortcutKey: char; const Shift: TShiftState);
var
  NF: _TFuncItem;
begin
  // Set up the new function
  fillchar(NF, sizeof(NF), 0);
  {$IFDEF NPPUNICODE}
    StringToWideChar(Name, NF.ItemName, 1000); // @todo: change to constant
  {$ELSE}
    StrCopy(NF.ItemName, PChar(Name));
  {$ENDIF}
  NF.Func := Func;

  if ShortcutKey <> #0 then
  begin
    New(NF.ShortcutKey);
    NF.ShortcutKey.IsCtrl  := ssCtrl  in Shift;
    NF.ShortcutKey.IsAlt   := ssAlt   in Shift;
    NF.ShortcutKey.IsShift := ssShift in Shift;
    NF.ShortcutKey.Key     := ShortcutKey; // need widechar ??
  end;

  // Add the new function to the list
  SetLength(FuncArray, Length(FuncArray) + 1);
  FuncArray[Length(FuncArray)-1] := NF;   // Zero-based so -1
end;

procedure TNppPlugin.GetFileLine(var filename: String; var Line: Integer);
var
  s: String;
  r: integer;
begin
  s := '';
  SetLength(s, 300);
  SendToNpp(NPPM_GETFULLCURRENTPATH,0, LPARAM(PChar(s)));
  SetLength(s, StrLen(PChar(s)));
  filename := s;
  r    := SendToNppScintilla(SciSupport.SCI_GETCURRENTPOS, 0, 0);
  Line := SendtoNppScintilla(SciSupport.SCI_LINEFROMPOSITION, r, 0);
end;

function TNppPlugin.GetFuncsArray(var FuncsCount: Integer): Pointer;
begin
  FuncsCount := Length(FuncArray);
  Result := FuncArray;
end;

function TNppPlugin.GetName: nppPChar;
begin
  Result := nppPChar(PluginName);
end;

function TNppPlugin.GetPluginsConfigDir: string;
begin
  result := GetString(NPPM_GETPLUGINSCONFIGDIR);
end;

function TNppPlugin.GetSourceFilenameNoPath: string;
begin
  result := GetString(NPPM_GETFILENAME);
end;

function TNppPlugin.GetSourceFilename: string;
begin
  result := GetString(NPPM_GETFULLCURRENTPATH)
end;

procedure TNppPlugin.BeNotified(sn: PSCNotification);
begin
  // Message for the plugin?
  if HWND(sn^.nmhdr.hwndFrom) = NppData.NppHandle then
    case sn^.nmhdr.code of
      NPPN_TB_MODIFICATION: DoNppnToolbarModification;
      NPPN_SHUTDOWN       : DoNppnShutdown;
    end;
  // @todo
end;

procedure TNppPlugin.MessageProc(var Msg: TMessage);
var
  hm: HMENU;
  i: integer;
begin
  if Msg.Msg = WM_CREATE then
  begin
    // Change - to separator items
    hm := GetMenu(NppData.NppHandle);
    for i := 0 to Length(FuncArray)-1 do
      if (FuncArray[i].ItemName[0] = '-') then
        ModifyMenu(hm, FuncArray[i].CmdID, MF_BYCOMMAND or MF_SEPARATOR, 0, nil);
  end;
  Dispatch(Msg);
end;

procedure TNppPlugin.SetToolbarIcon(out pToolbarIcon: TToolbarIcons);
begin
  // To be overridden for customization
end;

procedure TNppPlugin.SetInfo(pNppData: TNppData);
begin
  FNppData := pNppData;
end;

function TNppPlugin.GetWord: string;
begin
  result := GetString(NPPM_GETCURRENTWORD,800);
end;

function TNppPlugin.DoOpen(filename: String): boolean;
var
  s: string;
begin
  // ask if we are not already opened
  SetLength(s, 500);
  SendToNpp(NPPM_GETFULLCURRENTPATH, 0, LPARAM(PChar(s)));
  SetString(s, PChar(s), strlen(PChar(s)));
  Result := true;
  if s = filename then exit;

  Result := SendToNpp(WM_DOOPEN, 0, LPARAM(PChar(filename))) = 0;
end;

function TNppPlugin.DoOpen(filename: String; Line: Integer): boolean;
begin
  result := DoOpen(filename);
  if result then
    SendToNppScintilla(SciSupport.SCI_GOTOLINE, Line,0);
end;

// overrides 
procedure TNppPlugin.DoNppnShutdown;
begin
  // override these
end;

function TNppPlugin.GetString(const pMsg: UInt; const pSize: integer): ansistring;
var
  s: ansistring;
begin
  SetLength(s, pSize+1);
  SendToNpp(pMsg, pSize, LPARAM(PChar(s)));
  {$IFDEF NPPUNICODE}
    result := WideCharToString(PWideChar(s));
  {$ELSE}
    {$WARNING Untested code with ANSI Version of NPP plugin }
    result := s; // Untested so far; wild guess......
  {$ENDIF}
end;

procedure TNppPlugin.DoNppnToolbarModification;
var
  tb: TToolbarIcons;
begin
  tb.ToolbarIcon := 0;
  tb.ToolbarBmp  := 0;
  SetToolbarIcon(tb);
  if (tb.ToolbarBmp <> 0) or (tb.ToolbarIcon <> 0) then
    SendToNpp(NPPM_ADDTOOLBARICON, WPARAM(CmdIdFromDlgId(1)), LPARAM(@tb));
end;

function TNppPlugin.CmdIdFromDlgId(DlgId: Integer): Integer;
begin
  Result := FuncArray[DlgId].CmdId;
end;

end.