diff options
| -rw-r--r-- | lib/EwmhDesktops.hs | 249 | ||||
| -rw-r--r-- | xmonad.hs | 47 |
2 files changed, 287 insertions, 9 deletions
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 <mail@joachim-breitner.de> +-- License : BSD +-- +-- Maintainer : Joachim Breitner <mail@joachim-breitner.de> +-- 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] @@ -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-<Left>", shiftToPrev) , ("M-S-<Right>", shiftToNext) , ("M-S-b", withFocused toggleBorder >> refresh) - , ("M1-<F4>", kill) , ("M-<F1>", viewOrWarp 0) , ("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-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-<F4>", 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 |