module System.Clipboard
(
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
setClipboardString
, getClipboardString
, modifyClipboardString
, cF_UNICODETEXT
#else
#endif
) where
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import System.Win32.Mem
(globalAlloc, globalLock, globalUnlock, copyMemory, gHND)
import Graphics.Win32.GDI.Clip
( openClipboard, closeClipboard, emptyClipboard,
getClipboardData, setClipboardData
, cF_TEXT, ClipboardFormat
, isClipboardFormatAvailable)
import Foreign.C
(withCAString, peekCAString, withCWString, peekCWString)
import Foreign.Ptr
(castPtr, nullPtr)
import Data.List
(genericLength)
import Control.Exception
(bracket_, bracket)
import Data.Maybe
(isJust)
cF_UNICODETEXT :: ClipboardFormat
cF_UNICODETEXT = 13
setClipboardString :: String -> IO ()
setClipboardString str =
withCWString str $ \cstring -> do
mem <- globalAlloc gHND strLen
bracket (globalLock mem) globalUnlock $ \mem' -> do
copyMemory mem' (castPtr cstring) strLen
bracket_ (openClipboard nullPtr) closeClipboard $ do
emptyClipboard
setClipboardData cF_UNICODETEXT mem'
return ()
where
strLen = 2 * (genericLength str + 1)
getClipboardString :: IO (Maybe String)
getClipboardString =
bracket_ (openClipboard nullPtr) closeClipboard $ do
isUnicodeAvailable <- isClipboardFormatAvailable cF_UNICODETEXT
if isUnicodeAvailable
then do handle <- getClipboardData cF_UNICODETEXT
mem <- globalLock handle
str <- peekCWString (castPtr mem)
globalUnlock mem
return $ Just str
else do isAnsiAvailable <- isClipboardFormatAvailable cF_TEXT
if isAnsiAvailable
then do handle <- getClipboardData cF_TEXT
mem <- globalLock handle
str <- peekCAString (castPtr mem)
globalUnlock mem
return $ Just str
else return Nothing
modifyClipboardString :: (String -> String) -> IO Bool
modifyClipboardString f = do
s <- getClipboardString
case s of
Nothing -> return False
Just sc -> setClipboardString (f sc) >> return True
#endif