{-# LANGUAGE CPP #-}
module XMonad.Util.XSelection (
getSelection,
promptSelection,
safePromptSelection,
transformPromptSelection,
transformSafePromptSelection) where
import Control.Exception as E (catch,SomeException(..))
import XMonad
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
import Codec.Binary.UTF8.String (decode)
getSelection :: MonadIO m => m String
getSelection :: forall (m :: * -> *). MonadIO m => m String
getSelection = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
dpy <- String -> IO Display
openDisplay String
""
let dflt = Display -> Dimension
defaultScreen Display
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)
(\(E.SomeException e
_) -> Display -> String -> Bool -> IO Pixel
internAtom Display
dpy String
"COMPOUND_TEXT" Bool
False))
(\(E.SomeException e
_) -> Display -> String -> Bool -> IO Pixel
internAtom Display
dpy String
"sTring" Bool
False)
clp <- internAtom dpy "BLITZ_SEL_STRING" False
xConvertSelection dpy p ty clp win currentTime
allocaXEvent $ \XEventPtr
e -> do
Display -> XEventPtr -> IO ()
nextEvent Display
dpy XEventPtr
e
ev <- XEventPtr -> IO Event
getEvent XEventPtr
e
result <- if ev_event_type ev == selectionNotify
then do res <- getWindowProperty8 dpy clp win
return $ decode . maybe [] (map fromIntegral) $ res
else destroyWindow dpy win >> return ""
closeDisplay dpy
return result
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection :: String -> X ()
promptSelection = String -> X ()
unsafePromptSelection
safePromptSelection :: String -> X ()
safePromptSelection String
app = String -> [String] -> X ()
forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
app ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
forall (m :: * -> *). MonadIO m => m String
getSelection
unsafePromptSelection :: String -> X ()
unsafePromptSelection String
app = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn (String -> X ()) -> (String -> String) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> String
app String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
forall (m :: * -> *). MonadIO m => m String
getSelection
transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection String -> String
f String
app = (String -> [String] -> X ()
forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
app ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f) (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
forall (m :: * -> *). MonadIO m => m String
getSelection
transformSafePromptSelection :: (String -> String) -> String -> X ()
transformSafePromptSelection String -> String
f String
app = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn (String -> X ()) -> (String -> String) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> String
app String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
forall (m :: * -> *). MonadIO m => m String
getSelection