diff --git a/CHANGES.md b/CHANGES.md index 3817e714..33d160b7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -60,7 +60,8 @@ - The type of `getWorkspaceNames` was changed to fit into the new `ppRename` 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 current locale encoding instead. @@ -89,6 +90,39 @@ ### 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` A collection of hacks and fixes that should be easily acessible to users: @@ -172,8 +206,8 @@ * `XMonad.Util.ClickableWorkspaces` Provides `clickablePP`, which when applied to the `PP` pretty-printer used by - `XMonad.Hooks.DynamicLog.dynamicLogWithPP`, will make the workspace tags - clickable in XMobar (for switching focus). + `XMonad.Hooks.StatusBar.PP`, will make the workspace tags clickable in XMobar + (for switching focus). * `XMonad.Layout.VoidBorders` @@ -264,45 +298,11 @@ * `XMonad.Hooks.DynamicLog` - - Added `statusBar'` function, like existing `statusBar` but accepts a pretty - 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. - + - Added `xmobarProp`, for property-based alternative to `xmobar`. + - Add the -dock argument to the dzen spawn arguments - - Added `StatusBarConfig` and `makeStatusBar` and `makeStatusBar'` as - 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. + - The API for this module is frozen: this is now a compatibility wrapper. * `XMonad.Layout.BoringWindows` diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index e45d12ac..bf7542bb 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -484,6 +484,10 @@ Here is a list of the modules found in @XMonad.Hooks@: putting in a status bar of some sort. See "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": Makes xmonad use the EWMH hints to tell panel applications about its 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 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": 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 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 -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 enable it you need first to import "XMonad.Hooks.DynamicLog": diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 20e6bd20..e0db8952 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE FlexibleContexts, PatternGuards, TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | @@ -11,6 +10,16 @@ -- Stability : unstable -- Portability : unportable -- +-- __Note:__ This module is a __compatibility wrapper__ for the following: +-- +-- * "XMonad.Hooks.StatusBar" +-- * "XMonad.Hooks.StatusBar.PP" +-- +-- DynamicLog API is frozen and users are encouraged to migrate to these +-- modern replacements. +-- +-- /Original description and documentation follows:/ +-- -- 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. DynamicLog @@ -26,10 +35,7 @@ module XMonad.Hooks.DynamicLog ( -- * Drop-in loggers xmobarProp, xmobar, - statusBarProp, - statusBarPropTo, statusBar, - statusBar', dzen, dzenWithFlags, dynamicLog, @@ -38,6 +44,7 @@ module XMonad.Hooks.DynamicLog ( xmonadPropLog, xmonadPropLog', xmonadDefProp, + -- * Build your own formatter dynamicLogWithPP, dynamicLogString, @@ -56,226 +63,80 @@ module XMonad.Hooks.DynamicLog ( pprWindowSet, pprWindowSetXinerama, - -- * Specialized spawning and cleaning - spawnStatusBarAndRemember, - cleanupStatusBars, - - -- * Further customization - -- $furthercustomization - statusBarPropConfig, - statusBarPropToConfig, - statusBarHandleConfig, - statusBarHandleConfig', - makeStatusBar, - makeStatusBar', - StatusBarConfig(..), - - -- * Multiple loggers - -- $multiple - - -- * To Do - -- $todo - ) where -- Useful imports -import qualified Codec.Binary.UTF8.String as UTF8 (encode) -import Control.Applicative (liftA2) -import Control.Exception (SomeException, try) -import Control.Monad (msum, void) -import Data.Bool (bool) -import Data.Char (isSpace) -import Data.List (intercalate, isPrefixOf, sortOn, stripPrefix) -import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) -import System.Posix.Signals (sigTERM, signalProcessGroup) -import System.Posix.Types (ProcessID) - -import qualified Data.Map as M -import qualified XMonad.StackSet as S - -import Foreign.C (CChar) - import XMonad -import XMonad.Util.NamedWindows -import XMonad.Util.Run -import XMonad.Util.WorkspaceCompare -import qualified XMonad.Util.ExtensibleState as XS - import XMonad.Layout.LayoutModifier -import XMonad.Hooks.UrgencyHook import XMonad.Hooks.ManageDocks +import XMonad.Hooks.StatusBar.PP +import XMonad.Hooks.StatusBar -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- --- > import XMonad --- > import XMonad.Hooks.DynamicLog +-- > import XMonad +-- > import XMonad.Hooks.DynamicLog -- --- The recommended way to use this module with xmobar, as well as any other --- status bar that supports property logging (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 --- below), is to use one of the following two functions: +-- If you just want a quick-and-dirty status bar with zero effort, try +-- the 'xmobar' or 'dzen' functions: -- --- * 'xmobarProp' if you want to use the predefined pretty-printing function --- and toggle struts key (@mod-b@). --- --- * 'statusBarProp' if you want to define these things yourself. --- --- These functions are preferred over the other options listed below, as they --- take care of all the necessary plumbing—no shell scripting required! --- --- For example, to use the 'xmobarProp' function you could do --- --- > main = xmonad =<< xmobarProp myConfig +-- > main = xmonad =<< xmobar myConfig -- > -- > myConfig = def { ... } -- --- With 'statusBarProp', this would look something like the following +-- There is also 'statusBar' if you'd like to use another status bar, or would +-- like to use different formatting options. The 'xmobar', 'dzen', and +-- 'statusBar' functions are preferred over the other options listed below, as +-- they take care of all the necessary plumbing -- no shell scripting required! -- --- > main = xmonad =<< statusBarProp "xmobar" myXmobarPP myToggleStrutsKey myConfig --- > --- > myXmobarPP = def { ... } --- > toggleStrutsKey XConfig{ modMask = modm } = (modm, xK_b) --- > myConfig = 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 simply achieved by 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 --- otherwise! --- --- Because 'statusBarProp' lets you define your own executable, you can also --- give it a different status bar entirely; you only need to make sure that the --- status bar supports reading a property string from the root window, or use --- a wrapper that reads the property and pipes it into the bar (e.g. --- @xmonadpropread | dzen2@, see @scripts/xmonadpropread.hs@). --- --- If you don't want to use the default property, you can specify your own --- with the 'statusBarPropTo' function. --- --- If your status bar does not support property-based logging, you may also try --- 'statusBar' and 'statusBar'', as well as the `xmobar` function, instead. --- They can be used in the same way as the 'statusBarProp' and 'xmobarProp' --- functions above (for xmobar, you will now use the @StdinReader@ --- plugin in your @.xmobarrc@). Instead of writing to a property, these --- functions open a pipe and make 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. --- --- 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 definition of --- 'statusBarProp' may still 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 +-- Alternatively, you can choose among several default status bar formats +-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the +-- appropriate function, for instance: -- -- > main = xmonad $ def { -- > ... --- > , logHook = xmonadPropLog =<< dynamicLogString myPP +-- > logHook = dynamicLog -- > ... --- > } +-- > } -- --- 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 the @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 ones. --- --- Even if you don't use a statusbar, 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 log --- (like dzen), and you don't want to use the 'statusBar' or 'statusBar'' --- functions, you can, again, also manually add all of the required components. --- --- This works much like the property based solution above, just that you will --- want to use 'dynamicLog' or 'dynamicLogXinerama' in place of 'xmonadPropLog'. --- --- > main = xmonad $ def { --- > ... --- > , logHook = dynamicLog --- > ... --- > } --- --- For more flexibility, you can also use 'dynamicLogWithPP' and supply your own --- pretty-printing format (by either defining one from scratch, or customizing --- one of the provided examples). For example: +-- For more flexibility, you can also use 'dynamicLogWithPP' and supply +-- your own pretty-printing format (by either defining one from scratch, +-- or customizing one of the provided examples). +-- For example: -- -- > -- use sjanssen's pretty-printer format, but with the sections -- > -- in reverse -- > logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse } -- --- Again, you will have to do all the necessary plumbing yourself. In addition, --- you are also responsible for creating a pipe for you status bar to read from: +-- Note that setting the @logHook@ only sets up xmonad's output; you +-- are responsible for starting your own status bar program (e.g. dzen +-- or xmobar) and making sure xmonad's output is piped into it +-- appropriately, either by putting it in your @.xsession@ or similar +-- file, or by using @spawnPipe@ in your @main@ function, for example: -- --- > import XMonad.Util.Run (hPutStrLn, spawnPipe) +-- > import XMonad.Util.Run -- for spawnPipe and hPutStrLn -- > -- > main = do --- > h <- spawnPipe "dzen2 -options -foo -bar" +-- > h <- spawnPipe "xmobar -options -foo -bar" -- > xmonad $ def { -- > ... --- > , logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h } --- > ... --- > } +-- > 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, as was done in the example above; by --- default the status will be printed to stdout rather than the pipe you create. +-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of +-- your pretty-printer as in the example above; by default the status +-- will be printed to stdout rather than the pipe you create. -- - --- $todo +-- Even if you don't use a statusbar, 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)) -- --- * incorporate dynamicLogXinerama into the PP framework somehow ------------------------------------------------------------------------ @@ -318,30 +179,6 @@ dzen = dzenWithFlags flags bg = "'#3f3c6d'" flags = "-e 'onstart=lower' -dock -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg --- | Run xmonad with a property-based xmobar status bar set to some nice --- defaults. --- --- > main = xmonad =<< xmobarProp myConfig --- > --- > myConfig = def { ... } --- --- The intent is that the above config file should provide a nice --- status bar with minimal effort. Note that you still need to configure --- xmobar to use the @XMonadLog@ plugin instead of the default @StdinReader@, --- see above. --- --- If you wish to customize the status bar format at all, you'll have to --- use the 'statusBarProp' function instead. --- --- The binding uses the "XMonad.Hooks.ManageDocks" module to automatically --- handle screen placement for xmobar, and enables 'mod-b' for toggling --- the menu bar. --- -xmobarProp :: LayoutClass l Window - => XConfig l -- ^ The base config - -> IO (XConfig (ModifiedLayout AvoidStruts l)) -xmobarProp = statusBarProp "xmobar" xmobarPP toggleStrutsKey - -- | This function works like 'xmobarProp', but uses pipes instead of -- property-based logging. xmobar :: LayoutClass l Window @@ -349,76 +186,6 @@ xmobar :: LayoutClass l Window -> IO (XConfig (ModifiedLayout AvoidStruts l)) xmobar = statusBar "xmobar" xmobarPP toggleStrutsKey --- | Modifies the given base configuration to launch the given status bar, write --- status information to the @_XMONAD_LOG@ property for the bar to read, and --- allocate space on the screen edges for the bar. -statusBarProp :: LayoutClass l Window - => String -- ^ The command line to launch the status bar - -> PP -- ^ The pretty printing options - -> (XConfig Layout -> (KeyMask, KeySym)) - -- ^ The desired key binding to toggle bar visibility - -> XConfig l -- ^ The base config - -> IO (XConfig (ModifiedLayout AvoidStruts l)) -statusBarProp = statusBarPropTo xmonadDefProp - --- | Like 'statusBarProp', but one is able to specify the property to be written --- to. -statusBarPropTo :: LayoutClass l Window - => String -- ^ Property to write the string to - -> String -- ^ The command line to launch the status bar - -> PP -- ^ The pretty printing options - -> (XConfig Layout -> (KeyMask, KeySym)) - -- ^ The desired key binding to toggle bar visibility - -> XConfig l -- ^ The base config - -> IO (XConfig (ModifiedLayout AvoidStruts l)) -statusBarPropTo prop a p k c = do {sb <- statusBarPropToConfig prop a p; makeStatusBar' sb k c} - - --- | 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) - --- This newtype wrapper, together with the ExtensionClass instance makes 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) - - -- | Like 'statusBarProp', but uses pipes instead of property-based logging. -- Only use this function if your status bar does not support reading from a -- property of the root window. @@ -429,98 +196,15 @@ statusBar :: LayoutClass l Window -- ^ The desired key binding to toggle bar visibility -> XConfig l -- ^ The base config -> IO (XConfig (ModifiedLayout AvoidStruts l)) -statusBar = makeSB .: statusBarHandleConfig - - --- | Like 'statusBar' with the pretty printing options embedded in the --- 'X' monad. The @X PP@ value is re-executed every time the logHook runs. --- Useful if printing options need to be modified dynamically. -statusBar' :: LayoutClass l Window - => String -- ^ The command line to launch the status bar - -> X PP -- ^ The pretty printing options - -> (XConfig Layout -> (KeyMask, KeySym)) - -- ^ The desired key binding to toggle bar visibility - -> XConfig l -- ^ The base config - -> IO (XConfig (ModifiedLayout AvoidStruts l)) -statusBar' = makeSB .: statusBarHandleConfig' - --- | 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. -makeStatusBar :: LayoutClass l Window - => StatusBarConfig -- ^ The status bar config - -> XConfig l -- ^ The base config - -> IO (XConfig l) -makeStatusBar (StatusBarConfig lh sh ch) conf = - return $ conf - { logHook = logHook conf *> lh - , startupHook = startupHook conf *> ch *> sh - } - --- | Like 'makeStatusBar', 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. -makeStatusBar' :: 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)) -makeStatusBar' sb k conf = do - conf' <- makeStatusBar sb conf - return $ docks $ conf' { layoutHook = avoidStruts (layoutHook conf') - , keys = (<>) <$> keys' <*> keys conf' - } - where keys' = (`M.singleton` sendMessage ToggleStruts) . k - --- | A helper function to be used with 'statusBar', 'statusBarProp' --- and their variants. -makeSB :: LayoutClass l Window - => IO StatusBarConfig -- ^ The status bar config - -> (XConfig Layout -> (KeyMask, KeySym)) - -- ^ The key binding - -> XConfig l -- ^ The base config - -> IO (XConfig (ModifiedLayout AvoidStruts l)) -makeSB sb k conf = do - sb' <- sb - makeStatusBar' sb' k conf - --- | Write a string to a property on the root window. This property is of type --- @UTF8_STRING@. -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 - --- | Write a string to the @_XMONAD_LOG@ property on the root window. -xmonadPropLog :: String -> X () -xmonadPropLog = xmonadPropLog' xmonadDefProp +statusBar cmd pp k conf= do + sb <- statusBarPipe cmd (pure pp) + withEasySB sb k conf -- | -- Helper function which provides ToggleStruts keybinding -- toggleStrutsKey :: XConfig t -> (KeyMask, KeySym) -toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b ) - --- | The default property xmonad writes to. (@_XMONAD_LOG@). -xmonadDefProp :: String -xmonadDefProp = "_XMONAD_LOG" - ------------------------------------------------------------------------- +toggleStrutsKey = defToggleStrutsKey -- | An example log hook, which prints status information to stdout in -- the default format: @@ -535,66 +219,6 @@ xmonadDefProp = "_XMONAD_LOG" dynamicLog :: X () dynamicLog = dynamicLogWithPP def --- | 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 - -- | -- Workspace logger with a format designed for Xinerama: -- @@ -615,445 +239,28 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama -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 "" - where t = concat [""] - --- | 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 = "" - r = "" - --- | 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 "" - where - prefix = "" - --- | 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 [""] - --- | Strip xmobar markup, specifically the , and tags and --- the matching tags like . -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 ... 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 = "" - --- | Transforms a pretty-printer into one not displaying the given workspaces. +-- | Run xmonad with a property-based xmobar status bar set to some nice +-- defaults. -- --- For example, filtering out the @NSP@ workspace before giving the 'PP' to --- 'dynamicLogWithPP': +-- > main = xmonad =<< xmobarProp myConfig +-- > +-- > myConfig = def { ... } -- --- > logHook = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] $ def +-- The intent is that the above config file should provide a nice +-- status bar with minimal effort. Note that you still need to configure +-- xmobar to use the @XMonadLog@ plugin instead of the default @StdinReader@, +-- see above. -- --- 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 +-- If you wish to customize the status bar format at all, use the modernized +-- interface provided by the "XMonad.Hooks.StatusBar" and +-- "XMonad.Hooks.StatusBar.PP" modules instead. -- --- > 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 } - - --- $furthercustomization --- Internally, the status bars are managed through the 'StatusBarConfig', which provides a convenient --- abstraction over what a status bar is and how to manage it. --- Instead of directly modifying the config, the functions 'statusBarProp' and 'statusBar' create an --- appropriate 'StatusBarConfig' and call 'makeStatusBar' or 'makeStatusBar'' on it. This enables the user --- to have more flexibility and control over the status bars, without having do the plumbing themselves. --- --- The difference between 'makeStatusBar' and 'makeStatusBar'' is that 'makeStatusBar' tries to stay --- out of your way, whereas 'makeStatusBar'' configures an extra keybinding to toggle the status bars, --- and also applies the 'avoidStruts' layout modifier as well as the 'docks' combinator, which makes it --- similar to the 'statusBar' function and its variants. --- Using this interface has the benefit of enabling a cleaner config and composable status bars. --- --- For example, if you want to use property logging as provided by 'statusBarProp' you could do the following: --- --- > main = do --- > mySB <- statusBarPropConfig "xmobar" myPP --- > xmonad =<< makeStatusBar mySB myConf --- --- This plays nicer with other combinators that you might have already in your config: --- --- > main = do --- > mySB <- statusBarPropConfig "xmobar" myPP --- > xmonad =<< (makeStatusBar mySB . ewmh . docks $ def {...}) --- --- The different statusBar functions rely on the following status bar configs: --- --- * 'statusBarProp' relies on 'statusBarPropConfig' --- --- * 'statusBarPropTo' relies on 'statusBarPropConfig' --- --- * 'statusBar' relies on 'statusBarHandleConfig' --- --- * 'statusBar'' relies on 'statusBarHandleConfig'' - --- | This datataype abstracts a status bar to provide a common interface functions like 'statusBar' --- or 'statusBarProp'. Once defined, a status bar can be incorporated in 'XConfig' by using 'makeStatusBar', --- which takes care of all 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 when xmonad is restarted. - -- This is useful when the status bar is not started - -- with a pipe. - } - -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 - - --- | Creates a 'StatusBarConfig' that uses property logging to @_XMONAD_LOG@, which --- is set in 'xmonadDefProp' -statusBarPropConfig :: String -- ^ The command line to launch the status bar - -> PP -- ^ The pretty printing options - -> IO StatusBarConfig -statusBarPropConfig = statusBarPropToConfig xmonadDefProp - --- | Like 'statusBarPropConfig', but lets you define the property -statusBarPropToConfig :: String -- ^ Property to write the string to - -> String -- ^ The command line to launch the status bar - -> PP -- ^ The pretty printing options - -> IO StatusBarConfig -statusBarPropToConfig prop cmd pp = pure $ (def:: StatusBarConfig) - { sbLogHook = xmonadPropLog' prop =<< dynamicLogString pp - , sbStartupHook = spawnStatusBarAndRemember cmd - , sbCleanupHook = cleanupStatusBars - } - --- | Creates a 'StatusBarConfig' with logging to the standard input -statusBarHandleConfig :: String -- ^ The command line to launch the status bar - -> PP -- ^ The pretty printing options - -> IO StatusBarConfig -statusBarHandleConfig cmd pp = do - h <- spawnPipe cmd - return $ def { sbLogHook = dynamicLogWithPP pp { ppOutput = hPutStrLn h } } - --- | Like 'statusBarHandleConfig', but the pretty printing options are embedded in the --- 'X' monad. -statusBarHandleConfig' :: String -- ^ The command line to launch the status bar - -> X PP -- ^ The pretty printing options - -> IO StatusBarConfig -statusBarHandleConfig' cmd xpp = do - h <- spawnPipe cmd - return $ def { sbLogHook = xpp >>= \pp -> dynamicLogWithPP pp { ppOutput = hPutStrLn h } } - --- $multiple --- A pattern that is often found in a lot of configs that want multiple status bars, --- generally goes something like this: --- --- > main = do --- > xmproc0 <- spawnPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top" --- > xmproc1 <- spawnPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom" --- > xmproc2 <- spawnPipe "xmobar -x 1 $HOME/.config/xmobar/xmobarrc1" --- > xmonad $ def { --- > ... --- > , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 } --- > >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 } --- > >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 } --- > ... --- > } --- --- Which has a lot of boilerplate and error-prone. Using the provided functions --- in this section, the amount of boilerplate is reduced. --- If you wish to have multiple status bars managed by xmonad, you can do so by creating --- the status bar configs and combining them with '<>': --- --- > main = do --- > xmobarTop <- statusBarHandleConfig "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top" ppTop --- > xmobarBottom <- statusBarHandleConfig "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom" ppBottom --- > xmobar1 <- statusBarHandleConfig "xmobar -x 1 $HOME/.config/xmobar/xmobarrc1" pp1 --- > xmonad =<< makeStatusBar (xmobarTop <> xmobarBottom <> xmobar1) myConfig --- --- Or if you're feeling adventurous: --- --- > myBars = map (uncurry statusBarHandleConfig) [ ("xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top", ppTop) --- > , ("xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom", ppBottom) --- > , ("xmobar -x 1 $HOME/.config/xmobar/xmobarrc1", pp1) ] --- > main = do --- > sbs <- sequence myBars --- > xmonad =<< makeStatusBar (mconcat sbs) myConfig --- --- The above examples also work if the different status bars support different --- logging methods: you could do mix property logging and logging via standard input. --- One thing to keep in mind: 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. - --- | 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, as seen in 'dynamicLog'. -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 = [] - } - --- | 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 "" - --- | A helper combinator -(.:) :: (d -> c) -> (a -> b -> d) -> a -> b -> c -(.:) = (.) . (.) +-- The binding uses the "XMonad.Hooks.ManageDocks" module to automatically +-- handle screen placement for xmobar, and enables 'mod-b' for toggling +-- the menu bar. +xmobarProp :: LayoutClass l Window + => XConfig l -- ^ The base config + -> IO (XConfig (ModifiedLayout AvoidStruts l)) +xmobarProp conf = do + xmobarPropConfig <- statusBarProp "xmobar" (pure xmobarPP) + withEasySB xmobarPropConfig toggleStrutsKey conf diff --git a/XMonad/Hooks/StatusBar.hs b/XMonad/Hooks/StatusBar.hs new file mode 100644 index 00000000..d13dd1d4 --- /dev/null +++ b/XMonad/Hooks/StatusBar.hs @@ -0,0 +1,414 @@ +{-# LANGUAGE FlexibleContexts, TypeApplications #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.StatusBar +-- Copyright : (c) Yecine Megdiche +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Yecine Megdiche +-- 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) diff --git a/XMonad/Hooks/StatusBar/PP.hs b/XMonad/Hooks/StatusBar/PP.hs new file mode 100644 index 00000000..29921cf3 --- /dev/null +++ b/XMonad/Hooks/StatusBar/PP.hs @@ -0,0 +1,443 @@ +{-# LANGUAGE ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.StatusBar.PP +-- Copyright : (c) Don Stewart +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Don Stewart +-- 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 "" + where t = concat [""] + +-- | 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 = "" + r = "" + +-- | 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 "" + where + prefix = "" + +-- | 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 [""] + +-- | Strip xmobar markup, specifically the , and tags and +-- the matching tags like . +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 ... 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 = "" + +-- | 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 "" diff --git a/XMonad/Util/ClickableWorkspaces.hs b/XMonad/Util/ClickableWorkspaces.hs index 18916e18..24ccf1fd 100644 --- a/XMonad/Util/ClickableWorkspaces.hs +++ b/XMonad/Util/ClickableWorkspaces.hs @@ -8,8 +8,8 @@ -- Stability : unstable -- Portability : unportable -- --- Provides @clickablePP@, which when applied to the PP pretty-printer used by --- the "XMonad.Hooks.DynamicLog" hook, will make the workspace tags clickable in +-- Provides @clickablePP@, which when applied to the 'PP' pretty-printer used +-- by "XMonad.Hooks.StatusBar" will make the workspace tags clickable in -- XMobar (for switching focus). -- ----------------------------------------------------------------------------- @@ -25,17 +25,22 @@ import Control.Monad ((>=>)) import Data.Functor ((<&>)) import XMonad -import XMonad.Hooks.DynamicLog (xmobarAction, PP(..)) +import XMonad.Hooks.StatusBar.PP (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 --- to "XMonad.Hooks.DynamicLog"\'s dynamicLogWithPP like so: +-- If you're using the "XMonad.Hooks.StatusBar" interface, apply 'clickablePP' +-- 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 -- --- * Requirements: +-- Requirements: +-- -- * @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) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index b0f97bd3..ad8270da 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -93,7 +93,6 @@ library XMonad.Actions.FindEmptyWorkspace XMonad.Actions.FlexibleManipulate XMonad.Actions.FlexibleResize - XMonad.Actions.TiledWindowDragging XMonad.Actions.FloatKeys XMonad.Actions.FloatSnap XMonad.Actions.FocusNth @@ -116,8 +115,8 @@ library XMonad.Actions.Prefix XMonad.Actions.Promote XMonad.Actions.RandomBackground - XMonad.Actions.RotateSome XMonad.Actions.RotSlaves + XMonad.Actions.RotateSome XMonad.Actions.Search XMonad.Actions.ShowText XMonad.Actions.Sift @@ -125,9 +124,10 @@ library XMonad.Actions.SinkAll XMonad.Actions.SpawnOn XMonad.Actions.Submap - XMonad.Actions.SwapWorkspaces XMonad.Actions.SwapPromote + XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows + XMonad.Actions.TiledWindowDragging XMonad.Actions.TopicSpace XMonad.Actions.TreeSelect XMonad.Actions.UpdateFocus @@ -186,12 +186,14 @@ library XMonad.Hooks.Script XMonad.Hooks.ServerMode XMonad.Hooks.SetWMName + XMonad.Hooks.StatusBar + XMonad.Hooks.StatusBar.PP XMonad.Hooks.ToggleHook XMonad.Hooks.UrgencyHook XMonad.Hooks.WallpaperSetter + XMonad.Hooks.WindowSwallowing XMonad.Hooks.WorkspaceByPos XMonad.Hooks.WorkspaceHistory - XMonad.Hooks.WindowSwallowing XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.AutoMaster @@ -211,7 +213,6 @@ library XMonad.Layout.DecorationAddons XMonad.Layout.DecorationMadness XMonad.Layout.Dishes - XMonad.Layout.MultiDishes XMonad.Layout.DragPane XMonad.Layout.DraggingVisualizer XMonad.Layout.Drawer @@ -251,6 +252,7 @@ library XMonad.Layout.MosaicAlt XMonad.Layout.MouseResizableTile XMonad.Layout.MultiColumns + XMonad.Layout.MultiDishes XMonad.Layout.MultiToggle XMonad.Layout.MultiToggle.Instances XMonad.Layout.MultiToggle.TabBarDecoration @@ -264,8 +266,8 @@ library XMonad.Layout.PositionStoreFloat XMonad.Layout.Reflect XMonad.Layout.Renamed - XMonad.Layout.ResizableTile XMonad.Layout.ResizableThreeColumns + XMonad.Layout.ResizableTile XMonad.Layout.ResizeScreen XMonad.Layout.Roledex XMonad.Layout.ShowWName @@ -347,8 +349,8 @@ library XMonad.Util.Replace XMonad.Util.Run XMonad.Util.Scratchpad - XMonad.Util.SpawnNamedPipe XMonad.Util.SessionStart + XMonad.Util.SpawnNamedPipe XMonad.Util.SpawnOnce XMonad.Util.Stack XMonad.Util.StringProp