diff --git a/CHANGES.md b/CHANGES.md index e2768242ea..19ca312878 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -40,13 +40,18 @@ `XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well, and no configuration changes are required in this case. - - `ewmh` function will use `logHook` for handling activated window. And now - by default window activation will do nothing. - - You can use regular `ManageHook` combinators for changing window - activation behavior and then add resulting `ManageHook` using - `activateLogHook` to your `logHook`. Also, module `X.H.Focus` provides - additional combinators. + - Deprecated `ewmhDesktopsLogHookCustom` and `ewmhDesktopsEventHookCustom`; + these are now replaced by a composable `XMonad.Util.ExtensibleConf`-based + interface. Users are advised to just use the `ewmh` XConfig combinator + and customize behaviour using the provided `addEwmhWorkspaceSort`, + `addEwmhWorkspaceRename` functions, or better still, use integrations + provided by modules such as `XMonad.Actions.WorkspaceNames`. + + This interface now additionally allows customization of what happens + when clients request window activation. This can be used to ignore + activation of annoying applications, to mark windows as urgent instead + of focusing them, and more. There's also a new `XMonad.Hooks.Focus` + module extending the ManageHook EDSL with useful combinators. - Ordering of windows that are set to `_NET_CLIENT_LIST` and `_NET_CLIENT_LIST_STACKING` was changed to be closer to the spec. From now these two lists will have @@ -538,8 +543,8 @@ * `XMonad.Actions.WorkspaceNames` - - Added `workspaceNamesListTransform` which makes workspace names visible - to external pagers. + - Added `workspaceNamesEwmh` which makes workspace names visible to + external pagers. * `XMonad.Util.PureX` @@ -637,6 +642,10 @@ - Added a variant of `filterUrgencyHook` that takes a generic `Query Bool` to select which windows should never be marked urgent. + - Added `askUrgent` and a `doAskUrgent` manage hook helper for marking + windows as urgent from inside of xmonad. This can be used as a less + intrusive action for windows requesting focus. + * `XMonad.Hooks.ServerMode` - To make it easier to use, the `xmonadctl` client is now included in diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 1f25002581..13e5b28099 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -22,7 +22,6 @@ module XMonad.Actions.WorkspaceNames ( -- * Workspace naming renameWorkspace, - workspaceNamesPP, getWorkspaceNames', getWorkspaceNames, getWorkspaceName, @@ -38,8 +37,9 @@ module XMonad.Actions.WorkspaceNames ( -- * Workspace prompt workspaceNamePrompt, - -- * EwmhDesktops integration - workspaceNamesListTransform + -- * StatusBar, EwmhDesktops integration + workspaceNamesPP, + workspaceNamesEwmh, ) where import XMonad @@ -50,6 +50,7 @@ import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS) import qualified XMonad.Actions.SwapWorkspaces as Swap import XMonad.Hooks.StatusBar.PP (PP(..)) +import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename) import XMonad.Prompt (mkXPrompt, XPConfig) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) @@ -72,6 +73,11 @@ import qualified Data.Map as M -- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate -- this into your status bar. -- +-- To expose workspace names to pagers and other EWMH clients, integrate this +-- with "XMonad.Hooks.EwmhDesktops": +-- +-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…} +-- -- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s -- functionality, which may be used this way: -- @@ -135,11 +141,6 @@ renameWorkspace conf = mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName where pr = Wor "Workspace name: " --- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show --- workspace names as well. -workspaceNamesPP :: PP -> X PP -workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren } - -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X () swapTo dir = swapTo' dir anyWS @@ -177,12 +178,12 @@ workspaceNamePrompt conf job = do contains completions input = return $ filter (isInfixOf input) completions --- | Workspace list transformation for --- 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsLogHookCustom' that exposes --- workspace names to pagers and other EWMH-aware clients. --- --- Usage: --- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> … -workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace]) -workspaceNamesListTransform = - getWorkspaceNames ":" <&> \names -> map $ \ws -> ws{ W.tag = names (W.tag ws) ws } +-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show +-- workspace names as well. +workspaceNamesPP :: PP -> X PP +workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren } + +-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop +-- names. +workspaceNamesEwmh :: XConfig l -> XConfig l +workspaceNamesEwmh = addEwmhWorkspaceRename $ getWorkspaceNames ":" diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index 6a7a13d29e..f7eaa46b2b 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -197,15 +197,13 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = - docks $ + docks . ewmhFullscreen . ewmh $ def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, - logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, - handleEventHook = ewmhDesktopsEventHook - `mappend` fullscreenEventHook - `mappend` minimizeEventHook + logHook = currentWorkspaceOnTop, + handleEventHook = minimizeEventHook `mappend` serverModeEventHook' bluetileCommands `mappend` positionStoreEventHook, workspaces = bluetileWorkspaces, diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs index f94552f398..e6db6b86e3 100644 --- a/XMonad/Config/Desktop.hs +++ b/XMonad/Config/Desktop.hs @@ -60,7 +60,6 @@ import XMonad.Hooks.ManageDocks import XMonad.Hooks.EwmhDesktops import XMonad.Layout.LayoutModifier (ModifiedLayout) import XMonad.Util.Cursor -import qualified XMonad.StackSet as W import qualified Data.Map as M @@ -172,7 +171,6 @@ desktopConfig :: XConfig (ModifiedLayout AvoidStruts desktopConfig = docks $ ewmh def { startupHook = setDefaultCursor xC_left_ptr <+> startupHook def , layoutHook = desktopLayoutModifiers $ layoutHook def - , logHook = desktopLogHook <+> logHook def , keys = desktopKeys <+> keys def } desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ()) @@ -181,8 +179,3 @@ desktopKeys XConfig{modMask = modm} = M.fromList desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a desktopLayoutModifiers = avoidStruts - --- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to --- activated window. -desktopLogHook :: X () -desktopLogHook = activateLogHook (reader W.focusWindow >>= doF) diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 295850348c..f6dd58ec30 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -1,10 +1,11 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.EwmhDesktops --- Description : Make xmonad use the extended window manager hints (EWMH). +-- Description : Make xmonad use the extended window manager hints (EWMH). -- Copyright : (c) 2007, 2008 Joachim Breitner -- License : BSD -- @@ -12,25 +13,41 @@ -- Stability : unstable -- Portability : unportable -- --- Makes xmonad use the EWMH hints to tell panel applications about its --- workspaces and the windows therein. It also allows the user to interact --- with xmonad by clicking on panels and window lists. +-- Makes xmonad use the +-- +-- hints to tell panel applications about its workspaces and the windows +-- therein. It also allows the user to interact with xmonad by clicking on +-- panels and window lists. ----------------------------------------------------------------------------- module XMonad.Hooks.EwmhDesktops ( -- * Usage -- $usage ewmh, + ewmhFullscreen, + + -- * Customization + -- $customization + + -- ** Sorting/filtering of workspaces + -- $customSort + addEwmhWorkspaceSort, setEwmhWorkspaceSort, + + -- ** Renaming of workspaces + -- $customRename + addEwmhWorkspaceRename, setEwmhWorkspaceRename, + + -- ** Window activation + -- $customActivate + setEwmhActivateHook, + + -- * Standalone hooks (deprecated) ewmhDesktopsStartup, ewmhDesktopsLogHook, ewmhDesktopsLogHookCustom, - NetActivated (..), - activated, - activateLogHook, ewmhDesktopsEventHook, ewmhDesktopsEventHookCustom, - ewmhFullscreen, fullscreenEventHook, - fullscreenStartup + fullscreenStartup, ) where import Codec.Binary.UTF8.String (encode) @@ -41,10 +58,11 @@ import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W +import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName -import qualified XMonad.Util.ExtensibleState as E import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) +import qualified XMonad.Util.ExtensibleConf as XC import qualified XMonad.Util.ExtensibleState as XS -- $usage @@ -59,123 +77,235 @@ import qualified XMonad.Util.ExtensibleState as XS -- -- > main = xmonad $ … . ewmh . … $ def{…} -- --- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". +-- You may also be interested in 'XMonad.Hooks.ManageDocks.docks' and +-- 'XMonad.Hooks.UrgencyHook.withUrgencyHook', which provide support for other +-- parts of the +-- . + +-- | Add EWMH support for workspaces (virtual desktops) to the given +-- 'XConfig'. See above for an example. +ewmh :: XConfig a -> XConfig a +ewmh c = c { startupHook = ewmhDesktopsStartup <+> startupHook c + , handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c + , logHook = ewmhDesktopsLogHook <+> logHook c } + + +-- $customization +-- It's possible to customize the behaviour of 'ewmh' in several ways: + +-- | Customizable configuration for EwmhDesktops +data EwmhDesktopsConfig = + EwmhDesktopsConfig + { workspaceSort :: X WorkspaceSort + -- ^ configurable workspace sorting/filtering + , workspaceRename :: X (String -> WindowSpace -> String) + -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename') + , activateHook :: ManageHook + -- ^ configurable handling of window activation requests + } + +instance Default EwmhDesktopsConfig where + def = EwmhDesktopsConfig + { workspaceSort = getSortByIndex + , workspaceRename = pure pure + , activateHook = doFocus + } + + +-- $customSort +-- The list of workspaces exposed to EWMH pagers (like +-- and +-- ) and clients (such as +-- and +-- ) may be sorted and/or +-- filtered via a user-defined function. +-- +-- To show visible workspaces first, one may switch to a Xinerama-aware +-- sorting function: -- --- __/NOTE:/__ 'ewmh' function will call 'logHook' for handling activated --- window. +-- > import XMonad.Util.WorkspaceCompare +-- > +-- > mySort = getSortByXineramaRule +-- > main = xmonad $ … . setEwmhWorkspaceSort mySort . ewmh . … $ def{…} -- --- 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 and then add resulting 'ManageHook' --- using 'activateLogHook' to your 'logHook'. Also, you may be interested in --- "XMonad.Hooks.Focus", which provides additional predicates for using in --- 'ManageHook'. +-- Another useful example is not exposing the hidden scratchpad workspace: -- --- To get back old 'ewmh' window activation behavior (switch workspace and --- focus to activated window) you may use: +-- > import XMonad.Util.NamedScratchpad +-- > import XMonad.Util.WorkspaceCompare +-- > +-- > myFilter = filterOutWs [scratchpadWorkspaceTag] +-- > main = xmonad $ … . addEwmhWorkspaceSort (pure myFilter) . ewmh . … $ def{…} + +-- | Add (compose after) an arbitrary user-specified function to sort/filter +-- the workspace list. The default/initial function is 'getSortByIndex'. This +-- can be used to e.g. filter out scratchpad workspaces. Workspaces /must not/ +-- be renamed here. +addEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l +addEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = liftA2 (.) f (workspaceSort c) } + +-- | Like 'addEwmhWorkspaceSort', but replace it instead of adding/composing. +setEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l +setEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = f } + + +-- $customRename +-- The workspace names exposed to EWMH pagers and other clients (e.g. +-- ) may be altered using a similar +-- interface to 'XMonad.Hooks.StatusBar.PP.ppRename'. To configure workspace +-- renaming, use 'addEwmhWorkspaceRename'. -- --- > import XMonad +-- As an example, to expose workspaces uppercased: +-- +-- > import Data.Char -- > --- > import XMonad.Hooks.EwmhDesktops --- > import qualified XMonad.StackSet as W +-- > myRename :: String -> WindowSpace -> String +-- > myRename s _w = map toUpper s -- > --- > main :: IO () --- > main = do --- > let acMh :: ManageHook --- > acMh = reader W.focusWindow >>= doF --- > xcf = ewmh $ def --- > { modMask = mod4Mask --- > , logHook = activateLogHook acMh <+> logHook def --- > } --- > xmonad xcf - --- | Add EWMH functionality to the given config. See above for an example. -ewmh :: XConfig a -> XConfig a -ewmh c = c { startupHook = ewmhDesktopsStartup <+> startupHook c - , handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c - , logHook = ewmhDesktopsLogHook <+> logHook c } +-- > main = xmonad $ … . addEwmhWorkspaceRename (pure myRename) . ewmh . … $ def{…} +-- +-- Some modules like "XMonad.Actions.WorkspaceNames" provide ready-made +-- integrations: +-- +-- > import XMonad.Actions.WorkspaceNames +-- > +-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…} +-- +-- The above ensures workspace names are exposed through EWMH. + +-- | Add (compose after) an arbitrary user-specified function to rename each +-- workspace. This works just like 'XMonad.Hooks.StatusBar.PP.ppRename': the +-- @WindowSpace -> …@ acts as a Reader monad. Useful with +-- "XMonad.Actions.WorkspaceNames", "XMonad.Layout.IndependentScreens", +-- "XMonad.Hooks.DynamicIcons". +addEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l +addEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = liftA2 (<=<) f (workspaceRename c) } + +-- | Like 'addEwmhWorkspaceRename', but replace it instead of adding/composing. +setEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l +setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f } + + +-- $customActivate +-- When a client sends a @_NET_ACTIVE_WINDOW@ request to activate a window, by +-- default that window is activated by invoking the 'doFocus' 'ManageHook'. +-- +-- that a window manager may instead just mark the window as urgent, and this +-- can be achieved using the following: +-- +-- > import XMonad.Hooks.UrgencyHook +-- > +-- > main = xmonad $ … . setEwmhActivateHook doAskUrgent . ewmh . … $ def{…} +-- +-- One may also wish to ignore activation requests from certain applications +-- entirely: +-- +-- > import XMonad.Hooks.ManageHelpers +-- > +-- > myActivateHook :: ManageHook +-- > myActivateHook = +-- > className /=? "Google-chrome" <&&> className /=? "google-chrome" --> doFocus +-- > +-- > main = xmonad $ … . setEwmhActivateHook myActivateHook . ewmh . … $ def{…} +-- +-- Arbitrarily complex hooks can be used. This last example marks Chrome +-- windows as urgent and focuses everything else: +-- +-- > myActivateHook :: ManageHook +-- > myActivateHook = composeOne +-- > [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent +-- > , pure True -?> doFocus ] +-- +-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus" +-- for functions that can be useful here. --- | --- Initializes EwmhDesktops and advertises EWMH support to the X --- server +-- | Set (replace) the hook which is invoked when a client sends a +-- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus' +-- which focuses the window immediately, switching workspace if necessary. +-- 'XMonad.Hooks.UrgencyHook.doAskUrgent' is a less intrusive alternative. +-- +-- More complex hooks can be constructed using combinators from +-- "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus". +setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l +setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h } + + +-- | Initializes EwmhDesktops and advertises EWMH support to the X server. +{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-} ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported --- | --- Notifies pagers and window lists, such as those in the gnome-panel --- of the current state of workspaces and windows. +-- | Notifies pagers and window lists, such as those in the gnome-panel of the +-- current state of workspaces and windows. +{-# DEPRECATED ewmhDesktopsLogHook "Use ewmh instead." #-} ewmhDesktopsLogHook :: X () -ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id +ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook' --- | --- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and --- @_NET_DESKTOP_NAMES@). -newtype DesktopNames = DesktopNames [String] - deriving Eq - -instance ExtensionClass DesktopNames where - initialValue = DesktopNames [] - --- | --- Cached client list (e.g. @_NET_CLIENT_LIST@). -newtype ClientList = ClientList [Window] - deriving Eq - -instance ExtensionClass ClientList where - initialValue = ClientList [none] +-- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary +-- user-specified function to sort/filter the workspace list (post-sorting). +{-# DEPRECATED ewmhDesktopsLogHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-} +ewmhDesktopsLogHookCustom :: WorkspaceSort -> X () +ewmhDesktopsLogHookCustom f = + ewmhDesktopsLogHook' def{ workspaceSort = (f .) <$> workspaceSort def } --- | --- Cached stacking client list (e.g. @_NET_CLIENT_LIST_STACKING@). -newtype ClientListStacking = ClientListStacking [Window] - deriving Eq +-- | Intercepts messages from pagers and similar applications and reacts on them. +-- +-- Currently supports: +-- +-- * _NET_CURRENT_DESKTOP (switching desktops) +-- +-- * _NET_WM_DESKTOP (move windows to other desktops) +-- +-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) +-- +-- * _NET_CLOSE_WINDOW (close window) +{-# DEPRECATED ewmhDesktopsEventHook "Use ewmh instead." #-} +ewmhDesktopsEventHook :: Event -> X All +ewmhDesktopsEventHook = XC.withDef . ewmhDesktopsEventHook' -instance ExtensionClass ClientListStacking where - initialValue = ClientListStacking [none] +-- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary +-- user-specified function to sort/filter the workspace list (post-sorting). +{-# DEPRECATED ewmhDesktopsEventHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-} +ewmhDesktopsEventHookCustom :: WorkspaceSort -> Event -> X All +ewmhDesktopsEventHookCustom f e = + ewmhDesktopsEventHook' e def{ workspaceSort = (f .) <$> workspaceSort def } --- | --- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@). -newtype CurrentDesktop = CurrentDesktop Int - deriving Eq +-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@ +newtype DesktopNames = DesktopNames [String] deriving Eq +instance ExtensionClass DesktopNames where initialValue = DesktopNames [] -instance ExtensionClass CurrentDesktop where - initialValue = CurrentDesktop (-1) +-- | Cached @_NET_CLIENT_LIST@ +newtype ClientList = ClientList [Window] deriving Eq +instance ExtensionClass ClientList where initialValue = ClientList [none] --- | --- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@). -newtype WindowDesktops = WindowDesktops (M.Map Window Int) - deriving Eq +-- | Cached @_NET_CLIENT_LIST_STACKING@ +newtype ClientListStacking = ClientListStacking [Window] deriving Eq +instance ExtensionClass ClientListStacking where initialValue = ClientListStacking [none] -instance ExtensionClass WindowDesktops where - initialValue = WindowDesktops (M.singleton none (-1)) +-- | Cached @_NET_CURRENT_DESKTOP@ +newtype CurrentDesktop = CurrentDesktop Int deriving Eq +instance ExtensionClass CurrentDesktop where initialValue = CurrentDesktop (complement 0) --- | --- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property --- updates. -newtype ActiveWindow = ActiveWindow Window - deriving Eq +-- | Cached @_NET_WM_DESKTOP@ +newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving Eq +instance ExtensionClass WindowDesktops where initialValue = WindowDesktops (M.singleton none (complement 0)) -instance ExtensionClass ActiveWindow where - initialValue = ActiveWindow (complement none) +-- | Cached @_NET_ACTIVE_WINDOW@ +newtype ActiveWindow = ActiveWindow Window deriving Eq +instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (complement none) -- | Compare the given value against the value in the extensible state. Run the -- action if it has changed. whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () -whenChanged v action = do - v0 <- E.get - unless (v == v0) $ do - action - E.put v +whenChanged = whenX . XS.modified . const --- | --- Generalized version of ewmhDesktopsLogHook that allows an arbitrary --- user-specified function to transform the workspace list (post-sorting) -ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () -ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = t $ sort' $ W.workspaces s +ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X () +ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename} = withWindowSet $ \s -> do + sort' <- workspaceSort + let ws = sort' $ W.workspaces s -- Set number of workspaces and names thereof - let desktopNames = map W.tag ws + rename <- workspaceRename + let desktopNames = [ rename (W.tag w) w | w <- ws ] whenChanged (DesktopNames desktopNames) $ do setNumberOfDesktops (length desktopNames) setDesktopNames desktopNames @@ -191,9 +321,8 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do let clientListStacking = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws whenChanged (ClientListStacking clientListStacking) $ setClientListStacking clientListStacking - -- Remap the current workspace to handle any renames that f might be doing. - let maybeCurrent' = W.tag <$> listToMaybe (t [W.workspace $ W.current s]) - current = flip elemIndex (map W.tag ws) =<< maybeCurrent' + -- Set current desktop number + let current = W.currentTag s `elemIndex` map W.tag ws whenChanged (CurrentDesktop $ fromMaybe 0 current) $ mapM_ setCurrentDesktop current @@ -208,65 +337,13 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do let activeWindow' = fromMaybe none (W.peek s) whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' --- | --- Intercepts messages from pagers and similar applications and reacts on them. --- Currently supports: --- --- * _NET_CURRENT_DESKTOP (switching desktops) --- --- * _NET_WM_DESKTOP (move windows to other desktops) --- --- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) --- --- * _NET_CLOSE_WINDOW (close window) -ewmhDesktopsEventHook :: Event -> X All -ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id - --- | --- Generalized version of ewmhDesktopsEventHook that allows an arbitrary --- user-specified function to transform the workspace list (post-sorting) -ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All -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 'logHook' for handling activated --- windows and i need a way to tell 'logHook' what window is activated. -newtype NetActivated = NetActivated {netActivated :: Maybe Window} - deriving Show -instance ExtensionClass NetActivated where - initialValue = NetActivated Nothing - --- | Was new window @_NET_ACTIVE_WINDOW@ activated? -activated :: Query Bool -activated = fmap (isJust . netActivated) (liftX XS.get) - --- | Run supplied 'ManageHook' for activated windows /only/. If you want to --- run this 'ManageHook' for new windows too, add it to 'manageHook'. --- --- __/NOTE:/__ 'activateLogHook' will work only _once_. I.e. if several --- 'activateLogHook'-s was used, only first one will actually run (because it --- resets 'NetActivated' at the end and others won't know, that window is --- activated). -activateLogHook :: ManageHook -> X () -activateLogHook mh = XS.get >>= maybe (return ()) go . netActivated - where - go :: Window -> X () - go w = do - f <- runQuery mh w - -- I should reset 'NetActivated' here, because: - -- * 'windows' calls 'logHook' and i shouldn't go here the second - -- time for one window. - -- * if i reset 'NetActivated' before running 'logHook' once, - -- then 'activated' predicate won't match. - -- Thus, here is the /only/ correct place. - XS.put NetActivated{netActivated = Nothing} - windows (appEndo f) - -handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X () -handle f ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} = +ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All +ewmhDesktopsEventHook' + ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} + EwmhDesktopsConfig{workspaceSort, activateHook} = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = f $ sort' $ W.workspaces s + sort' <- workspaceSort + let ws = sort' $ W.workspaces s a_cd <- getAtom "_NET_CURRENT_DESKTOP" a_d <- getAtom "_NET_WM_DESKTOP" @@ -284,42 +361,35 @@ handle f ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} = | mt == a_aw, 2 : _ <- d -> -- when the request comes from a pager, honor it unconditionally -- https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html#sourceindication - windows $ W.focusWindow w - | mt == a_aw, W.peek s /= Just w -> do - lh <- asks (logHook . config) - XS.put (NetActivated (Just w)) - lh + if W.peek s == Just w then mempty else windows $ W.focusWindow w + | mt == a_aw -> do + if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w | mt == a_cw -> killWindow w | otherwise -> -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager - return () -handle _ _ = return () + mempty + + mempty +ewmhDesktopsEventHook' _ _ = mempty -- | Add EWMH fullscreen functionality to the given config. --- --- This must be applied after 'ewmh', like so: --- --- > main = xmonad $ ewmhFullscreen $ ewmh def --- --- NOT: --- --- > main = xmonad $ ewmh $ ewmhFullscreen def ewmhFullscreen :: XConfig a -> XConfig a ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup , handleEventHook = handleEventHook c <+> fullscreenEventHook } -- | Advertises EWMH fullscreen support to the X server. +{-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-} fullscreenStartup :: X () fullscreenStartup = setFullscreenSupported --- | --- An event hook to handle applications that wish to fullscreen using the --- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() +-- | An event hook to handle applications that wish to fullscreen using the +-- @_NET_WM_STATE@ protocol. This includes users of the @gtk_window_fullscreen()@ -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'. +{-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-} fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do managed <- isClient win @@ -385,6 +455,12 @@ setWindowDesktop win i = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_DESKTOP" io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i] +setActiveWindow :: Window -> X () +setActiveWindow w = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_ACTIVE_WINDOW" + io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w] + setSupported :: X () setSupported = withDisplay $ \dpy -> do r <- asks theRoot @@ -416,9 +492,3 @@ addSupported props = withDisplay $ \dpy -> do setFullscreenSupported :: X () setFullscreenSupported = addSupported ["_NET_WM_STATE", "_NET_WM_STATE_FULLSCREEN"] - -setActiveWindow :: Window -> X () -setActiveWindow w = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_ACTIVE_WINDOW" - io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w] diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index c9660550db..808d1e5479 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -4,10 +4,13 @@ -- | -- Module: XMonad.Hooks.Focus --- Description: Provide additional information about a new window. +-- Description: Extends ManageHook EDSL to work on focused windows and current workspace. -- Copyright: sgf-dma, 2016 -- Maintainer: sgf.dma@gmail.com -- +-- Extends "XMonad.ManageHook" EDSL to work on focused windows and current +-- workspace. +-- module XMonad.Hooks.Focus ( @@ -70,7 +73,6 @@ import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Hooks.ManageHelpers (currentWs) -import XMonad.Hooks.EwmhDesktops (activated) -- $main @@ -96,8 +98,8 @@ import XMonad.Hooks.EwmhDesktops (activated) -- -- I may use one of predefined configurations. -- --- 1. Default window activation behavior is to switch to workspace with --- activated window and switch focus to it: +-- 1. The default window activation behavior (switch to workspace with +-- activated window and switch focus to it) expressed using this module: -- -- > import XMonad -- > @@ -106,44 +108,42 @@ import XMonad.Hooks.EwmhDesktops (activated) -- > -- > main :: IO () -- > main = do --- > let mh :: ManageHook --- > mh = activateSwitchWs --- > xcf = ewmh $ def --- > { modMask = mod4Mask --- > , logHook = activateLogHook mh <+> logHook def --- > } +-- > let ah :: ManageHook +-- > ah = activateSwitchWs +-- > xcf = setEwmhActivateHook ah +-- > . ewmh $ def{ modMask = mod4Mask } -- > xmonad xcf -- -- 2. Or i may move activated window to current workspace and switch focus to -- it: -- --- > let mh :: ManageHook --- > mh = activateOnCurrentWs +-- > let ah :: ManageHook +-- > ah = activateOnCurrentWs -- -- 3. Or move activated window to current workspace, but keep focus unchanged: -- --- > let mh :: ManageHook --- > mh = activateOnCurrentKeepFocus +-- > let ah :: ManageHook +-- > ah = 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 =? "Firefox-esr" <||> className =? "Iceweasel") +-- > let ah :: ManageHook +-- > ah = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") -- > --> activateSwitchWs -- -- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless -- xterm is focused on /current/ workspace: -- --- > let mh :: ManageHook --- > mh = manageFocus (not <$> focusedCur (className =? "XTerm") +-- > let ah :: ManageHook +-- > ah = manageFocus (not <$> focusedCur (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- or activate all windows, unless focused window on the workspace, -- /where activated window is/, is not a xterm: -- --- > let mh :: ManageHook --- > mh = manageFocus (not <$> focused (className =? "XTerm") +-- > let ah :: ManageHook +-- > ah = manageFocus (not <$> focused (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- == Defining FocusHook. @@ -198,11 +198,11 @@ import XMonad.Hooks.EwmhDesktops (activated) -- > main = do -- > let newFh :: ManageHook -- > newFh = manageFocus newFocusHook --- > acFh :: X () --- > acFh = activateLogHook (manageFocus activateFocusHook) --- > xcf = ewmh $ def +-- > acFh :: ManageHook +-- > acFh = manageFocus activateFocusHook +-- > xcf = setEwmhActivateHook acFh +-- > . ewmh $ def -- > { manageHook = newFh <+> manageHook def --- > , logHook = acFh <+> logHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] @@ -215,30 +215,23 @@ import XMonad.Hooks.EwmhDesktops (activated) -- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window -- activation. -- - 'FocusHook' in 'manageHook' will be called /only/ for new windows. --- - 'FocusHook' in 'logHook' will be called /only/ for activated windows. +-- - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows. -- -- Alternatively, i may construct a single 'FocusHook' for both new and --- activated windows and then just add it to both 'manageHook' and 'logHook': --- --- > let fh :: ManageHook --- > fh = manageFocus $ (composeOne --- > [ liftQuery activated -?> activateFocusHook --- > , Just <$> newFocusHook --- > ]) --- > xcf = ewmh $ def --- > { manageHook = fh <+> manageHook def --- > , logHook = activateLogHook fh <+> logHook def +-- activated windows and then just add it to both 'manageHook' and 'setEwmhActivateHook': +-- +-- > let fh :: Bool -> ManageHook +-- > fh activated = manageFocus $ composeOne +-- > [ pure activated -?> activateFocusHook +-- > , pure True -?> newFocusHook +-- > ] +-- > xcf = setEwmhActivateHook (fh True) +-- > . ewmh $ def +-- > { manageHook = fh False <+> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- --- Note: --- - Predicate 'activated' will be 'True' for activated window. --- - 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 @@ -265,11 +258,6 @@ import XMonad.Hooks.EwmhDesktops (activated) -- -- now @FH2@ will see window shift made by @FH1@. -- --- Also, note, that if several 'activateLogHook'-s are sequenced, only --- /first/ one (leftmost) will run. Thus, to make above working, --- 'mappend' all 'ManageHook'-s first, and then run by /single/ --- 'activateLogHook' (see next example). --- -- Another interesting example is moving all activated windows to current -- workspace by default, and applying 'FocusHook' after: -- @@ -282,14 +270,14 @@ import XMonad.Hooks.EwmhDesktops (activated) -- > -- > main :: IO () -- > main = do --- > let fh :: ManageHook --- > fh = manageFocus $ (composeOne --- > [ liftQuery activated -?> (newOnCur --> keepFocus) --- > , Just <$> newFocusHook --- > ]) --- > xcf = ewmh $ def --- > { manageHook = fh <+> manageHook def --- > , logHook = activateLogHook (fh <+> activateOnCurrentWs) <+> logHook def +-- > let fh :: Bool -> ManageHook +-- > fh activated = manageFocus $ composeOne +-- > [ pure activated -?> (newOnCur --> keepFocus) +-- > , pure True -?> newFocusHook +-- > ] +-- > xcf = setEwmhActivateHook (fh True <+> activateOnCurrentWs) +-- > . ewmh $ def +-- > { manageHook = fh False <+> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] @@ -320,11 +308,10 @@ import XMonad.Hooks.EwmhDesktops (activated) -- -- - i keep focus, when activated window appears on current workspace, in -- this example. --- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated +-- - when @pure 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 before applying -- @activateOnCurrentWs@ 'FocusHook'. --- - i 'mappend' all 'ManageHook'-s and run 'activateLogHook' only once. -- FocusQuery. @@ -553,24 +540,22 @@ when' b mx -- $examples -- | Default EWMH window activation behavior: switch to workspace with --- activated window and switch focus to it. +-- activated window and switch focus to it. Not to be used in a 'manageHook'. activateSwitchWs :: ManageHook -activateSwitchWs = manageFocus (liftQuery activated --> - switchWorkspace <+> switchFocus) +activateSwitchWs = manageFocus (switchWorkspace <+> switchFocus) --- | Move activated window to current workspace. +-- | Move activated window to current workspace. Not to be used in a 'manageHook'. activateOnCurrent' :: ManageHook -activateOnCurrent' = activated --> currentWs >>= unlessFocusLock . doShift +activateOnCurrent' = 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. +-- switched. Not to be used in a 'manageHook'. activateOnCurrentWs :: ManageHook -activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus) - <+> activateOnCurrent' +activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <+> activateOnCurrent' -- | Move activated window to current workspace, but keep focus unchanged. +-- Not to be used in a 'manageHook'. activateOnCurrentKeepFocus :: ManageHook -activateOnCurrentKeepFocus = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus) - <+> activateOnCurrent' +activateOnCurrentKeepFocus = manageFocus (newOnCur --> keepFocus) <+> activateOnCurrent' diff --git a/XMonad/Hooks/ManageHelpers.hs b/XMonad/Hooks/ManageHelpers.hs index 7f09c6b143..bbd392b18c 100644 --- a/XMonad/Hooks/ManageHelpers.hs +++ b/XMonad/Hooks/ManageHelpers.hs @@ -56,6 +56,7 @@ module XMonad.Hooks.ManageHelpers ( doSink, doLower, doRaise, + doFocus, Match, ) where @@ -274,7 +275,7 @@ doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w) -- | Sinks a window doSink :: ManageHook -doSink = reader (Endo . W.sink) +doSink = doF . W.sink =<< ask -- | Lower an unmanaged window. Useful together with 'doIgnore' to lower -- special windows that for some reason don't do it themselves. @@ -285,3 +286,7 @@ doLower = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (lowerWindow dpy w) >> -- special windows that for some reason don't do it themselves. doRaise :: ManageHook doRaise = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (raiseWindow dpy w) >> mempty + +-- | Focus a window (useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook'). +doFocus :: ManageHook +doFocus = doF . W.focusWindow =<< ask diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index cc9b0e7bae..e2012c68b1 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -60,6 +60,7 @@ module XMonad.Hooks.UrgencyHook ( FocusHook(..), filterUrgencyHook, filterUrgencyHook', minutes, seconds, + askUrgent, doAskUrgent, -- * Stuff for developers: readUrgents, withUrgents, clearUrgents', StdoutUrgencyHook(..), @@ -70,7 +71,7 @@ module XMonad.Hooks.UrgencyHook ( ) where import XMonad -import XMonad.Prelude (delete, fromMaybe, listToMaybe, maybeToList, when, (\\)) +import XMonad.Prelude (fi, delete, fromMaybe, listToMaybe, maybeToList, when, (\\)) import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers (windowTag) @@ -542,3 +543,28 @@ filterUrgencyHook skips = filterUrgencyHook' $ maybe False (`elem` skips) <$> wi -- should never be marked urgent. filterUrgencyHook' :: Query Bool -> Window -> X () filterUrgencyHook' q w = whenX (runQuery q w) (clearUrgents' [w]) + +-- | Mark the given window urgent. +-- +-- (The implementation is a bit hacky: send a _NET_WM_STATE ClientMessage to +-- ourselves. This is so that we respect the 'SuppressWhen' of the configured +-- urgency hooks. If this module if ever migrated to the ExtensibleConf +-- infrastrcture, we'll then invoke markUrgent directly.) +askUrgent :: Window -> X () +askUrgent w = withDisplay $ \dpy -> do + rw <- asks theRoot + a_wmstate <- getAtom "_NET_WM_STATE" + a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION" + let state_add = 1 + let source_pager = 2 + io $ allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent' e w a_wmstate 32 [state_add, fi a_da, 0, source_pager] + sendEvent dpy rw False (substructureRedirectMask .|. substructureNotifyMask) e + +-- | Helper for 'ManageHook' that marks the window as urgent (unless +-- suppressed, see 'SuppressWhen'). Useful in +-- 'XMonad.Hooks.EwmhDesktops.setEwmhActivateHook' and also in combination +-- with "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus". +doAskUrgent :: ManageHook +doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> mempty diff --git a/XMonad/Util/ExtensibleConf.hs b/XMonad/Util/ExtensibleConf.hs index e51b9c478c..56c57c2207 100644 --- a/XMonad/Util/ExtensibleConf.hs +++ b/XMonad/Util/ExtensibleConf.hs @@ -21,20 +21,27 @@ module XMonad.Util.ExtensibleConf ( -- * Usage -- $usage - -- * High-level idioms + -- * High-level idioms based on Semigroup with, add, once, onceM, + -- * High-level idioms based on Default + withDef, + modifyDef, + modifyDefM, + -- * Low-level primitivies ask, lookup, alter, + alterF, ) where import Prelude hiding (lookup) -import XMonad hiding (ask) +import XMonad hiding (ask, modify, trace) +import XMonad.Prelude ((<|>), (<&>), fromMaybe) import Data.Typeable import qualified Data.Map as M @@ -85,6 +92,15 @@ alter f = mapEC $ M.alter (mapConfExt f) (typeRep (Proxy @a)) where mapEC g c = c{ extensibleConf = g (extensibleConf c) } +-- | Config-time: Functor variant of 'alter', useful if the configuration +-- modifications needs to do some 'IO'. +alterF :: forall a l f. (Typeable a, Functor f) + => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l) +alterF f = mapEC $ M.alterF (mapConfExtF f) (typeRep (Proxy @a)) + where + mapEC g c = g (extensibleConf c) <&> \ec -> c{ extensibleConf = ec } + + fromConfExt :: Typeable a => ConfExtension -> Maybe a fromConfExt (ConfExtension val) = cast val @@ -92,9 +108,13 @@ mapConfExt :: Typeable a => (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension mapConfExt f = fmap ConfExtension . f . (>>= fromConfExt) +mapConfExtF :: (Typeable a, Functor f) + => (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension) +mapConfExtF f = fmap (fmap ConfExtension) . f . (>>= fromConfExt) + -- --------------------------------------------------------------------- --- High-level idioms +-- High-level idioms based on Semigroup -- | Run-time: Run a monadic action with the value of the custom -- configuration, if set. @@ -113,11 +133,14 @@ add x = alter (<> Just x) -- -- This can be used to implement a composable interface for modules that must -- only hook into xmonad core once. +-- +-- (The piece of custom configuration is the last argument as it's expected to +-- come from the user.) once :: forall a l. (Semigroup a, Typeable a) => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> XConfig l -once f x c = add x $ maybe f (const id) (lookup @a c) c +once f x c = maybe f (const id) (lookup @a c) $ add x c -- | Config-time: Applicative (monadic) variant of 'once', useful if the -- 'XConfig' modification needs to do some 'IO' (e.g. create an @@ -126,4 +149,33 @@ onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> m (XConfig l) -onceM f x c = add x <$> maybe f (const pure) (lookup @a c) c +onceM f x c = maybe f (const pure) (lookup @a c) $ add x c + + +-- --------------------------------------------------------------------- +-- High-level idioms based on Default + +-- | Run-time: Run a monadic action with the value of the custom +-- configuration, or the 'Default' value thereof, if absent. +withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b +withDef a = ask >>= a . fromMaybe def + +-- | Config-time: Modify a configuration value in 'XConfig', initializing it +-- to its 'Default' value first if absent. This is an alternative to 'add' for +-- when a 'Semigroup' instance is unavailable or unsuitable. +-- +-- Note that this must /not/ be used together with any variant of 'once'! +modifyDef :: forall a l. (Default a, Typeable a) + => (a -> a) -- ^ modification of configuration + -> XConfig l -> XConfig l +modifyDef f = alter ((f <$>) . (<|> Just def)) + +-- | Config-time: Applicative (monadic) variant of 'modifyDef', useful if the +-- configuration value modification needs to do some 'IO' (e.g. create an +-- 'Data.IORef.IORef'). +-- +-- Note that this must /not/ be used together with any variant of 'once'! +modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a) + => (a -> m a) -- ^ modification of configuration + -> XConfig l -> m (XConfig l) +modifyDefM f = alterF (traverse f . (<|> Just def)) diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs index 9aecbdcb98..12d6629304 100644 --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -90,11 +90,13 @@ import qualified XMonad.StackSet as W -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings" -- --- For some applications (like displaying your workspaces in a status bar) it is --- convenient to filter out the @NSP@ workspace when looking at all workspaces. --- For this, you can use functions 'XMonad.Hooks.StatusBar.PP.filterOutWsPP' and --- 'XMonad.Util.WorkspaceCompare.filterOutWs'. See the documentation of these --- functions for examples. +-- For some applications (like displaying your workspaces in a status bar) it +-- is convenient to filter out the @NSP@ workspace when looking at all +-- workspaces. For this, you can use 'XMonad.Hooks.StatusBar.PP.filterOutWsPP', +-- or 'XMonad.Util.WorkspaceCompare.filterOutWs' together with +-- 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort' if your status bar gets +-- the list of workspaces from EWMH. See the documentation of these functions +-- for examples. -- -- Further, there is also a @logHook@ that you can use to hide -- scratchpads when they lose focus; this is functionality akin to what diff --git a/XMonad/Util/Scratchpad.hs b/XMonad/Util/Scratchpad.hs index ca62a9c6ce..281835ec63 100644 --- a/XMonad/Util/Scratchpad.hs +++ b/XMonad/Util/Scratchpad.hs @@ -111,7 +111,9 @@ scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery -- | Transforms a workspace list containing the SP workspace into one that --- doesn't contain it. Intended for use with logHooks. +-- doesn't contain it. Intended for use with 'logHook's (see +-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops" +-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] scratchpadFilterOutWorkspace = filterOutWs [scratchpadWorkspaceTag] diff --git a/XMonad/Util/WorkspaceCompare.hs b/XMonad/Util/WorkspaceCompare.hs index 1290d1daaf..facc09940a 100644 --- a/XMonad/Util/WorkspaceCompare.hs +++ b/XMonad/Util/WorkspaceCompare.hs @@ -33,7 +33,9 @@ type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace] -- | Transforms a workspace list by filtering out the workspaces that --- correspond to the given 'tag's. Intended for use with logHooks. +-- correspond to the given 'tag's. Intended for use with 'logHook's (see +-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops" +-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). filterOutWs :: [WorkspaceId] -> WorkspaceSort filterOutWs ws = filter (\S.Workspace{ S.tag = tag } -> tag `notElem` ws) diff --git a/tests/ExtensibleConf.hs b/tests/ExtensibleConf.hs index bfb55560c8..e3bb906216 100644 --- a/tests/ExtensibleConf.hs +++ b/tests/ExtensibleConf.hs @@ -21,11 +21,21 @@ spec = do specify "lookup @() . add @String . add @[Int]" $ XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ()) - specify "once" $ - borderWidth (XC.once incBorderWidth "a" def) `shouldBe` succ (borderWidth def) - specify "once . once" $ - borderWidth (XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def)) - `shouldBe` succ (borderWidth def) + specify "once" $ do + let c = XC.once incBorderWidth "a" def + borderWidth c `shouldBe` succ (borderWidth def) + XC.lookup c `shouldBe` Just "a" + specify "once . once" $ do + let c = XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def) + borderWidth c `shouldBe` succ (borderWidth def) + XC.lookup c `shouldBe` Just "ab" + + specify "modifyDef" $ do + let c = XC.modifyDef (<> "a") def + XC.lookup c `shouldBe` Just "a" + specify "modifyDef . modifyDef" $ do + let c = XC.modifyDef (<> "b") (XC.modifyDef (<> "a") def) + XC.lookup c `shouldBe` Just "ab" incBorderWidth :: XConfig l -> XConfig l incBorderWidth c = c{ borderWidth = succ (borderWidth c) }