[Xmonad] Window tags

Hi, today I added the ability to add tags to windows. Some uses which are possible with them right now: * move a tag group of windows to another workspace at once * get them back without switching to the other workspace * change focus only in the group of windows with a specified tag - if there is only one of them at the workspace this means specifically that you can jump to a specific window wherever the focus is and wherever the window is Would be nice to get tags assigned automatically, but i haven't thought about how to implement this ;-) As it is work in progress (docs and cleanup needed) I would welcome opinions suggestions as to what people might want to do with tagging. Most parts of the code are in a Contrib module but where are also changes in StackSet to store the tags therein. (Yesterday I wrote a similar tagging module which stored the tags in the X Server in a text-property of the window. But that turned out to be not very nice to work with. If anybody wants to see that code, just ask :-)) Regards, Karsten Example settings in Config.hs , ((modMask, xK_f ), withFocusedX (addTag "abc")) , ((modMask .|. controlMask, xK_f ), withFocusedX (delTag "abc")) -- Sink all windows with tag "abc" on all workspaces , ((modMask .|. shiftMask, xK_f ), withTaggedGlobalM "abc" sink) -- Move all windows with tag "abc" to workspace "2" , ((modWinMask, xK_f ), withTagged "abc" (shiftX "2")) -- Move all windows with tag "abc" from all workspaces to the current workspace , ((modWinMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" shiftHere) -- Change focus with "abc" windows , ((modWinMask .|. controlMask, xK_f ), focusTaggedUp "abc") diff -rN -u old-xmonad/StackSet.hs new-xmonad/StackSet.hs --- old-xmonad/StackSet.hs 2007-09-08 00:36:44.000000000 +0200 +++ new-xmonad/StackSet.hs 2007-09-08 00:36:44.000000000 +0200 @@ -22,11 +22,11 @@ -- * Operations on the current stack -- $stackOperations peek, index, integrate, integrate', differentiate, - focusUp, focusDown, - focusWindow, tagMember, member, findIndex, + focusUp, focusDown, focusUp', + focusWindow, workspaces, tagMember, member, findIndex, -- * Modifying the stackset -- $modifyStackset - insertUp, delete, filter, + insertUp, delete, deletetmp, filter, -- * Setting the master window -- $settingMW swapMaster, swapUp, swapDown, modify, modify', float, sink, -- needed by users @@ -39,6 +39,7 @@ import Data.Maybe (listToMaybe) import qualified Data.List as L (delete,deleteBy,find,splitAt,filter) import qualified Data.Map as M (Map,insert,delete,empty) +import Data.Set (Set) -- $intro -- @@ -151,6 +152,7 @@ , visible :: [Screen i a sid sd] -- ^ non-focused workspaces, visible in xinerama , hidden :: [Workspace i a] -- ^ workspaces not visible anywhere , floating :: M.Map a RationalRect -- ^ floating windows + , windowtags :: M.Map a (Set i) -- ^ window tags } deriving (Show, Read, Eq) -- | Visible workspaces, and their Xinerama screens. @@ -208,7 +210,7 @@ -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. -- new :: (Integral s) => [i] -> [sd] -> StackSet i a s sd -new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty +new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty M.empty where (seen,unseen) = L.splitAt (length m) $ map (flip Workspace Nothing) wids (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ] -- now zip up visibles with their screen id @@ -453,9 +455,16 @@ -- * otherwise, delete doesn't affect the master. -- delete :: (Ord a, Eq s) => a -> StackSet i a s sd -> StackSet i a s sd -delete w s = s { current = removeFromScreen (current s) - , visible = map removeFromScreen (visible s) - , hidden = map removeFromWorkspace (hidden s) } +delete w s = s' { floating = M.delete w (floating s') + , windowtags = M.delete w (windowtags s') } + where s' = deletetmp w s + +-- only temporarily remove the window from the stack, thereby not destroying special +-- information saved in the Stackset +deletetmp :: (Ord a, Eq s) => a -> StackSet i a s sd -> StackSet i a s sd +deletetmp w s = s { current = removeFromScreen (current s) + , visible = map removeFromScreen (visible s) + , hidden = map removeFromWorkspace (hidden s) } where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) } removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) } @@ -495,5 +504,5 @@ shift :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s) | otherwise = s - where go w = view curtag . insertUp w . view n . delete w $ s + where go w = view curtag . insertUp w . view n . deletetmp w $ s curtag = tag (workspace (current s)) TagWindows.hs ----------------------------------------------------------------------------- -- | -- Module : XMonadContrib.TagWindows -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : unstable -- Portability : unportable -- -- Functions for tagging windows and selecting them by tags. ----------------------------------------------------------------------------- module XMonadContrib.TagWindows ( -- * Usage -- $usage addTag, delTag, withTagged, withTaggedGlobal , withFocusedX, withTaggedM, withTaggedGlobalM, focusTaggedUp, shiftX, shiftHere ) where import Data.Set (Set) import qualified Data.Set as Set --import Data.Map (Map) import qualified Data.Map as Map import Data.List (intersect) import Control.Monad.State ( gets ) import StackSet hiding (filter) import Operations (windows) import Graphics.X11.Xlib import XMonad -- $usage -- a -> i -> StackSet i a s sd -> StackSet i a s sd getTags :: (Ord a) => a -> StackSet i a s sd -> Maybe (Set i) getTags w s = Map.lookup w (windowtags s) addTag :: (Ord a, Ord i) => i -> a -> i -> StackSet i a s sd -> StackSet i a s sd addTag t w _ s = s { windowtags = Map.insertWith (Set.union) w (Set.singleton t) (windowtags s) } delTag :: (Ord a, Ord i) => i -> a -> i -> StackSet i a s sd -> StackSet i a s sd delTag t w _ s = s { windowtags = Map.update (\x -> Just (Set.delete t x)) w (windowtags s) } hasTag :: (Ord a, Ord i) => i -> a -> StackSet i a s sd -> Bool hasTag t w s = case getTags w s of Nothing -> False (Just ts) -> Set.member t ts focusTaggedUp :: WorkspaceId -> X () focusTaggedUp t = windows (focusTaggedUp' t) focusTaggedUp' :: (Ord a, Eq s, Eq i, Ord i) => i -> StackSet i a s sd -> StackSet i a s sd focusTaggedUp' ta s | wt == [] = s | otherwise = modify' (focusUpWith (`elem` wt)) s where tagwins = Map.keys (Map.filter (Set.member ta) (windowtags s)) wt = (integrate' . stack . workspace . current $ s) `intersect` tagwins focusUpWith :: (a -> Bool) -> Stack a -> Stack a focusUpWith f (Stack t (l:ls) rs) = if f l then s else focusUpWith f s where s = Stack l ls (t:rs) focusUpWith f (Stack t [] rs) = if f x then s else focusUpWith f s where s = Stack x xs [] (x:xs) = reverse (t:rs) withTagged :: WorkspaceId -> (Window -> WorkspaceId -> WindowSet -> WindowSet) -> X () withTagged t f = do wset <- gets windowset let wspace = workspace . current $ wset taggedWins = filter (\w -> hasTag t w wset) (integrate' . stack $ wspace) case taggedWins of [] -> return () _ -> windows $ foldl1 (.) (map (\w -> f w (tag wspace)) taggedWins) withTaggedM :: WorkspaceId -> (Window -> X ()) -> X () withTaggedM t f = do wset <- gets windowset let wspace = workspace . current $ wset taggedWins = filter (\w -> hasTag t w wset) (integrate' . stack $ wspace) mapM_ f taggedWins withTaggedGlobal :: WorkspaceId -> (Window -> WorkspaceId -> WindowSet -> WindowSet) -> X () withTaggedGlobal t f = do wset <- gets windowset let wspaces = workspaces wset wins = concat $ map (\ws -> map (\w -> (w,tag ws)) (integrate' . stack $ ws)) wspaces taggedWins = filter (\(w,_) -> hasTag t w wset) wins case taggedWins of [] -> return () _ -> windows $ foldl1 (.) (map (\(w,tt) -> f w tt) taggedWins) withTaggedGlobalM :: WorkspaceId -> (Window -> X ()) -> X () withTaggedGlobalM t f = do tags <- gets (Map.toList . windowtags . windowset) let taggedWins = map (fst) $ (filter (\(_,wts) -> t `Set.member` wts) tags) mapM_ f taggedWins withFocusedX :: (Window -> WorkspaceId -> WindowSet -> WindowSet) -> X () withFocusedX f = do wset <- gets windowset let curtag = tag . workspace . current $ wset maybe (return ()) (\w -> windows (f w curtag)) (peek wset) shiftX :: (Ord a, Eq s, Eq i) => i -> a -> i -> StackSet i a s sd -> StackSet i a s sd shiftX to w from s | from `tagMember` s && to `tagMember` s && to /= from = go w | otherwise = s where go w' = view curtag . insertUp w' . view to . deletetmp w' . view from $ s curtag = tag (workspace (current s)) shiftHere :: (Ord a, Eq s, Eq i) => a -> i -> StackSet i a s sd -> StackSet i a s sd shiftHere w from s = shiftX (tag . workspace . current $ s) w from s