FIX disconnect from all clients
This commit is contained in:
parent
7ae05272e7
commit
f7ef373f78
|
@ -45,6 +45,9 @@ class SafeClient c where
|
||||||
|
|
||||||
getDBusClient :: IO (Maybe c)
|
getDBusClient :: IO (Maybe c)
|
||||||
|
|
||||||
|
disconnectDBusClient :: c -> IO ()
|
||||||
|
disconnectDBusClient = disconnect . toClient
|
||||||
|
|
||||||
withDBusClient :: (c -> IO a) -> IO (Maybe a)
|
withDBusClient :: (c -> IO a) -> IO (Maybe a)
|
||||||
withDBusClient f = do
|
withDBusClient f = do
|
||||||
client <- getDBusClient
|
client <- getDBusClient
|
||||||
|
|
|
@ -43,34 +43,35 @@ connectDBus = do
|
||||||
sys <- getDBusClient
|
sys <- getDBusClient
|
||||||
return DBusState { dbSesClient = ses, dbSysClient = sys }
|
return DBusState { dbSesClient = ses, dbSysClient = sys }
|
||||||
|
|
||||||
-- TODO why is this only the session client?
|
|
||||||
-- | Disconnect from the DBus
|
-- | Disconnect from the DBus
|
||||||
disconnectDBus :: DBusState -> IO ()
|
disconnectDBus :: DBusState -> IO ()
|
||||||
disconnectDBus db = forM_ (toClient <$> dbSysClient db) disconnect
|
disconnectDBus db = disc dbSesClient >> disc dbSysClient
|
||||||
|
where
|
||||||
|
disc f = maybe (return ()) disconnectDBusClient $ f db
|
||||||
|
|
||||||
-- | Connect to the DBus and request the XMonad name
|
-- | Connect to the DBus and request the XMonad name
|
||||||
connectDBusX :: IO DBusState
|
connectDBusX :: IO DBusState
|
||||||
connectDBusX = do
|
connectDBusX = do
|
||||||
db <- connectDBus
|
db <- connectDBus
|
||||||
forM_ (toClient <$> dbSesClient db) requestXMonadName
|
forM_ (dbSesClient db) requestXMonadName
|
||||||
return db
|
return db
|
||||||
|
|
||||||
-- | Disconnect from DBus and release the XMonad name
|
-- | Disconnect from DBus and release the XMonad name
|
||||||
disconnectDBusX :: DBusState -> IO ()
|
disconnectDBusX :: DBusState -> IO ()
|
||||||
disconnectDBusX db = do
|
disconnectDBusX db = do
|
||||||
forM_ (toClient <$> dbSesClient db) releaseXMonadName
|
forM_ (dbSesClient db) releaseXMonadName
|
||||||
disconnectDBus db
|
disconnectDBus db
|
||||||
|
|
||||||
-- | All exporter features to be assigned to the DBus
|
-- | All exporter features to be assigned to the DBus
|
||||||
dbusExporters :: [Maybe SesClient -> SometimesIO]
|
dbusExporters :: [Maybe SesClient -> SometimesIO]
|
||||||
dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
|
dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
|
||||||
|
|
||||||
releaseXMonadName :: Client -> IO ()
|
releaseXMonadName :: SesClient -> IO ()
|
||||||
releaseXMonadName cl = void $ releaseName cl xmonadBusName
|
releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
|
||||||
|
|
||||||
requestXMonadName :: Client -> IO ()
|
requestXMonadName :: SesClient -> IO ()
|
||||||
requestXMonadName client = do
|
requestXMonadName ses = do
|
||||||
res <- requestName client xmonadBusName []
|
res <- requestName (toClient ses) xmonadBusName []
|
||||||
-- TODO if the client is not released on shutdown the owner will be different
|
-- TODO if the client is not released on shutdown the owner will be different
|
||||||
let msg | res == NamePrimaryOwner = Nothing
|
let msg | res == NamePrimaryOwner = Nothing
|
||||||
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
|
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
|
||||||
|
@ -80,6 +81,3 @@ requestXMonadName client = do
|
||||||
forM_ msg putStrLn
|
forM_ msg putStrLn
|
||||||
where
|
where
|
||||||
xn = "'" ++ formatBusName xmonadBusName ++ "'"
|
xn = "'" ++ formatBusName xmonadBusName ++ "'"
|
||||||
|
|
||||||
-- executeExporters :: Maybe Client -> IO ()
|
|
||||||
-- executeExporters cl = mapM_ (\f -> executeSometimes $ f cl) dbusExporters
|
|
||||||
|
|
Loading…
Reference in New Issue