mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-29 03:01:51 -07:00
new contrib module, X.A.DynamicWorkspaceGroups, for managing groups of workspaces on multi-head setups
This commit is contained in:
137
XMonad/Actions/DynamicWorkspaceGroups.hs
Normal file
137
XMonad/Actions/DynamicWorkspaceGroups.hs
Normal file
@@ -0,0 +1,137 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
-- |
|
||||||
|
-- Module : XMonad.Actions.DynamicWorkspaceGroups
|
||||||
|
-- Copyright : (c) Brent Yorgey 2009
|
||||||
|
-- License : BSD-style (see LICENSE)
|
||||||
|
--
|
||||||
|
-- Maintainer : <byorgey@gmail.com>
|
||||||
|
-- Stability : experimental
|
||||||
|
-- Portability : unportable
|
||||||
|
--
|
||||||
|
-- Dynamically manage \"workspace groups\", sets of workspaces being
|
||||||
|
-- used together for some common task or purpose, to allow switching
|
||||||
|
-- between workspace groups in a single action. Note that this only
|
||||||
|
-- makes sense for multi-head setups.
|
||||||
|
--
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
module XMonad.Actions.DynamicWorkspaceGroups
|
||||||
|
( -- * Usage
|
||||||
|
-- $usage
|
||||||
|
|
||||||
|
WSGroupId
|
||||||
|
|
||||||
|
, addWSGroup
|
||||||
|
, addCurrentWSGroup
|
||||||
|
, forgetWSGroup
|
||||||
|
, viewWSGroup
|
||||||
|
|
||||||
|
, promptWSGroupView
|
||||||
|
, promptWSGroupAdd
|
||||||
|
, promptWSGroupForget
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.List (find)
|
||||||
|
import Control.Arrow ((&&&))
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
import XMonad
|
||||||
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
|
import XMonad.Prompt
|
||||||
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
|
||||||
|
-- $usage
|
||||||
|
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
|
||||||
|
--
|
||||||
|
-- > import XMonad.Actions.DynamicWorkspaceGroups
|
||||||
|
--
|
||||||
|
-- Then add keybindings like the following (this example uses
|
||||||
|
-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
|
||||||
|
--
|
||||||
|
-- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
|
||||||
|
-- > , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
|
||||||
|
-- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
|
||||||
|
--
|
||||||
|
|
||||||
|
type WSGroup = [(ScreenId,WorkspaceId)]
|
||||||
|
|
||||||
|
type WSGroupId = String
|
||||||
|
|
||||||
|
data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
|
||||||
|
deriving (Typeable, Read, Show)
|
||||||
|
|
||||||
|
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
|
||||||
|
withWSG f = WSG . f . unWSG
|
||||||
|
|
||||||
|
instance ExtensionClass WSGroupStorage where
|
||||||
|
initialValue = WSG $ M.empty
|
||||||
|
extensionType = PersistentExtension
|
||||||
|
|
||||||
|
-- | Add a new workspace group with the given name.
|
||||||
|
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
|
||||||
|
addWSGroup name wids = withWindowSet $ \w -> do
|
||||||
|
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
|
||||||
|
wmap = mapM (strength . (flip lookup wss &&& id)) wids
|
||||||
|
case wmap of
|
||||||
|
Just ps -> XS.modify . withWSG . M.insert name $ ps
|
||||||
|
Nothing -> return ()
|
||||||
|
where strength (ma, b) = ma >>= \a -> return (a,b)
|
||||||
|
|
||||||
|
-- | Give a name to the current workspace group.
|
||||||
|
addCurrentWSGroup :: WSGroupId -> X ()
|
||||||
|
addCurrentWSGroup name = withWindowSet $ \w ->
|
||||||
|
addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)
|
||||||
|
|
||||||
|
-- | Delete the named workspace group from the list of workspace
|
||||||
|
-- groups. Note that this has no effect on the workspaces involved;
|
||||||
|
-- it simply forgets the given name.
|
||||||
|
forgetWSGroup :: WSGroupId -> X ()
|
||||||
|
forgetWSGroup = XS.modify . withWSG . M.delete
|
||||||
|
|
||||||
|
-- | View the workspace group with the given name.
|
||||||
|
viewWSGroup :: WSGroupId -> X ()
|
||||||
|
viewWSGroup name = do
|
||||||
|
WSG m <- XS.get
|
||||||
|
case M.lookup name m of
|
||||||
|
Just grp -> mapM_ (uncurry viewWS) grp
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
|
-- | View the given workspace on the given screen.
|
||||||
|
viewWS :: ScreenId -> WorkspaceId -> X ()
|
||||||
|
viewWS sid wid = do
|
||||||
|
mw <- findScreenWS sid
|
||||||
|
case mw of
|
||||||
|
Just w -> do
|
||||||
|
windows $ W.view w
|
||||||
|
windows $ W.greedyView wid
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
|
-- | Find the workspace which is currently on the given screen.
|
||||||
|
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
|
||||||
|
findScreenWS sid = withWindowSet $
|
||||||
|
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
|
||||||
|
|
||||||
|
data WSGPrompt = WSGPrompt String
|
||||||
|
|
||||||
|
instance XPrompt WSGPrompt where
|
||||||
|
showXPrompt (WSGPrompt s) = s
|
||||||
|
|
||||||
|
-- | Prompt for a workspace group to view.
|
||||||
|
promptWSGroupView :: XPConfig -> String -> X ()
|
||||||
|
promptWSGroupView xp s = do
|
||||||
|
gs <- fmap (M.keys . unWSG) XS.get
|
||||||
|
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
|
||||||
|
|
||||||
|
-- | Prompt for a name for the current workspace group.
|
||||||
|
promptWSGroupAdd :: XPConfig -> String -> X ()
|
||||||
|
promptWSGroupAdd xp s =
|
||||||
|
mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup
|
||||||
|
|
||||||
|
-- | Prompt for a workspace group to forget.
|
||||||
|
promptWSGroupForget :: XPConfig -> String -> X ()
|
||||||
|
promptWSGroupForget xp s = do
|
||||||
|
gs <- fmap (M.keys . unWSG) XS.get
|
||||||
|
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
|
@@ -74,6 +74,7 @@ library
|
|||||||
XMonad.Actions.DeManage
|
XMonad.Actions.DeManage
|
||||||
XMonad.Actions.DwmPromote
|
XMonad.Actions.DwmPromote
|
||||||
XMonad.Actions.DynamicWorkspaces
|
XMonad.Actions.DynamicWorkspaces
|
||||||
|
XMonad.Actions.DynamicWorkspaceGroups
|
||||||
XMonad.Actions.FindEmptyWorkspace
|
XMonad.Actions.FindEmptyWorkspace
|
||||||
XMonad.Actions.FlexibleManipulate
|
XMonad.Actions.FlexibleManipulate
|
||||||
XMonad.Actions.FlexibleResize
|
XMonad.Actions.FlexibleResize
|
||||||
|
Reference in New Issue
Block a user