twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 04:31:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

Fix EwmhDesktops, ManageDocks, and SetWMName compilation for amd64

Browse Source
This commit is contained in:
Alex Tarkovsky
2007-10-10 21:38:53 +00:00
parent 26dc3c05f2
commit 85794b9558
3 changed files with 98 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
EwmhDesktops.hs
View File

@@ -12,14 +12,14 @@
-- workspaces and the windows therein. -- workspaces and the windows therein.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonadContrib.EwmhDesktops ( module XMonadContrib.EwmhDesktops (
-- * Usage -- * Usage
-- $usage -- $usage
ewmhDesktopsLogHook ewmhDesktopsLogHook
) where ) where
import Data.List (elemIndex, sortBy) import Data.List (elemIndex, sortBy)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Control.Monad.Reader import Control.Monad.Reader
import XMonad import XMonad
@@ -48,83 +48,83 @@ import XMonadContrib.SetWMName
-- of the current state of workspaces and windows. -- of the current state of workspaces and windows.
ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook = withWindowSet $ \s -> do ewmhDesktopsLogHook = withWindowSet $ \s -> do
-- Bad hack because xmonad forgets the original order of things, it seems -- Bad hack because xmonad forgets the original order of things, it seems
-- see http://code.google.com/p/xmonad/issues/detail?id=53 -- see http://code.google.com/p/xmonad/issues/detail?id=53
let ws = sortBy (comparing W.tag) $ W.workspaces s let ws = sortBy (comparing W.tag) $ W.workspaces s
let wins = W.allWindows s let wins = W.allWindows s
setSupported setSupported
-- Number of Workspaces -- Number of Workspaces
setNumberOfDesktops (length ws) setNumberOfDesktops (length ws)
-- Names thereof -- Names thereof
setDesktopNames (map W.tag ws) 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 -- Current desktop
fromMaybe (return ()) $ do
n <- W.lookupWorkspace 0 s
i <- elemIndex n $ map W.tag ws
return $ setCurrentDesktop i
-- Per window Desktop setClientList wins
forM (zip ws [(0::Int)..]) $ \(w, wn) ->
forM (W.integrate' (W.stack w)) $ \win -> do -- Per window Desktop
setWindowDesktop win wn forM (zip ws [(0::Int)..]) $ \(w, wn) ->
forM (W.integrate' (W.stack w)) $ \win -> do
return () setWindowDesktop win wn
return ()
setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops :: (Integral a) => a -> X ()
setNumberOfDesktops n = withDisplay $ \dpy -> do setNumberOfDesktops n = withDisplay $ \dpy -> do
a <- getAtom "_NET_NUMBER_OF_DESKTOPS" a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
c <- getAtom "CARDINAL" c <- getAtom "CARDINAL"
r <- asks theRoot r <- asks theRoot
io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]
setCurrentDesktop :: (Integral a) => a -> X () setCurrentDesktop :: (Integral a) => a -> X ()
setCurrentDesktop i = withDisplay $ \dpy -> do setCurrentDesktop i = withDisplay $ \dpy -> do
a <- getAtom "_NET_CURRENT_DESKTOP" a <- getAtom "_NET_CURRENT_DESKTOP"
c <- getAtom "CARDINAL" c <- getAtom "CARDINAL"
r <- asks theRoot r <- asks theRoot
io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]
setDesktopNames :: [String] -> X () setDesktopNames :: [String] -> X ()
setDesktopNames names = withDisplay $ \dpy -> do setDesktopNames names = withDisplay $ \dpy -> do
-- Names thereof -- Names thereof
r <- asks theRoot r <- asks theRoot
a <- getAtom "_NET_DESKTOP_NAMES" a <- getAtom "_NET_DESKTOP_NAMES"
c <- getAtom "UTF8_STRING" c <- getAtom "UTF8_STRING"
let names' = map (fromIntegral.fromEnum) $ let names' = map (fromIntegral.fromEnum) $
concatMap (("Workspace "++) . (++['\0'])) names concatMap (("Workspace "++) . (++['\0'])) names
io $ changeProperty8 dpy r a c propModeReplace names' io $ changeProperty8 dpy r a c propModeReplace names'
setClientList :: [Window] -> X () setClientList :: [Window] -> X ()
setClientList wins = withDisplay $ \dpy -> do setClientList wins = withDisplay $ \dpy -> do
-- (What order do we really need? Something about age and stacking) -- (What order do we really need? Something about age and stacking)
r <- asks theRoot r <- asks theRoot
c <- getAtom "WINDOW" c <- getAtom "WINDOW"
a <- getAtom "_NET_CLIENT_LIST" a <- getAtom "_NET_CLIENT_LIST"
io $ changeProperty32 dpy r a c propModeReplace wins io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)
a' <- getAtom "_NET_CLIENT_LIST_STACKING" a' <- getAtom "_NET_CLIENT_LIST_STACKING"
io $ changeProperty32 dpy r a' c propModeReplace wins io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
setWindowDesktop :: (Integral a) => Window -> a -> X () setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop win i = withDisplay $ \dpy -> do setWindowDesktop win i = withDisplay $ \dpy -> do
a <- getAtom "_NET_WM_DESKTOP" a <- getAtom "_NET_WM_DESKTOP"
c <- getAtom "CARDINAL" c <- getAtom "CARDINAL"
io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]
setSupported :: X () setSupported :: X ()
setSupported = withDisplay $ \dpy -> do setSupported = withDisplay $ \dpy -> do
r <- asks theRoot r <- asks theRoot
a <- getAtom "_NET_SUPPORTED" a <- getAtom "_NET_SUPPORTED"
c <- getAtom "ATOM" c <- getAtom "ATOM"
supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"] supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]
io $ changeProperty32 dpy r a c propModeReplace supp io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
setWMName "xmonad" setWMName "xmonad"

