ENH check for xset before running screensaver
This commit is contained in:
parent
5ef9f46a0a
commit
d7e5668d21
|
@ -161,4 +161,4 @@ config confDir = defaultConfig
|
||||||
}
|
}
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = xmobar =<< config <$> getXMonadDir
|
main = xmobar . config =<< getXMonadDir
|
||||||
|
|
|
@ -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
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue