ENH make vpn plugin listen to property changed signal

This commit is contained in:
Nathan Dwarshuis 2021-11-24 00:43:58 -05:00
parent 0fe36fcccb
commit d2268da188
5 changed files with 46 additions and 40 deletions

View File

@ -43,7 +43,6 @@ 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.Common import XMonad.Internal.DBus.Common
-- 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.Shell import XMonad.Internal.Shell
@ -155,8 +154,7 @@ batteryCmd = CmdSpec
vpnCmd :: CmdSpec vpnCmd :: CmdSpec
vpnCmd = CmdSpec vpnCmd = CmdSpec
{ csAlias = vpnAlias { csAlias = vpnAlias
, csRunnable = Run , csRunnable = Run $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor)
$ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
} }
btCmd :: CmdSpec btCmd :: CmdSpec
@ -307,12 +305,11 @@ type BarFeature = Feature CmdSpec
getVPN :: Maybe Client -> BarFeature getVPN :: Maybe Client -> BarFeature
getVPN client = Feature getVPN client = Feature
{ ftrDepTree = DBusTree (Single (const vpnCmd)) client [ep] [dp] { ftrDepTree = DBusTree (Single (const vpnCmd)) client [vpnDep] [dp]
, ftrName = "VPN status indicator" , ftrName = "VPN status indicator"
, ftrWarning = Default , ftrWarning = Default
} }
where where
ep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
dp = IOTest vpnPresent dp = IOTest vpnPresent
getBt :: Maybe Client -> BarFeature getBt :: Maybe Client -> BarFeature

View File

@ -14,10 +14,10 @@ import Data.Maybe
import DBus import DBus
import DBus.Client import DBus.Client
import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
import Xmobar import Xmobar
import Xmobar.Plugins.Common
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show) newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
@ -54,10 +54,10 @@ instance Exec Bluetooth where
start (Bluetooth (text, colorOn, colorOff)) cb = do start (Bluetooth (text, colorOn, colorOff)) cb = do
withDBusClientConnection_ True $ \c -> do withDBusClientConnection_ True $ \c -> do
reply <- callGetPowered c reply <- callGetPowered c
cb $ maybe "N/A" chooseColor $ fromVariant =<< listToMaybe reply cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
addMatchCallback (matchProperty btPath) (procMatch cb . matchPowered) c addMatchCallback (matchProperty btPath) (procMatch cb . matchPowered) c
where where
procMatch f (Match on) = f $ chooseColor on procMatch f (Match on) = f $ chooseColor' on
procMatch f Failure = f "N/A" procMatch f Failure = f "N/A"
procMatch _ NoMatch = return () procMatch _ NoMatch = return ()
chooseColor state = xmobarColor (if state then colorOn else colorOff) "" text chooseColor' = chooseColor text colorOn colorOff

View File

@ -0,0 +1,10 @@
module Xmobar.Plugins.Common
(chooseColor)
where
import XMonad.Hooks.DynamicLog (xmobarColor)
chooseColor :: String -> String -> String -> Bool -> String
chooseColor text colorOn colorOff state =
xmobarColor (if state then colorOn else colorOff) "" text

View File

@ -1,6 +1,3 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | VPN plugin -- | VPN plugin
-- --
@ -9,34 +6,29 @@
module Xmobar.Plugins.VPN module Xmobar.Plugins.VPN
( VPN(..) ( VPN(..)
, vpnAlias , vpnAlias
, vpnBus , vpnDep
, vpnPath
, vpnInterface
, vpnConnType
) where ) where
import Data.Maybe
import DBus import DBus
import DBus.Client import DBus.Client
import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
import Xmobar import Xmobar
import Xmobar.Plugins.Common
data VPN = VPN (String, String, String) Int newtype VPN = VPN (String, String, String) deriving (Read, Show)
deriving (Read, Show)
callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client =
getProperty client (methodCall vpnPath vpnInterface $ memberName_ vpnConnType)
{ methodCallDestination = Just vpnBus }
vpnBus :: BusName vpnBus :: BusName
vpnBus = "org.freedesktop.NetworkManager" vpnBus = busName_ "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath vpnPath :: ObjectPath
vpnPath = "/org/freedesktop/NetworkManager" vpnPath = objectPath_ "/org/freedesktop/NetworkManager"
vpnInterface :: InterfaceName vpnInterface :: InterfaceName
vpnInterface = "org.freedesktop.NetworkManager" vpnInterface = interfaceName_ "org.freedesktop.NetworkManager"
vpnConnType :: String vpnConnType :: String
vpnConnType = "PrimaryConnectionType" vpnConnType = "PrimaryConnectionType"
@ -44,18 +36,24 @@ vpnConnType = "PrimaryConnectionType"
vpnAlias :: String vpnAlias :: String
vpnAlias = "vpn" vpnAlias = "vpn"
vpnDep :: DBusDep
vpnDep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
matchConnType :: [Variant] -> SignalMatch String
matchConnType = matchPropertyChanged vpnInterface vpnConnType fromVariant
callGetConnectionType :: Client -> IO [Variant]
callGetConnectionType = callPropertyGet vpnBus vpnPath vpnInterface vpnConnType
instance Exec VPN where instance Exec VPN where
alias (VPN _ _) = vpnAlias alias (VPN _) = vpnAlias
rate (VPN _ r) = r start (VPN (text, colorOn, colorOff)) cb = do
run (VPN (text, colorOn, colorOff) _) = do withDBusClientConnection_ True $ \c -> do
client <- connectSystem reply <- callGetConnectionType c
reply <- callConnectionType client cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
disconnect client addMatchCallback (matchProperty vpnPath) (procMatch cb . matchConnType) c
return $ fmtState $ procReply reply
where where
procReply = \case procMatch f (Match t) = f $ chooseColor' t
Right r -> (fromVariant r :: Maybe String) procMatch f Failure = f "N/A"
Left _ -> Nothing procMatch _ NoMatch = return ()
fmtState = \case chooseColor' = chooseColor text colorOn colorOff . ("vpn" ==)
Just s -> xmobarColor (if s == "vpn" then colorOn else colorOff) "" text
Nothing -> "N/A"

View File

@ -24,6 +24,7 @@ library
, XMonad.Internal.DBus.Control , XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver , XMonad.Internal.DBus.Screensaver
, XMonad.Internal.Process , XMonad.Internal.Process
, Xmobar.Plugins.Common
, Xmobar.Plugins.BacklightCommon , Xmobar.Plugins.BacklightCommon
, Xmobar.Plugins.Bluetooth , Xmobar.Plugins.Bluetooth
, Xmobar.Plugins.ClevoKeyboard , Xmobar.Plugins.ClevoKeyboard