ENH reuse client when possible
This commit is contained in:
parent
81543cbbbc
commit
be73dd64d3
|
@ -39,6 +39,7 @@ import XMonad.Hooks.DynamicLog
|
||||||
, xmobarColor
|
, xmobarColor
|
||||||
)
|
)
|
||||||
import XMonad.Internal.Command.Power (hasBattery)
|
import XMonad.Internal.Command.Power (hasBattery)
|
||||||
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
-- import XMonad.Internal.DBus.Common (xmonadBus)
|
-- import XMonad.Internal.DBus.Common (xmonadBus)
|
||||||
|
@ -273,7 +274,7 @@ rightPlugins =
|
||||||
, evalFeature getAlsa
|
, evalFeature getAlsa
|
||||||
, evalFeature getBattery
|
, evalFeature getBattery
|
||||||
, evalFeature getBl
|
, evalFeature getBl
|
||||||
, nocheck ckCmd
|
, evalFeature getCk
|
||||||
, evalFeature getSs
|
, evalFeature getSs
|
||||||
, nocheck lockCmd
|
, nocheck lockCmd
|
||||||
, nocheck dateCmd
|
, nocheck dateCmd
|
||||||
|
@ -340,6 +341,14 @@ getBl = Feature
|
||||||
, ftrChildren = [intelBacklightSignalDep]
|
, ftrChildren = [intelBacklightSignalDep]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
getCk :: BarFeature
|
||||||
|
getCk = Feature
|
||||||
|
{ ftrMaybeAction = ckCmd
|
||||||
|
, ftrName = "Clevo keyboard indicator"
|
||||||
|
, ftrWarning = Default
|
||||||
|
, ftrChildren = [clevoKeyboardSignalDep]
|
||||||
|
}
|
||||||
|
|
||||||
getSs :: BarFeature
|
getSs :: BarFeature
|
||||||
getSs = Feature
|
getSs = Feature
|
||||||
{ ftrMaybeAction = ssCmd
|
{ ftrMaybeAction = ssCmd
|
||||||
|
|
|
@ -549,14 +549,14 @@ externalBindings ts lock =
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "System"
|
, KeyGroup "System"
|
||||||
[ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls
|
[ KeyBinding "M-." "backlight up" $ ib bctlInc
|
||||||
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
|
, KeyBinding "M-," "backlight down" $ ib bctlDec
|
||||||
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
|
, KeyBinding "M-M1-," "backlight min" $ ib bctlMin
|
||||||
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
|
, KeyBinding "M-M1-." "backlight max" $ ib bctlMax
|
||||||
, KeyBinding "M-S-." "keyboard up" $ ioFeature $ bctlInc clevoKeyboardControls
|
, KeyBinding "M-S-." "keyboard up" $ ck bctlInc
|
||||||
, KeyBinding "M-S-," "keyboard down" $ ioFeature $ bctlDec clevoKeyboardControls
|
, KeyBinding "M-S-," "keyboard down" $ ck bctlDec
|
||||||
, KeyBinding "M-S-M1-," "keyboard min" $ ioFeature $ bctlMin clevoKeyboardControls
|
, KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
|
||||||
, KeyBinding "M-S-M1-." "keyboard max" $ ioFeature $ bctlMax clevoKeyboardControls
|
, KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
|
||||||
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
|
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
|
||||||
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||||
|
@ -568,7 +568,12 @@ externalBindings ts lock =
|
||||||
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
|
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
|
||||||
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
|
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
|
||||||
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
|
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
|
||||||
, KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature callToggle
|
, KeyBinding "M-<F11>" "toggle screensaver" $ maybe BlankFeature (ioFeature . callToggle) cl
|
||||||
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
|
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
where
|
||||||
|
cl = tsClient ts
|
||||||
|
brightessControls ctl getter = maybe BlankFeature (ioFeature . getter . ctl) cl
|
||||||
|
ib = brightessControls intelBacklightControls
|
||||||
|
ck = brightessControls clevoKeyboardControls
|
||||||
|
|
|
@ -120,10 +120,10 @@ exportClevoKeyboard :: Client -> FeatureIO
|
||||||
exportClevoKeyboard =
|
exportClevoKeyboard =
|
||||||
brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig
|
brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig
|
||||||
|
|
||||||
clevoKeyboardControls :: BrightnessControls
|
clevoKeyboardControls :: Client -> BrightnessControls
|
||||||
clevoKeyboardControls = brightnessControls clevoKeyboardConfig
|
clevoKeyboardControls = brightnessControls clevoKeyboardConfig
|
||||||
|
|
||||||
callGetBrightnessCK :: IO (Maybe Brightness)
|
callGetBrightnessCK :: Client -> IO (Maybe Brightness)
|
||||||
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
|
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
|
||||||
|
|
||||||
matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
||||||
|
|
|
@ -50,8 +50,8 @@ data BrightnessControls = BrightnessControls
|
||||||
, bctlDec :: FeatureIO
|
, bctlDec :: FeatureIO
|
||||||
}
|
}
|
||||||
|
|
||||||
brightnessControls :: BrightnessConfig a b -> BrightnessControls
|
brightnessControls :: BrightnessConfig a b -> Client -> BrightnessControls
|
||||||
brightnessControls bc =
|
brightnessControls bc client =
|
||||||
BrightnessControls
|
BrightnessControls
|
||||||
{ bctlMax = cb "max brightness" memMax
|
{ bctlMax = cb "max brightness" memMax
|
||||||
, bctlMin = cb "min brightness" memMin
|
, bctlMin = cb "min brightness" memMin
|
||||||
|
@ -59,12 +59,12 @@ brightnessControls bc =
|
||||||
, bctlDec = cb "decrease brightness" memDec
|
, bctlDec = cb "decrease brightness" memDec
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
cb = callBacklight bc
|
cb = callBacklight client bc
|
||||||
|
|
||||||
-- TODO not dry
|
-- TODO not dry
|
||||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
callGetBrightness :: Num c => BrightnessConfig a b -> Client -> IO (Maybe c)
|
||||||
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client = do
|
||||||
reply <- callMethod xmonadBus p i memGet
|
reply <- callMethod client xmonadBusName p i memGet
|
||||||
return $ either (const Nothing) bodyGetBrightness reply
|
return $ either (const Nothing) bodyGetBrightness reply
|
||||||
|
|
||||||
signalDep :: BrightnessConfig a b -> Dependency
|
signalDep :: BrightnessConfig a b -> Dependency
|
||||||
|
@ -131,10 +131,10 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
||||||
where
|
where
|
||||||
sig = signal p i memCur
|
sig = signal p i memCur
|
||||||
|
|
||||||
callBacklight :: BrightnessConfig a b -> String -> MemberName -> FeatureIO
|
callBacklight :: Client -> BrightnessConfig a b -> String -> MemberName -> FeatureIO
|
||||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
||||||
Feature
|
Feature
|
||||||
{ ftrMaybeAction = void $ callMethod xmonadBus p i m
|
{ ftrMaybeAction = void $ callMethod client xmonadBusName p i m
|
||||||
, ftrName = unwords [n, controlName]
|
, ftrName = unwords [n, controlName]
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
, ftrChildren = [xDbusDep p i $ Method_ m]
|
, ftrChildren = [xDbusDep p i $ Method_ m]
|
||||||
|
|
|
@ -102,10 +102,10 @@ exportIntelBacklight :: Client -> FeatureIO
|
||||||
exportIntelBacklight =
|
exportIntelBacklight =
|
||||||
brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
|
brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
|
||||||
|
|
||||||
intelBacklightControls :: BrightnessControls
|
intelBacklightControls :: Client -> BrightnessControls
|
||||||
intelBacklightControls = brightnessControls intelBacklightConfig
|
intelBacklightControls = brightnessControls intelBacklightConfig
|
||||||
|
|
||||||
callGetBrightnessIB :: IO (Maybe Brightness)
|
callGetBrightnessIB :: Client -> IO (Maybe Brightness)
|
||||||
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
||||||
|
|
||||||
matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
||||||
|
|
|
@ -120,19 +120,19 @@ exportScreensaver client = Feature
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
callToggle :: FeatureIO
|
callToggle :: Client -> FeatureIO
|
||||||
callToggle = Feature
|
callToggle client = Feature
|
||||||
{ ftrMaybeAction = cmd
|
{ ftrMaybeAction = cmd
|
||||||
, ftrName = "screensaver toggle"
|
, ftrName = "screensaver toggle"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
|
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
cmd = void $ callMethod xmonadBus ssPath interface memToggle
|
cmd = void $ callMethod client xmonadBusName ssPath interface memToggle
|
||||||
|
|
||||||
callQuery :: IO (Maybe SSState)
|
callQuery :: Client -> IO (Maybe SSState)
|
||||||
callQuery = do
|
callQuery client = do
|
||||||
reply <- callMethod xmonadBus ssPath interface memQuery
|
reply <- callMethod client xmonadBusName ssPath interface memQuery
|
||||||
-- return $ reply >>= bodyGetCurrentState
|
-- return $ reply >>= bodyGetCurrentState
|
||||||
return $ either (const Nothing) bodyGetCurrentState reply
|
return $ either (const Nothing) bodyGetCurrentState reply
|
||||||
|
|
||||||
|
|
|
@ -245,17 +245,18 @@ introspectMethod :: MemberName
|
||||||
introspectMethod = memberName_ "Introspect"
|
introspectMethod = memberName_ "Introspect"
|
||||||
|
|
||||||
-- TODO this belongs somewhere else, IDK where tho for now
|
-- TODO this belongs somewhere else, IDK where tho for now
|
||||||
callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant])
|
callMethod :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName
|
||||||
callMethod (Bus usesys bus) path iface mem = do
|
-> IO (Either String [Variant])
|
||||||
client <- if usesys then connectSystem else connectSession
|
callMethod client bus path iface mem = do
|
||||||
reply <- call client (methodCall path iface mem)
|
reply <- call client (methodCall path iface mem)
|
||||||
{ methodCallDestination = Just bus }
|
{ methodCallDestination = Just bus }
|
||||||
disconnect client
|
|
||||||
return $ bimap methodErrorMessage methodReturnBody reply
|
return $ bimap methodErrorMessage methodReturnBody reply
|
||||||
|
|
||||||
busSatisfied :: Bus -> IO (Maybe String)
|
busSatisfied :: Bus -> IO (Maybe String)
|
||||||
busSatisfied (Bus usesystem bus) = do
|
busSatisfied (Bus usesystem bus) = do
|
||||||
ret <- callMethod (Bus usesystem queryBus) queryPath queryIface queryMem
|
client <- if usesystem then connectSystem else connectSession
|
||||||
|
ret <- callMethod client queryBus queryPath queryIface queryMem
|
||||||
|
disconnect client
|
||||||
return $ case ret of
|
return $ case ret of
|
||||||
Left e -> Just e
|
Left e -> Just e
|
||||||
Right b -> let ns = bodyGetNames b in
|
Right b -> let ns = bodyGetNames b in
|
||||||
|
@ -271,8 +272,10 @@ busSatisfied (Bus usesystem bus) = do
|
||||||
bodyGetNames _ = []
|
bodyGetNames _ = []
|
||||||
|
|
||||||
endpointSatisfied :: Bus -> Endpoint -> IO (Maybe String)
|
endpointSatisfied :: Bus -> Endpoint -> IO (Maybe String)
|
||||||
endpointSatisfied b@(Bus _ bus) (Endpoint objpath iface mem) = do
|
endpointSatisfied (Bus u bus) (Endpoint objpath iface mem) = do
|
||||||
ret <- callMethod b objpath introspectInterface introspectMethod
|
client <- if u then connectSystem else connectSession
|
||||||
|
ret <- callMethod client bus objpath introspectInterface introspectMethod
|
||||||
|
disconnect client
|
||||||
return $ case ret of
|
return $ case ret of
|
||||||
Left e -> Just e
|
Left e -> Just e
|
||||||
Right body -> procBody body
|
Right body -> procBody body
|
||||||
|
|
|
@ -14,12 +14,13 @@ module Xmobar.Plugins.ClevoKeyboard
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
|
|
||||||
data ClevoKeyboard = ClevoKeyboard String
|
newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show)
|
||||||
deriving (Read, Show)
|
|
||||||
|
|
||||||
ckAlias :: String
|
ckAlias :: String
|
||||||
ckAlias = "clevokeyboard"
|
ckAlias = "clevokeyboard"
|
||||||
|
@ -28,7 +29,9 @@ instance Exec ClevoKeyboard where
|
||||||
alias (ClevoKeyboard _) = ckAlias
|
alias (ClevoKeyboard _) = ckAlias
|
||||||
start (ClevoKeyboard icon) cb = do
|
start (ClevoKeyboard icon) cb = do
|
||||||
_ <- matchSignalCK $ cb . formatBrightness
|
_ <- matchSignalCK $ cb . formatBrightness
|
||||||
cb . formatBrightness =<< callGetBrightnessCK
|
-- TODO this could fail, and also should try to reuse client objects when
|
||||||
|
-- possible
|
||||||
|
cb . formatBrightness =<< callGetBrightnessCK =<< connectSession
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
formatBrightness = \case
|
formatBrightness = \case
|
||||||
|
|
|
@ -14,6 +14,8 @@ module Xmobar.Plugins.IntelBacklight
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
@ -27,7 +29,7 @@ instance Exec IntelBacklight where
|
||||||
alias (IntelBacklight _) = blAlias
|
alias (IntelBacklight _) = blAlias
|
||||||
start (IntelBacklight icon) cb = do
|
start (IntelBacklight icon) cb = do
|
||||||
_ <- matchSignalIB $ cb . formatBrightness
|
_ <- matchSignalIB $ cb . formatBrightness
|
||||||
cb . formatBrightness =<< callGetBrightnessIB
|
cb . formatBrightness =<< callGetBrightnessIB =<< connectSession
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
formatBrightness = \case
|
formatBrightness = \case
|
||||||
|
|
|
@ -14,13 +14,14 @@ module Xmobar.Plugins.Screensaver
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
import XMonad.Hooks.DynamicLog (xmobarColor)
|
import XMonad.Hooks.DynamicLog (xmobarColor)
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
|
|
||||||
newtype Screensaver = Screensaver (String, String, String)
|
newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show)
|
||||||
deriving (Read, Show)
|
|
||||||
|
|
||||||
ssAlias :: String
|
ssAlias :: String
|
||||||
ssAlias = "screensaver"
|
ssAlias = "screensaver"
|
||||||
|
@ -29,7 +30,7 @@ instance Exec Screensaver where
|
||||||
alias (Screensaver _) = ssAlias
|
alias (Screensaver _) = ssAlias
|
||||||
start (Screensaver (text, colorOn, colorOff)) cb = do
|
start (Screensaver (text, colorOn, colorOff)) cb = do
|
||||||
_ <- matchSignal $ cb . fmtState
|
_ <- matchSignal $ cb . fmtState
|
||||||
cb . fmtState =<< callQuery
|
cb . fmtState =<< callQuery =<< connectSession
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
fmtState = \case
|
fmtState = \case
|
||||||
|
|
Loading…
Reference in New Issue