{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
module XMonad.Layout.WindowSwitcherDecoration
(
windowSwitcherDecoration,
windowSwitcherDecorationWithButtons,
windowSwitcherDecorationWithImageButtons,
WindowSwitcherDecoration, ImageWindowSwitcherDecoration,
) where
import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
import XMonad.Layout.ImageButtonDecoration
import XMonad.Layout.DraggingVisualizer
import qualified XMonad.StackSet as S
import XMonad.Prelude
import Foreign.C.Types(CInt)
windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecoration :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecoration s
s Theme
c = forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
c forall a b. (a -> b) -> a -> b
$ forall a. Bool -> WindowSwitcherDecoration a
WSD Bool
False
windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecorationWithButtons :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecorationWithButtons s
s Theme
c = forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
c forall a b. (a -> b) -> a -> b
$ forall a. Bool -> WindowSwitcherDecoration a
WSD Bool
True
newtype WindowSwitcherDecoration a = WSD Bool deriving (Int -> WindowSwitcherDecoration a -> ShowS
forall a. Int -> WindowSwitcherDecoration a -> ShowS
forall a. [WindowSwitcherDecoration a] -> ShowS
forall a. WindowSwitcherDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowSwitcherDecoration a] -> ShowS
$cshowList :: forall a. [WindowSwitcherDecoration a] -> ShowS
show :: WindowSwitcherDecoration a -> String
$cshow :: forall a. WindowSwitcherDecoration a -> String
showsPrec :: Int -> WindowSwitcherDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> WindowSwitcherDecoration a -> ShowS
Show, ReadPrec [WindowSwitcherDecoration a]
ReadPrec (WindowSwitcherDecoration a)
ReadS [WindowSwitcherDecoration a]
forall a. ReadPrec [WindowSwitcherDecoration a]
forall a. ReadPrec (WindowSwitcherDecoration a)
forall a. Int -> ReadS (WindowSwitcherDecoration a)
forall a. ReadS [WindowSwitcherDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowSwitcherDecoration a]
$creadListPrec :: forall a. ReadPrec [WindowSwitcherDecoration a]
readPrec :: ReadPrec (WindowSwitcherDecoration a)
$creadPrec :: forall a. ReadPrec (WindowSwitcherDecoration a)
readList :: ReadS [WindowSwitcherDecoration a]
$creadList :: forall a. ReadS [WindowSwitcherDecoration a]
readsPrec :: Int -> ReadS (WindowSwitcherDecoration a)
$creadsPrec :: forall a. Int -> ReadS (WindowSwitcherDecoration a)
Read)
instance Eq a => DecorationStyle WindowSwitcherDecoration a where
describeDeco :: WindowSwitcherDecoration a -> String
describeDeco WindowSwitcherDecoration a
_ = String
"WindowSwitcherDeco"
decorationCatchClicksHook :: WindowSwitcherDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook (WSD Bool
withButtons) Window
mainw Int
dFL Int
dFR = if Bool
withButtons
then Window -> Int -> Int -> X Bool
titleBarButtonHandler Window
mainw Int
dFL Int
dFR
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
decorationWhileDraggingHook :: WindowSwitcherDecoration a
-> CInt
-> CInt
-> (Window, Rectangle)
-> Position
-> Position
-> X ()
decorationWhileDraggingHook WindowSwitcherDecoration a
_ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleTiledDraggingInProgress
decorationAfterDraggingHook :: WindowSwitcherDecoration a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook WindowSwitcherDecoration a
_ (Window
mainw, Rectangle
_) Window
decoWin = do Window -> X ()
focus Window
mainw
Bool
hasCrossed <- Window -> Window -> X Bool
handleScreenCrossing Window
mainw Window
decoWin
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasCrossed forall a b. (a -> b) -> a -> b
$ do forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped
Window -> X ()
performWindowSwitching Window
mainw
windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
windowSwitcherDecorationWithImageButtons :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
windowSwitcherDecorationWithImageButtons s
s Theme
c = forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
c forall a b. (a -> b) -> a -> b
$ forall a. Bool -> ImageWindowSwitcherDecoration a
IWSD Bool
True
newtype ImageWindowSwitcherDecoration a = IWSD Bool deriving (Int -> ImageWindowSwitcherDecoration a -> ShowS
forall a. Int -> ImageWindowSwitcherDecoration a -> ShowS
forall a. [ImageWindowSwitcherDecoration a] -> ShowS
forall a. ImageWindowSwitcherDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageWindowSwitcherDecoration a] -> ShowS
$cshowList :: forall a. [ImageWindowSwitcherDecoration a] -> ShowS
show :: ImageWindowSwitcherDecoration a -> String
$cshow :: forall a. ImageWindowSwitcherDecoration a -> String
showsPrec :: Int -> ImageWindowSwitcherDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> ImageWindowSwitcherDecoration a -> ShowS
Show, ReadPrec [ImageWindowSwitcherDecoration a]
ReadPrec (ImageWindowSwitcherDecoration a)
ReadS [ImageWindowSwitcherDecoration a]
forall a. ReadPrec [ImageWindowSwitcherDecoration a]
forall a. ReadPrec (ImageWindowSwitcherDecoration a)
forall a. Int -> ReadS (ImageWindowSwitcherDecoration a)
forall a. ReadS [ImageWindowSwitcherDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageWindowSwitcherDecoration a]
$creadListPrec :: forall a. ReadPrec [ImageWindowSwitcherDecoration a]
readPrec :: ReadPrec (ImageWindowSwitcherDecoration a)
$creadPrec :: forall a. ReadPrec (ImageWindowSwitcherDecoration a)
readList :: ReadS [ImageWindowSwitcherDecoration a]
$creadList :: forall a. ReadS [ImageWindowSwitcherDecoration a]
readsPrec :: Int -> ReadS (ImageWindowSwitcherDecoration a)
$creadsPrec :: forall a. Int -> ReadS (ImageWindowSwitcherDecoration a)
Read)
instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where
describeDeco :: ImageWindowSwitcherDecoration a -> String
describeDeco ImageWindowSwitcherDecoration a
_ = String
"ImageWindowSwitcherDeco"
decorationCatchClicksHook :: ImageWindowSwitcherDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook (IWSD Bool
withButtons) Window
mainw Int
dFL Int
dFR = if Bool
withButtons
then Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler Window
mainw Int
dFL Int
dFR
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
decorationWhileDraggingHook :: ImageWindowSwitcherDecoration a
-> CInt
-> CInt
-> (Window, Rectangle)
-> Position
-> Position
-> X ()
decorationWhileDraggingHook ImageWindowSwitcherDecoration a
_ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleTiledDraggingInProgress
decorationAfterDraggingHook :: ImageWindowSwitcherDecoration a
-> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook ImageWindowSwitcherDecoration a
_ (Window
mainw, Rectangle
_) Window
decoWin = do Window -> X ()
focus Window
mainw
Bool
hasCrossed <- Window -> Window -> X Bool
handleScreenCrossing Window
mainw Window
decoWin
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasCrossed forall a b. (a -> b) -> a -> b
$ do forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped
Window -> X ()
performWindowSwitching Window
mainw
handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleTiledDraggingInProgress CInt
ex CInt
ey (Window
mainw, Rectangle
r) Position
x Position
y = do
let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ex forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r))
(Position
y forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ey forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_y Rectangle
r))
(Rectangle -> Dimension
rect_width Rectangle
r)
(Rectangle -> Dimension
rect_height Rectangle
r)
forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
mainw Rectangle
rect
performWindowSwitching :: Window -> X ()
performWindowSwitching :: Window -> X ()
performWindowSwitching Window
win =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
(Bool
_, Window
_, Window
selWin, CInt
_, CInt
_, CInt
_, CInt
_, Modifier
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
root
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let allWindows :: [Window]
allWindows = forall i l a s sd. StackSet i l a s sd -> [a]
S.index WindowSet
ws
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Window
win forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows) Bool -> Bool -> Bool
&& (Window
selWin forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows)) forall a b. (a -> b) -> a -> b
$ do
let allWindowsSwitched :: [Window]
allWindowsSwitched = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Eq a => a -> a -> a -> a
switchEntries Window
win Window
selWin) [Window]
allWindows
let ([Window]
ls, forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Window
t :| [Window]
rs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Window
win forall a. Eq a => a -> a -> Bool
==) [Window]
allWindowsSwitched
let newStack :: Stack Window
newStack = forall a. a -> [a] -> [a] -> Stack a
S.Stack Window
t (forall a. [a] -> [a]
reverse [Window]
ls) [Window]
rs
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
S.modify' forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Stack Window
newStack
where
switchEntries :: a -> a -> a -> a
switchEntries a
a a
b a
x
| a
x forall a. Eq a => a -> a -> Bool
== a
a = a
b
| a
x forall a. Eq a => a -> a -> Bool
== a
b = a
a
| Bool
otherwise = a
x