diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/EwmhDesktops.hs | 249 |
1 files changed, 249 insertions, 0 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] |