From 5af4daccc8db2f097d612360292c274f3cad7f33 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 28 Feb 2011 23:51:55 +0100 Subject: [PATCH 01/10] Simplify utility window query --- xmonad.hs | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/xmonad.hs b/xmonad.hs index f458ad4..b66154a 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -86,20 +86,8 @@ myStartupHook = do setWMName "LG3D" -atomProperty :: String -> Query Atom -atomProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe 0) $ getAtomProperty d w p) - -getAtomProperty :: Display -> Window -> String -> X (Maybe Atom) -getAtomProperty d w p = do - a <- getAtom p - md <- io $ getWindowProperty32 d a w - return $ fmap fromIntegral $ listToMaybe $ fromMaybe [] md - isUtility :: Query Bool -isUtility = do - atom__NET_WM_WINDOW_TYPE_UTILITY <- liftX $ getAtom "_NET_WM_WINDOW_TYPE_UTILITY" - atomProperty "_NET_WM_WINDOW_TYPE" =? atom__NET_WM_WINDOW_TYPE_UTILITY - +isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" myManageHook :: ManageHook myManageHook = composeAll From 2ec96d9c2482ecf55358bdb4218c60dadd8aecbd Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Tue, 1 Mar 2011 02:31:21 +0100 Subject: [PATCH 02/10] Forget empty window groups --- lib/ProcessWorkspaces.hs | 32 ++++++++++++++++++++++++++++---- xmonad.hs | 11 +++++------ 2 files changed, 33 insertions(+), 10 deletions(-) diff --git a/lib/ProcessWorkspaces.hs b/lib/ProcessWorkspaces.hs index 8789c51..72f4270 100644 --- a/lib/ProcessWorkspaces.hs +++ b/lib/ProcessWorkspaces.hs @@ -4,13 +4,16 @@ module ProcessWorkspaces ( setProcessWorkspace , getProcessWorkspace , doAutoShift , doIgnoreProcessWorkspace + , ignoreProcessWorkspace + , ignoreWinProcessWorkspace , regroupProcess , regroupWinProcess , shiftIgnoreGroup , shiftWinIgnoreGroup , shiftGroup , shiftWinGroup - , processWorkspaceStorage + , handleForgetEmptyWindowGroups + , processWorkspaceManager , spawnOn , spawnOnCurrent ) where @@ -21,17 +24,20 @@ import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) import XMonad.Hooks.ManageHelpers (pid) import Graphics.X11.Types (Window) +import Graphics.X11.Xlib.Extras (Event) import System.Posix.Process (getProcessPriority) import System.Posix.Types (ProcessID) import Control.Monad import Data.Maybe +import Data.Monoid import qualified Data.Map as M import Storage + doAutoShift :: ManageHook doAutoShift = do mp <- pid @@ -53,6 +59,12 @@ doIgnoreProcessWorkspace = do liftX $ setProcessWorkspace (fromJust mp) Nothing idHook +ignoreProcessWorkspace :: X () +ignoreProcessWorkspace = withFocused ignoreWinProcessWorkspace + +ignoreWinProcessWorkspace :: Window -> X () +ignoreWinProcessWorkspace w = runQuery doIgnoreProcessWorkspace w >> return () + regroupProcess :: WorkspaceId -> X () regroupProcess ws = withFocused $ regroupWinProcess ws @@ -67,7 +79,7 @@ shiftIgnoreGroup ws = withFocused $ shiftWinIgnoreGroup ws shiftWinIgnoreGroup :: WorkspaceId -> Window -> X () shiftWinIgnoreGroup ws w = do - runQuery doIgnoreProcessWorkspace w + ignoreWinProcessWorkspace w windows $ W.shiftWin ws w shiftGroup :: WorkspaceId -> X () @@ -89,13 +101,25 @@ shiftWinGroup ws w = do _ -> windows $ W.shiftWin ws w +handleForgetEmptyWindowGroups :: Event -> X All +handleForgetEmptyWindowGroups (UnmapEvent {ev_window = w}) = do + mp <- runQuery pid w + when (isJust mp) $ do + wins <- withWindowSet $ return . W.allWindows + hasWindows <- foldM (\b w' -> liftM ((|| b) . (&& (w /= w')) . (== mp)) . runQuery pid $ w') False wins + unless hasWindows $ updateStoreData ((\(ProcessWorkspaceStoreData map) -> ProcessWorkspaceStoreData $ M.delete (fromJust mp) map)) + return $ All True + +handleForgetEmptyWindowGroups _ = return $ All True + data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID (Maybe WorkspaceId)) deriving (Typeable, Show, Read) instance StoreData ProcessWorkspaceStoreData -processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a -processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty + +processWorkspaceManager :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a +processWorkspaceManager = storage (ProcessWorkspaceStoreData M.empty) setProcessWorkspace :: ProcessID -> Maybe WorkspaceId -> X () setProcessWorkspace pid ws = do diff --git a/xmonad.hs b/xmonad.hs index b66154a..6c8b522 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -93,12 +93,10 @@ myManageHook :: ManageHook myManageHook = composeAll [ isDialog --> doFloat , composeOne - [ className =? "Guake.py" -?> (doFloatMaybeFullscreen <+> doIgnoreProcessWorkspace) -- <+> doConfigBorderOff) - --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) - , className =? "Gmpc" -?> doIgnoreProcessWorkspace - , className =? "Liferea" -?> doIgnoreProcessWorkspace - , className =? "Gnome-session" -?> doIgnoreProcessWorkspace + [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) + --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) , className =? "MPlayer" -?> doCenterFloat + , className =? "Gnome-session" -?> doIgnoreProcessWorkspace , className =? "Gimp" -?> doFloat , className =? "Display" -?> doFloat , className =? "Wine" -?> doFloat @@ -111,7 +109,7 @@ myManageHook = composeAll ] -myLayoutHook = processWorkspaceStorage $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) +myLayoutHook = processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) where -- default tiling algorithm partitions the screen into two panes tiled = ResizableTall nmaster delta ratio [] @@ -127,5 +125,6 @@ myLayoutHook = processWorkspaceStorage $ manageFullscreen $ smartBorders (Full | myEventHook :: Event -> X All myEventHook ev = do + handleForgetEmptyWindowGroups ev handleFullscreen ev (handleEventHook gnomeConfig) ev From e29db941e75488dfafc4268b5c8f297de1381bad Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 18 Jul 2011 14:05:19 +0200 Subject: [PATCH 03/10] Fixed window ordering --- lib/EwmhDesktops.hs | 249 ++++++++++++++++++++++++++++++++++++++++++++ xmonad.hs | 47 +++++++-- 2 files changed, 287 insertions(+), 9 deletions(-) create mode 100644 lib/EwmhDesktops.hs diff --git a/lib/EwmhDesktops.hs b/lib/EwmhDesktops.hs new file mode 100644 index 0000000..74d0260 --- /dev/null +++ b/lib/EwmhDesktops.hs @@ -0,0 +1,249 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.EwmhDesktops +-- Copyright : (c) 2007, 2008 Joachim Breitner +-- License : BSD +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- Makes xmonad use the EWMH hints to tell panel applications about its +-- workspaces and the windows therein. It also allows the user to interact +-- with xmonad by clicking on panels and window lists. +----------------------------------------------------------------------------- +module EwmhDesktops ( + -- * Usage + -- $usage + ewmh, + ewmhDesktopsStartup, + ewmhDesktopsLogHook, + ewmhDesktopsEventHook, + fullscreenEventHook + ) where + +import Codec.Binary.UTF8.String (encode) +import Data.List +import Data.Maybe +import Data.Monoid + +import XMonad +import Control.Monad +import qualified XMonad.StackSet as W + +import XMonad.Hooks.SetWMName +import XMonad.Util.XUtils (fi) +import XMonad.Util.WorkspaceCompare +import XMonad.Util.WindowProperties (getProp32) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Hooks.EwmhDesktops +-- > +-- > main = xmonad $ ewmh defaultConfig +-- +-- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks. + + +-- | Add EWMH functionality to the given config. See above for an example. +ewmh :: XConfig a -> XConfig a +ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup + , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook + , logHook = logHook c +++ ewmhDesktopsLogHook } + where x +++ y = mappend x y + +-- | +-- Initializes EwmhDesktops and advertises EWMH support to the X +-- server +ewmhDesktopsStartup :: X () +ewmhDesktopsStartup = setSupported + +-- | +-- Notifies pagers and window lists, such as those in the gnome-panel +-- of the current state of workspaces and windows. +ewmhDesktopsLogHook :: X () +ewmhDesktopsLogHook = withWindowSet $ \s -> do + sort' <- getSortByIndex + let ws = sort' $ W.workspaces s + + -- Number of Workspaces + setNumberOfDesktops (length ws) + + -- Names thereof + setDesktopNames (map W.tag ws) + + let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ [x] ++ r) . W.stack) $ ws + -- all windows, with focused windows last + winsStacking = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws + setClientList wins winsStacking + + -- Current desktop + case (elemIndex (W.currentTag s) $ map W.tag ws) of + Nothing -> return () + 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 -> + case elemIndex (W.tag w) (map W.tag ws) of + Nothing -> return () + Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn + + setActiveWindow + + return () + +-- | +-- Intercepts messages from pagers and similar applications and reacts on them. +-- Currently supports: +-- +-- * _NET_CURRENT_DESKTOP (switching desktops) +-- +-- * _NET_WM_DESKTOP (move windows to other desktops) +-- +-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) +-- +ewmhDesktopsEventHook :: Event -> X All +ewmhDesktopsEventHook e = handle e >> return (All True) + +handle :: Event -> X () +handle ClientMessageEvent { + ev_window = w, + ev_message_type = mt, + ev_data = d + } = withWindowSet $ \s -> do + sort' <- getSortByIndex + let ws = sort' $ W.workspaces s + + a_cd <- getAtom "_NET_CURRENT_DESKTOP" + a_d <- getAtom "_NET_WM_DESKTOP" + a_aw <- getAtom "_NET_ACTIVE_WINDOW" + a_cw <- getAtom "_NET_CLOSE_WINDOW" + a_ignore <- mapM getAtom ["XMONAD_TIMER"] + if mt == a_cd then do + let n = head d + if 0 <= n && fi n < length ws then + windows $ W.view (W.tag (ws !! fi n)) + else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n + else if mt == a_d then do + let n = head d + if 0 <= n && fi n < length ws then + windows $ W.shiftWin (W.tag (ws !! fi n)) w + else trace $ "Bad _NET_DESKTOP with data[0]="++show n + else if mt == a_aw then do + windows $ W.focusWindow w + else if mt == a_cw then do + killWindow w + else if mt `elem` a_ignore then do + return () + else do + -- The Message is unknown to us, but that is ok, not all are meant + -- to be handled by the window manager + return () +handle _ = return () + +-- | +-- An event hook to handle applications that wish to fullscreen using the +-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() +-- function, such as Totem, Evince and OpenOffice.org. +fullscreenEventHook :: Event -> X All +fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do + state <- getAtom "_NET_WM_STATE" + fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" + wstate <- fromMaybe [] `fmap` getProp32 state win + + let isFull = fromIntegral fullsc `elem` wstate + + -- Constants for the _NET_WM_STATE protocol: + remove = 0 + add = 1 + toggle = 2 + ptype = 4 -- The atom property type for changeProperty + chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate) + + when (typ == state && fi fullsc `elem` dats) $ do + when (action == add || (action == toggle && not isFull)) $ do + chWstate (fi fullsc:) + windows $ W.float win $ W.RationalRect 0 0 1 1 + when (action == remove || (action == toggle && isFull)) $ do + chWstate $ delete (fi fullsc) + windows $ W.sink win + + return $ All True + +fullscreenEventHook _ = return $ All True + +setNumberOfDesktops :: (Integral a) => a -> X () +setNumberOfDesktops n = withDisplay $ \dpy -> do + a <- getAtom "_NET_NUMBER_OF_DESKTOPS" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] + +setCurrentDesktop :: (Integral a) => a -> X () +setCurrentDesktop i = withDisplay $ \dpy -> do + a <- getAtom "_NET_CURRENT_DESKTOP" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] + +setDesktopNames :: [String] -> X () +setDesktopNames names = withDisplay $ \dpy -> do + -- Names thereof + r <- asks theRoot + a <- getAtom "_NET_DESKTOP_NAMES" + c <- getAtom "UTF8_STRING" + let names' = map fromIntegral $ concatMap ((++[0]) . encode) names + io $ changeProperty8 dpy r a c propModeReplace names' + +setClientList :: [Window] -> [Window] -> X () +setClientList wins winsStacking = withDisplay $ \dpy -> do + -- (What order do we really need? Something about age and stacking) + r <- asks theRoot + c <- getAtom "WINDOW" + a <- getAtom "_NET_CLIENT_LIST" + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) + a' <- getAtom "_NET_CLIENT_LIST_STACKING" + io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral winsStacking) + +setWindowDesktop :: (Integral a) => Window -> a -> X () +setWindowDesktop win i = withDisplay $ \dpy -> do + a <- getAtom "_NET_WM_DESKTOP" + c <- getAtom "CARDINAL" + io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] + +setSupported :: X () +setSupported = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_SUPPORTED" + c <- getAtom "ATOM" + supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN" + ,"_NET_NUMBER_OF_DESKTOPS" + ,"_NET_CLIENT_LIST" + ,"_NET_CLIENT_LIST_STACKING" + ,"_NET_CURRENT_DESKTOP" + ,"_NET_DESKTOP_NAMES" + ,"_NET_ACTIVE_WINDOW" + ,"_NET_WM_DESKTOP" + ,"_NET_WM_STRUT" + ] + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) + + setWMName "xmonad" + +setActiveWindow :: X () +setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do + let w = fromMaybe none (W.peek s) + r <- asks theRoot + a <- getAtom "_NET_ACTIVE_WINDOW" + c <- getAtom "WINDOW" + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w] diff --git a/xmonad.hs b/xmonad.hs index 6c8b522..a9c321d 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -1,6 +1,5 @@ import XMonad import XMonad.Config.Desktop -import XMonad.Config.Gnome import XMonad.Actions.CycleWS import XMonad.Actions.NoBorders import XMonad.Actions.PhysicalScreens @@ -17,8 +16,11 @@ import Control.Monad.Trans import Data.Maybe import Data.Monoid import Ratio((%)) +import System.Exit --import ConfigurableBorders +import DynamicPerScreenWorkspaces +import EwmhDesktops import FullscreenManager import NoBorders import ProcessWorkspaces @@ -26,13 +28,15 @@ import ProcessWorkspaces modm = mod4Mask -main = xmonad $ gnomeConfig +main = xmonad $ ewmh $ defaultConfig { modMask = modm , manageHook = myManageHook , layoutHook = desktopLayoutModifiers myLayoutHook , startupHook = myStartupHook , handleEventHook = myEventHook , workspaces = myWorkspaces + , borderWidth = 0 + , logHook = ewmhDesktopsLogHook } `additionalKeysP` ( [ ("M-a", sendMessage MirrorShrink) @@ -42,13 +46,16 @@ main = xmonad $ gnomeConfig , ("M-S-", shiftToPrev) , ("M-S-", shiftToNext) , ("M-S-b", withFocused toggleBorder >> refresh) - , ("M1-", kill) , ("M-", viewOrWarp 0) , ("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-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") + , ("M1-", kill) ] ++ [ (("M-" ++ 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])] @@ -62,7 +69,7 @@ main = xmonad $ gnomeConfig ] -myWorkspaces = ["Firefox", "Thunderbird", "Emacs", "4", "5", "6", "7", "8", "Chat", "10"] +myWorkspaces = map (show . flip mod 10) [1..10] viewOrWarp :: Int -> X () @@ -80,24 +87,46 @@ viewOrWarp n = do -- startupHook gnomeConfig -- spawn "killall -u `id -un` -q xcompmgr; exec xcompmgr" + +setFullscreenSupported :: X () +setFullscreenSupported = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_SUPPORTED" + c <- getAtom "ATOM" + f <- getAtom "_NET_WM_STATE_FULLSCREEN" + io $ changeProperty32 dpy r a c propModeAppend [fromIntegral f] + + + myStartupHook :: X () myStartupHook = do - startupHook gnomeConfig + startupHook desktopConfig setWMName "LG3D" - + setFullscreenSupported + spawn "ibus-daemon -r -x" isUtility :: Query Bool isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" +moveToBottom :: ManageHook +moveToBottom = doF $ \windowSet@W.StackSet {W.current = screen@W.Screen {W.workspace = ws@W.Workspace {W.stack = windowStack}}} -> + let windowStack' = fmap (\(W.Stack f u d) -> W.Stack f (reverse d ++ u) []) windowStack + in windowSet { W.current = screen {W.workspace = ws {W.stack = windowStack'}} } + + + myManageHook :: ManageHook myManageHook = composeAll - [ isDialog --> doFloat + [ moveToBottom + , isDialog --> doFloat , composeOne [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) , className =? "MPlayer" -?> doCenterFloat , className =? "Gnome-session" -?> doIgnoreProcessWorkspace , className =? "Gimp" -?> doFloat + , className =? "jrummikub-JRummikub" -?> doFloat + , className =? "Stjerm" -?> doFloatMaybeFullscreen , className =? "Display" -?> doFloat , className =? "Wine" -?> doFloat , className =? "Pcsx2" -?> doFloat @@ -105,7 +134,7 @@ myManageHook = composeAll , isFullscreen -?> doFullscreen ] , isUtility =? False --> doAutoShift - , manageHook gnomeConfig + , manageHook desktopConfig ] @@ -127,4 +156,4 @@ myEventHook :: Event -> X All myEventHook ev = do handleForgetEmptyWindowGroups ev handleFullscreen ev - (handleEventHook gnomeConfig) ev + handleEventHook defaultConfig ev From 527abbe03a87d4c352ad719967b2c4cdff545dfa Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 18 Jul 2011 14:16:53 +0200 Subject: [PATCH 04/10] The last fix wasn't a good idea after all... --- xmonad.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/xmonad.hs b/xmonad.hs index a9c321d..55868b8 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -108,17 +108,10 @@ myStartupHook = do isUtility :: Query Bool isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" -moveToBottom :: ManageHook -moveToBottom = doF $ \windowSet@W.StackSet {W.current = screen@W.Screen {W.workspace = ws@W.Workspace {W.stack = windowStack}}} -> - let windowStack' = fmap (\(W.Stack f u d) -> W.Stack f (reverse d ++ u) []) windowStack - in windowSet { W.current = screen {W.workspace = ws {W.stack = windowStack'}} } - - myManageHook :: ManageHook myManageHook = composeAll - [ moveToBottom - , isDialog --> doFloat + [ isDialog --> doFloat , composeOne [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) From 4456299ef5af8958e777a92667f130990fdc88eb Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 18 Jul 2011 15:20:40 +0200 Subject: [PATCH 05/10] A better solution for correct ordering :) --- xmonad.hs | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/xmonad.hs b/xmonad.hs index 55868b8..9d21184 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -31,6 +31,7 @@ modm = mod4Mask main = xmonad $ ewmh $ defaultConfig { modMask = modm , manageHook = myManageHook + , unmanageHook = myUnmanageHook , layoutHook = desktopLayoutModifiers myLayoutHook , startupHook = myStartupHook , handleEventHook = myEventHook @@ -108,10 +109,32 @@ myStartupHook = do isUtility :: Query Bool isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" +stackHook :: (Window -> W.Stack Window -> W.Stack Window) -> ManageHook +stackHook f = ask >>= \w -> doF $ \s -> s { W.current = mapScreen w (W.current s) + , W.visible = map (mapScreen w) (W.visible s) + , W.hidden = map (mapWorkspace w) (W.hidden s) + } + where + mapWorkspace w ws = ws { W.stack = fmap (f w) $ W.stack ws } + mapScreen w scr = scr { W.workspace = mapWorkspace w (W.workspace scr) } + +moveDown1 :: ManageHook +moveDown1 = stackHook down + where + down w (W.Stack c u (d:dx)) | c == w = W.Stack c (d:u) dx + down _ stack = stack + +moveUp1 :: ManageHook +moveUp1 = stackHook up + where + up w (W.Stack c (u:ux) d) | c == w = W.Stack c ux (u:d) + up _ stack = stack + myManageHook :: ManageHook myManageHook = composeAll - [ isDialog --> doFloat + [ moveDown1 + , isDialog --> doFloat , composeOne [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) @@ -129,7 +152,10 @@ myManageHook = composeAll , isUtility =? False --> doAutoShift , manageHook desktopConfig ] - + +myUnmanageHook :: ManageHook +myUnmanageHook = moveUp1 + myLayoutHook = processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) where From d7735aa3cc1dbf273bb5464e15d9d4fea1b76495 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 12:12:07 +0200 Subject: [PATCH 06/10] 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) From daadcaa31bf5bff6111a1d0cf7fee161b985cdab Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 13:00:38 +0200 Subject: [PATCH 07/10] DynamicPerScreenWorkspaces mostly working --- lib/DynamicPerScreenWorkspaces.hs | 65 ++++++++++++++----------------- xmonad.hs | 13 +++---- 2 files changed, 35 insertions(+), 43 deletions(-) diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs index 8e52722..c54e9a1 100644 --- a/lib/DynamicPerScreenWorkspaces.hs +++ b/lib/DynamicPerScreenWorkspaces.hs @@ -3,6 +3,8 @@ module DynamicPerScreenWorkspaces ( WorkspaceScreens , DynamicWorkspaceConfig(..) , dynamicRescreenHook + , create + , cleanup , view , viewOn , viewOnCurrent @@ -19,8 +21,6 @@ import Data.Maybe import Storage -import System.IO - data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId) deriving (Typeable, Show, Read) @@ -44,16 +44,16 @@ defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf 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) + 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} + 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 @@ -74,20 +74,13 @@ hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset 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' } +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 @@ -95,26 +88,20 @@ viewOn' conf sid i wset = 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 +create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet +create' 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) } + return $ if W.tagMember tag wset then wset else wset { W.hidden = workspace:(W.hidden wset) } + +viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet +viewEmpty conf sid i = create' conf sid i >=> viewOn' conf sid i 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 @@ -129,17 +116,25 @@ windows' :: (WindowSet -> X WindowSet) -> X () windows' f = do wset <- gets windowset wset' <- f wset - windows . const . cleanup $ wset' + windows . const $ wset' + +create :: DynamicWorkspaceConfig -> Int -> X () +create conf i = do + sid <- workspaceScreen conf i + windows' $ create' conf sid i + +cleanup :: X () +cleanup = windows cleanup' view :: DynamicWorkspaceConfig -> Int -> X () view conf i = do sid <- workspaceScreen conf i - windows' $ viewOn' conf sid i + windows' $ liftM cleanup' . 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 + windows' $ liftM cleanup' . viewOn' conf sid i viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X () viewOnCurrent conf i = do diff --git a/xmonad.hs b/xmonad.hs index 29dfe7a..637dd6e 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -60,11 +60,10 @@ main = xmonad $ ewmh $ defaultConfig , ("", spawn "amixer -q sset Master 5%+ unmute") , ("M1-", kill) ] - -- ++ [ (("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-" ++ 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])] + ++ [ ("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])] + ++ [ ("M-S-" ++ show n, create dwConfig ws >> shiftGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])] + ++ [ ("M-S-C-" ++ show n, create dwConfig ws >> shiftIgnoreGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])] ) `additionalMouseBindings` [ ((modm, button4), \_ -> sendMessage Shrink) @@ -74,8 +73,6 @@ main = xmonad $ ewmh $ defaultConfig ] -myWorkspaces = map show [1..10] - dwConfig :: DynamicWorkspaceConfig dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen , workspaceTag = show . (+1) @@ -87,7 +84,7 @@ 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) +defWSScreen n i = S ((i-10) `mod` n) viewOrWarp :: Int -> X () From 6ce8a6515eba6b979095efe30eaa7c978e16a27f Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 13:09:55 +0200 Subject: [PATCH 08/10] Use screenWorkspaceStorage --- lib/DynamicPerScreenWorkspaces.hs | 4 +++- xmonad.hs | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs index c54e9a1..263174d 100644 --- a/lib/DynamicPerScreenWorkspaces.hs +++ b/lib/DynamicPerScreenWorkspaces.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} -module DynamicPerScreenWorkspaces ( WorkspaceScreens +module DynamicPerScreenWorkspaces ( screenWorkspaceStorage + , WorkspaceScreens , DynamicWorkspaceConfig(..) , dynamicRescreenHook , create @@ -59,6 +60,7 @@ 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 diff --git a/xmonad.hs b/xmonad.hs index 637dd6e..d2c3ba8 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -164,7 +164,7 @@ myManageHook = composeAll --myUnmanageHook = moveUp1 -myLayoutHook = processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) +myLayoutHook = screenWorkspaceStorage $ processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) where -- default tiling algorithm partitions the screen into two panes tiled = ResizableTall nmaster delta ratio [] From 01a381911a2ce989c9e9e5ff470ff67f16a4a4f7 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 13:43:11 +0200 Subject: [PATCH 09/10] Adjusted EwmhDesktops module --- lib/DynamicPerScreenWorkspaces.hs | 10 ++++++++++ lib/EwmhDesktops.hs | 27 ++++++++++++++++----------- xmonad.hs | 2 +- 3 files changed, 27 insertions(+), 12 deletions(-) diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs index 263174d..66bbf11 100644 --- a/lib/DynamicPerScreenWorkspaces.hs +++ b/lib/DynamicPerScreenWorkspaces.hs @@ -6,6 +6,7 @@ module DynamicPerScreenWorkspaces ( screenWorkspaceStorage , dynamicRescreenHook , create , cleanup + , focusWindow , view , viewOn , viewOnCurrent @@ -128,6 +129,15 @@ create conf i = do cleanup :: X () cleanup = windows cleanup' +focusWindow :: DynamicWorkspaceConfig -> Window -> X () +focusWindow conf w = do + wset <- gets windowset + let mws = W.findTag w wset + whenJust mws $ \ws -> do + let i = head $ filter ((== ws) . workspaceTag conf) [0..] + sid <- workspaceScreen conf i + windows' $ liftM (cleanup' . W.focusWindow w) . viewOn' conf sid i + view :: DynamicWorkspaceConfig -> Int -> X () view conf i = do sid <- workspaceScreen conf i diff --git a/lib/EwmhDesktops.hs b/lib/EwmhDesktops.hs index 334233d..12b1688 100644 --- a/lib/EwmhDesktops.hs +++ b/lib/EwmhDesktops.hs @@ -36,6 +36,8 @@ import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) +import DynamicPerScreenWorkspaces + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- @@ -48,10 +50,10 @@ import XMonad.Util.WindowProperties (getProp32) -- | Add EWMH functionality to the given config. See above for an example. -ewmh :: XConfig a -> XConfig a -ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup - , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook - , logHook = logHook c +++ ewmhDesktopsLogHook } +ewmh :: DynamicWorkspaceConfig -> XConfig a -> XConfig a +ewmh dwc c = c { startupHook = startupHook c +++ ewmhDesktopsStartup + , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook dwc + , logHook = logHook c +++ ewmhDesktopsLogHook } where x +++ y = mappend x y -- | @@ -105,11 +107,11 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do -- -- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) -- -ewmhDesktopsEventHook :: Event -> X All -ewmhDesktopsEventHook e = handle e >> return (All True) +ewmhDesktopsEventHook :: DynamicWorkspaceConfig -> Event -> X All +ewmhDesktopsEventHook dwc e = handle dwc e >> return (All True) -handle :: Event -> X () -handle ClientMessageEvent { +handle :: DynamicWorkspaceConfig -> Event -> X () +handle dwc ClientMessageEvent { ev_window = w, ev_message_type = mt, ev_data = d @@ -125,7 +127,9 @@ handle ClientMessageEvent { if mt == a_cd then do let n = head d if 0 <= n && fi n < length ws then - windows $ W.view (W.tag (ws !! fi n)) + --windows $ W.view (W.tag (ws !! fi n)) + --view dwc $ fi n + return () else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n else if mt == a_d then do let n = head d @@ -133,7 +137,8 @@ handle ClientMessageEvent { windows $ W.shiftWin (W.tag (ws !! fi n)) w else trace $ "Bad _NET_DESKTOP with data[0]="++show n else if mt == a_aw then do - windows $ W.focusWindow w + --windows $ W.focusWindow w + focusWindow dwc w else if mt == a_cw then do killWindow w else if mt `elem` a_ignore then do @@ -142,7 +147,7 @@ handle ClientMessageEvent { -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager return () -handle _ = return () +handle _ _ = return () -- | -- An event hook to handle applications that wish to fullscreen using the diff --git a/xmonad.hs b/xmonad.hs index d2c3ba8..486db50 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -28,7 +28,7 @@ import ProcessWorkspaces modm = mod4Mask -main = xmonad $ ewmh $ defaultConfig +main = xmonad $ ewmh dwConfig $ defaultConfig { modMask = modm , manageHook = myManageHook , layoutHook = desktopLayoutModifiers myLayoutHook From a544d20f7bcbf8e17f4b0679baae7cbed7e92495 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Thu, 8 Mar 2012 21:12:54 +0100 Subject: [PATCH 10/10] Some updates for GHC 7.4 --- lib/Storage.hs | 2 +- xmonad.hs | 13 ++++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/lib/Storage.hs b/lib/Storage.hs index 7f68b15..9c70b04 100644 --- a/lib/Storage.hs +++ b/lib/Storage.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards, DatatypeContexts #-} module Storage ( StoreData , Storage diff --git a/xmonad.hs b/xmonad.hs index 486db50..8fcfa9b 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -15,7 +15,7 @@ import Control.Monad import Control.Monad.Trans import Data.Maybe import Data.Monoid -import Ratio((%)) +import Data.Ratio((%)) import System.Exit --import ConfigurableBorders @@ -37,10 +37,11 @@ main = xmonad $ ewmh dwConfig $ defaultConfig , logHook = ewmhDesktopsLogHook , focusedBorderColor = "#008000" , rescreenHook = dynamicRescreenHook dwConfig + , borderWidth = 0 } `additionalKeysP` ( [ ("M-a", sendMessage MirrorShrink) - , ("M-y", sendMessage MirrorExpand) + , ("M-z", sendMessage MirrorExpand) , ("M-", prevWS) , ("M-", nextWS) , ("M-S-", shiftToPrev) @@ -50,10 +51,11 @@ main = xmonad $ ewmh dwConfig $ defaultConfig , ("M-", viewOrWarp 1) , ("M-", viewOrWarp 2) , ("M-b", banishScreen LowerRight) + , ("M-f", withFocused $ \w -> windows $ W.float w $ W.RationalRect 0 0 1 1) , ("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") + , ("C-M1-l", spawn "xscreensaver-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") @@ -145,8 +147,9 @@ myManageHook = composeAll [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) , className =? "MPlayer" -?> doCenterFloat + , className =? "mplayer2" -?> doCenterFloat , className =? "Gnome-session" -?> doIgnoreProcessWorkspace - , className =? "Gimp" -?> doFloat + --, className =? "Gimp" -?> doFloat , className =? "jrummikub-JRummikub" -?> doFloat , className =? "Stjerm" -?> doFloatMaybeFullscreen , className =? "Display" -?> doFloat @@ -164,7 +167,7 @@ myManageHook = composeAll --myUnmanageHook = moveUp1 -myLayoutHook = screenWorkspaceStorage $ processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) +myLayoutHook = screenWorkspaceStorage $ processWorkspaceManager $ manageFullscreen {- $ smartBorders -} (Full ||| tiled ||| Mirror tiled) where -- default tiling algorithm partitions the screen into two panes tiled = ResizableTall nmaster delta ratio []