From f7ec7cbc441f26ca39bfe4029245d9fb23099db9 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 15 Feb 2008 18:08:01 -0800 Subject: [PATCH 1/7] ole32.dll bindings --- core/alien/alien-docs.factor | 18 ++++++++++- core/alien/alien.factor | 10 +++++- extra/opengl/shaders/shaders.factor | 9 +++--- extra/windows/ce/ce.factor | 1 + extra/windows/com/com.factor | 8 +++++ extra/windows/com/syntax/syntax.factor | 26 ++++++++++++++++ extra/windows/nt/nt.factor | 1 + extra/windows/ole32/ole32.factor | 43 ++++++++++++++++++++++++++ extra/windows/shell32/shell32.factor | 16 ++-------- 9 files changed, 112 insertions(+), 20 deletions(-) mode change 100644 => 100755 extra/opengl/shaders/shaders.factor mode change 100644 => 100755 extra/windows/ce/ce.factor create mode 100755 extra/windows/com/com.factor create mode 100755 extra/windows/com/syntax/syntax.factor mode change 100644 => 100755 extra/windows/nt/nt.factor create mode 100755 extra/windows/ole32/ole32.factor mode change 100644 => 100755 extra/windows/shell32/shell32.factor diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 19ee52b039..68509db37f 100755 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -145,7 +145,23 @@ HELP: alien-callback } { $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ; -{ alien-invoke alien-indirect alien-callback } related-words +HELP: out-keep +{ $values { "quot" "A quotation" } { "out-indexes" "A sequence of indexes relative to the top of the stack" } } +{ $description + "Invokes " { $snippet "quot" } ", restoring the values to the stack indicated by " { $snippet "out-indexes" } ". This word is useful for calling C functions with out parameters. " { $snippet "quot" } " can invoke the function and manipulate its return value, after which the actually interesting values stored in the out parameters are brought back to the top of the stack." } +{ $notes "The indexes in " { $snippet "out-indexes" } " are relative to the top of the stack, with " { $snippet "1" } " indicating the topmost value. This means that the indexes are reversed relative to the order in the C prototype; 1 indicates the rightmost parameter, and higher numbers count leftward." } +{ $examples + "A simple wrapper around memcpy (pretending that the return value is not equal to the out parameter):" + { $code + "LIBRARY: libc" + "FUNCTION: void* memcpy ( void* out, void* in, size_t n ) ;" + ": copy-byte-array ( a -- a' )" + " dup length dup -rot" + " [ memcpy drop ] { 3 } out-keep ;" + } +} ; + +{ alien-invoke alien-indirect alien-callback out-keep } related-words ARTICLE: "aliens" "Alien addresses" "Instances of the " { $link alien } " class represent pointers to C data outside the Factor heap:" diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 317dac803e..b644846393 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel math namespaces sequences system -kernel.private tuples bit-arrays byte-arrays float-arrays ; +kernel.private tuples bit-arrays byte-arrays float-arrays +shuffle arrays macros ; IN: alien ! Some predicate classes used by the compiler for optimization @@ -89,3 +90,10 @@ TUPLE: alien-invoke-error library symbol ; : alien-invoke ( ... return library function parameters -- ... ) 2over \ alien-invoke-error construct-boa throw ; + +MACRO: out-keep ( word out-indexes -- ... ) + [ + dup >r [ \ npick \ >r 3array % ] each + % + r> [ drop \ r> , ] each + ] [ ] make ; diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor old mode 100644 new mode 100755 index 0ff708d6d4..7755df6513 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -92,10 +92,11 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; GL_ATTACHED_SHADERS gl-program-get-int ; inline : gl-program-shaders ( program -- shaders ) - dup gl-program-shaders-length [ - dup "GLuint" - [ 0 swap glGetAttachedShaders ] keep - ] keep c-uint-array> ; + dup gl-program-shaders-length + dup "GLuint" + 0 swap + [ glGetAttachedShaders ] { 3 1 } out-keep + c-uint-array> ; : delete-gl-program-only ( program -- ) glDeleteProgram ; inline diff --git a/extra/windows/ce/ce.factor b/extra/windows/ce/ce.factor old mode 100644 new mode 100755 index 1180d78a2b..948612b2b2 --- a/extra/windows/ce/ce.factor +++ b/extra/windows/ce/ce.factor @@ -11,4 +11,5 @@ USING: alien sequences ; ! { "gl" "libGLES_CM.dll" "stdcall" } ! { "glu" "libGLES_CM.dll" "stdcall" } ! { "freetype" "libfreetype-6.dll" "stdcall" } + { "ole32" "ole32.dll" "stdcall" } } [ first3 add-library ] each diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor new file mode 100755 index 0000000000..9543ec7e6a --- /dev/null +++ b/extra/windows/com/com.factor @@ -0,0 +1,8 @@ +USING: alien alien.c-types windows.com.syntax windows.ole32 +windows.types ; +IN: windows.com + +COM-INTERFACE: IUnknown f + HRESULT QueryInterface ( void* this, REFGUID iid, void** ppvObject ) + ULONG AddRef ( void* this ) + ULONG Release ( void* this ) ; diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor new file mode 100755 index 0000000000..12258644ae --- /dev/null +++ b/extra/windows/com/syntax/syntax.factor @@ -0,0 +1,26 @@ +USING: alien alien.c-types kernel windows windows.ole32 +combinators.lib parser splitting sequences.lib ; +IN: windows.com.syntax + + + +: COM-INTERFACE: + scan + parse-inheritance + ";" parse-tokens { ")" } split + [ + ; parsing + diff --git a/extra/windows/nt/nt.factor b/extra/windows/nt/nt.factor old mode 100644 new mode 100755 index 8a709416d8..1dc997b38a --- a/extra/windows/nt/nt.factor +++ b/extra/windows/nt/nt.factor @@ -12,4 +12,5 @@ USING: alien sequences ; { "gl" "opengl32.dll" "stdcall" } { "glu" "glu32.dll" "stdcall" } { "freetype" "freetype6.dll" "cdecl" } + { "ole32" "ole32.dll" "stdcall" } } [ first3 add-library ] each diff --git a/extra/windows/ole32/ole32.factor b/extra/windows/ole32/ole32.factor new file mode 100755 index 0000000000..6d62e17d6c --- /dev/null +++ b/extra/windows/ole32/ole32.factor @@ -0,0 +1,43 @@ +USING: alien alien.syntax alien.c-types math kernel sequences +windows windows.types ; +IN: windows.ole32 + +LIBRARY: ole32 + +C-STRUCT: GUID + { "DWORD" "part1" } + { "DWORD" "part2" } + { "DWORD" "part3" } + { "DWORD" "part4" } ; + +TYPEDEF: void* REFGUID +TYPEDEF: void* LPUNKNOWN +TYPEDEF: ushort* LPOLESTR + +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 ) ; + +: S_OK 0 ; inline +: S_FALSE 1 ; inline +: E_FAIL HEX: 80004005 ; inline +: E_INVALIDARG HEX: 80070057 ; inline + +: ole32-error ( n -- ) + dup S_OK = [ + drop + ] [ (win32-error-string) throw ] if ; + +: guid= ( a b -- ? ) + IsEqualGUID c-bool> ; + +: GUID-STRING-LENGTH + "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline + +: string>guid ( string -- guid ) + string>u16-alien "GUID" [ CLSIDFromString ole32-error ] keep ; +: guid>string ( guid -- string ) + GUID-STRING-LENGTH 1+ [ "ushort" ] keep + [ StringFromGUID2 drop ] { 2 } out-keep alien>u16-string ; + diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor old mode 100644 new mode 100755 index 501f49edfe..1d8d67dad7 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types alien.syntax combinators -kernel windows windows.user32 ; +kernel windows windows.user32 windows.ole32 ; IN: windows.shell32 : CSIDL_DESKTOP HEX: 00 ; inline @@ -68,10 +68,6 @@ IN: windows.shell32 : CSIDL_FLAG_MASK HEX: ff00 ; inline -: S_OK 0 ; inline -: S_FALSE 1 ; inline -: E_FAIL HEX: 80004005 ; inline -: E_INVALIDARG HEX: 80070057 ; inline : ERROR_FILE_NOT_FOUND 2 ; inline : SHGFP_TYPE_CURRENT 0 ; inline @@ -89,15 +85,7 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi f "open" rot f f SW_SHOWNORMAL ShellExecute drop ; : shell32-error ( n -- ) - dup S_OK = [ - drop - ] [ - { - ! { ERROR_FILE_NOT_FOUND [ "file not found" throw ] } - ! { E_INVALIDARG [ "invalid arg" throw ] } - [ (win32-error-string) throw ] - } case - ] if ; + ole32-error ; inline : shell32-directory ( n -- str ) f swap f SHGFP_TYPE_DEFAULT From 5f793727893e1eb658546ee8285a9353740fcf1c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 15 Feb 2008 22:51:52 -0800 Subject: [PATCH 2/7] Rename out-keep to multikeep and move it into combinators.lib --- core/alien/alien-docs.factor | 18 +----------------- core/alien/alien.factor | 7 ------- extra/combinators/lib/lib.factor | 7 +++++++ extra/opengl/shaders/shaders.factor | 2 +- extra/windows/ole32/ole32.factor | 4 ++-- 5 files changed, 11 insertions(+), 27 deletions(-) diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 68509db37f..19ee52b039 100755 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -145,23 +145,7 @@ HELP: alien-callback } { $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ; -HELP: out-keep -{ $values { "quot" "A quotation" } { "out-indexes" "A sequence of indexes relative to the top of the stack" } } -{ $description - "Invokes " { $snippet "quot" } ", restoring the values to the stack indicated by " { $snippet "out-indexes" } ". This word is useful for calling C functions with out parameters. " { $snippet "quot" } " can invoke the function and manipulate its return value, after which the actually interesting values stored in the out parameters are brought back to the top of the stack." } -{ $notes "The indexes in " { $snippet "out-indexes" } " are relative to the top of the stack, with " { $snippet "1" } " indicating the topmost value. This means that the indexes are reversed relative to the order in the C prototype; 1 indicates the rightmost parameter, and higher numbers count leftward." } -{ $examples - "A simple wrapper around memcpy (pretending that the return value is not equal to the out parameter):" - { $code - "LIBRARY: libc" - "FUNCTION: void* memcpy ( void* out, void* in, size_t n ) ;" - ": copy-byte-array ( a -- a' )" - " dup length dup -rot" - " [ memcpy drop ] { 3 } out-keep ;" - } -} ; - -{ alien-invoke alien-indirect alien-callback out-keep } related-words +{ alien-invoke alien-indirect alien-callback } related-words ARTICLE: "aliens" "Alien addresses" "Instances of the " { $link alien } " class represent pointers to C data outside the Factor heap:" diff --git a/core/alien/alien.factor b/core/alien/alien.factor index b644846393..d5e9b5c3e9 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -90,10 +90,3 @@ TUPLE: alien-invoke-error library symbol ; : alien-invoke ( ... return library function parameters -- ... ) 2over \ alien-invoke-error construct-boa throw ; - -MACRO: out-keep ( word out-indexes -- ... ) - [ - dup >r [ \ npick \ >r 3array % ] each - % - r> [ drop \ r> , ] each - ] [ ] make ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 9ccada1ec1..f73a99c1a2 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -167,3 +167,10 @@ MACRO: construct-slots ( assoc tuple-class -- tuple ) : and? ( obj quot1 quot2 -- ? ) >r keep r> rot [ call ] [ 2drop f ] if ; inline + +MACRO: multikeep ( word out-indexes -- ... ) + [ + dup >r [ \ npick \ >r 3array % ] each + % + r> [ drop \ r> , ] each + ] [ ] make ; diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor index 7755df6513..6033933146 100755 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -95,7 +95,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; dup gl-program-shaders-length dup "GLuint" 0 swap - [ glGetAttachedShaders ] { 3 1 } out-keep + [ glGetAttachedShaders ] { 3 1 } multikeep c-uint-array> ; : delete-gl-program-only ( program -- ) diff --git a/extra/windows/ole32/ole32.factor b/extra/windows/ole32/ole32.factor index 6d62e17d6c..ec0b02bc3f 100755 --- a/extra/windows/ole32/ole32.factor +++ b/extra/windows/ole32/ole32.factor @@ -1,5 +1,5 @@ USING: alien alien.syntax alien.c-types math kernel sequences -windows windows.types ; +windows windows.types combinators.lib ; IN: windows.ole32 LIBRARY: ole32 @@ -39,5 +39,5 @@ FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ; string>u16-alien "GUID" [ CLSIDFromString ole32-error ] keep ; : guid>string ( guid -- string ) GUID-STRING-LENGTH 1+ [ "ushort" ] keep - [ StringFromGUID2 drop ] { 2 } out-keep alien>u16-string ; + [ StringFromGUID2 drop ] { 2 } multikeep alien>u16-string ; From 86e700cea06266e8c7cd1a0c2387750464552d39 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 12 Mar 2008 22:21:37 -0700 Subject: [PATCH 3/7] Fix macosx gl-function-address to use symbols from GL library linked to VM --- extra/opengl/gl/macosx/macosx.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/opengl/gl/macosx/macosx.factor b/extra/opengl/gl/macosx/macosx.factor index 3d4cb6ae93..eb8dda5e33 100644 --- a/extra/opengl/gl/macosx/macosx.factor +++ b/extra/opengl/gl/macosx/macosx.factor @@ -2,5 +2,5 @@ USING: kernel alien ; IN: opengl.gl.macosx : gl-function-context ( -- context ) 0 ; inline -: gl-function-address ( name -- address ) "gl" load-library dlsym ; inline +: gl-function-address ( name -- address ) f dlsym ; inline : gl-function-calling-convention ( -- str ) "cdecl" ; inline From fe9ab0e26ba5a272bf3dbf97aecdcf4e3375eac4 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 15 Mar 2008 17:45:05 -0700 Subject: [PATCH 4/7] COM unit tests. Remove redundant call-with word and use cleave instead. --- extra/bunny/outlined/outlined.factor | 6 +- extra/combinators/lib/lib.factor | 20 ++--- extra/io/windows/files/files.factor | 5 +- extra/opengl/demo-support/demo-support.factor | 5 +- extra/opengl/shaders/shaders.factor | 4 +- extra/windows/com/com-tests.factor | 87 +++++++++++++++++++ extra/windows/com/com.factor | 19 ++-- extra/windows/com/syntax/syntax.factor | 4 - 8 files changed, 117 insertions(+), 33 deletions(-) create mode 100755 extra/windows/com/com-tests.factor diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index d7064ebdde..67617b0273 100644 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -1,5 +1,5 @@ USING: arrays bunny.model bunny.cel-shaded -combinators.lib continuations kernel math multiline +combinators.cleave continuations kernel math multiline opengl opengl.shaders opengl.framebuffers opengl.gl opengl.capabilities sequences ui.gadgets ; IN: bunny.outlined @@ -177,7 +177,7 @@ TUPLE: bunny-outlined [ bunny-outlined-normal-texture [ delete-texture ] when* ] [ bunny-outlined-depth-texture [ delete-texture ] when* ] [ f swap set-bunny-outlined-framebuffer-dim ] - } call-with + } cleave ] [ drop ] if ; : remake-framebuffer-if-needed ( draw -- ) @@ -237,4 +237,4 @@ M: bunny-outlined dispose [ bunny-outlined-pass1-program [ delete-gl-program ] when* ] [ bunny-outlined-pass2-program [ delete-gl-program ] when* ] [ dispose-framebuffer ] - } call-with ; + } cleave ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 99386272f3..c617466d1b 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -130,24 +130,14 @@ MACRO: parallel-call ( quots -- ) ! map-call and friends ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: (make-call-with) ( quots -- quot ) - [ [ keep ] curry ] map concat [ drop ] append ; - -MACRO: call-with ( quots -- ) - (make-call-with) ; - MACRO: map-call-with ( quots -- ) - [ (make-call-with) ] keep length [ narray ] curry compose ; - -: (make-call-with2) ( quots -- quot ) - [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat - [ 2drop ] append ; - -MACRO: call-with2 ( quots -- ) - (make-call-with2) ; + [ [ [ keep ] curry ] map concat [ drop ] append ] keep length [ narray ] curry compose ; MACRO: map-call-with2 ( quots -- ) - [ (make-call-with2) ] keep length [ narray ] curry append ; + [ + [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat + [ 2drop ] append + ] keep length [ narray ] curry append ; MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 3d51e65116..afd2a09e08 100644 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -3,7 +3,8 @@ USING: alien.c-types io.files io.windows kernel math windows windows.kernel32 combinators.cleave windows.time calendar combinators math.functions -sequences combinators.lib namespaces words symbols ; +sequences combinators.lib combinators.cleave +namespaces words symbols ; IN: io.windows.files SYMBOLS: +read-only+ +hidden+ +system+ @@ -19,7 +20,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ first2 expand-constants [ swapd mask? [ , ] [ drop ] if ] 2curry - ] map call-with + ] map cleave ] { } make ; : win32-file-attributes ( n -- seq ) diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 59b7a3bcc3..f7df84cbda 100644 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -1,4 +1,5 @@ -USING: arrays combinators.lib kernel math math.functions math.vectors namespaces +USING: arrays combinators.lib combinators.cleave kernel math + math.functions math.vectors namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render ; IN: opengl.demo-support @@ -49,7 +50,7 @@ M: demo-gadget pref-dim* ( gadget -- dim ) glLoadIdentity { [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ] [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ] - [ demo-gadget-yaw 0.0 1.0 0.0 glRotatef ] } call-with ; + [ demo-gadget-yaw 0.0 1.0 0.0 glRotatef ] } cleave ; : reset-last-drag-rel ( -- ) { 0 0 } last-drag-loc set ; diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor index c8186e55c3..7403b7cb05 100755 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel opengl.gl alien.c-types continuations namespaces assocs alien libc opengl math sequences combinators.lib -macros arrays ; +combinators.cleave macros arrays ; IN: opengl.shaders : with-gl-shader-source-ptr ( string quot -- ) @@ -118,7 +118,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; : (make-with-gl-program) ( uniforms quot -- q ) [ \ dup , - [ swap (with-gl-program-uniforms) , \ call-with , % ] + [ swap (with-gl-program-uniforms) , \ cleave , % ] [ ] make , \ (with-gl-program) , ] [ ] make ; diff --git a/extra/windows/com/com-tests.factor b/extra/windows/com/com-tests.factor new file mode 100755 index 0000000000..2e6e8a9c22 --- /dev/null +++ b/extra/windows/com/com-tests.factor @@ -0,0 +1,87 @@ +USING: kernel windows.com windows.com.syntax windows.ole32 +alien alien.syntax tools.test libc ; +IN: windows.com.tests + +! Create some test COM interfaces + +COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} + HRESULT returnOK ( ) + HRESULT returnError ( ) ; + +COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} + int getX ( ) ; + void setX ( int newX ) ; + +! Implement the IInherited interface in factor using alien-callbacks + +: QueryInterface-callback + "HRESULT" { "void*" "REFGUID" "void**" } "stdcall" [ nip 0 -rot set-void*-nth ] + alien-callback ; +: AddRef-callback + "ULONG" { "void*" } "stdcall" [ drop 2 ] + alien-callback ; +: Release-callback + "ULONG" { "void*" } "stdcall" [ drop 1 ] + alien-callback ; +: returnOK-callback + "HRESULT"{ "void*" } "stdcall" [ drop S_OK ] + alien-callback ; +: returnError-callback + "HRESULT"{ "void*" } "stdcall" [ drop E_FAIL ] + alien-callback ; +: getX-callback + "int" { "void*" } "stdcall" [ test-interface-x ] + alien-callback ; +: setX-callback + "void" { "void*" "int" } "stdcall" [ swap set-test-interface-x ] + alien-callback ; + +SYMBOL: +test-implementation-vtbl+ +{ + QueryInterface-callback + AddRef-callback + Release-callback + returnOK-callback + returnError-callback + getX-callback + setX-callback +} [ execute ] map >c-void*-array ++test-implementation-vtbl+ set + +C-STRUCT: test-implementation + { "void*" "vtbl" } + { "int" "x" } ; + +: (make-test-implementation) ( x imp -- imp ) + [ set-test-implementation-x ] keep + +test-implementation-vtbl+ get over set-test-implementation-vtbl ; + +: ( x -- imp ) + "test-implementation" (make-test-implementation) ; + +! Test that the words defined by COM-INTERFACE: do their magic + +"{216fb341-0eb2-44b1-8edb-60b76e353abc}" string>guid 1array [ ISimple-iid ] unit-test +"{9620ecec-8438-423b-bb14-86f835aa40dd}" string>guid 1array [ IInherited-iid ] unit-test +"{00000000-0000-0000-C000-000000000046}" string>guid 1array [ IUnknown-iid ] unit-test +S_OK 1array [ 0 ISimple::returnOK ] unit-test +E_FAIL 1array [ 0 ISimple::returnError ] unit-test +1984 1array [ 0 dup 1984 IInherited::setX IInherited::getX ] unit-test + +! Test that the helper functions for QueryInterface, AddRef, Release work + +: ( x -- imp ) + "test-implementation" heap-size malloc (make-test-implementation) ; + +SYMBOL: +guinea-pig-implementation+ + +0 +guinea-pig-implementation+ set +[ + +guinea-pig-implementation+ get 1array [ + +guinea-pig-implementation+ get IUnknown-iid com-query-interface + ] unit-test + + { } [ +guinea-pig-implementation+ get com-add-ref ] unit-test + { } [ +guinea-pig-implementation+ get com-release ] unit-test +] [ +guinea-pig-implementation+ get free ] [ ] cleanup + diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor index 9543ec7e6a..477eaad038 100755 --- a/extra/windows/com/com.factor +++ b/extra/windows/com/com.factor @@ -1,8 +1,17 @@ USING: alien alien.c-types windows.com.syntax windows.ole32 -windows.types ; +windows.types continuations ; IN: windows.com -COM-INTERFACE: IUnknown f - HRESULT QueryInterface ( void* this, REFGUID iid, void** ppvObject ) - ULONG AddRef ( void* this ) - ULONG Release ( void* this ) ; +COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} + HRESULT QueryInterface ( REFGUID iid, void** ppvObject ) + ULONG AddRef ( ) + ULONG Release ( ) ; + +: com-query-interface ( interface iid -- interface' ) + f [ IUnknown::QueryInterface ] keep *void* ; + +: com-add-ref ( interface -- ) + IUnknown::AddRef drop ; inline + +: com-release ( interface -- ) + IUnknown::Release drop ; inline diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index 12258644ae..0895c0e201 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -11,10 +11,6 @@ IN: windows.com.syntax swap vtbl swap void*-nth ] 4 ndip alien-indirect ; -: parse-inheritance - scan dup { - } case ; - PRIVATE> : COM-INTERFACE: From 53ccdc39542910f2a107f2f4347652e4d94e61b9 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 16 Mar 2008 18:36:33 -0700 Subject: [PATCH 5/7] Sketch out windows.com.syntax --- extra/windows/com/syntax/syntax.factor | 79 ++++++++++++++++++++++---- 1 file changed, 69 insertions(+), 10 deletions(-) diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index 0895c0e201..9068d75d16 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -1,22 +1,81 @@ -USING: alien alien.c-types kernel windows windows.ole32 -combinators.lib parser splitting sequences.lib ; +USING: alien alien.c-types kernel windows.ole32 +combinators.lib parser splitting sequences.lib +sequences namespaces new-slots combinators.cleave +assocs quotations shuffle ; IN: windows.com.syntax com-interface-definition + +TUPLE: com-function-definition name return parameters ; +C: com-function-definition + +SYMBOL: +com-interface-definitions+ +H{ } +com-interface-definitions+ set-global + +: find-com-interface-definition ( name -- definition ) + dup "f" = [ drop f ] [ + dup +com-interface-definitions+ get-global at* + [ nip ] + [ swap " COM interface hasn't been defined" append throw ] + if + ] if ; + +: save-com-interface-definition ( definition -- ) + dup name>> +com-interface-definitions+ get-global set-at ; + +: (parse-com-function) ( tokens -- definition ) + [ second ] + [ first ] + [ 3 tail 2 group [ first ] map "void*" add* ] + tri + ; + +: parse-com-functions ( -- functions ) + ";" parse-tokens { ")" } split + [ (parse-com-function) ] map ; + +: (iid-word) ( definition -- word ) + name>> "-iid" append create-in ; + +: (function-word) ( function interface -- word ) + name>> "::" rot name>> 3append create-in ; + +: all-functions ( definition -- functions ) + dup parent>> [ all-functions ] [ { } ] if* + swap functions>> append ; + +: (define-word-for-function) ( function interface n -- ) + -rot [ (function-word) swap ] 2keep drop + { return>> parameters>> } get-slots + [ [ com-invoke ] 3curry ] keep + length [ npick ] curry swap compose + define ; + +: define-words-for-com-interface ( definition -- ) + [ [ (iid-word) ] [ iid>> 1quotation ] bi define ] + [ + dup all-functions + [ (define-word-for-function) ] with each-index + ] + bi ; PRIVATE> : COM-INTERFACE: scan - parse-inheritance - ";" parse-tokens { ")" } split - [ + scan find-com-interface-definition + scan string>guid + parse-com-functions + + dup save-com-interface-definition + define-words-for-com-interface ; parsing From ede3e068a072f259502578b5f21b5dfde8702680 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 18 Mar 2008 22:56:54 -0700 Subject: [PATCH 6/7] Get COM interface working. Add IShellFolder interface to shell32.dll to play around with --- extra/windows/com/authors.txt | 1 + extra/windows/com/com-docs.factor | 15 ++++ extra/windows/com/com-tests.factor | 88 ++++++++++--------- extra/windows/com/com.factor | 13 ++- extra/windows/com/summary.txt | 1 + extra/windows/com/syntax/authors.txt | 1 + extra/windows/com/syntax/summary.txt | 1 + extra/windows/com/syntax/syntax-docs.factor | 26 ++++++ extra/windows/com/syntax/syntax.factor | 27 ++++-- extra/windows/com/syntax/tags.txt | 3 + extra/windows/com/tags.txt | 3 + extra/windows/ole32/authors.txt | 1 + extra/windows/ole32/ole32.factor | 16 ++++ extra/windows/shell32/shell32.factor | 97 ++++++++++++++++++++- 14 files changed, 238 insertions(+), 55 deletions(-) create mode 100755 extra/windows/com/authors.txt create mode 100755 extra/windows/com/com-docs.factor create mode 100755 extra/windows/com/summary.txt create mode 100755 extra/windows/com/syntax/authors.txt create mode 100755 extra/windows/com/syntax/summary.txt create mode 100755 extra/windows/com/syntax/syntax-docs.factor create mode 100755 extra/windows/com/syntax/tags.txt create mode 100755 extra/windows/com/tags.txt create mode 100755 extra/windows/ole32/authors.txt diff --git a/extra/windows/com/authors.txt b/extra/windows/com/authors.txt new file mode 100755 index 0000000000..6a1b3e726a --- /dev/null +++ b/extra/windows/com/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/windows/com/com-docs.factor b/extra/windows/com/com-docs.factor new file mode 100755 index 0000000000..901a88675f --- /dev/null +++ b/extra/windows/com/com-docs.factor @@ -0,0 +1,15 @@ +USING: help.markup help.syntax io kernel math quotations +multiline ; +IN: windows.com + +HELP: com-query-interface +{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } { "iid" "An interface GUID (IID)" } { "interface'" "Pointer to a COM interface implementing the interface indicated by " { $snippet "iid" } } } +{ $description "A small wrapper around " { $link IUnknown::QueryInterface } ". Queries " { $snippet "interface" } " to see if it implements the interface indicated by " { $snippet "iid" } ". Returns a pointer to the " { $snippet "iid" } " interface if implemented, or raises an error if the object does not implement the interface.\n\nCOM memory management conventions state that the returned pointer must be immediately retained using " { $link com-add-ref } ". The pointer must then be released using " { $link com-release } " when it is no longer needed." } ; + +HELP: com-add-ref +{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } } +{ $description "A small wrapper around " { $link IUnknown::AddRef } ". Increments the reference count on " { $snippet "interface" } ", keeping it on the stack. The reference count must be decremented with " { $link com-release } " when the reference is no longer held." } ; + +HELP: com-release +{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } } +{ $description "A small wrapper around " { $link IUnknown::Release } ". Decrements the reference count on " { $snippet "interface" } ", releasing the underlying object if the reference count has reached zero." } ; diff --git a/extra/windows/com/com-tests.factor b/extra/windows/com/com-tests.factor index 2e6e8a9c22..4a2f465fef 100755 --- a/extra/windows/com/com-tests.factor +++ b/extra/windows/com/com-tests.factor @@ -1,5 +1,6 @@ USING: kernel windows.com windows.com.syntax windows.ole32 -alien alien.syntax tools.test libc ; +alien alien.syntax tools.test libc alien.c-types arrays.lib +namespaces arrays continuations ; IN: windows.com.tests ! Create some test COM interfaces @@ -9,13 +10,17 @@ COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} HRESULT returnError ( ) ; COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} - int getX ( ) ; + int getX ( ) void setX ( int newX ) ; ! Implement the IInherited interface in factor using alien-callbacks +C-STRUCT: test-implementation + { "void*" "vtbl" } + { "int" "x" } ; + : QueryInterface-callback - "HRESULT" { "void*" "REFGUID" "void**" } "stdcall" [ nip 0 -rot set-void*-nth ] + "HRESULT" { "void*" "REFGUID" "void**" } "stdcall" [ nip 0 swap set-void*-nth S_OK ] alien-callback ; : AddRef-callback "ULONG" { "void*" } "stdcall" [ drop 2 ] @@ -24,33 +29,20 @@ COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} "ULONG" { "void*" } "stdcall" [ drop 1 ] alien-callback ; : returnOK-callback - "HRESULT"{ "void*" } "stdcall" [ drop S_OK ] + "HRESULT" { "void*" } "stdcall" [ drop S_OK ] alien-callback ; : returnError-callback - "HRESULT"{ "void*" } "stdcall" [ drop E_FAIL ] + "HRESULT" { "void*" } "stdcall" [ drop E_FAIL ] alien-callback ; : getX-callback - "int" { "void*" } "stdcall" [ test-interface-x ] + "int" { "void*" } "stdcall" [ test-implementation-x ] alien-callback ; : setX-callback - "void" { "void*" "int" } "stdcall" [ swap set-test-interface-x ] + "void" { "void*" "int" } "stdcall" [ swap set-test-implementation-x ] alien-callback ; SYMBOL: +test-implementation-vtbl+ -{ - QueryInterface-callback - AddRef-callback - Release-callback - returnOK-callback - returnError-callback - getX-callback - setX-callback -} [ execute ] map >c-void*-array -+test-implementation-vtbl+ set - -C-STRUCT: test-implementation - { "void*" "vtbl" } - { "int" "x" } ; +SYMBOL: +guinea-pig-implementation+ : (make-test-implementation) ( x imp -- imp ) [ set-test-implementation-x ] keep @@ -59,29 +51,43 @@ C-STRUCT: test-implementation : ( x -- imp ) "test-implementation" (make-test-implementation) ; -! Test that the words defined by COM-INTERFACE: do their magic - -"{216fb341-0eb2-44b1-8edb-60b76e353abc}" string>guid 1array [ ISimple-iid ] unit-test -"{9620ecec-8438-423b-bb14-86f835aa40dd}" string>guid 1array [ IInherited-iid ] unit-test -"{00000000-0000-0000-C000-000000000046}" string>guid 1array [ IUnknown-iid ] unit-test -S_OK 1array [ 0 ISimple::returnOK ] unit-test -E_FAIL 1array [ 0 ISimple::returnError ] unit-test -1984 1array [ 0 dup 1984 IInherited::setX IInherited::getX ] unit-test - -! Test that the helper functions for QueryInterface, AddRef, Release work - : ( x -- imp ) "test-implementation" heap-size malloc (make-test-implementation) ; -SYMBOL: +guinea-pig-implementation+ +QueryInterface-callback +AddRef-callback +Release-callback +returnOK-callback +returnError-callback +getX-callback +setX-callback +7 narray >c-void*-array +dup byte-length [ + [ byte-array>memory ] keep + +test-implementation-vtbl+ set -0 +guinea-pig-implementation+ set -[ - +guinea-pig-implementation+ get 1array [ - +guinea-pig-implementation+ get IUnknown-iid com-query-interface - ] unit-test + ! Test that the words defined by COM-INTERFACE: do their magic - { } [ +guinea-pig-implementation+ get com-add-ref ] unit-test - { } [ +guinea-pig-implementation+ get com-release ] unit-test -] [ +guinea-pig-implementation+ get free ] [ ] cleanup + "{216fb341-0eb2-44b1-8edb-60b76e353abc}" string>guid 1array [ ISimple-iid ] unit-test + "{9620ecec-8438-423b-bb14-86f835aa40dd}" string>guid 1array [ IInherited-iid ] unit-test + "{00000000-0000-0000-C000-000000000046}" string>guid 1array [ IUnknown-iid ] unit-test + S_OK 1array [ 0 ISimple::returnOK ] unit-test + E_FAIL *long 1array [ 0 ISimple::returnError ] unit-test + 1984 1array [ 0 dup 1984 IInherited::setX IInherited::getX ] unit-test + ! Test that the helper functions for QueryInterface, AddRef, Release work + + 0 +guinea-pig-implementation+ set + [ + +guinea-pig-implementation+ get 1array [ + +guinea-pig-implementation+ get com-add-ref + ] unit-test + + { } [ +guinea-pig-implementation+ get com-release ] unit-test + + +guinea-pig-implementation+ get 1array [ + +guinea-pig-implementation+ get IUnknown-iid com-query-interface + ] unit-test + + ] [ +guinea-pig-implementation+ get free ] [ ] cleanup +] with-malloc diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor index 477eaad038..b78d9b5b91 100755 --- a/extra/windows/com/com.factor +++ b/extra/windows/com/com.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types windows.com.syntax windows.ole32 -windows.types continuations ; +windows.types continuations kernel ; IN: windows.com COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} @@ -8,10 +8,15 @@ COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} ULONG Release ( ) ; : com-query-interface ( interface iid -- interface' ) - f [ IUnknown::QueryInterface ] keep *void* ; + f + [ IUnknown::QueryInterface ole32-error ] keep + *void* ; -: com-add-ref ( interface -- ) - IUnknown::AddRef drop ; inline +: com-add-ref ( interface -- interface ) + [ IUnknown::AddRef drop ] keep ; inline : com-release ( interface -- ) IUnknown::Release drop ; inline + +: with-com-interface ( interface quot -- ) + [ keep ] [ com-release ] [ ] cleanup ; inline diff --git a/extra/windows/com/summary.txt b/extra/windows/com/summary.txt new file mode 100755 index 0000000000..779367e673 --- /dev/null +++ b/extra/windows/com/summary.txt @@ -0,0 +1 @@ +COM interface diff --git a/extra/windows/com/syntax/authors.txt b/extra/windows/com/syntax/authors.txt new file mode 100755 index 0000000000..6a1b3e726a --- /dev/null +++ b/extra/windows/com/syntax/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/windows/com/syntax/summary.txt b/extra/windows/com/syntax/summary.txt new file mode 100755 index 0000000000..6c2977a108 --- /dev/null +++ b/extra/windows/com/syntax/summary.txt @@ -0,0 +1 @@ +Parsing words for defining COM interfaces diff --git a/extra/windows/com/syntax/syntax-docs.factor b/extra/windows/com/syntax/syntax-docs.factor new file mode 100755 index 0000000000..fa06d5e4e7 --- /dev/null +++ b/extra/windows/com/syntax/syntax-docs.factor @@ -0,0 +1,26 @@ +USING: help.markup help.syntax io kernel math quotations +multiline ; +IN: windows.com.syntax + +HELP: COM-INTERFACE: +{ $syntax <" +COM-INTERFACE: + ( ) + ( ) + ... ; +"> } +{ $description "\nFor the interface " { $snippet "" } ", a word " { $snippet "-iid ( -- iid )" } " is defined to push the interface GUID (IID) onto the stack. Words of the form " { $snippet "::" } " are also defined to invoke each method, as well as the methods inherited from " { $snippet "" } ". A " { $snippet "" } " of " { $snippet "f" } " indicates that the interface is a root interface. (Note that COM conventions demand that all interfaces at least inherit from " { $snippet "IUnknown" } ".)\n\nExample:" } +{ $code <" +COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} + HRESULT QueryInterface ( REFGUID iid, void** ppvObject ) + ULONG AddRef ( ) + ULONG Release ( ) ; + +COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} + HRESULT returnOK ( ) + HRESULT returnError ( ) ; + +COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} + int getX ( ) + void setX ( int newX ) ; +"> } ; diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index 9068d75d16..32e7433d88 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -1,15 +1,21 @@ USING: alien alien.c-types kernel windows.ole32 combinators.lib parser splitting sequences.lib sequences namespaces new-slots combinators.cleave -assocs quotations shuffle ; +assocs quotations shuffle accessors words macros +alien.syntax fry ; IN: windows.com.syntax com-interface-definition @@ -18,7 +24,9 @@ TUPLE: com-function-definition name return parameters ; C: com-function-definition SYMBOL: +com-interface-definitions+ -H{ } +com-interface-definitions+ set-global ++com-interface-definitions+ get-global +[ H{ } +com-interface-definitions+ set-global ] +unless : find-com-interface-definition ( name -- definition ) dup "f" = [ drop f ] [ @@ -40,6 +48,7 @@ H{ } +com-interface-definitions+ set-global : parse-com-functions ( -- functions ) ";" parse-tokens { ")" } split + [ empty? not ] subset [ (parse-com-function) ] map ; : (iid-word) ( definition -- word ) @@ -55,17 +64,17 @@ H{ } +com-interface-definitions+ set-global : (define-word-for-function) ( function interface n -- ) -rot [ (function-word) swap ] 2keep drop { return>> parameters>> } get-slots - [ [ com-invoke ] 3curry ] keep - length [ npick ] curry swap compose + [ com-invoke ] 3curry define ; : define-words-for-com-interface ( definition -- ) [ [ (iid-word) ] [ iid>> 1quotation ] bi define ] + [ name>> "com-interface" swap typedef ] [ dup all-functions [ (define-word-for-function) ] with each-index ] - bi ; + tri ; PRIVATE> diff --git a/extra/windows/com/syntax/tags.txt b/extra/windows/com/syntax/tags.txt new file mode 100755 index 0000000000..49139bab66 --- /dev/null +++ b/extra/windows/com/syntax/tags.txt @@ -0,0 +1,3 @@ +windows +com +bindings diff --git a/extra/windows/com/tags.txt b/extra/windows/com/tags.txt new file mode 100755 index 0000000000..49139bab66 --- /dev/null +++ b/extra/windows/com/tags.txt @@ -0,0 +1,3 @@ +windows +com +bindings diff --git a/extra/windows/ole32/authors.txt b/extra/windows/ole32/authors.txt new file mode 100755 index 0000000000..6a1b3e726a --- /dev/null +++ b/extra/windows/ole32/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/windows/ole32/ole32.factor b/extra/windows/ole32/ole32.factor index ec0b02bc3f..44ea853af0 100755 --- a/extra/windows/ole32/ole32.factor +++ b/extra/windows/ole32/ole32.factor @@ -13,6 +13,10 @@ C-STRUCT: GUID TYPEDEF: void* REFGUID TYPEDEF: void* LPUNKNOWN TYPEDEF: ushort* LPOLESTR +TYPEDEF: ushort* LPCOLESTR + +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 ) ; @@ -24,6 +28,18 @@ FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ; : E_FAIL HEX: 80004005 ; inline : E_INVALIDARG HEX: 80070057 ; inline +: MK_ALT HEX: 20 ; inline +: DROPEFFECT_NONE 0 ; inline +: DROPEFFECT_COPY 1 ; inline +: DROPEFFECT_MOVE 2 ; inline +: DROPEFFECT_LINK 4 ; inline +: DROPEFFECT_SCROLL HEX: 80000000 ; inline +: DD_DEFSCROLLINSET 11 ; inline +: DD_DEFSCROLLDELAY 50 ; inline +: DD_DEFSCROLLINTERVAL 50 ; inline +: DD_DEFDRAGDELAY 200 ; inline +: DD_DEFDRAGMINDIST 2 ; inline + : ole32-error ( n -- ) dup S_OK = [ drop diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index 1d8d67dad7..e32b2dc058 100755 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -1,5 +1,6 @@ USING: alien alien.c-types alien.syntax combinators -kernel windows windows.user32 windows.ole32 ; +kernel windows windows.user32 windows.ole32 +windows.com windows.com.syntax ; IN: windows.shell32 : CSIDL_DESKTOP HEX: 00 ; inline @@ -118,3 +119,97 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi : program-files-common-x86 ( -- str ) CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ; + +: SHCONTF_FOLDERS 32 ; inline +: SHCONTF_NONFOLDERS 64 ; inline +: SHCONTF_INCLUDEHIDDEN 128 ; inline +: SHCONTF_INIT_ON_FIRST_NEXT 256 ; inline +: SHCONTF_NETPRINTERSRCH 512 ; inline +: SHCONTF_SHAREABLE 1024 ; inline +: SHCONTF_STORAGE 2048 ; inline + +TYPEDEF: DWORD SHCONTF + +: SHGDN_NORMAL 0 ; inline +: SHGDN_INFOLDER 1 ; inline +: SHGDN_FOREDITING HEX: 1000 ; inline +: SHGDN_INCLUDE_NONFILESYS HEX: 2000 ; inline +: SHGDN_FORADDRESSBAR HEX: 4000 ; inline +: SHGDN_FORPARSING HEX: 8000 ; inline + +TYPEDEF: DWORD SHGDNF + +: SFGAO_CANCOPY DROPEFFECT_COPY ; inline +: SFGAO_CANMOVE DROPEFFECT_MOVE ; inline +: SFGAO_CANLINK DROPEFFECT_LINK ; inline +: SFGAO_CANRENAME HEX: 00000010 ; inline +: SFGAO_CANDELETE HEX: 00000020 ; inline +: SFGAO_HASPROPSHEET HEX: 00000040 ; inline +: SFGAO_DROPTARGET HEX: 00000100 ; inline +: SFGAO_CAPABILITYMASK HEX: 00000177 ; inline +: SFGAO_LINK HEX: 00010000 ; inline +: SFGAO_SHARE HEX: 00020000 ; inline +: SFGAO_READONLY HEX: 00040000 ; inline +: SFGAO_GHOSTED HEX: 00080000 ; inline +: SFGAO_HIDDEN HEX: 00080000 ; inline +: SFGAO_DISPLAYATTRMASK HEX: 000F0000 ; inline +: SFGAO_FILESYSANCESTOR HEX: 10000000 ; inline +: SFGAO_FOLDER HEX: 20000000 ; inline +: SFGAO_FILESYSTEM HEX: 40000000 ; inline +: SFGAO_HASSUBFOLDER HEX: 80000000 ; inline +: SFGAO_CONTENTSMASK HEX: 80000000 ; inline +: SFGAO_VALIDATE HEX: 01000000 ; inline +: SFGAO_REMOVABLE HEX: 02000000 ; inline +: SFGAO_COMPRESSED HEX: 04000000 ; inline +: SFGAO_BROWSABLE HEX: 08000000 ; inline +: SFGAO_NONENUMERATED HEX: 00100000 ; inline +: SFGAO_NEWCONTENT HEX: 00200000 ; inline + +TYPEDEF: ULONG SFGAOF + +C-STRUCT: SHITEMID + { "USHORT" "cb" } + { "BYTE[1]" "abID" } ; +TYPEDEF: SHITEMID* LPSHITEMID +TYPEDEF: SHITEMID* LPCSHITEMID + +C-STRUCT: ITEMIDLIST + { "SHITEMID" "mkid" } ; +TYPEDEF: ITEMIDLIST* LPITEMIDLIST +TYPEDEF: ITEMIDLIST* LPCITEMIDLIST +TYPEDEF: ITEMIDLIST ITEMID_CHILD +TYPEDEF: ITEMID_CHILD* PITEMID_CHILD +TYPEDEF: ITEMID_CHILD* PCUITEMID_CHILD + +: STRRET_WSTR 0 ; inline +: STRRET_OFFSET 1 ; inline +: STRRET_CSTR 2 ; inline + +C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ; +C-STRUCT: STRRET + { "int" "uType" } + { "STRRET-union" "union" } ; + +COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046} + HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched ) + HRESULT Skip ( ULONG celt ) + HRESULT Reset ( ) + HRESULT Clone ( IEnumIDList** ppenum ) ; + +COM-INTERFACE: IShellFolder IUnknown {000214E6-0000-0000-C000-000000000046} + HRESULT ParseDisplayName ( HWND hwndOwner, void* pbcReserved, LPOLESTR lpszDisplayName, ULONG* pchEaten, LPITEMIDLIST* ppidl, ULONG* pdwAttributes ) + HRESULT EnumObjects ( HWND hwndOwner, SHCONTF grfFlags, IEnumIDList** ppenumIDList ) + HRESULT BindToObject ( LPCITEMIDLIST pidl, void* pbcReserved, REFGUID riid, void** ppvOut ) + HRESULT BindToStorage ( LPCITEMIDLIST pidl, void* pbcReserved, REFGUID riid, void** ppvObj ) + HRESULT CompareIDs ( LPARAM lParam, LPCITEMIDLIST pidl1, LPCITEMIDLIST pidl2 ) + HRESULT CreateViewObject ( HWND hwndOwner, REFGUID riid, void** ppvOut ) + HRESULT GetAttributesOf ( UINT cidl, LPCITEMIDLIST* apidl, SFGAOF* rgfInOut + ) + HRESULT GetUIObjectOf ( HWND hwndOwner, UINT cidl, LPCITEMIDLIST* apidl, REFGUID riid, UINT* prgfInOut, void** ppvOut ) + HRESULT GetDisplayNameOf ( LPCITEMIDLIST pidl, SHGDNF uFlags, STRRET* lpName ) + HRESULT SetNameOf ( HWND hwnd, LPCITEMIDLIST pidl, LPCOLESTR lpszName, SHGDNF uFlags, LPITEMIDLIST* ppidlOut ) ; + +FUNCTION: HRESULT SHGetDesktopFolder ( IShellFolder** ppshf ) ; + +FUNCTION: HRESULT StrRetToBufW ( STRRET *pstr, PCUITEMID_CHILD pidl, LPWSTR pszBuf, UINT cchBuf ) ; +: StrRetToBuf StrRetToBufW ; inline From 46c21e2580036c81f6d96954f53fb6fd9867997b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 18 Mar 2008 23:02:21 -0700 Subject: [PATCH 7/7] Correct perms on windows/ tree --- extra/windows/advapi32/advapi32.factor | 0 extra/windows/advapi32/authors.txt | 0 extra/windows/ce/authors.txt | 0 extra/windows/ce/ce.factor | 0 extra/windows/com/authors.txt | 0 extra/windows/com/com-docs.factor | 0 extra/windows/com/com-tests.factor | 0 extra/windows/com/com.factor | 0 extra/windows/com/summary.txt | 0 extra/windows/com/syntax/authors.txt | 0 extra/windows/com/syntax/summary.txt | 0 extra/windows/com/syntax/syntax-docs.factor | 0 extra/windows/com/syntax/syntax.factor | 0 extra/windows/com/syntax/tags.txt | 0 extra/windows/com/tags.txt | 0 extra/windows/errors/authors.txt | 0 extra/windows/errors/errors.factor | 0 extra/windows/gdi32/authors.txt | 0 extra/windows/kernel32/authors.txt | 0 extra/windows/kernel32/kernel32.factor | 0 extra/windows/messages/authors.txt | 0 extra/windows/messages/messages.factor | 0 extra/windows/nt/authors.txt | 0 extra/windows/nt/nt.factor | 0 extra/windows/ole32/authors.txt | 0 extra/windows/ole32/ole32.factor | 0 extra/windows/opengl32/authors.txt | 0 extra/windows/opengl32/opengl32.factor | 0 extra/windows/shell32/authors.txt | 0 extra/windows/shell32/shell32.factor | 3 +-- extra/windows/time/authors.txt | 0 extra/windows/time/time-tests.factor | 0 extra/windows/time/time.factor | 0 extra/windows/types/authors.txt | 0 extra/windows/user32/authors.txt | 0 extra/windows/user32/user32.factor | 0 extra/windows/windows.factor | 0 extra/windows/winsock/authors.txt | 0 extra/windows/winsock/winsock.factor | 0 39 files changed, 1 insertion(+), 2 deletions(-) mode change 100755 => 100644 extra/windows/advapi32/advapi32.factor mode change 100755 => 100644 extra/windows/advapi32/authors.txt mode change 100755 => 100644 extra/windows/ce/authors.txt mode change 100755 => 100644 extra/windows/ce/ce.factor mode change 100755 => 100644 extra/windows/com/authors.txt mode change 100755 => 100644 extra/windows/com/com-docs.factor mode change 100755 => 100644 extra/windows/com/com-tests.factor mode change 100755 => 100644 extra/windows/com/com.factor mode change 100755 => 100644 extra/windows/com/summary.txt mode change 100755 => 100644 extra/windows/com/syntax/authors.txt mode change 100755 => 100644 extra/windows/com/syntax/summary.txt mode change 100755 => 100644 extra/windows/com/syntax/syntax-docs.factor mode change 100755 => 100644 extra/windows/com/syntax/syntax.factor mode change 100755 => 100644 extra/windows/com/syntax/tags.txt mode change 100755 => 100644 extra/windows/com/tags.txt mode change 100755 => 100644 extra/windows/errors/authors.txt mode change 100755 => 100644 extra/windows/errors/errors.factor mode change 100755 => 100644 extra/windows/gdi32/authors.txt mode change 100755 => 100644 extra/windows/kernel32/authors.txt mode change 100755 => 100644 extra/windows/kernel32/kernel32.factor mode change 100755 => 100644 extra/windows/messages/authors.txt mode change 100755 => 100644 extra/windows/messages/messages.factor mode change 100755 => 100644 extra/windows/nt/authors.txt mode change 100755 => 100644 extra/windows/nt/nt.factor mode change 100755 => 100644 extra/windows/ole32/authors.txt mode change 100755 => 100644 extra/windows/ole32/ole32.factor mode change 100755 => 100644 extra/windows/opengl32/authors.txt mode change 100755 => 100644 extra/windows/opengl32/opengl32.factor mode change 100755 => 100644 extra/windows/shell32/authors.txt mode change 100755 => 100644 extra/windows/shell32/shell32.factor mode change 100755 => 100644 extra/windows/time/authors.txt mode change 100755 => 100644 extra/windows/time/time-tests.factor mode change 100755 => 100644 extra/windows/time/time.factor mode change 100755 => 100644 extra/windows/types/authors.txt mode change 100755 => 100644 extra/windows/user32/authors.txt mode change 100755 => 100644 extra/windows/user32/user32.factor mode change 100755 => 100644 extra/windows/windows.factor mode change 100755 => 100644 extra/windows/winsock/authors.txt mode change 100755 => 100644 extra/windows/winsock/winsock.factor diff --git a/extra/windows/advapi32/advapi32.factor b/extra/windows/advapi32/advapi32.factor old mode 100755 new mode 100644 diff --git a/extra/windows/advapi32/authors.txt b/extra/windows/advapi32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/ce/authors.txt b/extra/windows/ce/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/ce/ce.factor b/extra/windows/ce/ce.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/authors.txt b/extra/windows/com/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/com/com-docs.factor b/extra/windows/com/com-docs.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/com-tests.factor b/extra/windows/com/com-tests.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/summary.txt b/extra/windows/com/summary.txt old mode 100755 new mode 100644 diff --git a/extra/windows/com/syntax/authors.txt b/extra/windows/com/syntax/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/com/syntax/summary.txt b/extra/windows/com/syntax/summary.txt old mode 100755 new mode 100644 diff --git a/extra/windows/com/syntax/syntax-docs.factor b/extra/windows/com/syntax/syntax-docs.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/extra/windows/com/syntax/tags.txt b/extra/windows/com/syntax/tags.txt old mode 100755 new mode 100644 diff --git a/extra/windows/com/tags.txt b/extra/windows/com/tags.txt old mode 100755 new mode 100644 diff --git a/extra/windows/errors/authors.txt b/extra/windows/errors/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/errors/errors.factor b/extra/windows/errors/errors.factor old mode 100755 new mode 100644 diff --git a/extra/windows/gdi32/authors.txt b/extra/windows/gdi32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/kernel32/authors.txt b/extra/windows/kernel32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor old mode 100755 new mode 100644 diff --git a/extra/windows/messages/authors.txt b/extra/windows/messages/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/messages/messages.factor b/extra/windows/messages/messages.factor old mode 100755 new mode 100644 diff --git a/extra/windows/nt/authors.txt b/extra/windows/nt/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/nt/nt.factor b/extra/windows/nt/nt.factor old mode 100755 new mode 100644 diff --git a/extra/windows/ole32/authors.txt b/extra/windows/ole32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/ole32/ole32.factor b/extra/windows/ole32/ole32.factor old mode 100755 new mode 100644 diff --git a/extra/windows/opengl32/authors.txt b/extra/windows/opengl32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/opengl32/opengl32.factor b/extra/windows/opengl32/opengl32.factor old mode 100755 new mode 100644 diff --git a/extra/windows/shell32/authors.txt b/extra/windows/shell32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor old mode 100755 new mode 100644 index e32b2dc058..d64fb68cb3 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -203,8 +203,7 @@ COM-INTERFACE: IShellFolder IUnknown {000214E6-0000-0000-C000-000000000046} HRESULT BindToStorage ( LPCITEMIDLIST pidl, void* pbcReserved, REFGUID riid, void** ppvObj ) HRESULT CompareIDs ( LPARAM lParam, LPCITEMIDLIST pidl1, LPCITEMIDLIST pidl2 ) HRESULT CreateViewObject ( HWND hwndOwner, REFGUID riid, void** ppvOut ) - HRESULT GetAttributesOf ( UINT cidl, LPCITEMIDLIST* apidl, SFGAOF* rgfInOut - ) + HRESULT GetAttributesOf ( UINT cidl, LPCITEMIDLIST* apidl, SFGAOF* rgfInOut ) HRESULT GetUIObjectOf ( HWND hwndOwner, UINT cidl, LPCITEMIDLIST* apidl, REFGUID riid, UINT* prgfInOut, void** ppvOut ) HRESULT GetDisplayNameOf ( LPCITEMIDLIST pidl, SHGDNF uFlags, STRRET* lpName ) HRESULT SetNameOf ( HWND hwnd, LPCITEMIDLIST pidl, LPCOLESTR lpszName, SHGDNF uFlags, LPITEMIDLIST* ppidlOut ) ; diff --git a/extra/windows/time/authors.txt b/extra/windows/time/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/time/time-tests.factor b/extra/windows/time/time-tests.factor old mode 100755 new mode 100644 diff --git a/extra/windows/time/time.factor b/extra/windows/time/time.factor old mode 100755 new mode 100644 diff --git a/extra/windows/types/authors.txt b/extra/windows/types/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/user32/authors.txt b/extra/windows/user32/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor old mode 100755 new mode 100644 diff --git a/extra/windows/windows.factor b/extra/windows/windows.factor old mode 100755 new mode 100644 diff --git a/extra/windows/winsock/authors.txt b/extra/windows/winsock/authors.txt old mode 100755 new mode 100644 diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor old mode 100755 new mode 100644