From d7e5668d21e8931fe7ab014c71d30f25c6d18922 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 20 Jun 2021 22:26:58 -0400 Subject: [PATCH] ENH check for xset before running screensaver --- bin/xmobar.hs | 2 +- bin/xmonad.hs | 14 +++++++++----- lib/XMonad/Internal/Command/Power.hs | 2 +- lib/XMonad/Internal/DBus/Control.hs | 9 +++++---- lib/XMonad/Internal/DBus/Screensaver.hs | 17 +++++++++++++++-- lib/XMonad/Internal/Shell.hs | 25 ++++++++++++++----------- 6 files changed, 45 insertions(+), 24 deletions(-) diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 8ccb615..a8ccdd6 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -161,4 +161,4 @@ config confDir = defaultConfig } main :: IO () -main = xmobar =<< config <$> getXMonadDir +main = xmobar . config =<< getXMonadDir diff --git a/bin/xmonad.hs b/bin/xmonad.hs index a2cf6c9..9d71ca6 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -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 "" "select/launch app" runAppMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu @@ -536,7 +540,7 @@ externalBindings bc ts = , KeyBinding "M-" "select autorandr profile" runAutorandrMenu , KeyBinding "M-" "toggle ethernet" runToggleEthernet , KeyBinding "M-" "toggle bluetooth" runToggleBluetooth - , KeyBinding "M-" "toggle screensaver" $ noCheck runToggleDPMS + , KeyBinding "M-" "toggle screensaver" $ return $ fmap (io . ssToggle) sc , KeyBinding "M-" "switch gpu" runOptimusPrompt ] ] diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index 50861bd..1eee5a4 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -42,7 +42,7 @@ myOptimusManager = "optimus-manager" -------------------------------------------------------------------------------- -- | Core commands -runScreenLock :: IOMaybeX +runScreenLock :: IO MaybeX runScreenLock = spawnIfInstalled myScreenlock runPowerOff :: X () diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index b84e144..2604618 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -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 diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 34c538b..4575aa5 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -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 diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index 6a4479c..7c666bb 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -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