{-# LANGUAGE CPP #-}
module XMonad.Util.XSelection (
getSelection,
promptSelection,
safePromptSelection,
transformPromptSelection,
transformSafePromptSelection) where
import Control.Exception.Extensible as E (catch,SomeException(..))
import Control.Monad (liftM, join)
import Data.Maybe (fromMaybe)
import XMonad
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
import Codec.Binary.UTF8.String (decode)
getSelection :: MonadIO m => m String
getSelection :: 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
Display
dpy <- String -> IO Display
openDisplay String
""
let dflt :: ScreenNumber
dflt = Display -> ScreenNumber
defaultScreen Display
dpy
Window
rootw <- Display -> ScreenNumber -> IO Window
rootWindow Display
dpy ScreenNumber
dflt
Window
win <- Display
-> Window
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> CInt
-> Window
-> Window
-> IO Window
createSimpleWindow Display
dpy Window
rootw Position
0 Position
0 ScreenNumber
1 ScreenNumber
1 CInt
0 Window
0 Window
0
Window
p <- Display -> String -> Bool -> IO Window
internAtom Display
dpy String
"PRIMARY" Bool
True
Window
ty <- IO Window -> (SomeException -> IO Window) -> IO Window
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(IO Window -> (SomeException -> IO Window) -> IO Window
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(Display -> String -> Bool -> IO Window
internAtom Display
dpy String
"UTF8_STRING" Bool
False)
(\(E.SomeException e
_) -> Display -> String -> Bool -> IO Window
internAtom Display
dpy String
"COMPOUND_TEXT" Bool
False))
(\(E.SomeException e
_) -> Display -> String -> Bool -> IO Window
internAtom Display
dpy String
"sTring" Bool
False)
Window
clp <- Display -> String -> Bool -> IO Window
internAtom Display
dpy String
"BLITZ_SEL_STRING" Bool
False
Display -> Window -> Window -> Window -> Window -> Window -> IO ()
xConvertSelection Display
dpy Window
p Window
ty Window
clp Window
win Window
currentTime
(XEventPtr -> IO String) -> IO String
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO String) -> IO String)
-> (XEventPtr -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
Display -> XEventPtr -> IO ()
nextEvent Display
dpy XEventPtr
e
Event
ev <- XEventPtr -> IO Event
getEvent XEventPtr
e
String
result <- if Event -> ScreenNumber
ev_event_type Event
ev ScreenNumber -> ScreenNumber -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenNumber
selectionNotify
then do Maybe [CChar]
res <- Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 Display
dpy Window
clp Window
win
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [Word8] -> String
decode ([Word8] -> String)
-> (Maybe [CChar] -> [Word8]) -> Maybe [CChar] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChar -> Word8) -> [CChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CChar] -> [Word8])
-> (Maybe [CChar] -> [CChar]) -> Maybe [CChar] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CChar] -> Maybe [CChar] -> [CChar]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [CChar] -> String) -> Maybe [CChar] -> String
forall a b. (a -> b) -> a -> b
$ Maybe [CChar]
res
else Display -> Window -> IO ()
destroyWindow Display
dpy Window
win IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Display -> IO ()
closeDisplay Display
dpy
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
result
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection :: String -> X ()
promptSelection = String -> X ()
unsafePromptSelection
safePromptSelection :: String -> X ()
safePromptSelection String
app = X (X ()) -> X ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X ()) -> X ()) -> X (X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO (X ()) -> X (X ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (X ()) -> X (X ())) -> IO (X ()) -> X (X ())
forall a b. (a -> b) -> a -> b
$ (String -> X ()) -> IO String -> IO (X ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (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 (m :: * -> *) a. Monad m => a -> m a
return) IO String
forall (m :: * -> *). MonadIO m => m String
getSelection
unsafePromptSelection :: String -> X ()
unsafePromptSelection String
app = X (X ()) -> X ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X ()) -> X ()) -> X (X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO (X ()) -> X (X ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (X ()) -> X (X ())) -> IO (X ()) -> X (X ())
forall a b. (a -> b) -> a -> b
$ (String -> X ()) -> IO String -> IO (X ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn (IO String -> IO (X ())) -> IO String -> IO (X ())
forall a b. (a -> b) -> a -> b
$ (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> String
app String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) IO 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 = X (X ()) -> X ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X ()) -> X ()) -> X (X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO (X ()) -> X (X ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (X ()) -> X (X ())) -> IO (X ()) -> X (X ())
forall a b. (a -> b) -> a -> b
$ (String -> X ()) -> IO String -> IO (X ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (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 (m :: * -> *) a. Monad m => a -> m a
return) ((String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
f IO String
forall (m :: * -> *). MonadIO m => m String
getSelection)
transformSafePromptSelection :: (String -> String) -> String -> X ()
transformSafePromptSelection String -> String
f String
app = X (X ()) -> X ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X ()) -> X ()) -> X (X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO (X ()) -> X (X ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (X ()) -> X (X ())) -> IO (X ()) -> X (X ())
forall a b. (a -> b) -> a -> b
$ (String -> X ()) -> IO String -> IO (X ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn (IO String -> IO (X ())) -> IO String -> IO (X ())
forall a b. (a -> b) -> a -> b
$ (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\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) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
f IO String
forall (m :: * -> *). MonadIO m => m String
getSelection)