X.U.NamedScratchpad: Use a map for internal state

This commit is contained in:
slotThe 2022-03-06 18:51:24 +01:00
parent bc2aaf41af
commit 4c350b9a65

View File

@ -1,5 +1,4 @@
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@ -44,14 +43,16 @@ module XMonad.Util.NamedScratchpad (
) where ) where
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Data.Map.Strict (Map, (!?))
import XMonad import XMonad
import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
import XMonad.Actions.SpawnOn (spawnHere) import XMonad.Actions.SpawnOn (spawnHere)
import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Hooks.ManageHelpers (doRectFloat)
import XMonad.Hooks.RefocusLast (withRecentsIn) import XMonad.Hooks.RefocusLast (withRecentsIn)
import XMonad.Hooks.StatusBar.PP (PP, ppSort) import XMonad.Hooks.StatusBar.PP (PP, ppSort)
import XMonad.Prelude (filterM, find, unless, when) import XMonad.Prelude (filterM, unless, when)
import qualified Data.Map.Strict as Map
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
@ -123,12 +124,17 @@ data NamedScratchpad = NS { name :: String -- ^ Scratchpad name
, hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@ , hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@
} }
newtype NSPState = NSPState [NamedScratchpad] -- | The NSP state associates a name to an entire scratchpad.
newtype NSPState = NSPState (Map String NamedScratchpad)
instance ExtensionClass NSPState where instance ExtensionClass NSPState where
initialValue :: NSPState initialValue :: NSPState
initialValue = NSPState mempty initialValue = NSPState mempty
-- | Construct an 'NSPState' from an ordinary list of scratchpads.
buildNSPState :: NamedScratchpads -> NSPState
buildNSPState nsps = NSPState . Map.fromList $ zip (map name nsps) nsps
-- | Manage hook that makes the window non-floating -- | Manage hook that makes the window non-floating
nonFloating :: ManageHook nonFloating :: ManageHook
nonFloating = idHook nonFloating = idHook
@ -144,10 +150,6 @@ customFloating = doRectFloat
-- | Named scratchpads configuration -- | Named scratchpads configuration
type NamedScratchpads = [NamedScratchpad] type NamedScratchpads = [NamedScratchpad]
-- | Finds named scratchpad configuration by name
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName c s = find ((s ==) . name) c
-- | Runs application which should appear in specified scratchpad -- | Runs application which should appear in specified scratchpad
runApplication :: NamedScratchpad -> X () runApplication :: NamedScratchpad -> X ()
runApplication = spawn . cmd runApplication = spawn . cmd
@ -225,7 +227,7 @@ someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ())
-> X () -> X ()
someNamedScratchpadAction f runApp _ns scratchpadName = do someNamedScratchpadAction f runApp _ns scratchpadName = do
NSPState scratchpadConfig <- XS.get NSPState scratchpadConfig <- XS.get
case findByName scratchpadConfig scratchpadName of case scratchpadConfig !? scratchpadName of
Just conf -> withWindowSet $ \winSet -> do Just conf -> withWindowSet $ \winSet -> do
let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet) let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet)
allWindows = W.allWindows winSet allWindows = W.allWindows winSet
@ -250,9 +252,10 @@ scratchpadWorkspaceTag = "NSP"
namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration
-> ManageHook -> ManageHook
namedScratchpadManageHook nsps = do namedScratchpadManageHook nsps = do
ns <- liftX $ XS.get >>= \case ns <- liftX $ XS.get >>= \(NSPState xs) ->
NSPState [] -> nsps <$ XS.put (NSPState nsps) -- initialise if null xs
NSPState xs -> pure xs then nsps <$ XS.put (buildNSPState nsps)
else pure $ Map.elems xs
composeAll $ fmap (\c -> query c --> hook c) ns composeAll $ fmap (\c -> query c --> hook c) ns
-- | Shift some windows to the scratchpad workspace according to the -- | Shift some windows to the scratchpad workspace according to the
@ -307,13 +310,11 @@ mkDynamicNSP s w =
-- | Make a window a dynamic scratchpad -- | Make a window a dynamic scratchpad
addDynamicNSP :: String -> Window -> X () addDynamicNSP :: String -> Window -> X ()
addDynamicNSP s w = do addDynamicNSP s w = XS.modify @NSPState . coerce $ Map.insert s (mkDynamicNSP s w)
removeDynamicNSP s
XS.modify @NSPState $ coerce (mkDynamicNSP s w :)
-- | Make a window stop being a dynamic scratchpad -- | Make a window stop being a dynamic scratchpad
removeDynamicNSP :: String -> X () removeDynamicNSP :: String -> X ()
removeDynamicNSP s = XS.modify @NSPState $ coerce (filter ((/= s) . name)) removeDynamicNSP s = XS.modify @NSPState . coerce $ Map.delete @_ @NamedScratchpad s
-- | Toggle the visibility of a dynamic scratchpad. -- | Toggle the visibility of a dynamic scratchpad.
dynamicNSPAction :: String -> X () dynamicNSPAction :: String -> X ()
@ -323,8 +324,8 @@ dynamicNSPAction = customRunNamedScratchpadAction (const $ pure ()) []
-- a window from being one if it already is. -- a window from being one if it already is.
toggleDynamicNSP :: String -> Window -> X () toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP s w = do toggleDynamicNSP s w = do
NSPState xs <- XS.get NSPState nsps <- XS.get
case find ((s ==) . name) xs of case nsps !? s of
Nothing -> addDynamicNSP s w Nothing -> addDynamicNSP s w
Just nsp -> ifM (runQuery (query nsp) w) Just nsp -> ifM (runQuery (query nsp) w)
(removeDynamicNSP s) (removeDynamicNSP s)