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