steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

windows: Attempt to fix circularity.

db4
Doug Coleman 2012-10-24 19:02:59 -07:00
parent 12df557b11
commit 2921829b79
4 changed files with 33 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/io/files/info/windows/windows.factor
View File

@ -96,6 +96,31 @@ M: windows file-info ( path -- info )
M: windows link-info ( path -- info ) M: windows link-info ( path -- info )
file-info ; file-info ;
: file-executable-type ( path -- executable/f )
normalize-path dup
0
f
! hi is zero means old style executable
0 SHGFI_EXETYPE SHGetFileInfoW
[
file-info drop f
] [
nip >lo-hi first2 zero? [
{
{ 0x5A4D [ +dos-executable+ ] }
{ 0x4550 [ +win32-console-executable+ ] }
[ drop f ]
} case
] [
{
{ 0x454C [ +win32-vxd-executable+ ] }
{ 0x454E [ +win32-os2-executable+ ] }
{ 0x4550 [ +win32-nt-executable+ ] }
[ drop f ]
} case
] if
] if-zero ;
CONSTANT: path-length $[ MAX_PATH 1 + ] CONSTANT: path-length $[ MAX_PATH 1 + ]
: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) : volume-information ( normalized-path -- volume-name volume-serial max-component flags type )

3
basis/ui/backend/windows/windows.factor
View File

@ -169,9 +169,6 @@ M: windows-ui-backend (pixel-format-attribute)
PRIVATE> PRIVATE>
: lo-word ( wparam -- lo ) c:short <ref> c:short deref ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; inline
: GET_APPCOMMAND_LPARAM ( lParam -- appCommand ) : GET_APPCOMMAND_LPARAM ( lParam -- appCommand )
hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline

27
basis/windows/shell32/shell32.factor
View File

@ -5,7 +5,7 @@ alien.syntax classes.struct combinators io.backend io.files
io.pathnames kernel math sequences specialized-arrays io.pathnames kernel math sequences specialized-arrays
ui.backend.windows windows windows.com windows.com.syntax ui.backend.windows windows windows.com windows.com.syntax
windows.errors windows.kernel32 windows.ole32 windows.types windows.errors windows.kernel32 windows.ole32 windows.types
windows.user32 io.files.info ; windows.user32 ;
SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: ushort
IN: windows.shell32 IN: windows.shell32
@ -142,31 +142,6 @@ INSTANCE: +win32-vxd-executable+ windows-executable ! le
INSTANCE: +win32-os2-executable+ windows-executable ! ne INSTANCE: +win32-os2-executable+ windows-executable ! ne
INSTANCE: +win32-nt-executable+ windows-executable ! pe INSTANCE: +win32-nt-executable+ windows-executable ! pe
: file-executable-type ( path -- executable/f )
normalize-path dup
0
f
! hi is zero means old style executable
0 SHGFI_EXETYPE SHGetFileInfoW
[
file-info drop f
] [
nip >lo-hi first2 zero? [
{
{ 0x5A4D [ +dos-executable+ ] }
{ 0x4550 [ +win32-console-executable+ ] }
[ drop f ]
} case
] [
{
{ 0x454C [ +win32-vxd-executable+ ] }
{ 0x454E [ +win32-os2-executable+ ] }
{ 0x4550 [ +win32-nt-executable+ ] }
[ drop f ]
} case
] if
] if-zero ;
: shell32-directory ( n -- str ) : shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH ushort <c-array> MAX_UNICODE_PATH ushort <c-array>

8
basis/windows/windows.factor
View File

@ -1,6 +1,8 @@
! Copyright (C) 2005, 2006 Doug Coleman. ! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien sequences alien.libraries ; USING: alien alien.data alien.libraries arrays kernel math
sequences ;
QUALIFIED-WITH: alien.c-types c
IN: windows IN: windows
CONSTANT: MAX_UNICODE_PATH 32768 CONSTANT: MAX_UNICODE_PATH 32768
@ -23,3 +25,7 @@ CONSTANT: MAX_UNICODE_PATH 32768
{ "usp10" "usp10.dll" stdcall } { "usp10" "usp10.dll" stdcall }
{ "psapi" "psapi.dll" stdcall } { "psapi" "psapi.dll" stdcall }
} [ first3 add-library ] each } [ first3 add-library ] each
: lo-word ( wparam -- lo ) c:short <ref> c:short deref ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; inline