]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/shell32/shell32.factor
factor: Clean up wrong form of specialized-arrays in using lists.
[factor.git] / basis / windows / shell32 / shell32.factor
index 4f83de503f5b2085d39a39af5b526f847dce999a..864663bd40b6b8fc379c1fe08b45a5c7e9d5dcb9 100644 (file)
@@ -1,11 +1,8 @@
 ! 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.encodings.utf16n io.files
-io.pathnames kernel windows.errors windows.com
-windows.com.syntax windows.types windows.user32
-windows.ole32 windows specialized-arrays ;
-SPECIALIZED-ARRAY: ushort
+classes.struct io.backend kernel windows windows.com
+windows.com.syntax windows.kernel32 windows.ole32 windows.types ;
 IN: windows.shell32
 
 CONSTANT: CSIDL_DESKTOP 0x00
@@ -73,24 +70,81 @@ CONSTANT: CSIDL_FLAG_DONT_VERIFY 0x4000
 CONSTANT: CSIDL_FLAG_CREATE 0x8000
 CONSTANT: CSIDL_FLAG_MASK 0xff00
 
-
-CONSTANT: ERROR_FILE_NOT_FOUND 2
-
 CONSTANT: SHGFP_TYPE_CURRENT 0
 CONSTANT: SHGFP_TYPE_DEFAULT 1
 
 LIBRARY: shell32
 
-FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ;
+FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner,
+                                     int nFolder,
+                                     HANDLE hToken,
+                                     DWORD dwReserved,
+                                     LPTSTR pszPath )
 ALIAS: SHGetFolderPath SHGetFolderPathW
 
-FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
+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
+
 : shell32-directory ( n -- str )
     f swap f SHGFP_TYPE_DEFAULT
     MAX_UNICODE_PATH ushort <c-array>
-    [ SHGetFolderPath drop ] keep utf16n alien>string ;
+    [ SHGetFolderPath drop ] keep alien>native-string ;
 
 : desktop ( -- str )
     CSIDL_DESKTOPDIRECTORY shell32-directory ;
@@ -119,6 +173,7 @@ ALIAS: ShellExecute ShellExecuteW
 : program-files-common-x86 ( -- str )
     CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;
 
+
 CONSTANT: SHCONTF_FOLDERS 32
 CONSTANT: SHCONTF_NONFOLDERS 64
 CONSTANT: SHCONTF_INCLUDEHIDDEN 128
@@ -173,7 +228,6 @@ STRUCT: DROPFILES
     { fWide BOOL } ;
 TYPEDEF: DROPFILES* LPDROPFILES
 TYPEDEF: DROPFILES* LPCDROPFILES
-TYPEDEF: HANDLE HDROP
 
 STRUCT: SHITEMID
     { cb USHORT }
@@ -208,20 +262,59 @@ COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
     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: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ;
+    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: void DragAcceptFiles ( HWND hWnd, BOOL fAccept )
+
+FUNCTION: UINT DragQueryFileW ( HDROP hDrop,
+                                UINT iFile,
+                                LPWSTR lpszFile,
+                                UINT cch )
 ALIAS: DragQueryFile DragQueryFileW
 
-FUNCTION: BOOL IsUserAnAdmin ( ) ;
+FUNCTION: BOOL DragQueryPoint ( HDROP hDrop, POINT* lppt )
+
+FUNCTION: void DragFinish ( HDROP hDrop )
+
+FUNCTION: BOOL IsUserAnAdmin ( )