]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/ole32/ole32.factor
windows.ole32: use sets in tests.
[factor.git] / basis / windows / ole32 / ole32.factor
old mode 100755 (executable)
new mode 100644 (file)
index 6e90cae..47c45c8
@@ -10,30 +10,34 @@ LIBRARY: ole32
 
 TYPEDEF: GUID* REFGUID
 TYPEDEF: void* LPUNKNOWN
-TYPEDEF: wchar_t* LPOLESTR
-TYPEDEF: wchar_t* LPCOLESTR
+TYPEDEF: LPWSTR LPOLESTR
+TYPEDEF: LPWSTR LPCOLESTR
+
+TYPEDEF: GUID IID
+TYPEDEF: GUID CLSID
 
 TYPEDEF: REFGUID LPGUID
 TYPEDEF: REFGUID REFIID
 TYPEDEF: REFGUID REFCLSID
 
-FUNCTION: HRESULT CoCreateInstance ( REFGUID rclsid, LPUNKNOWN pUnkOuter, DWORD dwClsContext, REFGUID riid, LPUNKNOWN out_ppv ) ;
-FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 ) ;
-FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax ) ;
-FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ;
+FUNCTION: HRESULT CoCreateInstance ( REFGUID rclsid, LPUNKNOWN pUnkOuter, DWORD dwClsContext, REFGUID riid, LPUNKNOWN out_ppv )
+FUNCTION: HRESULT CoCreateGuid ( GUID* pguid )
+FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 )
+FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax )
+FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid )
 
 CONSTANT: S_OK 0
 CONSTANT: S_FALSE 1
-CONSTANT: E_NOINTERFACE HEX: 80004002
-CONSTANT: E_FAIL HEX: 80004005
-CONSTANT: E_INVALIDARG HEX: 80070057
+CONSTANT: E_NOINTERFACE 0x80004002
+CONSTANT: E_FAIL 0x80004005
+CONSTANT: E_INVALIDARG 0x80070057
 
-CONSTANT: MK_ALT HEX: 20
+CONSTANT: MK_ALT 0x20
 CONSTANT: DROPEFFECT_NONE 0
 CONSTANT: DROPEFFECT_COPY 1
 CONSTANT: DROPEFFECT_MOVE 2
 CONSTANT: DROPEFFECT_LINK 4
-CONSTANT: DROPEFFECT_SCROLL HEX: 80000000
+CONSTANT: DROPEFFECT_SCROLL 0x80000000
 CONSTANT: DD_DEFSCROLLINSET 11
 CONSTANT: DD_DEFSCROLLDELAY 50
 CONSTANT: DD_DEFSCROLLINTERVAL 50
@@ -58,11 +62,11 @@ CONSTANT: CF_HDROP            15
 CONSTANT: CF_LOCALE           16
 CONSTANT: CF_MAX              17
 
-CONSTANT: CF_OWNERDISPLAY     HEX: 0080
-CONSTANT: CF_DSPTEXT          HEX: 0081
-CONSTANT: CF_DSPBITMAP        HEX: 0082
-CONSTANT: CF_DSPMETAFILEPICT  HEX: 0083
-CONSTANT: CF_DSPENHMETAFILE   HEX: 008E
+CONSTANT: CF_OWNERDISPLAY     0x0080
+CONSTANT: CF_DSPTEXT          0x0081
+CONSTANT: CF_DSPBITMAP        0x0082
+CONSTANT: CF_DSPMETAFILEPICT  0x0083
+CONSTANT: CF_DSPENHMETAFILE   0x008E
 
 CONSTANT: DVASPECT_CONTENT    1
 CONSTANT: DVASPECT_THUMBNAIL  2
@@ -108,29 +112,32 @@ CONSTANT: COINIT_APARTMENTTHREADED 2
 CONSTANT: COINIT_DISABLE_OLE1DDE   4
 CONSTANT: COINIT_SPEED_OVER_MEMORY 8
 
-FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
-FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
+FUNCTION: HRESULT OleInitialize ( void* reserved )
+FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit )
 
 : succeeded? ( hresult -- ? )
-    0 HEX: 7FFFFFFF between? ;
+    0 0x7FFFFFFF between? ;
 
 TUPLE: ole32-error code message ;
 
 : <ole32-error> ( code -- error )
     dup n>win32-error-string \ ole32-error boa ;
 
-: ole32-error ( hresult -- )
+: check-ole32-error ( hresult -- )
     dup succeeded? [ drop ] [ <ole32-error> throw ] if ;
 
 : ole-initialize ( -- )
-    f OleInitialize ole32-error ;
+    f OleInitialize check-ole32-error ;
 
 : guid= ( a b -- ? )
-    [ 16 memory>byte-array ] bi@ = ;
+    [ 16 memory>byte-array ] same? ;
 
 CONSTANT: GUID-STRING-LENGTH
     $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
 
+: create-guid ( -- GUID )
+    GUID <struct> dup CoCreateGuid check-ole32-error ;
+
 : string>guid ( string -- guid )
     "{-}" split harvest
     [ first3 [ hex> ] tri@ ]