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 |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
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.
Synopsis
- data PP = PP {
- ppCurrent :: WorkspaceId -> String
- ppVisible :: WorkspaceId -> String
- ppHidden :: WorkspaceId -> String
- ppHiddenNoWindows :: WorkspaceId -> String
- ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
- ppUrgent :: WorkspaceId -> String
- ppRename :: String -> WindowSpace -> String
- ppSep :: String
- ppWsSep :: String
- ppTitle :: String -> String
- ppTitleSanitize :: String -> String
- ppLayout :: String -> String
- ppOrder :: [String] -> [String]
- ppSort :: X ([WindowSpace] -> [WindowSpace])
- ppExtras :: [X (Maybe String)]
- ppOutput :: String -> IO ()
- ppPrinters :: WSPP
- def :: Default a => a
- dynamicLogString :: PP -> X String
- dynamicLogString' :: PP -> X String
- dynamicLogWithPP :: PP -> X ()
- data WS = WS {
- wsUrgents :: [Window]
- wsWindowSet :: WindowSet
- wsWS :: WindowSpace
- wsPP :: PP
- type WSPP = WSPP' (WorkspaceId -> String)
- type WSPP' = ReaderT WS Maybe
- fallbackPrinters :: WSPP
- isUrgent :: WS -> Bool
- isCurrent :: WS -> Bool
- isVisible :: WS -> Bool
- isVisibleNoWindows :: WS -> Bool
- isHidden :: WS -> Bool
- dzenPP :: PP
- xmobarPP :: PP
- sjanssenPP :: PP
- byorgeyPP :: PP
- wrap :: String -> String -> String -> String
- pad :: String -> String
- trim :: String -> String
- shorten :: Int -> String -> String
- shorten' :: String -> Int -> String -> String
- shortenLeft :: Int -> String -> String
- shortenLeft' :: String -> Int -> String -> String
- xmobarColor :: String -> String -> String -> String
- xmobarFont :: Int -> String -> String
- xmobarAction :: String -> String -> String -> String
- xmobarBorder :: String -> String -> Int -> String -> String
- xmobarRaw :: String -> String
- xmobarStrip :: String -> String
- xmobarStripTags :: [String] -> String -> String
- dzenColor :: String -> String -> String -> String
- dzenEscape :: String -> String
- dzenStrip :: String -> String
- filterOutWsPP :: [WorkspaceId] -> PP -> PP
- pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String
- pprWindowSetXinerama :: WindowSet -> String
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" } mySB = statusBarProp "xmobar" (pure myPP) main = xmonad . withEasySB mySB defToggleStrutsKey $ myConfig
Check XMonad.Hooks.StatusBar for more examples and an in depth explanation.
Build your own formatter
The PP
type allows the user to customize the formatting of
status information.
PP | |
|
dynamicLogString :: PP -> X String Source #
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 Source #
The guts of dynamicLogString
. Forces the result, so it may throw
an exception (most commonly because ppOrder
is non-total). Use
dynamicLogString
for a version that catches the exception and
produces an error string.
dynamicLogWithPP :: PP -> X () Source #
Format the current status using the supplied pretty-printing format, and write it to stdout.
Predicates and formatters
Using WSPP
with ppPrinters
allows extension modules (and users) to
extend PP
with new workspace types beyond ppCurrent
, ppUrgent
, and
the rest.
The data available to WSPP'
.
WS | |
|
type WSPP = WSPP' (WorkspaceId -> String) Source #
The type allowing to build formatters (and predicates). See
the source fallbackPrinters
for an example.
fallbackPrinters :: WSPP Source #
For a PP
pp
, fallbackPrinters pp
returns the default WSPP
used to format workspaces: the formatter chosen corresponds to the
first matching workspace type, respecting the following precedence:
ppUrgent
, ppCurrent
, ppVisible
, ppVisibleNoWindows
, ppHidden
,
ppHiddenNoWindows
.
This can be useful if one needs to use the default set of formatters and
post-process their output. (For pre-processing their input, there's
ppRename
.)
isVisibleNoWindows :: WS -> Bool Source #
Predicate for visible workspaces that have no windows.
Example formatters
sjanssenPP :: PP Source #
The options that sjanssen likes to use with xmobar, as an
example. Note the use of xmobarColor
and the record update on
def
.
Formatting utilities
Wrap a string in delimiters, unless it is empty.
shorten :: Int -> String -> String Source #
Limit a string to a certain length, adding "..." if truncated.
shorten' :: String -> Int -> String -> String Source #
Limit a string to a certain length, adding end
if truncated.
shortenLeft :: Int -> String -> String Source #
Like shorten
, but truncate from the left instead of right.
shortenLeft' :: String -> Int -> String -> String Source #
Like shorten'
, but truncate from the left instead of right.
:: String | foreground color: a color name, or #rrggbb format |
-> String | background color |
-> String | output string |
-> String |
Use xmobar escape codes to output a string with given foreground and background colors.
Use xmobar escape codes to output a string with the font at the given index
:: 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 |
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.
:: 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 |
Use xmobar box to add a border to an arbitrary string.
xmobarRaw :: String -> String Source #
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.
xmobarStrip :: String -> String Source #
Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and the matching tags like </fc>.
:: String | foreground color: a color name, or #rrggbb format |
-> String | background color |
-> String | output string |
-> String |
Use dzen escape codes to output a string with given foreground and background colors.
dzenEscape :: String -> String Source #
Escape any dzen metacharacters.
filterOutWsPP :: [WorkspaceId] -> PP -> PP Source #
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
Internal formatting functions
pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String Source #
Format the workspace information, given a workspace sorting function, a list of urgent windows, a pretty-printer format, and the current WindowSet.