diff --git a/CHANGES.md b/CHANGES.md index 19dbdef0..5c071a1c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -84,6 +84,13 @@ - Fix bug when cursor gets stuck in one of the corners. + * `XMonad.Hooks.SetWMName` + + Add function `getWMName`. + + * `XMonad.Hooks.Focus` + + Do not overwrite wm name in `handleFocusQuery`, if user has already set it. ## 0.12 (December 14, 2015) diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index 305234d7..7559f9f1 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -546,7 +546,8 @@ activateEventHook _ _ = return (All True) -- call it many times - only window name in '_NET_WM_NAME' may change. activateStartupHook :: X () activateStartupHook = do - setWMName "xmonad" + wn <- getWMName + when (isNothing wn) (setWMName "xmonad") getAtom "_NET_ACTIVE_WINDOW" >>= addNETSupported -- | Enable 'FocusHook' handling and set key for toggling focus lock. This is diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs index 86e8327a..e788e831 100644 --- a/XMonad/Hooks/SetWMName.hs +++ b/XMonad/Hooks/SetWMName.hs @@ -36,18 +36,45 @@ ----------------------------------------------------------------------------- module XMonad.Hooks.SetWMName ( - setWMName) where + setWMName + , getWMName + ) + where -import Control.Monad (join) +import Control.Monad (guard, join) import Data.Char (ord) import Data.List (nub) -import Data.Maybe (fromJust, listToMaybe, maybeToList) +import Data.Maybe (listToMaybe, maybeToList) +import qualified Data.Traversable as T import Foreign.C.Types (CChar) import Foreign.Marshal.Alloc (alloca) import XMonad +-- is there a better way to check the validity of the window? +isValidWindow :: Window -> X Bool +isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do + status <- xGetWindowAttributes dpy w p + return (status /= 0) + +netSupportingWMCheckAtom :: X Atom +netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" + +-- Return either valid support window or @Nothing@. +getSupportWindow :: X (Maybe Window) +getSupportWindow = withDisplay $ \dpy -> do + at <- netSupportingWMCheckAtom + root <- asks theRoot + mw <- fmap (fmap fromIntegral . join . fmap listToMaybe) $ liftIO + $ getWindowProperty32 dpy at root + mb <- T.mapM isValidWindow mw + return (mb >>= guard >> mw) + +-- | Get WM name. +getWMName :: X (Maybe String) +getWMName = getSupportWindow >>= T.mapM (runQuery title) + -- | sets WM name setWMName :: String -> X () setWMName name = do @@ -57,7 +84,8 @@ setWMName name = do atom_UTF8_STRING <- getAtom "UTF8_STRING" root <- asks theRoot - supportWindow <- getSupportWindow + mw <- getSupportWindow + supportWindow <- maybe createSupportWindow return mw dpy <- asks display io $ do -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window @@ -68,33 +96,9 @@ setWMName name = do supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root 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" - latin1StringToCCharList :: String -> [CChar] latin1StringToCCharList str = map (fromIntegral . ord) str - getSupportWindow :: X Window - getSupportWindow = withDisplay $ \dpy -> 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 (fmap fromIntegral supportWindow) - - validateWindow :: Maybe Window -> X Window - validateWindow w = do - valid <- maybe (return False) isValidWindow w - if valid then - return $ fromJust w - else - createSupportWindow - - -- is there a better way to check the validity of the window? - isValidWindow :: Window -> X Bool - 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