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 DBus.Client
|
||||
import DBus.Internal
|
||||
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import System.IO.Error
|
||||
-- import System.Process
|
||||
-- ( readProcessWithExitCode
|
||||
-- )
|
||||
|
||||
import Xmobar.Plugins.Bluetooth
|
||||
import Xmobar.Plugins.ClevoKeyboard
|
||||
|
|
@ -42,6 +38,7 @@ import XMonad.Hooks.DynamicLog (wrap)
|
|||
import XMonad.Internal.Command.Power (hasBattery)
|
||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||
import XMonad.Internal.DBus.Control
|
||||
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
||||
import XMonad.Internal.Dependency
|
||||
import XMonad.Internal.Process
|
||||
|
|
@ -50,30 +47,82 @@ import XMonad.Internal.Process
|
|||
)
|
||||
import XMonad.Internal.Shell
|
||||
import qualified XMonad.Internal.Theme as T
|
||||
import Xmobar
|
||||
import Xmobar hiding
|
||||
( iconOffset
|
||||
)
|
||||
import Xmobar.Plugins.Common
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
sysClient <- getDBusClient True
|
||||
sesClient <- getDBusClient False
|
||||
ff <- evalFonts
|
||||
cs <- getAllCommands =<< rightPlugins sysClient sesClient
|
||||
d <- cfgDir <$> getDirectories
|
||||
db <- connectDBus
|
||||
c <- evalConfig db
|
||||
disconnectDBus db
|
||||
-- this is needed to prevent waitForProcess error when forking in plugins (eg
|
||||
-- alsacmd)
|
||||
_ <- installHandler sigCHLD Default Nothing
|
||||
-- this is needed to see any printed messages
|
||||
hFlush stdout
|
||||
mapM_ (maybe skip disconnect) [sysClient, sesClient]
|
||||
xmobar $ config ff cs d
|
||||
xmobar c
|
||||
|
||||
config :: (BarFont -> BarMetaFont) -> BarRegions -> String -> Config
|
||||
config ff br confDir = defaultConfig
|
||||
{ font = fontString ff firstFont
|
||||
, additionalFonts = fontString ff <$> restFonts
|
||||
, textOffset = fontOffset ff firstFont
|
||||
, textOffsets = fontOffset ff <$> restFonts
|
||||
evalConfig :: DBusState -> IO Config
|
||||
evalConfig db = do
|
||||
cs <- getAllCommands =<< rightPlugins db
|
||||
bf <- getTextFont
|
||||
(ifs, ios) <- getIconFonts
|
||||
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
|
||||
, fgColor = T.fgColor
|
||||
, position = BottomSize C 100 24
|
||||
|
|
@ -96,6 +145,121 @@ config ff br confDir = defaultConfig
|
|||
, 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
|
||||
|
||||
|
|
@ -124,15 +288,17 @@ wirelessCmd iface = CmdSpec
|
|||
] 5
|
||||
}
|
||||
|
||||
ethernetCmd :: String -> CmdSpec
|
||||
ethernetCmd iface = CmdSpec
|
||||
ethernetCmd :: Bool -> String -> CmdSpec
|
||||
ethernetCmd icon iface = CmdSpec
|
||||
{ csAlias = iface
|
||||
, 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 = CmdSpec
|
||||
batteryCmd :: Bool -> CmdSpec
|
||||
batteryCmd icon = CmdSpec
|
||||
{ csAlias = "battery"
|
||||
, csRunnable = Run
|
||||
$ Battery
|
||||
|
|
@ -144,64 +310,75 @@ batteryCmd = CmdSpec
|
|||
, "--high", T.fgColor
|
||||
, "--"
|
||||
, "-P"
|
||||
, "-o" , fontify "\xf0e7"
|
||||
, "-O" , fontify "\xf1e6"
|
||||
, "-i" , fontify "\xf1e6"
|
||||
, "-o" , fontify "\xf0e7" "BAT"
|
||||
, "-O" , fontify "\xf1e6" "AC"
|
||||
, "-i" , fontify "\xf1e6" "AC"
|
||||
] 50
|
||||
}
|
||||
where
|
||||
fontify = fontifyText IconSmall
|
||||
fontify i t = if icon then fontifyText IconSmall i else t ++ ": "
|
||||
|
||||
vpnCmd :: CmdSpec
|
||||
vpnCmd = CmdSpec
|
||||
vpnCmd :: Bool -> CmdSpec
|
||||
vpnCmd icon = CmdSpec
|
||||
{ csAlias = vpnAlias
|
||||
, csRunnable = Run $ VPN (fontifyText IconMedium "\xf023", colors)
|
||||
}
|
||||
|
||||
btCmd :: CmdSpec
|
||||
btCmd = CmdSpec
|
||||
{ csAlias = btAlias
|
||||
, csRunnable = Run
|
||||
$ Bluetooth (fontify "\xf5b0", fontify "\xf5ae") colors
|
||||
, csRunnable = Run $ VPN (text, colors)
|
||||
}
|
||||
where
|
||||
fontify = fontifyText IconLarge
|
||||
text = if icon then fontifyText IconMedium "\xf023" else "VPN"
|
||||
|
||||
alsaCmd :: CmdSpec
|
||||
alsaCmd = CmdSpec
|
||||
btCmd :: Bool -> 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"
|
||||
, csRunnable = Run
|
||||
$ Alsa "default" "Master"
|
||||
[ "-t", "<status><volume>%"
|
||||
, "--"
|
||||
, "-O", fontifyText IconSmall "\xf028"
|
||||
, "-o", fontifyText IconSmall "\xf026 "
|
||||
-- TODO just make this gray when muted
|
||||
, "-O", fontify "\xf028" "+"
|
||||
, "-o", fontify "\xf026" "-" ++ " "
|
||||
, "-c", T.fgColor
|
||||
, "-C", T.fgColor
|
||||
]
|
||||
}
|
||||
where
|
||||
fontify i t = if icon then fontifyText IconSmall i else "VOL" ++ t
|
||||
|
||||
blCmd :: CmdSpec
|
||||
blCmd = CmdSpec
|
||||
blCmd :: Bool -> CmdSpec
|
||||
blCmd icon = CmdSpec
|
||||
{ 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 = CmdSpec
|
||||
ckCmd :: Bool -> CmdSpec
|
||||
ckCmd icon = CmdSpec
|
||||
{ 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 = CmdSpec
|
||||
ssCmd :: Bool -> CmdSpec
|
||||
ssCmd icon = CmdSpec
|
||||
{ csAlias = ssAlias
|
||||
, csRunnable = Run
|
||||
$ Screensaver (fontifyText IconSmall "\xf254", colors)
|
||||
$ Screensaver (text, colors)
|
||||
}
|
||||
where
|
||||
text = if icon then fontifyText IconSmall "\xf254" else "SS"
|
||||
|
||||
lockCmd :: CmdSpec
|
||||
lockCmd = CmdSpec
|
||||
lockCmd :: Bool -> CmdSpec
|
||||
lockCmd icon = CmdSpec
|
||||
{ csAlias = "locks"
|
||||
, csRunnable = Run
|
||||
$ Locks
|
||||
|
|
@ -215,9 +392,9 @@ lockCmd = CmdSpec
|
|||
]
|
||||
}
|
||||
where
|
||||
numIcon = fontify "\xf8a5"
|
||||
capIcon = fontify "\xf657"
|
||||
fontify = fontifyText IconXLarge
|
||||
numIcon = fontify "\xf8a5" "N"
|
||||
capIcon = fontify "\xf657" "C"
|
||||
fontify i t = if icon then fontifyText IconXLarge i else t
|
||||
disabledColor = xmobarFGColor T.backdropFgColor
|
||||
|
||||
dateCmd :: CmdSpec
|
||||
|
|
@ -227,17 +404,12 @@ dateCmd = CmdSpec
|
|||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | command runtime checks and setup
|
||||
--
|
||||
-- some commands depend on the presence of interfaces that can only be
|
||||
-- determined at runtime; define these checks here
|
||||
-- | low-level testing functions
|
||||
--
|
||||
-- in the case of network interfaces, assume that the system uses systemd in
|
||||
-- which case ethernet interfaces always start with "en" and wireless
|
||||
-- interfaces always start with "wl"
|
||||
|
||||
type BarFeature = Sometimes CmdSpec
|
||||
|
||||
isWireless :: String -> Bool
|
||||
isWireless ('w':'l':_) = True
|
||||
isWireless _ = False
|
||||
|
|
@ -273,137 +445,45 @@ vpnPresent =
|
|||
++ show c ++ ": " ++ err
|
||||
go (Left e) = Just $ show e
|
||||
|
||||
xmobarDBus :: String -> DBusDependency_ -> CmdSpec -> Maybe Client -> BarFeature
|
||||
xmobarDBus n dep cmd cl = sometimesDBus cl n "xmobar dbus interface"
|
||||
(Only_ dep) $ const cmd
|
||||
--------------------------------------------------------------------------------
|
||||
-- | text font
|
||||
--
|
||||
-- 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]
|
||||
rightPlugins sysClient sesClient = mapM evalFeature
|
||||
[ Left getWireless
|
||||
, Left $ getEthernet sysClient
|
||||
, 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
|
||||
}
|
||||
getTextFont :: IO String
|
||||
getTextFont = do
|
||||
fb <- evalAlways textFont
|
||||
return $ fb textFontData
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | fonts
|
||||
-- | icon fonts
|
||||
|
||||
data BarFont = Text
|
||||
| IconSmall
|
||||
getIconFonts :: IO ([String], [Int])
|
||||
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
|
||||
| IconLarge
|
||||
| IconXLarge
|
||||
deriving (Eq, Enum, Bounded, Show)
|
||||
|
||||
data BarMetaFont = BarMetaFont
|
||||
{ bfOffset :: Int
|
||||
, bfBuilder :: T.FontBuilder
|
||||
, bfFontData :: T.FontData
|
||||
}
|
||||
iconFonts :: [BarFont]
|
||||
iconFonts = enumFrom minBound
|
||||
|
||||
fontString :: (BarFont -> BarMetaFont) -> BarFont -> String
|
||||
fontString f bf = b d
|
||||
where
|
||||
b = bfBuilder $ f bf
|
||||
d = bfFontData $ f bf
|
||||
iconString :: T.FontBuilder -> BarFont -> String
|
||||
iconString fb i = fb $ iconFontData $ iconSize i
|
||||
|
||||
fontOffset :: (BarFont -> BarMetaFont) -> BarFont -> Int
|
||||
fontOffset f = bfOffset . f
|
||||
|
||||
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 }
|
||||
iconDependency :: IODependency_
|
||||
iconDependency = IOSometimes_ iconFont
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -82,6 +82,8 @@ module XMonad.Internal.Dependency
|
|||
, pathRW
|
||||
, pathW
|
||||
, sysTest
|
||||
, voidResult
|
||||
, voidRead
|
||||
|
||||
-- misc
|
||||
, shellTest
|
||||
|
|
@ -621,6 +623,15 @@ listToAnds i = foldr (And_ . Only_) (Only_ i)
|
|||
toAnd :: d -> d -> Tree_ d
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -21,11 +21,13 @@ module XMonad.Internal.Theme
|
|||
, FontData(..)
|
||||
, FontBuilder
|
||||
, buildFont
|
||||
, fontTree
|
||||
, fontDependency
|
||||
, fontDependency_
|
||||
, defFontData
|
||||
, defFontDep
|
||||
, defFontTree
|
||||
, fontFeature
|
||||
, fontDependency
|
||||
, tabbedTheme
|
||||
, tabbedFeature
|
||||
, promptTheme
|
||||
|
|
@ -155,6 +157,11 @@ fontDependency :: String -> IODependency FontBuilder
|
|||
fontDependency 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 fam = Or (Only $ fontDependency fam) (Only $ IOConst fallbackFont)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue