{-# LANGUAGE CPP #-}
{- |
Module      :  XMonad.Util.XSelection
Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman
License     :  BSD3

Maintainer  : Gwern Branwen <gwern0@gmail.com>
Stability   :  unstable
Portability :  unportable

A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).
'getSelection' is an adaptation of Hxsel.hs and Hxput.hs from the XMonad-utils, available:

> $ darcs get <http://gorgias.mine.nu/repos/xmonad-utils>
-}

module XMonad.Util.XSelection (  -- * Usage
                                 -- $usage
                                 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)

{- $usage
   Add @import XMonad.Util.XSelection@ to the top of Config.hs
   Then make use of getSelection or promptSelection as needed; if
   one wanted to run Firefox with the selection as an argument (perhaps
   the selection string is an URL you just highlighted), then one could add
   to the xmonad.hs a line like thus:

   > , ((modm .|. shiftMask, xK_b), promptSelection "firefox")

   Future improvements for XSelection:

   * More elaborate functionality: Emacs' registers are nice; if you
      don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -}

-- | Returns a String corresponding to the current mouse selection in X;
--   if there is none, an empty string is returned.
--
-- WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes,
-- deadlock or crash. For details, see <http://code.google.com/p/xmonad/issues/detail?id=573>.
-- (These errors are generally very rare in practice, but still exist.)
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 ""
  let dflt :: ScreenNumber
dflt = Display -> ScreenNumber
defaultScreen Display
dpy
  ScreenNumber
rootw  <- Display -> ScreenNumber -> IO ScreenNumber
rootWindow Display
dpy ScreenNumber
dflt
  ScreenNumber
win <- Display
-> ScreenNumber
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> CInt
-> ScreenNumber
-> ScreenNumber
-> IO ScreenNumber
createSimpleWindow Display
dpy ScreenNumber
rootw 0 0 1 1 0 0 0
  ScreenNumber
p <- Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy "PRIMARY" Bool
True
  ScreenNumber
ty <- IO ScreenNumber
-> (SomeException -> IO ScreenNumber) -> IO ScreenNumber
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
               (IO ScreenNumber
-> (SomeException -> IO ScreenNumber) -> IO ScreenNumber
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                     (Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy "UTF8_STRING" Bool
False)
                     (\(E.SomeException _) -> Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy "COMPOUND_TEXT" Bool
False))
             (\(E.SomeException _) -> Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy "sTring" Bool
False)
  ScreenNumber
clp <- Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy "BLITZ_SEL_STRING" Bool
False
  Display
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> IO ()
xConvertSelection Display
dpy ScreenNumber
p ScreenNumber
ty ScreenNumber
clp ScreenNumber
win ScreenNumber
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
$ \e :: 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 -> ScreenNumber -> ScreenNumber -> IO (Maybe [CChar])
getWindowProperty8 Display
dpy ScreenNumber
clp ScreenNumber
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 -> ScreenNumber -> IO ()
destroyWindow Display
dpy ScreenNumber
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 ""
    Display -> IO ()
closeDisplay Display
dpy
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
result

{- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument.
  This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to
         @promptSelection \"firefox\"@;
  this would allow you to highlight a URL string and then immediately open it up in Firefox.

  'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text
  to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the
  shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more
  details on the advantages and disadvantages of using safeSpawn. -}
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection :: String -> X ()
promptSelection = String -> X ()
unsafePromptSelection
safePromptSelection :: String -> X ()
safePromptSelection app :: 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 app :: 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 (\x :: String
x -> String
app String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) IO String
forall (m :: * -> *). MonadIO m => m String
getSelection

{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the
     first is a function that transforms strings, and the second is the application to run.
     The transformer essentially transforms the selection in X.
     One example is to wrap code, such as a command line action copied out of the browser
     to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -}
transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection f :: String -> String
f app :: 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 f :: String -> String
f app :: 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 (\x :: String
x -> String
app String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " 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)