5 Apr 2011 10:02
[commit: Win32] encoding: Attempt to fix lurking Unicode errors in Win32 (5e3ce77)
Max Bolingbroke <batterseapower <at> hotmail.com>
2011-04-05 08:02:56 GMT
2011-04-05 08:02:56 GMT
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 <at> <at> -376,10 +376,10 <at> <at> 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 <at> <at> -54,7 +54,7 <at> <at> 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 <at> <at> -350,7 +350,7 <at> <at> 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 <at> <at> -20,7 +20,9 <at> <at> 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 ) <at> <at> -141,7 +143,7 <at> <at> 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 <at> <at> -190,8 +192,8 <at> <at> 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) <at> <at> -242,8 +244,8 <at> <at> 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 <at> <at> -253,7 +255,7 <at> <at> 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) <at> <at> -310,7 +312,7 <at> <at> 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 <at> <at> -330,9 +332,9 <at> <at> 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) <at> <at> -363,11 +365,11 <at> <at> 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 <at> <at> -34,10 +34,9 <at> <at> //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; <at> <at> -132,8 +131,8 <at> <at> 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; }
RSS Feed