Merge branch 'TheMC47/split-dynamic-log'

This commit is contained in:
Tomas Janousek 2021-04-02 21:36:38 +01:00
commit 654fa5045c
7 changed files with 1002 additions and 922 deletions

View File

@ -60,7 +60,8 @@
- The type of `getWorkspaceNames` was changed to fit into the new `ppRename` - The type of `getWorkspaceNames` was changed to fit into the new `ppRename`
field of `PP`. field of `PP`.
* `XMonad.Hooks.DynamicLog` and `XMonad.Util.Run` * `XMonad.Hooks.StatusBar`, `XMonad.Hooks.StatusBar.PP` (previously
`XMonad.Hooks.DynamicLog`) and `XMonad.Util.Run`
- `spawnPipe` no longer uses binary mode handles but defaults to the - `spawnPipe` no longer uses binary mode handles but defaults to the
current locale encoding instead. current locale encoding instead.
@ -89,6 +90,39 @@
### New Modules ### New Modules
* `XMonad.Hooks.StatusBar.PP`
Originally contained inside `XMonad.Hooks.DynamicLog`, this module provides the
pretty-printing abstraction and utilities, used primarly with `logHook`.
Below are changes from `XMonad.Hooks.DynamicLog`, that now are included in
this module:
- Added `shortenLeft` function, like existing `shorten` but shortens by
truncating from left instead of right. Useful for showing directories.
- Added `shorten'` and `shortenLeft'` functions with customizable overflow
markers.
- Added `filterOutWsPP` for filtering out certain workspaces from being
displayed.
- Added `ppTitleUnfocused` to `PP` for showing unfocused windows on
the current workspace in the status bar.
- Added `xmobarBorder` function to create borders around strings.
- Added `ppRename` to `PP`, which makes it possible for extensions like
`workspaceNamesPP`, `marshallPP` and/or `clickablePP` to compose
intuitively.
* `XMonad.Hooks.StatusBar`
This module provides a new interface that replaces `XMonad.Hooks.DynamicLog`,
by providing composoble status bars. Supports property-based as well
as pipe-based status bars.
* `XMonad.Util.Hacks` * `XMonad.Util.Hacks`
A collection of hacks and fixes that should be easily acessible to users: A collection of hacks and fixes that should be easily acessible to users:
@ -172,8 +206,8 @@
* `XMonad.Util.ClickableWorkspaces` * `XMonad.Util.ClickableWorkspaces`
Provides `clickablePP`, which when applied to the `PP` pretty-printer used by Provides `clickablePP`, which when applied to the `PP` pretty-printer used by
`XMonad.Hooks.DynamicLog.dynamicLogWithPP`, will make the workspace tags `XMonad.Hooks.StatusBar.PP`, will make the workspace tags clickable in XMobar
clickable in XMobar (for switching focus). (for switching focus).
* `XMonad.Layout.VoidBorders` * `XMonad.Layout.VoidBorders`
@ -264,45 +298,11 @@
* `XMonad.Hooks.DynamicLog` * `XMonad.Hooks.DynamicLog`
- Added `statusBar'` function, like existing `statusBar` but accepts a pretty - Added `xmobarProp`, for property-based alternative to `xmobar`.
printing options argument embedded in the X monad, to allow for dynamically
modified options such as `workspaceNamesPP`.
- Added `shortenLeft` function, like existing `shorten` but shortens by
truncating from left instead of right. Useful for showing directories.
- Added `shorten'` and `shortenLeft'` functions with customizable overflow
markers.
- Added `filterOutWsPP` for filtering out certain workspaces from being
displayed.
- Added `xmobarProp`, `statusBarProp`, and `statusBarPropTo` for
property-based alternatives to `xmobar` and `statusBar` respectively.
- Reworked the module documentation to suggest property-based logging
instead of pipe-based logging, due to the various issues associated with
the latter.
- Added `spawnStatusBarAndRemember` and `cleanupStatusBars` to provide
a way to safely restart status bars without relying on pipes.
- Added `ppTitleUnfocused` to `PP` for showing unfocused windows on
the current workspace in the status bar.
- Added `xmobarBorder` function to create borders around strings.
- Add the -dock argument to the dzen spawn arguments - Add the -dock argument to the dzen spawn arguments
- Added `StatusBarConfig` and `makeStatusBar` and `makeStatusBar'` as - The API for this module is frozen: this is now a compatibility wrapper.
an abstraction for status bars; together with `statusBarPropConfig`,
`statusBarPropToConfig`, `statusBarHandleConfig` and `statusBarHandleConfig'`
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` * `XMonad.Layout.BoringWindows`

View File

@ -484,6 +484,10 @@ Here is a list of the modules found in @XMonad.Hooks@:
putting in a status bar of some sort. See putting in a status bar of some sort. See
"XMonad.Doc.Extending#The_log_hook_and_external_status_bars". "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".
* "XMonad.Hooks.StatusBar.PP": originally in "XMonad.Hooks.DynamicLog",
this module provides the pretty-printing abstraction 'PP' and a set of
functions to interact with it.
* "XMonad.Hooks.EwmhDesktops": * "XMonad.Hooks.EwmhDesktops":
Makes xmonad use the EWMH hints to tell panel applications about its Makes xmonad use the EWMH hints to tell panel applications about its
workspaces and the windows therein. It also allows the user to interact workspaces and the windows therein. It also allows the user to interact
@ -559,6 +563,10 @@ Here is a list of the modules found in @XMonad.Hooks@:
_NET_SUPPORTING_WM_CHECK protocol. May be useful for making Java GUI _NET_SUPPORTING_WM_CHECK protocol. May be useful for making Java GUI
programs work. programs work.
* "XMonad.Hooks.StatusBar":
This module provides a new interface that replaces "XMonad.Hooks.DynamicLog",
by providing composoble and dynamic status bars.
* "XMonad.Hooks.ToggleHook": * "XMonad.Hooks.ToggleHook":
Hook and keybindings for toggling hook behavior. Hook and keybindings for toggling hook behavior.
@ -1742,7 +1750,8 @@ specifically for logging some of the most interesting information
about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This
module can be used with an external status bar to print the produced module can be used with an external status bar to print the produced
logs in a convenient way; the most commonly used status bars are dzen logs in a convenient way; the most commonly used status bars are dzen
and xmobar. and xmobar. The module "XMonad.Hooks.StatusBar" offers another interface
to interact with status bars, that might be more convenient to use.
By default the 'XMonad.Core.logHook' doesn't produce anything. To By default the 'XMonad.Core.logHook' doesn't produce anything. To
enable it you need first to import "XMonad.Hooks.DynamicLog": enable it you need first to import "XMonad.Hooks.DynamicLog":

File diff suppressed because it is too large Load Diff

414
XMonad/Hooks/StatusBar.hs Normal file
View File

@ -0,0 +1,414 @@
{-# LANGUAGE FlexibleContexts, TypeApplications #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.StatusBar
-- Copyright : (c) Yecine Megdiche <yecine.megdiche@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Yecine Megdiche <yecine.megdiche@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- xmonad calls the logHook with every internal state update, which is
-- useful for (among other things) outputting status information to an
-- external status bar program such as xmobar or dzen.
--
-- This module provides a composable interface for (re)starting these status
-- bars and logging to them, either using pipes or X properties. There's also
-- "XMonad.Hooks.StatusBar.PP" which provides an abstraction and some
-- utilities for customization what is logged to a status bar. Together, these
-- are a modern replacement for "XMonad.Hooks.DynamicLog", which is now just a
-- compatibility wrapper.
--
-----------------------------------------------------------------------------
module XMonad.Hooks.StatusBar (
-- * Usage
-- $usage
StatusBarConfig(..),
withSB,
withEasySB,
defToggleStrutsKey,
-- * Available Configs
-- $availableconfigs
statusBarProp,
statusBarPropTo,
statusBarPipe,
-- * Multiple Status Bars
-- $multiple
-- * Property Logging utilities
xmonadPropLog,
xmonadPropLog',
xmonadDefProp,
-- * Managing Status Bar Processes
spawnStatusBarAndRemember,
cleanupStatusBars,
-- * Manual Plumbing
-- $plumbing
) where
import Control.Exception (SomeException, try)
import Control.Monad (void)
import qualified Codec.Binary.UTF8.String as UTF8 (encode)
import System.Posix.Signals (sigTERM, signalProcessGroup)
import System.Posix.Types (ProcessID)
import qualified Data.Map as M
import Foreign.C (CChar)
import XMonad
import XMonad.Util.Run
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Layout.LayoutModifier
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.StatusBar.PP
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Hooks.StatusBar
-- > import XMonad.Hooks.StatusBar.PP
--
-- The easiest way to use this module with xmobar, as well as any other
-- status bar that supports property logging, is to use 'statusBarProp'
-- with 'withEasySB'; these take care of the necessary plumbing:
--
-- > main = do
-- > mySB <- statusBarProp "xmobar" (pure xmobarPP)
-- > xmonad =<< withEasySB mySB defToggleStrutsKey def
--
-- You can read more about X11 properties
-- [here](https://en.wikipedia.org/wiki/X_Window_System_core_protocol#Properties)
-- or
-- [here](https://tronche.com/gui/x/xlib/window-information/properties-and-atoms.html),
-- although you don't have to understand them in order to use the functions
-- mentioned above.
--
-- Most users will, however, want to customize the logging and integrate it
-- into their existing custom xmonad configuration. The 'withSB'
-- function is more appropriate in this case: it doesn't touch your
-- keybindings, layout modifiers, or event hooks; instead, you're expected
-- to configure "XMonad.Hooks.ManageDocks" yourself. Here's what that might
-- look like:
--
-- > main = do
-- > mySB <- statusBarProp "xmobar" (pure myPP)
-- > xmonad =<< (withSB mySB . ewmh . docks $ def {...})
--
-- You then have to tell your status bar to read from the @_XMONAD_LOG@ property
-- of the root window. In the case of xmobar, this is achieved by simply using
-- the @XMonadLog@ plugin instead of @StdinReader@ in your @.xmobarrc@:
--
-- > Config { ...
-- > , commands = [ Run XMonadLog, ... ]
-- > , template = "%XMonadLog% }{ ..."
-- > }
--
-- If you don't have an @.xmobarrc@, create it; the @XMonadLog@ plugin is not
-- part of the default xmobar configuration and your status bar will not show
-- workspace information otherwise!
--
-- With 'statusBarProp', you need to use property logging. Make sure the
-- status bar you use supports reading a property string from the root window,
-- or use some kind of wrapper that reads the property and pipes it into the
-- bar (e.g. @xmonadpropread | dzen2@, see @scripts/xmonadpropread.hs@). The
-- default property is @_XMONAD_LOG@, which is conveniently saved in 'xmonadDefProp'.
-- You can use another property by using the function 'statusBarPropTo'.
--
-- If your status bar does not support property-based logging, you may also try
-- 'statusBarPipe'.
-- It can be used in the same way as 'statusBarProp' above (for xmobar, you now
-- have to use the @StdinReader@ plugin in your @.xmobarrc@). Instead of
-- writing to a property, this function opens a pipe and makes the given status
-- bar read from that pipe.
-- Please be aware that this kind of setup is very bug-prone and hence is
-- discouraged: if anything goes wrong with the bar, xmonad will freeze!
-- $plumbing
-- If you do not want to use any of the "batteries included" functions above,
-- you can also add all of the necessary plumbing yourself (the source of
-- 'withSB' might come in handy here).
--
-- 'xmonadPropLog' allows you to write a string to the @_XMONAD_LOG@ property of
-- the root window. Together with 'dynamicLogString', you can now simply set
-- your 'logHook' to the appropriate function; for instance:
--
-- > main = xmonad $ def {
-- > ...
-- > , logHook = xmonadPropLog =<< dynamicLogString myPP
-- > ...
-- > }
--
-- If you want to define your own property name, use 'xmonadPropLog'' instead of
-- 'xmonadPropLog'.
--
-- If you just want to use the default pretty-printing format, you can replace
-- @myPP@ with 'def' in the above 'logHook'.
--
-- Note that setting 'logHook' only sets up xmonad's output; you are
-- responsible for starting your own status bar program and making sure it reads
-- from the property that xmonad writes to. To start your bar, simply put it
-- into your 'startupHook'. You will also have also have to add 'docks' and
-- 'avoidStruts' to your config. Putting all of this together would look
-- something like
--
-- > import XMonad.Util.SpawnOnce (spawnOnce)
-- > import XMonad.Hooks.ManageDocks (avoidStruts, docks)
-- >
-- > main = do
-- > xmonad $ docks $ def {
-- > ...
-- > , logHook = xmonadPropLog =<< dynamicLogString myPP
-- > , startupHook = spawnOnce "xmobar"
-- > , layoutHook = avoidStruts myLayout
-- > ...
-- > }
-- > myPP = def { ... }
-- > myLayout = ...
--
-- If you want a keybinding to toggle your bar, you will also need to add this
-- to the rest of your keybindings.
--
-- The above has the problem that xmobar will not get restarted whenever you
-- restart xmonad ('XMonad.Util.SpawnOnce.spawnOnce' will simply prevent your
-- chosen status bar from spawning again). Using 'statusBarProp', however, takes
-- care of the necessary plumbing /and/ keeps track of the started status bars, so
-- they can be correctly restarted with xmonad. This is achieved using
-- 'spawnStatusBarAndRemember' to start them and 'cleanupStatusBars' to kill
-- previously started bars.
--
-- Even if you don't use a status bar, you can still use 'dynamicLogString' to
-- show on-screen notifications in response to some events. For example, to show
-- the current layout when it changes, you could make a keybinding to cycle the
-- layout and display the current status:
--
-- > ((mod1Mask, xK_a), sendMessage NextLayout >> (dynamicLogString myPP >>= \d -> spawn $ "xmessage " ++ d))
--
-- If you use a status bar that does not support reading from a property
-- (like dzen), and you don't want to use the 'statusBar' function, you can,
-- again, also manually add all of the required components, like this:
--
-- > import XMonad.Util.Run (hPutStrLn, spawnPipe)
-- >
-- > main = do
-- > h <- spawnPipe "dzen2 -options -foo -bar"
-- > xmonad $ def {
-- > ...
-- > , logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }
-- > ...
-- > }
--
-- In the above, note that if you use @spawnPipe@ you need to redefine the
-- 'ppOutput' field of your pretty-printer; by default the status will be
-- printed to stdout rather than the pipe you create. This was meant to be
-- used together with running xmonad piped to a status bar like so: @xmonad |
-- dzen2@, and is what the old 'XMonad.Hooks.DynamicLog.dynamicLog' assumes,
-- but it isn't recommended in modern setups. Applications launched from
-- xmonad inherit its stdout and stderr, and will print their own garbage to
-- the status bar.
-- | This datataype abstracts a status bar to provide a common interface
-- functions like 'statusBarPipe' or 'statusBarProp'. Once defined, a status
-- bar can be incorporated in 'XConfig' by using 'withSB' or
-- 'withEasySB', which take care of the necessary plumbing.
data StatusBarConfig = StatusBarConfig { sbLogHook :: X ()
-- ^ What and how to log to the status bar.
, sbStartupHook :: X ()
-- ^ How to start the status bar.
, sbCleanupHook :: X ()
-- ^ How to kill the status bar.
}
instance Semigroup StatusBarConfig where
StatusBarConfig l s c <> StatusBarConfig l' s' c' =
StatusBarConfig (l <> l') (s <> s') (c <> c')
instance Monoid StatusBarConfig where
mempty = StatusBarConfig mempty mempty mempty
-- | Per default, all the hooks do nothing.
instance Default StatusBarConfig where
def = mempty
-- | Incorporates a 'StatusBarConfig' into an 'XConfig' by taking care of the
-- necessary plumbing (starting, restarting and logging to it).
--
-- Using this function multiple times to combine status bars may result in
-- only one status bar working properly. See the section on using multiple
-- status bars for more details.
withSB :: LayoutClass l Window
=> StatusBarConfig -- ^ The status bar config
-> XConfig l -- ^ The base config
-> IO (XConfig l)
withSB (StatusBarConfig lh sh ch) conf =
return $ conf
{ logHook = logHook conf *> lh
, startupHook = startupHook conf *> ch *> sh
}
-- | Like 'withSB', but takes an extra key to toggle struts. It also
-- applies the 'avoidStruts' layout modifier and the 'docks' combinator.
--
-- Using this function multiple times to combine status bars may result in
-- only one status bar working properly. See the section on using multiple
-- status bars for more details.
withEasySB :: LayoutClass l Window
=> StatusBarConfig -- ^ The status bar config
-> (XConfig Layout -> (KeyMask, KeySym))
-- ^ The key binding
-> XConfig l -- ^ The base config
-> IO (XConfig (ModifiedLayout AvoidStruts l))
withEasySB sb k conf = do
conf' <- withSB sb conf
return $ docks $ conf' { layoutHook = avoidStruts (layoutHook conf')
, keys = (<>) <$> keys' <*> keys conf'
}
where keys' = (`M.singleton` sendMessage ToggleStruts) . k
-- | Default @mod-b@ key binding for 'withEasySB'
defToggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
defToggleStrutsKey XConfig{modMask = modm} = (modm, xK_b)
-- | Creates a 'StatusBarConfig' that uses property logging to @_XMONAD_LOG@, which
-- is set in 'xmonadDefProp'
statusBarProp :: String -- ^ The command line to launch the status bar
-> X PP -- ^ The pretty printing options
-> IO StatusBarConfig
statusBarProp = statusBarPropTo xmonadDefProp
-- | Like 'statusBarProp', but lets you define the property
statusBarPropTo :: String -- ^ Property to write the string to
-> String -- ^ The command line to launch the status bar
-> X PP -- ^ The pretty printing options
-> IO StatusBarConfig
statusBarPropTo prop cmd pp = pure def
{ sbLogHook = xmonadPropLog' prop =<< dynamicLogString =<< pp
, sbStartupHook = spawnStatusBarAndRemember cmd
, sbCleanupHook = cleanupStatusBars
}
-- | Like 'statusBarProp', but uses pipe-based logging instead.
statusBarPipe :: String -- ^ The command line to launch the status bar
-> X PP -- ^ The pretty printing options
-> IO StatusBarConfig
statusBarPipe cmd xpp = do
h <- spawnPipe cmd
return $ def { sbLogHook = xpp >>= \pp -> dynamicLogWithPP pp { ppOutput = hPutStrLn h } }
-- $multiple
-- 'StatusBarConfig' is a 'Monoid', which means that multiple status bars can
-- be combined together using '<>' or 'mconcat' and passed to 'withSB'.
--
-- Here's an example of what such declarative configuration of multiple status
-- bars may look like:
--
-- > main = do
-- > xmobarTop <- statusBarPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" (pure ppTop)
-- > xmobarBottom <- statusBarPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
-- > xmobar1 <- statusBarPipe "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1)
-- > xmonad =<< withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig
--
-- The above example also works if the different status bars support different
-- logging methods: you could mix property logging and logging via pipes.
-- One thing to keep in mind is that if multiple bars read from the same
-- property, their content will be the same. If you want to use property-based
-- logging with multiple bars, they should read from different properties.
--
-- Long-time xmonad users will note that the above config is equivalent to
-- the following less robust and more verbose configuration that they might
-- find in their old configs:
--
-- > main = do
-- > -- do not use this, this is an example of a deprecated config
-- > xmproc0 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"
-- > xmproc1 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom"
-- > xmproc2 <- spawnPipe "xmobar -x 1 ~/.config/xmobar/xmobarrc1"
-- > xmonad $ def {
-- > ...
-- > , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 }
-- > >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 }
-- > >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 }
-- > ...
-- > }
--
-- By using the new interface, the config becomes more declarative and there's
-- less room for errors.
-- | The default property xmonad writes to. (@_XMONAD_LOG@).
xmonadDefProp :: String
xmonadDefProp = "_XMONAD_LOG"
-- | Write a string to the @_XMONAD_LOG@ property on the root window.
xmonadPropLog :: String -> X ()
xmonadPropLog = xmonadPropLog' xmonadDefProp
-- | Write a string to a property on the root window. This property is of type
-- @UTF8_STRING@. The string must have been processed by 'encodeString'
-- ('dynamicLogString' does this).
xmonadPropLog' :: String -- ^ Property name
-> String -- ^ Message to be written to the property
-> X ()
xmonadPropLog' prop msg = do
d <- asks display
r <- asks theRoot
xlog <- getAtom prop
ustring <- getAtom "UTF8_STRING"
io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)
where
encodeCChar :: String -> [CChar]
encodeCChar = map fromIntegral . UTF8.encode
-- This newtype wrapper, together with the ExtensionClass instance make use of
-- the extensible state to save the PIDs bewteen xmonad restarts.
newtype StatusBarPIDs = StatusBarPIDs { getPIDs :: [ProcessID] }
deriving (Show, Read)
instance ExtensionClass StatusBarPIDs where
initialValue = StatusBarPIDs []
extensionType = PersistentExtension
-- | Kills the status bars started with 'spawnStatusBarAndRemember', and resets
-- the state. This could go for example at the beginning of the startupHook.
--
-- Concretely, this function sends a 'sigTERM' to the saved PIDs using
-- 'signalProcessGroup' to effectively terminate all processes, regardless
-- of how many were started by using 'spawnStatusBarAndRemember'.
--
-- There is one caveat to keep in mind: to keep the implementation simple;
-- no checks are executed before terminating the processes. This means: if the
-- started process dies for some reason, and enough time passes for the PIDs
-- to wrap around, this function might terminate another process that happens
-- to have the same PID. However, this isn't a typical usage scenario.
cleanupStatusBars :: X ()
cleanupStatusBars =
getPIDs <$> XS.get
>>= (io . mapM_ killPid)
>> XS.put (StatusBarPIDs [])
where
killPid :: ProcessID -> IO ()
killPid pidToKill = void $ try @SomeException (signalProcessGroup sigTERM pidToKill)
-- | Spawns a status bar and saves its PID. This is useful when the status bars
-- should be restarted with xmonad. Use this in combination with 'cleanupStatusBars'.
--
-- Note: in some systems, multiple processes might start, even though one command is
-- provided. This means the first PID, of the group leader, is saved.
spawnStatusBarAndRemember :: String -- ^ The command used to spawn the status bar
-> X ()
spawnStatusBarAndRemember cmd = do
newPid <- spawnPID cmd
XS.modify (StatusBarPIDs . (newPid :) . getPIDs)

View File

@ -0,0 +1,443 @@
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.StatusBar.PP
-- Copyright : (c) Don Stewart <dons@cse.unsw.edu.au>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Don Stewart <dons@cse.unsw.edu.au>
-- Stability : unstable
-- Portability : unportable
--
-- xmonad calls the logHook with every internal state update, which is
-- useful for (among other things) outputting status information to an
-- external status bar program such as xmobar or dzen.
--
-- This module provides a pretty-printing abstraction and utilities that can
-- be used to customize what is logged to a status bar. See
-- "XMonad.Hooks.StatusBar" for an abstraction over starting these status
-- bars. Together these are a modern replacement for
-- "XMonad.Hooks.DynamicLog", which is now just a compatibility wrapper.
--
-----------------------------------------------------------------------------
module XMonad.Hooks.StatusBar.PP (
-- * Usage
-- $usage
-- * Build your own formatter
PP(..), def,
dynamicLogString,
dynamicLogWithPP,
-- * Example formatters
dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
-- * Formatting utilities
wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft',
xmobarColor, xmobarAction, xmobarBorder,
xmobarRaw, xmobarStrip, xmobarStripTags,
dzenColor, dzenEscape, dzenStrip, filterOutWsPP,
-- * Internal formatting functions
pprWindowSet,
pprWindowSetXinerama
) where
import Control.Applicative (liftA2)
import Control.Monad (msum)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (intercalate, isPrefixOf, sortOn, stripPrefix)
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
import qualified XMonad.StackSet as S
import XMonad
import XMonad.Util.NamedWindows
import XMonad.Util.WorkspaceCompare
import XMonad.Hooks.UrgencyHook
-- $usage
-- An example usage for this module would be:
--
-- > import XMonad
-- > import XMonad.Hooks.StatusBar
-- > import XMonad.Hooks.StatusBar.PP
-- >
-- > myPP = def { ppCurrent = xmobarColor "black" "white" }
-- > main = do
-- > mySB <- statusBarProp "xmobar" (pure myPP)
-- > xmonad =<< withEasySB mySB defToggleStrutsKey myConfig
--
-- Check "XMonad.Hooks.StatusBar" for more examples and an in depth
-- explanation.
-- | The 'PP' type allows the user to customize the formatting of
-- status information.
data PP = PP { ppCurrent :: WorkspaceId -> String
-- ^ how to print the tag of the currently focused
-- workspace
, ppVisible :: WorkspaceId -> String
-- ^ how to print tags of visible but not focused
-- workspaces (xinerama only)
, ppHidden :: WorkspaceId -> String
-- ^ how to print tags of hidden workspaces which
-- contain windows
, ppHiddenNoWindows :: WorkspaceId -> String
-- ^ how to print tags of empty hidden workspaces
, ppVisibleNoWindows :: Maybe (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)
, ppWsSep :: String
-- ^ separator to use between workspace tags
, ppTitle :: String -> String
-- ^ window title format for the focused window
, ppTitleUnfocused :: String -> String
-- ^ window title format for unfocused windows
, ppTitleSanitize :: String -> String
-- ^ escape / sanitizes input to 'ppTitle' and
-- 'ppTitleUnfocused'
, ppLayout :: String -> String
-- ^ layout name format
, ppOrder :: [String] -> [String]
-- ^ how to order the different log sections. By
-- default, this function receives a list with three
-- formatted strings, representing the workspaces,
-- the layout, and the current window titles,
-- respectively. If you have specified any extra
-- loggers in 'ppExtras', their output will also be
-- appended to the list. To get them in the reverse
-- order, you can just use @ppOrder = reverse@. If
-- you don't want to display the current layout, you
-- could use something like @ppOrder = \\(ws:_:t:_) ->
-- [ws,t]@, and so on.
, ppSort :: X ([WindowSpace] -> [WindowSpace])
-- ^ how to sort the workspaces. See
-- "XMonad.Util.WorkspaceCompare" for some useful
-- sorts.
, ppExtras :: [X (Maybe String)]
-- ^ loggers for generating extra information such as
-- time and date, system load, battery status, and so
-- on. See "XMonad.Util.Loggers" for examples, or create
-- your own!
, ppOutput :: String -> IO ()
-- ^ applied to the entire formatted string in order to
-- output it. Can be used to specify an alternative
-- output method (e.g. write to a pipe instead of
-- stdout), and\/or to perform some last-minute
-- formatting.
}
-- | The default pretty printing options:
--
-- > 1 2 [3] 4 7 : full : title
--
-- That is, the currently populated workspaces, the current
-- workspace layout, and the title of the focused window.
instance Default PP where
def = PP { ppCurrent = wrap "[" "]"
, ppVisible = wrap "<" ">"
, ppHidden = id
, ppHiddenNoWindows = const ""
, ppVisibleNoWindows = Nothing
, ppUrgent = id
, ppRename = pure
, ppSep = " : "
, ppWsSep = " "
, ppTitle = shorten 80
, ppTitleUnfocused = const ""
, ppTitleSanitize = xmobarStrip . dzenEscape
, ppLayout = id
, ppOrder = id
, ppOutput = putStrLn
, ppSort = getSortByIndex
, ppExtras = []
}
-- | Format the current status using the supplied pretty-printing format,
-- and write it to stdout.
dynamicLogWithPP :: PP -> X ()
dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp
-- | The same as 'dynamicLogWithPP', except it simply returns the status
-- as a formatted string without actually printing it to stdout, to
-- allow for further processing, or use in some application other than
-- a status bar.
dynamicLogString :: PP -> X String
dynamicLogString pp = do
winset <- gets windowset
urgents <- readUrgents
sort' <- ppSort pp
-- layout description
let ld = description . S.layout . S.workspace . S.current $ winset
-- workspace list
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.
extras <- mapM (`catchX` return Nothing) $ ppExtras pp
return $ sepBy (ppSep pp) . ppOrder pp $
[ ws
, ppLayout pp ld
, ppNames
]
++ catMaybes extras
-- | Format the workspace information, given a workspace sorting function,
-- a list of urgent windows, a pretty-printer format, and the current
-- WindowSet.
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)
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
pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
where onscreen = map (S.tag . S.workspace)
. sortOn S.screen $ S.current ws : S.visible ws
offscreen = map S.tag . filter (isJust . S.stack)
. sortOn S.tag $ S.hidden ws
-- | Wrap a string in delimiters, unless it is empty.
wrap :: String -- ^ left delimiter
-> String -- ^ right delimiter
-> String -- ^ output string
-> String
wrap _ _ "" = ""
wrap l r m = l ++ m ++ r
-- | Pad a string with a leading and trailing space.
pad :: String -> String
pad = wrap " " " "
-- | Trim leading and trailing whitespace from a string.
trim :: String -> String
trim = f . f
where f = reverse . dropWhile isSpace
-- | Limit a string to a certain length, adding "..." if truncated.
shorten :: Int -> String -> String
shorten = shorten' "..."
-- | Limit a string to a certain length, adding @end@ if truncated.
shorten' :: String -> Int -> String -> String
shorten' end n xs | length xs < n = xs
| otherwise = take (n - length end) xs ++ end
-- | Like 'shorten', but truncate from the left instead of right.
shortenLeft :: Int -> String -> String
shortenLeft = shortenLeft' "..."
-- | Like 'shorten'', but truncate from the left instead of right.
shortenLeft' :: String -> Int -> String -> String
shortenLeft' end n xs | l < n = xs
| otherwise = end ++ drop (l - n + length end) xs
where l = length xs
-- | Output a list of strings, ignoring empty ones and separating the
-- rest with the given separator.
sepBy :: String -- ^ separator
-> [String] -- ^ fields to output
-> String
sepBy sep = intercalate sep . filter (not . null)
-- | Use dzen escape codes to output a string with given foreground
-- and background colors.
dzenColor :: String -- ^ foreground color: a color name, or #rrggbb format
-> String -- ^ background color
-> String -- ^ output string
-> String
dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)
where (fg1,fg2) | null fg = ("","")
| otherwise = ("^fg(" ++ fg ++ ")","^fg()")
(bg1,bg2) | null bg = ("","")
| otherwise = ("^bg(" ++ bg ++ ")","^bg()")
-- | Escape any dzen metacharacters.
dzenEscape :: String -> String
dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
-- | Strip dzen formatting or commands.
dzenStrip :: String -> String
dzenStrip = strip [] where
strip keep x
| null x = keep
| "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)
| '^' == head x = strip keep (drop 1 . dropWhile (/= ')') $ x)
| otherwise = let (good,x') = span (/= '^') x
in strip (keep ++ good) x'
-- | Use xmobar escape codes to output a string with given foreground
-- and background colors.
xmobarColor :: String -- ^ foreground color: a color name, or #rrggbb format
-> String -- ^ background color
-> String -- ^ output string
-> String
xmobarColor fg bg = wrap t "</fc>"
where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
-- | Encapsulate text with an action. The text will be displayed, and the
-- action executed when the displayed text is clicked. Illegal input is not
-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
-- syntax wherein the command is surrounded by backticks.
xmobarAction :: String
-- ^ Command. Use of backticks (`) will cause a parse error.
-> String
-- ^ Buttons 1-5, such as "145". Other characters will cause a
-- parse error.
-> String
-- ^ Displayed/wrapped text.
-> String
xmobarAction command button = wrap l r
where
l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
r = "</action>"
-- | Use xmobar box to add a border to an arbitrary string.
xmobarBorder :: String -- ^ Border type. Possible values: VBoth, HBoth, Full,
-- Top, Bottom, Left or Right
-> String -- ^ color: a color name, or #rrggbb format
-> Int -- ^ width in pixels
-> String -- ^ output string
-> String
xmobarBorder border color width = wrap prefix "</box>"
where
prefix = "<box type=" ++ border ++ " width=" ++ show width ++ " color="
++ color ++ ">"
-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
-- wrapped (perhaps from window titles) will be displayed only, with all tags
-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
-- to shorten the result.
xmobarRaw :: String -> String
xmobarRaw "" = ""
xmobarRaw s = concat ["<raw=", show $ length s, ":", s, "/>"]
-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
-- the matching tags like </fc>.
xmobarStrip :: String -> String
xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])
converge :: (Eq a) => (a -> a) -> a -> a
converge f a = let xs = iterate f a
in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs
xmobarStripTags :: [String] -- ^ tags
-> String -> String -- ^ with all <tag>...</tag> removed
xmobarStripTags tags = strip [] where
strip keep [] = keep
strip keep x
| rest: _ <- mapMaybe dropTag tags = strip keep rest
| '<':xs <- x = strip (keep ++ "<") xs
| (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags
where dropTag :: String -> Maybe String
dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),
closeTag tag `stripPrefix` x]
dropTilClose, openTag, closeTag :: String -> String
dropTilClose = drop 1 . dropWhile (/= '>')
openTag str = "<" ++ str ++ "="
closeTag str = "</" ++ str ++ ">"
-- | Transforms a pretty-printer into one not displaying the given workspaces.
--
-- For example, filtering out the @NSP@ workspace before giving the 'PP' to
-- 'dynamicLogWithPP':
--
-- > logHook = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] $ def
--
-- Here is another example, when using "XMonad.Layout.IndependentScreens". If
-- you have handles @hLeft@ and @hRight@ for bars on the left and right screens,
-- respectively, and @pp@ is a pretty-printer function that takes a handle, you
-- could write
--
-- > logHook = let log screen handle = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] . marshallPP screen . pp $ handle
-- > in log 0 hLeft >> log 1 hRight
filterOutWsPP :: [WorkspaceId] -> PP -> PP
filterOutWsPP ws pp = pp { ppSort = (. filterOutWs ws) <$> ppSort pp }
-- | Settings to emulate dwm's statusbar, dzen only.
dzenPP :: PP
dzenPP = def
{ ppCurrent = dzenColor "white" "#2b4f98" . pad
, ppVisible = dzenColor "black" "#999999" . pad
, ppHidden = dzenColor "black" "#cccccc" . pad
, ppHiddenNoWindows = const ""
, ppUrgent = dzenColor "red" "yellow" . pad
, ppWsSep = ""
, ppSep = ""
, ppLayout = dzenColor "black" "#cccccc"
. (\x -> pad $ case x of
"TilePrime Horizontal" -> "TTT"
"TilePrime Vertical" -> "[]="
"Hinted Full" -> "[ ]"
_ -> x
)
, ppTitle = ("^bg(#324c80) " ++) . dzenEscape
}
-- | Some nice xmobar defaults.
xmobarPP :: PP
xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
, ppTitle = xmobarColor "green" "" . shorten 40
, ppVisible = wrap "(" ")"
, ppUrgent = xmobarColor "red" "yellow"
}
-- | The options that sjanssen likes to use with xmobar, as an
-- example. Note the use of 'xmobarColor' and the record update on
-- 'def'.
sjanssenPP :: PP
sjanssenPP = def { ppCurrent = xmobarColor "white" "black"
, ppTitle = xmobarColor "#00ee00" "" . shorten 120
}
-- | The options that byorgey likes to use with dzen, as another example.
byorgeyPP :: PP
byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces
, ppHidden = dzenColor "black" "#a8a3f7" . pad
, ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
, ppUrgent = dzenColor "red" "yellow" . pad
, ppSep = " | "
, ppWsSep = ""
, ppTitle = shorten 70
, ppOrder = reverse
}
where
showNamedWorkspaces wsId =
if any (`elem` wsId) ['a' .. 'z'] then pad wsId else ""

