Win32 2.1.0.0 → 2.2.0.0

raw patch · 15 files changed

+93/−23 lines, 15 filesdep ~basenew-uploader

Dependency ranges changed: base

Files

• Graphics/Win32/GDI/HDC.hs +3/−1
• Graphics/Win32/Window.hsc +2/−2
• System/Win32/NLS.hsc +40/−0
• System/Win32/Process.hsc +1/−6
• System/Win32/Registry.hsc +8/−3
• System/Win32/SimpleMAPI.hsc +11/−6
• System/Win32/Types.hs +14/−1
• Win32.cabal +3/−4
• cbits/diatemp.c +1/−0
• cbits/dumpBMP.c +1/−0
• cbits/ellipse.c +1/−0
• cbits/errors.c +1/−0
• include/HsGDI.h +5/−0
• include/HsWin32.h +1/−0
• include/WndProc.h +1/−0

@@ -248,8 +248,10 @@ selectRgn dc rgn =   withForeignPtr rgn $ \ p_rgn ->   failIf (== gDI_ERROR) "SelectRgn" $ c_SelectRgn dc p_rgn-foreign import stdcall unsafe "windows.h SelectObject"+foreign import ccall unsafe "windows.h SelectObjectInt"   c_SelectRgn :: HDC -> PRGN -> IO RegionType+-- avoid using SelectObject() at different types by calling our own+-- wrapper.  selectClipRgn :: HDC -> Maybe HRGN -> IO RegionType selectClipRgn dc mb_rgn =

@@ -87,7 +87,7 @@   #{poke WNDCLASS,lpszClassName} p cls   f p -foreign import ccall unsafe "WndProc.h &genericWndProc"+foreign import stdcall unsafe "WndProc.h &genericWndProc"   genericWndProc_p :: FunPtr WindowClosure  {-# CFILES cbits/WndProc.c #-}@@ -176,7 +176,7 @@  type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT -foreign import ccall "wrapper"+foreign import stdcall "wrapper"   mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure)  setWindowClosure :: HWND -> WindowClosure -> IO ()

@@ -24,6 +24,7 @@ import System.Win32.Types  import Foreign+import Foreign.C  #include <windows.h> #include "errors.h"@@ -336,3 +337,42 @@  }  -- , SUBLANG_LITHUANIAN_CLASSIC (not in mingw-20001111)++-- ----------------------------------------------------------------------------++-- | The `System.IO` input functions (e.g. `getLine`) don't+-- automatically convert to Unicode, so this function is provided to+-- make the conversion from a multibyte string in the given code page +-- to a proper Unicode string.  To get the code page for the console,+-- use `getConsoleCP`.++stringToUnicode :: CodePage -> String -> IO String+stringToUnicode _cp "" = return ""+     -- MultiByteToWideChar doesn't handle empty strings (#1929)+stringToUnicode cp mbstr =+  withCStringLen mbstr $ \(cstr,len) -> do+    wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar +                cp+                0+                cstr+                (fromIntegral len)+                nullPtr 0+    -- wchars is the length of buffer required+    allocaArray (fromIntegral wchars) $ \cwstr -> do+      wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar +                cp+                0+                cstr+                (fromIntegral len)+                cwstr wchars+      peekCWStringLen (cwstr,fromIntegral wchars)  -- converts UTF-16 to [Char]++foreign import stdcall unsafe "MultiByteToWideChar"+  multiByteToWideChar+        :: CodePage+        -> DWORD   -- dwFlags,+        -> LPCSTR  -- lpMultiByteStr+        -> CInt    -- cbMultiByte+        -> LPWSTR  -- lpWideCharStr+        -> CInt    -- cchWideChar+        -> IO CInt

