    {- |
    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, fromMaybe)
    import XMonad.Util.XSelection (getSelection)
    import XMonad.Util.EZConfig (parseKey)
    import XMonad.Util.Parser (runParser)

    {- $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 a b. X a -> (a -> X b) -> X b
    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 a. Eq a => a -> [a] -> 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 -> Maybe KeySym -> KeySym
    forall a. a -> Maybe a -> a
    fromMaybe (Char -> KeySym
    unicodeToKeysym Char
    c)
                    (Maybe KeySym -> KeySym) -> Maybe KeySym -> KeySym
    forall a b. (a -> b) -> a -> b
    $ Parser KeySym -> String -> Maybe KeySym
    forall a. Parser a -> String -> Maybe a
    runParser Parser 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