{- |
Module      :  XMonad.Util.Paste
Description :  A module for sending key presses to windows.
Copyright   :  (C) 2008 Jérémy Bobbio, gwern
License     :  BSD3

Maintainer  :  none
Stability   :  unstable
Portability :  unportable

A module for sending key presses to windows. This modules provides generalized
and specialized functions for this task.
-}

module XMonad.Util.Paste ( -- * Usage
                           -- $usage
                           pasteSelection,
                           pasteString,
                           pasteChar,
                           sendKey,
                           sendKeyWindow,
                           noModMask
                         )
                           where

import XMonad (io, theRoot, withDisplay, X ())
import Graphics.X11
import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent)
import Control.Monad.Reader (asks)
import XMonad.Operations (withFocused)
import XMonad.Prelude (isUpper, listToMaybe)
import XMonad.Util.XSelection (getSelection)
import XMonad.Util.EZConfig (parseKey)
import Text.ParserCombinators.ReadP (readP_to_S)

{- $usage

Import this module into your xmonad.hs as usual:

> import XMonad.Util.Paste

And use the functions. They all return 'X' (), and so are appropriate
for use as keybindings. Example:

>          , ((m,              xK_d), pasteString "foo bar") ]

Don't expect too much of the functions; they probably don't work on complex
texts.
-}

-- | Paste the current X mouse selection. Note that this uses 'getSelection' from
--   "XMonad.Util.XSelection" and so is heir to its flaws.
pasteSelection :: X ()
pasteSelection :: X ()
pasteSelection = X String
forall (m :: * -> *). MonadIO m => m String
getSelection X String -> (String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
pasteString

-- | Send a string to the window which is currently focused. This function correctly
-- handles capitalization. Warning: in dealing with capitalized characters, this assumes a QWERTY layout.
pasteString :: String -> X ()
pasteString :: String -> X ()
pasteString = (Char -> X ()) -> String -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Char
x -> if Char -> Bool
isUpper Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"~!@#$%^&*()_+{}|:\"<>?" then KeyMask -> Char -> X ()
pasteChar KeyMask
shiftMask Char
x else KeyMask -> Char -> X ()
pasteChar KeyMask
noModMask Char
x)

{- | Send a character to the current window. This is more low-level.
   Remember that you must handle the case of capitalization appropriately.
   That is, from the window's perspective:

   > pasteChar mod2Mask 'F' ~> "f"

   You would want to do something like:

   > pasteChar shiftMask 'F'

   Note that this function will probably have trouble with any 'Char'
   outside ASCII.
-}
pasteChar :: KeyMask -> Char -> X ()
pasteChar :: KeyMask -> Char -> X ()
pasteChar KeyMask
m Char
c = KeyMask -> KeySym -> X ()
sendKey KeyMask
m (KeySym -> X ()) -> KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ KeySym
-> ((KeySym, String) -> KeySym) -> Maybe (KeySym, String) -> KeySym
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> KeySym
unicodeToKeysym Char
c) (KeySym, String) -> KeySym
forall a b. (a, b) -> a
fst
                (Maybe (KeySym, String) -> KeySym)
-> Maybe (KeySym, String) -> KeySym
forall a b. (a -> b) -> a -> b
$ [(KeySym, String)] -> Maybe (KeySym, String)
forall a. [a] -> Maybe a
listToMaybe ([(KeySym, String)] -> Maybe (KeySym, String))
-> [(KeySym, String)] -> Maybe (KeySym, String)
forall a b. (a -> b) -> a -> b
$ ReadP KeySym -> ReadS KeySym
forall a. ReadP a -> ReadS a
readP_to_S ReadP KeySym
parseKey [Char
c]

-- | Send a key with a modifier to the currently focused window.
sendKey :: KeyMask -> KeySym -> X ()
sendKey :: KeyMask -> KeySym -> X ()
sendKey = ((KeySym -> X ()) -> X ()
withFocused ((KeySym -> X ()) -> X ())
-> (KeySym -> KeySym -> X ()) -> KeySym -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((KeySym -> KeySym -> X ()) -> KeySym -> X ())
-> (KeyMask -> KeySym -> KeySym -> X ())
-> KeyMask
-> KeySym
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMask -> KeySym -> KeySym -> X ()
sendKeyWindow

-- | The primitive. Allows you to send any combination of 'KeyMask' and 'KeySym' to any 'Window' you specify.
sendKeyWindow :: KeyMask -> KeySym -> Window -> X ()
sendKeyWindow :: KeyMask -> KeySym -> KeySym -> X ()
sendKeyWindow KeyMask
mods KeySym
key KeySym
w = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
              KeySym
rootw <- (XConf -> KeySym) -> X KeySym
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> KeySym
theRoot
              KeyCode
keycode <- IO KeyCode -> X KeyCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO KeyCode -> X KeyCode) -> IO KeyCode -> X KeyCode
forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> IO KeyCode
keysymToKeycode Display
d KeySym
key
              IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
ev -> do
                  XEventPtr -> EventType -> IO ()
setEventType XEventPtr
ev EventType
keyPress
                  XEventPtr
-> KeySym
-> KeySym
-> KeySym
-> KeyMask
-> KeyCode
-> Bool
-> IO ()
setKeyEvent XEventPtr
ev KeySym
w KeySym
rootw KeySym
none KeyMask
mods KeyCode
keycode Bool
True
                  Display -> KeySym -> Bool -> KeySym -> XEventPtr -> IO ()
sendEvent Display
d KeySym
w Bool
True KeySym
keyPressMask XEventPtr
ev
                  XEventPtr -> EventType -> IO ()
setEventType XEventPtr
ev EventType
keyRelease
                  Display -> KeySym -> Bool -> KeySym -> XEventPtr -> IO ()
sendEvent Display
d KeySym
w Bool
True KeySym
keyReleaseMask XEventPtr
ev

-- | Convert a unicode character to a 'KeySym'. Ideally, this should
-- work for any unicode character, but see here for details:
-- http://www.cl.cam.ac.uk/~mgk25/ucs/keysyms.txt
unicodeToKeysym :: Char -> KeySym
unicodeToKeysym :: Char -> KeySym
unicodeToKeysym Char
c
  | (Int
ucp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32)  Bool -> Bool -> Bool
&& (Int
ucp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
126) = Int -> KeySym
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ucp
  | (Int
ucp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
160) Bool -> Bool -> Bool
&& (Int
ucp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255) = Int -> KeySym
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ucp
  | Int
ucp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256                   = Int -> KeySym
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> KeySym) -> Int -> KeySym
forall a b. (a -> b) -> a -> b
$ Int
ucp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x1000000
  | Bool
otherwise                    = KeySym
0 -- this is supposed to be an error, but it's not ideal
  where ucp :: Int
ucp = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c -- codepoint