twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Revert "Add new module XMonad.Hooks.Focus ."

Browse Source
This commit is contained in:
Peter J. Jones 2017-04-10 16:19:06 -07:00 committed by GitHub
parent 65ac029636
commit 1b738c2bed
5 changed files with 40 additions and 633 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
XMonad/Hooks/EwmhDesktops.hs
View File

@ -1,5 +1,3 @@
{-# LANGUAGE DeriveDataTypeable #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Hooks.EwmhDesktops -- Module : XMonad.Hooks.EwmhDesktops
@ -21,8 +19,6 @@ module XMonad.Hooks.EwmhDesktops (
ewmhDesktopsStartup, ewmhDesktopsStartup,
ewmhDesktopsLogHook, ewmhDesktopsLogHook,
ewmhDesktopsLogHookCustom, ewmhDesktopsLogHookCustom,
NetActivated (..),
activated,
ewmhDesktopsEventHook, ewmhDesktopsEventHook,
ewmhDesktopsEventHookCustom, ewmhDesktopsEventHookCustom,
fullscreenEventHook fullscreenEventHook
@ -41,7 +37,6 @@ import XMonad.Hooks.SetWMName
import XMonad.Util.XUtils (fi) import XMonad.Util.XUtils (fi)
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
import XMonad.Util.WindowProperties (getProp32) import XMonad.Util.WindowProperties (getProp32)
import qualified XMonad.Util.ExtensibleState as XS
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -53,36 +48,7 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > handleEventHook def <+> fullscreenEventHook } -- > handleEventHook def <+> fullscreenEventHook }
-- --
-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". -- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
--
-- __/WARNING!/__ 'ewmh' function will use 'manageHook' for handling activated
-- window. That means, actions, which you don't want to happen on activated
-- windows, should be guarded by
--
-- > not <$> activated
--
-- predicate.
--
-- And now by default window activation will do nothing: neither switch
-- workspace, nor focus. You can use regular 'ManageHook' combinators for
-- changing window activation behavior. Also, you may be interested in
-- "XMonad.Hooks.Focus", which provides additional predicates for using in
-- 'ManageHook'.
--
-- To get back old 'ewmh' window activation behavior (switch workspace and
-- focus to activated window) you may use:
--
-- > import XMonad
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let fh :: ManageHook
-- > fh = manageFocus (liftQuery activated --> switchWorkspace <+> switchFocus)
-- > xcf = ewmh $ def {modMask = mod4Mask, manageHook = fh}
-- > xmonad xcf
-- | Add EWMH functionality to the given config. See above for an example. -- | Add EWMH functionality to the given config. See above for an example.
ewmh :: XConfig a -> XConfig a ewmh :: XConfig a -> XConfig a
@ -162,19 +128,6 @@ ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom f e = handle f e >> return (All True) ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
-- this value in global state, because i use 'ManageHook' for handling
-- activated windows and i need a way to tell 'manageHook', that now a window
-- is activated.
newtype NetActivated = NetActivated {netActivated :: Bool}
deriving (Show, Typeable)
instance ExtensionClass NetActivated where
initialValue = NetActivated False
-- | Was new window @_NET_ACTIVE_WINDOW@ activated?
activated :: Query Bool
activated = fmap netActivated (liftX XS.get)
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X () handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle f (ClientMessageEvent { handle f (ClientMessageEvent {
ev_window = w, ev_window = w,
@ -200,10 +153,7 @@ handle f (ClientMessageEvent {
windows $ W.shiftWin (W.tag (ws !! fi n)) w windows $ W.shiftWin (W.tag (ws !! fi n)) w
else trace $ "Bad _NET_DESKTOP with data[0]="++show n else trace $ "Bad _NET_DESKTOP with data[0]="++show n
else if mt == a_aw then do else if mt == a_aw then do
mh <- asks (manageHook . config) windows $ W.focusWindow w
XS.put (NetActivated True)
runQuery mh w >>= windows . appEndo
XS.put (NetActivated False)
else if mt == a_cw then do else if mt == a_cw then do
killWindow w killWindow w
else if mt `elem` a_ignore then do else if mt `elem` a_ignore then do

538
XMonad/Hooks/Focus.hs
View File

@ -1,538 +0,0 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module: XMonad.Hooks.Focus
-- Copyright: sgf-dma, 2016
-- Maintainer: sgf.dma@gmail.com
--
module XMonad.Hooks.Focus
(
-- $main
-- * FocusQuery.
--
-- $focusquery
Focus (..)
, FocusLock (..)
, toggleLock
, FocusQuery
, runFocusQuery
, FocusHook
-- * Lifting into FocusQuery.
--
-- $lift
, liftQuery
, new
, focused
, focused'
, focusedOn
, focusedOn'
, focusedCur
, focusedCur'
, newOn
, newOnCur
, unlessFocusLock
-- * Commonly used actions for modifying focus.
--
-- $common
, keepFocus
, switchFocus
, keepWorkspace
, switchWorkspace
-- * Running FocusQuery.
--
-- $running
, manageFocus
-- * Example configurations.
--
-- $examples
, activateSwitchWs
, activateOnCurrentWs
, activateOnCurrentKeepFocus
)
where
import Data.Maybe
import Data.Monoid
import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Control.Arrow hiding ((<+>))
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Hooks.ManageHelpers (currentWs)
import XMonad.Hooks.EwmhDesktops (activated)
-- $main
--
-- This module provides monad on top of Query monad providing additional
-- information about new window:
--
-- - workspace, where new window will appear;
-- - focused window on workspace, where new window will appear;
-- - current workspace;
--
-- And a property in extensible state:
--
-- - is focus lock enabled? Focus lock instructs all library's 'FocusHook'
-- functions to not move focus or switch workspace.
--
-- Lifting operations for standard 'ManageHook' EDSL combinators into
-- 'FocusQuery' monad allowing to run these combinators on focused window and
-- common actions for keeping focus and\/or workspace, switching focus and\/or
-- workspace are also provided.
--
-- == Quick start.
--
-- I may use one of predefined configurations.
--
-- 1. Default window activation behavior is switch to workspace with activated
-- window and switch focus to it:
--
-- > import XMonad
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let mh :: ManageHook
-- > mh = activateSwitchWs
-- > xcf = ewmh $ def
-- > { modMask = mod4Mask
-- > , manageHook = mh <+> manageHook def
-- > }
-- > xmonad xcf
--
-- 2. Or i may move activated window to current workspace and switch focus to
-- it:
--
-- > let mh :: ManageHook
-- > mh = activateOnCurrentWs
--
-- 3. Or move activated window to current workspace, but keep focus unchanged:
--
-- > let mh :: ManageHook
-- > mh = activateOnCurrentKeepFocus
--
-- 4. I may use regular 'ManageHook' combinators for filtering, which windows
-- may activate. E.g. activate all windows, except firefox:
--
-- > let mh :: ManageHook
-- > mh = not <$> (className =? "Firefox" <||> className =? "Iceweasel")
-- > --> activateSwitchWs
--
-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless
-- gnome-terminal is focused on /current/ workspace:
--
-- > let mh :: ManageHook
-- > mh = manageFocus (not <$> focusedCur (className =? "Gnome-terminal")
-- > --> liftQuery activateSwitchWs)
--
-- or activate all windows, unless focused window on the workspace,
-- /where activated window is/, is not a gnome-terminal:
--
-- > let mh :: ManageHook
-- > mh = manageFocus (not <$> focused (className =? "Gnome-terminal")
-- > --> liftQuery activateSwitchWs)
--
-- == Defining FocusHook.
--
-- I may define my own 'FocusHook' like:
--
-- > activateFocusHook :: FocusHook
-- > activateFocusHook = composeAll
-- > -- If 'gmrun' is focused on workspace, on which
-- > -- activated window is, keep focus unchanged. But i
-- > -- may still switch workspace.
-- > [ focused (className =? "Gmrun")
-- > --> keepFocus
-- > -- Default behavior for activated windows: switch
-- > -- workspace and focus.
-- > , return True --> switchWorkspace <+> switchFocus
-- > ]
-- >
-- > newFocusHook :: FocusHook
-- > newFocusHook = composeOne
-- > -- Always switch focus to 'gmrun'.
-- > [ new (className =? "Gmrun") -?> switchFocus
-- > -- And always keep focus on 'gmrun'. Note, that
-- > -- another 'gmrun' will steal focus from already
-- > -- running one.
-- > , focused (className =? "Gmrun") -?> keepFocus
-- > -- If firefox dialog prompt (e.g. master password
-- > -- prompt) is focused on current workspace and new
-- > -- window appears here too, keep focus unchanged
-- > -- (note, used predicates: @newOnCur <&&> focused@ is
-- > -- the same as @newOnCur <&&> focusedCur@, but is
-- > -- /not/ the same as just 'focusedCur' )
-- > , newOnCur <&&> focused
-- > ((className =? "Iceweasel" <||> className =? "Firefox") <&&> isDialog)
-- > -?> keepFocus
-- > -- Default behavior for new windows: switch focus.
-- > , return True -?> switchFocus
-- > ]
--
-- And then use it:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> activateFocusHook
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def {manageHook = fh}
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
--
-- Note:
--
-- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
-- workspace won't be switched).
-- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window
-- activation. It will call 'manageHook' for activated window and predicate
-- 'activated' will be 'True' in this case.
-- - The order, when constructing final 'FocusHook': 'FocusHook' without
-- 'activated' predicate will match to activated windows too, thus i should
-- place it after one with 'activated' (so the latter will have a chance to
-- handle activated window first).
--
-- And more technical notes:
--
-- - 'FocusHook' will run /many/ times, so it usually should not keep state
-- or save results. Precisely, it may do anything, but it must be idempotent
-- to operate properly.
-- - 'FocusHook' will see new window at workspace, where functions on the
-- /right/ from it in 'ManageHook' monoid place it. In other words, in
-- @(Endo WindowSet)@ monoid i may see changes only from functions applied
-- /before/ (more to the right in function composition). Thus, it's better to
-- add 'FocusHook' the last.
-- - 'FocusHook' functions won't see window shift to another workspace made
-- by function from 'FocusHook' itself: new window workspace is determined
-- /before/ running 'FocusHook' and even if later one of 'FocusHook'
-- functions moves window to another workspace, predicates ('focused',
-- 'newOn', etc) will still think new window is at workspace it was before.
-- This can be worked around by splitting 'FocusHook' into several different
-- values and evaluating each one separately, like:
--
-- > (FH2 -- manageFocus --> MH2) <+> (FH1 -- manageFocus --> MH1) <+> ..
--
-- E.g.
--
-- > manageFocus FH2 <+> manageFocus FH1 <+> ..
--
-- now @FH2@ will see window shift made by @FH1@.
--
-- Another interesting example is moving all activated windows to current
-- workspace by default, and applying 'FocusHook' after:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- > import qualified XMonad.StackSet as W
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> (newOnCur --> keepFocus)
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def {manageHook = fh <+> activateOnCurrentWs}
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
-- >
-- > activateOnCurrentWs :: ManageHook
-- > activateOnCurrentWs = activated --> currentWs >>= unlessFocusLock . doShift
-- >
-- > newFocusHook :: FocusHook
-- > newFocusHook = composeOne
-- > -- Always switch focus to 'gmrun'.
-- > [ new (className =? "Gmrun") -?> switchFocus
-- > -- And always keep focus on 'gmrun'. Note, that
-- > -- another 'gmrun' will steal focus from already
-- > -- running one.
-- > , focused (className =? "Gmrun") -?> keepFocus
-- > -- If firefox dialog prompt (e.g. master password
-- > -- prompt) is focused on current workspace and new
-- > -- window appears here too, keep focus unchanged
-- > -- (note, used predicates: @newOnCur <&&> focused@ is
-- > -- the same as @newOnCur <&&> focusedCur@, but is
-- > -- /not/ the same as just 'focusedCur' )
-- > , newOnCur <&&> focused
-- > ((className =? "Iceweasel" <||> className =? "Firefox") <&&> isDialog)
-- > -?> keepFocus
-- > -- Default behavior for new windows: switch focus.
-- > , return True -?> switchFocus
-- > ]
--
-- Note here:
--
-- - i keep focus, when activated window appears on current workspace, in
-- this example.
-- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated
-- window will be /already/ on current workspace, thus, if i do not want to
-- move some activated windows, i should filter them out in
-- @activateOnCurrentWs@ 'FocusHook'.
-- FocusQuery.
-- $focusquery
-- | Information about current workspace and focus.
data Focus = Focus
{ -- | Workspace, where new window appears.
newWorkspace :: WorkspaceId
-- | Focused window on workspace, where new window
-- appears.
, focusedWindow :: Maybe Window
-- | Current workspace.
, currentWorkspace :: WorkspaceId
}
deriving (Show)
instance Default Focus where
def = Focus
{ focusedWindow = Nothing
, newWorkspace = ""
, currentWorkspace = ""
}
newtype FocusLock = FocusLock {getFocusLock :: Bool}
deriving (Show, Typeable)
instance ExtensionClass FocusLock where
initialValue = FocusLock False
-- | Toggle stored focus lock state.
toggleLock :: X ()
toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b))
-- | Monad on top of 'Query' providing additional information about new
-- window.
newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
instance Functor FocusQuery where
fmap f (FocusQuery x) = FocusQuery (fmap f x)
instance Applicative FocusQuery where
pure x = FocusQuery (pure x)
(FocusQuery f) <*> (FocusQuery mx) = FocusQuery (f <*> mx)
instance Monad FocusQuery where
return x = FocusQuery (return x)
(FocusQuery mx) >>= f = FocusQuery $ mx >>= \x ->
let FocusQuery y = f x in y
instance MonadReader Focus FocusQuery where
ask = FocusQuery ask
local f (FocusQuery mx) = FocusQuery (local f mx)
instance MonadIO FocusQuery where
liftIO mx = FocusQuery (liftIO mx)
instance Monoid a => Monoid (FocusQuery a) where
mempty = return mempty
mappend = liftM2 mappend
runFocusQuery :: FocusQuery a -> Focus -> Query a
runFocusQuery (FocusQuery m) = runReaderT m
type FocusHook = FocusQuery (Endo WindowSet)
-- Lifting into 'FocusQuery'.
-- $lift
-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.
liftQuery :: Query a -> FocusQuery a
liftQuery = FocusQuery . lift
-- | Run 'Query' on new window.
new :: Query a -> FocusQuery a
new = liftQuery
-- | Run 'Query' on focused window on workspace, where new window appears. If
-- there is no focused window, return 'False'.
focused :: Query Bool -> FocusQuery Bool
focused m = getAny <$> focused' (Any <$> m)
-- | More general version of 'focused'.
focused' :: Monoid a => Query a -> FocusQuery a
focused' m = do
mw <- asks focusedWindow
liftQuery (maybe mempty (flip local m . const) mw)
-- | Run 'Query' on window focused at particular workspace. If there is no
-- focused window, return 'False'.
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn i m = getAny <$> focusedOn' i (Any <$> m)
-- | More general version of 'focusedOn'.
focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' i m = liftQuery $ do
mw <- liftX $ withWindowSet (return . W.peek . W.view i)
maybe mempty (flip local m . const) mw
-- | Run 'Query' on focused window on current workspace. If there is no
-- focused window, return 'False'. Note,
--
-- > focused <&&> newOnCur != focusedCur
--
-- The first will affect only new or activated window appearing on current
-- workspace, while the last will affect any window: focus even for windows
-- appearing on other workpsaces will depend on focus on /current/ workspace.
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur m = getAny <$> focusedCur' (Any <$> m)
-- | More general version of 'focusedCur'.
focusedCur' :: Monoid a => Query a -> FocusQuery a
focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m
-- | Does new window appear at particular workspace?
newOn :: WorkspaceId -> FocusQuery Bool
newOn i = (i ==) <$> asks newWorkspace
-- | Does new window appear at current workspace?
newOnCur :: FocusQuery Bool
newOnCur = asks currentWorkspace >>= newOn
-- | Execute 'Query', unless focus is locked.
unlessFocusLock :: Monoid a => Query a -> Query a
unlessFocusLock m = do
FocusLock b <- liftX XS.get
when' (not b) m
-- Commonly used actions for modifying focus.
--
-- $common
-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and
-- 'switchWorkspace' overwrite each other (the letftmost will determine what
-- happened):
--
-- prop> keepFocus <+> switchFocus = keepFocus
-- prop> switchFocus <+> keepFocus = switchFocus
-- prop> keepWorkspace <+> switchWorkspace = keepWorkspace
-- prop> switchWorkspace <+> keepWorkspace = switchWorkspace
--
-- and operations from different pairs are commutative:
--
-- prop> keepFocus <+> switchWorkspace = switchWorkspace <+> keepFocus
-- prop> switchFocus <+> switchWorkspace = switchWorkspace <+> switchFocus
--
-- etc.
-- | Keep focus on workspace (may not be current), where new window appears.
-- Workspace will not be switched. This operation is idempotent and
-- effectively returns focus to window focused on that workspace before
-- applying @(Endo WindowSet)@ function.
keepFocus :: FocusHook
keepFocus = focused' $ ask >>= \w -> doF $ \ws ->
W.view (W.currentTag ws) . W.focusWindow w $ ws
-- | Switch focus to new window on workspace (may not be current), where new
-- window appears. Workspace will not be switched. This operation is
-- idempotent.
switchFocus :: FocusHook
switchFocus = do
FocusLock b <- liftQuery . liftX $ XS.get
if b
-- When focus lock is enabled, call 'keepFocus' explicitly (still no
-- 'keepWorkspace') to overwrite default behavior.
then keepFocus
else new $ ask >>= \w -> doF $ \ws ->
W.view (W.currentTag ws) . W.focusWindow w $ ws
-- | Keep current workspace. Focus will not be changed at either current or
-- new window's workspace. This operation is idempotent and effectively
-- switches to workspace, which was current before applying @(Endo WindowSet)@
-- function.
keepWorkspace :: FocusHook
keepWorkspace = do
ws <- asks currentWorkspace
liftQuery . doF $ W.view ws
-- | Switch workspace to one, where new window appears. Focus will not be
-- changed at either current or new window's workspace. This operation is
-- idempotent.
switchWorkspace :: FocusHook
switchWorkspace = do
FocusLock b <- liftQuery . liftX $ XS.get
if b
-- When focus lock is enabled, call 'keepWorkspace' explicitly (still no
-- 'keepFocus') to overwrite default behavior.
then keepWorkspace
else do
ws <- asks newWorkspace
liftQuery . doF $ W.view ws
-- Running FocusQuery.
-- $running
-- | I don't know at which workspace new window will appear until @(Endo
-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run,
-- but in @(Endo WindowSet)@ function i can't already execute monadic actions,
-- because it's pure. So, i compute result for every workspace here and just
-- use it later in @(Endo WindowSet)@ function. Note, though, that this will
-- execute monadic actions many times, and therefore assume, that result of
-- 'FocusHook' does not depend on the number of times it was executed.
manageFocus :: FocusHook -> ManageHook
manageFocus m = do
fws <- liftX . withWindowSet $ return
. map (W.tag &&& fmap W.focus . W.stack) . W.workspaces
ct <- currentWs
let r = def {currentWorkspace = ct}
hs <- forM fws $ \(i, mw) -> do
f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i})
return (i, f)
reader (selectHook hs) >>= doF
where
-- | Select and apply @(Endo WindowSet)@ function depending on which
-- workspace new window appeared now.
selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook cfs nw ws = fromMaybe ws $ do
i <- W.findTag nw ws
f <- lookup i cfs
return (appEndo f ws)
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' b mx
| b = mx
| otherwise = return mempty
-- Exmaple configurations.
-- $examples
-- | Default EWMH window activation behavior: switch to workspace with
-- activated window and switch focus to it.
activateSwitchWs :: ManageHook
activateSwitchWs = manageFocus (liftQuery activated -->
switchWorkspace <+> switchFocus)
-- | Move activated window to current workspace.
activateOnCurrent' :: ManageHook
activateOnCurrent' = activated --> currentWs >>= unlessFocusLock . doShift
-- | Move activated window to current workspace and switch focus to it. Note,
-- that i need to explicitly call 'switchFocus' here, because otherwise, when
-- activated window is /already/ on current workspace, focus won't be
-- switched.
activateOnCurrentWs :: ManageHook
activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus)
<+> activateOnCurrent'
-- | Move activated window to current workspace, but keep focus unchanged.
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus)
<+> activateOnCurrent'

