module XMonad.Layout.IndependentScreens (
VirtualWorkspace, PhysicalWorkspace,
workspaces',
withScreens, onCurrentScreen,
marshallPP,
whenCurrentOn,
countScreens,
marshall, unmarshall, unmarshallS, unmarshallW,
marshallWindowSpace, unmarshallWindowSpace, marshallSort
) where
import Control.Applicative((<*), liftA2)
import Control.Arrow hiding ((|||))
import Control.Monad
import Data.List (nub, genericLength)
import Graphics.X11.Xinerama
import XMonad
import XMonad.StackSet hiding (filter, workspaces)
import XMonad.Hooks.DynamicLog
type VirtualWorkspace = WorkspaceId
type PhysicalWorkspace = WorkspaceId
marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace
marshall :: ScreenId -> VirtualWorkspace -> VirtualWorkspace
marshall (S Int
sc) VirtualWorkspace
vws = Int -> VirtualWorkspace
forall a. Show a => a -> VirtualWorkspace
show Int
sc VirtualWorkspace -> VirtualWorkspace -> VirtualWorkspace
forall a. [a] -> [a] -> [a]
++ Char
'_'Char -> VirtualWorkspace -> VirtualWorkspace
forall a. a -> [a] -> [a]
:VirtualWorkspace
vws
unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)
unmarshallS :: PhysicalWorkspace -> ScreenId
unmarshallW :: PhysicalWorkspace -> VirtualWorkspace
unmarshall :: VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall = ((Int -> ScreenId
S (Int -> ScreenId)
-> (VirtualWorkspace -> Int) -> VirtualWorkspace -> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> Int
forall a. Read a => VirtualWorkspace -> a
read) (VirtualWorkspace -> ScreenId)
-> (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace, VirtualWorkspace)
-> (ScreenId, VirtualWorkspace)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> VirtualWorkspace -> VirtualWorkspace
forall a. Int -> [a] -> [a]
drop Int
1) ((VirtualWorkspace, VirtualWorkspace)
-> (ScreenId, VirtualWorkspace))
-> (VirtualWorkspace -> (VirtualWorkspace, VirtualWorkspace))
-> VirtualWorkspace
-> (ScreenId, VirtualWorkspace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> VirtualWorkspace -> (VirtualWorkspace, VirtualWorkspace)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_')
unmarshallS :: VirtualWorkspace -> ScreenId
unmarshallS = (ScreenId, VirtualWorkspace) -> ScreenId
forall a b. (a, b) -> a
fst ((ScreenId, VirtualWorkspace) -> ScreenId)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall
unmarshallW :: VirtualWorkspace -> VirtualWorkspace
unmarshallW = (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall
workspaces' :: XConfig l -> [VirtualWorkspace]
workspaces' :: XConfig l -> [VirtualWorkspace]
workspaces' = [VirtualWorkspace] -> [VirtualWorkspace]
forall a. Eq a => [a] -> [a]
nub ([VirtualWorkspace] -> [VirtualWorkspace])
-> (XConfig l -> [VirtualWorkspace])
-> XConfig l
-> [VirtualWorkspace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualWorkspace -> VirtualWorkspace)
-> [VirtualWorkspace] -> [VirtualWorkspace]
forall a b. (a -> b) -> [a] -> [b]
map ((ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall) ([VirtualWorkspace] -> [VirtualWorkspace])
-> (XConfig l -> [VirtualWorkspace])
-> XConfig l
-> [VirtualWorkspace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l -> [VirtualWorkspace]
forall (l :: * -> *). XConfig l -> [VirtualWorkspace]
workspaces
withScreens :: ScreenId
-> [VirtualWorkspace]
-> [PhysicalWorkspace]
withScreens :: ScreenId -> [VirtualWorkspace] -> [VirtualWorkspace]
withScreens ScreenId
n [VirtualWorkspace]
vws = [ScreenId -> VirtualWorkspace -> VirtualWorkspace
marshall ScreenId
sc VirtualWorkspace
pws | VirtualWorkspace
pws <- [VirtualWorkspace]
vws, ScreenId
sc <- [ScreenId
0..ScreenId
nScreenId -> ScreenId -> ScreenId
forall a. Num a => a -> a -> a
-ScreenId
1]]
onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a)
onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a)
-> VirtualWorkspace -> WindowSet -> a
onCurrentScreen VirtualWorkspace -> WindowSet -> a
f VirtualWorkspace
vws = Screen
VirtualWorkspace (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
screen (Screen
VirtualWorkspace (Layout Window) Window ScreenId ScreenDetail
-> ScreenId)
-> (WindowSet
-> Screen
VirtualWorkspace (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen
VirtualWorkspace (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current (WindowSet -> ScreenId)
-> (ScreenId -> WindowSet -> a) -> WindowSet -> a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VirtualWorkspace -> WindowSet -> a
f (VirtualWorkspace -> WindowSet -> a)
-> (ScreenId -> VirtualWorkspace) -> ScreenId -> WindowSet -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId -> VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace -> ScreenId -> VirtualWorkspace
forall a b c. (a -> b -> c) -> b -> a -> c
flip ScreenId -> VirtualWorkspace -> VirtualWorkspace
marshall VirtualWorkspace
vws
countScreens :: (MonadIO m, Integral i) => m i
countScreens :: m i
countScreens = ([Rectangle] -> i) -> m [Rectangle] -> m i
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Rectangle] -> i
forall i a. Num i => [a] -> i
genericLength (m [Rectangle] -> m i)
-> (IO [Rectangle] -> m [Rectangle]) -> IO [Rectangle] -> m i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Rectangle] -> m [Rectangle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Rectangle] -> m i) -> IO [Rectangle] -> m i
forall a b. (a -> b) -> a -> b
$ VirtualWorkspace -> IO Display
openDisplay VirtualWorkspace
"" IO Display -> (Display -> IO [Rectangle]) -> IO [Rectangle]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO [Rectangle] -> IO () -> IO [Rectangle])
-> (Display -> IO [Rectangle])
-> (Display -> IO ())
-> Display
-> IO [Rectangle]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 IO [Rectangle] -> IO () -> IO [Rectangle]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) Display -> IO [Rectangle]
getScreenInfo Display -> IO ()
closeDisplay
marshallPP :: ScreenId -> PP -> PP
marshallPP :: ScreenId -> PP -> PP
marshallPP ScreenId
s PP
pp = PP
pp {
ppCurrent :: VirtualWorkspace -> VirtualWorkspace
ppCurrent = PP -> VirtualWorkspace -> VirtualWorkspace
ppCurrent PP
pp (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall,
ppVisible :: VirtualWorkspace -> VirtualWorkspace
ppVisible = PP -> VirtualWorkspace -> VirtualWorkspace
ppVisible PP
pp (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall,
ppHidden :: VirtualWorkspace -> VirtualWorkspace
ppHidden = PP -> VirtualWorkspace -> VirtualWorkspace
ppHidden PP
pp (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall,
ppHiddenNoWindows :: VirtualWorkspace -> VirtualWorkspace
ppHiddenNoWindows = PP -> VirtualWorkspace -> VirtualWorkspace
ppHiddenNoWindows PP
pp (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall,
ppUrgent :: VirtualWorkspace -> VirtualWorkspace
ppUrgent = PP -> VirtualWorkspace -> VirtualWorkspace
ppUrgent PP
pp (VirtualWorkspace -> VirtualWorkspace)
-> (VirtualWorkspace -> VirtualWorkspace)
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, VirtualWorkspace) -> VirtualWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, VirtualWorkspace) -> VirtualWorkspace)
-> (VirtualWorkspace -> (ScreenId, VirtualWorkspace))
-> VirtualWorkspace
-> VirtualWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualWorkspace -> (ScreenId, VirtualWorkspace)
unmarshall,
ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = (([WindowSpace] -> [WindowSpace])
-> [WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScreenId
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
marshallSort ScreenId
s) (PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp)
}
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn ScreenId
s PP
pp = PP
pp
{ ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = do
[WindowSpace] -> [WindowSpace]
sort <- PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp
([WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
forall (m :: * -> *) a. Monad m => a -> m a
return (([WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace]))
-> ([WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
forall a b. (a -> b) -> a -> b
$ \[WindowSpace]
xs -> case [WindowSpace]
xs of
WindowSpace
x:[WindowSpace]
_ | VirtualWorkspace -> ScreenId
unmarshallS (WindowSpace -> VirtualWorkspace
forall i l a. Workspace i l a -> i
tag WindowSpace
x) ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenId
s -> [WindowSpace] -> [WindowSpace]
sort [WindowSpace]
xs
[WindowSpace]
_ -> []
, ppOrder :: [VirtualWorkspace] -> [VirtualWorkspace]
ppOrder = \i :: [VirtualWorkspace]
i@(VirtualWorkspace
wss:[VirtualWorkspace]
_) -> case VirtualWorkspace
wss of
VirtualWorkspace
"" -> [VirtualWorkspace
"\0"]
VirtualWorkspace
_ -> PP -> [VirtualWorkspace] -> [VirtualWorkspace]
ppOrder PP
pp [VirtualWorkspace]
i
, ppOutput :: VirtualWorkspace -> IO ()
ppOutput = \VirtualWorkspace
out -> case VirtualWorkspace
out of
VirtualWorkspace
"\0" -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
VirtualWorkspace
_ -> PP -> VirtualWorkspace -> IO ()
ppOutput PP
pp VirtualWorkspace
out
}
marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace])
marshallSort :: ScreenId
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
marshallSort ScreenId
s [WindowSpace] -> [WindowSpace]
vSort = [WindowSpace] -> [WindowSpace]
pScreens ([WindowSpace] -> [WindowSpace])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
vSort ([WindowSpace] -> [WindowSpace])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
vScreens where
onScreen :: Workspace VirtualWorkspace l a -> Bool
onScreen Workspace VirtualWorkspace l a
ws = VirtualWorkspace -> ScreenId
unmarshallS (Workspace VirtualWorkspace l a -> VirtualWorkspace
forall i l a. Workspace i l a -> i
tag Workspace VirtualWorkspace l a
ws) ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenId
s
vScreens :: [WindowSpace] -> [WindowSpace]
vScreens = (WindowSpace -> WindowSpace) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WindowSpace
unmarshallWindowSpace ([WindowSpace] -> [WindowSpace])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter WindowSpace -> Bool
forall l a. Workspace VirtualWorkspace l a -> Bool
onScreen
pScreens :: [WindowSpace] -> [WindowSpace]
pScreens = (WindowSpace -> WindowSpace) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId -> WindowSpace -> WindowSpace
marshallWindowSpace ScreenId
s)
marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace
unmarshallWindowSpace :: WindowSpace -> WindowSpace
marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace
marshallWindowSpace ScreenId
s WindowSpace
ws = WindowSpace
ws { tag :: VirtualWorkspace
tag = ScreenId -> VirtualWorkspace -> VirtualWorkspace
marshall ScreenId
s (WindowSpace -> VirtualWorkspace
forall i l a. Workspace i l a -> i
tag WindowSpace
ws) }
unmarshallWindowSpace :: WindowSpace -> WindowSpace
unmarshallWindowSpace WindowSpace
ws = WindowSpace
ws { tag :: VirtualWorkspace
tag = VirtualWorkspace -> VirtualWorkspace
unmarshallW (WindowSpace -> VirtualWorkspace
forall i l a. Workspace i l a -> i
tag WindowSpace
ws) }