ENH check for xset before running screensaver

This commit is contained in:
Nathan Dwarshuis 2021-06-20 22:26:58 -04:00
parent 5ef9f46a0a
commit d7e5668d21
6 changed files with 45 additions and 24 deletions

View File

@ -161,4 +161,4 @@ config confDir = defaultConfig
}
main :: IO ()
main = xmobar =<< config <$> getXMonadDir
main = xmobar . config =<< getXMonadDir

View File

@ -46,6 +46,7 @@ import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Process
import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T
@ -65,7 +66,7 @@ import XMonad.Util.WorkspaceCompare
main :: IO ()
main = do
(cl, bc) <- startXMonadService
(cl, bc, sc) <- startXMonadService
(h, p) <- spawnPipe "xmobar"
_ <- forkIO runPowermon
_ <- forkIO runRemovableMon
@ -75,7 +76,7 @@ main = do
, childPIDs = [p]
, childHandles = [h]
}
(ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc ts
(ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc sc ts
mapM_ warnMissing missing
-- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout
@ -482,8 +483,11 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
Ignore -> (Nothing, [])
flagMissing s = "[!!!]" ++ s
externalBindings :: Maybe BacklightControls -> ThreadState -> [KeyGroup (IO MaybeX)]
externalBindings bc ts =
externalBindings :: Maybe BacklightControls
-> MaybeExe SSControls
-> ThreadState
-> [KeyGroup (IO MaybeX)]
externalBindings bc sc ts =
[ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -536,7 +540,7 @@ externalBindings bc ts =
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
, KeyBinding "M-<F11>" "toggle screensaver" $ noCheck runToggleDPMS
, KeyBinding "M-<F11>" "toggle screensaver" $ return $ fmap (io . ssToggle) sc
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
]
]

View File

@ -13,8 +13,9 @@ import DBus.Client
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Shell
startXMonadService :: IO (Client, Maybe BacklightControls)
startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
startXMonadService = do
client <- connectSession
requestResult <- requestName client "org.xmonad" []
@ -22,12 +23,12 @@ startXMonadService = do
-- different
if requestResult /= NamePrimaryOwner then do
putStrLn "Another service owns \"org.xmonad\""
return (client, Nothing)
return (client, Nothing, Ignore)
else do
putStrLn "Started xmonad dbus client"
bc <- exportIntelBacklight client
exportScreensaver client
return (client, bc)
sc <- exportScreensaver client
return (client, bc, sc)
stopXMonadService :: Client -> IO ()
stopXMonadService client = do

View File

@ -8,6 +8,7 @@ module XMonad.Internal.DBus.Screensaver
, callToggle
, callQuery
, matchSignal
, SSControls(..)
) where
import Control.Monad (void)
@ -20,6 +21,7 @@ import Graphics.X11.Xlib.Display
import XMonad.Internal.DBus.Common
import XMonad.Internal.Process
import XMonad.Internal.Shell
--------------------------------------------------------------------------------
-- | Low-level functions
@ -89,8 +91,18 @@ bodyGetCurrentState _ = Nothing
--------------------------------------------------------------------------------
-- | Exported haskell API
exportScreensaver :: Client -> IO ()
exportScreensaver client =
newtype SSControls = SSControls { ssToggle :: IO () }
exportScreensaver :: Client -> IO (MaybeExe SSControls)
exportScreensaver client = do
d <- depInstalled dep
if d then flip Installed [] <$> exportScreensaver' client
else return $ Missing [dep]
where
dep = exe "xset"
exportScreensaver' :: Client -> IO SSControls
exportScreensaver' client = do
export client path defaultInterface
{ interfaceName = interface
, interfaceMethods =
@ -98,6 +110,7 @@ exportScreensaver client =
, autoMethod memQuery query
]
}
return $ SSControls { ssToggle = callToggle }
callToggle :: IO ()
callToggle = void $ callMethod $ methodCall path interface memToggle

View File

@ -6,11 +6,11 @@ module XMonad.Internal.Shell
, UnitType(..)
, Dependency(..)
, MaybeX
, IOMaybeX
, exe
, systemUnit
, userUnit
, runIfInstalled
, depInstalled
, warnMissing
, whenInstalled
, ifInstalled
@ -74,11 +74,14 @@ systemUnit = unit SystemUnit
userUnit :: String -> Dependency
userUnit = unit UserUnit
data MaybeExe m = Installed (m ()) [Dependency] | Missing [Dependency] | Ignore
data MaybeExe a = Installed a [Dependency] | Missing [Dependency] | Ignore
type MaybeX = MaybeExe X
instance Functor MaybeExe where
fmap f (Installed x ds) = Installed (f x) ds
fmap _ (Missing x) = Missing x
fmap _ Ignore = Ignore
type IOMaybeX = IO MaybeX
type MaybeX = MaybeExe (X ())
warnMissing :: Dependency -> IO ()
warnMissing Dependency {depRequired = r, depName = n, depType = t } =
@ -110,30 +113,30 @@ depInstalled Dependency { depName = n, depType = t } =
filterMissing :: [Dependency] -> IO [Dependency]
filterMissing = filterM (fmap not . depInstalled)
runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe m)
runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe (m ()))
runIfInstalled ds x = do
missing <- filterMissing ds
return $ if not $ any depRequired missing
then Installed x $ filter (not . depRequired) missing
else Missing missing
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
whenInstalled :: Monad m => MaybeExe m -> m ()
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
whenInstalled = flip ifInstalled skip
ifInstalled :: Monad m => MaybeExe m -> m () -> m ()
ifInstalled :: MaybeExe a -> a -> a
ifInstalled (Installed x _) _ = x
ifInstalled _ alt = alt
skip :: Monad m => m ()
skip = return ()
noCheck :: Monad m => a () -> m (MaybeExe a)
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
noCheck = return . flip Installed []
--------------------------------------------------------------------------------
@ -148,7 +151,7 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
soundDir :: FilePath
soundDir = "sound"
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
spawnSound file pre post = runIfInstalled [exe "paplay"]
$ pre >> playSound file >> post