diff --git a/CHANGES.md b/CHANGES.md index 759ca2b4..7f1456c8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -45,6 +45,11 @@ - `execScriptHook` now has an `X` constraint (was: `MonadIO`), due to changes in how the xmonad core handles XDG directories. + * `XMonad.Actions.WorkspaceNames` + + - The type of `getWorkspaceNames` was changed to fit into the new `ppRename` + field of `PP`. + ### New Modules * `XMonad.Util.Hacks` @@ -240,6 +245,10 @@ to provide the configs for the already existing functionality. This provides multiple status bars support. + - Added `ppRename` to `PP`, which makes it possible for extensions like + `workspaceNamesPP`, `marshallPP` and/or `clickablePP` to compose + intuitively. + * `XMonad.Layout.BoringWindows` - Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions. diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 4464c383..49d04759 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -54,6 +54,7 @@ import XMonad.Prompt (mkXPrompt, XPConfig) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) +import Control.Monad ((>=>)) import Data.Functor ((<&>)) import qualified Data.Map as M import Data.Maybe (fromMaybe) @@ -101,12 +102,12 @@ getWorkspaceNames' = do WorkspaceNames m <- XS.get return (`M.lookup` m) --- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for --- workspaces with a name, and to @\"t\"@ otherwise. -getWorkspaceNames :: X (WorkspaceId -> String) -getWorkspaceNames = do - lookup' <- getWorkspaceNames' - return $ \wks -> wks ++ maybe "" (':' :) (lookup' wks) +-- | Returns a function for 'ppRename' that appends @sep@ and the workspace +-- name, if set. +getWorkspaceNames :: String -> X (String -> WindowSpace -> String) +getWorkspaceNames sep = ren <$> getWorkspaceNames' + where + ren name s w = s ++ maybe "" (sep ++) (name (W.tag w)) -- | Gets the name of a workspace, if set, otherwise returns nothing. getWorkspaceName :: WorkspaceId -> X (Maybe String) @@ -139,17 +140,7 @@ renameWorkspace conf = -- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show -- workspace names as well. workspaceNamesPP :: PP -> X PP -workspaceNamesPP pp = do - names <- getWorkspaceNames - return $ - pp { - ppCurrent = ppCurrent pp . names, - ppVisible = ppVisible pp . names, - ppHidden = ppHidden pp . names, - ppHiddenNoWindows = ppHiddenNoWindows pp . names, - ppVisibleNoWindows= ppVisibleNoWindows pp <&> (. names), - ppUrgent = ppUrgent pp . names - } +workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren } -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X () @@ -176,17 +167,15 @@ swapNames w1 w2 = do XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module. -workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X () +workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X () workspaceNamePrompt conf job = do - myWorkspaces <- gets $ map W.tag . W.workspaces . windowset - myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces - let pairs = zip myWorkspacesName myWorkspaces + myWorkspaces <- gets $ W.workspaces . windowset + myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- myWorkspaces] + let pairs = zip myWorkspacesName (map W.tag myWorkspaces) mkXPrompt (Wor "Select workspace: ") conf (contains myWorkspacesName) (job . toWsId pairs) - where toWsId pairs name = case lookup name pairs of - Nothing -> "" - Just i -> i + where toWsId pairs name = fromMaybe "" (lookup name pairs) contains completions input = return $ filter (Data.List.isInfixOf input) completions @@ -197,6 +186,5 @@ workspaceNamePrompt conf job = do -- Usage: -- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> … workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace]) -workspaceNamesListTransform = do - names <- getWorkspaceNames - return $ map $ \ws -> ws{ W.tag = names $ W.tag ws } +workspaceNamesListTransform = + getWorkspaceNames ":" <&> \names -> map $ \ws -> ws{ W.tag = names (W.tag ws) ws } diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 789c66c7..35321670 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -583,16 +583,18 @@ dynamicLogString pp = do pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ map S.workspace (S.current s : S.visible s) ++ S.hidden s - where this = S.currentTag s - visibles = map (S.tag . S.workspace) (S.visible s) + where + this = S.currentTag s + visibles = map (S.tag . S.workspace) (S.visible s) - fmt w = printer pp (S.tag w) - where printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents = ppUrgent - | S.tag w == this = ppCurrent - | S.tag w `elem` visibles && isJust (S.stack w) = ppVisible - | S.tag w `elem` visibles = liftA2 fromMaybe ppVisible ppVisibleNoWindows - | isJust (S.stack w) = ppHidden - | otherwise = ppHiddenNoWindows + fmt w = printer pp (ppRename pp (S.tag w) w) + where + printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents = ppUrgent + | S.tag w == this = ppCurrent + | S.tag w `elem` visibles && isJust (S.stack w) = ppVisible + | S.tag w `elem` visibles = liftA2 fromMaybe ppVisible ppVisibleNoWindows + | isJust (S.stack w) = ppHidden + | otherwise = ppHiddenNoWindows -- | -- Workspace logger with a format designed for Xinerama: @@ -936,6 +938,9 @@ data PP = PP { ppCurrent :: WorkspaceId -> String -- ^ how to print tags of empty visible workspaces , ppUrgent :: WorkspaceId -> String -- ^ format to be applied to tags of urgent workspaces. + , ppRename :: String -> WindowSpace -> String + -- ^ rename/augment the workspace tag + -- (note that @WindowSpace -> …@ acts as a Reader monad) , ppSep :: String -- ^ separator to use between different log sections -- (window name, layout, workspaces) @@ -987,6 +992,7 @@ instance Default PP where , ppHiddenNoWindows = const "" , ppVisibleNoWindows= Nothing , ppUrgent = id + , ppRename = pure , ppSep = " : " , ppWsSep = " " , ppTitle = shorten 80 diff --git a/XMonad/Layout/IndependentScreens.hs b/XMonad/Layout/IndependentScreens.hs index f729c577..7117e1eb 100644 --- a/XMonad/Layout/IndependentScreens.hs +++ b/XMonad/Layout/IndependentScreens.hs @@ -31,7 +31,6 @@ module XMonad.Layout.IndependentScreens ( -- for the screen stuff import Control.Applicative(liftA2) import Control.Arrow hiding ((|||)) -import Data.Functor ((<&>)) import Data.List (nub, genericLength) import Graphics.X11.Xinerama import XMonad @@ -135,15 +134,8 @@ countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getS -- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle -- > in log 0 hLeft >> log 1 hRight marshallPP :: ScreenId -> PP -> PP -marshallPP s pp = pp { - ppCurrent = ppCurrent pp . unmarshallW, - ppVisible = ppVisible pp . unmarshallW, - ppHidden = ppHidden pp . unmarshallW, - ppHiddenNoWindows = ppHiddenNoWindows pp . unmarshallW, - ppVisibleNoWindows = ppVisibleNoWindows pp <&> (. unmarshallW), - ppUrgent = ppUrgent pp . unmarshallW, - ppSort = fmap (marshallSort s) (ppSort pp) - } +marshallPP s pp = pp { ppRename = ppRename pp . unmarshallW + , ppSort = fmap (marshallSort s) (ppSort pp) } -- | Take a pretty-printer and turn it into one that only runs when the current -- workspace is one associated with the given screen. The way this works is a diff --git a/XMonad/Util/ClickableWorkspaces.hs b/XMonad/Util/ClickableWorkspaces.hs index 0ef4c44e..18916e18 100644 --- a/XMonad/Util/ClickableWorkspaces.hs +++ b/XMonad/Util/ClickableWorkspaces.hs @@ -18,22 +18,16 @@ module XMonad.Util.ClickableWorkspaces ( -- * Usage -- $usage clickablePP, - clickableRenamedPP, clickableWrap, - - -- * Integrations - clickableWorkspaceNamesPP, - clickableMarshallPP, - clickableMarshallWorkspaceNamesPP ) where +import Control.Monad ((>=>)) import Data.Functor ((<&>)) import XMonad -import XMonad.Actions.WorkspaceNames -import XMonad.Hooks.DynamicLog (xmobarAction, xmobarRaw, PP(..)) -import XMonad.Layout.IndependentScreens +import XMonad.Hooks.DynamicLog (xmobarAction, PP(..)) import XMonad.Util.WorkspaceCompare (getWsIndex) +import qualified XMonad.StackSet as W -- $usage -- However you have set up your PP, apply @clickablePP@ to it, and bind the result @@ -45,61 +39,26 @@ import XMonad.Util.WorkspaceCompare (getWsIndex) -- * @xdotool@ on system (in path) -- * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup) -- * use of UnsafeStdinReader/UnsafeXMonadLog in xmobarrc (rather than StdinReader/XMonadLog) +-- +-- Note that UnsafeStdinReader is potentially dangerous if your workspace +-- names are dynamically generated from untrusted input (like window titles). +-- You may need to add @xmobarRaw@ to 'ppRename' before applying +-- 'clickablePP' in such case. -- | Wrap string with an xmobar action that uses @xdotool@ to switch to -- workspace @i@. clickableWrap :: Int -> String -> String -clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" $ xmobarRaw ws +clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" ws -- | Return a function that wraps workspace names in an xmobar action that --- switches to that workspace. That workspace name must be exactly as --- configured in 'XMonad.Core.workspaces', so this takes an additional --- parameter that allows renaming/marshalling of the name for display, which --- is applied after the workspace's index is looked up. +-- switches to that workspace. -- --- This additionally assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook' +-- This assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook' -- isn't configured to change the workspace order. We might need to add an -- additional parameter if anyone needs that. -getClickable :: (WorkspaceId -> String) -> X (WorkspaceId -> String) -getClickable ren = do - wsIndex <- getWsIndex - return $ \ws -> case wsIndex ws of - Just idx -> clickableWrap idx (ren ws) - Nothing -> ws +getClickable :: X (String -> WindowSpace -> String) +getClickable = getWsIndex <&> \idx s w -> maybe id clickableWrap (idx (W.tag w)) s --- | Apply clickable wrapping to all workspace fields in given PP. +-- | Apply clickable wrapping to the given PP. clickablePP :: PP -> X PP -clickablePP = clickableRenamedPP id - --- | Alternative to 'clickablePP' that allows changing the visible workspace --- name. Useful for integration with modules that change workspace names, such --- as "XMonad.Layout.IndependentScreens" and "XMonad.Actions.WorkspaceNames". -clickableRenamedPP :: (WorkspaceId -> String) -> PP -> X PP -clickableRenamedPP ren pp = do - clickable <- getClickable ren - return $ - pp { ppCurrent = ppCurrent pp . clickable - , ppVisible = ppVisible pp . clickable - , ppHidden = ppHidden pp . clickable - , ppHiddenNoWindows = ppHiddenNoWindows pp . clickable - , ppVisibleNoWindows= ppVisibleNoWindows pp <&> (. clickable) - , ppUrgent = ppUrgent pp . clickable - } - --- | Integration with "XMonad.Actions.WorkspaceNames". -clickableWorkspaceNamesPP :: PP -> X PP -clickableWorkspaceNamesPP pp = do - rename <- getWorkspaceNames - clickableRenamedPP rename pp - --- | Integration with "XMonad.Layout.IndependentScreens". -clickableMarshallPP :: ScreenId -> PP -> X PP -clickableMarshallPP s pp = - clickableRenamedPP unmarshallW pp{ ppSort = marshallSort s <$> ppSort pp } - --- | Integration with both "XMonad.Actions.WorkspaceNames" and --- "XMonad.Layout.IndependentScreens". -clickableMarshallWorkspaceNamesPP :: ScreenId -> PP -> X PP -clickableMarshallWorkspaceNamesPP s pp = do - rename <- getWorkspaceNames - clickableRenamedPP (unmarshallW . rename) pp{ ppSort = marshallSort s <$> ppSort pp } +clickablePP pp = getClickable <&> \ren -> pp{ ppRename = ppRename pp >=> ren }