From b0358c0cbe077bb0d4aa1760485db2eb0d846257 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 27 Nov 2021 17:33:02 -0500 Subject: [PATCH] REF make colors and fonts more concise --- bin/xmobar.hs | 139 +++++++++++++++++++----------- lib/Xmobar/Plugins/Bluetooth.hs | 6 +- lib/Xmobar/Plugins/Common.hs | 19 +++- lib/Xmobar/Plugins/Device.hs | 8 +- lib/Xmobar/Plugins/Screensaver.hs | 6 +- lib/Xmobar/Plugins/VPN.hs | 6 +- 6 files changed, 114 insertions(+), 70 deletions(-) diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 363847a..3ecc9e1 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -36,10 +36,7 @@ import Xmobar.Plugins.Screensaver import Xmobar.Plugins.VPN import XMonad (getXMonadDir) -import XMonad.Hooks.DynamicLog - ( wrap - , xmobarColor - ) +import XMonad.Hooks.DynamicLog (wrap) import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.IntelBacklight @@ -48,6 +45,7 @@ import XMonad.Internal.Dependency import XMonad.Internal.Shell import qualified XMonad.Internal.Theme as T import Xmobar +import Xmobar.Plugins.Common main :: IO () main = do @@ -62,10 +60,11 @@ main = do config :: BarRegions -> String -> Config config br confDir = defaultConfig - { font = barFont - , additionalFonts = [iconFont, iconFontLarge, iconFontXLarge, iconFontXXLarge] - , textOffset = 16 - , textOffsets = [16, 17, 17, 18] + -- TODO head makes me feel icky + { font = head allFontStrings + , additionalFonts = drop 1 allFontStrings + , textOffset = head allFontOffsets + , textOffsets = drop 1 allFontOffsets , bgColor = T.bgColor , fgColor = T.fgColor , position = BottomSize C 100 24 @@ -120,7 +119,7 @@ ethernetCmd :: String -> CmdSpec ethernetCmd iface = CmdSpec { csAlias = iface , csRunnable = Run - $ Device (iface, "\xf0e8", T.fgColor, T.backdropFgColor) + $ Device (iface, fontifyText IconMedium "\xf0e8", colors) } batteryCmd :: CmdSpec @@ -137,12 +136,14 @@ batteryCmd = CmdSpec , "--" , "-a", notify , "-P" - , "-o" , "\xf0e7" - , "-O" , "\xf1e6" - , "-i" , "\xf1e6" + , "-o" , fontify "\xf0e7" + , "-O" , fontify "\xf1e6" + , "-i" , fontify "\xf1e6" ] 50 } where + fontify = fontifyText IconSmall + -- TODO format this with standardized notification library from xmonad.internal notify = fmtCmd "notify-send" [ "-u" , "critical" @@ -154,16 +155,17 @@ batteryCmd = CmdSpec vpnCmd :: CmdSpec vpnCmd = CmdSpec { csAlias = vpnAlias - , csRunnable = Run $ VPN ("\xf023", T.fgColor, T.backdropFgColor) + , csRunnable = Run $ VPN (fontifyText IconMedium "\xf023", colors) } btCmd :: CmdSpec btCmd = CmdSpec { csAlias = btAlias , csRunnable = Run - -- $ Bluetooth ("\xf293", T.fgColor, T.backdropFgColor) - $ Bluetooth ("\xf5b0", "\xf5ae") (T.fgColor, T.backdropFgColor) + $ Bluetooth (fontify "\xf5b0", fontify "\xf5ae") colors } + where + fontify = fontifyText IconLarge alsaCmd :: CmdSpec alsaCmd = CmdSpec @@ -172,8 +174,8 @@ alsaCmd = CmdSpec $ Alsa "default" "Master" [ "-t", "%" , "--" - , "-O", "\xf028" - , "-o", "\xf026 " + , "-O", fontifyText IconSmall "\xf028" + , "-o", fontifyText IconSmall "\xf026 " , "-c", T.fgColor , "-C", T.fgColor ] @@ -182,20 +184,20 @@ alsaCmd = CmdSpec blCmd :: CmdSpec blCmd = CmdSpec { csAlias = blAlias - , csRunnable = Run $ IntelBacklight "\xf185" + , csRunnable = Run $ IntelBacklight $ fontifyText IconSmall "\xf185" } ckCmd :: CmdSpec ckCmd = CmdSpec { csAlias = ckAlias - , csRunnable = Run $ ClevoKeyboard "\xf40b" + , csRunnable = Run $ ClevoKeyboard $ fontifyText IconSmall "\xf40b" } ssCmd :: CmdSpec ssCmd = CmdSpec { csAlias = ssAlias , csRunnable = Run - $ Screensaver ("\xf254", T.fgColor, T.backdropFgColor) + $ Screensaver (fontifyText IconSmall "\xf254", colors) } lockCmd :: CmdSpec @@ -203,15 +205,20 @@ lockCmd = CmdSpec { csAlias = "locks" , csRunnable = Run $ Locks - [ "-N", "\xf8a5" - , "-n", xmobarColor T.backdropFgColor "" "\xf8a5" - , "-C", "\xf657" - , "-c", xmobarColor T.backdropFgColor "" "\xf657" + [ "-N", numIcon + , "-n", disabledColor numIcon + , "-C", capIcon + , "-c", disabledColor capIcon , "-s", "" , "-S", "" , "-d", " " ] } + where + numIcon = fontify "\xf8a5" + capIcon = fontify "\xf657" + fontify = fontifyText IconXLarge + disabledColor = xmobarFGColor T.backdropFgColor dateCmd :: CmdSpec dateCmd = CmdSpec @@ -229,6 +236,8 @@ dateCmd = CmdSpec -- which case ethernet interfaces always start with "en" and wireless -- interfaces always start with "wl" +type BarFeature = Feature CmdSpec + isWireless :: String -> Bool isWireless ('w':'l':_) = True isWireless _ = False @@ -301,8 +310,6 @@ getBattery = Feature , ftrWarning = Default } -type BarFeature = Feature CmdSpec - getVPN :: Maybe Client -> BarFeature getVPN client = Feature { ftrDepTree = DBusTree (Single (const vpnCmd)) client [vpnDep] [dp] @@ -361,11 +368,64 @@ getAllCommands right = do , brRight = catMaybes right } +-------------------------------------------------------------------------------- +-- | fonts + +data Font = Text + | IconSmall + | IconMedium + | IconLarge + | IconXLarge + deriving (Eq, Enum, Bounded, Show) + +-- font data ~ (offset, fontification string) +fontData :: Font -> (Int, String) +fontData Text = (16, barFont) +fontData IconSmall = (16, nerdFont 13) +fontData IconMedium = (17, nerdFont 15) +fontData IconLarge = (17, nerdFont 18) +fontData IconXLarge = (18, nerdFont 20) + +fontString :: Font -> String +fontString = snd . fontData + +fontOffset :: Font -> Int +fontOffset = fst . fontData + +allFonts :: [Font] +allFonts = enumFrom minBound + +allFontOffsets :: [Int] +allFontOffsets = fontOffset <$> allFonts + +allFontStrings :: [String] +allFontStrings = fontString <$> allFonts + +barFont :: String +barFont = T.fmtFontXFT T.font + { T.family = "DejaVu Sans Mono" + , T.size = Just 11 + , T.weight = Just T.Bold + } + +nerdFont :: Int -> String +nerdFont size = T.fmtFontXFT T.font + { T.family = "Symbols Nerd Font" + , T.size = Nothing + , T.pixelsize = Just size + } + +fontifyText :: Font -> String -> String +fontifyText fnt txt = concat ["", txt, ""] + -------------------------------------------------------------------------------- -- | various formatting things +colors :: Colors +colors = Colors { colorsOn = T.fgColor, colorsOff = T.backdropFgColor } + sep :: String -sep = xmobarColor T.backdropFgColor "" " : " +sep = xmobarFGColor T.backdropFgColor " : " lSep :: Char lSep = '}' @@ -385,28 +445,3 @@ fmtRegions :: BarRegions -> String fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = fmtSpecs l ++ [lSep] ++ fmtSpecs c ++ [rSep] ++ fmtSpecs r -barFont :: String -barFont = T.fmtFontXFT T.font - { T.family = "DejaVu Sans Mono" - , T.size = Just 11 - , T.weight = Just T.Bold - } - -nerdFont :: Int -> String -nerdFont size = T.fmtFontXFT T.font - { T.family = "Symbols Nerd Font" - , T.size = Nothing - , T.pixelsize = Just size - } - -iconFont :: String -iconFont = nerdFont 13 - -iconFontLarge :: String -iconFontLarge = nerdFont 15 - -iconFontXLarge :: String -iconFontXLarge = nerdFont 18 - -iconFontXXLarge :: String -iconFontXXLarge = nerdFont 20 diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index 34b6de1..5344fa1 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -93,16 +93,14 @@ type IconFormatter = (Maybe Bool -> Bool -> String) type Icons = (String, String) -type Colors = (String, String) - displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO () displayIcon callback formatter = callback . uncurry formatter <=< readState -- TODO maybe I want this to fail when any of the device statuses are Nothing iconFormatter :: Icons -> Colors -> IconFormatter -iconFormatter (iconConn, iconDisc) (colorOn, colorOff) powered connected = - maybe na (chooseColor icon colorOn colorOff) powered +iconFormatter (iconConn, iconDisc) cs powered connected = + maybe na (\p -> colorText cs p icon) powered where icon = if connected then iconConn else iconDisc diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index 5b09185..06ad8fe 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -1,14 +1,16 @@ module Xmobar.Plugins.Common - ( chooseColor + ( colorText , startListener , procSignalMatch , na , fromSingletonVariant , withDBusClientConnection , Callback + , Colors(..) , displayMaybe , displayMaybe' + , xmobarFGColor ) where @@ -22,6 +24,12 @@ import XMonad.Hooks.DynamicLog (xmobarColor) type Callback = String -> IO () +data Colors = Colors + { colorsOn :: String + , colorsOff :: String + } + deriving (Eq, Show, Read) + startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant]) -> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback -> Client -> IO () @@ -35,9 +43,12 @@ startListener rule getProp fromSignal toColor cb client = do procSignalMatch :: Callback -> (a -> IO String) -> SignalMatch a -> IO () procSignalMatch cb f = withSignalMatch (displayMaybe cb f) -chooseColor :: String -> String -> String -> Bool -> String -chooseColor text colorOn colorOff state = - xmobarColor (if state then colorOn else colorOff) "" text +colorText :: Colors -> Bool -> String -> String +colorText Colors { colorsOn = c } True = xmobarFGColor c +colorText Colors { colorsOff = c } False = xmobarFGColor c + +xmobarFGColor :: String -> String -> String +xmobarFGColor c = xmobarColor c "" na :: String na = "N/A" diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs index f186056..e0aa723 100644 --- a/lib/Xmobar/Plugins/Device.hs +++ b/lib/Xmobar/Plugins/Device.hs @@ -21,7 +21,7 @@ import XMonad.Internal.Dependency import Xmobar import Xmobar.Plugins.Common -newtype Device = Device (String, String, String, String) deriving (Read, Show) +newtype Device = Device (String, String, Colors) deriving (Read, Show) nmBus :: BusName nmBus = busName_ "org.freedesktop.NetworkManager" @@ -59,8 +59,8 @@ matchStatus :: [Variant] -> SignalMatch Word32 matchStatus = matchPropertyChanged nmDeviceInterface devSignal instance Exec Device where - alias (Device (iface, _, _, _)) = iface - start (Device (iface, text, colorOn, colorOff)) cb = do + alias (Device (iface, _, _)) = iface + start (Device (iface, text, colors)) cb = do withDBusClientConnection True cb $ \client -> do path <- getDevice client iface displayMaybe' cb (listener client) path @@ -70,4 +70,4 @@ instance Exec Device where -- TODO warn the user here rather than silently drop the listener forM_ rule $ \r -> startListener r (getDeviceConnected path) matchStatus chooseColor' cb client - chooseColor' = return . chooseColor text colorOn colorOff . (> 1) + chooseColor' = return . (\s -> colorText colors s text) . (> 1) diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 6ac0738..d44913c 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -14,17 +14,17 @@ import Xmobar import XMonad.Internal.DBus.Screensaver import Xmobar.Plugins.Common -newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show) +newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show) ssAlias :: String ssAlias = "screensaver" instance Exec Screensaver where alias (Screensaver _) = ssAlias - start (Screensaver (text, colorOn, colorOff)) cb = do + start (Screensaver (text, colors)) cb = do withDBusClientConnection False cb $ \c -> do matchSignal display c display =<< callQuery c where - display = displayMaybe cb $ return . chooseColor text colorOn colorOff + display = displayMaybe cb $ return . (\s -> colorText colors s text) diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index 1c6f2af..0177a90 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -18,7 +18,7 @@ import XMonad.Internal.Dependency import Xmobar import Xmobar.Plugins.Common -newtype VPN = VPN (String, String, String) deriving (Read, Show) +newtype VPN = VPN (String, Colors) deriving (Read, Show) vpnBus :: BusName vpnBus = busName_ "org.freedesktop.NetworkManager" @@ -40,7 +40,7 @@ vpnDep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType instance Exec VPN where alias (VPN _) = vpnAlias - start (VPN (text, colorOn, colorOff)) cb = + start (VPN (text, colors)) cb = withDBusClientConnection True cb $ \c -> do rule <- matchPropertyFull c vpnBus (Just vpnPath) -- TODO intelligently warn user @@ -48,4 +48,4 @@ instance Exec VPN where where getProp = callPropertyGet vpnBus vpnPath vpnInterface $ memberName_ vpnConnType fromSignal = matchPropertyChanged vpnInterface vpnConnType - chooseColor' = return . chooseColor text colorOn colorOff . ("vpn" ==) + chooseColor' = return . (\s -> colorText colors s text) . ("vpn" ==)