ENH add CLI thingy to print dependencies (kinda)
This commit is contained in:
parent
29c58aec7a
commit
d767dc7bc0
|
@ -14,7 +14,8 @@ import Control.Monad
|
||||||
)
|
)
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
( isPrefixOf
|
( intercalate
|
||||||
|
, isPrefixOf
|
||||||
, sortBy
|
, sortBy
|
||||||
, sortOn
|
, sortOn
|
||||||
)
|
)
|
||||||
|
@ -28,6 +29,7 @@ import Graphics.X11.Types
|
||||||
import Graphics.X11.Xlib.Atom
|
import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
|
import System.Environment
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
|
@ -75,22 +77,27 @@ import XMonad.Util.NamedActions
|
||||||
import XMonad.Util.WorkspaceCompare
|
import XMonad.Util.WorkspaceCompare
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = getArgs >>= parse
|
||||||
sesClient <- startXMonadService
|
|
||||||
sysClient <- getDBusClient True
|
parse :: [String] -> IO ()
|
||||||
|
parse [] = run
|
||||||
|
parse ["--deps"] = printDeps
|
||||||
|
parse _ = usage
|
||||||
|
|
||||||
|
run :: IO ()
|
||||||
|
run = do
|
||||||
|
db <- connectDBus
|
||||||
(h, p) <- spawnPipe "xmobar"
|
(h, p) <- spawnPipe "xmobar"
|
||||||
executeFeature_ $ runRemovableMon sysClient
|
executeFeature_ $ runRemovableMon $ dbSystemClient db
|
||||||
executeFeatureWith_ forkIO_ runPowermon
|
executeFeatureWith_ forkIO_ runPowermon
|
||||||
forkIO_ $ runWorkspaceMon allDWs
|
forkIO_ $ runWorkspaceMon allDWs
|
||||||
let ts = ThreadState
|
let ts = ThreadState
|
||||||
{ tsSessionClient = sesClient
|
{ tsChildPIDs = [p]
|
||||||
, tsSystemClient = sysClient
|
, tsChildHandles = [h]
|
||||||
, tsChildPIDs = [p]
|
}
|
||||||
, tsChildHandles = [h]
|
|
||||||
}
|
|
||||||
lockRes <- evalFeature runScreenLock
|
lockRes <- evalFeature runScreenLock
|
||||||
let lock = whenSatisfied lockRes
|
let lock = whenSatisfied lockRes
|
||||||
ext <- evalExternal $ externalBindings ts lock
|
ext <- evalExternal $ externalBindings ts db lock
|
||||||
-- IDK why this is necessary; nothing prior to this line will print if missing
|
-- IDK why this is necessary; nothing prior to this line will print if missing
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
ds <- getDirectories
|
ds <- getDirectories
|
||||||
|
@ -114,22 +121,54 @@ main = do
|
||||||
where
|
where
|
||||||
forkIO_ = void . forkIO
|
forkIO_ = void . forkIO
|
||||||
|
|
||||||
|
printDeps :: IO ()
|
||||||
|
printDeps = do
|
||||||
|
db <- connectDBus
|
||||||
|
lockRes <- evalFeature runScreenLock
|
||||||
|
let lock = whenSatisfied lockRes
|
||||||
|
mapM_ printDep $ concatMap flatten $ externalBindings ts db lock
|
||||||
|
where
|
||||||
|
ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
|
||||||
|
flatten = concatMap (dtDeps . ftrDepTree . kbMaybeAction) . kgBindings
|
||||||
|
dtDeps (GenTree _ ds) = ds
|
||||||
|
dtDeps (DBusTree _ _ _ ds) = ds
|
||||||
|
printDep (Executable s) = putStrLn s
|
||||||
|
printDep _ = skip
|
||||||
|
|
||||||
|
usage :: IO ()
|
||||||
|
usage = putStrLn $ intercalate "\n"
|
||||||
|
[ "xmonad: run greatest window manager"
|
||||||
|
, "xmonad --deps: print dependencies"
|
||||||
|
]
|
||||||
|
|
||||||
|
connectDBus :: IO DBusState
|
||||||
|
connectDBus = do
|
||||||
|
sesClient <- startXMonadService
|
||||||
|
sysClient <- getDBusClient True
|
||||||
|
return DBusState
|
||||||
|
{ dbSessionClient = sesClient
|
||||||
|
, dbSystemClient = sysClient
|
||||||
|
}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Concurrency configuration
|
-- | Concurrency configuration
|
||||||
|
|
||||||
|
data DBusState = DBusState
|
||||||
|
{ dbSessionClient :: Maybe Client
|
||||||
|
, dbSystemClient :: Maybe Client
|
||||||
|
}
|
||||||
|
|
||||||
data ThreadState = ThreadState
|
data ThreadState = ThreadState
|
||||||
{ tsSessionClient :: Maybe Client
|
{ tsChildPIDs :: [ProcessHandle]
|
||||||
, tsSystemClient :: Maybe Client
|
, tsChildHandles :: [Handle]
|
||||||
, tsChildPIDs :: [ProcessHandle]
|
|
||||||
, tsChildHandles :: [Handle]
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- TODO shouldn't this be run by a signal handler?
|
-- TODO shouldn't this be run by a signal handler?
|
||||||
runCleanup :: ThreadState -> X ()
|
runCleanup :: ThreadState -> DBusState -> X ()
|
||||||
runCleanup ts = io $ do
|
runCleanup ts db = io $ do
|
||||||
mapM_ killHandle $ tsChildPIDs ts
|
mapM_ killHandle $ tsChildPIDs ts
|
||||||
forM_ (tsSessionClient ts) stopXMonadService
|
forM_ (dbSessionClient db) stopXMonadService
|
||||||
forM_ (tsSystemClient ts) disconnect
|
forM_ (dbSystemClient db) disconnect
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Startuphook configuration
|
-- | Startuphook configuration
|
||||||
|
@ -504,8 +543,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbMaybeAction = a } = case a of
|
||||||
(Just x) -> Just $ k{ kbMaybeAction = x }
|
(Just x) -> Just $ k{ kbMaybeAction = x }
|
||||||
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
||||||
|
|
||||||
externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX]
|
externalBindings :: ThreadState -> DBusState -> X () -> [KeyGroup FeatureX]
|
||||||
externalBindings ts lock =
|
externalBindings ts db lock =
|
||||||
[ KeyGroup "Launchers"
|
[ KeyGroup "Launchers"
|
||||||
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
||||||
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
|
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
|
||||||
|
@ -564,7 +603,7 @@ externalBindings ts lock =
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
|
||||||
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||||
-- M-<F1> reserved for showing the keymap
|
-- M-<F1> reserved for showing the keymap
|
||||||
, KeyBinding "M-<F2>" "restart xmonad" $ ConstFeature (runCleanup ts >> runRestart)
|
, KeyBinding "M-<F2>" "restart xmonad" $ ConstFeature (runCleanup ts db >> runRestart)
|
||||||
, KeyBinding "M-<F3>" "recompile xmonad" $ ConstFeature runRecompile
|
, KeyBinding "M-<F3>" "recompile xmonad" $ ConstFeature runRecompile
|
||||||
, KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
|
, KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
|
||||||
, KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
|
, KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
|
||||||
|
@ -576,7 +615,7 @@ externalBindings ts lock =
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
cl = tsSessionClient ts
|
cl = dbSessionClient db
|
||||||
brightessControls ctl getter = (ioFeature . getter . ctl) cl
|
brightessControls ctl getter = (ioFeature . getter . ctl) cl
|
||||||
ib = brightessControls intelBacklightControls
|
ib = brightessControls intelBacklightControls
|
||||||
ck = brightessControls clevoKeyboardControls
|
ck = brightessControls clevoKeyboardControls
|
||||||
|
|
|
@ -113,7 +113,7 @@ featureEndpoint name busname path iface mem client = Feature
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
cmd = \c -> void $ callMethod c busname path iface mem
|
cmd c = void $ callMethod c busname path iface mem
|
||||||
deps = [Endpoint busname path iface $ Method_ mem]
|
deps = [Endpoint busname path iface $ Method_ mem]
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
Loading…
Reference in New Issue