On Sat, Sep 08, 2007 at 01:03:57AM +0200, Karsten Schoelzel wrote:
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 :-))
Hi, extending the patch with automagic-tagging and automagic-moving of on window start This patch needs changes to the core of xmonad to work, but most work is done is in the TagWindows module: - add/delete tags - automatically adding tags on window creation based on window class, name, command - use tags for automagically assigning workspaces to windows (including floating status) * adding a tag "~" makes the window floating initially * adding a existing workspace id will move the window to workspace with that id, e.g. adding "2" will move the window to the second workspace - change focus restricted to a group of windows with a specified tag, either only on the current workspace or globally The two rules in tagMatches below state: - tag every window with WM_CLASS = gimp with the tags "2" and "~", thus moving them to workspace "2" and float them - tag every xterm window which has "screen" as an argument gets with "abc" As it is a bit invasive I'd like to hear your comments. Regards, Karsten diff -rN -u old-xmonad/Config.hs new-xmonad/Config.hs @@ -120,6 +133,20 @@ logHook = return () -- | +-- Perform an arbitrary action on window manage event. +-- +manageHook :: Window -> X (Bool) +manageHook = tagManageHook tagMatches +--manageHook = do \_ -> return (False) + +tagMatches :: [TagMatch] +tagMatches = [ + defaultTM { tmclass = ("gimp" `elem`), tmtags = ["2", "~"] } + , defaultTM { tmcommand = ("screen" `elem`), tmclass = ("xterm" `elem`), tmtags = ["abc"] } + ] + +-- Examples include: +-- | -- The key bindings list. -- -- The unusual comment format is used to generate the documentation @@ -152,6 +180,17 @@ , ((modMask, xK_l ), sendMessage Expand) -- @@ Expand the master area , ((modMask, xK_t ), withFocused sink) -- @@ Push window back into tiling + , ((modMask, xK_f ), withFocusedX (addTag "abc")) + , ((modMask .|. controlMask, xK_f ), withFocusedX (delTag "abc")) + , ((modMask .|. shiftMask, xK_f ), withTaggedGlobalM "abc" sink) + , ((modWinMask, xK_f ), withTagged "abc" (shiftX "2")) + , ((modWinMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" shiftHere) + , ((modWinMask .|. controlMask, xK_f ), focusTaggedUpGlobal "abc") -- increase or decrease number of windows in the master area , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- @@ Increment the number of windows in the master area diff -rN -u old-xmonad/Config.hs-boot new-xmonad/Config.hs-boot --- old-xmonad/Config.hs-boot 2007-09-08 16:32:04.000000000 +0200 +++ new-xmonad/Config.hs-boot 2007-09-08 16:32:04.000000000 +0200 @@ -1,8 +1,9 @@ module Config where import Graphics.X11.Xlib.Types (Dimension) -import Graphics.X11.Xlib (KeyMask) +import Graphics.X11.Xlib (KeyMask,Window) import XMonad borderWidth :: Dimension logHook :: X () +manageHook :: Window -> X (Bool) numlockMask :: KeyMask workspaces :: [WorkspaceId] diff -rN -u old-xmonad/Operations.hs new-xmonad/Operations.hs --- old-xmonad/Operations.hs 2007-09-08 16:32:04.000000000 +0200 +++ new-xmonad/Operations.hs 2007-09-08 16:32:04.000000000 +0200 @@ -18,7 +18,7 @@ import XMonad import qualified StackSet as W -import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask) +import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask) import Data.Maybe import Data.List (nub, (\\), find) @@ -49,19 +49,23 @@ -- manage :: Window -> X () manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do - setInitialProperties w >> reveal w -- FIXME: This is pretty awkward. We can't can't let "refresh" happen -- before the call to float, because that will resize the window and -- lose the default sizing. - - sh <- io $ getWMNormalHints d w - let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh - isTransient <- isJust `liftM` io (getTransientForHint d w) - if isFixedSize || isTransient - then do modify $ \s -> s { windowset = W.insertUp w (windowset s) } - float w -- \^^ now go the refresh. - else windows $ W.insertUp w + + managed <- manageHook w + if not managed + then do + setInitialProperties w >> reveal w + sh <- io $ getWMNormalHints d w + let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh + isTransient <- isJust `liftM` io (getTransientForHint d w) + if isFixedSize || isTransient + then do modify $ \s -> s { windowset = W.insertUp w (windowset s) } + float w -- \^^ now go the refresh. + else windows $ W.insertUp w + else return () -- | unmanage. A window no longer exists, remove it from the window -- list, on whatever workspace it is. diff -rN -u old-xmonad/StackSet.hs new-xmonad/StackSet.hs --- old-xmonad/StackSet.hs 2007-09-08 16:32:04.000000000 +0200 +++ new-xmonad/StackSet.hs 2007-09-08 16:32:04.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)) Sat Sep 8 16:15:07 CEST 2007 Karsten Schoelzel <kuser@gmx.de> * TagWindows (windows tagging and managing) This patch needs changes to the core of xmonad to work, but most work is done is in the TagWindows module: - add/delete tags - automatically adding tags on window creation based on window class, name, command - use tags for automagically assigning workspaces to windows (including floating status) * adding a tag "~" makes the window floating initially * adding a existing workspace id will move the window to workspace with that id, e.g. adding "2" will move the window to the second workspace - change focus restricted to a group of windows with a specified tag, either only on the current workspace or globally TODO: cleanup + docs diff -rN -u old-XMonadContrib/MetaModule.hs new-XMonadContrib/MetaModule.hs --- old-XMonadContrib/MetaModule.hs 2007-09-08 16:32:12.000000000 +0200 +++ new-XMonadContrib/MetaModule.hs 2007-09-08 16:32:12.000000000 +0200 @@ -64,6 +64,7 @@ import XMonadContrib.Submap () import XMonadContrib.SwitchTrans () import XMonadContrib.Tabbed () +import XMonadContrib.TagWindows () import XMonadContrib.ThreeColumns () import XMonadContrib.TwoPane () import XMonadContrib.ViewPrev () diff -rN -u old-XMonadContrib/TagWindows.hs new-XMonadContrib/TagWindows.hs --- old-XMonadContrib/TagWindows.hs 1970-01-01 01:00:00.000000000 +0100 +++ new-XMonadContrib/TagWindows.hs 2007-09-08 16:32:12.000000000 +0200 @@ -0,0 +1,196 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.TagWindows +-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de> +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel <kuser@gmx.de> +-- 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, focusTaggedUpGlobal, + shiftX, shiftHere, + tagManageHook, TagMatch (..), defaultTM + ) where + +import Data.Char (chr) +import Data.Set (Set) +import qualified Data.Set as Set +--import Data.Map (Map) +import qualified Data.Map as Map +import Data.List (intersect,sortBy,find) +import Data.Maybe (maybeToList,listToMaybe,isJust) + +import Control.Monad.State ( gets, liftM, modify ) +import StackSet hiding (filter, modify, float) +import Operations (windows, float, setInitialProperties, reveal) + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +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 + +focusTaggedUpGlobal :: WorkspaceId -> X () +focusTaggedUpGlobal t = windows (focusTaggedUpGlobal' t) + +focusTaggedUpGlobal' :: (Ord a, Eq s, Eq i, Ord i) => i -> StackSet i a s sd -> StackSet i a s sd +focusTaggedUpGlobal' ta s | tagwins == [] = s + | tagwins == maybeToList (peek s) = s + | otherwise = case ff of + Nothing -> s + Just (fw, fn) -> (focusWindow fw) . (view fn) $ s + where + curtag = tag . workspace . current $ s + tagwins = Map.keys (Map.filter (Set.member ta) (windowtags s)) + cls = maybe [] (\(Stack _ ls _) -> pairtag curtag ls ) (stack . workspace . current $ s) + crs = maybe [] (\(Stack _ _ rs) -> pairtag curtag (reverse rs)) (stack . workspace . current $ s) + lws = map pairmap . sortByTag . filter (\w -> tag w < curtag) . workspaces $ s + rws = map pairmap . sortByTag . filter (\w -> tag w > curtag) . workspaces $ s + ff = find (\(x,_) -> x `elem` tagwins ) (concat ([cls] ++ lws ++ rws ++ [crs])) + pairtag t = map (\x -> (x, t)) + pairmap w = pairtag (tag w) (reverse . integrate' . stack $ w) + sortByTag = sortBy (\x y -> compare (tag y) (tag x)) + +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 + +data TagMatch = + TagMatch { tmname :: [String] -> Bool + , tmcommand :: [String] -> Bool + , tmclass :: [String] -> Bool + , tmtags :: [WorkspaceId] + } + +defaultTM :: TagMatch +defaultTM = TagMatch (const True) (const True) (const True) [] + +tagManageHook :: [TagMatch] -> Window -> X (Bool) +tagManageHook tms w = withDisplay $ \d -> do + setInitialProperties w >> reveal w + + let getprop p = io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]]) + xname <- getprop wM_NAME + xcommand' <- getprop wM_COMMAND + xclass <- getprop wM_CLASS + let xcommand = concat . map splitAtNull $ xcommand' + matchTags tm = do + if and [ tmname tm $ xname, tmcommand tm $ xcommand, tmclass tm $ xclass ] + then applyTags w (tmtags tm) + else return () + mapM_ matchTags tms + + wset <- gets windowset + sh <- io $ getWMNormalHints d w + let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh + isTransient <- isJust `liftM` io (getTransientForHint d w) + if isFixedSize || isTransient || (hasTag "~" w wset) + then do modify $ \s -> s { windowset = insertUp w (windowset s) } + float w -- \^^ now go the refresh. + else windows $ insertUp w + case getWS w wset of + Nothing -> return () + (Just t) -> windows $ shiftX t w (tag . workspace . current $ wset) + return True + +getWS :: (Ord a, Eq s, Eq i) => a -> StackSet i a s sd -> Maybe i +getWS w wset = maybe Nothing insx' (getTags w wset) + where insx' ts = listToMaybe $ (Set.toList ts) `intersect` (map tag . workspaces $ wset) + + +applyTags :: Window -> [WorkspaceId] -> X () +applyTags _ [] = return () +applyTags w ts = do modify $ \s -> s { windowset = (foldl1 (.) (map (\t -> addTag t w []) ts)) $ windowset s } + +splitAtNull :: String -> [String] +splitAtNull s = case dropWhile (== (chr 0)) s of + "" -> [] + s' -> w : splitAtNull s'' + where (w, s'') = break (== (chr 0)) s'