
with Ada.Unchecked_Deallocation;

with GNATCOM;                          use GNATCOM;
with GNATCOM.Errors;
with GNATCOM.Dispinterface;            use GNATCOM.Dispinterface;
with GNATOCX.IOleObject_Interface;     use GNATOCX.IOleObject_Interface;
with GNATOCX.IOleClientSite_Interface; use GNATOCX.IOleClientSite_Interface;

package body MSHTMLHST.IDocHostUIHandler_Object is

   function s_QueryInterface(
			     This   : Pointer_To_IDocHostUIHandler_Obj;
			     riid   : Pointer_To_GUID;
			     ppvObj : Pointer_To_Pointer_To_Void
			    ) return HRESULT;
   pragma Convention (StdCall, s_QueryInterface);

   function s_AddRef (This : Pointer_To_IDocHostUIHandler_Obj)
		      return unsigned_long;
   pragma Convention (StdCall, s_AddRef);

   function s_Release (This : Pointer_To_IDocHostUIHandler_Obj)
		       return unsigned_long;
   pragma Convention (StdCall, s_Release);

   function s_ShowContextMenu(
			      This : Pointer_To_IDocHostUIHandler_Obj;
			      dwID : DWORD;
			      ppt  : access Point_Type;
			      pcmdtReserved : access IUnknown;
			      pdispReserved : access IDispatch
			     ) return HRESULT;
   pragma Convention (StdCall, s_ShowContextMenu);

   function s_GetHostInfo(
			  This  : Pointer_To_IDocHostUIHandler_Obj;
			  pInfo : access DOCHOSTUIINFO
			 ) return HRESULT;
   pragma Convention (StdCall, s_GetHostInfo);

   function s_ShowUI(
		     This           : Pointer_To_IDocHostUIHandler_Obj;
		     dwID           : DWORD;
		     pActiveObject  : access IOleInPlaceActiveObject;
		     pCommandTarget : access IOleCommandTarget;
		     pFrame         : access IOleInPlaceFrame;
		     pDoc           : access IOleInPlaceUIWindow
		    ) return HRESULT;
   pragma Convention (StdCall, s_ShowUI);

   function s_HideUI(
		     This           : Pointer_To_IDocHostUIHandler_Obj
		    ) return HRESULT;
   pragma Convention (StdCall, s_HideUI);

   function s_UpdateUI(
		       This           : Pointer_To_IDocHostUIHandler_Obj
		      ) return HRESULT;
   pragma Convention (StdCall, s_UpdateUI);

   function s_EnableModeless(
			     This           : Pointer_To_IDocHostUIHandler_Obj;
			     fEnable        : System.Win32.BOOL
			    ) return HRESULT;
   pragma Convention (StdCall, s_EnableModeless);

   function s_OnDocWindowActivate(
				  This           : Pointer_To_IDocHostUIHandler_Obj;
				  fActivate      : System.Win32.BOOL
				 ) return HRESULT;
   pragma Convention (StdCall, s_OnDocWindowActivate);

   function s_OnFrameWindowActivate(
				    This           : Pointer_To_IDocHostUIHandler_Obj;
				    fActivate      : System.Win32.BOOL
				   ) return HRESULT;
   pragma Convention (StdCall, s_OnFrameWindowActivate);

   function s_ResizeBorder(
			   This           : Pointer_To_IDocHostUIHandler_Obj;
			   prcBorder      : access GNATOCX.RECT;
			   pUIWindow      : access IOleInPlaceUIWindow;
			   fRameWindow    : System.Win32.BOOL
			  ) return HRESULT;
   pragma Convention (StdCall, s_ResizeBorder);

   function s_TranslateAccelerator(
				   This           : Pointer_To_IDocHostUIHandler_Obj;
				   lpMsg          : access GNATOCX.MSG;
				   pguidCmdGroup  : access GNATCOM.Types.GUID;
				   nCmdID         : DWORD
				  ) return HRESULT;
   pragma Convention (StdCall, s_TranslateAccelerator);

   function s_GetOptionKeyPath(
			       This           : Pointer_To_IDocHostUIHandler_Obj;
			       pchKey         : access LPWSTR
			      ) return HRESULT;
   pragma Convention (StdCall, s_GetOptionKeyPath);

   function s_GetDropTarget(
			    This           : Pointer_To_IDocHostUIHandler_Obj;
			    pDropTarget    : access IDropTarget;
			    ppDropTarget   : access Pointer_To_IDropTarget
			   ) return HRESULT;
   pragma Convention (StdCall, s_GetDropTarget);

   function s_GetExternal(
			  This           : Pointer_To_IDocHostUIHandler_Obj;
			  ppDispatch     : access Pointer_To_IDispatch
			 ) return HRESULT;
   pragma Convention (StdCall, s_GetExternal);

   function s_TranslateUrl(
			   This           : Pointer_To_IDocHostUIHandler_Obj;
			   dwTranslate    : DWORD;
			   pchURLIn       : LPWSTR;
			   ppchURLOut     : access LPWSTR
			  ) return HRESULT;
   pragma Convention (StdCall, s_TranslateUrl);

   function s_FilterDataObject(
			       This           : Pointer_To_IDocHostUIHandler_Obj;
			       pDO            : access IDataObject;
			       ppDORet        : access Pointer_TO_IDataObject
			      ) return HRESULT;
   pragma Convention (StdCall, s_FilterDataObject);

   c_IDocHostUIHandlerVtbl : aliased IDocHostUIHandlerVtbl_Obj :=
     (
      s_QueryInterface'Access,
      s_AddRef'Access,
      s_Release'Access,
      s_ShowContextMenu'Access,
      s_GetHostInfo'Access,
      s_ShowUI'Access,
      s_HideUI'Access,
      s_UpdateUI'Access,
      s_EnableModeless'Access,
      s_OnDocWindowActivate'Access,
      s_OnFrameWindowActivate'Access,
      s_ResizeBorder'Access,
      s_TranslateAccelerator'Access,
      s_GetOptionKeyPath'Access,
      s_GetDropTarget'Access,
      s_GetExternal'Access,
      s_TranslateUrl'Access,
      s_FilterDataObject'Access
     );

   procedure Create (This : in out IDocHostUIHandler_Object_Type)
   is
      pInterface : Pointer_To_IDocHostUIHandler_Obj := new IDocHostUIHandler_Obj;
   begin
      pInterface.Vtbl := c_IDocHostUIHandlerVtbl'Access;
      pInterface.pObject := This'Unchecked_Access;
      Attach(This, pInterface.all'Address);
   end Create;


   procedure Initialize (This : in out IDocHostUIHandler_Object_Type) is
   begin
      Set_IID (This, IID_IDocHostUIHandler);
   end Initialize;

   function Pointer (This : IDocHostUIHandler_Object_Type)
		     return Pointer_To_IDocHostUIHandler_Obj
   is
   begin
      return To_Pointer_To_IDocHostUIHandler_Obj (Address (This));
   end Pointer;

   procedure Attach (This    : in out IDocHostUIHandler_Object_Type;
		     Pointer : in     Pointer_To_IDocHostUIHandler_Obj)
   is
   begin
      Attach (This, GNATCOM.Iinterface.To_Pointer_To_IUnknown
	      (Pointer.all'Address));
   end Attach;

   function ShowContextMenu(
			    This           : IDocHostUIHandler_Object_Type;
			    dwID           : DWORD;
			    ppt            : access Point_Type;
			    pcmdtReserved  : access IUnknown;
			    pdispReserved  : access IDispatch
			   ) return HRESULT
   is
   begin
      return S_FALSE;
   end ShowContextMenu;

   function GetHostInfo(
			This           : IDocHostUIHandler_Object_Type;
			pInfo          : access DOCHOSTUIINFO
		       ) return HRESULT
   is
   begin
      return S_OK;
   end GetHostInfo;

   function ShowUI(
		   This           : IDocHostUIHandler_Object_Type;
		   dwID           : DWORD;
		   pActiveObject  : access IOleInPlaceActiveObject;
		   pCommandTarget : access IOleCommandTarget;
		   pFrame         : access IOleInPlaceFrame;
		   pDoc           : access IOleInPlaceUIWindow
		  ) return HRESULT
   is
   begin
      return S_FALSE;
   end ShowUI;

   function HideUI(
		   This           : IDocHostUIHandler_Object_Type
		  ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end HideUI;

   function UpdateUI(
		     This           : IDocHostUIHandler_Object_Type
		    ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end UpdateUI;

   function EnableModeless(
			   This           : IDocHostUIHandler_Object_Type;
			   fEnable        : System.Win32.BOOL
			  ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end EnableModeless;

   function OnDocWindowActivate(
				This           : IDocHostUIHandler_Object_Type;
				fActivate      : System.Win32.BOOL
			       ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end OnDocWindowActivate;

   function OnFrameWindowActivate(
				  This           : IDocHostUIHandler_Object_Type;
				  fActivate      : System.Win32.BOOL
				 ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end OnFrameWindowActivate;

   function ResizeBorder(
			 This           : IDocHostUIHandler_Object_Type;
			 prcBorder      : access GNATOCX.RECT;
			 pUIWindow      : access IOleInPlaceUIWindow;
			 fRameWindow    : System.Win32.BOOL
			) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end ResizeBorder;

   function TranslateAccelerator(
				 This           : IDocHostUIHandler_Object_Type;
				 lpMsg          : access GNATOCX.MSG;
				 pguidCmdGroup  : access GNATCOM.Types.GUID;
				 nCmdID         : DWORD
				) return HRESULT
   is
   begin
      return S_FALSE;
   end TranslateAccelerator;

   function GetOptionKeyPath(
			     This           : IDocHostUIHandler_Object_Type;
			     pchKey         : access LPWSTR
			    ) return HRESULT
   is
   begin
      return E_NOTIMPL;
   end GetOptionKeyPath;

   function GetDropTarget(
			  This           : IDocHostUIHandler_Object_Type;
			  pDropTarget    : access IDropTarget;
			  ppDropTarget   : access Pointer_To_IDropTarget
			 ) return HRESULT
   is
   begin
      ppDropTarget.all := null;
      return E_NOTIMPL;
   end GetDropTarget;

   function GetExternal(
			This           : IDocHostUIHandler_Object_Type;
			ppDispatch     : access Pointer_To_IDispatch
		       ) return HRESULT
   is
   begin
      if ppDispatch = null then
	 return E_POINTER;
      end if;
      -- if (m_spExternalDisp.p && CanAccessExternal())
      -- in C:\Program Files (x86)\Microsoft Visual Studio 12.0\VC\atlmfc\src\mfc\dlgdhtml.cpp
      ppDispatch.all := null;
      return E_NOTIMPL;
   end GetExternal;

   function TranslateUrl(
			 This           : IDocHostUIHandler_Object_Type;
			 dwTranslate    : DWORD;
			 pchURLIn       : LPWSTR;
			 ppchURLOut     : access LPWSTR
			) return HRESULT
   is
   begin
      ppchURLOut.all := null;
      return S_FALSE;
   end TranslateUrl;

   function FilterDataObject(
			     This           : IDocHostUIHandler_Object_Type;
			     pDO            : access IDataObject;
			     ppDORet        : access Pointer_TO_IDataObject
			    ) return HRESULT
   is
   begin
      if ppDORet = null then
	 return E_POINTER;
      end if;
      ppDORet.all := null;
      return S_FALSE;
   end FilterDataObject;


   function s_QueryInterface(
			     This   : Pointer_To_IDocHostUIHandler_Obj;
			     riid   : Pointer_To_GUID;
			     ppvObj : Pointer_To_Pointer_To_Void
			    ) return HRESULT
   is
   begin
      ppvObj.all := System.Null_Address;
      if riid.all = IID_IUnknown or else riid.all = IID_IDocHostUIHandler then
	 ppvObj.all := This.all'Address;
	 return S_OK;
      end if;
      return E_NOINTERFACE;
   end s_QueryInterface;

   function s_AddRef (This : Pointer_To_IDocHostUIHandler_Obj)
		      return unsigned_long
   is
   begin
      This.nRefCount := This.nRefCount + 1;
      return This.nRefCount;
   end s_AddRef;

   function s_Release (This : Pointer_To_IDocHostUIHandler_Obj)
		       return unsigned_long
   is
   begin
      This.nRefCount := This.nRefCount - 1;
      return This.nRefCount;
   end s_Release;

   function s_ShowContextMenu(
			      This : Pointer_To_IDocHostUIHandler_Obj;
			      dwID : DWORD;
			      ppt  : access Point_Type;
			      pcmdtReserved : access IUnknown;
			      pdispReserved : access IDispatch
			     ) return HRESULT
   is
   begin
      return ShowContextMenu(
			     This.pObject.all,
			     dwID,
			     ppt,
			     pcmdtReserved,
			     pdispReserved
			    );
   end s_ShowContextMenu;

   function s_GetHostInfo(
			  This  : Pointer_To_IDocHostUIHandler_Obj;
			  pInfo : access DOCHOSTUIINFO
			 ) return HRESULT
   is
   begin
      return GetHostInfo(
			 This.pObject.all,
			 pInfo
			);
   end s_GetHostInfo;

   function s_ShowUI(
		     This  : Pointer_To_IDocHostUIHandler_Obj;
		     dwID           : DWORD;
		     pActiveObject  : access IOleInPlaceActiveObject;
		     pCommandTarget : access IOleCommandTarget;
		     pFrame         : access IOleInPlaceFrame;
		     pDoc           : access IOleInPlaceUIWindow
		    ) return HRESULT
   is
   begin
      return ShowUI(
		    This.pObject.all,
		    dwID,
		    pActiveObject,
		    pCommandTarget,
		    pFrame,
		    pDoc
		   );
   end s_ShowUI;

   function s_HideUI(
		     This           : Pointer_To_IDocHostUIHandler_Obj
		    ) return HRESULT
   is
   begin
      return HideUI(
		    This.pObject.all
		   );
   end s_HideUI;

   function s_UpdateUI(
		       This           : Pointer_To_IDocHostUIHandler_Obj
		      ) return HRESULT
   is
   begin
      return UpdateUI(
		      This.pObject.all
		     );
   end s_UpdateUI;

   function s_EnableModeless(
			     This           : Pointer_To_IDocHostUIHandler_Obj;
			     fEnable        : System.Win32.BOOL
			    ) return HRESULT
   is
   begin
      return EnableModeless(
			    This.pObject.all,
			    fEnable
			   );
   end s_EnableModeless;

   function s_OnDocWindowActivate(
				  This           : Pointer_To_IDocHostUIHandler_Obj;
				  fActivate      : System.Win32.BOOL
				 ) return HRESULT
   is
   begin
      return OnDocWindowActivate(
				 This.pObject.all,
				 fActivate
				);
   end s_OnDocWindowActivate;

   function s_OnFrameWindowActivate(
				    This           : Pointer_To_IDocHostUIHandler_Obj;
				    fActivate      : System.Win32.BOOL
				   ) return HRESULT
   is
   begin
      return OnFrameWindowActivate(
				   This.pObject.all,
				   fActivate
				  );
   end s_OnFrameWindowActivate;

   function s_ResizeBorder(
			   This           : Pointer_To_IDocHostUIHandler_Obj;
			   prcBorder      : access GNATOCX.RECT;
			   pUIWindow      : access IOleInPlaceUIWindow;
			   fRameWindow    : System.Win32.BOOL
			  ) return HRESULT
   is
   begin
      return ResizeBorder(
			  This.pObject.all,
			  prcBorder,
			  pUIWindow,
			  fRameWindow
			 );
   end s_ResizeBorder;

   function s_TranslateAccelerator(
				   This           : Pointer_To_IDocHostUIHandler_Obj;
				   lpMsg          : access GNATOCX.MSG;
				   pguidCmdGroup  : access GNATCOM.Types.GUID;
				   nCmdID         : DWORD
				  ) return HRESULT
   is
   begin
      return TranslateAccelerator(
				  This.pObject.all,
				  lpMsg,
				  pguidCmdGroup,
				  nCmdID
				 );
   end s_TranslateAccelerator;

   function s_GetOptionKeyPath(
			       This           : Pointer_To_IDocHostUIHandler_Obj;
			       pchKey         : access LPWSTR
			      ) return HRESULT
   is
   begin
      return GetOptionKeyPath(
			      This.pObject.all,
			      pchKey
			     );
   end s_GetOptionKeyPath;

   function s_GetDropTarget(
			    This           : Pointer_To_IDocHostUIHandler_Obj;
			    pDropTarget    : access IDropTarget;
			    ppDropTarget   : access Pointer_To_IDropTarget
			   ) return HRESULT
   is
   begin
      return GetDropTarget(
			   This.pObject.all,
			   pDropTarget,
			   ppDropTarget
			  );
   end s_GetDropTarget;

   function s_GetExternal(
			  This           : Pointer_To_IDocHostUIHandler_Obj;
			  ppDispatch     : access Pointer_To_IDispatch
			 ) return HRESULT
   is
   begin
      return GetExternal(
			 This.pObject.all,
			 ppDispatch
			);
   end s_GetExternal;

   function s_TranslateUrl(
			   This           : Pointer_To_IDocHostUIHandler_Obj;
			   dwTranslate    : DWORD;
			   pchURLIn       : LPWSTR;
			   ppchURLOut     : access LPWSTR
			  ) return HRESULT
   is
   begin
      return TranslateUrl(
			  This.pObject.all,
			  dwTranslate,
			  pchURLIn,
			  ppchURLOut
			 );
   end s_TranslateUrl;

   function s_FilterDataObject(
			       This           : Pointer_To_IDocHostUIHandler_Obj;
			       pDO            : access IDataObject;
			       ppDORet        : access Pointer_TO_IDataObject
			      ) return HRESULT
   is
   begin
      return FilterDataObject(
			      This.pObject.all,
			      pDO,
			      ppDORet
			     );
   end s_FilterDataObject;

end MSHTMLHST.IDocHostUIHandler_Object;
