Add initial DynamicPerScreenWorkspaces implementation
This commit is contained in:
parent
4456299ef5
commit
d7735aa3cc
3 changed files with 178 additions and 28 deletions
147
lib/DynamicPerScreenWorkspaces.hs
Normal file
147
lib/DynamicPerScreenWorkspaces.hs
Normal file
|
|
@ -0,0 +1,147 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
module DynamicPerScreenWorkspaces ( WorkspaceScreens
|
||||
, DynamicWorkspaceConfig(..)
|
||||
, dynamicRescreenHook
|
||||
, view
|
||||
, viewOn
|
||||
, viewOnCurrent
|
||||
) where
|
||||
|
||||
import XMonad hiding (hide)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.Monad
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
|
||||
import Storage
|
||||
|
||||
import System.IO
|
||||
|
||||
|
||||
data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId)
|
||||
deriving (Typeable, Show, Read)
|
||||
instance StoreData DynamicWorkspaceStoreData
|
||||
|
||||
screenWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage DynamicWorkspaceStoreData) l a
|
||||
screenWorkspaceStorage = storage (DWSD M.empty)
|
||||
|
||||
|
||||
type WorkspaceScreens = Int -> Int -> ScreenId
|
||||
|
||||
data DynamicWorkspaceConfig = DynamicWorkspaceConfig
|
||||
{ defaultWorkspaceScreen :: !WorkspaceScreens
|
||||
, workspaceTag :: !(Int -> WorkspaceId)
|
||||
}
|
||||
|
||||
defaultScreenWorkspaces :: DynamicWorkspaceConfig -> Int -> ScreenId -> [Int]
|
||||
defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf n) [0..]
|
||||
|
||||
|
||||
dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X ()
|
||||
dynamicRescreenHook conf sds = do
|
||||
layout <- asks $ layoutHook . config
|
||||
windows $ cleanup . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
|
||||
|
||||
mkWS i = let tag = workspaceTag conf i
|
||||
in W.Workspace tag layout Nothing
|
||||
|
||||
mkScreen sid (Just ws) sd = W.Screen ws sid sd
|
||||
mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd
|
||||
|
||||
(s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds
|
||||
in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset}
|
||||
|
||||
workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId
|
||||
workspaceScreen conf i = do
|
||||
wset <- gets windowset
|
||||
d <- getStoreData
|
||||
let defaultScreen = defaultWorkspaceScreen conf (length $ W.screens wset) i
|
||||
return $ case d of
|
||||
Just (DWSD wsscreens) -> do
|
||||
case (M.lookup i wsscreens) of
|
||||
Just s -> s
|
||||
Nothing -> defaultScreen
|
||||
_ ->
|
||||
defaultScreen
|
||||
|
||||
hide :: DynamicWorkspaceConfig -> Int -> WindowSet -> X WindowSet
|
||||
hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset
|
||||
where
|
||||
hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s)
|
||||
hideOn _ = return
|
||||
|
||||
cleanup :: WindowSet -> WindowSet
|
||||
cleanup wset = wset { W.hidden = hidden' }
|
||||
where
|
||||
hidden' = filter (isJust . W.stack) $ W.hidden wset
|
||||
|
||||
viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
|
||||
viewOn' conf sid i wset = do
|
||||
io $ do
|
||||
file <- openFile "/tmp/log" AppendMode
|
||||
hPrint file "viewOn'"
|
||||
hPrint file wset
|
||||
hPrint file i
|
||||
hClose file
|
||||
|
||||
let tag = workspaceTag conf i
|
||||
case W.tagMember tag wset of
|
||||
False -> viewEmpty conf sid i wset
|
||||
True -> do
|
||||
wset' <- hide conf i wset
|
||||
let mws = W.lookupWorkspace sid wset'
|
||||
|
||||
io $ do
|
||||
file <- openFile "/tmp/log" AppendMode
|
||||
hPrint file "viewOn'+"
|
||||
hPrint file wset
|
||||
hPrint file mws
|
||||
hPrint file tag
|
||||
hClose file
|
||||
|
||||
return $ case mws of
|
||||
Just ws -> W.view tag . W.view ws $ wset'
|
||||
Nothing -> wset'
|
||||
|
||||
viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
|
||||
viewEmpty conf sid i wset = do
|
||||
layout <- asks $ layoutHook . config
|
||||
|
||||
let tag = workspaceTag conf i
|
||||
workspace = W.Workspace tag layout Nothing
|
||||
|
||||
if W.tagMember tag wset then return wset else viewOn' conf sid i wset { W.hidden = workspace:(W.hidden wset) }
|
||||
|
||||
nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int
|
||||
nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid
|
||||
|
||||
nextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> Int
|
||||
nextEmpty conf sid wset = nextEmpty' conf (length $ W.screens wset) sid wset
|
||||
|
||||
viewNextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> X WindowSet
|
||||
viewNextEmpty conf sid wset = viewEmpty conf sid (nextEmpty conf sid wset) wset
|
||||
|
||||
windows' :: (WindowSet -> X WindowSet) -> X ()
|
||||
windows' f = do
|
||||
wset <- gets windowset
|
||||
wset' <- f wset
|
||||
windows . const . cleanup $ wset'
|
||||
|
||||
view :: DynamicWorkspaceConfig -> Int -> X ()
|
||||
view conf i = do
|
||||
sid <- workspaceScreen conf i
|
||||
windows' $ viewOn' conf sid i
|
||||
|
||||
viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X ()
|
||||
viewOn conf sid i = do
|
||||
updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m
|
||||
windows' $ viewOn' conf sid i
|
||||
|
||||
viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X ()
|
||||
viewOnCurrent conf i = do
|
||||
sid <- gets (W.screen . W.current . windowset)
|
||||
viewOn conf sid i
|
||||
|
|
@ -85,14 +85,7 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
|
|||
Just curr -> do
|
||||
setCurrentDesktop curr
|
||||
|
||||
-- Per window Desktop
|
||||
-- To make gnome-panel accept our xinerama stuff, we display
|
||||
-- all visible windows on the current desktop.
|
||||
forM_ (W.current s : W.visible s) $ \x ->
|
||||
forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
|
||||
setWindowDesktop win curr
|
||||
|
||||
forM_ (W.hidden s) $ \w ->
|
||||
forM_ (map W.workspace (W.current s : W.visible s) ++ W.hidden s) $ \w ->
|
||||
case elemIndex (W.tag w) (map W.tag ws) of
|
||||
Nothing -> return ()
|
||||
Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
|
||||
|
|
|
|||
Reference in a new issue