diff --git a/bin/xmonad.hs b/bin/xmonad.hs index ab7c10b..82a2c74 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -7,15 +7,18 @@ module Main (main) where import Control.Concurrent -import Control.Monad (unless) +import Control.Monad (unless) import Data.List ( isPrefixOf , sortBy , sortOn ) -import Data.Maybe (isJust, mapMaybe) -import Data.Monoid (All (..)) +import Data.Maybe + ( isJust + , mapMaybe + ) +import Data.Monoid (All (..)) import Graphics.X11.Types import Graphics.X11.Xlib.Atom @@ -45,35 +48,34 @@ import XMonad.Internal.Concurrent.ClientMessage import XMonad.Internal.Concurrent.DynamicWorkspaces import XMonad.Internal.Concurrent.Removable import XMonad.Internal.DBus.Brightness.Common +import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Screensaver import XMonad.Internal.Dependency import XMonad.Internal.Process import XMonad.Internal.Shell -import qualified XMonad.Internal.Theme as T +import qualified XMonad.Internal.Theme as T import XMonad.Layout.MultiToggle import XMonad.Layout.NoBorders import XMonad.Layout.NoFrillsDecoration import XMonad.Layout.PerWorkspace import XMonad.Layout.Renamed import XMonad.Layout.Tabbed -import qualified XMonad.Operations as O -import qualified XMonad.StackSet as W +import qualified XMonad.Operations as O +import qualified XMonad.StackSet as W import XMonad.Util.Cursor import XMonad.Util.EZConfig -import qualified XMonad.Util.ExtensibleState as E +import qualified XMonad.Util.ExtensibleState as E import XMonad.Util.NamedActions import XMonad.Util.WorkspaceCompare main :: IO () main = do - DBusXMonad - { dxClient = cl - , dxIntelBacklightCtrl = bc - , dxScreensaverCtrl = sc - } <- startXMonadService + cl <- startXMonadService (h, p) <- spawnPipe "xmobar" + dbusActions <- mapM evalFeature [exportScreensaver cl, exportIntelBacklight cl] depActions <- mapM evalFeature [runPowermon, runRemovableMon] + mapM_ whenInstalled dbusActions mapM_ (mapM_ forkIO) depActions _ <- forkIO $ runWorkspaceMon allDWs let ts = ThreadState @@ -82,8 +84,8 @@ main = do , childHandles = [h] } lock <- whenInstalled <$> evalFeature runScreenLock - ext <- evalExternal $ externalBindings bc sc ts lock - warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions + ext <- evalExternal $ externalBindings ts lock + warnMissing $ externalToMissing ext ++ fmap (io <$>) (depActions ++ dbusActions) -- IDK why this is necessary; nothing prior to this line will print if missing hFlush stdout launch @@ -496,9 +498,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of (Right x) -> Just $ k{ kbAction = x } (Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip } -externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X () - -> [KeyGroup FeatureX] -externalBindings bc sc ts lock = +externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX] +externalBindings ts lock = [ KeyGroup "Launchers" [ KeyBinding "" "select/launch app" runAppMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu @@ -543,10 +544,10 @@ externalBindings bc sc ts lock = ] , KeyGroup "System" - [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc bc - , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec bc - , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin bc - , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax bc + [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls + , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls + , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls + , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls , KeyBinding "M-" "power menu" $ ConstFeature $ runPowerPrompt lock , KeyBinding "M-" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-" "lock screen" runScreenLock @@ -558,7 +559,7 @@ externalBindings bc sc ts lock = , KeyBinding "M-" "select autorandr profile" runAutorandrMenu , KeyBinding "M-" "toggle ethernet" runToggleEthernet , KeyBinding "M-" "toggle bluetooth" runToggleBluetooth - , KeyBinding "M-" "toggle screensaver" $ ioFeature $ ssToggle sc + , KeyBinding "M-" "toggle screensaver" $ ioFeature callToggle , KeyBinding "M-" "switch gpu" runOptimusPrompt ] ] diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index 0109793..f04d7f9 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -4,7 +4,8 @@ module XMonad.Internal.DBus.Brightness.Common ( BrightnessConfig(..) , BrightnessControls(..) - , exportBrightnessControls + , brightnessControls + , brightnessExporter , callGetBrightness , matchSignal ) where @@ -45,18 +46,16 @@ data BrightnessControls = BrightnessControls , bctlDec :: FeatureIO } -exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b - -> Client -> IO BrightnessControls -exportBrightnessControls deps bc client = - initControls client (brightnessExporter deps bc) controls +brightnessControls :: BrightnessConfig a b -> BrightnessControls +brightnessControls BrightnessConfig { bcPath = p, bcInterface = i } = + BrightnessControls + { bctlMax = cb memMax + , bctlMin = cb memMin + , bctlInc = cb memInc + , bctlDec = cb memDec + } where - controls _ = let callBacklight' = callBacklight bc in - BrightnessControls - { bctlMax = callBacklight' memMax - , bctlMin = callBacklight' memMin - , bctlInc = callBacklight' memInc - , bctlDec = callBacklight' memDec - } + cb = callBacklight p i callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c) callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do @@ -77,24 +76,8 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do -------------------------------------------------------------------------------- -- | Internal DBus Crap --- exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO () --- exportBrightnessControls' bc client = do --- maxval <- bcGetMax bc -- assume the max value will never change --- let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval --- let funget = bcGet bc --- export client (bcPath bc) defaultInterface --- { interfaceName = bcInterface bc --- , interfaceMethods = --- [ autoMethod' memMax bcMax --- , autoMethod' memMin bcMin --- , autoMethod' memInc bcInc --- , autoMethod' memDec bcDec --- , autoMethod memGet (round <$> funget maxval :: IO Int32) --- ] --- } - -brightnessExporter :: RealFrac b => [Dependency] - -> BrightnessConfig a b -> Client -> FeatureIO +brightnessExporter :: RealFrac b => [Dependency] -> BrightnessConfig a b + -> Client -> FeatureIO brightnessExporter deps bc client = Feature { ftrAction = exportBrightnessControls' bc client , ftrSilent = False @@ -123,19 +106,13 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur = where sig = signal p i memCur --- callBacklight :: BrightnessConfig a b -> MemberName -> IO () --- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem = --- void $ callMethod $ methodCall p i mem - -callBacklight :: BrightnessConfig a b -> MemberName -> FeatureIO -callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem = +callBacklight :: ObjectPath -> InterfaceName -> MemberName -> FeatureIO +callBacklight p i m = Feature - { ftrAction = void $ callMethod $ methodCall p i mem + { ftrAction = void $ callMethod $ methodCall p i m , ftrSilent = False - , ftrChildren = [mkDep mem] + , ftrChildren = [xDbusDep p i $ Method_ m] } - where - mkDep = xDbusDep p i . Method_ bodyGetBrightness :: Num a => [Variant] -> Maybe a bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32) diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index 23fc5c1..0bc278b 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -5,6 +5,7 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight ( callGetBrightnessIB , matchSignalIB , exportIntelBacklight + , intelBacklightControls , curFileDep , maxFileDep , blPath @@ -88,9 +89,12 @@ curFileDep = pathRW curFile maxFileDep :: Dependency maxFileDep = pathR maxFile -exportIntelBacklight :: Client -> IO BrightnessControls +exportIntelBacklight :: Client -> FeatureIO exportIntelBacklight = - exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig + brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig + +intelBacklightControls :: BrightnessControls +intelBacklightControls = brightnessControls intelBacklightConfig callGetBrightnessIB :: IO (Maybe Brightness) callGetBrightnessIB = callGetBrightness intelBacklightConfig diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 2d607ad..2ad5429 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -18,10 +18,10 @@ import DBus import DBus.Client import XMonad.Internal.DBus.Brightness.Common -import XMonad.Internal.DBus.Brightness.IntelBacklight +-- import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Screensaver -import XMonad.Internal.Dependency +-- import XMonad.Internal.Dependency introspectInterface :: InterfaceName introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable" @@ -36,37 +36,47 @@ data DBusXMonad = DBusXMonad , dxScreensaverCtrl :: SSControls } -blankControls :: BrightnessControls -blankControls = BrightnessControls - { bctlMax = BlankFeature - , bctlMin = BlankFeature - , bctlInc = BlankFeature - , bctlDec = BlankFeature - } +-- blankControls :: BrightnessControls +-- blankControls = BrightnessControls +-- { bctlMax = BlankFeature +-- , bctlMin = BlankFeature +-- , bctlInc = BlankFeature +-- , bctlDec = BlankFeature +-- } -blankSSToggle :: SSControls -blankSSToggle = SSControls { ssToggle = BlankFeature } +-- blankSSToggle :: SSControls +-- blankSSToggle = SSControls { ssToggle = BlankFeature } -startXMonadService :: IO DBusXMonad +-- xmonadService :: Feature (IO Client) +-- xmonadService = Feature +-- { ftrAction = undefined +-- , ftr + + +startXMonadService :: IO Client startXMonadService = do client <- connectSession - requestResult <- requestName client xmonadBus [] + res <- requestName client xmonadBus [] + case res of + NamePrimaryOwner -> return () + _ -> putStrLn $ "error when requesting '" ++ formatBusName xmonadBus ++ "'" -- TODO if the client is not released on shutdown the owner will be -- different - (i, s) <- if requestResult /= NamePrimaryOwner then do - putStrLn "Another service owns \"org.xmonad\"" - return (blankControls, blankSSToggle) - else do - putStrLn "Started xmonad dbus client" - bc <- exportIntelBacklight client - sc <- exportScreensaver client - return (bc, sc) - return $ DBusXMonad - { dxClient = client - , dxIntelBacklightCtrl = i - -- , dxClevoBacklightCtrl = c - , dxScreensaverCtrl = s - } + -- (i, s) <- if requestResult /= NamePrimaryOwner then do + -- putStrLn "Another service owns \"org.xmonad\"" + -- return (blankControls, blankSSToggle) + -- else do + -- putStrLn "Started xmonad dbus client" + -- bc <- exportIntelBacklight client + -- sc <- exportScreensaver client + -- return (bc, sc) + return client + -- return $ DBusXMonad + -- { dxClient = client + -- , dxIntelBacklightCtrl = i + -- -- , dxClevoBacklightCtrl = c + -- , dxScreensaverCtrl = s + -- } stopXMonadService :: Client -> IO () stopXMonadService client = do diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index e4e1625..f2a6fda 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -99,13 +99,13 @@ bodyGetCurrentState _ = Nothing newtype SSControls = SSControls { ssToggle :: FeatureIO } -exportScreensaver :: Client -> IO SSControls -exportScreensaver client = initControls client exportScreensaver' controls - where - controls _ = SSControls { ssToggle = callToggle } +-- exportScreensaver :: Client -> IO SSControls +-- exportScreensaver client = initControls client exportScreensaver' controls +-- where +-- controls _ = SSControls { ssToggle = callToggle } -exportScreensaver' :: Client -> FeatureIO -exportScreensaver' client = Feature +exportScreensaver :: Client -> FeatureIO +exportScreensaver client = Feature { ftrAction = cmd , ftrSilent = False , ftrChildren = [ssDep] @@ -123,11 +123,10 @@ callToggle :: FeatureIO callToggle = Feature { ftrAction = cmd , ftrSilent = False - , ftrChildren = mkDep <$> [memQuery, memState, memToggle] + , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle] } where cmd = void $ callMethod $ methodCall ssPath interface memToggle - mkDep = xDbusDep ssPath interface . Method_ callQuery :: IO (Maybe SSState) callQuery = do diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs index b657f37..8ef6f9e 100644 --- a/lib/XMonad/Internal/Dependency.hs +++ b/lib/XMonad/Internal/Dependency.hs @@ -55,7 +55,6 @@ data DBusMember = Method_ MemberName | Property_ String deriving (Eq, Show) --- data DependencyData = Executable String data Dependency = Executable String | AccessiblePath FilePath Bool Bool | IOTest (IO (Maybe String)) @@ -68,9 +67,6 @@ data Dependency = Executable String } | Systemd UnitType String --- data Dependency a = SubFeature (Feature a a) --- | Dependency DependencyData - data Feature a = Feature { ftrAction :: a , ftrSilent :: Bool @@ -102,17 +98,14 @@ evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do exe :: String -> Dependency exe = Executable -path :: Bool -> Bool -> String -> Dependency -path r w n = AccessiblePath n r w - pathR :: String -> Dependency -pathR = path True False +pathR n = AccessiblePath n True False pathW :: String -> Dependency -pathW = path False True +pathW n = AccessiblePath n False True pathRW :: String -> Dependency -pathRW = path True True +pathRW n = AccessiblePath n True True systemUnit :: String -> Dependency systemUnit = Systemd SystemUnit