From cfc6a5293537a7cd61b9992c337279df5dba7628 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tomasz=20Ho=C5=82ubowicz?= <mail@alternateved.com>
Date: Tue, 16 Aug 2022 23:11:22 +0200
Subject: [PATCH] X.U.Loggers: Add variants of logTitle with urgent windows
 support

---
 CHANGES.md             |  5 ++++
 XMonad/Util/Loggers.hs | 63 ++++++++++++++++++++++++++++++++++--------
 2 files changed, 57 insertions(+), 11 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index bd29dfcf..b88f5180 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -787,6 +787,11 @@
       ones) on the focused workspace, as well as `logTitlesOnScreen` as
       a screen-specific variant thereof.
 
+    - Added `logTitles'` and `logTitleOnScreen'`.  These act like
+      `logTitles` and `logTitlesOnScreen` but use a record as an input
+      to enable logging for more window types.  For example, currently
+      urgent windows are additionally supported.
+
   * `XMonad.Layout.Minimize`
 
     - Export `Minimize` type constructor.
diff --git a/XMonad/Util/Loggers.hs b/XMonad/Util/Loggers.hs
index ef960627..6f937f40 100644
--- a/XMonad/Util/Loggers.hs
+++ b/XMonad/Util/Loggers.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Util.Loggers
@@ -32,12 +33,15 @@ module XMonad.Util.Loggers (
 
     -- * XMonad Loggers
     -- $xmonad
-    , logCurrent, logLayout, logTitle, logTitles
+    , logCurrent, logLayout
+    , logTitle, logTitles, logTitles'
     , logConst, logDefault, (.|)
     -- * XMonad: Screen-specific Loggers
     -- $xmonad-screen
     , logCurrentOnScreen, logLayoutOnScreen
-    , logTitleOnScreen, logWhenActive, logTitlesOnScreen
+    , logTitleOnScreen, logWhenActive
+    , logTitlesOnScreen, logTitlesOnScreen'
+    , TitlesFormat(..)
     -- * Formatting Utilities
     -- $format
     , onLogger
@@ -48,10 +52,11 @@ module XMonad.Util.Loggers (
 
   ) where
 
-import XMonad (liftIO, gets)
+import XMonad (Default, gets, liftIO, Window)
 import XMonad.Core
 import qualified XMonad.StackSet as W
 import XMonad.Hooks.StatusBar.PP
+import XMonad.Hooks.UrgencyHook (readUrgents)
 import XMonad.Util.Font (Align (..))
 import XMonad.Util.NamedWindows (getName)
 
@@ -193,15 +198,30 @@ logTitlesOnScreen
   -> (String -> String) -- ^ Formatting for the focused   window
   -> (String -> String) -- ^ Formatting for the unfocused window
   -> Logger
-logTitlesOnScreen sid formatFoc formatUnfoc = (`withScreen` sid) $ \screen -> do
-  let focWin = fmap W.focus . W.stack . W.workspace $ screen
-      wins   = maybe [] W.integrate . W.stack . W.workspace $ screen
+logTitlesOnScreen sid formatFoc formatUnfoc =
+  logTitlesOnScreen' sid TitlesFormat{ focusedFormat   = formatFoc
+                                     , unfocusedFormat = formatUnfoc
+                                     , urgentFormat    = id
+                                     }
+
+-- | Like 'logTitlesOnScreen' but with support for urgent windows.  To
+-- be used with "XMonad.Hooks.UrgencyHook".
+logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger
+logTitlesOnScreen' sid (TitlesFormat formatFoc formatUnfoc formatUrg) =
+  (`withScreen` sid) $ \screen -> do
+    let focWin = fmap W.focus . W.stack . W.workspace $ screen
+    urgWins <- readUrgents
+    logTitlesOnScreenWorker screen $ \win name ->
+      if | Just win == focWin -> formatFoc   name
+         | win `elem` urgWins -> formatUrg   name
+         | otherwise          -> formatUnfoc name
+
+-- | Internal function for 'logTitlesOnScreen' and 'logTitlesOnScreen''.
+logTitlesOnScreenWorker :: WindowScreen -> (Window -> String -> String) -> Logger
+logTitlesOnScreenWorker screen logger = do
+  let wins = maybe [] W.integrate . W.stack . W.workspace $ screen
   winNames <- traverse (fmap show . getName) wins
-  pure . Just
-       . unwords
-       $ zipWith (\w n -> if Just w == focWin then formatFoc n else formatUnfoc n)
-                 wins
-                 winNames
+  pure . Just . unwords $ zipWith logger wins winNames
 
 -- | Like 'logTitlesOnScreen', but directly use the "focused" screen
 -- (the one with the currently focused workspace).
@@ -210,6 +230,27 @@ logTitles formatFoc formatUnfoc = do
   sid <- gets $ W.screen . W.current . windowset
   logTitlesOnScreen sid formatFoc formatUnfoc
 
+-- | Variant of 'logTitles', but with support for urgent windows.
+logTitles' :: TitlesFormat -> Logger
+logTitles' formatter =
+  gets (W.screen . W.current . windowset) >>= (`logTitlesOnScreen'` formatter)
+
+-- | Formatting applied to the titles of certain windows.
+data TitlesFormat = TitlesFormat
+  { focusedFormat   :: String -> String  -- ^ Focused formatting.
+  , unfocusedFormat :: String -> String  -- ^ Unfocused formatting.
+  , urgentFormat    :: String -> String  -- ^ Formatting when urgent.
+  }
+
+-- | How to format these titles by default when using 'logTitles'' and
+-- 'logTitlesOnScreen''.
+instance Default TitlesFormat where
+  def = TitlesFormat
+    { focusedFormat   = wrap "[" "]" . xmobarRaw . shorten 30 . xmobarStrip
+    , unfocusedFormat =                xmobarRaw . shorten 30 . xmobarStrip
+    , urgentFormat    = wrap "!" "!" . xmobarRaw . shorten 30 . xmobarStrip
+    }
+
 -- | Get the name of the current layout.
 logLayout :: Logger
 logLayout = withWindowSet $ return . Just . ld