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

Merge pull request #481 from liskin/pr/pp-composable-rename

Browse Source 
Extend PP with ppRename: nicer compose of WorkspaceNames, ClickableWorkspaces, …
This commit is contained in:
slotThe
2021-03-20 16:32:57 +01:00
committed by GitHub
parent f1bd315448 b0f5c69baf
commit cf9388a918
5 changed files with 56 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
CHANGES.md
View File

@@ -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.

42
XMonad/Actions/WorkspaceNames.hs
View File

@@ -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 }

24
XMonad/Hooks/DynamicLog.hs
View File

@@ -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

12
XMonad/Layout/IndependentScreens.hs
View File

@@ -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

71
XMonad/Util/ClickableWorkspaces.hs
View File

@@ -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 }