20
XMonad/Hooks/ManageHelpers.hs
View File

@ -73,8 +73,8 @@ data Match a = Match Bool a
-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
-- a candidate returns a 'Just' value, effectively running only the first match -- a candidate returns a 'Just' value, effectively running only the first match
-- (whereas 'composeAll' continues and executes all matching rules). -- (whereas 'composeAll' continues and executes all matching rules).
composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a composeOne :: [MaybeManageHook] -> ManageHook
composeOne = foldr try (return mempty) composeOne = foldr try idHook
where where
try q z = do try q z = do
x <- q x <- q
@ -85,17 +85,17 @@ composeOne = foldr try (return mempty)
infixr 0 -?>, -->>, -?>> infixr 0 -?>, -->>, -?>>
-- | q \/=? x. if the result of q equals x, return False -- | q \/=? x. if the result of q equals x, return False
(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool (/=?) :: Eq a => Query a -> a -> Query Bool
q /=? x = fmap (/= x) q q /=? x = fmap (/= x) q
-- | q <==? x. if the result of q equals x, return True grouped with q -- | q <==? x. if the result of q equals x, return True grouped with q
(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a) (<==?) :: Eq a => Query a -> a -> Query (Match a)
q <==? x = fmap (`eq` x) q q <==? x = fmap (`eq` x) q
where where
eq q' x' = Match (q' == x') q' eq q' x' = Match (q' == x') q'
-- | q <\/=? x. if the result of q notequals x, return True grouped with q -- | q <\/=? x. if the result of q notequals x, return True grouped with q
(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a) (</=?) :: Eq a => Query a -> a -> Query (Match a)
q </=? x = fmap (`neq` x) q q </=? x = fmap (`neq` x) q
where where
neq q' x' = Match (q' /= x') q' neq q' x' = Match (q' /= x') q'
@ -103,19 +103,19 @@ q </=? x = fmap (`neq` x) q
-- | A helper operator for use in 'composeOne'. It takes a condition and an action; -- | A helper operator for use in 'composeOne'. It takes a condition and an action;
-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will -- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
-- go on and try the next rule. -- go on and try the next rule.
(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a) (-?>) :: Query Bool -> ManageHook -> MaybeManageHook
p -?> f = do p -?> f = do
x <- p x <- p
if x then fmap Just f else return Nothing if x then fmap Just f else return Nothing
-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action. -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action.
(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b (-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
p -->> f = do p -->> f = do
Match b m <- p Match b m <- p
if b then (f m) else return mempty if b then (f m) else mempty
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule. -- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b) (-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
p -?>> f = do p -?>> f = do
Match b m <- p Match b m <- p
if b then fmap Just (f m) else return Nothing if b then fmap Just (f m) else return Nothing
@ -179,7 +179,7 @@ transience' :: ManageHook
transience' = maybeToDefinite transience transience' = maybeToDefinite transience
-- | converts 'MaybeManageHook's to 'ManageHook's -- | converts 'MaybeManageHook's to 'ManageHook's
maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a maybeToDefinite :: MaybeManageHook -> ManageHook
maybeToDefinite = fmap (fromMaybe mempty) maybeToDefinite = fmap (fromMaybe mempty)

60
XMonad/Hooks/SetWMName.hs
View File

@ -36,45 +36,18 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Hooks.SetWMName ( module XMonad.Hooks.SetWMName (
setWMName setWMName) where
, getWMName
)
where
import Control.Monad (guard, join) import Control.Monad (join)
import Data.Char (ord) import Data.Char (ord)
import Data.List (nub) import Data.List (nub)
import Data.Maybe (listToMaybe, maybeToList) import Data.Maybe (fromJust, listToMaybe, maybeToList)
import qualified Data.Traversable as T
import Foreign.C.Types (CChar) import Foreign.C.Types (CChar)
import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Alloc (alloca)
import XMonad 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 -- | sets WM name
setWMName :: String -> X () setWMName :: String -> X ()
setWMName name = do setWMName name = do
@ -84,8 +57,7 @@ setWMName name = do
atom_UTF8_STRING <- getAtom "UTF8_STRING" atom_UTF8_STRING <- getAtom "UTF8_STRING"
root <- asks theRoot root <- asks theRoot
mw <- getSupportWindow supportWindow <- getSupportWindow
supportWindow <- maybe createSupportWindow return mw
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
@ -96,9 +68,33 @@ setWMName name = do
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 $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral 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 = getAtom "_NET_SUPPORTING_WM_CHECK"
latin1StringToCCharList :: String -> [CChar] latin1StringToCCharList :: String -> [CChar]
latin1StringToCCharList str = map (fromIntegral . ord) str 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) -- 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

1
xmonad-contrib.cabal
View File

@ -169,7 +169,6 @@ library
XMonad.Hooks.FadeInactive XMonad.Hooks.FadeInactive
XMonad.Hooks.FadeWindows XMonad.Hooks.FadeWindows
XMonad.Hooks.FloatNext XMonad.Hooks.FloatNext
XMonad.Hooks.Focus
XMonad.Hooks.ICCCMFocus XMonad.Hooks.ICCCMFocus
XMonad.Hooks.InsertPosition XMonad.Hooks.InsertPosition
XMonad.Hooks.ManageDebug XMonad.Hooks.ManageDebug