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