@@ -103,22 +103,17 @@ -- | Enumerate processes using Process32First and Process32Next th32SnapEnumProcesses :: Th32SnapHandle -> IO [ProcessEntry32] th32SnapEnumProcesses h = allocaBytes (#size PROCESSENTRY32) $ \pe -> do-    putStrLn "1"     (#poke PROCESSENTRY32, dwSize) pe ((#size PROCESSENTRY32)::DWORD)-    putStrLn "2"     ok <- c_Process32First h pe-    putStrLn "3"     readAndNext ok pe []     where         readAndNext ok pe res             | not ok    = do                 err <- getLastError-                print err-                if err==(#const ERROR_NO_MORE_FILES)+                if err == (#const ERROR_NO_MORE_FILES)                     then return $ reverse res                     else failWith "th32SnapEnumProcesses: Process32First/Process32Next" err             | otherwise = do-                putStrLn "reading"                 entry <- peekProcessEntry32 pe                 ok' <- c_Process32Next h pe                 readAndNext ok' pe (entry:res)

@@ -162,11 +162,16 @@ foreign import stdcall unsafe "windows.h RegDeleteValueW"   c_RegDeleteValue :: PKEY -> LPCTSTR -> IO ErrCode +-- XXX Not 100% sure this is right, but I think it is.+-- Surely this function already exists somewhere?+mallocWideChars :: Int -> IO (Ptr a)+mallocWideChars i = mallocBytes (4 * i)+ regEnumKeys :: HKEY -> IO [String] regEnumKeys hkey = do    hinfo <- regQueryInfoKey hkey    let buflen = 1+max_subkey_len hinfo-   buf   <- mallocBytes (fromIntegral buflen)+   buf   <- mallocWideChars (fromIntegral buflen)    ls    <- go 0 buf buflen    free buf    return ls@@ -184,8 +189,8 @@    hinfo <- regQueryInfoKey hkey    let nmlen  = 1+max_value_name_len hinfo  -- add spc for terminating NUL.    let vallen = 1+max_value_len hinfo-   nmbuf  <- mallocBytes (fromIntegral nmlen)-   valbuf <- mallocBytes (fromIntegral vallen)+   nmbuf  <- mallocWideChars (fromIntegral nmlen)+   valbuf <- mallocWideChars (fromIntegral vallen)    ls     <- go 0 nmbuf nmlen valbuf vallen    free nmbuf    free valbuf

@@ -13,7 +13,8 @@ ----------------------------------------------------------------------------- module System.Win32.SimpleMAPI where-import Control.Exception    ( bracket, handle, throw, finally )+import Control.Exception    ( bracket, handle, throw, finally, onException+                            , IOException ) import Control.Monad        ( liftM5 ) import Foreign              ( FunPtr, newForeignPtr, pokeByteOff, maybeWith                             , Ptr, castPtr, castPtrToFunPtr, nullPtr@@ -147,9 +148,9 @@ loadMapiDll :: String -> IO (MapiFuncs, HMODULE) loadMapiDll dllname = do     dll <- loadLibrary dllname-    handle (\e -> freeLibrary dll >> throw e) $ do-        funcs <- loadMapiFuncs dllname dll-        return (funcs, dll)+    do funcs <- loadMapiFuncs dllname dll+       return (funcs, dll)+     `onException` freeLibrary dll  -- | withMapiFuncs :: [String] -> (MapiFuncs -> IO a) -> IO a@@ -157,7 +158,7 @@     where         loadOne l = case l of             []  -> fail $ "withMapiFuncs: Failed to load DLLs: " ++ show dlls-            x:y -> handle (const $ loadOne y) (loadMapiDll x)+            x:y -> handleIOException (const $ loadOne y) (loadMapiDll x)         load = loadOne dlls         free = freeLibrary . snd @@ -170,7 +171,7 @@     where         loadOne l = case l of             []  -> fail $ "loadMapi: Failed to load any of DLLs: " ++ show dlls-            x:y -> handle (const $ loadOne y) (loadMapiDll x)+            x:y -> handleIOException (const $ loadOne y) (loadMapiDll x)  -- | withMapiLoaded :: MapiLoaded -> (MapiFuncs -> IO a) -> IO a@@ -387,3 +388,7 @@ mapiSendMail :: MapiFuncs -> LHANDLE -> Maybe HWND -> Message -> MapiFlag -> IO () mapiSendMail f ses hwnd msg flag = withMessage f ses msg $ \msg ->     mapiFail_ "MAPISendMail" $ mapifSendMail f ses (maybeHWND hwnd) msg flag 0++handleIOException :: (IOException -> IO a) -> IO a -> IO a+handleIOException = handle+

@@ -21,6 +21,9 @@ import Foreign import Foreign.C import Numeric (showHex)+import Control.Exception+import System.IO.Error+import Data.Char  ---------------------------------------------------------------- -- Platform specific definitions@@ -202,7 +205,17 @@   c_msg <- getErrorMessage err_code   msg <- peekTString c_msg   localFree c_msg-  fail (fn_name ++ ": " ++ msg ++ " (error code: " ++ showHex err_code ")")+  c_maperrno -- turn GetLastError() into errno, which errnoToIOError knows+             -- how to convert to an IOException we can throw.+             -- XXX we should really do this directly.+  errno <- getErrno+  let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n+      ioerror = errnoToIOError fn_name errno Nothing Nothing+                  `ioeSetErrorString` msg'+  throw ioerror++foreign import ccall unsafe "maperrno" -- in base/cbits/Win32Utils.c+   c_maperrno :: IO ()  ---------------------------------------------------------------- -- Misc helpers

@@ -1,5 +1,5 @@ name:		Win32-version:	2.1.0.0+version:	2.2.0.0 license:	BSD3 license-file:	LICENSE author:		Alastair Reid@@ -7,12 +7,12 @@ maintainer:	Esa Ilari Vuokko <ei@vuokko.info> category:	System, Graphics synopsis:	A binding to part of the Win32 library-build-type: Configure+build-type:     Simple extra-source-files: 	include/diatemp.h include/dumpBMP.h include/ellipse.h include/errors.h 	include/gettime.h include/Win32Aux.h include/win32debug.h build-depends:	base, bytestring-ghc-options:    -O -fvia-C -Wall -fno-warn-name-shadowing+ghc-options:    -Wall -fno-warn-name-shadowing exposed-modules: 	Graphics.Win32.GDI, 	Graphics.Win32.GDI.Bitmap,@@ -65,4 +65,3 @@ 	cbits/dumpBMP.c, 	cbits/ellipse.c, 	cbits/errors.c-cc-options:	-DUNICODE

@@ -10,6 +10,7 @@  *  */ +#define UNICODE #include <windows.h> #include <wchar.h> #include <stdlib.h>

@@ -16,6 +16,7 @@ *       #include <windows.h> * \**************************************************************************/+#define UNICODE #include <windows.h> #include <stdio.h> #include "dumpBMP.h"

@@ -1,3 +1,4 @@+#define UNICODE #include <windows.h> #include <math.h> 

@@ -1,3 +1,4 @@+#define UNICODE #include <stdio.h> #include <stdlib.h> #include <windows.h>

@@ -1,6 +1,7 @@ #ifndef __HSGDI_H #define __HSGDI_H +#define UNICODE #include <windows.h>  #ifndef INLINE@@ -37,6 +38,10 @@ } INLINE HWND prim_ChildWindowFromPointEx(HWND parent, LPPOINT p_pt, UINT flags) {   return ChildWindowFromPointEx(parent, *p_pt, flags);+}++INLINE INT SelectObjectInt(HANDLE h) {+    return DeleteObject(h); }  #endif /* __HSGDI_H */

@@ -1,6 +1,7 @@ #ifndef __HSWIN32_H #define __HSWIN32_H +#define UNICODE #include <windows.h>  #ifndef INLINE

@@ -1,6 +1,7 @@ #ifndef __WNDPROC_H #define __WNDPROC_H +#define UNICODE #include <windows.h>  extern LRESULT CALLBACK genericWndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);