content: -----------------------------------------------------------------------------
  -- |
  -- 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 XMonad.Hooks.EwmhDesktops (
      -- * Usage
      -- $usage
      ewmh,
      ewmhDesktopsStartup,
      ewmhDesktopsLogHook,
      ewmhDesktopsLogHookCustom,
      ewmhDesktopsEventHook,
      ewmhDesktopsEventHookCustom,
      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 def{ handleEventHook =
  -- >            handleEventHook def <+> fullscreenEventHook }
  --
  -- 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 }
   -- @@@ will fix this correctly later with the rewrite
   where x +++ y = mappend y x
  
  -- |
  -- 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 = ewmhDesktopsLogHookCustom id
  -- |
  -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
  -- user-specified function to transform the workspace list (post-sorting)
  ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
  ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
      sort' <- getSortByIndex
      let ws = f $ sort' $ W.workspaces s
  
      -- Number of Workspaces
      setNumberOfDesktops (length ws)
  
      -- Names thereof
      setDesktopNames (map W.tag ws)
  
      -- all windows, with focused windows last
      let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
      setClientList wins
  
      -- 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 = ewmhDesktopsEventHookCustom id
  
  -- |
  -- Generalized version of ewmhDesktopsEventHook that allows an arbitrary
  -- user-specified function to transform the workspace list (post-sorting)
  ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
  ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
  
  handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
  handle f (ClientMessageEvent {
                 ev_window = w,
                 ev_message_type = mt,
                 ev_data = d
         }) = withWindowSet $ \s -> do
         sort' <- getSortByIndex
         let ws = f $ 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.
  --
  -- Note this is not included in 'ewmh'.
  fullscreenEventHook :: Event -> X All
  fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
    wmstate <- getAtom "_NET_WM_STATE"
    fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
    wstate <- fromMaybe [] `fmap` getProp32 wmstate 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 wmstate ptype propModeReplace (f wstate)
  
    when (typ == wmstate && 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] -> X ()
  setClientList wins = 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 wins)
  
  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]
  