Clipboard 2.3.0.2 → 2.3.1.0

raw patch · 3 files changed

+48/−42 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

Clipboard.cabal +1/−1
System/Clipboard/Windows.hs +1/−2
System/Clipboard/X11.hs +46/−39

Clipboard.cabal view

@@ -1,5 +1,5 @@ Name:         Clipboard
-Version:      2.3.0.2
+Version:      2.3.1.0
 Author:       Sævar Berg (Windows), Matthew Bekkema (X11), Daniel Díaz (Maintainer)
 Homepage:     http://haskell.org/haskellwiki/Clipboard
 License:      BSD3

System/Clipboard/Windows.hs view

@@ -3,8 +3,7 @@ -- For more information, see "Graphics.Win32.GDI.Clip"
 -- or documentation for /GetClipboardData/ on MSDN.
 module System.Clipboard.Windows
-    (
-      setClipboardString
+    ( setClipboardString
     , getClipboardString
     ) where

System/Clipboard/X11.hs view

@@ -1,27 +1,33 @@++{-# LANGUAGE RecordWildCards #-}+ module System.Clipboard.X11-( getClipboardString-, setClipboardString-) where+  ( getClipboardString+  , setClipboardString+  ) where  import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras-import System.Posix.Process (forkProcess)+import System.Posix.Process     (forkProcess) -import Data.Maybe-import Data.Functor-import Control.Monad-import System.IO (hClose, stdin, stdout, stderr)-import System.Directory (setCurrentDirectory)-import Foreign.C.Types (CChar, CUChar)-import Foreign.Marshal.Array (withArrayLen) import Codec.Binary.UTF8.String (decode, encode)+import Control.Monad+import Data.Maybe+import Foreign                  (peekByteOff)+import Foreign.C.Types          (CChar, CUChar)+import Foreign.Marshal.Array    (withArrayLen)+import System.Directory         (setCurrentDirectory)+import System.IO                (hClose, stderr, stdin, stdout)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif  getClipboardString :: IO (Maybe String) getClipboardString = do-    (display, window, clipboard) <- initialSetup+    (display, window, clipboards) <- initialSetup     inp <- internAtom display "clipboard_get" False     target <- internAtom display "UTF8_STRING" True-    xConvertSelection display clipboard target inp window currentTime+    xConvertSelection display (head clipboards) target inp window currentTime     ret <- clipboardInputWait display window inp     cleanup display window     return ret@@ -30,41 +36,44 @@ clipboardInputWait display window inp = do     ev <- getNextEvent display     if ev_event_type ev == selectionNotify-        then (charsToString <$>) <$> getWindowProperty8 display inp window+        then fmap charsToString <$> getWindowProperty8 display inp window         else clipboardInputWait display window inp  charsToString :: [CChar] -> String charsToString = decode . map fromIntegral - setClipboardString :: String -> IO () setClipboardString str = do-    (display, window, clipboard) <- initialSetup-    xSetSelectionOwner display clipboard window currentTime+    (display, window, clipboards) <- initialSetup+    mapM_ (\atom -> xSetSelectionOwner display atom window currentTime) clipboards     void $ forkProcess $ do         hClose stdin         hClose stdout         hClose stderr         setCurrentDirectory "/"-        clipboardOutputWait display $ stringToChars str+        advertiseSelection display clipboards (stringToChars str)         cleanup display window -clipboardOutputWait :: Display -> [CUChar] -> IO ()-clipboardOutputWait display str = do-    let loop = clipboardOutputWait display str-    ev <- getNextEvent display-    case ev of-        SelectionRequest { ev_requestor = req-                         , ev_target = target-                         , ev_property = prop-                         , ev_selection = sel-                         , ev_time = time} -> do-            target' <- getAtomName display target-            res <- handleOutput display req prop target' str-            sendSelectionNotify display req sel target res time-            loop-        _ -> unless (ev_event_type ev == selectionClear) loop+advertiseSelection :: Display -> [Atom] -> [CUChar] -> IO ()+advertiseSelection display clipboards' str = allocaXEvent (go clipboards')+  where+    go [] _ = return ()+    go clipboards evPtr = do+      nextEvent display evPtr+      ev <- getEvent evPtr+      case ev of+          SelectionRequest {..} -> do+              target' <- getAtomName display ev_target+              res <- handleOutput display ev_requestor ev_property target' str+              sendSelectionNotify display ev_requestor ev_selection ev_target res ev_time+              go clipboards evPtr +          _ | ev_event_type ev == selectionClear -> do+              target <- peekByteOff evPtr 40 :: IO Atom+              go (filter (/= target) clipboards) evPtr++          _ -> go clipboards evPtr+ handleOutput :: Display -> Window -> Atom -> Maybe String -> [CUChar] -> IO Atom handleOutput display req prop (Just "UTF8_STRING") str = do     prop' <- getAtomName display prop@@ -76,8 +85,7 @@         return prop handleOutput _ _ _ _ _ = return none -sendSelectionNotify :: Display -> Window -> Atom -> Atom -> Atom -> Time ->-                           IO ()+sendSelectionNotify :: Display -> Window -> Atom -> Atom -> Atom -> Time -> IO () sendSelectionNotify display req sel target prop time = allocaXEvent $ \ev -> do     setEventType ev selectionNotify     setSelectionNotify ev req sel target prop time@@ -86,14 +94,13 @@ stringToChars :: String -> [CUChar] stringToChars = map fromIntegral . encode --initialSetup :: IO (Display, Window, Atom)+initialSetup :: IO (Display, Window, [Atom]) initialSetup = do     display <- openDisplay ""     window <- createSimpleWindow display (defaultRootWindow display)                                  0 0 1 1 0 0 0-    clipboard <- internAtom display "CLIPBOARD" True-    return (display, window, clipboard)+    clipboards <- internAtom display "CLIPBOARD" False+    return (display, window, [clipboards, pRIMARY])  cleanup :: Display -> Window -> IO () cleanup display window = do