{-# LANGUAGE LambdaCase #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.ExclusiveScratchpads
-- Description :  Named scratchpads that can be mutually exclusive.
-- Copyright   :  Bruce Forte (2017)
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Bruce Forte
-- Stability   :  unstable
-- Portability :  unportable
--
-- Named scratchpads that can be mutually exclusive.
--
-----------------------------------------------------------------------------

module XMonad.Util.ExclusiveScratchpads (
  -- * Usage
  -- $usage
  mkXScratchpads,
  xScratchpadsManageHook,
  -- * Keyboard related
  scratchpadAction,
  hideAll,
  resetExclusiveSp,
  -- * Mouse related
  setNoexclusive,
  resizeNoexclusive,
  floatMoveNoexclusive,
  -- * Types
  ExclusiveScratchpad(..),
  ExclusiveScratchpads,
  -- * Hooks
  nonFloating,
  defaultFloating,
  customFloating
  ) where

import XMonad.Prelude (appEndo, filterM, liftA2, (<=<))
import XMonad
import XMonad.Actions.Minimize
import XMonad.Actions.TagWindows (addTag,delTag)
import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)

import qualified XMonad.StackSet as W

-- $usage
--
-- For this module to work properly, you need to use "XMonad.Layout.BoringWindows" and
-- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more
-- information on how to configure them.
--
-- To use this module, put the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Utils.ExclusiveScratchpads
-- > import XMonad.ManageHook (title,appName)
-- > import qualified XMonad.StackSet as W
--
-- Add exclusive scratchpads, for example:
--
-- > exclusiveSps = mkXScratchpads [ ("htop",   "urxvt -name htop -e htop", title =? "htop")
-- >                               , ("xclock", "xclock", appName =? "xclock")
-- >                               ] $ customFloating $ W.RationalRect (1/4) (1/4) (1/2) (1/2)
--
-- The scratchpads don\'t have to be exclusive, you can create them like this (see 'ExclusiveScratchpad'):
--
-- > regularSps   = [ XSP "term" "urxvt -name scratchpad" (appName =? "scratchpad") defaultFloating [] ]
--
-- Create a list that contains all your scratchpads like this:
--
-- > scratchpads = exclusiveSps ++ regularSps
--
-- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook"), eg.:
--
-- > manageHook = myManageHook <+> xScratchpadsManageHook scratchpads
--
-- And finally add some keybindings (see "XMonad.Doc.Extending#Editing_key_bindings"):
--
-- > , ((modMask, xK_h), scratchpadAction scratchpads "htop")
-- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock")
-- > , ((modMask, xK_t), scratchpadAction scratchpads "term")
-- > , ((modMask, xK_h), hideAll scratchpads)
--
-- Now you can get your scratchpads by pressing the corresponding keys, if you
-- have the @htop@ scratchpad on your current screen and you fetch the @xclock@
-- scratchpad then @htop@ gets hidden.
--
-- If you move a scratchpad it still gets hidden when you fetch a scratchpad of
-- the same family, to change that behaviour and make windows not exclusive
-- anymore when they get resized or moved add these mouse bindings
-- (see "XMonad.Doc.Extending#Editing_mouse_bindings"):
--
-- >     , ((mod4Mask, button1), floatMoveNoexclusive scratchpads)
-- >     , ((mod4Mask, button3), resizeNoexclusive scratchpads)
--
-- To reset a moved scratchpad to the original position that you set with its hook,
-- call @resetExclusiveSp@ when it is in focus. For example if you want to extend
-- Mod-Return to reset the placement when a scratchpad is in focus but keep the
-- default behaviour for tiled windows, set these key bindings:
--
-- > , ((modMask, xK_Return), windows W.swapMaster >> resetExclusiveSp scratchpads)
--
-- __Note:__ This is just an example, in general you can add more than two
-- exclusive scratchpads and multiple families of such.

data ExclusiveScratchpad = XSP { ExclusiveScratchpad -> String
name   :: String       -- ^ Name of the scratchpad
                               , ExclusiveScratchpad -> String
cmd    :: String       -- ^ Command to spawn the scratchpad
                               , ExclusiveScratchpad -> Query Bool
query  :: Query Bool   -- ^ Query to match the scratchpad
                               , ExclusiveScratchpad -> ManageHook
hook   :: ManageHook   -- ^ Hook to specify the placement policy
                               , ExclusiveScratchpad -> [String]
exclusive :: [String]  -- ^ Names of exclusive scratchpads
                               }

type ExclusiveScratchpads = [ExclusiveScratchpad]

-- -----------------------------------------------------------------------------------

