twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 04:31:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

Refactor someNamedScratchpadOption to use Data.NonEmpty and to improve readability

Browse Source
This commit is contained in:
Leon Kowarschick
2020-06-06 14:55:31 +02:00
parent a861a8f954
commit 5f3edb110e
1 changed files with 28 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
XMonad/Util/NamedScratchpad.hs
View File

@@ -36,7 +36,9 @@ import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
import XMonad.Hooks.DynamicLog (PP, ppSort)
import XMonad.Actions.SpawnOn (spawnHere)
import Control.Monad (filterM)
import qualified Data.List.NonEmpty as NE
import Control.Monad (filterM, unless)
import Data.Maybe (listToMaybe)
import qualified XMonad.StackSet as W
@@ -112,7 +114,7 @@ type NamedScratchpads = [NamedScratchpad]
-- | Finds named scratchpad configuration by name
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName c s = listToMaybe $ filter ((s==) . name) c
findByName c s = listToMaybe $ filter ((s ==) . name) c
-- | Runs application which should appear in specified scratchpad
runApplication :: NamedScratchpad -> X ()
@@ -139,34 +141,40 @@ customRunNamedScratchpadAction :: (NamedScratchpad -> X ()) -- ^ Function initi
-> NamedScratchpads -- ^ Named scratchpads configuration
-> String -- ^ Scratchpad name
-> X ()
customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ head ws)
customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ NE.head ws)
allNamedScratchpadAction :: NamedScratchpads
-> String
-> X ()
allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication
someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())
-- | execute some action on a named scratchpad
someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ())
-> (NamedScratchpad -> X ())
-> NamedScratchpads
-> String
-> X ()
someNamedScratchpadAction f runApp confs n
| Just conf <- findByName confs n = withWindowSet $ \s -> do
filterCurrent <- filterM (runQuery (query conf))
((maybe [] W.integrate . W.stack . W.workspace . W.current) s)
filterAll <- filterM (runQuery (query conf)) (W.allWindows s)
case filterCurrent of
[] ->
case filterAll of
[] -> runApp conf
_ -> f (windows . W.shiftWin (W.currentTag s)) filterAll
_ -> do
if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))
then addHiddenWorkspace scratchpadWorkspaceTag
else return ()
f (windows . W.shiftWin scratchpadWorkspaceTag) filterAll
| otherwise = return ()
someNamedScratchpadAction f runApp scratchpadConfig scratchpadName =
case findByName scratchpadConfig scratchpadName of
Just conf -> withWindowSet $ \winSet -> do
let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet)
allWindows = W.allWindows winSet
matchingOnCurrent <- filterM (runQuery (query conf)) focusedWspWindows
matchingOnAll <- filterM (runQuery (query conf)) allWindows
case NE.nonEmpty matchingOnCurrent of
-- no matching window on the current workspace -> scratchpad not running or in background
Nothing -> case NE.nonEmpty matchingOnAll of
Nothing -> runApp conf
Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins
-- matching window running on current workspace -> window should be shifted to scratchpad workspace
Just wins -> do
unless (any (\wsp -> scratchpadWorkspaceTag == W.tag wsp) (W.workspaces winSet))
(addHiddenWorkspace scratchpadWorkspaceTag)
f (windows . W.shiftWin scratchpadWorkspaceTag) wins
Nothing -> return ()
-- tag of the scratchpad workspace