----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Minimize
-- Description :  Actions for minimizing and maximizing windows.
-- Copyright   :  (c) Bogdan Sinitsyn (2016)
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
-- Stability   :  unstable
-- Portability :  not portable
--
-- Adds actions for minimizing and maximizing windows
--
-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from
-- this module
--
-- Possible keybindings:
--
-- >        , ((modm,               xK_m     ), withFocused minimizeWindow)
-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindowAndFocus)
--
-----------------------------------------------------------------------------

module XMonad.Actions.Minimize
  ( -- * Usage
    -- $usage
    minimizeWindow
  , maximizeWindow
  , maximizeWindowAndFocus
  , withLastMinimized
  , withLastMinimized'
  , withFirstMinimized
  , withFirstMinimized'
  , withMinimized
  ) where

import XMonad
import XMonad.Prelude (fromMaybe, join, listToMaybe)
import qualified XMonad.StackSet as W

import qualified XMonad.Layout.BoringWindows as BW
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Minimize
import XMonad.Util.WindowProperties (getProp32)

import Foreign.C.Types (CLong)
import qualified Data.List as L
import qualified Data.Map as M

-- $usage
-- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":
--
-- > import XMonad.Actions.Minimize
-- > import XMonad.Layout.Minimize
-- > import qualified XMonad.Layout.BoringWindows as BW
--
-- Then apply 'minimize' and 'boringWindows' to your layout hook and use some
-- actions from this module:
--
-- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }
--
-- Example keybindings:
--
-- >        , ((modm,               xK_m     ), withFocused minimizeWindow      )
-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow)

setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState Window
win Int
st CLong -> [CLong] -> [CLong]
f = do
    Window -> Int -> X ()
setWMState Window
win Int
st
    (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
dpy -> do
        Window
wm_state <- WorkspaceId -> X Window
getAtom WorkspaceId
"_NET_WM_STATE"
        CLong
hidden <- Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Window -> CLong) -> X Window -> X CLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WorkspaceId -> X Window
getAtom WorkspaceId
"_NET_WM_STATE_HIDDEN"
        [CLong]
