From: Joe Groff Date: Sun, 27 Sep 2009 23:19:53 +0000 (-0500) Subject: update windows vocabs to load without c-type strings X-Git-Tag: 0.97~5467^2~1^2~1 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=4f82861bf349b77b144bc803d1b137aaa050ee89 update windows vocabs to load without c-type strings --- diff --git a/basis/opengl/gl/windows/windows.factor b/basis/opengl/gl/windows/windows.factor old mode 100644 new mode 100755 index c8a179edf5..5821e3f212 --- a/basis/opengl/gl/windows/windows.factor +++ b/basis/opengl/gl/windows/windows.factor @@ -1,4 +1,4 @@ -USING: alien.syntax kernel windows.types ; +USING: alien.c-types alien.syntax kernel windows.types ; IN: opengl.gl.windows LIBRARY: gl diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index 21f048a00f..fa478b03ed 100755 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -1,5 +1,5 @@ -USING: alien.syntax kernel math windows.types windows.kernel32 -math.bitwise classes.struct ; +USING: alien.c-types alien.syntax kernel math windows.types +windows.kernel32 math.bitwise classes.struct ; IN: windows.advapi32 LIBRARY: advapi32 @@ -222,15 +222,15 @@ C-ENUM: SE_WMIGUID_OBJECT SE_REGISTRY_WOW64_32KEY ; -TYPEDEF: TRUSTEE* PTRUSTEE - STRUCT: TRUSTEE - { pMultipleTrustee PTRUSTEE } + { pMultipleTrustee TRUSTEE* } { MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION } { TrusteeForm TRUSTEE_FORM } { TrusteeType TRUSTEE_TYPE } { ptstrName LPTSTR } ; +TYPEDEF: TRUSTEE* PTRUSTEE + STRUCT: EXPLICIT_ACCESS { grfAccessPermissions DWORD } { grfAccessMode ACCESS_MODE } diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor old mode 100644 new mode 100755 index e06f5b6071..45a74e2250 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -1,45 +1,51 @@ -USING: alien alien.c-types alien.destructors windows.com.syntax -windows.ole32 windows.types continuations kernel alien.syntax -libc destructors accessors alien.data ; -IN: windows.com - -LIBRARY: ole32 - -COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} - HRESULT QueryInterface ( REFGUID iid, void** ppvObject ) - ULONG AddRef ( ) - ULONG Release ( ) ; - -COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046} - HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium ) - HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium ) - HRESULT QueryGetData ( FORMATETC* pFormatetc ) - HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut ) - HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease ) - HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc ) - HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection ) - HRESULT DUnadvise ( DWORD pdwConnection ) - HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ; - -COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046} - HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) - HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) - HRESULT DragLeave ( ) - HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ; - -: com-query-interface ( interface iid -- interface' ) - [ - "void*" malloc-object &free - [ IUnknown::QueryInterface ole32-error ] keep *void* - ] with-destructors ; - -: com-add-ref ( interface -- interface ) - [ IUnknown::AddRef drop ] keep ; inline - -: com-release ( interface -- ) - IUnknown::Release drop ; inline - -: with-com-interface ( interface quot -- ) - over [ com-release ] curry [ ] cleanup ; inline - -DESTRUCTOR: com-release +USING: alien alien.c-types alien.destructors windows.com.syntax +windows.ole32 windows.types continuations kernel alien.syntax +libc destructors accessors alien.data ; +IN: windows.com + +LIBRARY: ole32 + +COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} + HRESULT QueryInterface ( REFGUID iid, void** ppvObject ) + ULONG AddRef ( ) + ULONG Release ( ) ; + +TYPEDEF: void* IAdviseSink* + +COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046} + HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium ) + HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium ) + HRESULT QueryGetData ( FORMATETC* pFormatetc ) + HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut ) + HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease ) + HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc ) + HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection ) + HRESULT DUnadvise ( DWORD pdwConnection ) + HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ; + +COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046} + HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) + HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) + HRESULT DragLeave ( ) + HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ; + +FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ; +FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ; +FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ; + +: com-query-interface ( interface iid -- interface' ) + [ + "void*" malloc-object &free + [ IUnknown::QueryInterface ole32-error ] keep *void* + ] with-destructors ; + +: com-add-ref ( interface -- interface ) + [ IUnknown::AddRef drop ] keep ; inline + +: com-release ( interface -- ) + IUnknown::Release drop ; inline + +: with-com-interface ( interface quot -- ) + over [ com-release ] curry [ ] cleanup ; inline + +DESTRUCTOR: com-release diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 3cf8b55e39..bbade332cc 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -1,8 +1,8 @@ -USING: alien alien.c-types alien.accessors effects kernel -windows.ole32 parser lexer splitting grouping sequences -namespaces assocs quotations generalizations accessors words -macros alien.syntax fry arrays layouts math classes.struct -windows.kernel32 ; +USING: alien alien.c-types alien.accessors alien.parser +effects kernel windows.ole32 parser lexer splitting grouping +sequences namespaces assocs quotations generalizations +accessors words macros alien.syntax fry arrays layouts math +classes.struct windows.kernel32 ; IN: windows.com.syntax com-interface-definition TUPLE: com-function-definition name return parameters ; @@ -25,22 +25,25 @@ SYMBOL: +com-interface-definitions+ [ H{ } +com-interface-definitions+ set-global ] unless +ERROR: no-com-interface interface ; + : find-com-interface-definition ( name -- definition ) - dup "f" = [ drop f ] [ + [ dup +com-interface-definitions+ get-global at* - [ nip ] - [ " COM interface hasn't been defined" prepend throw ] - if - ] if ; + [ nip ] [ drop no-com-interface ] if + ] [ f ] if* ; : save-com-interface-definition ( definition -- ) - dup name>> +com-interface-definitions+ get-global set-at ; + dup word>> +com-interface-definitions+ get-global set-at ; : (parse-com-function) ( tokens -- definition ) [ second ] [ first ] - [ 3 tail [ CHAR: , swap remove ] map 2 group { "void*" "this" } prefix ] - tri + [ + 3 tail [ CHAR: , swap remove ] map + 2 group [ first2 normalize-c-arg 2array ] map + { void* "this" } prefix + ] tri ; : parse-com-functions ( -- functions ) @@ -48,10 +51,11 @@ unless [ (parse-com-function) ] map ; : (iid-word) ( definition -- word ) - name>> "-iid" append create-in ; + word>> name>> "-iid" append create-in ; : (function-word) ( function interface -- word ) - name>> "::" rot name>> 3append create-in ; + swap [ word>> name>> "::" ] [ name>> ] bi* + 3append create-in ; : family-tree ( definition -- definitions ) dup parent>> [ family-tree ] [ { } ] if* @@ -79,7 +83,7 @@ unless : define-words-for-com-interface ( definition -- ) [ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ] - [ name>> "com-interface" swap typedef ] + [ word>> void* swap typedef ] [ dup family-tree-functions [ (define-word-for-function) ] with each-index @@ -89,8 +93,8 @@ unless PRIVATE> SYNTAX: COM-INTERFACE: - scan - scan find-com-interface-definition + CREATE-C-TYPE + scan-object find-com-interface-definition scan string>guid parse-com-functions diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor index 5187c3f660..43307cb6ba 100755 --- a/basis/windows/gdi32/gdi32.factor +++ b/basis/windows/gdi32/gdi32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax alien.destructors kernel windows.types -math.bitwise ; +USING: alien alien.c-types alien.syntax alien.destructors +kernel windows.types math.bitwise ; IN: windows.gdi32 CONSTANT: BI_RGB 0 diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 075b0218b3..bb0a679c01 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax kernel windows.types multiline -classes.struct ; +USING: alien alien.c-types alien.syntax kernel windows.types +multiline classes.struct ; IN: windows.kernel32 CONSTANT: MAX_PATH 260 @@ -543,7 +543,7 @@ STRUCT: DCB TYPEDEF: DCB* PDCB TYPEDEF: DCB* LPDCB -STRUCT: COMM_CONFIG +STRUCT: COMMCONFIG { dwSize DWORD } { wVersion WORD } { wReserved WORD } diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 3bc7f45960..6e90cae89a 100755 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -111,10 +111,6 @@ CONSTANT: COINIT_SPEED_OVER_MEMORY 8 FUNCTION: HRESULT OleInitialize ( void* reserved ) ; FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ; -FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ; -FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ; -FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ; - : succeeded? ( hresult -- ? ) 0 HEX: 7FFFFFFF between? ; diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor old mode 100644 new mode 100755 index 6b4e0d797e..bede62c813 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -3,8 +3,8 @@ USING: alien alien.c-types alien.strings alien.syntax classes.struct combinators io.encodings.utf16n io.files io.pathnames kernel windows.errors windows.com -windows.com.syntax windows.user32 windows.ole32 windows -specialized-arrays ; +windows.com.syntax windows.types windows.user32 +windows.ole32 windows specialized-arrays ; SPECIALIZED-ARRAY: ushort IN: windows.shell32 diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index f3455fbb0f..ea5daba688 100755 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -61,6 +61,7 @@ TYPEDEF: ulong ULONG_PTR TYPEDEF: int INT32 TYPEDEF: uint UINT32 TYPEDEF: uint DWORD32 +TYPEDEF: long LONG32 TYPEDEF: ulong ULONG32 TYPEDEF: ulonglong ULONG64 TYPEDEF: long* POINTER_32 @@ -75,6 +76,8 @@ TYPEDEF: longlong LARGE_INTEGER TYPEDEF: ulonglong ULARGE_INTEGER TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER +TYPEDEF: size_t SIZE_T +TYPEDEF: ptrdiff_t SSIZE_T TYPEDEF: wchar_t* LPCSTR TYPEDEF: wchar_t* LPWSTR @@ -201,15 +204,6 @@ TYPEDEF: LONG_PTR SSIZE_T TYPEDEF: LONGLONG USN TYPEDEF: UINT_PTR WPARAM -TYPEDEF: RECT* LPRECT -TYPEDEF: void* PWNDCLASS -TYPEDEF: void* PWNDCLASSEX -TYPEDEF: void* LPWNDCLASS -TYPEDEF: void* LPWNDCLASSEX -TYPEDEF: void* MSGBOXPARAMSA -TYPEDEF: void* MSGBOXPARAMSW -TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE - TYPEDEF: size_t socklen_t TYPEDEF: void* WNDPROC @@ -343,6 +337,14 @@ TYPEDEF: PFD* LPPFD TYPEDEF: HANDLE HGLRC TYPEDEF: HANDLE HRGN +TYPEDEF: void* PWNDCLASS +TYPEDEF: void* PWNDCLASSEX +TYPEDEF: void* LPWNDCLASS +TYPEDEF: void* LPWNDCLASSEX +TYPEDEF: void* MSGBOXPARAMSA +TYPEDEF: void* MSGBOXPARAMSW +TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE + STRUCT: LVITEM { mask uint } { iItem int } diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index 43b59d613b..e10ee67357 100755 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax parser namespaces kernel math -windows.types generalizations math.bitwise classes.struct -literals ; +USING: alien alien.c-types alien.syntax parser namespaces +kernel math windows.types generalizations math.bitwise +classes.struct literals windows.kernel32 ; IN: windows.user32 ! HKL for ActivateKeyboardLayout diff --git a/basis/windows/usp10/usp10.factor b/basis/windows/usp10/usp10.factor index eb57a46925..f021b55289 100755 --- a/basis/windows/usp10/usp10.factor +++ b/basis/windows/usp10/usp10.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax alien.destructors classes.struct ; +USING: alien.c-types alien.syntax alien.destructors classes.struct +windows.types ; IN: windows.usp10 LIBRARY: usp10 @@ -56,6 +57,9 @@ SCRIPT_JUSTIFFY_RESERVED4 ; STRUCT: SCRIPT_VISATTR { flags WORD } ; +TYPEDEF: void* SCRIPT_CACHE* +TYPEDEF: void* ABC* + FUNCTION: HRESULT ScriptShape ( HDC hdc, SCRIPT_CACHE* psc,