View File

@ -8,8 +8,8 @@
-- Stability : unstable -- Stability : unstable
-- Portability : unportable -- Portability : unportable
-- --
-- Provides @clickablePP@, which when applied to the PP pretty-printer used by -- Provides @clickablePP@, which when applied to the 'PP' pretty-printer used
-- the "XMonad.Hooks.DynamicLog" hook, will make the workspace tags clickable in -- by "XMonad.Hooks.StatusBar" will make the workspace tags clickable in
-- XMobar (for switching focus). -- XMobar (for switching focus).
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@ -25,17 +25,22 @@ import Control.Monad ((>=>))
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import XMonad import XMonad
import XMonad.Hooks.DynamicLog (xmobarAction, PP(..)) import XMonad.Hooks.StatusBar.PP (xmobarAction, PP(..))
import XMonad.Util.WorkspaceCompare (getWsIndex) import XMonad.Util.WorkspaceCompare (getWsIndex)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
-- $usage -- $usage
-- However you have set up your PP, apply @clickablePP@ to it, and bind the result -- If you're using the "XMonad.Hooks.StatusBar" interface, apply 'clickablePP'
-- to "XMonad.Hooks.DynamicLog"\'s dynamicLogWithPP like so: -- to the 'PP' passed to 'XMonad.Hooks.StatusBar.statusBarProp':
--
-- > mySB <- statusBarProp "xmobar" (clickablePP xmobarPP)
--
-- Or if you're using the old "XMonad.Hooks.DynamicLog" interface:
-- --
-- > logHook = clickablePP xmobarPP { ... } >>= dynamicLogWithPP -- > logHook = clickablePP xmobarPP { ... } >>= dynamicLogWithPP
-- --
-- * Requirements: -- Requirements:
--
-- * @xdotool@ on system (in path) -- * @xdotool@ on system (in path)
-- * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup) -- * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup)
-- * use of UnsafeStdinReader/UnsafeXMonadLog in xmobarrc (rather than StdinReader/XMonadLog) -- * use of UnsafeStdinReader/UnsafeXMonadLog in xmobarrc (rather than StdinReader/XMonadLog)

