From d7735aa3cc1dbf273bb5464e15d9d4fea1b76495 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 12:12:07 +0200 Subject: Add initial DynamicPerScreenWorkspaces implementation --- lib/DynamicPerScreenWorkspaces.hs | 147 ++++++++++++++++++++++++++++++++++++++ lib/EwmhDesktops.hs | 9 +-- xmonad.hs | 50 +++++++------ 3 files changed, 178 insertions(+), 28 deletions(-) create mode 100644 lib/DynamicPerScreenWorkspaces.hs diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs new file mode 100644 index 0000000..8e52722 --- /dev/null +++ b/lib/DynamicPerScreenWorkspaces.hs @@ -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 diff --git a/lib/EwmhDesktops.hs b/lib/EwmhDesktops.hs index 74d0260..334233d 100644 --- a/lib/EwmhDesktops.hs +++ b/lib/EwmhDesktops.hs @@ -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 diff --git a/xmonad.hs b/xmonad.hs index 9d21184..29dfe7a 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -31,13 +31,12 @@ modm = mod4Mask main = xmonad $ ewmh $ defaultConfig { modMask = modm , manageHook = myManageHook - , unmanageHook = myUnmanageHook , layoutHook = desktopLayoutModifiers myLayoutHook , startupHook = myStartupHook , handleEventHook = myEventHook - , workspaces = myWorkspaces - , borderWidth = 0 , logHook = ewmhDesktopsLogHook + , focusedBorderColor = "#008000" + , rescreenHook = dynamicRescreenHook dwConfig } `additionalKeysP` ( [ ("M-a", sendMessage MirrorShrink) @@ -51,16 +50,21 @@ main = xmonad $ ewmh $ defaultConfig , ("M-", viewOrWarp 1) , ("M-", viewOrWarp 2) , ("M-b", banishScreen LowerRight) - , ("M-p", spawnOnCurrent "exe=`dmenu_path | /home/neoraider/bin/dmemu -b` && eval \"exec $exe\"") + , ("M-p", spawnOnCurrent "/home/neoraider/bin/dmemu_run -b") , ("M-g", gets (W.currentTag . windowset) >>= regroupProcess) , ("M-S-q", io (exitWith ExitSuccess)) , ("C-M1-l", spawn "gnome-screensaver-command --lock") , ("M-`", spawn "xclip -o | qrencode -s 10 -o- | display -geometry +0+0") + , ("", spawn "amixer -q sset Master 5%- unmute") + , ("", spawn "amixer -q sset Master toggle") + , ("", spawn "amixer -q sset Master 5%+ unmute") , ("M1-", kill) ] - ++ [ (("M-" ++ show n, windows $ W.greedyView ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] + -- ++ [ (("M-C-" ++ show n, windows $ W.greedyView ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] ++ [ (("M-S-" ++ show n, shiftGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] - ++ [ (("M-C-" ++ show n, shiftIgnoreGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] + -- ++ [ (("M-C-" ++ show n, shiftIgnoreGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] + ++ [ (("M-" ++ show n, view dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])] + ++ [ (("M-C-" ++ show n, viewOnCurrent dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])] ) `additionalMouseBindings` [ ((modm, button4), \_ -> sendMessage Shrink) @@ -70,7 +74,20 @@ main = xmonad $ ewmh $ defaultConfig ] -myWorkspaces = map (show . flip mod 10) [1..10] +myWorkspaces = map show [1..10] + +dwConfig :: DynamicWorkspaceConfig +dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen + , workspaceTag = show . (+1) + } + +defWSScreen :: WorkspaceScreens +defWSScreen 1 _ = S 0 + +defWSScreen _ i | i `elem` [0..7] = S 0 +defWSScreen _ i | i `elem` [8,9] = S 1 + +defWSScreen n i = S (i `mod` n) viewOrWarp :: Int -> X () @@ -82,13 +99,6 @@ viewOrWarp n = do whenJust ws $ \w -> windows . W.view $ w when (s == (W.screen . W.current $ wset)) $ warpToScreen s (1%2) (1%2) - ---myStartupHook :: X () ---myStartupHook = do --- startupHook gnomeConfig --- spawn "killall -u `id -un` -q xcompmgr; exec xcompmgr" - - setFullscreenSupported :: X () setFullscreenSupported = withDisplay $ \dpy -> do r <- asks theRoot @@ -104,7 +114,7 @@ myStartupHook = do startupHook desktopConfig setWMName "LG3D" setFullscreenSupported - spawn "ibus-daemon -r -x" + isUtility :: Query Bool isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" @@ -133,8 +143,7 @@ moveUp1 = stackHook up myManageHook :: ManageHook myManageHook = composeAll - [ moveDown1 - , isDialog --> doFloat + [ isDialog --> doFloat , composeOne [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) @@ -144,17 +153,18 @@ myManageHook = composeAll , className =? "jrummikub-JRummikub" -?> doFloat , className =? "Stjerm" -?> doFloatMaybeFullscreen , className =? "Display" -?> doFloat + , className =? "Dwarf_Fortress" -?> doFloat , className =? "Wine" -?> doFloat , className =? "Pcsx2" -?> doFloat - , stringProperty "WM_ICON_NAME" =? "ZeroGS" -?> doFloat + , stringProperty "WM_ICON_NAME" =? "ZZogl-pg" -?> doFloat , isFullscreen -?> doFullscreen ] , isUtility =? False --> doAutoShift , manageHook desktopConfig ] -myUnmanageHook :: ManageHook -myUnmanageHook = moveUp1 +--myUnmanageHook :: ManageHook +--myUnmanageHook = moveUp1 myLayoutHook = processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) -- cgit v1.2.3