From 0ae18456fd7ca10dded75f5ad05e47e100267fc4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 24 Oct 2012 16:15:28 -0700
Subject: [PATCH] windows.shell32: Add a way to find out the kind of executable
 of a file on windows. Inline a word.

---
 basis/ui/backend/windows/windows.factor |  2 +-
 basis/windows/shell32/shell32.factor    | 85 +++++++++++++++++++++++--
 2 files changed, 82 insertions(+), 5 deletions(-)

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 4ca35bb5ae..edc52fe908 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -171,7 +171,7 @@ 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 ;
+: >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
 
diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor
index 6bb7dea69d..bf2076953d 100644
--- a/basis/windows/shell32/shell32.factor
+++ b/basis/windows/shell32/shell32.factor
@@ -1,9 +1,11 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.data alien.strings alien.syntax
-classes.struct combinators io.files io.pathnames kernel
-windows.errors windows.com windows.com.syntax windows.types
-windows.user32 windows.ole32 windows specialized-arrays ;
+USING: alien alien.c-types alien.data alien.strings
+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 ;
 SPECIALIZED-ARRAY: ushort
 IN: windows.shell32
 
@@ -86,6 +88,80 @@ ALIAS: SHGetFolderPath SHGetFolderPathW
 FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
 ALIAS: ShellExecute ShellExecuteW
 
+CONSTANT: SHGFI_ICON 0x000000100
+CONSTANT: SHGFI_DISPLAYNAME 0x000000200
+CONSTANT: SHGFI_TYPENAME 0x000000400
+CONSTANT: SHGFI_ATTRIBUTES 0x000000800
+CONSTANT: SHGFI_ICONLOCATION 0x000001000
+CONSTANT: SHGFI_EXETYPE 0x000002000
+CONSTANT: SHGFI_SYSICONINDEX 0x000004000
+CONSTANT: SHGFI_LINKOVERLAY 0x000008000
+CONSTANT: SHGFI_SELECTED 0x000010000
+CONSTANT: SHGFI_ATTR_SPECIFIED 0x000020000
+CONSTANT: SHGFI_LARGEICON 0x000000000
+CONSTANT: SHGFI_SMALLICON 0x000000001
+CONSTANT: SHGFI_OPENICON 0x000000002
+CONSTANT: SHGFI_SHELLICONSIZE 0x000000004
+CONSTANT: SHGFI_PIDL 0x000000008
+CONSTANT: SHGFI_USEFILEATTRIBUTES 0x000000010
+CONSTANT: SHGFI_ADDOVERLAYS 0x000000020
+CONSTANT: SHGFI_OVERLAYINDEX 0x000000040
+
+STRUCT: SHFILEINFO
+    { hIcon HICON }
+    { iIcon int }
+    { dwAttributes DWORD }
+    { szDisplayName TCHAR[MAX_PATH] }
+    { szTypeName TCHAR[80] } ;
+
+FUNCTION: DWORD_PTR SHGetFileInfoW (
+    LPCTSTR pszPath,
+    DWORD dwFileAttributes,
+    SHFILEINFO *psfi,
+    UINT cbFileInfo,
+    UINT uFlags
+) ;
+
+: shell32-file-info ( path -- err struct )
+    normalize-path
+    0
+    SHFILEINFO <struct>
+    [ dup byte-length SHGFI_EXETYPE SHGetFileInfoW ] keep ;
+
+SINGLETONS:
+    +dos-executable+
+    +win32-console-executable+
+    +win32-vxd-executable+
+    +win32-os2-executable+
+    +win32-nt-executable+ ;
+
+MIXIN: windows-executable
+INSTANCE: +dos-executable+ windows-executable        ! mz
+INSTANCE: +win32-console-executable+ windows-executable
+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
+    0
+    f
+    ! hi is zero means old style executable
+    0 SHGFI_EXETYPE SHGetFileInfoW >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 ;
+
 : shell32-directory ( n -- str )
     f swap f SHGFP_TYPE_DEFAULT
     MAX_UNICODE_PATH ushort <c-array>
@@ -117,6 +193,7 @@ ALIAS: ShellExecute ShellExecuteW
 
 : program-files-common-x86 ( -- str )
     CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;
+    
 
 CONSTANT: SHCONTF_FOLDERS 32
 CONSTANT: SHCONTF_NONFOLDERS 64
-- 
2.34.1