View File

@ -93,7 +93,6 @@ library
XMonad.Actions.FindEmptyWorkspace XMonad.Actions.FindEmptyWorkspace
XMonad.Actions.FlexibleManipulate XMonad.Actions.FlexibleManipulate
XMonad.Actions.FlexibleResize XMonad.Actions.FlexibleResize
XMonad.Actions.TiledWindowDragging
XMonad.Actions.FloatKeys XMonad.Actions.FloatKeys
XMonad.Actions.FloatSnap XMonad.Actions.FloatSnap
XMonad.Actions.FocusNth XMonad.Actions.FocusNth
@ -116,8 +115,8 @@ library
XMonad.Actions.Prefix XMonad.Actions.Prefix
XMonad.Actions.Promote XMonad.Actions.Promote
XMonad.Actions.RandomBackground XMonad.Actions.RandomBackground
XMonad.Actions.RotateSome
XMonad.Actions.RotSlaves XMonad.Actions.RotSlaves
XMonad.Actions.RotateSome
XMonad.Actions.Search XMonad.Actions.Search
XMonad.Actions.ShowText XMonad.Actions.ShowText
XMonad.Actions.Sift XMonad.Actions.Sift
@ -125,9 +124,10 @@ library
XMonad.Actions.SinkAll XMonad.Actions.SinkAll
XMonad.Actions.SpawnOn XMonad.Actions.SpawnOn
XMonad.Actions.Submap XMonad.Actions.Submap
XMonad.Actions.SwapWorkspaces
XMonad.Actions.SwapPromote XMonad.Actions.SwapPromote
XMonad.Actions.SwapWorkspaces
XMonad.Actions.TagWindows XMonad.Actions.TagWindows
XMonad.Actions.TiledWindowDragging
XMonad.Actions.TopicSpace XMonad.Actions.TopicSpace
XMonad.Actions.TreeSelect XMonad.Actions.TreeSelect
XMonad.Actions.UpdateFocus XMonad.Actions.UpdateFocus
@ -186,12 +186,14 @@ library
XMonad.Hooks.Script XMonad.Hooks.Script
XMonad.Hooks.ServerMode XMonad.Hooks.ServerMode
XMonad.Hooks.SetWMName XMonad.Hooks.SetWMName
XMonad.Hooks.StatusBar
XMonad.Hooks.StatusBar.PP
XMonad.Hooks.ToggleHook XMonad.Hooks.ToggleHook
XMonad.Hooks.UrgencyHook XMonad.Hooks.UrgencyHook
XMonad.Hooks.WallpaperSetter XMonad.Hooks.WallpaperSetter
XMonad.Hooks.WindowSwallowing
XMonad.Hooks.WorkspaceByPos XMonad.Hooks.WorkspaceByPos
XMonad.Hooks.WorkspaceHistory XMonad.Hooks.WorkspaceHistory
XMonad.Hooks.WindowSwallowing
XMonad.Hooks.XPropManage XMonad.Hooks.XPropManage
XMonad.Layout.Accordion XMonad.Layout.Accordion
XMonad.Layout.AutoMaster XMonad.Layout.AutoMaster
@ -211,7 +213,6 @@ library
XMonad.Layout.DecorationAddons XMonad.Layout.DecorationAddons
XMonad.Layout.DecorationMadness XMonad.Layout.DecorationMadness
XMonad.Layout.Dishes XMonad.Layout.Dishes
XMonad.Layout.MultiDishes
XMonad.Layout.DragPane XMonad.Layout.DragPane
XMonad.Layout.DraggingVisualizer XMonad.Layout.DraggingVisualizer
XMonad.Layout.Drawer XMonad.Layout.Drawer
@ -251,6 +252,7 @@ library
XMonad.Layout.MosaicAlt XMonad.Layout.MosaicAlt
XMonad.Layout.MouseResizableTile XMonad.Layout.MouseResizableTile
XMonad.Layout.MultiColumns XMonad.Layout.MultiColumns
XMonad.Layout.MultiDishes
XMonad.Layout.MultiToggle XMonad.Layout.MultiToggle
XMonad.Layout.MultiToggle.Instances XMonad.Layout.MultiToggle.Instances
XMonad.Layout.MultiToggle.TabBarDecoration XMonad.Layout.MultiToggle.TabBarDecoration
@ -264,8 +266,8 @@ library
XMonad.Layout.PositionStoreFloat XMonad.Layout.PositionStoreFloat
XMonad.Layout.Reflect XMonad.Layout.Reflect
XMonad.Layout.Renamed XMonad.Layout.Renamed
XMonad.Layout.ResizableTile
XMonad.Layout.ResizableThreeColumns XMonad.Layout.ResizableThreeColumns
XMonad.Layout.ResizableTile
XMonad.Layout.ResizeScreen XMonad.Layout.ResizeScreen
XMonad.Layout.Roledex XMonad.Layout.Roledex
XMonad.Layout.ShowWName XMonad.Layout.ShowWName
@ -347,8 +349,8 @@ library
XMonad.Util.Replace XMonad.Util.Replace
XMonad.Util.Run XMonad.Util.Run
XMonad.Util.Scratchpad XMonad.Util.Scratchpad
XMonad.Util.SpawnNamedPipe
XMonad.Util.SessionStart XMonad.Util.SessionStart
XMonad.Util.SpawnNamedPipe
XMonad.Util.SpawnOnce XMonad.Util.SpawnOnce
XMonad.Util.Stack XMonad.Util.Stack
XMonad.Util.StringProp XMonad.Util.StringProp