From 210c40758ec1c209bcc13fbe63ab81214e026da4 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Sun, 21 Sep 2008 08:09:47 +0200 Subject: Move XMonad.Util.XPaste to XMonad.Util.Paste darcs-hash:20080921060947-25a6b-6feda2edc133f5968df19892c2490a3a2df785c8.gz --- XMonad/Doc/Extending.hs | 2 +- XMonad/Util/Paste.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++++++ XMonad/Util/XPaste.hs | 74 ------------------------------------------------- 3 files changed, 75 insertions(+), 75 deletions(-) create mode 100644 XMonad/Util/Paste.hs delete mode 100644 XMonad/Util/XPaste.hs (limited to 'XMonad') diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 9bcad51..67dd8c6 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -490,7 +490,7 @@ 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 +* "XMonad.Util.Paste" provides utilities for pasting or sending keys and strings to windows; * "XMonad.Util.XSelection" provide utilities for using the mouse diff --git a/XMonad/Util/Paste.hs b/XMonad/Util/Paste.hs new file mode 100644 index 0000000..98ccd98 --- /dev/null +++ b/XMonad/Util/Paste.hs @@ -0,0 +1,74 @@ +{- | +Module : XMonad.Util.Paste +Author : Jérémy Bobbio +Copyright : (C) 2008 +License : BSD3 + +Maintainer : +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 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 diff --git a/XMonad/Util/XPaste.hs b/XMonad/Util/XPaste.hs deleted file mode 100644 index a51a1e2..0000000 --- a/XMonad/Util/XPaste.hs +++ /dev/null @@ -1,74 +0,0 @@ -{- | -Module : XMonad.Util.XPaste -Author : Jérémy Bobbio -Copyright : (C) 2008 -License : BSD3 - -Maintainer : -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 -- cgit v1.2.3