{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.WindowSwitcherDecoration
-- Description :  Switch the position of windows by dragging them onto each other.
-- Copyright   :  (c) Jan Vornberger 2009
--                    Alejandro Serrano 2010
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- A decoration that allows to switch the position of windows by dragging
-- them onto each other.
--
-----------------------------------------------------------------------------

module XMonad.Layout.WindowSwitcherDecoration
    ( -- * Usage:
      -- $usage
      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)

-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.WindowSwitcherDecoration
-- > import XMonad.Layout.DraggingVisualizer
--
-- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to
-- your layout:
--
-- > myL = windowSwitcherDecoration shrinkText def (draggingVisualizer $ layoutHook def)
-- > main = xmonad def { layoutHook = myL }
--
-- There is also a version of the decoration that contains buttons like
-- "XMonad.Layout.ButtonDecoration". To use that version, you will need to
-- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@
-- in the following way:
--
-- > import XMonad.Layout.DecorationAddons
-- >
-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook def)
-- > main = xmonad def { layoutHook = myL }
--
-- Additionaly, there is a version of the decoration that contains image buttons like
-- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to
-- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@
-- in the following way:
--
-- > import XMonad.Layout.ImageButtonDecoration
-- >
-- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook def)
-- > main = xmonad def { layoutHook = myL }
--

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 = s
-> Theme
-> WindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
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 (WindowSwitcherDecoration a
 -> l a
 -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a)
-> WindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
forall a b. (a -> b) -> a -> b
$ Bool -> WindowSwitcherDecoration a
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 = s
-> Theme
-> WindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
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 (WindowSwitcherDecoration a
 -> l a
 -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a)
-> WindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
forall a b. (a -> b) -> a -> b
$ Bool -> WindowSwitcherDecoration a
forall a. Bool -> WindowSwitcherDecoration a
WSD Bool
True

newtype WindowSwitcherDecoration a = WSD Bool deriving (Int -> WindowSwitcherDecoration a -> ShowS
[WindowSwitcherDecoration a] -> ShowS
WindowSwitcherDecoration a -> String
(Int -> WindowSwitcherDecoration a -> ShowS)
-> (WindowSwitcherDecoration a -> String)
-> ([WindowSwitcherDecoration a] -> ShowS)
-> Show (WindowSwitcherDecoration a)
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)
Int -> ReadS (WindowSwitcherDecoration a)
ReadS [WindowSwitcherDecoration a]
(Int -> ReadS (WindowSwitcherDecoration a))
-> ReadS [WindowSwitcherDecoration a]
-> ReadPrec (WindowSwitcherDecoration a)
-> ReadPrec [WindowSwitcherDecoration a]
-> Read (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 Bool -> X Bool
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
                                                          Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasCrossed (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do DraggingVisualizerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped
                                                                                 Window -> X ()
performWindowSwitching Window
mainw

-- Note: the image button code is duplicated from the above
-- because the title bar handle is different

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 = s
-> Theme
-> ImageWindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
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 (ImageWindowSwitcherDecoration a
 -> l a
 -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a)
-> ImageWindowSwitcherDecoration a
-> l a
-> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
forall a b. (a -> b) -> a -> b
$ Bool -> ImageWindowSwitcherDecoration a
forall a. Bool -> ImageWindowSwitcherDecoration a
IWSD Bool
True

newtype ImageWindowSwitcherDecoration a = IWSD Bool deriving (Int -> ImageWindowSwitcherDecoration a -> ShowS
[ImageWindowSwitcherDecoration a] -> ShowS
ImageWindowSwitcherDecoration a -> String
(Int -> ImageWindowSwitcherDecoration a -> ShowS)
-> (ImageWindowSwitcherDecoration a -> String)
-> ([ImageWindowSwitcherDecoration a] -> ShowS)
-> Show (ImageWindowSwitcherDecoration a)
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)
Int -> ReadS (ImageWindowSwitcherDecoration a)
ReadS [ImageWindowSwitcherDecoration a]
(Int -> ReadS (ImageWindowSwitcherDecoration a))
-> ReadS [ImageWindowSwitcherDecoration a]
-> ReadPrec (ImageWindowSwitcherDecoration a)
-> ReadPrec [ImageWindowSwitcherDecoration a]
-> Read (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 Bool -> X Bool
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
                                                          Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasCrossed (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do DraggingVisualizerMsg -> X ()
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
- (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
ex Position -> Position -> Position
forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r))
                         (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
ey Position -> Position -> Position
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)
    DraggingVisualizerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (DraggingVisualizerMsg -> X ()) -> DraggingVisualizerMsg -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
mainw Rectangle
rect

performWindowSwitching :: Window -> X ()
performWindowSwitching :: Window -> X ()
performWindowSwitching Window
win =
    (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
       Window
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
       (Bool
_, Window
_, Window
selWin, CInt
_, CInt
_, CInt
_, CInt
_, Modifier
_) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
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 <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
       let allWindows :: [Window]
allWindows = WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
S.index WindowSet
ws
       -- do a little double check to be sure
       Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Window
win Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows) Bool -> Bool -> Bool
&& (Window
selWin Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
                let allWindowsSwitched :: [Window]
allWindowsSwitched = (Window -> Window) -> [Window] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window -> Window -> Window -> Window
forall {a}. Eq a => a -> a -> a -> a
switchEntries Window
win Window
selWin) [Window]
allWindows
                let ([Window]
ls, [Window] -> NonEmpty Window
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Window
t :| [Window]
rs) = (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Window
win Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==) [Window]
allWindowsSwitched
                let newStack :: Stack Window
newStack = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
S.Stack Window
t ([Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
ls) [Window]
rs
                (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
S.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Stack Window -> Stack Window -> Stack Window
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a    = a
b
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b    = a
a
            | Bool
otherwise = a
x