[Xmonad] darcs patch: keybindings to warp pointer to window center
Daniel Wagner
wagnerd at stanford.edu
Sat Jun 2 02:33:04 EDT 2007
Fri Jun 1 23:31:27 PST 2007 Daniel Wagner <daniel at wagner-home.com>
* keybindings to warp pointer to window center
-------------- next part --------------
New patches:
[keybindings to warp pointer to window center
daniel at wagner-home.com**20070602062328] {
addfile ./Warp.hs
hunk ./Warp.hs 1
+module XMonadContrib.Warp where
+
+{- Usage:
+ - This can be used to make a keybinding that warps the pointer to a given
+ - window or screen. For example, I've added the following keybindings to
+ - my Config.hs:
+ -
+ - , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+ -
+ - -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
+ - ++
+ - [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+ - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
+ -
+ - Note that warping to a particular screen may change the focus.
+ -}
+
+import Data.Ratio
+import Data.Maybe
+import Control.Monad.RWS
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Operations
+import XMonad
+
+fraction :: (Integral a, Integral b) => Rational -> a -> b
+fraction f x = floor (f * fromIntegral x)
+
+ix :: Int -> [a] -> Maybe a
+ix n = listToMaybe . take 1 . drop n
+
+warp :: Window -> Position -> Position -> X ()
+warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
+
+warpToWindow :: Rational -> Rational -> X ()
+warpToWindow h v =
+ withDisplay $ \d ->
+ withFocused $ \w -> do
+ wa <- io $ getWindowAttributes d w
+ warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
+
+warpToScreen :: Int -> Rational -> Rational -> X ()
+warpToScreen n h v = do
+ xScreens <- gets xineScreens
+ root <- asks theRoot
+ whenJust (ix n xScreens) $ \r ->
+ warp root (rect_x r + fraction h (rect_width r))
+ (rect_y r + fraction v (rect_height r))
}
Context:
[Extract NamedWindow support from Mosaic into its own module
glasser at mit.edu**20070523155855]
[remove SwapFocus (which is no longer possible)
David Roundy <droundy at darcs.net>**20070523153841
This module depended on the focus stack.
]
[Fix Spiral's module name
Spencer Janssen <sjanssen at cse.unl.edu>**20070522170909]
[[SPIRAL] add spiral tiling layout
joe.thornber at gmail.com**20070522062537]
[Make RotView compile.
Miikka Koskinen <arcatan at kapsi.fi>**20070522075338
As I'm not a Xinerama user, I'm not sure if rotView should consider only
hidden workspaces or also visible but not focused workspaces. I thought hidden
workspaces only would be more logical.
]
[bug fix in DwmPromote. whoops.
Miikka Koskinen <arcatan at kapsi.fi>**20070522062118]
[make FindEmptyWorkspace compile
Miikka Koskinen <arcatan at kapsi.fi>**20070521123239]
[make DwmPromote compile
Miikka Koskinen <arcatan at kapsi.fi>**20070521123140]
[updated Dmenu.hs to work with zipper StackSet
Jason Creighton <jcreigh at gmail.com>**20070521233947]
[Add GreedyView
Spencer Janssen <sjanssen at cse.unl.edu>**20070521220048]
[Rescreen: collects new screen information
Spencer Janssen <sjanssen at cse.unl.edu>**20070521164808]
[Fixes for windowset -> workspace rename
Spencer Janssen <sjanssen at cse.unl.edu>**20070521042118]
[TwoPane: hide windows that aren't in view
Spencer Janssen <sjanssen at cse.unl.edu>**20070518224240]
[make Mosaic even less picky by default.
David Roundy <droundy at darcs.net>**20070516175554]
[add clear window message in Mosaic.
David Roundy <droundy at darcs.net>**20070516175518]
[Comment only
Spencer Janssen <sjanssen at cse.unl.edu>**20070517211003]
[Add instructions for TwoPane
Spencer Janssen <sjanssen at cse.unl.edu>**20070517210206]
[Add TwoPane
Spencer Janssen <sjanssen at cse.unl.edu>**20070517195618]
[throttle the exponential expense when many windows are present.
David Roundy <droundy at darcs.net>**20070516022123]
[make mosaic configure windows by name rather than by Window.
David Roundy <droundy at darcs.net>**20070512215644
Note that this is still pretty flawed. Often window names change, and the
layout then stagnates a bit. Gimp, for example, opens most its windows
with the same name before renaming them, so you have to hit mod-return or
something to force a doLayout. Also, gimp still overrides xmonad regarding
the size of its main window. :(
]
[XMonadContrib.FindEmptyWorkspace
Miikka Koskinen <arcatan at kapsi.fi>**20070513184338
With this module you can find empty workspaces, view them and tag windows to
them.
]
[make DwmPromote compile
Miikka Koskinen <arcatan at kapsi.fi>**20070513184254]
[make DwmPromote compile again
Miikka Koskinen <arcatan at kapsi.fi>**20070510154158]
[make DwmPromote compile
Miikka Koskinen <arcatan at kapsi.fi>**20070503105236]
[add SwapFocus.
David Roundy <droundy at darcs.net>**20070512191315]
[make rotView only consider non-visible workspaces (Xinerama)
Jason Creighton <jcreigh at gmail.com>**20070510012059]
[fix commend in RotView.
David Roundy <droundy at darcs.net>**20070505185654]
[switch to Message type for layout messages
Don Stewart <dons at cse.unsw.edu.au>**20070505014332]
[Fix instructions in Mosaic.
Chris Mears <chris at cmears.id.au>**20070503222345]
[add Mosaic layout.
David Roundy <droundy at darcs.net>**20070503151024]
[-Wall police
Spencer Janssen <sjanssen at cse.unl.edu>**20070503211700]
[Make RotView build, and add a brief description.
Chris Mears <chris at cmears.id.au>**20070503104234]
[comment: Gave URL to xinerama-enabled dmenu patch
Jason Creighton <jcreigh at gmail.com>**20070503053133]
[Put dmenu in X too
Spencer Janssen <sjanssen at cse.unl.edu>**20070503053727]
[Add dmenu (thanks jcreigh)
Spencer Janssen <sjanssen at cse.unl.edu>**20070503052225]
[add RotView module.
David Roundy <droundy at darcs.net>**20070421233838]
[XMonadContrib.DwmPromote: dwm-like promote
Miikka Koskinen <arcatan at kapsi.fi>**20070501082031
I like the way dwm's equivalent to xmonad's promote works, so I
implemented dwmpromote.
]
[add simple date example
Don Stewart <dons at cse.unsw.edu.au>**20070429064013]
[more details
Don Stewart <dons at cse.unsw.edu.au>**20070429061426]
[add readme
Don Stewart <dons at cse.unsw.edu.au>**20070429061329]
[Initial import of xmonad contributions
Don Stewart <dons at cse.unsw.edu.au>**20070429061150]
Patch bundle hash:
e45f520b8209418b2358630d1587af1528af78b1
More information about the Xmonad
mailing list