-- | Create 'ExclusiveScratchpads' from @[(name,cmd,query)]@ with a common @hook@
mkXScratchpads :: [(String,String,Query Bool)]  -- ^ List of @(name,cmd,query)@ of the
                                                --   exclusive scratchpads
               -> ManageHook                    -- ^ The common @hook@ that they use
               -> ExclusiveScratchpads
mkXScratchpads :: [(String, String, Query Bool)]
-> ManageHook -> ExclusiveScratchpads
mkXScratchpads [(String, String, Query Bool)]
xs ManageHook
h = (ExclusiveScratchpads
 -> (String, String, Query Bool) -> ExclusiveScratchpads)
-> ExclusiveScratchpads
-> [(String, String, Query Bool)]
-> ExclusiveScratchpads
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ExclusiveScratchpads
-> (String, String, Query Bool) -> ExclusiveScratchpads
accumulate [] [(String, String, Query Bool)]
xs
  where
    accumulate :: ExclusiveScratchpads
-> (String, String, Query Bool) -> ExclusiveScratchpads
accumulate ExclusiveScratchpads
a (String
n,String
c,Query Bool
q) = String
-> String
-> Query Bool
-> ManageHook
-> [String]
-> ExclusiveScratchpad
XSP String
n String
c Query Bool
q ManageHook
h ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
nString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=) [String]
names) ExclusiveScratchpad -> ExclusiveScratchpads -> ExclusiveScratchpads
forall a. a -> [a] -> [a]
: ExclusiveScratchpads
a
    names :: [String]
names = ((String, String, Query Bool) -> String)
-> [(String, String, Query Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,String
_,Query Bool
_) -> String
n) [(String, String, Query Bool)]
xs

-- | Create 'ManageHook' from 'ExclusiveScratchpads'
xScratchpadsManageHook :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads from
                                                --   which a 'ManageHook' should be generated
                       -> ManageHook
xScratchpadsManageHook :: ExclusiveScratchpads -> ManageHook
xScratchpadsManageHook = [ManageHook] -> ManageHook
forall m. Monoid m => [m] -> m
composeAll ([ManageHook] -> ManageHook)
-> (ExclusiveScratchpads -> [ManageHook])
-> ExclusiveScratchpads
-> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExclusiveScratchpad -> ManageHook)
-> ExclusiveScratchpads -> [ManageHook]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ExclusiveScratchpad
sp -> ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpad
sp Query Bool -> ManageHook -> ManageHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> ExclusiveScratchpad -> ManageHook
hook ExclusiveScratchpad
sp)

-- | Pop up/hide the scratchpad by name and possibly hide its exclusive
scratchpadAction :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads
                 -> String                -- ^ Name of the scratchpad to toggle
                 -> X ()
scratchpadAction :: ExclusiveScratchpads -> String -> X ()
scratchpadAction ExclusiveScratchpads
xs String
n =
  let ys :: ExclusiveScratchpads
ys = (ExclusiveScratchpad -> Bool)
-> ExclusiveScratchpads -> ExclusiveScratchpads
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==)(String -> Bool)
-> (ExclusiveScratchpad -> String) -> ExclusiveScratchpad -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs in

  case ExclusiveScratchpads
