diff options
Diffstat (limited to 'XMonad')
-rw-r--r-- | XMonad/Doc/Extending.hs | 3 | ||||
-rw-r--r-- | XMonad/Util/XPaste.hs | 74 |
2 files changed, 77 insertions, 0 deletions
diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 244ec43..9bcad51 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -490,6 +490,9 @@ A non complete list with a brief description: workspaces in various ways, used by several other modules which need to sort workspaces (e.g. "XMonad.Hooks.DynamicLog"). +* "XMonad.Util.XPaste" provides utilities for pasting or sending keys and + strings to windows; + * "XMonad.Util.XSelection" provide utilities for using the mouse selection; diff --git a/XMonad/Util/XPaste.hs b/XMonad/Util/XPaste.hs new file mode 100644 index 0000000..b4f1db1 --- /dev/null +++ b/XMonad/Util/XPaste.hs @@ -0,0 +1,74 @@ +{- | +Module : XMonad.Util.XPaste +Copyright : (C) 2008 +License : BSD3 + +Maintainer : <gwern0@gmail.com +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.XPaste 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 Data.Char (isUpper) +import Graphics.X11.Xlib.Misc (stringToKeysym) +import XMonad.Util.XSelection (getSelection) + + +{- $usage + +Import this module into your xmonad.hs as usual: + +> import XMonad.Util.XPaste + +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 = getSelection >>= pasteString + +-- | Send a string to the window with current focus. This function correctly handles capitalization. +pasteString :: String -> X () +pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar 0 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' +-} +pasteChar :: KeyMask -> Char -> X () +pasteChar m c = pasteKey m $ stringToKeysym [c] + +pasteKey :: KeyMask -> KeySym -> X () +pasteKey = (withFocused .) . pasteKeyWindow + +pasteKeyWindow :: KeyMask -> KeySym -> Window -> X () +pasteKeyWindow mods key w = withDisplay $ \d -> do + rootw <- asks theRoot + keycode <- io $ keysymToKeycode d key + io $ allocaXEvent $ \ev -> do + setEventType ev keyPress + setKeyEvent ev w rootw none mods keycode True + sendEvent d w True keyPressMask ev + setEventType ev keyRelease + sendEvent d w True keyReleaseMask ev
\ No newline at end of file |