Commit b1ae6a1b authored by batterseapower's avatar batterseapower
Browse files

Unicode: use wide APIs on Windows and withFilePath on GHC

parent 3922bde0
......@@ -40,12 +40,15 @@ import Foreign
#endif /* __GLASGOW_HASKELL__ */
#ifndef mingw32_HOST_OS
#if __GLASGOW_HASKELL__ >= 611
import System.Posix.Internals (withFilePath)
#else
import Foreign.C (withCString)
#endif
import System.Posix.Types
( FileMode )
import System.Posix.Internals
( c_chmod )
import Foreign.C
( withCString )
#if __GLASGOW_HASKELL__ >= 608
import Foreign.C
( throwErrnoPathIfMinus1_ )
......@@ -66,7 +69,11 @@ setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x
setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m =
#if __GLASGOW_HASKELL__ >= 611
withFilePath name $ \s -> do
#else
withCString name $ \s -> do
#endif
#if __GLASGOW_HASKELL__ >= 608
throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
#else
......
......@@ -192,21 +192,21 @@ pkgPathEnvVar pkg_descr var =
get_prefix_win32 :: String
get_prefix_win32 =
"getPrefixDirRel :: FilePath -> IO FilePath\n"++
"getPrefixDirRel dirRel = do \n"++
" let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
" buf <- mallocArray len\n"++
" ret <- getModuleFileName nullPtr buf len\n"++
" if ret == 0 \n"++
" then do free buf;\n"++
" return (prefix `joinFileName` dirRel)\n"++
" else do exePath <- peekCString buf\n"++
" free buf\n"++
" let (bindir,_) = splitFileName exePath\n"++
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
"getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n"++
" where\n"++
" try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n"++
" ret <- c_GetModuleFileName nullPtr buf size\n"++
" case ret of\n"++
" 0 -> return (prefix `joinFileName` dirRel)\n"++
" _ | ret < size -> do\n"++
" exePath <- peekCWString buf\n"++
" let (bindir,_) = splitFileName exePath\n"++
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
" | otherwise -> try_size (size * 2)\n"++
"\n"++
"foreign import stdcall unsafe \"windows.h GetModuleFileNameA\"\n"++
" getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"
"foreign import stdcall unsafe \"windows.h GetModuleFileNameW\"\n"++
" c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
get_prefix_hugs :: String
get_prefix_hugs =
......
......@@ -560,13 +560,13 @@ shGetFolderPath n =
# if __HUGS__
return Nothing
# else
allocaBytes long_path_size $ \pPath -> do
allocaArray long_path_size $ \pPath -> do
r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath
if (r /= 0)
then return Nothing
else do s <- peekCString pPath; return (Just s)
else do s <- peekCWString pPath; return (Just s)
where
long_path_size = 1024
long_path_size = 1024 -- MAX_PATH is 260, this should be plenty
# endif
csidl_PROGRAM_FILES :: CInt
......@@ -574,12 +574,12 @@ csidl_PROGRAM_FILES = 0x0026
-- csidl_PROGRAM_FILES_COMMON :: CInt
-- csidl_PROGRAM_FILES_COMMON = 0x002b
foreign import stdcall unsafe "shlobj.h SHGetFolderPathA"
foreign import stdcall unsafe "shlobj.h SHGetFolderPathW"
c_SHGetFolderPath :: Ptr ()
-> CInt
-> Ptr ()
-> CInt
-> CString
-> CWString
-> IO CInt
#endif
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment