From 2f71ea564022ea66b4c1863b4a980e76c5cae0d2 Mon Sep 17 00:00:00 2001 From: Alex Tarkovsky Date: Wed, 10 Oct 2007 23:38:53 +0200 Subject: Fix EwmhDesktops, ManageDocks, and SetWMName compilation for amd64 darcs-hash:20071010213853-bd4fb-66e3492b55dc7aeb9dee18201a66f540b52e8b53.gz --- EwmhDesktops.hs | 128 ++++++++++++++++++++++++++++---------------------------- ManageDocks.hs | 60 +++++++++++++------------- SetWMName.hs | 8 ++-- 3 files changed, 98 insertions(+), 98 deletions(-) diff --git a/EwmhDesktops.hs b/EwmhDesktops.hs index 0fbe0fa..ee69c98 100644 --- a/EwmhDesktops.hs +++ b/EwmhDesktops.hs @@ -12,14 +12,14 @@ -- workspaces and the windows therein. ----------------------------------------------------------------------------- module XMonadContrib.EwmhDesktops ( - -- * Usage - -- $usage - ewmhDesktopsLogHook - ) where + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where -import Data.List (elemIndex, sortBy) -import Data.Ord (comparing) -import Data.Maybe (fromMaybe) +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) import Control.Monad.Reader import XMonad @@ -48,83 +48,83 @@ import XMonadContrib.SetWMName -- 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 + -- 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 + setSupported - -- Number of Workspaces - setNumberOfDesktops (length ws) + -- 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 + -- Names thereof + setDesktopNames (map W.tag ws) - setClientList wins + -- Current desktop + fromMaybe (return ()) $ do + n <- W.lookupWorkspace 0 s + i <- elemIndex n $ map W.tag ws + return $ setCurrentDesktop i - -- Per window Desktop - forM (zip ws [(0::Int)..]) $ \(w, wn) -> - forM (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn - - return () + 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] +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] + 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' + -- 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 wins - a' <- getAtom "_NET_CLIENT_LIST_STACKING" - io $ changeProperty32 dpy r a' c propModeReplace wins + -- (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] +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 supp - - setWMName "xmonad" +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/ManageDocks.hs b/ManageDocks.hs index 3ff0248..16015bd 100644 --- a/ManageDocks.hs +++ b/ManageDocks.hs @@ -19,10 +19,10 @@ -- * To reset the gap, press Mod-b twice and restart xmonad (Mod-q) ----------------------------------------------------------------------------- module XMonadContrib.ManageDocks ( - -- * Usage - -- $usage - manageDocksHook - ) where + -- * Usage + -- $usage + manageDocksHook + ) where import Control.Monad.Reader import XMonad @@ -51,40 +51,40 @@ import Data.Word -- not manage it. If the window has the STRUT property set, adjust the gap accordingly. manageDocksHook :: Window -> X (WindowSet -> WindowSet) manageDocksHook w = do - hasStrut <- getStrut w - maybe (return ()) setGap hasStrut + hasStrut <- getStrut w + maybe (return ()) setGap hasStrut - isDock <- checkDock w - if isDock then do - reveal w - return (W.delete w) - else do - return id + isDock <- checkDock w + if isDock then do + reveal w + return (W.delete w) + else do + return id -- | -- Checks if a window is a DOCK window checkDock :: Window -> X (Bool) checkDock w = do - a <- getAtom "_NET_WM_WINDOW_TYPE" - d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" - mbr <- getProp a w - case mbr of - Just [r] -> return (r == d) - _ -> return False + a <- getAtom "_NET_WM_WINDOW_TYPE" + d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + mbr <- getProp a w + case mbr of + Just [r] -> return (fromIntegral r == d) + _ -> return False --- | +-- | -- Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X (Maybe (Int, Int, Int, Int)) -getStrut w = do - a <- getAtom "_NET_WM_STRUT" - mbr <- getProp a w - case mbr of - Just [l,r,t,b] -> return (Just ( - fromIntegral t, - fromIntegral b, - fromIntegral l, - fromIntegral r)) - _ -> return Nothing +getStrut w = do + a <- getAtom "_NET_WM_STRUT" + mbr <- getProp a w + case mbr of + Just [l,r,t,b] -> return (Just ( + fromIntegral t, + fromIntegral b, + fromIntegral l, + fromIntegral r)) + _ -> return Nothing -- | -- Helper to read a property @@ -98,5 +98,5 @@ setGap gap = modifyGap (\_ -> max4 gap) -- | -- Piecewise maximum of a 4-tuple of Ints -max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) +max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4) diff --git a/SetWMName.hs b/SetWMName.hs index 84e346e..da7af3d 100644 --- a/SetWMName.hs +++ b/SetWMName.hs @@ -63,12 +63,12 @@ setWMName name = do dpy <- asks display io $ do -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window - mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [supportWindow]) [root, supportWindow] + mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow] -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder) changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToWord8List name) -- declare which _NET protocols are supported (append to the list if it exists) supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root - changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ atom_NET_SUPPORTING_WM_CHECK : atom_NET_WM_NAME : supportedList) + changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) where netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" @@ -81,7 +81,7 @@ setWMName name = do atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom root <- asks theRoot supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root - validateWindow supportWindow + validateWindow (fmap fromIntegral supportWindow) validateWindow :: Maybe Window -> X Window validateWindow w = do @@ -96,7 +96,7 @@ setWMName name = do isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do status <- xGetWindowAttributes dpy w p return (status /= 0) - + -- this code was translated from C (see OpenBox WM, screen.c) createSupportWindow :: X Window createSupportWindow = withDisplay $ \dpy -> do -- cgit v1.2.3