basis/windows/com/com.factor

   1 USING: alien alien.c-types windows.com.syntax windows.ole32\r
   2 windows.types continuations kernel alien.syntax libc\r
   3 destructors accessors ;\r
   4 IN: windows.com\r
   5 \r
   6 LIBRARY: ole32\r
   7 \r
   8 COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}\r
   9     HRESULT QueryInterface ( REFGUID iid, void** ppvObject )\r
  10     ULONG AddRef ( )\r
  11     ULONG Release ( ) ;\r
  12 \r
  13 COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}\r
  14     HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
  15     HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
  16     HRESULT QueryGetData ( FORMATETC* pFormatetc )\r
  17     HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )\r
  18     HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )\r
  19     HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )\r
  20     HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )\r
  21     HRESULT DUnadvise ( DWORD pdwConnection )\r
  22     HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;\r
  23 \r
  24 COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}\r
  25     HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
  26     HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
  27     HRESULT DragLeave ( )\r
  28     HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;\r
  29 \r
  30 : com-query-interface ( interface iid -- interface' )\r
  31     "void*" heap-size [\r
  32         [ IUnknown::QueryInterface ole32-error ] keep *void*\r
  33     ] with-malloc ;\r
  34 \r
  35 : com-add-ref ( interface -- interface )\r
  36      [ IUnknown::AddRef drop ] keep ; inline\r
  37 \r
  38 : com-release ( interface -- )\r
  39     IUnknown::Release drop ; inline\r
  40 \r
  41 : with-com-interface ( interface quot -- )\r
  42     over [ slip ] [ com-release ] [ ] cleanup ; inline\r
  43 \r
  44 TUPLE: com-destructor interface disposed ;\r
  45 M: com-destructor dispose* interface>> com-release ;\r
  46 \r
  47 : &com-release ( interface -- interface )\r
  48     dup f com-destructor boa &dispose drop ;\r
  49 : |com-release ( interface -- interface )\r
  50     dup f com-destructor boa |dispose drop ;\r