[commit: Win32] encoding: Attempt to fix lurking Unicode errors in Win32 (5e3ce77)
Max Bolingbroke
batterseapower at hotmail.com
Tue Apr 5 10:02:56 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Win32
On branch : encoding
http://hackage.haskell.org/trac/ghc/changeset/5e3ce77d290b8094debb21dbdbc24a492cc80880
>---------------------------------------------------------------
commit 5e3ce77d290b8094debb21dbdbc24a492cc80880
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date: Mon Apr 4 22:21:27 2011 +0100
Attempt to fix lurking Unicode errors in Win32
>---------------------------------------------------------------
Graphics/Win32/GDI/Bitmap.hsc | 4 ++--
System/Win32/DLL.hsc | 2 +-
System/Win32/NLS.hsc | 2 +-
System/Win32/SimpleMAPI.hsc | 32 +++++++++++++++++---------------
cbits/dumpBMP.c | 7 +++----
5 files changed, 24 insertions(+), 23 deletions(-)
diff --git a/Graphics/Win32/GDI/Bitmap.hsc b/Graphics/Win32/GDI/Bitmap.hsc
index 2d9bb59..6b07fc0 100644
--- a/Graphics/Win32/GDI/Bitmap.hsc
+++ b/Graphics/Win32/GDI/Bitmap.hsc
@@ -376,10 +376,10 @@ sizeofLPBITMAPFILEHEADER = #{size BITMAPFILEHEADER}
createBMPFile :: String -> HBITMAP -> HDC -> IO ()
createBMPFile name bm dc =
- withCString name $ \ c_name ->
+ withCWString name $ \ c_name ->
c_CreateBMPFile c_name bm dc
foreign import ccall unsafe "dumpBMP.h CreateBMPFile"
- c_CreateBMPFile :: LPCSTR -> HBITMAP -> HDC -> IO ()
+ c_CreateBMPFile :: LPCTSTR -> HBITMAP -> HDC -> IO ()
{-# CFILES cbits/dumpBMP.c #-}
diff --git a/System/Win32/DLL.hsc b/System/Win32/DLL.hsc
index 676ac32..2a431f6 100644
--- a/System/Win32/DLL.hsc
+++ b/System/Win32/DLL.hsc
@@ -54,7 +54,7 @@ foreign import stdcall unsafe "windows.h GetModuleHandleW"
getProcAddress :: HMODULE -> String -> IO Addr
getProcAddress hmod procname =
- withCString procname $ \ c_procname ->
+ withCAString procname $ \ c_procname ->
failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname
foreign import stdcall unsafe "windows.h GetProcAddress"
c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr
diff --git a/System/Win32/NLS.hsc b/System/Win32/NLS.hsc
index a06df83..20e9a0b 100644
--- a/System/Win32/NLS.hsc
+++ b/System/Win32/NLS.hsc
@@ -350,7 +350,7 @@ stringToUnicode :: CodePage -> String -> IO String
stringToUnicode _cp "" = return ""
-- MultiByteToWideChar doesn't handle empty strings (#1929)
stringToUnicode cp mbstr =
- withCStringLen mbstr $ \(cstr,len) -> do
+ withCAStringLen mbstr $ \(cstr,len) -> do
wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar
cp
0
diff --git a/System/Win32/SimpleMAPI.hsc b/System/Win32/SimpleMAPI.hsc
index 965061d..edc76ed 100644
--- a/System/Win32/SimpleMAPI.hsc
+++ b/System/Win32/SimpleMAPI.hsc
@@ -20,7 +20,9 @@ import Foreign ( FunPtr, newForeignPtr, pokeByteOff, maybeWith
, Ptr, castPtr, castPtrToFunPtr, nullPtr
, touchForeignPtr, alloca, peek, allocaBytes
, minusPtr, plusPtr, copyBytes, ForeignPtr )
-import Foreign.C ( withCString, withCStringLen )
+import Foreign.C ( withCAString, withCAStringLen )
+ -- Apparently, simple MAPI does not support unicode and probably never will,
+ -- so this module will just mangle any Unicode in your strings
import Graphics.Win32.GDI.Types ( HWND)
import System.Win32.DLL ( loadLibrary, c_GetProcAddress, freeLibrary
, c_FreeLibraryFinaliser )
@@ -141,7 +143,7 @@ loadMapiFuncs dllname dll = liftM5 MapiFuncs
(loadProc "MAPISendMail" dll mkMapiSendMail)
where
loadProc :: String -> HMODULE -> (FunPtr a -> a) -> IO a
- loadProc name dll conv = withCString name $ \name' -> do
+ loadProc name dll conv = withCAString name $ \name' -> do
proc <- failIfNull ("loadMapiDll: " ++ dllname ++ ": " ++ name)
$ c_GetProcAddress dll name'
return $ conv $ castPtrToFunPtr proc
@@ -190,8 +192,8 @@ mapiLogon
-> MapiFlag -- ^ None, one or many flags: FORCE_DOWNLOAD, NEW_SESSION, LOGON_UI, PASSWORD_UI
-> IO LHANDLE
mapiLogon f hwnd ses pw flags =
- maybeWith withCString ses $ \ses ->
- maybeWith withCString pw $ \pw ->
+ maybeWith withCAString ses $ \ses ->
+ maybeWith withCAString pw $ \pw ->
alloca $ \out -> do
mapiFail_ "MAPILogon: " $ mapifLogon
f (maybeHWND hwnd)
@@ -242,8 +244,8 @@ withRecipient f ses rcls rec act = resolve "" rec
act buf
resolve err rc = case rc of
Recip name addr ->
- withCString name $ \name ->
- withCString addr $ \addr ->
+ withCAString name $ \name ->
+ withCAString addr $ \addr ->
allocaBytes (#size MapiRecipDesc) $ \buf -> do
(#poke MapiRecipDesc, ulReserved) buf (0::ULONG)
(#poke MapiRecipDesc, lpszName) buf name
@@ -253,7 +255,7 @@ withRecipient f ses rcls rec act = resolve "" rec
a buf
RecipResolve hwnd flag name fallback -> do
res <- alloca $ \res ->
- withCString name $ \name' -> do
+ withCAString name $ \name' -> do
errn <- mapifResolveName
f ses (maybeHWND hwnd) name' flag 0 res
if errn==(#const SUCCESS_SUCCESS)
@@ -310,7 +312,7 @@ withFileTag ft act =
where
w v a = case v of
Nothing -> a (nullPtr, 0)
- Just x -> withCStringLen x a
+ Just x -> withCAStringLen x a
data Attachment = Attachment
{ attFlag :: MapiFlag
@@ -330,9 +332,9 @@ withAttachments att act = allocaBytes (len*as) $ \buf -> write (act len buf) buf
len = length att
write act _ [] = act
write act buf (att:y) =
- withCString (attPath att) $ \path ->
+ withCAString (attPath att) $ \path ->
maybeWith withFileTag (attTag att) $ \tag ->
- withCString (maybe (attPath att) id (attName att)) $ \name -> do
+ withCAString (maybe (attPath att) id (attName att)) $ \name -> do
(#poke MapiFileDesc, ulReserved) buf (0::ULONG)
(#poke MapiFileDesc, flFlags) buf (attFlag att)
(#poke MapiFileDesc, nPosition) buf (maybe 0xffffffff id $ attPosition att)
@@ -363,11 +365,11 @@ withMessage
-> (Ptr Message -> IO a)
-> IO a
withMessage f ses m act =
- withCString (msgSubject m) $ \subject ->
- withCString (msgBody m) $ \body ->
- maybeWith withCString (msgType m) $ \message_type ->
- maybeWith withCString (msgDate m) $ \date ->
- maybeWith withCString (msgConversationId m) $ \conv_id ->
+ withCAString (msgSubject m) $ \subject ->
+ withCAString (msgBody m) $ \body ->
+ maybeWith withCAString (msgType m) $ \message_type ->
+ maybeWith withCAString (msgDate m) $ \date ->
+ maybeWith withCAString (msgConversationId m) $ \conv_id ->
withRecipients f ses (msgRecips m) $ \rlen rbuf ->
withAttachments (msgAttachments m) $ \alen abuf ->
maybeWith (withRecipient f ses RcOriginal) (msgFrom m) $ \from ->
diff --git a/cbits/dumpBMP.c b/cbits/dumpBMP.c
index 9a1d409..df89a96 100644
--- a/cbits/dumpBMP.c
+++ b/cbits/dumpBMP.c
@@ -34,10 +34,9 @@
//typedef LPBITMAPINFO PBITMAPINFO; // hack to keep cygwin32b17 happy
-void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
+void CreateBMPFile(LPCTSTR pszFileName, HBITMAP hBmp, HDC hDC)
{
int hFile;
- OFSTRUCT ofReOpenBuff;
HBITMAP hTmpBmp, hBmpOld;
BOOL bSuccess;
BITMAPFILEHEADER bfh;
@@ -132,8 +131,8 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
//
// Lets open the file and get ready for writing
//
- if ((hFile = OpenFile(pszFileName, (LPOFSTRUCT)&ofReOpenBuff,
- OF_CREATE | OF_WRITE)) == -1) {
+ if ((hFile = CreateFileW(pszFileName, GENERIC_WRITE, FILE_SHARE_READ, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL))
+ == INVALID_HANDLE_VALUE) {
fprintf(stderr, "Failed in OpenFile!");
goto ErrExit2;
}
More information about the Cvs-libraries
mailing list