]> gitweb.factorcode.org Git - factor.git/commitdiff
windows.shell32: Throw an error if file does not exist on file-executable?
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 25 Oct 2012 00:47:30 +0000 (17:47 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 25 Oct 2012 00:48:42 +0000 (17:48 -0700)
call.

basis/windows/shell32/shell32.factor

index bf2076953d3475b3c4e322d6ee3205e0e5f2e78c..68ec7359790c85c03f004fb50b252ec010c38e85 100644 (file)
@@ -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 ;
+windows.user32 io.files.info ;
 SPECIALIZED-ARRAY: ushort
 IN: windows.shell32
 
@@ -141,26 +141,31 @@ 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
+    normalize-path dup
     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
+    0 SHGFI_EXETYPE SHGetFileInfoW
+    [
+        file-info drop f
     ] [
-        {
-            { 0x454C [ +win32-vxd-executable+ ] }
-            { 0x454E [ +win32-os2-executable+ ] }
-            { 0x4550 [ +win32-nt-executable+ ] }
-            [ drop f ]
-        } case
-    ] if ;
+        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