diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 22ed08d..ae07ecc 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -119,7 +119,7 @@ config confDir = defaultConfig , Run $ Date "%Y-%m-%d %H:%M" "date" 10 - , Run $ Screensaver ("\xf254", T.fgColor, T.fgColor) 10 + , Run $ Screensaver ("\xf254", T.fgColor, T.backdropFgColor) , Run UnsafeStdinReader ] diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 879802b..b174459 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -11,6 +11,7 @@ import Shell import DBus.Common import DBus.IntelBacklight +import DBus.Screensaver import qualified Theme as T @@ -536,11 +537,8 @@ runMaxBacklight = io $ void callMaxBrightness showWorkspace :: WorkspaceId -> X () showWorkspace tag = windows $ W.view tag -enableDPMS :: X () -enableDPMS = spawnCmd "xset" ["s", "on", "+dpms"] - -disableDPMS :: X () -disableDPMS = spawnCmd "xset" ["s", "off", "-dpms"] +toggleDPMS :: X () +toggleDPMS = io $ void callToggle -- keybindings @@ -658,8 +656,7 @@ myKeys hs client c = , ("M-,", addName "backlight down" runDecBacklight) , ("M-M1-,", addName "backlight min" runMinBacklight) , ("M-M1-.", addName "backlight max" runMaxBacklight) - , ("M-M1-=", addName "enable screensaver" enableDPMS) - , ("M-M1--", addName "disable screensaver" disableDPMS) + , ("M-M1-=", addName "toggle screensaver" toggleDPMS) , ("M-", addName "restart xmonad" $ runCleanup hs client >> runRestart) , ("M-S-", addName "recompile xmonad" runRecompile) , ("M-", addName "power menu" myPowerPrompt) diff --git a/lib/DBus/Common.hs b/lib/DBus/Common.hs index c44196a..fd32223 100644 --- a/lib/DBus/Common.hs +++ b/lib/DBus/Common.hs @@ -3,6 +3,7 @@ module DBus.Common where import DBus.IntelBacklight +import DBus.Screensaver import DBus.Client @@ -17,6 +18,7 @@ startXMonadService = do else do putStrLn "Started xmonad dbus client" exportIntelBacklight client + exportScreensaver client return client stopXMonadService :: Client -> IO () diff --git a/lib/DBus/IntelBacklight.hs b/lib/DBus/IntelBacklight.hs index c533283..c9bfd1e 100644 --- a/lib/DBus/IntelBacklight.hs +++ b/lib/DBus/IntelBacklight.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- @@ -208,8 +207,4 @@ callGetBrightness = do matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler matchSignal cb = do client <- connectSession - addMatch client brMatcher $ cb . pullBrightness . signalBody - where - pullBrightness = \case - [b] -> fromVariant b :: Maybe Brightness - _ -> Nothing + addMatch client brMatcher $ cb . signalBrightness . signalBody diff --git a/lib/DBus/Internal.hs b/lib/DBus/Internal.hs new file mode 100644 index 0000000..6a52106 --- /dev/null +++ b/lib/DBus/Internal.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module DBus.Internal where + +import Control.Monad (forM_) + +import DBus +import DBus.Client + +callMethod' :: Client -> MethodCall -> IO (Maybe [Variant]) +callMethod' client mc = do + -- TODO handle clienterrors here + reply <- call client mc { methodCallDestination = Just "org.xmonad" } + return $ case reply of + Left _ -> Nothing + Right ret -> Just $ methodReturnBody ret + +callMethod :: MethodCall -> ([Variant] -> Maybe a) -> IO (Maybe a) +callMethod mc procBody = do + client <- connectSession + body <- callMethod' client mc + return $ body >>= procBody + +callMethodEmit :: MethodCall + -> ([Variant] -> Maybe a) + -> ([Variant] -> Signal) + -> IO (Maybe a) +callMethodEmit mc procBody bodyToSignal = do + client <- connectSession + body <- callMethod' client mc + forM_ body $ emit client . bodyToSignal + return $ body >>= procBody + +addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler +addMatchCallback rule cb = do + client <- connectSession + addMatch client rule $ cb . signalBody diff --git a/lib/DBus/Screensaver.hs b/lib/DBus/Screensaver.hs new file mode 100644 index 0000000..bef8afd --- /dev/null +++ b/lib/DBus/Screensaver.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} + +-------------------------------------------------------------------------------- +-- | DBus module for X11 screensave/DPMS control + +module DBus.Screensaver where + +import DBus +import DBus.Client +import DBus.Internal + +import Graphics.X11.Xlib.Display +import Graphics.X11.XScreenSaver + +import Shell + +import XMonad + +-------------------------------------------------------------------------------- +-- | Low-level functions + +type SSState = Bool -- true is enabled + +toggle :: IO SSState +toggle = do + st <- query + -- TODO figure out how not to do this with shell commands + spawn $ fmtCmd "xset" $ "s" : args st + -- TODO this assumes the command succeeds + return $ not st + where + args s = if s then ["off", "-dpms"] else ["on", "+dpms"] + +query :: IO SSState +query = do + dpy <- openDisplay "" + xssi <- xScreenSaverQueryInfo dpy + print xssi + closeDisplay dpy + return $ case xssi of + Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False + Just XScreenSaverInfo { xssi_state = _ } -> True + -- TODO handle errors better (at least log them?) + Nothing -> False + +-------------------------------------------------------------------------------- +-- | DBus Interface +-- +-- Define two methods to enable/disable the screensaver. These methods will +-- emit signals with the state when called. Define another method to get the +-- current state. + +ssPath :: ObjectPath +ssPath = "/screensaver" + +ssInterface :: InterfaceName +ssInterface = "org.xmonad.Screensaver" + +ssState :: MemberName +ssState = "State" + +ssToggle :: MemberName +ssToggle = "Toggle" + +ssQuery :: MemberName +ssQuery = "Query" + +ssSignal :: Signal +ssSignal = signal ssPath ssInterface ssState + +ssMatcher :: MatchRule +ssMatcher = matchAny + { matchPath = Just ssPath + , matchInterface = Just ssInterface + , matchMember = Just ssState + } + +exportScreensaver :: Client -> IO () +exportScreensaver client = + export client ssPath defaultInterface + { interfaceName = ssInterface + , interfaceMethods = + [ autoMethod ssToggle toggle + , autoMethod ssQuery query + ] + } + +callToggle :: IO (Maybe SSState) +callToggle = callMethodEmit mc bodyState sig + where + mc = methodCall ssPath ssInterface ssToggle + sig b = ssSignal { signalBody = b } + +bodyState :: [Variant] -> Maybe SSState +bodyState [b] = fromVariant b :: Maybe SSState +bodyState _ = Nothing + +callQuery :: IO (Maybe SSState) +callQuery = callMethod mc bodyState + where + mc = methodCall ssPath ssInterface ssQuery + +matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler +matchSignal cb = addMatchCallback ssMatcher $ cb . bodyState diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 4004f31..109e428 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -1,31 +1,26 @@ +{-# LANGUAGE LambdaCase #-} + module Xmobar.Plugins.Screensaver where -import Graphics.X11.Xlib.Display -import Graphics.X11.XScreenSaver +import Control.Concurrent +import Control.Monad + +import DBus.Screensaver import Xmobar -data Screensaver = Screensaver (String, String, String) Int +data Screensaver = Screensaver (String, String, String) deriving (Read, Show) instance Exec Screensaver where - alias (Screensaver _ _) = "screensaver" - run (Screensaver opts _) = run' opts - rate (Screensaver _ r) = r - --- TODO make this respond to events rather than polling -run' :: (String, String, String) -> IO String -run' (text, colorOn, colorOff) = do - dpy <- openDisplay "" - xssi <- xScreenSaverQueryInfo dpy - closeDisplay dpy - return $ case xssi of - Just x -> wrapColor text - $ case xssi_state x of - ScreenSaverDisabled -> colorOff - _ -> colorOn - Nothing -> "N/A" - where - -- TODO not DRY - wrapColor s c = "" ++ s ++ "" + alias (Screensaver _) = "screensaver" + start (Screensaver (text, colorOn, colorOff)) cb = do + _ <- matchSignal $ cb . fmtState + cb . fmtState =<< callQuery + forever (threadDelay 5000) + where + fmtState = \case + Just s -> wrapColor text $ if s then colorOn else colorOff + Nothing -> "N/A" + wrapColor s c = "" ++ s ++ "" diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 6b56cdc..988a7ad 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -12,6 +12,8 @@ library , Shell , DBus.Common , DBus.IntelBacklight + , DBus.Internal + , DBus.Screensaver , Xmobar.Plugins.Screensaver , Xmobar.Plugins.IntelBacklight build-depends: base