mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
X.U.NamedScratchpad: Use a map for internal state
This commit is contained in:
parent
bc2aaf41af
commit
4c350b9a65
@ -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)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user