ys of []     -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             (ExclusiveScratchpad
sp:ExclusiveScratchpads
_) -> let q :: Query Bool
q = ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpad
sp in (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
s -> do
                       [Window]
ws <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
q) ([Window] -> X [Window]) -> [Window] -> X [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s

                       case [Window]
ws of []    -> do String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (ExclusiveScratchpad -> String
cmd ExclusiveScratchpad
sp)
                                              ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n
                                              (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

                                  (Window
w:[Window]
_) -> do Window -> X ()
toggleWindow Window
w
                                              X Bool -> X () -> X ()
whenX (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
isExclusive Window
w) (ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n)
  where
    toggleWindow :: Window -> X ()
toggleWindow Window
w = (Bool -> Bool -> Bool) -> X Bool -> X Bool -> X Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
isMaximized Window
w) (Window -> X Bool
onCurrentScreen Window
w) X Bool -> (Bool -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True  -> X Bool -> X () -> X ()
whenX (Window -> X Bool
onCurrentScreen Window
w) (Window -> X ()
minimizeWindow Window
w)
      Bool
False -> do (WindowSet -> WindowSet) -> X ()
windows ((String -> Window -> WindowSet -> WindowSet)
-> Window -> String -> WindowSet -> WindowSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin Window
w (String -> WindowSet -> WindowSet)
-> (WindowSet -> String) -> WindowSet -> WindowSet
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
                  Window -> X ()
maximizeWindowAndFocus Window
w
                  (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

    onCurrentScreen :: Window -> X Bool
onCurrentScreen Window
w = (WindowSet -> X Bool) -> X Bool
forall a. (WindowSet -> X a) -> X a
withWindowSet (Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> (WindowSet -> Bool) -> WindowSet -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Window
w ([Window] -> Bool) -> (WindowSet -> [Window]) -> WindowSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
forall i l a sid sd. StackSet i l a sid sd -> [a]
currentWindows)

-- | Hide all 'ExclusiveScratchpads' on the current screen
hideAll :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads
        -> X ()
hideAll :: ExclusiveScratchpads -> X ()
hideAll ExclusiveScratchpads
xs = Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
minimizeWindow
  where q :: Query Bool
q = [Query Bool] -> Query Bool
joinQueries ((ExclusiveScratchpad -> Query Bool)
-> ExclusiveScratchpads -> [Query Bool]
forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpads
xs) Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isExclusive Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isMaximized

-- | If the focused window is a scratchpad, the scratchpad gets reset to the original
-- placement specified with the hook and becomes exclusive again
resetExclusiveSp :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
                 -> X ()
resetExclusiveSp :: ExclusiveScratchpads -> X ()
resetExclusiveSp ExclusiveScratchpads
xs = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> X Bool -> X () -> X ()
whenX (ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
  let ys :: X ExclusiveScratchpads
ys = (ExclusiveScratchpad -> X Bool)
-> ExclusiveScratchpads -> X ExclusiveScratchpads
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Query Bool -> Window -> X Bool) -> Window -> Query Bool -> X Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Window
w (Query Bool -> X Bool)
-> (ExclusiveScratchpad -> Query Bool)
-> ExclusiveScratchpad
-> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExclusiveScratchpad -> Query Bool
query) ExclusiveScratchpads
xs

  X Bool -> X () -> X ()
unlessX (ExclusiveScratchpads -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ExclusiveScratchpads -> Bool) -> X ExclusiveScratchpads -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    ManageHook
mh <- [ManageHook] -> ManageHook
forall a. [a] -> a
head ([ManageHook] -> ManageHook)
-> (ExclusiveScratchpads -> [ManageHook])
-> ExclusiveScratchpads
-> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExclusiveScratchpad -> ManageHook)
-> ExclusiveScratchpads -> [ManageHook]
forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> ManageHook
hook (ExclusiveScratchpads -> ManageHook)
-> X ExclusiveScratchpads -> X ManageHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys  -- ys /= [], so `head` is fine
    String
n  <- [String] -> String
forall a. [a] -> a
head ([String] -> String)
-> (ExclusiveScratchpads -> [String])
-> ExclusiveScratchpads
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExclusiveScratchpad -> String) -> ExclusiveScratchpads -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> String
name (ExclusiveScratchpads -> String)
-> X ExclusiveScratchpads -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys  -- same

    ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Endo WindowSet -> WindowSet -> WindowSet)
-> Endo WindowSet
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo WindowSet -> WindowSet -> WindowSet
forall a. Endo a -> a -> a
appEndo (Endo WindowSet -> X ())
-> (Window -> X (Endo WindowSet)) -> Window -> X ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ManageHook -> Window -> X (Endo WindowSet)
forall a. Query a -> Window -> X a
runQuery ManageHook
mh) Window
w
    ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n
    String -> Window -> X ()
delTag String
"_XSP_NOEXCLUSIVE" Window
w

  where unlessX :: X Bool -> X () -> X ()
unlessX = X Bool -> X () -> X ()
whenX (X Bool -> X () -> X ())
-> (X Bool -> X Bool) -> X Bool -> X () -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> X Bool -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not

-- -----------------------------------------------------------------------------------

-- | Hide the scratchpad of the same family by name if it's on the focused workspace
hideOthers :: ExclusiveScratchpads -> String -> X ()
hideOthers :: ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n =
  let ys :: [String]
ys = (ExclusiveScratchpad -> [String])
-> ExclusiveScratchpads -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExclusiveScratchpad -> [String]
exclusive (ExclusiveScratchpads -> [String])
-> ExclusiveScratchpads -> [String]
forall a b. (a -> b) -> a -> b
$ (ExclusiveScratchpad -> Bool)
-> ExclusiveScratchpads -> ExclusiveScratchpads
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==)(String -> Bool)
-> (ExclusiveScratchpad -> String) -> ExclusiveScratchpad -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs
      qs :: [Query Bool]
qs = (ExclusiveScratchpad -> Query Bool)
-> ExclusiveScratchpads -> [Query Bool]
forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query (ExclusiveScratchpads -> [Query Bool])
-> ExclusiveScratchpads -> [Query Bool]
forall a b. (a -> b) -> a -> b
$ (ExclusiveScratchpad -> Bool)
-> ExclusiveScratchpads -> ExclusiveScratchpads
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ys)(String -> Bool)
-> (ExclusiveScratchpad -> String) -> ExclusiveScratchpad -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs
      q :: Query Bool
