ENH make xmobar plugins crap out when icon font doesn't exist
This commit is contained in:
parent
05c0b6a116
commit
3644efe205
440
bin/xmobar.hs
440
bin/xmobar.hs
|
@ -16,15 +16,11 @@ import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal
|
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
-- import System.Process
|
|
||||||
-- ( readProcessWithExitCode
|
|
||||||
-- )
|
|
||||||
|
|
||||||
import Xmobar.Plugins.Bluetooth
|
import Xmobar.Plugins.Bluetooth
|
||||||
import Xmobar.Plugins.ClevoKeyboard
|
import Xmobar.Plugins.ClevoKeyboard
|
||||||
|
@ -42,6 +38,7 @@ import XMonad.Hooks.DynamicLog (wrap)
|
||||||
import XMonad.Internal.Command.Power (hasBattery)
|
import XMonad.Internal.Command.Power (hasBattery)
|
||||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
@ -50,30 +47,82 @@ import XMonad.Internal.Process
|
||||||
)
|
)
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
import Xmobar
|
import Xmobar hiding
|
||||||
|
( iconOffset
|
||||||
|
)
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
sysClient <- getDBusClient True
|
db <- connectDBus
|
||||||
sesClient <- getDBusClient False
|
c <- evalConfig db
|
||||||
ff <- evalFonts
|
disconnectDBus db
|
||||||
cs <- getAllCommands =<< rightPlugins sysClient sesClient
|
|
||||||
d <- cfgDir <$> getDirectories
|
|
||||||
-- this is needed to prevent waitForProcess error when forking in plugins (eg
|
-- this is needed to prevent waitForProcess error when forking in plugins (eg
|
||||||
-- alsacmd)
|
-- alsacmd)
|
||||||
_ <- installHandler sigCHLD Default Nothing
|
_ <- installHandler sigCHLD Default Nothing
|
||||||
-- this is needed to see any printed messages
|
-- this is needed to see any printed messages
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
mapM_ (maybe skip disconnect) [sysClient, sesClient]
|
xmobar c
|
||||||
xmobar $ config ff cs d
|
|
||||||
|
|
||||||
config :: (BarFont -> BarMetaFont) -> BarRegions -> String -> Config
|
evalConfig :: DBusState -> IO Config
|
||||||
config ff br confDir = defaultConfig
|
evalConfig db = do
|
||||||
{ font = fontString ff firstFont
|
cs <- getAllCommands =<< rightPlugins db
|
||||||
, additionalFonts = fontString ff <$> restFonts
|
bf <- getTextFont
|
||||||
, textOffset = fontOffset ff firstFont
|
(ifs, ios) <- getIconFonts
|
||||||
, textOffsets = fontOffset ff <$> restFonts
|
d <- cfgDir <$> getDirectories
|
||||||
|
return $ config bf ifs ios cs d
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | toplevel configuration
|
||||||
|
|
||||||
|
-- | The text font family
|
||||||
|
textFont :: Always T.FontBuilder
|
||||||
|
textFont = T.fontFeature "XMobar Text Font" "DejaVu Sans Mono"
|
||||||
|
|
||||||
|
-- | Offset of the text in the bar
|
||||||
|
textFontOffset :: Int
|
||||||
|
textFontOffset = 16
|
||||||
|
|
||||||
|
-- | Attributes for the bar font (size, weight, etc)
|
||||||
|
textFontData :: T.FontData
|
||||||
|
textFontData = T.defFontData { T.weight = Just T.Bold, T.size = Just 11 }
|
||||||
|
|
||||||
|
-- | The icon font family
|
||||||
|
iconFont :: Sometimes T.FontBuilder
|
||||||
|
iconFont = sometimes1 "XMobar Icon Font" sfn root
|
||||||
|
where
|
||||||
|
fam = "Symbols Nerd Font"
|
||||||
|
sfn = "Font family for " ++ singleQuote fam
|
||||||
|
root = IORoot id $ T.fontTree fam
|
||||||
|
|
||||||
|
-- | Offsets for the icons in the bar (relative to the text offset)
|
||||||
|
iconOffset :: BarFont -> Int
|
||||||
|
iconOffset IconSmall = 0
|
||||||
|
iconOffset IconMedium = 1
|
||||||
|
iconOffset IconLarge = 1
|
||||||
|
iconOffset IconXLarge = 2
|
||||||
|
|
||||||
|
-- | Sizes (in pixels) for the icon fonts
|
||||||
|
iconSize :: BarFont -> Int
|
||||||
|
iconSize IconSmall = 13
|
||||||
|
iconSize IconMedium = 15
|
||||||
|
iconSize IconLarge = 18
|
||||||
|
iconSize IconXLarge = 20
|
||||||
|
|
||||||
|
-- | Attributes for icon fonts
|
||||||
|
iconFontData :: Int -> T.FontData
|
||||||
|
iconFontData s = T.defFontData { T.pixelsize = Just s, T.size = Nothing }
|
||||||
|
|
||||||
|
-- | Global configuration
|
||||||
|
-- Note that the 'font' and 'textOffset' are assumed to pertain to one (and
|
||||||
|
-- only one) text font, and all other fonts are icon fonts. If this assumption
|
||||||
|
-- changes the code will need to change significantly
|
||||||
|
config :: String -> [String] -> [Int] -> BarRegions -> FilePath -> Config
|
||||||
|
config bf ifs ios br confDir = defaultConfig
|
||||||
|
{ font = bf
|
||||||
|
, additionalFonts = ifs
|
||||||
|
, textOffset = textFontOffset
|
||||||
|
, textOffsets = ios
|
||||||
, bgColor = T.bgColor
|
, bgColor = T.bgColor
|
||||||
, fgColor = T.fgColor
|
, fgColor = T.fgColor
|
||||||
, position = BottomSize C 100 24
|
, position = BottomSize C 100 24
|
||||||
|
@ -96,6 +145,121 @@ config ff br confDir = defaultConfig
|
||||||
, commands = csRunnable <$> concatRegions br
|
, commands = csRunnable <$> concatRegions br
|
||||||
}
|
}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | plugin features
|
||||||
|
--
|
||||||
|
-- some commands depend on the presence of interfaces that can only be
|
||||||
|
-- determined at runtime; define these checks here
|
||||||
|
|
||||||
|
getAllCommands :: [Maybe CmdSpec] -> IO BarRegions
|
||||||
|
getAllCommands right = do
|
||||||
|
let left =
|
||||||
|
[ CmdSpec
|
||||||
|
{ csAlias = "UnsafeStdinReader"
|
||||||
|
, csRunnable = Run UnsafeStdinReader
|
||||||
|
}
|
||||||
|
]
|
||||||
|
return $ BarRegions
|
||||||
|
{ brLeft = left
|
||||||
|
, brCenter = []
|
||||||
|
, brRight = catMaybes right
|
||||||
|
}
|
||||||
|
|
||||||
|
rightPlugins :: DBusState -> IO [Maybe CmdSpec]
|
||||||
|
rightPlugins DBusState { dbSesClient = ses, dbSysClient = sys }
|
||||||
|
= mapM evalFeature
|
||||||
|
[ Left getWireless
|
||||||
|
, Left $ getEthernet sys
|
||||||
|
, Left $ getVPN sys
|
||||||
|
, Left $ getBt sys
|
||||||
|
, Left getAlsa
|
||||||
|
, Left getBattery
|
||||||
|
, Left $ getBl ses
|
||||||
|
, Left $ getCk ses
|
||||||
|
, Left $ getSs ses
|
||||||
|
, Right getLock
|
||||||
|
, always' "date indicator" dateCmd
|
||||||
|
]
|
||||||
|
where
|
||||||
|
always' n = Right . Always n . Always_ . FallbackAlone
|
||||||
|
|
||||||
|
type BarFeature = Sometimes CmdSpec
|
||||||
|
|
||||||
|
getWireless :: BarFeature
|
||||||
|
getWireless = sometimes1 "wireless status indicator" "sysfs path"
|
||||||
|
$ IORoot wirelessCmd
|
||||||
|
$ Only $ readInterface "get wifi interface" isWireless
|
||||||
|
|
||||||
|
getEthernet :: Maybe Client -> BarFeature
|
||||||
|
getEthernet cl = iconDBus "ethernet status indicator" root tree
|
||||||
|
where
|
||||||
|
root useIcon tree' = DBusRoot (const . ethernetCmd useIcon) tree' cl
|
||||||
|
tree = And1 (Only readEth) (Only_ devDep)
|
||||||
|
readEth = readInterface "read ethernet interface" isEthernet
|
||||||
|
|
||||||
|
getBattery :: BarFeature
|
||||||
|
getBattery = iconIO_ "battery level indicator" root tree
|
||||||
|
where
|
||||||
|
root useIcon = IORoot_ (batteryCmd useIcon)
|
||||||
|
tree = Only_ $ sysTest "Test if battery is present" hasBattery
|
||||||
|
|
||||||
|
getVPN :: Maybe Client -> BarFeature
|
||||||
|
getVPN cl = iconDBus_ "VPN status indicator" root $ toAnd vpnDep test
|
||||||
|
where
|
||||||
|
root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
|
||||||
|
test = DBusIO $ sysTest "Use nmcli to test if VPN is present" vpnPresent
|
||||||
|
|
||||||
|
getBt :: Maybe Client -> BarFeature
|
||||||
|
getBt = xmobarDBus "bluetooth status indicator" btDep btCmd
|
||||||
|
|
||||||
|
getAlsa :: BarFeature
|
||||||
|
getAlsa = iconIO_ "volume level indicator" root $ Only_ $ sysExe "alsactl"
|
||||||
|
where
|
||||||
|
root useIcon = IORoot_ (alsaCmd useIcon)
|
||||||
|
|
||||||
|
getBl :: Maybe Client -> BarFeature
|
||||||
|
getBl = xmobarDBus "Intel backlight indicator" intelBacklightSignalDep blCmd
|
||||||
|
|
||||||
|
getCk :: Maybe Client -> BarFeature
|
||||||
|
getCk = xmobarDBus "Clevo keyboard indicator" clevoKeyboardSignalDep ckCmd
|
||||||
|
|
||||||
|
getSs :: Maybe Client -> BarFeature
|
||||||
|
getSs = xmobarDBus "screensaver indicator" ssSignalDep ssCmd
|
||||||
|
|
||||||
|
getLock :: Always CmdSpec
|
||||||
|
getLock = always1 "lock indicator" "icon indicator" root $ lockCmd False
|
||||||
|
where
|
||||||
|
root = IORoot_ (lockCmd True) $ Only_ iconDependency
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | bar feature constructors
|
||||||
|
|
||||||
|
xmobarDBus :: String -> DBusDependency_ -> (Bool -> CmdSpec) -> Maybe Client -> BarFeature
|
||||||
|
xmobarDBus n dep cmd cl = iconDBus_ n root (Only_ dep)
|
||||||
|
where
|
||||||
|
root useIcon tree = DBusRoot_ (const $ cmd useIcon) tree cl
|
||||||
|
|
||||||
|
iconIO_ :: String -> (Bool -> IOTree_ -> Root CmdSpec) -> IOTree_ -> BarFeature
|
||||||
|
iconIO_ = iconSometimes' And_ Only_
|
||||||
|
|
||||||
|
iconDBus :: String -> (Bool -> DBusTree p -> Root CmdSpec)
|
||||||
|
-> DBusTree p -> BarFeature
|
||||||
|
iconDBus = iconSometimes' And1 $ Only_ . DBusIO
|
||||||
|
|
||||||
|
iconDBus_ :: String -> (Bool -> DBusTree_ -> Root CmdSpec) -> DBusTree_
|
||||||
|
-> BarFeature
|
||||||
|
iconDBus_ = iconSometimes' And_ $ Only_ . DBusIO
|
||||||
|
|
||||||
|
iconSometimes' :: (t -> t_ -> t) -> (IODependency_ -> t_) -> String
|
||||||
|
-> (Bool -> t -> Root CmdSpec) -> t -> BarFeature
|
||||||
|
iconSometimes' c d n r t = Sometimes n
|
||||||
|
[ Subfeature icon "icon indicator" Error
|
||||||
|
, Subfeature text "text indicator" Error
|
||||||
|
]
|
||||||
|
where
|
||||||
|
icon = r True $ c t $ d iconDependency
|
||||||
|
text = r False t
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | command specifications
|
-- | command specifications
|
||||||
|
|
||||||
|
@ -124,15 +288,17 @@ wirelessCmd iface = CmdSpec
|
||||||
] 5
|
] 5
|
||||||
}
|
}
|
||||||
|
|
||||||
ethernetCmd :: String -> CmdSpec
|
ethernetCmd :: Bool -> String -> CmdSpec
|
||||||
ethernetCmd iface = CmdSpec
|
ethernetCmd icon iface = CmdSpec
|
||||||
{ csAlias = iface
|
{ csAlias = iface
|
||||||
, csRunnable = Run
|
, csRunnable = Run
|
||||||
$ Device (iface, fontifyText IconMedium "\xf0e8", colors)
|
$ Device (iface, text, colors)
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
text = if icon then fontifyText IconMedium "\xf0e8" else "ETH"
|
||||||
|
|
||||||
batteryCmd :: CmdSpec
|
batteryCmd :: Bool -> CmdSpec
|
||||||
batteryCmd = CmdSpec
|
batteryCmd icon = CmdSpec
|
||||||
{ csAlias = "battery"
|
{ csAlias = "battery"
|
||||||
, csRunnable = Run
|
, csRunnable = Run
|
||||||
$ Battery
|
$ Battery
|
||||||
|
@ -144,64 +310,75 @@ batteryCmd = CmdSpec
|
||||||
, "--high", T.fgColor
|
, "--high", T.fgColor
|
||||||
, "--"
|
, "--"
|
||||||
, "-P"
|
, "-P"
|
||||||
, "-o" , fontify "\xf0e7"
|
, "-o" , fontify "\xf0e7" "BAT"
|
||||||
, "-O" , fontify "\xf1e6"
|
, "-O" , fontify "\xf1e6" "AC"
|
||||||
, "-i" , fontify "\xf1e6"
|
, "-i" , fontify "\xf1e6" "AC"
|
||||||
] 50
|
] 50
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
fontify = fontifyText IconSmall
|
fontify i t = if icon then fontifyText IconSmall i else t ++ ": "
|
||||||
|
|
||||||
vpnCmd :: CmdSpec
|
vpnCmd :: Bool -> CmdSpec
|
||||||
vpnCmd = CmdSpec
|
vpnCmd icon = CmdSpec
|
||||||
{ csAlias = vpnAlias
|
{ csAlias = vpnAlias
|
||||||
, csRunnable = Run $ VPN (fontifyText IconMedium "\xf023", colors)
|
, csRunnable = Run $ VPN (text, colors)
|
||||||
}
|
|
||||||
|
|
||||||
btCmd :: CmdSpec
|
|
||||||
btCmd = CmdSpec
|
|
||||||
{ csAlias = btAlias
|
|
||||||
, csRunnable = Run
|
|
||||||
$ Bluetooth (fontify "\xf5b0", fontify "\xf5ae") colors
|
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
fontify = fontifyText IconLarge
|
text = if icon then fontifyText IconMedium "\xf023" else "VPN"
|
||||||
|
|
||||||
alsaCmd :: CmdSpec
|
btCmd :: Bool -> CmdSpec
|
||||||
alsaCmd = CmdSpec
|
btCmd icon = CmdSpec
|
||||||
|
{ csAlias = btAlias
|
||||||
|
, csRunnable = Run
|
||||||
|
$ Bluetooth (fontify "\xf5b0" "+", fontify "\xf5ae" "-") colors
|
||||||
|
}
|
||||||
|
where
|
||||||
|
fontify i t = if icon then fontifyText IconLarge i else "BT" ++ t
|
||||||
|
|
||||||
|
alsaCmd :: Bool -> CmdSpec
|
||||||
|
alsaCmd icon = CmdSpec
|
||||||
{ csAlias = "alsa:default:Master"
|
{ csAlias = "alsa:default:Master"
|
||||||
, csRunnable = Run
|
, csRunnable = Run
|
||||||
$ Alsa "default" "Master"
|
$ Alsa "default" "Master"
|
||||||
[ "-t", "<status><volume>%"
|
[ "-t", "<status><volume>%"
|
||||||
, "--"
|
, "--"
|
||||||
, "-O", fontifyText IconSmall "\xf028"
|
-- TODO just make this gray when muted
|
||||||
, "-o", fontifyText IconSmall "\xf026 "
|
, "-O", fontify "\xf028" "+"
|
||||||
|
, "-o", fontify "\xf026" "-" ++ " "
|
||||||
, "-c", T.fgColor
|
, "-c", T.fgColor
|
||||||
, "-C", T.fgColor
|
, "-C", T.fgColor
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
fontify i t = if icon then fontifyText IconSmall i else "VOL" ++ t
|
||||||
|
|
||||||
blCmd :: CmdSpec
|
blCmd :: Bool -> CmdSpec
|
||||||
blCmd = CmdSpec
|
blCmd icon = CmdSpec
|
||||||
{ csAlias = blAlias
|
{ csAlias = blAlias
|
||||||
, csRunnable = Run $ IntelBacklight $ fontifyText IconSmall "\xf185"
|
, csRunnable = Run $ IntelBacklight text
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
text = if icon then fontifyText IconSmall "\xf185" else "BL: "
|
||||||
|
|
||||||
ckCmd :: CmdSpec
|
ckCmd :: Bool -> CmdSpec
|
||||||
ckCmd = CmdSpec
|
ckCmd icon = CmdSpec
|
||||||
{ csAlias = ckAlias
|
{ csAlias = ckAlias
|
||||||
, csRunnable = Run $ ClevoKeyboard $ fontifyText IconSmall "\xf40b"
|
, csRunnable = Run $ ClevoKeyboard text
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
text = if icon then fontifyText IconSmall "\xf40b" else "KB: "
|
||||||
|
|
||||||
ssCmd :: CmdSpec
|
ssCmd :: Bool -> CmdSpec
|
||||||
ssCmd = CmdSpec
|
ssCmd icon = CmdSpec
|
||||||
{ csAlias = ssAlias
|
{ csAlias = ssAlias
|
||||||
, csRunnable = Run
|
, csRunnable = Run
|
||||||
$ Screensaver (fontifyText IconSmall "\xf254", colors)
|
$ Screensaver (text, colors)
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
text = if icon then fontifyText IconSmall "\xf254" else "SS"
|
||||||
|
|
||||||
lockCmd :: CmdSpec
|
lockCmd :: Bool -> CmdSpec
|
||||||
lockCmd = CmdSpec
|
lockCmd icon = CmdSpec
|
||||||
{ csAlias = "locks"
|
{ csAlias = "locks"
|
||||||
, csRunnable = Run
|
, csRunnable = Run
|
||||||
$ Locks
|
$ Locks
|
||||||
|
@ -215,9 +392,9 @@ lockCmd = CmdSpec
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
numIcon = fontify "\xf8a5"
|
numIcon = fontify "\xf8a5" "N"
|
||||||
capIcon = fontify "\xf657"
|
capIcon = fontify "\xf657" "C"
|
||||||
fontify = fontifyText IconXLarge
|
fontify i t = if icon then fontifyText IconXLarge i else t
|
||||||
disabledColor = xmobarFGColor T.backdropFgColor
|
disabledColor = xmobarFGColor T.backdropFgColor
|
||||||
|
|
||||||
dateCmd :: CmdSpec
|
dateCmd :: CmdSpec
|
||||||
|
@ -227,17 +404,12 @@ dateCmd = CmdSpec
|
||||||
}
|
}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | command runtime checks and setup
|
-- | low-level testing functions
|
||||||
--
|
|
||||||
-- some commands depend on the presence of interfaces that can only be
|
|
||||||
-- determined at runtime; define these checks here
|
|
||||||
--
|
--
|
||||||
-- in the case of network interfaces, assume that the system uses systemd in
|
-- in the case of network interfaces, assume that the system uses systemd in
|
||||||
-- which case ethernet interfaces always start with "en" and wireless
|
-- which case ethernet interfaces always start with "en" and wireless
|
||||||
-- interfaces always start with "wl"
|
-- interfaces always start with "wl"
|
||||||
|
|
||||||
type BarFeature = Sometimes CmdSpec
|
|
||||||
|
|
||||||
isWireless :: String -> Bool
|
isWireless :: String -> Bool
|
||||||
isWireless ('w':'l':_) = True
|
isWireless ('w':'l':_) = True
|
||||||
isWireless _ = False
|
isWireless _ = False
|
||||||
|
@ -273,137 +445,45 @@ vpnPresent =
|
||||||
++ show c ++ ": " ++ err
|
++ show c ++ ": " ++ err
|
||||||
go (Left e) = Just $ show e
|
go (Left e) = Just $ show e
|
||||||
|
|
||||||
xmobarDBus :: String -> DBusDependency_ -> CmdSpec -> Maybe Client -> BarFeature
|
--------------------------------------------------------------------------------
|
||||||
xmobarDBus n dep cmd cl = sometimesDBus cl n "xmobar dbus interface"
|
-- | text font
|
||||||
(Only_ dep) $ const cmd
|
--
|
||||||
|
-- ASSUME there is only one text font for this entire configuration. This
|
||||||
|
-- will correspond to the first font/offset parameters in the config record.
|
||||||
|
|
||||||
rightPlugins :: Maybe Client -> Maybe Client -> IO [Maybe CmdSpec]
|
getTextFont :: IO String
|
||||||
rightPlugins sysClient sesClient = mapM evalFeature
|
getTextFont = do
|
||||||
[ Left getWireless
|
fb <- evalAlways textFont
|
||||||
, Left $ getEthernet sysClient
|
return $ fb textFontData
|
||||||
, Left $ getVPN sysClient
|
|
||||||
, Left $ getBt sysClient
|
|
||||||
, Left getAlsa
|
|
||||||
, Left getBattery
|
|
||||||
, Left $ getBl sesClient
|
|
||||||
, Left $ getCk sesClient
|
|
||||||
, Left $ getSs sesClient
|
|
||||||
, always' "lock indicator" lockCmd
|
|
||||||
, always' "date indicator" dateCmd
|
|
||||||
]
|
|
||||||
where
|
|
||||||
always' n = Right . Always n . Always_ . FallbackAlone
|
|
||||||
|
|
||||||
getWireless :: BarFeature
|
|
||||||
getWireless = sometimes1 "wireless status indicator" "sysfs path"
|
|
||||||
$ IORoot wirelessCmd
|
|
||||||
$ Only $ readInterface "get wifi interface" isWireless
|
|
||||||
|
|
||||||
getEthernet :: Maybe Client -> BarFeature
|
|
||||||
getEthernet client = sometimes1 "ethernet status indicator" "sysfs path"
|
|
||||||
$ DBusRoot (const . ethernetCmd) tree client
|
|
||||||
where
|
|
||||||
tree = And1 (Only readEth) (Only_ devDep)
|
|
||||||
readEth = readInterface "read ethernet interface" isEthernet
|
|
||||||
|
|
||||||
getBattery :: BarFeature
|
|
||||||
getBattery = sometimesIO_ "battery level indicator" "sysfs path"
|
|
||||||
(Only_ $ sysTest "Test if battery is present" hasBattery)
|
|
||||||
batteryCmd
|
|
||||||
|
|
||||||
getVPN :: Maybe Client -> BarFeature
|
|
||||||
getVPN client = sometimesDBus client "VPN status indicator"
|
|
||||||
"xmobar dbus interface" (toAnd vpnDep test) (const vpnCmd)
|
|
||||||
where
|
|
||||||
test = DBusIO $ sysTest "Use nmcli to test if VPN is present" vpnPresent
|
|
||||||
|
|
||||||
getBt :: Maybe Client -> BarFeature
|
|
||||||
getBt = xmobarDBus "bluetooth status indicator" btDep btCmd
|
|
||||||
|
|
||||||
getAlsa :: BarFeature
|
|
||||||
getAlsa = sometimesIO_ "volume level indicator" "alsactl"
|
|
||||||
(Only_ $ sysExe "alsactl") alsaCmd
|
|
||||||
|
|
||||||
getBl :: Maybe Client -> BarFeature
|
|
||||||
getBl = xmobarDBus "Intel backlight indicator" intelBacklightSignalDep blCmd
|
|
||||||
|
|
||||||
getCk :: Maybe Client -> BarFeature
|
|
||||||
getCk = xmobarDBus "Clevo keyboard indicator" clevoKeyboardSignalDep ckCmd
|
|
||||||
|
|
||||||
getSs :: Maybe Client -> BarFeature
|
|
||||||
getSs = xmobarDBus "screensaver indicator" ssSignalDep ssCmd
|
|
||||||
|
|
||||||
getAllCommands :: [Maybe CmdSpec] -> IO BarRegions
|
|
||||||
getAllCommands right = do
|
|
||||||
let left =
|
|
||||||
[ CmdSpec
|
|
||||||
{ csAlias = "UnsafeStdinReader"
|
|
||||||
, csRunnable = Run UnsafeStdinReader
|
|
||||||
}
|
|
||||||
]
|
|
||||||
return $ BarRegions
|
|
||||||
{ brLeft = left
|
|
||||||
, brCenter = []
|
|
||||||
, brRight = catMaybes right
|
|
||||||
}
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | fonts
|
-- | icon fonts
|
||||||
|
|
||||||
data BarFont = Text
|
getIconFonts :: IO ([String], [Int])
|
||||||
| IconSmall
|
getIconFonts = do
|
||||||
|
fb <- evalSometimes iconFont
|
||||||
|
return $ maybe ([], []) apply fb
|
||||||
|
where
|
||||||
|
apply fb = unzip $ (\i -> (iconString fb i, iconOffset i + textFontOffset))
|
||||||
|
<$> iconFonts
|
||||||
|
|
||||||
|
data BarFont = IconSmall
|
||||||
| IconMedium
|
| IconMedium
|
||||||
| IconLarge
|
| IconLarge
|
||||||
| IconXLarge
|
| IconXLarge
|
||||||
deriving (Eq, Enum, Bounded, Show)
|
deriving (Eq, Enum, Bounded, Show)
|
||||||
|
|
||||||
data BarMetaFont = BarMetaFont
|
iconFonts :: [BarFont]
|
||||||
{ bfOffset :: Int
|
iconFonts = enumFrom minBound
|
||||||
, bfBuilder :: T.FontBuilder
|
|
||||||
, bfFontData :: T.FontData
|
|
||||||
}
|
|
||||||
|
|
||||||
fontString :: (BarFont -> BarMetaFont) -> BarFont -> String
|
iconString :: T.FontBuilder -> BarFont -> String
|
||||||
fontString f bf = b d
|
iconString fb i = fb $ iconFontData $ iconSize i
|
||||||
where
|
|
||||||
b = bfBuilder $ f bf
|
|
||||||
d = bfFontData $ f bf
|
|
||||||
|
|
||||||
fontOffset :: (BarFont -> BarMetaFont) -> BarFont -> Int
|
iconDependency :: IODependency_
|
||||||
fontOffset f = bfOffset . f
|
iconDependency = IOSometimes_ iconFont
|
||||||
|
|
||||||
firstFont :: BarFont
|
|
||||||
firstFont = minBound
|
|
||||||
|
|
||||||
restFonts :: [BarFont]
|
|
||||||
restFonts = enumFrom $ succ minBound
|
|
||||||
|
|
||||||
barFont :: Always T.FontBuilder
|
|
||||||
barFont = T.fontFeature "XMobar Text Font" "DejaVu Sans Mono"
|
|
||||||
|
|
||||||
nerdFont :: Always T.FontBuilder
|
|
||||||
nerdFont = T.fontFeature "XMobar Icon Font" "Symbols Nerd Font"
|
|
||||||
|
|
||||||
evalFonts :: IO (BarFont -> BarMetaFont)
|
|
||||||
evalFonts = do
|
|
||||||
bf <- evalAlways barFont
|
|
||||||
nf <- evalAlways nerdFont
|
|
||||||
return $ fontData bf nf
|
|
||||||
|
|
||||||
fontData :: T.FontBuilder -> T.FontBuilder -> BarFont -> BarMetaFont
|
|
||||||
fontData barBuilder nerdBuilder bf = case bf of
|
|
||||||
Text -> BarMetaFont 16 barBuilder
|
|
||||||
$ T.defFontData { T.weight = Just T.Bold, T.size = Just 11 }
|
|
||||||
IconSmall -> nerd 16 13
|
|
||||||
IconMedium -> nerd 17 15
|
|
||||||
IconLarge -> nerd 17 18
|
|
||||||
IconXLarge -> nerd 18 20
|
|
||||||
where
|
|
||||||
nerd o s = BarMetaFont o nerdBuilder
|
|
||||||
$ T.defFontData { T.pixelsize = Just s, T.size = Nothing }
|
|
||||||
|
|
||||||
fontifyText :: BarFont -> String -> String
|
fontifyText :: BarFont -> String -> String
|
||||||
fontifyText fnt txt = concat ["<fn=", show $ fromEnum fnt, ">", txt, "</fn>"]
|
fontifyText fnt txt = concat ["<fn=", show $ 1 + fromEnum fnt, ">", txt, "</fn>"]
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | various formatting things
|
-- | various formatting things
|
||||||
|
|
|
@ -82,6 +82,8 @@ module XMonad.Internal.Dependency
|
||||||
, pathRW
|
, pathRW
|
||||||
, pathW
|
, pathW
|
||||||
, sysTest
|
, sysTest
|
||||||
|
, voidResult
|
||||||
|
, voidRead
|
||||||
|
|
||||||
-- misc
|
-- misc
|
||||||
, shellTest
|
, shellTest
|
||||||
|
@ -621,6 +623,15 @@ listToAnds i = foldr (And_ . Only_) (Only_ i)
|
||||||
toAnd :: d -> d -> Tree_ d
|
toAnd :: d -> d -> Tree_ d
|
||||||
toAnd a b = And_ (Only_ a) (Only_ b)
|
toAnd a b = And_ (Only_ a) (Only_ b)
|
||||||
|
|
||||||
|
voidResult :: Result p -> Result_
|
||||||
|
voidResult (Left es) = Left es
|
||||||
|
voidResult (Right (PostPass _ ws)) = Right ws
|
||||||
|
|
||||||
|
voidRead :: Result p -> Maybe String
|
||||||
|
voidRead (Left []) = Just "unspecified error"
|
||||||
|
voidRead (Left (e:_)) = Just e
|
||||||
|
voidRead (Right _) = Nothing
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | IO Dependency Constructors
|
-- | IO Dependency Constructors
|
||||||
|
|
||||||
|
|
|
@ -21,11 +21,13 @@ module XMonad.Internal.Theme
|
||||||
, FontData(..)
|
, FontData(..)
|
||||||
, FontBuilder
|
, FontBuilder
|
||||||
, buildFont
|
, buildFont
|
||||||
|
, fontTree
|
||||||
|
, fontDependency
|
||||||
|
, fontDependency_
|
||||||
, defFontData
|
, defFontData
|
||||||
, defFontDep
|
, defFontDep
|
||||||
, defFontTree
|
, defFontTree
|
||||||
, fontFeature
|
, fontFeature
|
||||||
, fontDependency
|
|
||||||
, tabbedTheme
|
, tabbedTheme
|
||||||
, tabbedFeature
|
, tabbedFeature
|
||||||
, promptTheme
|
, promptTheme
|
||||||
|
@ -155,6 +157,11 @@ fontDependency :: String -> IODependency FontBuilder
|
||||||
fontDependency fam =
|
fontDependency fam =
|
||||||
IORead (unwords ["test if font", singleQuote fam, "exists"]) $ testFont fam
|
IORead (unwords ["test if font", singleQuote fam, "exists"]) $ testFont fam
|
||||||
|
|
||||||
|
fontDependency_ :: String -> IODependency_
|
||||||
|
fontDependency_ fam = sysTest n $ voidRead <$> testFont fam
|
||||||
|
where
|
||||||
|
n = unwords ["test if font", singleQuote fam, "exists"]
|
||||||
|
|
||||||
fontTree :: String -> IOTree FontBuilder
|
fontTree :: String -> IOTree FontBuilder
|
||||||
fontTree fam = Or (Only $ fontDependency fam) (Only $ IOConst fallbackFont)
|
fontTree fam = Or (Only $ fontDependency fam) (Only $ IOConst fallbackFont)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue