summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/DynamicPerScreenWorkspaces.hs147
-rw-r--r--lib/EwmhDesktops.hs9
-rw-r--r--xmonad.hs50
3 files changed, 178 insertions, 28 deletions
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-<F2>", viewOrWarp 1)
, ("M-<F3>", 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")
+ , ("<XF86AudioLowerVolume>", spawn "amixer -q sset Master 5%- unmute")
+ , ("<XF86AudioMute>", spawn "amixer -q sset Master toggle")
+ , ("<XF86AudioRaiseVolume>", spawn "amixer -q sset Master 5%+ unmute")
, ("M1-<F4>", 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)