q  = [Query Bool] -> Query Bool
joinQueries [Query Bool]
qs Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isExclusive Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isMaximized in

  Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
minimizeWindow

-- | Conditionally map a function on all windows of the current screen
mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
f = (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
s -> do
  [Window]
ws <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
q) ([Window] -> X [Window]) -> [Window] -> X [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall i l a sid sd. StackSet i l a sid sd -> [a]
currentWindows WindowSet
s
  (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
f [Window]
ws

-- | Extract all windows on the current screen from a StackSet
currentWindows :: W.StackSet i l a sid sd -> [a]
currentWindows :: StackSet i l a sid sd -> [a]
currentWindows = Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack a) -> [a])
-> (StackSet i l a sid sd -> Maybe (Stack a))
-> StackSet i l a sid sd
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace i l a -> Maybe (Stack a))
-> (StackSet i l a sid sd -> Workspace i l a)
-> StackSet i l a sid sd
-> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen i l a sid sd -> Workspace i l a)
-> (StackSet i l a sid sd -> Screen i l a sid sd)
-> StackSet i l a sid sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a sid sd -> Screen i l a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current

-- | Check if given window is a scratchpad
isScratchpad :: ExclusiveScratchpads -> Window -> X Bool
isScratchpad :: ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w = (WindowSet -> X Bool) -> X Bool
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X Bool) -> X Bool)
-> (WindowSet -> X Bool) -> X Bool
forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
  let q :: Query Bool
q = [Query Bool] -> Query Bool
joinQueries ([Query Bool] -> Query Bool) -> [Query Bool] -> Query Bool
forall a b. (a -> b) -> a -> b
$ (ExclusiveScratchpad -> Query Bool)
-> ExclusiveScratchpads -> [Query Bool]
forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpads
xs

  [Window]
ws <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
q) ([Window] -> X [Window]) -> [Window] -> X [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s
  Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Window
w [Window]
ws

-- | Build a disjunction from a list of clauses
joinQueries :: [Query Bool] -> Query Bool
joinQueries :: [Query Bool] -> Query Bool
joinQueries = (Query Bool -> Query Bool -> Query Bool)
-> Query Bool -> [Query Bool] -> Query Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(<||>) (X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool) -> X Bool -> Query Bool
forall a b. (a -> b) -> a -> b
$ Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Useful queries
isExclusive, isMaximized :: Query Bool
isExclusive :: Query Bool
isExclusive = String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
"_XSP_NOEXCLUSIVE" ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Bool) -> Query String -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Query String
stringProperty String
"_XMONAD_TAGS"
isMaximized :: Query Bool
isMaximized = Bool -> Bool
not (Bool -> Bool) -> Query Bool -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Query Bool
isInProperty String
"_NET_WM_STATE" String
"_NET_WM_STATE_HIDDEN"

-- -----------------------------------------------------------------------------------

-- | Make a window not exclusive anymore
setNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads
               -> Window                -- ^ Window which should be made not
                                        --   exclusive anymore
               -> X ()
setNoexclusive :: ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs Window
w = X Bool -> X () -> X ()
whenX (ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ String -> Window -> X ()
addTag String
"_XSP_NOEXCLUSIVE" Window
w

-- | Float and drag the window, make it not exclusive anymore
floatMoveNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads
                     -> Window                -- ^ Window which should be moved
                     -> X ()
floatMoveNoexclusive :: ExclusiveScratchpads -> Window -> X ()
floatMoveNoexclusive ExclusiveScratchpads
xs Window
w = ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
focus Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
mouseMoveWindow Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

-- | Resize window, make it not exclusive anymore
resizeNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads
                  -> Window                -- ^ Window which should be resized
                  -> X ()
resizeNoexclusive :: ExclusiveScratchpads -> Window -> X ()
resizeNoexclusive ExclusiveScratchpads
xs Window
w = ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
focus Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
mouseResizeWindow Window
w
  X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

-- -----------------------------------------------------------------------------------

-- | Manage hook that makes the window non-floating
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = ManageHook
forall m. Monoid m => m
idHook

-- | Manage hook that makes the window floating with the default placement
defaultFloating :: ManageHook
defaultFloating :: ManageHook
defaultFloating = ManageHook
doFloat

-- | Manage hook that makes the window floating with custom placement
customFloating :: W.RationalRect  -- ^ @RationalRect x y w h@ that specifies relative position,
                                  --   height and width (see "XMonad.StackSet#RationalRect")
               -> ManageHook
customFloating :: RationalRect -> ManageHook
customFloating = RationalRect -> ManageHook
doRectFloat