{-# LANGUAGE CPP #-}
{- |
Module      :  XMonad.Util.XSelection
Description :  A module for accessing and manipulating the primary selection.
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,
                                 getClipboard,
                                 getSecondarySelection,
                                 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)

{- $usage
   Add @import XMonad.Util.XSelection@ to the top of Config.hs

   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")

   To add a 'paste' keybinding in your prompts, use:

   > prompt_extra_bindings = [
   >   ((mod1Mask, xK_v), getClipboard >>= insertString) -- Alt+v to paste
   >   ]
   > 
   > prompt_conf = def {
   >   promptKeymap =
   >     foldl (\m (k, a) -> M.insert k a m) defaultXPKeymap prompt_extra_bindings,
   >   -- other prompt config
   > }

   Next use it to construct a prompt, for example in your bindings:

   > ("M-p", shellPrompt prompt_conf),

   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>

   WARNING: these functions are 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.) -}

-- Query the content of a selection in X
getSelectionNamed :: String -> IO String
getSelectionNamed :: String -> IO String
getSelectionNamed String
sel_name = do
  Display
dpy <- String -> IO Display
openDisplay String
""
  let dflt :: Dimension
dflt = Display -> Dimension
defaultScreen Display
dpy
  Pixel
rootw  <- Display -> Dimension -> IO Pixel
rootWindow Display
dpy Dimension
dflt
  Pixel
win <- Display
-> Pixel
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> Pixel
-> Pixel
-> IO Pixel
createSimpleWindow Display
dpy Pixel
rootw Position
0 Position
0 Dimension
1 Dimension
1 CInt
0 Pixel
0 Pixel
0
  Pixel
p <- Display -> String -> Bool -> IO Pixel
internAtom Display
dpy String
sel_name Bool
True
  Pixel
ty <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
               (forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                     (Display -> String -> Bool -> IO Pixel
internAtom Display
dpy String
"UTF8_STRING" Bool
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)
  Pixel
clp <- Display -> String -> Bool -> IO Pixel
internAtom Display
dpy String
"BLITZ_SEL_STRING" Bool
False
  Display -> Pixel -> Pixel -> Pixel -> Pixel -> Pixel -> IO ()
xConvertSelection Display
dpy Pixel
p Pixel
ty Pixel
clp Pixel
win Pixel
currentTime
  forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent 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 -> Dimension
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== Dimension
selectionNotify
                 then do Maybe [CChar]
res <- Display -> Pixel -> Pixel -> IO (Maybe [CChar])
getWindowProperty8 Display
dpy Pixel
clp Pixel
win
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Word8] -> String
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ Maybe [CChar]
res
                 else forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    Display -> Pixel -> IO ()
destroyWindow Display
dpy Pixel
win
    Display -> IO ()
closeDisplay Display
dpy
    forall (m :: * -> *) a. Monad m => a -> m a
return String
result

-- | Returns a String corresponding to the current mouse selection in X;
--   if there is none, an empty string is returned.
getSelection :: MonadIO m => m String
getSelection :: forall (m :: * -> *). MonadIO m => m String
getSelection = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ String -> IO String
getSelectionNamed String
"PRIMARY"

-- | Returns a String corresponding to the current clipboard in X;
--   if there is none, an empty string is returned.
getClipboard :: MonadIO m => m String
getClipboard :: forall (m :: * -> *). MonadIO m => m String
getClipboard = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ String -> IO String
getSelectionNamed String
"CLIPBOARD"

-- | Returns a String corresponding to the secondary selection in X;
--   if there is none, an empty string is returned.
getSecondarySelection :: MonadIO m => m String
getSecondarySelection :: forall (m :: * -> *). MonadIO m => m String
getSecondarySelection = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ String -> IO String
getSelectionNamed String
"SECONDARY"

{- | 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 String
app = forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
app forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
getSelection
unsafePromptSelection :: String -> X ()
unsafePromptSelection String
app = forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> String
app forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 String -> String
f String
app = (forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
app forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
getSelection
transformSafePromptSelection :: (String -> String) -> String -> X ()
transformSafePromptSelection String -> String
f String
app = forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> String
app forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
getSelection