From f127cf55f41653854737871426e90f6809430169 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 12 Mar 2021 23:03:33 +0000 Subject: [PATCH 1/6] X.H.DynamicIcons: Improve configuration of output formatting Make it possible to keep workspace id in the output (iconsFmtAppend) and to wrap icons even if there's just one, or zero. Also, change the default to use curly brackets to avoid confict with brackets/parentheses used by default PPs in DynamicLog. Related: https://github.com/xmonad/xmonad-contrib/pull/450 --- XMonad/Hooks/DynamicIcons.hs | 67 ++++++++++++++++++++++++++++++------ 1 file changed, 56 insertions(+), 11 deletions(-) diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index 44dc7fbd..6533dddb 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -22,6 +23,7 @@ module XMonad.Hooks.DynamicIcons ( -- * Data Types appIcon, IconSet, IconConfig(..), Icon(..), + iconsFmtAppend, iconsFmtReplace, wrapUnwords, ) where import XMonad @@ -104,36 +106,79 @@ dynamicLogIconsWithPP iconset pp = dynamicLogWithPP =<< dynamicLogIconsConvert ( -- | Datatype for expanded 'Icon' configurations data IconConfig = IconConfig { iconConfigIcons :: IconSet -- ^ The 'IconSet' to use - , iconConfigStack :: [String] -> String -- ^ The function to manage stacking of 'Icon's + , iconConfigFmt :: WorkspaceId -> [String] -> String + -- ^ How to format the result, see 'iconsFmtReplace', 'iconsFmtAppend'. , iconConfigPP :: PP -- ^ The 'PP' to alter } instance Default IconConfig where def = IconConfig { iconConfigIcons = mempty - , iconConfigStack = wrap "[" "]" . unwords + , iconConfigFmt = iconsFmtReplace (wrapUnwords "{" "}") , iconConfigPP = def } +-- | 'iconConfigFmt' that replaces the workspace name with icons, if any. +-- +-- First parameter specifies how to concatenate multiple icons. Useful values +-- include: 'concat', 'unwords', 'wrapUnwords'. +-- +-- >>> iconsFmtReplace concat "1" [] +-- "1" +-- +-- >>> iconsFmtReplace concat "1" ["A", "B"] +-- "AB" +-- +-- >>> iconsFmtReplace (wrapUnwords "{" "}") "1" ["A", "B"] +-- "{A B}" +iconsFmtReplace :: ([String] -> String) -> WorkspaceId -> [String] -> String +iconsFmtReplace cat ws is | null is = ws + | otherwise = cat is + +-- | 'iconConfigFmt' that appends icons to the workspace name. +-- +-- First parameter specifies how to concatenate multiple icons. Useful values +-- include: 'concat', 'unwords', 'wrapUnwords'. +-- +-- >>> iconsFmtAppend concat "1" [] +-- "1" +-- +-- >>> iconsFmtAppend concat "1" ["A", "B"] +-- "1:AB" +iconsFmtAppend :: ([String] -> String) -> WorkspaceId -> [String] -> String +iconsFmtAppend cat ws is | null is = ws + | otherwise = ws ++ ':' : cat is + +-- | Join words with spaces, and wrap the result in delimiters unless there +-- was exactly one element. +-- +-- >>> wrapUnwords "{" "}" ["A", "B"] +-- "{A B}" +-- +-- >>> wrapUnwords "{" "}" ["A"] +-- "A" +-- +-- >>> wrapUnwords "{" "}" [] +-- "" +wrapUnwords :: String -> String -> [String] -> String +wrapUnwords _ _ [x] = x +wrapUnwords l r xs = wrap l r (unwords xs) + -- | This is the same as 'dynamicLogIconsWithPP' but it takes a 'IconConfig'. -- This allows you to manually customise the 'Icon's the stacking function and also your `PP` dynamicLogIconsConvert :: IconConfig -> X PP -dynamicLogIconsConvert iconConfig = do +dynamicLogIconsConvert IconConfig{..} = do ws <- gets (S.workspaces . windowset) - icons <- M.fromList . catMaybes <$> mapM (getIcons (iconConfigIcons iconConfig)) ws - pure $ (iconConfigPP iconConfig) + icons <- M.fromList . catMaybes <$> mapM (getIcons iconConfigIcons) ws + pure $ iconConfigPP { ppCurrent = ppSection ppCurrent iconCurrent icons , ppVisible = ppSection ppVisible iconVisible icons , ppHidden = ppSection ppHidden iconHidden icons , ppHiddenNoWindows = ppSection ppHiddenNoWindows iconHiddenNoWindows icons } where - ppSection pF f icons = pF (iconConfigPP iconConfig) . concatIcons f . iconLookup icons - iconLookup icons x = M.findWithDefault [baseIconSet x] x icons - concatIcons f y - | length y > 1 = iconConfigStack iconConfig $ map f y - | otherwise = concatMap f y - + ppSection ppField icField icons wks = + ppField iconConfigPP $ iconConfigFmt wks $ map icField $ M.findWithDefault [] wks icons getIcons :: IconSet -> WindowSpace -> X (Maybe (WorkspaceId, [Icon])) getIcons is w = do From a00043852667c00afe313283e6715d6de6a2132b Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 12 Mar 2021 23:28:24 +0000 Subject: [PATCH 2/6] X.H.DynamicIcons: Refactor dynamicLogIconsConvert a bit Rename to dynamicIconsPP and change the type to something similar to workspaceNamesPP and marshallPP. Related: https://github.com/xmonad/xmonad-contrib/pull/450 --- XMonad/Hooks/DynamicIcons.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index 6533dddb..d03637ac 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -18,7 +18,7 @@ module XMonad.Hooks.DynamicIcons ( -- $usage -- * Creating Dynamic Icons - dynamicLogIconsWithPP, dynamicLogIconsConvert, + dynamicLogIconsWithPP, dynamicIconsPP, -- * Data Types appIcon, IconSet, @@ -33,6 +33,7 @@ import qualified Data.Map as M import XMonad.Hooks.DynamicLog import Data.Maybe (catMaybes) +import Control.Monad ((<=<)) -- $usage -- Dynamically changes a 'Workspace's 'WorkspaceId' based on the 'Window's inside the Workspace. @@ -101,21 +102,19 @@ appIcon x = pure [baseIconSet x] dynamicLogIconsWithPP :: IconSet -- ^ The 'IconSet' to use -> PP -- ^ The 'PP' to alter -> X () -- ^ The resulting 'X' action -dynamicLogIconsWithPP iconset pp = dynamicLogWithPP =<< dynamicLogIconsConvert (def{ iconConfigIcons = iconset, iconConfigPP = pp }) +dynamicLogIconsWithPP iconset = dynamicLogWithPP <=< dynamicIconsPP def{ iconConfigIcons = iconset } -- | Datatype for expanded 'Icon' configurations data IconConfig = IconConfig { iconConfigIcons :: IconSet -- ^ The 'IconSet' to use , iconConfigFmt :: WorkspaceId -> [String] -> String -- ^ How to format the result, see 'iconsFmtReplace', 'iconsFmtAppend'. - , iconConfigPP :: PP -- ^ The 'PP' to alter } instance Default IconConfig where def = IconConfig { iconConfigIcons = mempty , iconConfigFmt = iconsFmtReplace (wrapUnwords "{" "}") - , iconConfigPP = def } -- | 'iconConfigFmt' that replaces the workspace name with icons, if any. @@ -164,13 +163,13 @@ wrapUnwords :: String -> String -> [String] -> String wrapUnwords _ _ [x] = x wrapUnwords l r xs = wrap l r (unwords xs) --- | This is the same as 'dynamicLogIconsWithPP' but it takes a 'IconConfig'. --- This allows you to manually customise the 'Icon's the stacking function and also your `PP` -dynamicLogIconsConvert :: IconConfig -> X PP -dynamicLogIconsConvert IconConfig{..} = do +-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to augment +-- workspace names with icons based on the contents (windows) of the workspace. +dynamicIconsPP :: IconConfig -> PP -> X PP +dynamicIconsPP IconConfig{..} pp = do ws <- gets (S.workspaces . windowset) icons <- M.fromList . catMaybes <$> mapM (getIcons iconConfigIcons) ws - pure $ iconConfigPP + pure $ pp { ppCurrent = ppSection ppCurrent iconCurrent icons , ppVisible = ppSection ppVisible iconVisible icons , ppHidden = ppSection ppHidden iconHidden icons @@ -178,7 +177,7 @@ dynamicLogIconsConvert IconConfig{..} = do } where ppSection ppField icField icons wks = - ppField iconConfigPP $ iconConfigFmt wks $ map icField $ M.findWithDefault [] wks icons + ppField pp $ iconConfigFmt wks $ map icField $ M.findWithDefault [] wks icons getIcons :: IconSet -> WindowSpace -> X (Maybe (WorkspaceId, [Icon])) getIcons is w = do From a18a155a8b8c1edb6956c26124c62084900086c8 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 13 Mar 2021 00:00:57 +0000 Subject: [PATCH 3/6] X.H.DynamicIcons: Refactor dynamicIconsPP, getIcons a bit Move all the workspaces and icon generation logic into getWorkspaceIcons and drop the Maybe which is no longer necessary since we made the formatting logic configurable. Related: https://github.com/xmonad/xmonad-contrib/pull/450 --- XMonad/Hooks/DynamicIcons.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index d03637ac..c57298b2 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -32,7 +32,7 @@ import qualified XMonad.StackSet as S import qualified Data.Map as M import XMonad.Hooks.DynamicLog -import Data.Maybe (catMaybes) +import Data.Traversable (for) import Control.Monad ((<=<)) -- $usage @@ -167,8 +167,7 @@ wrapUnwords l r xs = wrap l r (unwords xs) -- workspace names with icons based on the contents (windows) of the workspace. dynamicIconsPP :: IconConfig -> PP -> X PP dynamicIconsPP IconConfig{..} pp = do - ws <- gets (S.workspaces . windowset) - icons <- M.fromList . catMaybes <$> mapM (getIcons iconConfigIcons) ws + icons <- getWorkspaceIcons iconConfigIcons pure $ pp { ppCurrent = ppSection ppCurrent iconCurrent icons , ppVisible = ppSection ppVisible iconVisible icons @@ -179,7 +178,8 @@ dynamicIconsPP IconConfig{..} pp = do ppSection ppField icField icons wks = ppField pp $ iconConfigFmt wks $ map icField $ M.findWithDefault [] wks icons -getIcons :: IconSet -> WindowSpace -> X (Maybe (WorkspaceId, [Icon])) -getIcons is w = do - validIcons <- sequence $ foldMap (runQuery is) . S.integrate <$> S.stack w - pure $ (S.tag w,) <$> (validIcons >>= \x -> if null x then Nothing else Just x) +getWorkspaceIcons :: IconSet -> X (M.Map WorkspaceId [Icon]) +getWorkspaceIcons iconSet = do + ws <- gets (S.workspaces . windowset) + is <- for ws $ foldMap (runQuery iconSet) . S.integrate' . S.stack + pure $ M.fromList (zip (map S.tag ws) is) From 52f6aa2c4ba581e0b39f829775976af845f3961a Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 22 Mar 2021 11:39:29 +0000 Subject: [PATCH 4/6] X.H.DynamicIcons: Use ppRename - simpler, better interop with other modules This ports DynamicIcons to the recently introduced ppRename mechanism, which means DynamicIcons can now safely be combined with clickablePP, workspaceNamesPP and marshallPP. This also fixes DynamicIcons not working properly with urgent workspaces due to forgotten ppUrgent counterpart in data Icon. Also, ppVisibleNoWindows wouldn't work properly. The code is now considerably simpler, but we lost the ability to use different icons depending on whether the workspace is visible/hidden/urgent/etc. If anyone needs that, it can be worked around by using some markup that is later interpreted in ppVisible/ppHidden/ppUrgent/etc. Related: https://github.com/xmonad/xmonad-contrib/pull/481 --- XMonad/Hooks/DynamicIcons.hs | 78 +++++++++++------------------------- 1 file changed, 24 insertions(+), 54 deletions(-) diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index c57298b2..fe180d42 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -18,11 +18,11 @@ module XMonad.Hooks.DynamicIcons ( -- $usage -- * Creating Dynamic Icons - dynamicLogIconsWithPP, dynamicIconsPP, + dynamicLogIconsWithPP, appIcon, - -- * Data Types - appIcon, IconSet, - IconConfig(..), Icon(..), + -- * Customization + dynamicIconsPP, getWorkspaceIcons, + IconConfig(..), iconsFmtAppend, iconsFmtReplace, wrapUnwords, ) where @@ -32,8 +32,9 @@ import qualified XMonad.StackSet as S import qualified Data.Map as M import XMonad.Hooks.DynamicLog +import Data.Functor ((<&>)) import Data.Traversable (for) -import Control.Monad ((<=<)) +import Control.Monad ((<=<), (>=>)) -- $usage -- Dynamically changes a 'Workspace's 'WorkspaceId' based on the 'Window's inside the Workspace. @@ -65,48 +66,20 @@ import Control.Monad ((<=<)) -- NOTE: You can use any string you want here. The example shown here, uses NerdFont Icons to represent open applications --- | Custom datatype for custom icons based on the state of the 'Workspace' --- For example, --- --- > Icon "discord" "discord" "discord" "" --- --- Then you can add it to your IconSet. --- --- > icons :: IconSet --- > icons = mconcat --- > [ className =? "discord" --> pure [Icon "discord" "discord" "discord" ""] --- > ] -data Icon = Icon - { iconCurrent :: !String -- ^ If the 'Workspace' is the current workspace - , iconVisible :: !String -- ^ If the 'Workspace' is visible (Xinerama only) - , iconHidden :: !String -- ^ If the 'Workspace' isnt visible but still has windows - , iconHiddenNoWindows :: !String -- ^ If the 'Workspace' isnt visible and has no windows - } - --- | The set of Icons to use -type IconSet = Query [Icon] - -baseIconSet :: String -> Icon -baseIconSet x = - Icon { iconCurrent = x - , iconVisible = x - , iconHidden = x - , iconHiddenNoWindows = x - } - --- | Create an 'IconSet' from a 'String' -appIcon :: String -> IconSet -appIcon x = pure [baseIconSet x] +-- | Shortcut for configuring single icons. +appIcon :: String -> Query [String] +appIcon = pure . pure -- | Adjusts the 'PP' and then runs 'dynamicLogWithPP' -dynamicLogIconsWithPP :: IconSet -- ^ The 'IconSet' to use +dynamicLogIconsWithPP :: Query [String] -- ^ The 'IconSet' to use -> PP -- ^ The 'PP' to alter -> X () -- ^ The resulting 'X' action -dynamicLogIconsWithPP iconset = dynamicLogWithPP <=< dynamicIconsPP def{ iconConfigIcons = iconset } +dynamicLogIconsWithPP q = dynamicLogWithPP <=< dynamicIconsPP def{ iconConfigIcons = q } -- | Datatype for expanded 'Icon' configurations data IconConfig = IconConfig - { iconConfigIcons :: IconSet -- ^ The 'IconSet' to use + { iconConfigIcons :: Query [String] + -- ^ What icons to use for each window. , iconConfigFmt :: WorkspaceId -> [String] -> String -- ^ How to format the result, see 'iconsFmtReplace', 'iconsFmtAppend'. } @@ -166,20 +139,17 @@ wrapUnwords l r xs = wrap l r (unwords xs) -- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to augment -- workspace names with icons based on the contents (windows) of the workspace. dynamicIconsPP :: IconConfig -> PP -> X PP -dynamicIconsPP IconConfig{..} pp = do - icons <- getWorkspaceIcons iconConfigIcons - pure $ pp - { ppCurrent = ppSection ppCurrent iconCurrent icons - , ppVisible = ppSection ppVisible iconVisible icons - , ppHidden = ppSection ppHidden iconHidden icons - , ppHiddenNoWindows = ppSection ppHiddenNoWindows iconHiddenNoWindows icons - } - where - ppSection ppField icField icons wks = - ppField pp $ iconConfigFmt wks $ map icField $ M.findWithDefault [] wks icons +dynamicIconsPP ic pp = getWorkspaceIcons ic <&> \ren -> pp{ ppRename = ppRename pp >=> ren } -getWorkspaceIcons :: IconSet -> X (M.Map WorkspaceId [Icon]) -getWorkspaceIcons iconSet = do +-- | Returns a function for 'ppRename' that augments workspaces with icons +-- according to the provided 'IconConfig'. +getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String) +getWorkspaceIcons IconConfig{..} = fmt <$> getWorkspaceIcons' iconConfigIcons + where + fmt icons s w = iconConfigFmt s (M.findWithDefault [] (S.tag w) icons) + +getWorkspaceIcons' :: Query [String] -> X (M.Map WorkspaceId [String]) +getWorkspaceIcons' q = do ws <- gets (S.workspaces . windowset) - is <- for ws $ foldMap (runQuery iconSet) . S.integrate' . S.stack + is <- for ws $ foldMap (runQuery q) . S.integrate' . S.stack pure $ M.fromList (zip (map S.tag ws) is) From 835aeaaffbd470560e1913fb26695d04d1e2a887 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 22 Mar 2021 12:00:50 +0000 Subject: [PATCH 5/6] X.H.DynamicIcons: Move stuff around a bit (similar order to export list) Makes the other commits easier to review. --- XMonad/Hooks/DynamicIcons.hs | 37 ++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index fe180d42..191afc20 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -76,6 +76,25 @@ dynamicLogIconsWithPP :: Query [String] -- ^ The 'IconSet' to use -> X () -- ^ The resulting 'X' action dynamicLogIconsWithPP q = dynamicLogWithPP <=< dynamicIconsPP def{ iconConfigIcons = q } +-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to augment +-- workspace names with icons based on the contents (windows) of the workspace. +dynamicIconsPP :: IconConfig -> PP -> X PP +dynamicIconsPP ic pp = getWorkspaceIcons ic <&> \ren -> pp{ ppRename = ppRename pp >=> ren } + +-- | Returns a function for 'ppRename' that augments workspaces with icons +-- according to the provided 'IconConfig'. +getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String) +getWorkspaceIcons IconConfig{..} = fmt <$> getWorkspaceIcons' iconConfigIcons + where + fmt icons s w = iconConfigFmt s (M.findWithDefault [] (S.tag w) icons) + +getWorkspaceIcons' :: Query [String] -> X (M.Map WorkspaceId [String]) +getWorkspaceIcons' q = do + ws <- gets (S.workspaces . windowset) + is <- for ws $ foldMap (runQuery q) . S.integrate' . S.stack + pure $ M.fromList (zip (map S.tag ws) is) + + -- | Datatype for expanded 'Icon' configurations data IconConfig = IconConfig { iconConfigIcons :: Query [String] @@ -135,21 +154,3 @@ iconsFmtAppend cat ws is | null is = ws wrapUnwords :: String -> String -> [String] -> String wrapUnwords _ _ [x] = x wrapUnwords l r xs = wrap l r (unwords xs) - --- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to augment --- workspace names with icons based on the contents (windows) of the workspace. -dynamicIconsPP :: IconConfig -> PP -> X PP -dynamicIconsPP ic pp = getWorkspaceIcons ic <&> \ren -> pp{ ppRename = ppRename pp >=> ren } - --- | Returns a function for 'ppRename' that augments workspaces with icons --- according to the provided 'IconConfig'. -getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String) -getWorkspaceIcons IconConfig{..} = fmt <$> getWorkspaceIcons' iconConfigIcons - where - fmt icons s w = iconConfigFmt s (M.findWithDefault [] (S.tag w) icons) - -getWorkspaceIcons' :: Query [String] -> X (M.Map WorkspaceId [String]) -getWorkspaceIcons' q = do - ws <- gets (S.workspaces . windowset) - is <- for ws $ foldMap (runQuery q) . S.integrate' . S.stack - pure $ M.fromList (zip (map S.tag ws) is) From a0caca5edce9f00b7bdc7d709fa696d5630ad1dd Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 22 Mar 2021 14:04:59 +0000 Subject: [PATCH 6/6] X.H.DynamicIcons: Update docs --- XMonad/Doc/Extending.hs | 3 +- XMonad/Hooks/DynamicIcons.hs | 62 ++++++++++++++++++++++++------------ 2 files changed, 43 insertions(+), 22 deletions(-) diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 0d0a39da..7c2023e1 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -477,7 +477,8 @@ Here is a list of the modules found in @XMonad.Hooks@: One-shot and permanent ManageHooks that can be updated at runtime. * "XMonad.Hooks.DynamicIcons": - Dynamic Icons based on Windows in Workspaces + Dynamically augment workspace names logged to a status bar via DynamicLog + based on the contents (windows) of the workspace. * "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send information about xmonad's state to standard output, suitable for diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index 191afc20..18c271d5 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -10,7 +10,8 @@ -- Stability : unstable -- Portability : unportable -- --- Dynamically change workspace text based on the contents of the workspace +-- Dynamically augment workspace names logged to a status bar via DynamicLog +-- based on the contents (windows) of the workspace. ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicIcons ( @@ -37,33 +38,46 @@ import Data.Traversable (for) import Control.Monad ((<=<), (>=>)) -- $usage --- Dynamically changes a 'Workspace's 'WorkspaceId' based on the 'Window's inside the Workspace. --- 'IconSet's describe which icons are shown depending on which windows fit a 'Query'. +-- Dynamically augment Workspace's 'WorkspaceId' as shown on a status bar +-- based on the 'Window's inside the Workspace. -- --- To create an 'IconSet' make a 'Query' that returns a ['Icon']. +-- Icons are specified by a @Query [String]@, which is something like a +-- 'ManageHook' (and uses the same syntax) that returns a list of 'String's +-- (icons). This 'Query' is evaluated for each window and the results are +-- joined together. 'appIcon' is a useful shortcut here. -- --- 'appIcon' can be used to simplify this process --- For example, +-- For example: -- --- > icons :: IconSet --- > icons = composeAll --- > [ className =? "discord" --> appIcon "\xfb6e" --- > , className =? "Discord" --> appIcon "\xf268" --- > , className =? "Firefox" --> appIcon "\63288" --- > , className =? "Spotify" <||> className =? "spotify" --> appIcon "阮" --- > ] +-- > myIcons :: Query [String] +-- > myIcons = composeAll +-- > [ className =? "discord" --> appIcon "\xfb6e" +-- > , className =? "Discord" --> appIcon "\xf268" +-- > , className =? "Firefox" --> appIcon "\63288" +-- > , className =? "Spotify" <||> className =? "spotify" --> appIcon "阮" +-- > ] -- --- then you can add the hook to your config +-- then you can add the hook to your config: -- --- > xmonad $ def --- > { logHook = dynamicLogIconsWithPP icons xmobarPP <> myManageHook --- > } +-- > main = xmonad $ … $ def +-- > { logHook = dynamicLogIconsWithPP icons xmobarPP +-- > , … } -- --- Here is an example of this +-- Here is an example of this -- --- <> --- --- NOTE: You can use any string you want here. The example shown here, uses NerdFont Icons to represent open applications +-- <> +-- +-- Note: You can use any string you want here. +-- The example shown here uses NerdFont Icons to represent open applications. +-- +-- If you want to customize formatting and/or combine this with other +-- 'PP' extensions like "XMonad.Util.ClickableWorkspaces", here's a more +-- advanced example how to do that: +-- +-- > myIconConfig = def{ iconConfigIcons = myIcons, iconConfigFmt = iconsFmtAppend concat } +-- > main = xmonad $ … $ def +-- > { logHook = xmonadPropLog =<< dynamicLogString =<< clickablePP =<< +-- > dynamicIconsPP myIconConfig xmobarPP +-- > , … } -- | Shortcut for configuring single icons. @@ -114,6 +128,8 @@ instance Default IconConfig where -- First parameter specifies how to concatenate multiple icons. Useful values -- include: 'concat', 'unwords', 'wrapUnwords'. -- +-- ==== __Examples__ +-- -- >>> iconsFmtReplace concat "1" [] -- "1" -- @@ -131,6 +147,8 @@ iconsFmtReplace cat ws is | null is = ws -- First parameter specifies how to concatenate multiple icons. Useful values -- include: 'concat', 'unwords', 'wrapUnwords'. -- +-- ==== __Examples__ +-- -- >>> iconsFmtAppend concat "1" [] -- "1" -- @@ -143,6 +161,8 @@ iconsFmtAppend cat ws is | null is = ws -- | Join words with spaces, and wrap the result in delimiters unless there -- was exactly one element. -- +-- ==== __Examples__ +-- -- >>> wrapUnwords "{" "}" ["A", "B"] -- "{A B}" --