module XMonad.Util.XSelection (
getSelection,
promptSelection,
safePromptSelection,
putSelection) where
import Control.Concurrent (forkIO)
import Control.Exception as E (catch)
import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)
import Data.Bits (shiftL, (.&.), (.|.))
import Data.Char (chr, ord)
import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import XMonad
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
getSelection :: IO String
getSelection = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
p <- internAtom dpy "PRIMARY" True
ty <- E.catch
(E.catch
(internAtom dpy "UTF8_STRING" False)
(\_ -> internAtom dpy "COMPOUND_TEXT" False))
(\_ -> internAtom dpy "sTring" False)
clp <- internAtom dpy "BLITZ_SEL_STRING" False
xConvertSelection dpy p ty clp win currentTime
allocaXEvent $ \e -> do
nextEvent dpy e
ev <- getEvent e
if ev_event_type ev == selectionNotify
then do res <- getWindowProperty8 dpy clp win
return $ decode . map fromIntegral . fromMaybe [] $ res
else destroyWindow dpy win >> return ""
putSelection :: String -> IO ()
putSelection text = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
p <- internAtom dpy "PRIMARY" True
ty <- internAtom dpy "UTF8_STRING" False
xSetSelectionOwner dpy p win currentTime
winOwn <- xGetSelectionOwner dpy p
if winOwn == win
then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return ()
else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win
return ()
where
processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO ()
processEvent dpy ty txt e = do
nextEvent dpy e
ev <- getEvent e
if ev_event_type ev == selectionRequest
then do print ev
allocaXEvent $ \replyPtr -> do
changeProperty8 (ev_event_display ev)
(ev_requestor ev)
(ev_property ev)
ty
propModeReplace
(map (fromIntegral . ord) txt)
setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev)
(ev_target ev) (ev_property ev) (ev_time ev)
sendEvent dpy (ev_requestor ev) False noEventMask replyPtr
sync dpy False
else do putStrLn "Unexpected Message Received"
print ev
processEvent dpy ty text e
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection = unsafePromptSelection
safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
decode :: [Word8] -> String
decode [ ] = ""
decode (c:cs)
| c < 0x80 = chr (fromEnum c) : decode cs
| c < 0xc0 = replacement_character : decode cs
| c < 0xe0 = multi_byte 1 0x1f 0x80
| c < 0xf0 = multi_byte 2 0xf 0x800
| c < 0xf8 = multi_byte 3 0x7 0x10000
| c < 0xfc = multi_byte 4 0x3 0x200000
| c < 0xfe = multi_byte 5 0x1 0x4000000
| otherwise = replacement_character : decode cs
where
replacement_character :: Char
replacement_character = '\xfffd'
multi_byte :: Int -> Word8 -> Int -> [Char]
multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))
where
aux 0 rs acc
| overlong <= acc && acc <= 0x10ffff &&
(acc < 0xd800 || 0xdfff < acc) &&
(acc < 0xfffe || 0xffff < acc) = chr acc : decode rs
| otherwise = replacement_character : decode rs
aux n (r:rs) acc
| r .&. 0xc0 == 0x80 = aux (n1) rs
$ shiftL acc 6 .|. fromEnum (r .&. 0x3f)
aux _ rs _ = replacement_character : decode rs