windows: Attempt to fix circularity.
							parent
							
								
									12df557b11
								
							
						
					
					
						commit
						2921829b79
					
				| 
						 | 
				
			
			@ -96,6 +96,31 @@ M: windows file-info ( path -- info )
 | 
			
		|||
M: windows link-info ( path -- 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 + ]
 | 
			
		||||
 | 
			
		||||
: volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -169,9 +169,6 @@ M: windows-ui-backend (pixel-format-attribute)
 | 
			
		|||
 | 
			
		||||
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 )
 | 
			
		||||
    hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -5,7 +5,7 @@ alien.syntax classes.struct combinators io.backend io.files
 | 
			
		|||
io.pathnames kernel math sequences specialized-arrays
 | 
			
		||||
ui.backend.windows windows windows.com windows.com.syntax
 | 
			
		||||
windows.errors windows.kernel32 windows.ole32 windows.types
 | 
			
		||||
windows.user32 io.files.info ;
 | 
			
		||||
windows.user32 ;
 | 
			
		||||
SPECIALIZED-ARRAY: ushort
 | 
			
		||||
IN: windows.shell32
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -142,31 +142,6 @@ INSTANCE: +win32-vxd-executable+ windows-executable  ! le
 | 
			
		|||
INSTANCE: +win32-os2-executable+ windows-executable  ! ne
 | 
			
		||||
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 )
 | 
			
		||||
    f swap f SHGFP_TYPE_DEFAULT
 | 
			
		||||
    MAX_UNICODE_PATH ushort <c-array>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,8 @@
 | 
			
		|||
! Copyright (C) 2005, 2006 Doug Coleman.
 | 
			
		||||
! 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
 | 
			
		||||
 | 
			
		||||
CONSTANT: MAX_UNICODE_PATH 32768
 | 
			
		||||
| 
						 | 
				
			
			@ -23,3 +25,7 @@ CONSTANT: MAX_UNICODE_PATH 32768
 | 
			
		|||
    { "usp10"       "usp10.dll"          stdcall }
 | 
			
		||||
    { "psapi"       "psapi.dll"          stdcall }
 | 
			
		||||
} [ 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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue