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

View File

@ -42,7 +42,7 @@ myOptimusManager = "optimus-manager"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Core commands -- | Core commands
runScreenLock :: IOMaybeX runScreenLock :: IO MaybeX
runScreenLock = spawnIfInstalled myScreenlock runScreenLock = spawnIfInstalled myScreenlock
runPowerOff :: X () runPowerOff :: X ()

View File

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

View File

@ -8,6 +8,7 @@ module XMonad.Internal.DBus.Screensaver
, callToggle , callToggle
, callQuery , callQuery
, matchSignal , matchSignal
, SSControls(..)
) where ) where
import Control.Monad (void) import Control.Monad (void)
@ -20,6 +21,7 @@ import Graphics.X11.Xlib.Display
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.Process import XMonad.Internal.Process
import XMonad.Internal.Shell
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Low-level functions -- | Low-level functions
@ -89,8 +91,18 @@ bodyGetCurrentState _ = Nothing
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported haskell API -- | Exported haskell API
exportScreensaver :: Client -> IO () newtype SSControls = SSControls { ssToggle :: IO () }
exportScreensaver client =
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 export client path defaultInterface
{ interfaceName = interface { interfaceName = interface
, interfaceMethods = , interfaceMethods =
@ -98,6 +110,7 @@ exportScreensaver client =
, autoMethod memQuery query , autoMethod memQuery query
] ]
} }
return $ SSControls { ssToggle = callToggle }
callToggle :: IO () callToggle :: IO ()
callToggle = void $ callMethod $ methodCall path interface memToggle callToggle = void $ callMethod $ methodCall path interface memToggle

View File

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