You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

TagWindows.hs 7.5KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  1. -----------------------------------------------------------------------------
  2. -- |
  3. -- Module : XMonad.Actions.TagWindows
  4. -- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
  5. -- License : BSD
  6. --
  7. -- Maintainer : Karsten Schoelzel <kuser@gmx.de>
  8. -- Stability : unstable
  9. -- Portability : unportable
  10. --
  11. -- Functions for tagging windows and selecting them by tags.
  12. -----------------------------------------------------------------------------
  13. module XMonad.Actions.TagWindows (
  14. -- * Usage
  15. -- $usage
  16. addTag, delTag, unTag,
  17. setTags, getTags, hasTag,
  18. withTaggedP, withTaggedGlobalP, withFocusedP,
  19. withTagged , withTaggedGlobal ,
  20. focusUpTagged, focusUpTaggedGlobal,
  21. focusDownTagged, focusDownTaggedGlobal,
  22. shiftHere, shiftToScreen,
  23. tagPrompt,
  24. tagDelPrompt,
  25. TagPrompt,
  26. ) where
  27. import Data.List (nub,sortBy)
  28. import Control.Monad
  29. import Control.Exception as E
  30. import XMonad.StackSet hiding (filter)
  31. import XMonad.Prompt
  32. import XMonad hiding (workspaces)
  33. econst :: Monad m => a -> IOException -> m a
  34. econst = const . return
  35. -- $usage
  36. --
  37. -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
  38. --
  39. -- > import XMonad.Actions.TagWindows
  40. -- > import XMonad.Prompt -- to use tagPrompt
  41. --
  42. -- and add keybindings such as the following:
  43. --
  44. -- > , ((modm, xK_f ), withFocused (addTag "abc"))
  45. -- > , ((modm .|. controlMask, xK_f ), withFocused (delTag "abc"))
  46. -- > , ((modm .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink)
  47. -- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2"))
  48. -- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere)
  49. -- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc")
  50. -- > , ((modm, xK_g ), tagPrompt def (\s -> withFocused (addTag s)))
  51. -- > , ((modm .|. controlMask, xK_g ), tagDelPrompt def)
  52. -- > , ((modm .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobal s float))
  53. -- > , ((modWinMask, xK_g ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2")))
  54. -- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere))
  55. -- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s))
  56. --
  57. -- NOTE: Tags are saved as space separated strings and split with
  58. -- 'unwords'. Thus if you add a tag \"a b\" the window will have
  59. -- the tags \"a\" and \"b\" but not \"a b\".
  60. --
  61. -- For detailed instructions on editing your key bindings, see
  62. -- "XMonad.Doc.Extending#Editing_key_bindings".
  63. -- | set multiple tags for a window at once (overriding any previous tags)
  64. setTags :: [String] -> Window -> X ()
  65. setTags = setTag . unwords
  66. -- | set a tag for a window (overriding any previous tags)
  67. -- writes it to the \"_XMONAD_TAGS\" window property
  68. setTag :: String -> Window -> X ()
  69. setTag s w = withDisplay $ \d ->
  70. io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s
  71. -- | read all tags of a window
  72. -- reads from the \"_XMONAD_TAGS\" window property
  73. getTags :: Window -> X [String]
  74. getTags w = withDisplay $ \d ->
  75. io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
  76. getTextProperty d w >>=
  77. wcTextPropertyToTextList d)
  78. (econst [[]])
  79. >>= return . words . unwords
  80. -- | check a window for the given tag
  81. hasTag :: String -> Window -> X Bool
  82. hasTag s w = (s `elem`) <$> getTags w
  83. -- | add a tag to the existing ones
  84. addTag :: String -> Window -> X ()
  85. addTag s w = do
  86. tags <- getTags w
  87. if (s `notElem` tags) then setTags (s:tags) w else return ()
  88. -- | remove a tag from a window, if it exists
  89. delTag :: String -> Window -> X ()
  90. delTag s w = do
  91. tags <- getTags w
  92. setTags (filter (/= s) tags) w
  93. -- | remove all tags
  94. unTag :: Window -> X ()
  95. unTag = setTag ""
  96. -- | Move the focus in a group of windows, which share the same given tag.
  97. -- The Global variants move through all workspaces, whereas the other
  98. -- ones operate only on the current workspace
  99. focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()
  100. focusUpTagged = focusTagged' (reverse . wsToList)
  101. focusDownTagged = focusTagged' wsToList
  102. focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal)
  103. focusDownTaggedGlobal = focusTagged' wsToListGlobal
  104. wsToList :: (Ord i) => StackSet i l a s sd -> [a]
  105. wsToList ws = crs ++ cls
  106. where
  107. (crs, cls) = (cms down, cms (reverse . up))
  108. cms f = maybe [] f (stack . workspace . current $ ws)
  109. wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
  110. wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])
  111. where
  112. curtag = currentTag ws
  113. (crs, cls) = (cms down, cms (reverse . up))
  114. cms f = maybe [] f (stack . workspace . current $ ws)
  115. (lws, rws) = (mws (<), mws (>))
  116. mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws
  117. sortByTag = sortBy (\x y -> compare (tag x) (tag y))
  118. focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
  119. focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
  120. maybe (return ()) (windows . focusWindow)
  121. findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
  122. findM _ [] = return Nothing
  123. findM p (x:xs) = do b <- p x
  124. if b then return (Just x) else findM p xs
  125. -- | apply a pure function to windows with a tag
  126. withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
  127. withTaggedP t f = withTagged' t (winMap f)
  128. withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)
  129. winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
  130. winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw))
  131. withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()
  132. withTagged t f = withTagged' t (mapM_ f)
  133. withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)
  134. withTagged' :: String -> ([Window] -> X ()) -> X ()
  135. withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
  136. withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
  137. withTaggedGlobal' t m = gets windowset >>=
  138. filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
  139. withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
  140. withFocusedP f = withFocused $ windows . f
  141. shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
  142. shiftHere w s = shiftWin (currentTag s) w s
  143. shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
  144. shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
  145. [] -> s
  146. (t:_) -> shiftWin (tag . workspace $ t) w s
  147. data TagPrompt = TagPrompt
  148. instance XPrompt TagPrompt where
  149. showXPrompt TagPrompt = "Select Tag: "
  150. tagPrompt :: XPConfig -> (String -> X ()) -> X ()
  151. tagPrompt c f = do
  152. sc <- tagComplList
  153. mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
  154. tagComplList :: X [String]
  155. tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
  156. mapM getTags >>=
  157. return . nub . concat
  158. tagDelPrompt :: XPConfig -> X ()
  159. tagDelPrompt c = do
  160. sc <- tagDelComplList
  161. if (sc /= [])
  162. then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
  163. else return ()
  164. tagDelComplList :: X [String]
  165. tagDelComplList = gets windowset >>= maybe (return []) getTags . peek