    {-# 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
      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 0 0 1 1 0 0 0
      Window
    p <- Display -> String -> Bool -> IO Window
    internAtom Display
    dpy "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 "UTF8_STRING" Bool
    False)
                         (\(E.SomeException _) -> Display -> String -> Bool -> IO Window
    internAtom Display
    dpy "COMPOUND_TEXT" Bool
    False))
                 (\(E.SomeException _) -> Display -> String -> Bool -> IO Window
    internAtom Display
    dpy "sTring" Bool
    False)
      Window
    clp <- Display -> String -> Bool -> IO Window
    internAtom Display
    dpy "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
    $ \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 -> 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 ""
        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)