From a258e295276d4f6f11777f252af45e75327a674c Mon Sep 17 00:00:00 2001 From: Devin Mullins Date: Mon, 12 May 2008 07:06:37 +0200 Subject: add more flexible withWindowNavigationKeys Names aren't permanent yet, so don't cry if they change. darcs-hash:20080512050637-78224-ac7c46ba5f826be132d1d28133f76416d63cff66.gz --- XMonad/Actions/WindowNavigation.hs | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) (limited to 'XMonad/Actions/WindowNavigation.hs') diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index ea86413..5cbc216 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -19,6 +19,8 @@ module XMonad.Actions.WindowNavigation ( -- * Usage -- $usage withWindowNavigation, + withWindowNavigationKeys, + WNAction(..), go, swap, Direction(..) ) where @@ -28,6 +30,7 @@ import XMonad.Hooks.ManageDocks (Direction(..)) import qualified XMonad.StackSet as W import Control.Applicative ((<$>)) +import Control.Arrow (second) import Data.IORef import Data.List (sortBy) import Data.Map (Map()) @@ -40,8 +43,8 @@ import Graphics.X11.Xlib -- Don't use it! What, are you crazy? -- TODO: +-- - implement swap -- - cleanup --- - actually deal with multiple screens -- - documentation :) -- - tests? (esp. for edge cases in currentPosition) -- - solve the 2+3, middle right to bottom left problem @@ -49,14 +52,22 @@ import Graphics.X11.Xlib -- TODO: more flexible api withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l) -withWindowNavigation (u,l,d,r) conf = do +withWindowNavigation (u,l,d,r) conf = + withWindowNavigationKeys [ ((modMask conf, u), WNGo U), + ((modMask conf, l), WNGo L), + ((modMask conf, d), WNGo D), + ((modMask conf, r), WNGo R) ] + conf + +withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) +withWindowNavigationKeys wnKeys conf = do posRef <- newIORef M.empty - return conf { keys = \cnf -> M.fromList [ - ((modMask cnf, u), go posRef U), - ((modMask cnf, l), go posRef L), - ((modMask cnf, d), go posRef D), - ((modMask cnf, r), go posRef R) - ] `M.union` (keys conf cnf) } + return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) + `M.union` keys conf cnf } + where fromWNAction posRef (WNGo dir) = go posRef dir + fromWNAction posRef (WNSwap dir) = swap posRef dir + +data WNAction = WNGo Direction | WNSwap Direction type WNState = Map WorkspaceId Point -- cgit v1.2.3