[Xmonad] Window tags (automagic) + assign workspace to windows
on startup
Karsten Schoelzel
kuser at gmx.de
Sat Sep 8 10:45:33 EDT 2007
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 at 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 at gmx.de>
+-- License : BSD
+--
+-- Maintainer : Karsten Schoelzel <kuser at 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'
More information about the Xmonad
mailing list