|
|
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ScreenCorners
-- Copyright : (c) 2009 Nils Schweinsberg
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Nils Schweinsberg <mail@n-sch.de>
-- Stability : unstable
-- Portability : unportable
--
-- Run @X ()@ actions by touching the edge of your screen with your mouse.
--
-----------------------------------------------------------------------------
module XMonad.Hooks.ScreenCorners
(
-- * Usage
-- $usage
-- * Adding screen corners
ScreenCorner (..)
, addScreenCorner
, addScreenCorners
-- * Event hook
, screenCornerEventHook
) where
import Data.Monoid
import Data.List (find)
import XMonad
import XMonad.Util.XUtils (fi)
import qualified Data.Map as M
import qualified XMonad.Util.ExtensibleState as XS
data ScreenCorner = SCUpperLeft
| SCUpperRight
| SCLowerLeft
| SCLowerRight
deriving (Eq, Ord, Show)
--------------------------------------------------------------------------------
-- ExtensibleState modifications
--------------------------------------------------------------------------------
newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
deriving Typeable
instance ExtensionClass ScreenCornerState where
initialValue = ScreenCornerState M.empty
-- | Add one single @X ()@ action to a screen corner
addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner corner xF = do
ScreenCornerState m <- XS.get
(win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
Nothing -> flip (,) xF `fmap` createWindowAt corner
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
-- | Add a list of @(ScreenCorner, X ())@ tuples
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
--------------------------------------------------------------------------------
-- Xlib functions
--------------------------------------------------------------------------------
-- "Translate" a ScreenCorner to real (x,y) Positions
createWindowAt :: ScreenCorner -> X Window
createWindowAt SCUpperLeft = createWindowAt' 0 0
createWindowAt SCUpperRight = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1
in createWindowAt' (fi w) 0
createWindowAt SCLowerLeft = withDisplay $ \dpy ->
let h = displayHeight dpy (defaultScreen dpy) - 1
in createWindowAt' 0 (fi h)
createWindowAt SCLowerRight = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1
h = displayHeight dpy (defaultScreen dpy) - 1
in createWindowAt' (fi w) (fi h)
-- Create a new X window at a (x,y) Position
createWindowAt' :: Position -> Position -> X Window
createWindowAt' x y = withDisplay $ \dpy -> io $ do
rootw <- rootWindow dpy (defaultScreen dpy)
let
visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
attrmask = cWOverrideRedirect
w <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
createWindow dpy -- display
rootw -- parent window
x -- x
y -- y
1 -- width
1 -- height
0 -- border width
0 -- depth
inputOnly -- class
visual -- visual
attrmask -- valuemask
attributes -- attributes
-- we only need mouse entry events
selectInput dpy w enterWindowMask
mapWindow dpy w
sync dpy False
return w
--------------------------------------------------------------------------------
-- Event hook
--------------------------------------------------------------------------------
-- | Handle screen corner events
screenCornerEventHook :: Event -> X All
screenCornerEventHook CrossingEvent { ev_window = win } = do
ScreenCornerState m <- XS.get
case M.lookup win m of
Just (_, xF) -> xF
Nothing -> return ()
return (All True)
screenCornerEventHook _ = return (All True)
--------------------------------------------------------------------------------
-- $usage
--
-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
-- into one of your screen corners you can trigger an @X ()@ action, for
-- example @"XMonad.Actions.GridSelect".goToSelected@ or
-- @"XMonad.Actions.CycleWS".nextWS@ etc.
--
-- To use it, import it on top of your @xmonad.hs@:
--
-- > import XMonad.Hooks.ScreenCorners
--
-- Then add your screen corners in our startup hook:
--
-- > myStartupHook = do
-- > ...
-- > addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
-- > addScreenCorners [ (SCLowerRight, nextWS)
-- > , (SCLowerLeft, prevWS)
-- > ]
--
-- And finally wait for screen corner events in your event hook:
--
-- > myEventHook e = do
-- > ...
-- > screenCornerEventHook e
|