60
ManageDocks.hs
View File

@@ -19,10 +19,10 @@
-- * To reset the gap, press Mod-b twice and restart xmonad (Mod-q) -- * To reset the gap, press Mod-b twice and restart xmonad (Mod-q)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonadContrib.ManageDocks ( module XMonadContrib.ManageDocks (
-- * Usage -- * Usage
-- $usage -- $usage
manageDocksHook manageDocksHook
) where ) where
import Control.Monad.Reader import Control.Monad.Reader
import XMonad import XMonad
@@ -51,40 +51,40 @@ import Data.Word
-- not manage it. If the window has the STRUT property set, adjust the gap accordingly. -- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
manageDocksHook :: Window -> X (WindowSet -> WindowSet) manageDocksHook :: Window -> X (WindowSet -> WindowSet)
manageDocksHook w = do manageDocksHook w = do
hasStrut <- getStrut w hasStrut <- getStrut w
maybe (return ()) setGap hasStrut maybe (return ()) setGap hasStrut
isDock <- checkDock w isDock <- checkDock w
if isDock then do if isDock then do
reveal w reveal w
return (W.delete w) return (W.delete w)
else do else do
return id return id
-- | -- |
-- Checks if a window is a DOCK window -- Checks if a window is a DOCK window
checkDock :: Window -> X (Bool) checkDock :: Window -> X (Bool)
checkDock w = do checkDock w = do
a <- getAtom "_NET_WM_WINDOW_TYPE" a <- getAtom "_NET_WM_WINDOW_TYPE"
d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
mbr <- getProp a w mbr <- getProp a w
case mbr of case mbr of
Just [r] -> return (r == d) Just [r] -> return (fromIntegral r == d)
_ -> return False _ -> return False
-- | -- |
-- Gets the STRUT config, if present, in xmonad gap order -- Gets the STRUT config, if present, in xmonad gap order
getStrut :: Window -> X (Maybe (Int, Int, Int, Int)) getStrut :: Window -> X (Maybe (Int, Int, Int, Int))
getStrut w = do getStrut w = do
a <- getAtom "_NET_WM_STRUT" a <- getAtom "_NET_WM_STRUT"
mbr <- getProp a w mbr <- getProp a w
case mbr of case mbr of
Just [l,r,t,b] -> return (Just ( Just [l,r,t,b] -> return (Just (
fromIntegral t, fromIntegral t,
fromIntegral b, fromIntegral b,
fromIntegral l, fromIntegral l,
fromIntegral r)) fromIntegral r))
_ -> return Nothing _ -> return Nothing
-- | -- |
-- Helper to read a property -- Helper to read a property
@@ -98,5 +98,5 @@ setGap gap = modifyGap (\_ -> max4 gap)
-- | -- |
-- Piecewise maximum of a 4-tuple of Ints -- 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) max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)

8
SetWMName.hs
View File

@@ -63,12 +63,12 @@ setWMName name = do
dpy <- asks display dpy <- asks display
io $ do io $ do
-- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window -- _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) -- 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) 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) -- declare which _NET protocols are supported (append to the list if it exists)
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root 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 where
netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom :: X Atom
netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
@@ -81,7 +81,7 @@ setWMName name = do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
root <- asks theRoot root <- asks theRoot
supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root 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 :: Maybe Window -> X Window
validateWindow w = do validateWindow w = do
@@ -96,7 +96,7 @@ setWMName name = do
isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do
status <- xGetWindowAttributes dpy w p status <- xGetWindowAttributes dpy w p
return (status /= 0) return (status /= 0)
-- this code was translated from C (see OpenBox WM, screen.c) -- this code was translated from C (see OpenBox WM, screen.c)
createSupportWindow :: X Window createSupportWindow :: X Window
createSupportWindow = withDisplay $ \dpy -> do createSupportWindow = withDisplay $ \dpy -> do