{-# 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.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 = 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

-- 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 = 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
       -- do a little double check to be sure
       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