From cd8cc40fd18d12ffb1ccebb4449efa98cbdaddd3 Mon Sep 17 00:00:00 2001 From: quesel Date: Thu, 10 Feb 2011 17:50:18 +0100 Subject: Added a module for linking workspaces Ignore-this: 1dba2164cc3387409873d33099596d91 This module provides a way to link certain workspaces in a multihead setup. That way, when switching to the first one the other heads display the linked workspaces. darcs-hash:20110210165018-2216c-b7c81c706c50c4401c433fc06e0c133a3d242156.gz --- XMonad/Actions/LinkWorkspaces.hs | 168 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) create mode 100644 XMonad/Actions/LinkWorkspaces.hs (limited to 'XMonad') diff --git a/XMonad/Actions/LinkWorkspaces.hs b/XMonad/Actions/LinkWorkspaces.hs new file mode 100644 index 0000000..8b3f9c3 --- /dev/null +++ b/XMonad/Actions/LinkWorkspaces.hs @@ -0,0 +1,168 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.LinkWorkspaces +-- Copyright : (c) Jan-David Quesel +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : none +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to add and delete links between workspaces. It is aimed +-- at providing useful links between workspaces in a multihead setup. Linked +-- workspaces are view at the same time. +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE DeriveDataTypeable #-} +module XMonad.Actions.LinkWorkspaces ( + -- * Usage + -- $usage + switchWS, + removeAllMatchings, + unMatch, + toggleLinkWorkspaces, + defaultMessageConf, + MessageConfig(..) + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.IndependentScreens(countScreens) +import qualified XMonad.Util.ExtensibleState as XS (get, put) +import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen') +import qualified Data.Map as M + ( insert, delete, Map, lookup, empty, filter ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.LinkWorkspaces +-- +-- and add a function to print messages like +-- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1) +-- > message_color_func c1 c2 msg = dzenColor c1 c2 msg +-- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen +-- +-- alternatively you can use the noMessages function as the argument +-- +-- Then add keybindings like the following: +-- +-- > ,((modm, xK_p), toggleLinkWorkspaces message) +-- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message) +-- +-- > [ ((modm .|. m, k), a i) +-- > | (a, m) <- [(switchWS view message, 0),(\x -> switchWS (shift x . view x) message, shiftMask)] +-- > , (i, k) <- zip [1..] [xK_1 .. xK_9]] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X()) + , foreground :: [Char] + , alertedForeground :: [Char] + , background :: [Char] + } + +defaultMessageConf :: MessageConfig +defaultMessageConf = MessageConfig { messageFunction = noMessageFn + , background = "#000000" + , alertedForeground = "#ff7701" + , foreground = "#00ff00" } + +noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X() +noMessageFn _ _ _ _ = return () :: X () + +-- | Stuff for linking workspaces +data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable) +instance ExtensionClass WorkspaceMap + where initialValue = WorkspaceMap M.empty + extensionType = PersistentExtension + +switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X () +switchWS f m ws = switchWS' f m ws Nothing + +-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen +-- | we already did switching on +switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X () +switchWS' switchFn message workspace stopAtScreen = do + ws <- gets windowset + nScreens <- countScreens + let now = W.screen (W.current ws) + let next = ((now + 1) `mod` nScreens) + switchFn workspace + case stopAtScreen of + Nothing -> sTM now next (Just now) + Just sId -> if sId == next then return () else sTM now next (Just sId) + where sTM = switchToMatching (switchWS' switchFn message) message workspace + +-- | Switch to the workspace that matches the current one, executing switches for that workspace as well. +-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again. +switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId + -> ScreenId -> (Maybe ScreenId) -> X () +switchToMatching f message t now next stopAtScreen = do + WorkspaceMap matchings <- XS.get :: X WorkspaceMap + case (M.lookup t matchings) of + Nothing -> return () :: X() + Just newWorkspace -> do + onScreen' (f newWorkspace stopAtScreen) FocusCurrent next + messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace)) + +-- | Insert a mapping between t1 and t2 or remove it was already present +toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X () +toggleMatching message t1 t2 = do + WorkspaceMap matchings <- XS.get :: X WorkspaceMap + case (M.lookup t1 matchings) of + Nothing -> setMatching message t1 t2 matchings + Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings + return () + +-- | Insert a mapping between t1 and t2 and display a message +setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () +setMatching message t1 t2 matchings = do + ws <- gets windowset + let now = W.screen (W.current ws) + XS.put $ WorkspaceMap $ M.insert t1 t2 matchings + messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2)) + +-- currently this function is called manually this means that if workspaces +-- were deleted, some links stay in the RAM even though they are not used +-- anymore... because of the small amount of memory used for those there is no +-- special cleanup so far +removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () +removeMatching' message t1 t2 matchings = do + ws <- gets windowset + let now = W.screen (W.current ws) + XS.put $ WorkspaceMap $ M.delete t1 matchings + messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2) + +-- | Remove all maps between workspaces +removeAllMatchings :: MessageConfig -> X () +removeAllMatchings message = do + ws <- gets windowset + let now = W.screen (W.current ws) + XS.put $ WorkspaceMap $ M.empty + messageFunction message now (alertedForeground message) (background message) "All links removed!" + +-- | remove all matching regarding a given workspace +unMatch :: WorkspaceId -> X () +unMatch workspace = do + WorkspaceMap matchings <- XS.get :: X WorkspaceMap + XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings) + +-- | Toggle the currently displayed workspaces as matching. Starting from the one with focus +-- | a linked list of workspaces is created that will later be iterated by switchToMatching. +toggleLinkWorkspaces :: MessageConfig -> X () +toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message + +toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X () +toggleLinkWorkspaces' first message = do + ws <- gets windowset + nScreens <- countScreens + let now = W.screen (W.current ws) + let next = (now + 1) `mod` nScreens + if next == first then return () else do -- this is also the case if there is only one screen + case (W.lookupWorkspace next ws) of + Nothing -> return () + Just name -> toggleMatching message (W.currentTag ws) (name) + onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next -- cgit v1.2.3