wstate <- [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [CLong] -> [CLong]) -> X (Maybe [CLong]) -> X [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Window -> X (Maybe [CLong])
getProp32 Window
wm_state Window
win
        IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
win Window
wm_state Window
aTOM CInt
propModeReplace (CLong -> [CLong] -> [CLong]
f CLong
hidden [CLong]
wstate)

setMinimized :: Window -> X ()
setMinimized :: Window -> X ()
setMinimized Window
win = Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState Window
win Int
iconicState (:)

setNotMinimized :: Window -> X ()
setNotMinimized :: Window -> X ()
setNotMinimized Window
win = Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState Window
win Int
normalState CLong -> [CLong] -> [CLong]
forall a. Eq a => a -> [a] -> [a]
L.delete

-- It does not just set minimizedStack to newWindows because it should save
-- order in which elements were added (newer first)
modified :: (RectMap -> RectMap) -> X Bool
modified :: (RectMap -> RectMap) -> X Bool
modified RectMap -> RectMap
f = (Minimized -> Minimized) -> X Bool
forall a (m :: * -> *).
(ExtensionClass a, Eq a, XLike m) =>
(a -> a) -> m Bool
XS.modified ((Minimized -> Minimized) -> X Bool)
-> (Minimized -> Minimized) -> X Bool
forall a b. (a -> b) -> a -> b
$
    \Minimized { rectMap :: Minimized -> RectMap
rectMap = RectMap
oldRectMap, minimizedStack :: Minimized -> [Window]
minimizedStack = [Window]
oldStack } ->
      let newRectMap :: RectMap
newRectMap = RectMap -> RectMap
f RectMap
oldRectMap
          newWindows :: [Window]
newWindows = RectMap -> [Window]
forall k a. Map k a -> [k]
M.keys RectMap
newRectMap
       in Minimized { rectMap :: RectMap
rectMap = RectMap
newRectMap
                    , minimizedStack :: [Window]
minimizedStack = ([Window]
newWindows [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Window]
oldStack)
                                       [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++
                                       ([Window]
oldStack [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` [Window]
newWindows)
                    }


-- | Minimize a window
minimizeWindow :: Window -> X ()
minimizeWindow :: Window -> X ()
minimizeWindow Window
w = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
  X Bool -> X () -> X ()
whenX ((RectMap -> RectMap) -> X Bool
modified ((RectMap -> RectMap) -> X Bool) -> (RectMap -> RectMap) -> X Bool
forall a b. (a -> b) -> a -> b
$ Window -> Maybe RationalRect -> RectMap -> RectMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
w (Window -> Map Window RationalRect -> Maybe RationalRect
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w (Map Window RationalRect -> Maybe RationalRect)
-> Map Window RationalRect -> Maybe RationalRect
forall a b. (a -> b) -> a -> b
$ WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Window -> X ()
setMinimized Window
w
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink Window
w
    X ()
BW.focusDown


-- | Maximize window and apply a function to maximized window and 'WindowSet'
maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()
maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()
maximizeWindowAndChangeWSet Window -> WindowSet -> WindowSet
f Window
w = do
  Maybe RationalRect
mrect <- (Minimized -> Maybe RationalRect) -> X (Maybe RationalRect)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (Maybe (Maybe RationalRect) -> Maybe RationalRect
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe RationalRect) -> Maybe RationalRect)
-> (Minimized -> Maybe (Maybe RationalRect))
-> Minimized
-> Maybe RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> RectMap -> Maybe (Maybe RationalRect)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w (RectMap -> Maybe (Maybe RationalRect))
-> (Minimized -> RectMap)
-> Minimized
-> Maybe (Maybe RationalRect)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Minimized -> RectMap
rectMap)
  X Bool -> X () -> X ()
whenX ((RectMap -> RectMap) -> X Bool
modified ((RectMap -> RectMap) -> X Bool) -> (RectMap -> RectMap) -> X Bool
forall a b. (a -> b) -> a -> b
$ Window -> RectMap -> RectMap
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Window -> X ()
setNotMinimized Window
w
    UpdateBoring -> X ()
forall a. Message a => a -> X ()
broadcastMessage UpdateBoring
BW.UpdateBoring
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> WindowSet
f Window
w (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet)
-> (RationalRect -> WindowSet -> WindowSet)
-> Maybe RationalRect
-> WindowSet
-> WindowSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WindowSet -> WindowSet
forall a. a -> a
id (Window -> RationalRect -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w) Maybe RationalRect
mrect

-- | Just maximize a window without focusing
maximizeWindow :: Window -> X ()
maximizeWindow :: Window -> X ()
maximizeWindow = (Window -> WindowSet -> WindowSet) -> Window -> X ()
maximizeWindowAndChangeWSet ((Window -> WindowSet -> WindowSet) -> Window -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> Window -> WindowSet -> WindowSet
forall a b. a -> b -> a
const WindowSet -> WindowSet
forall a. a -> a
id

-- | Maximize a window and then focus it
maximizeWindowAndFocus :: Window -> X ()
maximizeWindowAndFocus :: Window -> X ()
maximizeWindowAndFocus = (Window -> WindowSet -> WindowSet) -> Window -> X ()
maximizeWindowAndChangeWSet Window -> WindowSet -> WindowSet
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

-- | Perform an action with first minimized window on current workspace
--   or do nothing if there is no minimized windows on current workspace
withFirstMinimized :: (Window -> X ()) -> X ()
withFirstMinimized :: (Window -> X ()) -> X ()
withFirstMinimized Window -> X ()
action = (Maybe Window -> X ()) -> X ()
withFirstMinimized' (Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` Window -> X ()
action)

-- | Like withFirstMinimized but the provided action is always invoked with a
--   'Maybe Window', that will be nothing if there is no first minimized window.
withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
withFirstMinimized' Maybe Window -> X ()
action = ([Window] -> X ()) -> X ()
forall a. ([Window] -> X a) -> X a
withMinimized (Maybe Window -> X ()
action (Maybe Window -> X ())
-> ([Window] -> Maybe Window) -> [Window] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> ([Window] -> [Window]) -> [Window] -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> [Window]
forall a. [a] -> [a]
reverse)

-- | Perform an action with last minimized window on current workspace
--   or do nothing if there is no minimized windows on current workspace
withLastMinimized :: (Window -> X ()) -> X ()
withLastMinimized :: (Window -> X ()) -> X ()
withLastMinimized Window -> X ()
action = (Maybe Window -> X ()) -> X ()
withLastMinimized' (Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` Window -> X ()
action)

-- | Like withLastMinimized but the provided action is always invoked with a
--   'Maybe Window', that will be nothing if there is no last minimized window.
withLastMinimized' :: (Maybe Window -> X ()) -> X ()
withLastMinimized' :: (Maybe Window -> X ()) -> X ()
withLastMinimized' Maybe Window -> X ()
action = ([Window] -> X ()) -> X ()
forall a. ([Window] -> X a) -> X a
withMinimized (Maybe Window -> X ()
action (Maybe Window -> X ())
-> ([Window] -> Maybe Window) -> [Window] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe)

withMinimized :: ([Window] -> X a) -> X a
withMinimized :: forall a. ([Window] -> X a) -> X a
withMinimized [Window] -> X a
action = do
  [Window]
minimized <- (Minimized -> [Window]) -> X [Window]
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets Minimized -> [Window]
minimizedStack
  [Window]
currentStack <- (WindowSet -> X [Window]) -> X [Window]
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X [Window]) -> X [Window])
-> (WindowSet -> X [Window]) -> X [Window]
forall a b. (a -> b) -> a -> b
$ [Window] -> X [Window]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Window] -> X [Window])
-> (WindowSet -> [Window]) -> WindowSet -> X [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index
  [Window] -> X a
action ([Window] -> X a) -> [Window] -> X a
forall a b. (a -> b) -> a -> b
$ [Window]
minimized [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` [Window]
currentStack