X.H.SB.PP: Move ppTitleUnfocused to X.U.Loggers

This way, people not using this functionality don't get the burden of a
bunch of `getName`s that they haven't asked about.
This commit is contained in:
slotThe
2021-05-04 10:39:58 +02:00
parent a99c76cce4
commit 322e06eed9
2 changed files with 37 additions and 18 deletions

View File

@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Hooks.StatusBar.PP -- Module : XMonad.Hooks.StatusBar.PP
@@ -47,7 +48,6 @@ module XMonad.Hooks.StatusBar.PP (
import Control.Applicative (liftA2) import Control.Applicative (liftA2)
import Control.Monad (msum) import Control.Monad (msum)
import Data.Bool (bool)
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List (intercalate, isPrefixOf, sortOn, stripPrefix) import Data.List (intercalate, isPrefixOf, sortOn, stripPrefix)
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
@@ -102,11 +102,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
-- ^ separator to use between workspace tags -- ^ separator to use between workspace tags
, ppTitle :: String -> String , ppTitle :: String -> String
-- ^ window title format for the focused window -- ^ window title format for the focused window
, ppTitleUnfocused :: String -> String
-- ^ window title format for unfocused windows
, ppTitleSanitize :: String -> String , ppTitleSanitize :: String -> String
-- ^ escape / sanitizes input to 'ppTitle' and -- ^ escape / sanitizes input to 'ppTitle'
-- 'ppTitleUnfocused'
, ppLayout :: String -> String , ppLayout :: String -> String
-- ^ layout name format -- ^ layout name format
, ppOrder :: [String] -> [String] , ppOrder :: [String] -> [String]
@@ -155,7 +152,6 @@ instance Default PP where
, ppSep = " : " , ppSep = " : "
, ppWsSep = " " , ppWsSep = " "
, ppTitle = shorten 80 , ppTitle = shorten 80
, ppTitleUnfocused = const ""
, ppTitleSanitize = xmobarStrip . dzenEscape , ppTitleSanitize = xmobarStrip . dzenEscape
, ppLayout = id , ppLayout = id
, ppOrder = id , ppOrder = id
@@ -186,22 +182,16 @@ dynamicLogString pp = do
-- workspace list -- workspace list
let ws = pprWindowSet sort' urgents pp winset let ws = pprWindowSet sort' urgents pp winset
-- window titles
let stack = S.index winset
focWin = S.peek winset
ppWin :: Window -> String -> String -- pretty print a window title
= bool (ppTitleUnfocused pp) (ppTitle pp) . (focWin ==) . Just
winNames <- traverse (fmap show . getName) stack
let ppNames = unwords . filter (not . null) $
zipWith (\w n -> ppWin w $ ppTitleSanitize pp n) stack winNames
-- run extra loggers, ignoring any that generate errors. -- run extra loggers, ignoring any that generate errors.
extras <- mapM (`catchX` return Nothing) $ ppExtras pp extras <- mapM (`catchX` return Nothing) $ ppExtras pp
-- window title
wt <- maybe (pure "") (fmap show . getName) . S.peek $ winset
return $ sepBy (ppSep pp) . ppOrder pp $ return $ sepBy (ppSep pp) . ppOrder pp $
[ ws [ ws
, ppLayout pp ld , ppLayout pp ld
, ppNames , ppTitle pp $ ppTitleSanitize pp wt
] ]
++ catMaybes extras ++ catMaybes extras

View File

@@ -31,7 +31,7 @@ module XMonad.Util.Loggers (
-- * XMonad Loggers -- * XMonad Loggers
-- $xmonad -- $xmonad
, logCurrent, logLayout, logTitle , logCurrent, logLayout, logTitle, logTitles
, logConst, logDefault, (.|) , logConst, logDefault, (.|)
-- * XMonad: Screen-specific Loggers -- * XMonad: Screen-specific Loggers
-- $xmonad-screen -- $xmonad-screen
@@ -47,7 +47,7 @@ module XMonad.Util.Loggers (
) where ) where
import XMonad (liftIO, Window) import XMonad (liftIO, Window, gets)
import XMonad.Core import XMonad.Core
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog import XMonad.Hooks.DynamicLog
@@ -175,6 +175,35 @@ maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".")
logTitle :: Logger logTitle :: Logger
logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek
-- | Get the titles of all windows on the current workspace and format
-- them according to the given functions.
--
-- ==== __Example__
--
-- > myXmobarPP :: X PP
-- > myXmobarPP = pure $ def
-- > { ppOrder = [ws, l, _, wins] -> [ws, l, wins]
-- > , ppExtras = [logTitles formatFocused formatUnfocused]
-- > }
-- > where
-- > formatFocused = wrap "[" "]" . xmobarColor "#ff79c6" "" . shorten 50 . xmobarStrip
-- > formatUnfocused = wrap "(" ")" . xmobarColor "#bd93f9" "" . shorten 30 . xmobarStrip
--
logTitles
:: (String -> String) -- ^ Formatting for the focused window
-> (String -> String) -- ^ Formatting for the unfocused window
-> Logger
logTitles formatFoc formatUnfoc = do
winset <- gets windowset
let focWin = W.peek winset
wins = W.index winset
winNames <- traverse (fmap show . getName) wins
pure . Just
. unwords
$ zipWith (\w n -> if Just w == focWin then formatFoc n else formatUnfoc n)
wins
winNames
-- | Get the name of the current layout. -- | Get the name of the current layout.
logLayout :: Logger logLayout :: Logger
logLayout = withWindowSet $ return . Just . ld logLayout = withWindowSet $ return . Just . ld