ENH use logging in dbus connect
This commit is contained in:
parent
c94d83f41e
commit
7821140dc2
|
@ -28,8 +28,7 @@ import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Display
|
import Graphics.X11.Xlib.Display
|
||||||
import Graphics.X11.Xlib.Event
|
import Graphics.X11.Xlib.Event
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
import Graphics.X11.Xlib.Types
|
import XMonad.Internal.IO
|
||||||
import RIO hiding (Display)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Data structure for the ClientMessage
|
-- Data structure for the ClientMessage
|
||||||
|
@ -64,13 +63,6 @@ splitXMsg (x : xs) = (xtype, tag)
|
||||||
xtype = toEnum $ fromIntegral x
|
xtype = toEnum $ fromIntegral x
|
||||||
tag = chr . fromIntegral <$> takeWhile (/= 0) xs
|
tag = chr . fromIntegral <$> takeWhile (/= 0) xs
|
||||||
|
|
||||||
withOpenDisplay :: (Display -> IO a) -> IO a
|
|
||||||
withOpenDisplay = bracket (openDisplay "") cleanup
|
|
||||||
where
|
|
||||||
cleanup dpy = do
|
|
||||||
flush dpy
|
|
||||||
closeDisplay dpy
|
|
||||||
|
|
||||||
-- | Emit a ClientMessage event to the X server with the given type and payloud
|
-- | Emit a ClientMessage event to the X server with the given type and payloud
|
||||||
sendXMsg :: XMsgType -> String -> IO ()
|
sendXMsg :: XMsgType -> String -> IO ()
|
||||||
sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
|
sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
|
||||||
|
|
|
@ -96,9 +96,6 @@ data WConf = WConf
|
||||||
|
|
||||||
type W a = RIO WConf ()
|
type W a = RIO WConf ()
|
||||||
|
|
||||||
withOpenDisplay :: (Display -> IO a) -> IO a
|
|
||||||
withOpenDisplay = bracket (openDisplay "") closeDisplay
|
|
||||||
|
|
||||||
runWorkspaceMon :: [DynWorkspace] -> IO ()
|
runWorkspaceMon :: [DynWorkspace] -> IO ()
|
||||||
runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
|
runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
|
||||||
root <- rootWindow dpy $ defaultScreen dpy
|
root <- rootWindow dpy $ defaultScreen dpy
|
||||||
|
|
|
@ -18,9 +18,9 @@ import qualified DBus.Introspection as I
|
||||||
import Data.Internal.DBus
|
import Data.Internal.DBus
|
||||||
import Data.Internal.Dependency
|
import Data.Internal.Dependency
|
||||||
import Graphics.X11.XScreenSaver
|
import Graphics.X11.XScreenSaver
|
||||||
import Graphics.X11.Xlib.Display
|
|
||||||
import RIO
|
import RIO
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
|
import XMonad.Internal.IO
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -31,7 +31,7 @@ type SSState = Bool -- true is enabled
|
||||||
ssExecutable :: FilePath
|
ssExecutable :: FilePath
|
||||||
ssExecutable = "xset"
|
ssExecutable = "xset"
|
||||||
|
|
||||||
toggle :: IO SSState
|
toggle :: MonadUnliftIO m => m SSState
|
||||||
toggle = do
|
toggle = do
|
||||||
st <- query
|
st <- query
|
||||||
let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
|
let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
|
||||||
|
@ -40,12 +40,9 @@ toggle = do
|
||||||
rc <- runProcess (proc ssExecutable $ "s" : args)
|
rc <- runProcess (proc ssExecutable $ "s" : args)
|
||||||
return $ if rc == ExitSuccess then not st else st
|
return $ if rc == ExitSuccess then not st else st
|
||||||
|
|
||||||
query :: IO SSState
|
query :: MonadUnliftIO m => m SSState
|
||||||
query = do
|
query = do
|
||||||
-- TODO bracket the display
|
xssi <- withOpenDisplay (liftIO . xScreenSaverQueryInfo)
|
||||||
dpy <- openDisplay ""
|
|
||||||
xssi <- xScreenSaverQueryInfo dpy
|
|
||||||
closeDisplay dpy
|
|
||||||
return $ case xssi of
|
return $ case xssi of
|
||||||
Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
|
Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
|
||||||
Just XScreenSaverInfo {xssi_state = _} -> True
|
Just XScreenSaverInfo {xssi_state = _} -> True
|
||||||
|
@ -101,7 +98,7 @@ exportScreensaver ses =
|
||||||
where
|
where
|
||||||
cmd cl =
|
cmd cl =
|
||||||
let cl' = toClient cl
|
let cl' = toClient cl
|
||||||
in liftIO $
|
in withRunInIO $ \run ->
|
||||||
export
|
export
|
||||||
cl'
|
cl'
|
||||||
ssPath
|
ssPath
|
||||||
|
@ -109,7 +106,7 @@ exportScreensaver ses =
|
||||||
{ interfaceName = interface
|
{ interfaceName = interface
|
||||||
, interfaceMethods =
|
, interfaceMethods =
|
||||||
[ autoMethod memToggle $ emitState cl' =<< toggle
|
[ autoMethod memToggle $ emitState cl' =<< toggle
|
||||||
, autoMethod memQuery query
|
, autoMethod memQuery (run query)
|
||||||
]
|
]
|
||||||
, interfaceSignals = [sig]
|
, interfaceSignals = [sig]
|
||||||
}
|
}
|
||||||
|
|
|
@ -22,11 +22,15 @@ module XMonad.Internal.IO
|
||||||
, PermResult (..)
|
, PermResult (..)
|
||||||
, getPermissionsSafe
|
, getPermissionsSafe
|
||||||
, waitUntilExit
|
, waitUntilExit
|
||||||
|
, withOpenDisplay
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import RIO
|
import Graphics.X11.Xlib.Display
|
||||||
|
import Graphics.X11.Xlib.Event
|
||||||
|
import Graphics.X11.Xlib.Types
|
||||||
|
import RIO hiding (Display)
|
||||||
import RIO.Directory
|
import RIO.Directory
|
||||||
import RIO.FilePath
|
import RIO.FilePath
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
|
@ -168,3 +172,10 @@ waitUntilExit pid = do
|
||||||
when res $ do
|
when res $ do
|
||||||
threadDelay 100000
|
threadDelay 100000
|
||||||
waitUntilExit pid
|
waitUntilExit pid
|
||||||
|
|
||||||
|
withOpenDisplay :: MonadUnliftIO m => (Display -> m a) -> m a
|
||||||
|
withOpenDisplay = bracket (liftIO $ openDisplay "") cleanup
|
||||||
|
where
|
||||||
|
cleanup dpy = liftIO $ do
|
||||||
|
flush dpy
|
||||||
|
closeDisplay dpy
|
||||||
|
|
Loading…
Reference in New Issue