diff options
Diffstat (limited to 'XMonad/Hooks')
| -rw-r--r-- | XMonad/Hooks/DynamicLog.hs | 211 | ||||
| -rw-r--r-- | XMonad/Hooks/EwmhDesktops | 130 | ||||
| -rw-r--r-- | XMonad/Hooks/ManageDocks.hs | 153 | ||||
| -rw-r--r-- | XMonad/Hooks/SetWMName.hs | 114 | ||||
| -rw-r--r-- | XMonad/Hooks/UrgencyHook.hs | 134 | ||||
| -rw-r--r-- | XMonad/Hooks/XPropManage.hs | 91 |
6 files changed, 833 insertions, 0 deletions
diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs new file mode 100644 index 0000000..16f036a --- /dev/null +++ b/XMonad/Hooks/DynamicLog.hs @@ -0,0 +1,211 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.DynamicLog +-- Copyright : (c) Don Stewart <dons@cse.unsw.edu.au> +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Don Stewart <dons@cse.unsw.edu.au> +-- Stability : unstable +-- Portability : unportable +-- +-- DynamicLog +-- +-- Log events in: +-- +-- > 1 2 [3] 4 8 +-- +-- format. Suitable to pipe into dzen. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.DynamicLog ( + -- * Usage + -- $usage + dynamicLog, + dynamicLogDzen, + dynamicLogWithPP, + dynamicLogXinerama, + + pprWindowSet, + pprWindowSetXinerama, + + PP(..), defaultPP, dzenPP, sjanssenPP, + wrap, pad, shorten, + xmobarColor, dzenColor, dzenEscape + ) where + +-- +-- Useful imports +-- +import XMonad +import Control.Monad.Reader +import Data.Maybe ( isJust ) +import Data.List +import Data.Ord ( comparing ) +import qualified XMonad.StackSet as S +import Data.Monoid +import XMonad.Util.NamedWindows + +-- $usage +-- +-- To use, set: +-- +-- > import XMonad.Hooks.DynamicLog +-- > logHook = dynamicLog + +-- %import XMonad.Hooks.DynamicLog +-- %def -- comment out default logHook definition above if you uncomment any of these: +-- %def logHook = dynamicLog + + +-- | +-- An example log hook, print a status bar output to stdout, in the form: +-- +-- > 1 2 [3] 4 7 : full : title +-- +-- That is, the currently populated workspaces, the current +-- workspace layout, and the title of the focused window. +-- +dynamicLog :: X () +dynamicLog = dynamicLogWithPP defaultPP + +-- | +-- A log function that uses the 'PP' hooks to customize output. +dynamicLogWithPP :: PP -> X () +dynamicLogWithPP pp = do + spaces <- asks (workspaces . config) + -- layout description + ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current + -- workspace list + ws <- withWindowSet $ return . pprWindowSet spaces pp + -- window title + wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek + + io . putStrLn . sepBy (ppSep pp) . ppOrder pp $ + [ ws + , ppLayout pp ld + , ppTitle pp wt + ] + +-- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen +-- Requires dzen. Workspaces, xinerama, layouts and the window title are handled. +-- +dynamicLogDzen :: X () +dynamicLogDzen = dynamicLogWithPP dzenPP + + +pprWindowSet :: [String] -> PP -> WindowSet -> String +pprWindowSet spaces pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp + (map S.workspace (S.current s : S.visible s) ++ S.hidden s) + where f Nothing Nothing = EQ + f (Just _) Nothing = LT + f Nothing (Just _) = GT + f (Just x) (Just y) = compare x y + + wsIndex = flip elemIndex spaces . S.tag + + cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b) + + this = S.tag (S.workspace (S.current s)) + visibles = map (S.tag . S.workspace) (S.visible s) + + fmt w = printer pp (S.tag w) + where printer | S.tag w == this = ppCurrent + | S.tag w `elem` visibles = ppVisible + | isJust (S.stack w) = ppHidden + | otherwise = ppHiddenNoWindows + +-- | +-- Workspace logger with a format designed for Xinerama: +-- +-- > [1 9 3] 2 7 +-- +-- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively, +-- and 2 and 7 are non-visible, non-empty workspaces +-- +dynamicLogXinerama :: X () +dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama + +pprWindowSetXinerama :: WindowSet -> String +pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen + where onscreen = map (S.tag . S.workspace) + . sortBy (comparing S.screen) $ S.current ws : S.visible ws + offscreen = map S.tag . filter (isJust . S.stack) + . sortBy (comparing S.tag) $ S.hidden ws + +wrap :: String -> String -> String -> String +wrap _ _ "" = "" +wrap l r m = l ++ m ++ r + +pad :: String -> String +pad = wrap " " " " + +shorten :: Int -> String -> String +shorten n xs | length xs < n = xs + | otherwise = (take (n - length end) xs) ++ end + where + end = "..." + +sepBy :: String -> [String] -> String +sepBy sep = concat . intersperse sep . filter (not . null) + +dzenColor :: String -> String -> String -> String +dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2) + where (fg1,fg2) | null fg = ("","") + | otherwise = ("^fg(" ++ fg ++ ")","^fg()") + (bg1,bg2) | null bg = ("","") + | otherwise = ("^bg(" ++ bg ++ ")","^bg()") + +-- | Escape any dzen metacharaters. +dzenEscape :: String -> String +dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) + +xmobarColor :: String -> String -> String -> String +xmobarColor fg bg = wrap t "</fc>" + where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"] + +-- | The 'PP' type allows the user to customize various behaviors of +-- dynamicLogPP +data PP = PP { ppCurrent, ppVisible + , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String + , ppSep, ppWsSep :: String + , ppTitle :: String -> String + , ppLayout :: String -> String + , ppOrder :: [String] -> [String] } + +-- | The default pretty printing options, as seen in dynamicLog +defaultPP :: PP +defaultPP = PP { ppCurrent = wrap "[" "]" + , ppVisible = wrap "<" ">" + , ppHidden = id + , ppHiddenNoWindows = const "" + , ppSep = " : " + , ppWsSep = " " + , ppTitle = shorten 80 + , ppLayout = id + , ppOrder = id } + +-- | Settings to emulate dwm's statusbar, dzen only +dzenPP :: PP +dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad + , ppVisible = dzenColor "black" "#999999" . pad + , ppHidden = dzenColor "black" "#cccccc" . pad + , ppHiddenNoWindows = const "" + , ppWsSep = "" + , ppSep = "" + , ppLayout = dzenColor "black" "#cccccc" . + (\ x -> case x of + "TilePrime Horizontal" -> " TTT " + "TilePrime Vertical" -> " []= " + "Hinted Full" -> " [ ] " + _ -> pad x + ) + , ppTitle = ("^bg(#324c80) " ++) . dzenEscape + } + +-- | The options that sjanssen likes to use, as an example. Note the use of +-- 'xmobarColor' and the record update on defaultPP +sjanssenPP :: PP +sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000" + , ppTitle = xmobarColor "#00ee00" "" . shorten 80 + } diff --git a/XMonad/Hooks/EwmhDesktops b/XMonad/Hooks/EwmhDesktops new file mode 100644 index 0000000..4e2d754 --- /dev/null +++ b/XMonad/Hooks/EwmhDesktops @@ -0,0 +1,130 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.EwmhDesktops +-- Copyright : (c) Joachim Breitner <mail@joachim-breitner.de> +-- License : BSD +-- +-- Maintainer : Joachim Breitner <mail@joachim-breitner.de> +-- Stability : unstable +-- Portability : unportable +-- +-- Makes xmonad use the EWMH hints to tell panel applications about its +-- workspaces and the windows therein. +----------------------------------------------------------------------------- +module XMonadContrib.EwmhDesktops ( + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where + +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) + +import Control.Monad.Reader +import XMonad +import qualified XMonad.StackSet as W +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonadContrib.SetWMName + +-- $usage +-- Add the imports to your configuration file and add the logHook: +-- +-- > import XMonadContrib.EwmhDesktops +-- +-- > logHook :: X() +-- > logHook = do ewmhDesktopsLogHook +-- > return () + +-- %import XMonadContrib.EwmhDesktops +-- %def -- comment out default logHook definition above if you uncomment this: +-- %def logHook = ewmhDesktopsLogHook + + +-- | +-- Notifies pagers and window lists, such as those in the gnome-panel +-- of the current state of workspaces and windows. +ewmhDesktopsLogHook :: X () +ewmhDesktopsLogHook = withWindowSet $ \s -> do + -- Bad hack because xmonad forgets the original order of things, it seems + -- see http://code.google.com/p/xmonad/issues/detail?id=53 + let ws = sortBy (comparing W.tag) $ W.workspaces s + let wins = W.allWindows s + + setSupported + + -- Number of Workspaces + setNumberOfDesktops (length ws) + + -- Names thereof + setDesktopNames (map W.tag ws) + + -- Current desktop + fromMaybe (return ()) $ do + n <- W.lookupWorkspace 0 s + i <- elemIndex n $ map W.tag ws + return $ setCurrentDesktop i + + setClientList wins + + -- Per window Desktop + forM (zip ws [(0::Int)..]) $ \(w, wn) -> + forM (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn + + return () + + +setNumberOfDesktops :: (Integral a) => a -> X () +setNumberOfDesktops n = withDisplay $ \dpy -> do + a <- getAtom "_NET_NUMBER_OF_DESKTOPS" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] + +setCurrentDesktop :: (Integral a) => a -> X () +setCurrentDesktop i = withDisplay $ \dpy -> do + a <- getAtom "_NET_CURRENT_DESKTOP" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] + +setDesktopNames :: [String] -> X () +setDesktopNames names = withDisplay $ \dpy -> do + -- Names thereof + r <- asks theRoot + a <- getAtom "_NET_DESKTOP_NAMES" + c <- getAtom "UTF8_STRING" + let names' = map (fromIntegral.fromEnum) $ + concatMap (("Workspace "++) . (++['\0'])) names + io $ changeProperty8 dpy r a c propModeReplace names' + +setClientList :: [Window] -> X () +setClientList wins = withDisplay $ \dpy -> do + -- (What order do we really need? Something about age and stacking) + r <- asks theRoot + c <- getAtom "WINDOW" + a <- getAtom "_NET_CLIENT_LIST" + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) + a' <- getAtom "_NET_CLIENT_LIST_STACKING" + io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins) + +setWindowDesktop :: (Integral a) => Window -> a -> X () +setWindowDesktop win i = withDisplay $ \dpy -> do + a <- getAtom "_NET_WM_DESKTOP" + c <- getAtom "CARDINAL" + io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] + +setSupported :: X () +setSupported = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_SUPPORTED" + c <- getAtom "ATOM" + supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"] + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) + + setWMName "xmonad" + + diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs new file mode 100644 index 0000000..434701e --- /dev/null +++ b/XMonad/Hooks/ManageDocks.hs @@ -0,0 +1,153 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ManageDocks +-- Copyright : (c) Joachim Breitner <mail@joachim-breitner.de> +-- License : BSD +-- +-- Maintainer : Joachim Breitner <mail@joachim-breitner.de> +-- Stability : unstable +-- Portability : unportable +-- +-- Makes xmonad detect windows with type DOCK and does not put them in +-- layouts. It also detects window with STRUT set and modifies the +-- gap accordingly. +-- +-- It also allows you to reset the gap to reflect the state of current STRUT +-- windows (for example, after you resized or closed a panel), and to toggle the Gap +-- in a STRUT-aware fashion. +----------------------------------------------------------------------------- +module XMonad.Hooks.ManageDocks ( + -- * Usage + -- $usage + manageDocksHook + ,resetGap + ,toggleGap + ,avoidStruts + ) where + +import Control.Monad.Reader +import XMonad +import XMonad.Operations +import qualified XMonad.StackSet as W +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Data.Word (Word32) +import Data.Maybe (catMaybes) + +-- $usage +-- Add the imports to your configuration file and add the mangeHook: +-- +-- > import XMonad.Hooks.ManageDocks +-- +-- > manageHook w _ _ _ = manageDocksHook w +-- +-- and comment out the default `manageHook _ _ _ _ = return id` line. +-- +-- Then you can bind resetGap or toggleGap as you wish: +-- +-- > , ((modMask, xK_b), toggleGap) + +-- %import XMonad.Hooks.ManageDocks +-- %def -- comment out default manageHook definition above if you uncomment this: +-- %def manageHook w _ _ _ = manageDocksHook w +-- %keybind , ((modMask, xK_b), toggleGap) + + +-- | +-- Detects if the given window is of type DOCK and if so, reveals it, but does +-- not manage it. If the window has the STRUT property set, adjust the gap accordingly. +manageDocksHook :: Window -> X (WindowSet -> WindowSet) +manageDocksHook w = do + hasStrut <- getStrut w + maybe (return ()) setGap hasStrut + + isDock <- checkDock w + if isDock then do + reveal w + return (W.delete w) + else do + return id + +-- | +-- Checks if a window is a DOCK window +checkDock :: Window -> X (Bool) +checkDock w = do + a <- getAtom "_NET_WM_WINDOW_TYPE" + d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + mbr <- getProp a w + case mbr of + Just [r] -> return (fromIntegral r == d) + _ -> return False + +-- | +-- Gets the STRUT config, if present, in xmonad gap order +getStrut :: Window -> X (Maybe (Int, Int, Int, Int)) +getStrut w = do + a <- getAtom "_NET_WM_STRUT" + mbr <- getProp a w + case mbr of + Just [l,r,t,b] -> return (Just ( + fromIntegral t, + fromIntegral b, + fromIntegral l, + fromIntegral r)) + _ -> return Nothing + +-- | +-- Helper to read a property +getProp :: Atom -> Window -> X (Maybe [Word32]) +getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w + +-- | +-- Modifies the gap, setting new max +setGap :: (Int, Int, Int, Int) -> X () +setGap gap = modifyGap (\_ -> max4 gap) + + +-- | +-- Goes through the list of windows and find the gap so that all STRUT +-- settings are satisfied. +calcGap :: X (Int, Int, Int, Int) +calcGap = withDisplay $ \dpy -> do + rootw <- asks theRoot + -- We don’t keep track of dock like windows, so we find all of them here + (_,_,wins) <- io $ queryTree dpy rootw + struts <- catMaybes `fmap` mapM getStrut wins + return $ foldl max4 (0,0,0,0) struts + +-- | +-- Adjusts the gap to the STRUTs of all current Windows +resetGap :: X () +resetGap = do + newGap <- calcGap + modifyGap (\_ _ -> newGap) + +-- | +-- Removes the gap or, if already removed, sets the gap according to the windows’ STRUT +toggleGap :: X () +toggleGap = do + newGap <- calcGap + modifyGap (\_ old -> if old == (0,0,0,0) then newGap else (0,0,0,0)) + +-- | +-- Piecewise maximum of a 4-tuple of Ints +max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) +max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4) + +-- | Adjust layout automagically. +avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a +avoidStruts = AvoidStruts + +data AvoidStruts l a = AvoidStruts (l a) deriving ( Read, Show ) + +instance LayoutClass l a => LayoutClass (AvoidStruts l) a where + doLayout (AvoidStruts lo) (Rectangle x y w h) s = + do (t,l,b,r) <- calcGap + let rect = Rectangle (x+10+fromIntegral l) (y+fromIntegral t) + (w-fromIntegral l-fromIntegral r) (h-fromIntegral t-fromIntegral b) + (wrs,mlo') <- doLayout lo rect s + return (wrs, AvoidStruts `fmap` mlo') + handleMessage (AvoidStruts l) m = + do ml' <- handleMessage l m + return (AvoidStruts `fmap` ml') + description (AvoidStruts l) = description l diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs new file mode 100644 index 0000000..30bb4ce --- /dev/null +++ b/XMonad/Hooks/SetWMName.hs @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.SetWMName +-- Copyright : © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com> +-- License : BSD +-- +-- Maintainer : Ivan.Tarasov@gmail.com +-- Stability : experimental +-- Portability : unportable +-- +-- Sets the WM name to a given string, so that it could be detected using +-- _NET_SUPPORTING_WM_CHECK protocol. +-- +-- May be useful for making Java GUI programs work, just set WM name to "LG3D" +-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. +-- +-- Remember that you need to call the setWMName action yourself (at least until +-- we have startup hooks). E.g., you can bind it in your Config.hs: +-- +-- > ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack +-- +-- and press the key combination before running the Java programs (you only +-- need to do it once per XMonad execution) +-- +-- For details on the problems with running Java GUI programs in non-reparenting +-- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and +-- related bugs. +-- +-- Setting WM name to "compiz" does not solve the problem, because of yet +-- another bug in AWT code (related to insets). For LG3D insets are explicitly +-- set to 0, while for other WMs the insets are \"guessed\" and the algorithm +-- fails miserably by guessing absolutely bogus values. +----------------------------------------------------------------------------- + +module XMonad.Hooks.SetWMName ( + setWMName) where + +import Control.Monad (join) +import Control.Monad.Reader (asks) +import Data.Bits ((.|.)) +import Data.Char (ord) +import Data.List (nub) +import Data.Maybe (fromJust, listToMaybe, maybeToList) +import Data.Word (Word8) + +import Foreign.Marshal.Alloc (alloca) + +import XMonad +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Extras + +-- | sets WM name +setWMName :: String -> X () +setWMName name = do + atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom + atom_NET_WM_NAME <- getAtom "_NET_WM_NAME" + atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED" + atom_UTF8_STRING <- getAtom "UTF8_STRING" + + root <- asks theRoot + supportWindow <- getSupportWindow + dpy <- asks display + io $ do + -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window + mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow] + -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder) + changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToWord8List name) + -- declare which _NET protocols are supported (append to the list if it exists) + supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root + changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) + where + netSupportingWMCheckAtom :: X Atom + netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" + + latin1StringToWord8List :: String -> [Word8] + latin1StringToWord8List str = map (fromIntegral . ord) str + + getSupportWindow :: X Window + getSupportWindow = withDisplay $ \dpy -> do + atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom + root <- asks theRoot + supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root + validateWindow (fmap fromIntegral supportWindow) + + validateWindow :: Maybe Window -> X Window + validateWindow w = do + valid <- maybe (return False) isValidWindow w + if valid then + return $ fromJust w + else + createSupportWindow + + -- is there a better way to check the validity of the window? + isValidWindow :: Window -> X Bool + isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do + status <- xGetWindowAttributes dpy w p + return (status /= 0) + + -- this code was translated from C (see OpenBox WM, screen.c) + createSupportWindow :: X Window + createSupportWindow = withDisplay $ \dpy -> do + root <- asks theRoot + let visual = defaultVisual dpy (defaultScreen dpy) -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib + window <- io $ allocaSetWindowAttributes $ \winAttrs -> do + set_override_redirect winAttrs True -- WM cannot decorate/move/close this window + set_event_mask winAttrs propertyChangeMask -- not sure if this is needed + let bogusX = -100 + bogusY = -100 + in + createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs + io $ mapWindow dpy window -- not sure if this is needed + io $ lowerWindow dpy window -- not sure if this is needed + return window diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs new file mode 100644 index 0000000..9163b69 --- /dev/null +++ b/XMonad/Hooks/UrgencyHook.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.UrgencyHook +-- Copyright : Devin Mullins <me@twifkak.com> +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins <me@twifkak.com> +-- Stability : unstable +-- Portability : unportable +-- +-- UrgencyHook lets you configure an action to occur when a window demands +-- your attention. (In traditional WMs, this takes the form of "flashing" +-- on your "taskbar." Blech.) +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.UrgencyHook ( + -- * Usage + -- $usage + withUrgencyHook, + focusUrgent, + readUrgents, + withUrgents + ) where + +import {-# SOURCE #-} Config (urgencyHook, logHook) +import Operations (windows) +import qualified StackSet as W +import XMonad +import XMonad.Layout.LayoutModifier + +import Control.Monad (when) +import Control.Monad.State (gets) +import Data.Bits (testBit, clearBit) +import Data.IORef +import Data.List ((\\), delete) +import Data.Maybe (listToMaybe) +import qualified Data.Set as S +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Foreign (unsafePerformIO) + +-- $usage +-- To wire this up, add: +-- +-- > import XMonad.Hooks.UrgencyHook +-- +-- to your import list in Config. Change your defaultLayout such that +-- withUrgencyHook is applied along the chain. Mine, for example: +-- +-- > layoutHook = Layout $ withUrgencyHook $ windowNavigation $ +-- > Select layouts +-- +-- It shouldn't hurt to have the "withUrgencyHook $" at the outermost layer, +-- as above, as UrgencyHook is a LayoutModifier, and hence passes on any +-- messages sent to it. Next, add your actual urgencyHook to Config. This +-- needs to take a Window and return an X () action. Here's an example: +-- +-- > import XMonad.Util.Dzen +-- ... +-- > urgencyHook :: Window -> X () +-- > urgencyHook = dzenUrgencyHook (5 `seconds`) +-- +-- If you're comfortable with programming in the X monad, then you can build +-- whatever urgencyHook you like. Finally, in order to make this compile, +-- open up your Config.hs-boot file and add the following to it: +-- +-- > urgencyHook :: Window -> X () +-- +-- Compile! +-- +-- You can also modify your logHook to print out information about urgent windows. +-- The functions readUrgents and withUrgents are there to help you with that. +-- No example for you. + +-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. +-- Example keybinding: +-- > , ((modMask , xK_BackSpace), focusUrgent) +focusUrgent :: X () +focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe + +-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use +-- @readUrgents@ or @withUrgents@ instead. +{-# NOINLINE urgents #-} +urgents :: IORef [Window] +urgents = unsafePerformIO (newIORef []) + +readUrgents :: X [Window] +readUrgents = io $ readIORef urgents + +withUrgents :: ([Window] -> X a) -> X a +withUrgents f = readUrgents >>= f + +data WithUrgencyHook a = WithUrgencyHook deriving (Read, Show) + +instance LayoutModifier WithUrgencyHook Window where + handleMess _ mess + | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do + when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do + wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + when (testBit flags urgencyHintBit) $ do + urgencyHook w + -- Clear the urgency bit in the WMHints flags field. According to the + -- Xlib manual, the *client* is supposed to clear this flag when the urgency + -- has been resolved, but, Xchat2, for example, sets the WMHints several + -- times (e.g. causing the dzen to blink) unless it's cleared. XMonad is + -- not a typical WM, so we're just breaking one more rule, here. + io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + adjustUrgents (\ws -> if elem w ws then ws else w : ws) + logHook -- call logHook after IORef has been modified + -- Doing the setWMHints triggers another propertyNotify with the bit + -- cleared, so we ignore that message. This has the potentially wrong + -- effect of ignoring *all* urgency-clearing messages, some of which might + -- be legitimate. Let's wait for bug reports on that, though. + return Nothing + | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do + adjustUrgents (delete w) + return Nothing + | otherwise = + return Nothing + + -- Clear the urgency bit and remove from the urgent list when the window becomes visible. + redoLayout _ _ _ windowRects = do + visibles <- gets mapped + adjustUrgents (\\ (S.toList visibles)) + return (windowRects, Nothing) + +adjustUrgents :: ([Window] -> [Window]) -> X () +adjustUrgents f = io $ modifyIORef urgents f + +withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window +withUrgencyHook = ModifiedLayout WithUrgencyHook diff --git a/XMonad/Hooks/XPropManage.hs b/XMonad/Hooks/XPropManage.hs new file mode 100644 index 0000000..245a6a6 --- /dev/null +++ b/XMonad/Hooks/XPropManage.hs @@ -0,0 +1,91 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.XPropManage +-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de> +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel <kuser@gmx.de> +-- Stability : unstable +-- Portability : unportable +-- +-- A ManageHook matching on XProperties. +----------------------------------------------------------------------------- + +module XMonad.Hooks.XPropManage ( + -- * Usage + -- $usage + xPropManageHook, XPropMatch, pmX, pmP + ) where + +import Data.Char (chr) +import Data.List (concat) + +import Control.Monad.State +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad + +-- $usage +-- +-- Add something like the following lines to Config.hs to use this module +-- +-- > import XMonad.Hooks.XPropManage +-- +-- > manageHook = xPropManageHook xPropMatches +-- > +-- > xPropMatches :: [XPropMatch] +-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==)))], (\w -> float w >> return (W.shift "2"))) +-- > , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen")) +-- > , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3")) +-- > ] +-- +-- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND +-- +-- A XPropMatch consists of a list of conditions and function telling what to do. +-- +-- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1, +-- and an function which matches onto the value of the property (represented as a List +-- of Strings). +-- +-- If a match succeeds the function is called immediately, can perform any action and then return +-- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the +-- WindowSet use just 'pmP function'. +-- +-- \*1 You can get the available properties of an application with the xprop utility. STRING properties +-- should work fine. Others might not work. +-- + +type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet))) + +pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) +pmX f w = f w >> return id + +pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet) +pmP f _ = return f + +xPropManageHook :: [XPropMatch] -> Window -> X (WindowSet -> WindowSet) +xPropManageHook tms w = withDisplay $ \d -> do + fs <- mapM (matchProp d w `uncurry`) tms + return (foldr (.) id fs) + +matchProp :: Display -> Window -> [(Atom, [String] -> Bool)] -> (Window -> X (WindowSet -> WindowSet)) -> X (WindowSet -> WindowSet) +matchProp d w tm tf = do + m <- and `liftM` sequence (map (\(k,f) -> f `liftM` getProp d w k) tm) + case m of + True -> tf w + False -> return id + +getProp :: Display -> Window -> Atom -> X ([String]) +getProp d w p = do + prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]]) + let filt q | q == wM_COMMAND = concat . map splitAtNull + | otherwise = id + return (filt p prop) + +splitAtNull :: String -> [String] +splitAtNull s = case dropWhile (== (chr 0)) s of + "" -> [] + s' -> w : splitAtNull s'' + where (w, s'') = break (== (chr 0)) s' + |