module XMonad.Actions.WindowNavigation (
withWindowNavigation,
withWindowNavigationKeys,
WNAction(..),
go, swap,
Direction2D(..), WNState,
) where
import XMonad
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W
import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import qualified Data.Map as M
import qualified Data.Set as S
withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation :: forall (l :: * -> *).
(Window, Window, Window, Window) -> XConfig l -> IO (XConfig l)
withWindowNavigation (Window
u,Window
l,Window
d,Window
r) conf :: XConfig l
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask=KeyMask
modm} =
forall (l :: * -> *).
[((KeyMask, Window), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [ ((KeyMask
modm , Window
u), Direction2D -> WNAction
WNGo Direction2D
U),
((KeyMask
modm , Window
l), Direction2D -> WNAction
WNGo Direction2D
L),
((KeyMask
modm , Window
d), Direction2D -> WNAction
WNGo Direction2D
D),
((KeyMask
modm , Window
r), Direction2D -> WNAction
WNGo Direction2D
R),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
u), Direction2D -> WNAction
WNSwap Direction2D
U),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
l), Direction2D -> WNAction
WNSwap Direction2D
L),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
d), Direction2D -> WNAction
WNSwap Direction2D
D),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
r), Direction2D -> WNAction
WNSwap Direction2D
R) ]
XConfig l
conf
withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys :: forall (l :: * -> *).
[((KeyMask, Window), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [((KeyMask, Window), WNAction)]
wnKeys XConfig l
conf = do
IORef (Map WorkspaceId Point)
posRef <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, Window) (X ())
keys = \XConfig Layout
cnf -> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
posRef)) [((KeyMask, Window), WNAction)]
wnKeys)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
keys XConfig l
conf XConfig Layout
cnf,
logHook :: X ()
logHook = forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
posRef }
where fromWNAction :: IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
posRef (WNGo Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go IORef (Map WorkspaceId Point)
posRef Direction2D
dir
fromWNAction IORef (Map WorkspaceId Point)
posRef (WNSwap Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
posRef Direction2D
dir
data WNAction = WNGo Direction2D | WNSwap Direction2D
type WNState = Map WorkspaceId Point
go :: IORef WNState -> Direction2D -> X ()
go :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go = (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow
swap :: IORef WNState -> Direction2D -> X ()
swap :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap = (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
swapWithFocused
where swapWithFocused :: a -> StackSet i l a s sd -> StackSet i l a s sd
swapWithFocused a
targetWin StackSet i l a s sd
winSet =
case forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l a s sd
winSet of
Just a
currentWin -> forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow a
currentWin forall a b. (a -> b) -> a -> b
$
forall {a} {i} {l} {s} {sd}.
(a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows (forall {a}. Eq a => a -> a -> a -> a
swapWin a
currentWin a
targetWin) StackSet i l a s sd
winSet
Maybe a
Nothing -> StackSet i l a s sd
winSet
mapWindows :: (a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows a -> a
f = forall i l a s sd.
(Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
W.mapWorkspace (forall {a} {a} {i} {l}.
(a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f)
mapWindows' :: (a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f ws :: Workspace i l a
ws@W.Workspace{ stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack = Maybe (Stack a)
s } = Workspace i l a
ws { stack :: Maybe (Stack a)
W.stack = forall {a} {a}. (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack a)
s }
mapWindows'' :: (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f (W.Stack a
focused [a]
up [a]
down) = forall a. a -> [a] -> [a] -> Stack a
W.Stack (a -> a
f a
focused) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
up) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
down)
swapWin :: a -> a -> a -> a
swapWin a
win1 a
win2 a
win
| a
win forall a. Eq a => a -> a -> Bool
== a
win1 = a
win2
| a
win forall a. Eq a => a -> a -> Bool
== a
win2 = a
win1
| Bool
otherwise = a
win
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow :: (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow Window -> WindowSet -> WindowSet
adj IORef (Map WorkspaceId Point)
posRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef forall a b. (a -> b) -> a -> b
$ \Window
win Point
pos -> do
[(Window, Rectangle)]
targets <- forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Window
win) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets Point
pos Direction2D
dir
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall a. [a] -> Maybe a
listToMaybe [(Window, Rectangle)]
targets) forall a b. (a -> b) -> a -> b
$ \(Window
targetWin, Rectangle
targetRect) -> do
(WindowSet -> WindowSet) -> X ()
windows (Window -> WindowSet -> WindowSet
adj Window
targetWin)
IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
pos Rectangle
targetRect
trackMovement :: IORef WNState -> X ()
trackMovement :: IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
posRef = IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef forall a b. (a -> b) -> a -> b
$ \Window
win Point
pos ->
Window -> X (Maybe (Window, Rectangle))
windowRect Window
win forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint :: IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef Window -> Point -> X ()
f = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
win ->
IORef (Map WorkspaceId Point) -> X Point
currentPosition IORef (Map WorkspaceId Point)
posRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Window -> Point -> X ()
f Window
win
currentPosition :: IORef WNState -> X Point
currentPosition :: IORef (Map WorkspaceId Point) -> X Point
currentPosition IORef (Map WorkspaceId Point)
posRef = do
Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Maybe Window
currentWindow <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
Rectangle
currentRect <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X (Maybe (Window, Rectangle))
windowRect (forall a. a -> Maybe a -> a
fromMaybe Window
root Maybe Window
currentWindow)
WorkspaceId
wsid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
Maybe Point
mp <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
wsid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
posRef)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Rectangle -> Point
middleOf Rectangle
currentRect) (Point -> Rectangle -> Point
`inside` Rectangle
currentRect) Maybe Point
mp
where middleOf :: Rectangle -> Point
middleOf (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Point
Point (Position -> Dimension -> Position
midPoint Position
x Dimension
w) (Position -> Dimension -> Position
midPoint Position
y Dimension
h)
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
setPosition :: IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
oldPos Rectangle
newRect = do
WorkspaceId
wsid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map WorkspaceId Point)
posRef forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
wsid (Point
oldPos Point -> Rectangle -> Point
`inside` Rectangle
newRect)
inside :: Point -> Rectangle -> Point
Point Position
x Position
y inside :: Point -> Rectangle -> Point
`inside` Rectangle Position
rx Position
ry Dimension
rw Dimension
rh =
Position -> Position -> Point
Point (Position
x Position -> (Position, Dimension) -> Position
`within` (Position
rx, Dimension
rw)) (Position
y Position -> (Position, Dimension) -> Position
`within` (Position
ry, Dimension
rh))
where Position
pos within :: Position -> (Position, Dimension) -> Position
`within` (Position
lower, Dimension
dim) = if Position
pos forall a. Ord a => a -> a -> Bool
>= Position
lower Bool -> Bool -> Bool
&& Position
pos forall a. Ord a => a -> a -> Bool
< Position
lower forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim
then Position
pos
else Position -> Dimension -> Position
midPoint Position
lower Dimension
dim
midPoint :: Position -> Dimension -> Position
midPoint :: Position -> Dimension -> Position
midPoint Position
pos Dimension
dim = Position
pos forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim forall a. Integral a => a -> a -> a
`div` Position
2
navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets Point
point Direction2D
dir = Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
dir Point
point forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [(Window, Rectangle)]
windowRects
navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable :: Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt = forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
d Point
pt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
windowRects :: X [(Window, Rectangle)]
windowRects :: X [(Window, Rectangle)]
windowRects = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X (Maybe (Window, Rectangle))
windowRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set Window
mapped
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect Window
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
(Window
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
(Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy Window
win
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Window
win, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw) (Dimension
h forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw))
forall a. X a -> X a -> X a
`catchX` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
inr :: Direction2D -> Point -> Rectangle -> Bool
inr :: Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
D (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
h) = Position
px forall a. Ord a => a -> a -> Bool
>= Position
rx Bool -> Bool -> Bool
&& Position
px forall a. Ord a => a -> a -> Bool
< Position
rx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
Position
py forall a. Ord a => a -> a -> Bool
< Position
ry forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
inr Direction2D
U (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
_) = Position
px forall a. Ord a => a -> a -> Bool
>= Position
rx Bool -> Bool -> Bool
&& Position
px forall a. Ord a => a -> a -> Bool
< Position
rx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
Position
py forall a. Ord a => a -> a -> Bool
> Position
ry
inr Direction2D
R (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
h) = Position
px forall a. Ord a => a -> a -> Bool
< Position
rx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
Position
py forall a. Ord a => a -> a -> Bool
>= Position
ry Bool -> Bool -> Bool
&& Position
py forall a. Ord a => a -> a -> Bool
< Position
ry forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
inr Direction2D
L (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
_ Dimension
h) = Position
px forall a. Ord a => a -> a -> Bool
> Position
rx Bool -> Bool -> Bool
&&
Position
py forall a. Ord a => a -> a -> Bool
>= Position
ry Bool -> Bool -> Bool
&& Position
py forall a. Ord a => a -> a -> Bool
< Position
ry forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby :: forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
D = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Rectangle -> Position
rect_y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
sortby Direction2D
R = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Rectangle -> Position
rect_x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
sortby Direction2D
U = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
D
sortby Direction2D
L = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
R