From 318d99779ffc7f999b4ff9b22e8b6e0f8a446efa Mon Sep 17 00:00:00 2001 From: gwern0 Date: Tue, 6 Nov 2007 20:17:51 +0100 Subject: EwmhDesktops: move to correct name, update so it compiles darcs-hash:20071106191751-f7719-83d0cc7d50c7ce615a66c9fe38c1060cf2ef9405.gz --- XMonad/Hooks/EwmhDesktops | 130 ------------------------------------------- XMonad/Hooks/EwmhDesktops.hs | 130 +++++++++++++++++++++++++++++++++++++++++++ XMonad/Layout/Magnifier.hs | 2 +- 3 files changed, 131 insertions(+), 131 deletions(-) delete mode 100644 XMonad/Hooks/EwmhDesktops create mode 100644 XMonad/Hooks/EwmhDesktops.hs diff --git a/XMonad/Hooks/EwmhDesktops b/XMonad/Hooks/EwmhDesktops deleted file mode 100644 index 4e2d754..0000000 --- a/XMonad/Hooks/EwmhDesktops +++ /dev/null @@ -1,130 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.EwmhDesktops --- Copyright : (c) 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. ------------------------------------------------------------------------------ -module XMonadContrib.EwmhDesktops ( - -- * Usage - -- $usage - ewmhDesktopsLogHook - ) where - -import Data.List (elemIndex, sortBy) -import Data.Ord (comparing) -import Data.Maybe (fromMaybe) - -import Control.Monad.Reader -import XMonad -import qualified XMonad.StackSet as W -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras - -import XMonadContrib.SetWMName - --- $usage --- Add the imports to your configuration file and add the logHook: --- --- > import XMonadContrib.EwmhDesktops --- --- > logHook :: X() --- > logHook = do ewmhDesktopsLogHook --- > return () - --- %import XMonadContrib.EwmhDesktops --- %def -- comment out default logHook definition above if you uncomment this: --- %def logHook = ewmhDesktopsLogHook - - --- | --- 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 - -- Bad hack because xmonad forgets the original order of things, it seems - -- see http://code.google.com/p/xmonad/issues/detail?id=53 - let ws = sortBy (comparing W.tag) $ W.workspaces s - let wins = W.allWindows s - - setSupported - - -- Number of Workspaces - setNumberOfDesktops (length ws) - - -- Names thereof - setDesktopNames (map W.tag ws) - - -- Current desktop - fromMaybe (return ()) $ do - n <- W.lookupWorkspace 0 s - i <- elemIndex n $ map W.tag ws - return $ setCurrentDesktop i - - setClientList wins - - -- Per window Desktop - forM (zip ws [(0::Int)..]) $ \(w, wn) -> - forM (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn - - return () - - -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.fromEnum) $ - concatMap (("Workspace "++) . (++['\0'])) 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"] - io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) - - setWMName "xmonad" - - diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs new file mode 100644 index 0000000..80f7ae2 --- /dev/null +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -0,0 +1,130 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.EwmhDesktops +-- Copyright : (c) 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. +----------------------------------------------------------------------------- +module XMonad.Hooks.EwmhDesktops ( + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where + +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) + +import Control.Monad.Reader +import XMonad +import qualified XMonad.StackSet as W +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad.Hooks.SetWMName + +-- $usage +-- Add the imports to your configuration file and add the logHook: +-- +-- > import XMonad.Hooks.EwmhDesktops +-- +-- > logHook :: X() +-- > logHook = do ewmhDesktopsLogHook +-- > return () + +-- %import XMonad.Hooks.EwmhDesktops +-- %def -- comment out default logHook definition above if you uncomment this: +-- %def logHook = ewmhDesktopsLogHook + + +-- | +-- 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 + -- Bad hack because xmonad forgets the original order of things, it seems + -- see http://code.google.com/p/xmonad/issues/detail?id=53 + let ws = sortBy (comparing W.tag) $ W.workspaces s + let wins = W.allWindows s + + setSupported + + -- Number of Workspaces + setNumberOfDesktops (length ws) + + -- Names thereof + setDesktopNames (map W.tag ws) + + -- Current desktop + fromMaybe (return ()) $ do + n <- W.lookupWorkspace 0 s + i <- elemIndex n $ map W.tag ws + return $ setCurrentDesktop i + + setClientList wins + + -- Per window Desktop + forM (zip ws [(0::Int)..]) $ \(w, wn) -> + forM (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn + + return () + + +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.fromEnum) $ + concatMap (("Workspace "++) . (++['\0'])) 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"] + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) + + setWMName "xmonad" + + diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs index bcff71d..8f2db4d 100644 --- a/XMonad/Layout/Magnifier.hs +++ b/XMonad/Layout/Magnifier.hs @@ -25,7 +25,7 @@ module XMonad.Layout.Magnifier ( import Graphics.X11.Xlib (Window, Rectangle(..)) import XMonad import XMonad.StackSet -import XMonad.Layout.LayoutHelpers +-- import XMonad.Layout.LayoutHelpers -- $usage -- > import XMonad.Layout.Magnifier -- cgit v1.2.3