{-# LANGUAGE PatternGuards #-}
module XMonad.Actions.CopyWindow (
copy, copyToAll, copyWindow, runOrCopy
, killAllOtherCopies, kill1
, wsContainingCopies
) where
import XMonad
import Control.Arrow ((&&&))
import qualified Data.List as L
import XMonad.Actions.WindowGo
import qualified XMonad.StackSet as W
copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
copy :: i -> StackSet i l a s sd -> StackSet i l a s sd
copy n :: i
n s :: StackSet i l a s sd
s | Just w :: a
w <- StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l a s sd
s = a -> i -> StackSet i l a s sd -> StackSet i l a s sd
forall a i s l sd.
(Eq a, Eq i, Eq s) =>
a -> i -> StackSet i l a s sd -> StackSet i l a s sd
copyWindow a
w i
n StackSet i l a s sd
s
| Bool
otherwise = StackSet i l a s sd
s
copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
copyToAll :: StackSet i l a s sd -> StackSet i l a s sd
copyToAll s :: StackSet i l a s sd
s = (i -> StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> [i] -> StackSet i l a s sd
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i a l sd.
(Eq s, Eq i, Eq a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
copy StackSet i l a s sd
s ([i] -> StackSet i l a s sd) -> [i] -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ (Workspace i l a -> i) -> [Workspace i l a] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> i
forall i l a. Workspace i l a -> i
W.tag (StackSet i l a s sd -> [Workspace i l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces StackSet i l a s sd
s)
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
copyWindow :: a -> i -> StackSet i l a s sd -> StackSet i l a s sd
copyWindow w :: a
w n :: i
n = StackSet i l a s sd -> StackSet i l a s sd
forall s l sd. Eq s => StackSet i l a s sd -> StackSet i l a s sd
copy'
where copy' :: StackSet i l a s sd -> StackSet i l a s sd
copy' s :: StackSet i l a s sd
s = if i
n i -> StackSet i l a s sd -> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
`W.tagMember` StackSet i l a s sd
s
then i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag StackSet i l a s sd
s) (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
insertUp' a
w (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view i
n StackSet i l a s sd
s
else StackSet i l a s sd
s
insertUp' :: a -> StackSet i l a s sd -> StackSet i l a s sd
insertUp' a :: a
a s :: StackSet i l a s sd
s = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify (Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
a [] [])
(\(W.Stack t :: a
t l :: [a]
l r :: [a]
r) -> if a
a a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
r
then Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t [a]
l [a]
r
else Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
a (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
a [a]
l) (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
a (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r))) StackSet i l a s sd
s
runOrCopy :: String -> Query Bool -> X ()
runOrCopy :: String -> Query Bool -> X ()
runOrCopy = X () -> Query Bool -> X ()
copyMaybe (X () -> Query Bool -> X ())
-> (String -> X ()) -> String -> Query Bool -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn
copyMaybe :: X () -> Query Bool -> X ()
copyMaybe :: X () -> Query Bool -> X ()
copyMaybe f :: X ()
f qry :: Query Bool
qry = Query Bool -> ManageHook -> X () -> X ()
ifWindow Query Bool
qry ManageHook
forall l sd. Query (Endo (StackSet String l Window ScreenId sd))
copyWin X ()
f
where copyWin :: Query (Endo (StackSet String l Window ScreenId sd))
copyWin = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window
-> (Window -> Query (Endo (StackSet String l Window ScreenId sd)))
-> Query (Endo (StackSet String l Window ScreenId sd))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w :: Window
w -> (StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd)
-> Query (Endo (StackSet String l Window ScreenId sd))
forall s. (s -> s) -> Query (Endo s)
doF (\ws :: StackSet String l Window ScreenId sd
ws -> Window
-> String
-> StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd
forall a i s l sd.
(Eq a, Eq i, Eq s) =>
a -> i -> StackSet i l a s sd -> StackSet i l a s sd
copyWindow Window
w (StackSet String l Window ScreenId sd -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag StackSet String l Window ScreenId sd
ws) StackSet String l Window ScreenId sd
ws)
kill1 :: X ()
kill1 :: X ()
kill1 = do WindowSet
ss <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ss) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \w :: Window
w -> if Window -> WindowSet -> Bool
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
W.member Window
w (WindowSet -> Bool) -> WindowSet -> Bool
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> WindowSet
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
delete'' Window
w WindowSet
ss
then (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.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
delete'' Window
w
else X ()
kill
where delete'' :: a -> StackSet i l a s sd -> StackSet i l a s sd
delete'' w :: a
w = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify Maybe (Stack a)
forall a. Maybe a
Nothing ((a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w))
killAllOtherCopies :: X ()
killAllOtherCopies :: X ()
killAllOtherCopies = do WindowSet
ss <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ss) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \w :: Window
w -> (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$
String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ss) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Window -> WindowSet -> WindowSet
forall sid i a l sd.
(Eq sid, Eq i, Eq a) =>
a -> StackSet i l a sid sd -> StackSet i l a sid sd
delFromAllButCurrent Window
w
where
delFromAllButCurrent :: a -> StackSet i l a sid sd -> StackSet i l a sid sd
delFromAllButCurrent w :: a
w ss :: StackSet i l a sid sd
ss = ((StackSet i l a sid sd -> StackSet i l a sid sd)
-> StackSet i l a sid sd -> StackSet i l a sid sd)
-> StackSet i l a sid sd
-> [StackSet i l a sid sd -> StackSet i l a sid sd]
-> StackSet i l a sid sd
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (StackSet i l a sid sd -> StackSet i l a sid sd)
-> StackSet i l a sid sd -> StackSet i l a sid sd
forall a b. (a -> b) -> a -> b
($) StackSet i l a sid sd
ss ([StackSet i l a sid sd -> StackSet i l a sid sd]
-> StackSet i l a sid sd)
-> [StackSet i l a sid sd -> StackSet i l a sid sd]
-> StackSet i l a sid sd
forall a b. (a -> b) -> a -> b
$
(Workspace i l a -> StackSet i l a sid sd -> StackSet i l a sid sd)
-> [Workspace i l a]
-> [StackSet i l a sid sd -> StackSet i l a sid sd]
forall a b. (a -> b) -> [a] -> [b]
map (a -> i -> StackSet i l a sid sd -> StackSet i l a sid sd
forall s i a l sd.
(Eq s, Eq i, Eq a) =>
a -> i -> StackSet i l a s sd -> StackSet i l a s sd
delWinFromWorkspace a
w (i -> StackSet i l a sid sd -> StackSet i l a sid sd)
-> (Workspace i l a -> i)
-> Workspace i l a
-> StackSet i l a sid sd
-> StackSet i l a sid sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> i
forall i l a. Workspace i l a -> i
W.tag) ([Workspace i l a]
-> [StackSet i l a sid sd -> StackSet i l a sid sd])
-> [Workspace i l a]
-> [StackSet i l a sid sd -> StackSet i l a sid sd]
forall a b. (a -> b) -> a -> b
$
StackSet i l a sid sd -> [Workspace i l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.hidden StackSet i l a sid sd
ss [Workspace i l a] -> [Workspace i l a] -> [Workspace i l a]
forall a. [a] -> [a] -> [a]
++ (Screen i l a sid sd -> Workspace i l a)
-> [Screen i l a sid sd] -> [Workspace i l a]
forall a b. (a -> b) -> [a] -> [b]
map 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 (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.visible StackSet i l a sid sd
ss)
delWinFromWorkspace :: a -> i -> StackSet i l a s sd -> StackSet i l a s sd
delWinFromWorkspace w :: a
w wid :: i
wid = i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall s i s l a sd l a sd.
(Eq s, Eq i, Eq s) =>
i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
viewing i
wid ((StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify Maybe (Stack a)
forall a. Maybe a
Nothing ((a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w))
viewing :: i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
viewing wis :: i
wis f :: StackSet i l a s sd -> StackSet i l a s sd
f ss :: StackSet i l a s sd
ss = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag StackSet i l a s sd
ss) (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd -> StackSet i l a s sd
f (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view i
wis StackSet i l a s sd
ss
wsContainingCopies :: X [WorkspaceId]
wsContainingCopies :: X [String]
wsContainingCopies = do
WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
[String] -> X [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> X [String]) -> [String] -> X [String]
forall a b. (a -> b) -> a -> b
$ Maybe Window -> [(String, [Window])] -> [String]
forall a i. Eq a => Maybe a -> [(i, [a])] -> [i]
copiesOfOn (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ([Workspace String (Layout Window) Window] -> [(String, [Window])]
forall i l a. [Workspace i l a] -> [(i, [a])]
taggedWindows ([Workspace String (Layout Window) Window] -> [(String, [Window])])
-> [Workspace String (Layout Window) Window]
-> [(String, [Window])]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.hidden WindowSet
ws)
taggedWindows :: [W.Workspace i l a] -> [(i, [a])]
taggedWindows :: [Workspace i l a] -> [(i, [a])]
taggedWindows = (Workspace i l a -> (i, [a])) -> [Workspace i l a] -> [(i, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Workspace i l a -> (i, [a])) -> [Workspace i l a] -> [(i, [a])])
-> (Workspace i l a -> (i, [a])) -> [Workspace i l a] -> [(i, [a])]
forall a b. (a -> b) -> a -> b
$ Workspace i l a -> i
forall i l a. Workspace i l a -> i
W.tag (Workspace i l a -> i)
-> (Workspace i l a -> [a]) -> Workspace i l a -> (i, [a])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack a) -> [a])
-> (Workspace i l a -> Maybe (Stack a)) -> Workspace i l a -> [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
copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i]
copiesOfOn :: Maybe a -> [(i, [a])] -> [i]
copiesOfOn foc :: Maybe a
foc tw :: [(i, [a])]
tw = [i] -> (a -> [i]) -> Maybe a -> [i]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> [i]
hasCopyOf Maybe a
foc
where hasCopyOf :: a -> [i]
hasCopyOf f :: a
f = ((i, [a]) -> i) -> [(i, [a])] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map (i, [a]) -> i
forall a b. (a, b) -> a
fst ([(i, [a])] -> [i]) -> [(i, [a])] -> [i]
forall a b. (a -> b) -> a -> b
$ ((i, [a]) -> Bool) -> [(i, [a])] -> [(i, [a])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a
f a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ) ([a] -> Bool) -> ((i, [a]) -> [a]) -> (i, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, [a]) -> [a]
forall a b. (a, b) -> b
snd) [(i, [a])]
tw