{-# LANGUAGE PatternGuards #-}
module XMonad.Util.NamedScratchpad (
NamedScratchpad(..),
nonFloating,
defaultFloating,
customFloating,
NamedScratchpads,
namedScratchpadAction,
allNamedScratchpadAction,
namedScratchpadManageHook,
namedScratchpadFilterOutWorkspace,
namedScratchpadFilterOutWorkspacePP
) where
import XMonad
import XMonad.Hooks.ManageHelpers (doRectFloat)
import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
import XMonad.Hooks.DynamicLog (PP, ppSort)
import Control.Monad (filterM)
import Data.Maybe (listToMaybe)
import qualified XMonad.StackSet as W
data NamedScratchpad = NS { NamedScratchpad -> String
name :: String
, NamedScratchpad -> String
cmd :: String
, NamedScratchpad -> Query Bool
query :: Query Bool
, NamedScratchpad -> ManageHook
hook :: ManageHook
}
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = ManageHook
forall m. Monoid m => m
idHook
defaultFloating :: ManageHook
defaultFloating :: ManageHook
defaultFloating = ManageHook
doFloat
customFloating :: W.RationalRect -> ManageHook
customFloating :: RationalRect -> ManageHook
customFloating = RationalRect -> ManageHook
doRectFloat
type NamedScratchpads = [NamedScratchpad]
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName NamedScratchpads
c String
s = NamedScratchpads -> Maybe NamedScratchpad
forall a. [a] -> Maybe a
listToMaybe (NamedScratchpads -> Maybe NamedScratchpad)
-> NamedScratchpads -> Maybe NamedScratchpad
forall a b. (a -> b) -> a -> b
$ (NamedScratchpad -> Bool) -> NamedScratchpads -> NamedScratchpads
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> (NamedScratchpad -> String) -> NamedScratchpad -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> String
name) NamedScratchpads
c
runApplication :: NamedScratchpad -> X ()
runApplication :: NamedScratchpad -> X ()
runApplication = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (String -> X ())
-> (NamedScratchpad -> String) -> NamedScratchpad -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> String
cmd
namedScratchpadAction :: NamedScratchpads
-> String
-> X ()
namedScratchpadAction :: NamedScratchpads -> String -> X ()
namedScratchpadAction = ((Window -> X ()) -> [Window] -> X ())
-> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (\Window -> X ()
f [Window]
ws -> Window -> X ()
f (Window -> X ()) -> Window -> X ()
forall a b. (a -> b) -> a -> b
$ [Window] -> Window
forall a. [a] -> a
head [Window]
ws)
allNamedScratchpadAction :: NamedScratchpads
-> String
-> X ()
allNamedScratchpadAction :: NamedScratchpads -> String -> X ()
allNamedScratchpadAction = ((Window -> X ()) -> [Window] -> X ())
-> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())
-> NamedScratchpads
-> String
-> X ()
someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())
-> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (Window -> X ()) -> [Window] -> X ()
f NamedScratchpads
confs String
n
| Just NamedScratchpad
conf <- NamedScratchpads -> String -> Maybe NamedScratchpad
findByName NamedScratchpads
confs String
n = (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]
filterCurrent <- (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 (NamedScratchpad -> Query Bool
query NamedScratchpad
conf))
(([Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate (Maybe (Stack Window) -> [Window])
-> (WindowSet -> Maybe (Stack Window)) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (WindowSet -> Workspace String (Layout Window) Window)
-> WindowSet
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> (WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current) WindowSet
s)
[Window]
filterAll <- (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 (NamedScratchpad -> Query Bool
query NamedScratchpad
conf)) (WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s)
case [Window]
filterCurrent of
[] -> do
case [Window]
filterAll of
[] -> NamedScratchpad -> X ()
runApplication NamedScratchpad
conf
[Window]
_ -> (Window -> X ()) -> [Window] -> X ()
f ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
s)) [Window]
filterAll
[Window]
_ -> do
if [Workspace String (Layout Window) Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Workspace String (Layout Window) Window -> Bool)
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scratchpadWorkspaceTag) (String -> Bool)
-> (Workspace String (Layout Window) Window -> String)
-> Workspace String (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
W.tag) (WindowSet -> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
s))
then String -> X ()
addHiddenWorkspace String
scratchpadWorkspaceTag
else () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Window -> X ()) -> [Window] -> X ()
f ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 String
scratchpadWorkspaceTag) [Window]
filterAll
| Bool
otherwise = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag = String
"NSP"
namedScratchpadManageHook :: NamedScratchpads
-> ManageHook
namedScratchpadManageHook :: NamedScratchpads -> ManageHook
namedScratchpadManageHook = [ManageHook] -> ManageHook
forall m. Monoid m => [m] -> m
composeAll ([ManageHook] -> ManageHook)
-> (NamedScratchpads -> [ManageHook])
-> NamedScratchpads
-> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedScratchpad -> ManageHook) -> NamedScratchpads -> [ManageHook]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NamedScratchpad
c -> NamedScratchpad -> Query Bool
query NamedScratchpad
c Query Bool -> ManageHook -> ManageHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> NamedScratchpad -> ManageHook
hook NamedScratchpad
c)
namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]
namedScratchpadFilterOutWorkspace :: [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
namedScratchpadFilterOutWorkspace = (Workspace String (Layout Window) Window -> Bool)
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(W.Workspace String
tag Layout Window
_ Maybe (Stack Window)
_) -> String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
scratchpadWorkspaceTag)
namedScratchpadFilterOutWorkspacePP :: PP -> PP
namedScratchpadFilterOutWorkspacePP :: PP -> PP
namedScratchpadFilterOutWorkspacePP PP
pp = PP
pp {
ppSort :: X ([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
ppSort = (([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
-> X ([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
-> X ([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
-> ([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
namedScratchpadFilterOutWorkspace) (PP
-> X ([Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window])
ppSort PP
pp)
}