ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH print dynamic workspace features

This commit is contained in:
Nathan Dwarshuis 2022-07-02 20:08:37 -04:00
parent 851f034c3f
commit 129222c7e6
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
bin/xmonad.hs
View File

@ -127,21 +127,22 @@ printDeps = do
ses <- getDBusClient False ses <- getDBusClient False
sys <- getDBusClient True sys <- getDBusClient True
let db = DBusState ses sys let db = DBusState ses sys
(i, f) <- allFeatures db (i, f, d) <- allFeatures db
is <- mapM dumpSometimes i is <- mapM dumpSometimes i
fs <- mapM dumpFeature f fs <- mapM dumpFeature f
let (UQ u) = jsonArray $ fmap JSON_UQ $ is ++ fs ds <- mapM dumpSometimes d
let (UQ u) = jsonArray $ fmap JSON_UQ $ is ++ fs ++ ds
putStrLn u putStrLn u
forM_ ses disconnect forM_ ses disconnect
forM_ sys disconnect forM_ sys disconnect
allFeatures :: DBusState -> IO ([SometimesIO], [FeatureX]) allFeatures :: DBusState -> IO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
allFeatures db = do allFeatures db = do
let bfs = concatMap (fmap kbMaybeAction . kgBindings) let bfs = concatMap (fmap kbMaybeAction . kgBindings)
$ externalBindings ts db $ externalBindings ts db
let dbus = fmap (\f -> f $ dbSessionClient db) dbusExporters let dbus = fmap (\f -> f $ dbSessionClient db) dbusExporters
let others = [runRemovableMon $ dbSystemClient db, runPowermon] let others = [runRemovableMon $ dbSystemClient db, runPowermon]
return (dbus ++ others, Left runScreenLock:bfs) return (dbus ++ others, Left runScreenLock:bfs, allDWs')
where where
ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] } ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
@ -285,12 +286,15 @@ f5vpnDynamicWorkspace = sometimesIO_ "F5 VPN workspace" "f5vpn" tree dw
} }
c = "F5 VPN" c = "F5 VPN"
allDWs' :: [Sometimes DynWorkspace]
allDWs' = [xsaneDynamicWorkspace
, vmDynamicWorkspace
, gimpDynamicWorkspace
, f5vpnDynamicWorkspace
]
allDWs :: IO [DynWorkspace] allDWs :: IO [DynWorkspace]
allDWs = catMaybes <$> mapM evalSometimes [ xsaneDynamicWorkspace allDWs = catMaybes <$> mapM evalSometimes allDWs'
, vmDynamicWorkspace
, gimpDynamicWorkspace
, f5vpnDynamicWorkspace
]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Layout configuration -- | Layout configuration