Clipboard-2.0.0: System/Clipboard.hs

-- | Operations over the system clipboard.
--
-- Currently, this library only works for Windows.
-- For more information, see "Graphics.Win32.GDI.Clip"
-- or documentation for /GetClipboardData/ on MSDN.
module System.Clipboard
    (
      setClipboardString
    , getClipboardString 
    ) where

import System.Win32.Mem 
    (globalAlloc, globalLock, globalUnlock, copyMemory, gHND)
import Graphics.Win32.GDI.Clip 
    (openClipboard, closeClipboard, emptyClipboard, 
    getClipboardData, setClipboardData, cF_TEXT, isClipboardFormatAvailable)
import Foreign.C 
    (withCString, peekCString)
import Foreign.Ptr
    (castPtr, nullPtr)
import Data.List
    (genericLength)
import Control.Exception 
    (bracket_, bracket)
import Data.Maybe
    (isJust)

-- | Puts a string on the clipboard.
setClipboardString :: String -> IO ()
setClipboardString str = 
    withCString 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_TEXT mem'
            return ()
  where
    strLen = genericLength str + 1

-- | Gets the contents of the clipboard as a 'String'.
-- Returns 'Nothing' if the clipboard content is not
-- of type 'cF_TEXT', i.e. it doesn't contain /textual/ data.
getClipboardString :: IO (Maybe String)
getClipboardString =  
    bracket_ (openClipboard nullPtr) closeClipboard $ do
        isFormatAvailable <- isClipboardFormatAvailable cF_TEXT
        if isFormatAvailable 
          then do
              handle <- getClipboardData cF_TEXT
              mem <- globalLock handle
              str <- peekCString (castPtr mem)
              globalUnlock mem
              return $ Just str
          else
              return Nothing

-- | Modifies the clipboard content.
-- If the clipboard has /textual/ data, this function modifies its content,
-- and return 'True'. Otherwise, it does nothing and return 'False'.
modifyClipboardString :: (String -> String) -> IO Bool
modifyClipboardString f = getClipboardString >>= return . isJust . fmap (setClipboardString . f)