diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index 2d04fd307c..baf511f3e2 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -33,7 +33,7 @@ import Data.Maybe (listToMaybe,fromJust,isNothing) import qualified XMonad.StackSet as W import qualified Data.Set as S -import XMonad.Hooks.ManageDocks (calcGapForAll) +import XMonad.Hooks.ManageDocks (calcGap) import XMonad.Util.Types (Direction2D(..)) import XMonad.Actions.AfterDrag @@ -291,7 +291,7 @@ getSnap horiz collidedist d w = do screen <- W.current <$> gets windowset let sr = screenRect $ W.screenDetail screen wl = W.integrate' . W.stack $ W.workspace screen - gr <- fmap ($sr) $ calcGapForAll $ S.fromList [minBound .. maxBound] + gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound] wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) return ( neighbours (back wa sr gr wla) (wpos wa) diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index e0aaea6819..826b66a63f 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -180,8 +180,7 @@ bluetileManageHook :: ManageHook bluetileManageHook = composeAll [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) , className =? "MPlayer" --> doFloat - , isFullscreen --> doFullFloat - , manageDocks] + , isFullscreen --> doFullFloat] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( named "Floating" floating ||| @@ -199,6 +198,7 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = + docks $ def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs index 088aef8780..46d75f7a4d 100644 --- a/XMonad/Config/Desktop.hs +++ b/XMonad/Config/Desktop.hs @@ -164,11 +164,9 @@ import qualified Data.Map as M -- > adjustEventInput -- -desktopConfig = ewmh def - { startupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook <+> startupHook def +desktopConfig = docks $ ewmh def + { startupHook = setDefaultCursor xC_left_ptr <+> startupHook def , layoutHook = desktopLayoutModifiers $ layoutHook def - , manageHook = manageDocks <+> manageHook def - , handleEventHook = docksEventHook <+> handleEventHook def , keys = desktopKeys <+> keys def } desktopKeys (XConfig {modMask = modm}) = M.fromList $ diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs index a4b6aa6bab..4a85ba61e5 100644 --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -205,7 +205,7 @@ instance PPrint ScreenId instance (Show a, Show b) => PPrint (Map a b) -- }}} -- main {{{ -dmwitConfig nScreens = def { +dmwitConfig nScreens = docks $ def { borderWidth = 2, workspaces = withScreens nScreens (map show [1..5]), terminal = "urxvt", @@ -221,7 +221,6 @@ dmwitConfig nScreens = def { <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169) <+> fullscreenMPlayer <+> floatAll ["Gimp", "Wine"] - <+> manageDocks <+> manageSpawn, logHook = allPPs nScreens, startupHook = refresh diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index a26dbaea51..31f560ce64 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -42,7 +42,7 @@ import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), Direction1D( Prev, Next) ) -import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) +import XMonad.Hooks.ManageDocks ( avoidStruts, docks ) import XMonad.Hooks.EwmhDesktops ( ewmh ) myXPConfig :: XPConfig @@ -117,7 +117,7 @@ keys x = M.fromList $ ++ zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) -config = ewmh def +config = docks $ ewmh def { borderWidth = 1 -- Width of the window border in pixels. , XMonad.workspaces = ["mutt","iceweasel"] , layoutHook = showWName $ workspaceDir "~" $ @@ -129,7 +129,6 @@ config = ewmh def named "widescreen" ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 - , manageHook = manageHook def <+> manageDocks -- add panel-handling , terminal = "xterm" -- The preferred terminal program. , normalBorderColor = "#222222" -- Border color for unfocused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows. diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs index 1f2d66e593..919ad0e7e6 100644 --- a/XMonad/Config/Sjanssen.hs +++ b/XMonad/Config/Sjanssen.hs @@ -21,7 +21,7 @@ import XMonad.Layout.TwoPane import qualified Data.Map as M sjanssenConfig = - ewmh $ def + docks $ ewmh $ def { terminal = "exec urxvt" , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ @@ -35,7 +35,7 @@ sjanssenConfig = | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] - <+> manageHook def <+> manageDocks <+> manageSpawn + <+> manageHook def <+> manageSpawn <+> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index c13a2fb52c..ba673d9e2e 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -199,12 +199,11 @@ statusBar :: LayoutClass l Window -> IO (XConfig (ModifiedLayout AvoidStruts l)) statusBar cmd pp k conf = do h <- spawnPipe cmd - return $ conf + return $ docks $ conf { layoutHook = avoidStruts (layoutHook conf) , logHook = do logHook conf dynamicLogWithPP pp { ppOutput = hPutStrLn h } - , manageHook = manageHook conf <+> manageDocks , keys = liftM2 M.union keys' (keys conf) } where diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 9176691366..2508b7edb5 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -47,7 +47,7 @@ import XMonad.Util.WindowProperties (getProp32) -- > main = xmonad $ ewmh def{ handleEventHook = -- > handleEventHook def <+> fullscreenEventHook } -- --- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks". +-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". -- | Add EWMH functionality to the given config. See above for an example. diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index a1ee158ae3..d11d8110aa 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -15,7 +15,7 @@ module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage - manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, + docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, docksEventHook, docksStartupHook, ToggleStruts(..), SetStruts(..), @@ -28,7 +28,7 @@ module XMonad.Hooks.ManageDocks ( #endif -- for XMonad.Actions.FloatSnap - calcGap, calcGapForAll + calcGap ) where @@ -39,12 +39,12 @@ import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.XUtils (fi) +import qualified XMonad.Util.ExtensibleState as XS import Data.Monoid (All(..), mempty) import Data.Functor((<$>)) import qualified Data.Set as S import qualified Data.Map as M -import Data.Maybe (fromMaybe) import Control.Monad (when, forM_, filterM) -- $usage @@ -52,25 +52,16 @@ import Control.Monad (when, forM_, filterM) -- -- > import XMonad.Hooks.ManageDocks -- --- The first component is a 'ManageHook' which recognizes these --- windows and de-manages them, so that xmonad does not try to tile --- them. To enable it: +-- Wrap your xmonad config with a call to 'docks', like so: -- --- > manageHook = ... <+> manageDocks +-- > main = xmonad $ docks def -- --- The second component is a layout modifier that prevents windows --- from overlapping these dock windows. It is intended to replace --- xmonad's so-called \"gap\" support. First, you must add it to your --- list of layouts: +-- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout +-- to prevent windows from overlapping these windows. -- -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- > where tall = Tall 1 (3/100) (1/2) -- --- The third component is an event hook that causes new docks to appear --- immediately, instead of waiting for the next focus change. --- --- > handleEventHook = ... <+> docksEventHook --- -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- similar to: -- @@ -90,17 +81,36 @@ import Control.Monad (when, forM_, filterM) -- -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- --- /Important note/: if you are switching from manual gaps --- (defaultGaps in your config) to avoidStruts (recommended, since --- manual gaps will probably be phased out soon), be sure to switch --- off all your gaps (with mod-b) /before/ reloading your config with --- avoidStruts! Toggling struts with a 'ToggleStruts' message will --- not work unless your gaps are set to zero. --- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- +-- | Add docks functionality to the given config. See above for an example. +docks :: XConfig a -> XConfig a +docks c = c { startupHook = docksStartupHook <+> startupHook c + , handleEventHook = docksEventHook <+> handleEventHook c + , manageHook = manageDocks <+> manageHook c } + +newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] } + deriving (Eq, Typeable) + +data UpdateDocks = UpdateDocks deriving Typeable +instance Message UpdateDocks + +refreshDocks :: X () +refreshDocks = sendMessage UpdateDocks + +instance ExtensionClass StrutCache where + initialValue = StrutCache M.empty + +updateStrutCache :: Window -> [Strut] -> X Bool +updateStrutCache w strut = do + XS.modified $ StrutCache . M.insert w strut . fromStrutCache + +deleteFromStructCache :: Window -> X Bool +deleteFromStructCache w = do + XS.modified $ StrutCache . M.delete w . fromStrutCache + -- | Detects if the given window is of type DOCK and if so, reveals -- it, but does not manage it. manageDocks :: ManageHook @@ -125,9 +135,8 @@ checkDock = ask >>= \w -> liftX $ do docksEventHook :: Event -> X All docksEventHook (MapNotifyEvent { ev_window = w }) = do whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do - strut <- getRawStrut w - sendMessage $ UpdateDock w strut - broadcastMessage $ UpdateDock w strut + strut <- getStrut w + whenX (updateStrutCache w strut) refreshDocks return (All True) docksEventHook (PropertyEvent { ev_window = w , ev_atom = a }) = do @@ -135,13 +144,11 @@ docksEventHook (PropertyEvent { ev_window = w nws <- getAtom "_NET_WM_STRUT" nwsp <- getAtom "_NET_WM_STRUT_PARTIAL" when (a == nws || a == nwsp) $ do - strut <- getRawStrut w - broadcastMessage $ UpdateDock w strut - refresh + strut <- getStrut w + whenX (updateStrutCache w strut) refreshDocks return (All True) docksEventHook (DestroyWindowEvent {ev_window = w}) = do - sendMessage (RemoveDock w) - broadcastMessage (RemoveDock w) + whenX (deleteFromStructCache w) refreshDocks return (All True) docksEventHook _ = return (All True) @@ -151,23 +158,9 @@ docksStartupHook = withDisplay $ \dpy -> do (_,_,wins) <- io $ queryTree dpy rootw docks <- filterM (runQuery checkDock) wins forM_ docks $ \win -> do - strut <- getRawStrut win - broadcastMessage (UpdateDock win strut) - refresh - -getRawStrut :: Window -> X (Maybe (Either [CLong] [CLong])) -getRawStrut w = do - msp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT_PARTIAL" w - if null msp - then do - mp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT" w - if null mp then return Nothing - else return $ Just (Left mp) - else return $ Just (Right msp) - -getRawStruts :: [Window] -> X (M.Map Window (Maybe (Either [CLong] [CLong]))) -getRawStruts wins = M.fromList <$> zip wins <$> mapM getRawStrut wins - + strut <- getStrut win + updateStrutCache win strut + refreshDocks -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] @@ -185,18 +178,12 @@ getStrut w = do [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] parseStrutPartial _ = [] -calcGapForAll :: S.Set Direction2D -> X (Rectangle -> Rectangle) -calcGapForAll ss = withDisplay $ \dpy -> do - rootw <- asks theRoot - (_,_,wins) <- io $ queryTree dpy rootw - calcGap wins ss - -- | Goes through the list of windows and find the gap so that all -- STRUT settings are satisfied. -calcGap :: [Window] -> S.Set Direction2D -> X (Rectangle -> Rectangle) -calcGap wins ss = withDisplay $ \dpy -> do +calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) +calcGap ss = withDisplay $ \dpy -> do rootw <- asks theRoot - struts <- (filter careAbout . concat) `fmap` mapM getStrut wins + struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache) -- we grab the window attributes of the root window rather than checking -- the width of the screen because xlib caches this info and it tends to @@ -218,13 +205,9 @@ avoidStrutsOn :: LayoutClass l a => [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a -avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing M.empty +avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) -data AvoidStruts a = AvoidStruts { - avoidStrutsDirection :: S.Set Direction2D, - avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle), - strutMap :: M.Map Window (Maybe (Either [CLong] [CLong])) -} deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show ) -- | Message type which can be sent to an 'AvoidStruts' layout -- modifier to alter its behavior. @@ -234,15 +217,6 @@ data ToggleStruts = ToggleStruts instance Message ToggleStruts - --- | message sent to ensure that caching the gaps won't give a wrong result --- because a new dock has been added -data DockMessage = UpdateDock Window (Maybe (Either [CLong] [CLong])) - | RemoveDock Window - deriving (Read,Show,Typeable) -instance Message DockMessage - - -- | SetStruts is a message constructor used to set or unset specific struts, -- regardless of whether or not the struts were originally set. Here are some -- example bindings: @@ -270,44 +244,18 @@ data SetStruts = SetStruts { addedStruts :: [Direction2D] instance Message SetStruts instance LayoutModifier AvoidStruts a where - modifyLayoutWithUpdate as@(AvoidStruts ss cache smap) w r = do - let dockWins = M.keys smap - (nr, nsmap) <- case cache of - Just (ss', r', nr) | ss' == ss, r' == r -> do - nsmap <- getRawStruts dockWins - if nsmap /= smap - then do - wnr <- fmap ($ r) (calcGap dockWins ss) - setWorkarea wnr - return (wnr, nsmap) - else do - return (nr, smap) - _ -> do - nsset <- getRawStruts dockWins - nr <- fmap ($ r) (calcGap dockWins ss) - setWorkarea nr - return (nr, nsset) - arranged <- runLayout w nr - let newCache = Just (ss, r, nr) - return (arranged, if newCache == cache && smap == nsmap - then Nothing - else Just as { avoidStrutsRectCache = newCache - , strutMap = nsmap }) - - pureMess as@(AvoidStruts { avoidStrutsDirection = ss, strutMap = sm }) m - | Just ToggleStruts <- fromMessage m = Just $ as { avoidStrutsDirection = toggleAll ss } - | Just (ToggleStrut s) <- fromMessage m = Just $ as { avoidStrutsDirection = toggleOne s ss } + modifyLayout (AvoidStruts ss) w r = do + srect <- fmap ($ r) (calcGap ss) + setWorkarea srect + runLayout w srect + + pureMess as@(AvoidStruts ss) m + | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss) + | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss) | Just (SetStruts n k) <- fromMessage m , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) - , newSS /= ss = Just $ as { avoidStrutsDirection = newSS } - | Just (UpdateDock dock strut) <- fromMessage m = if maybe True (/= strut) (M.lookup dock sm) - then Just $ as { avoidStrutsRectCache = Nothing - , strutMap = M.insert dock strut sm } - else Nothing - | Just (RemoveDock dock) <- fromMessage m = if M.member dock sm - then Just $ as { avoidStrutsRectCache = Nothing - , strutMap = M.delete dock sm } - else Nothing + , newSS /= ss = Just $ AvoidStruts newSS + | Just UpdateDocks <- fromMessage m = Just as | otherwise = Nothing where toggleAll x | S.null x = S.fromList [minBound .. maxBound] | otherwise = S.empty diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs index 2a41cf6763..e32c3c919a 100644 --- a/XMonad/Hooks/PositionStoreHooks.hs +++ b/XMonad/Hooks/PositionStoreHooks.hs @@ -88,7 +88,7 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do else do sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) let sr = screenRect . W.screenDetail $ sc - sr' <- fmap ($ sr) (calcGapForAll $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting + sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting -- a somewhat unfortunate inter-dependency -- with 'XMonad.Hooks.ManageDocks' modifyPosStore (\ps -> posStoreInsert ps w diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs index 9a7e23aab2..0f4a799873 100644 --- a/XMonad/Layout/DecorationAddons.hs +++ b/XMonad/Layout/DecorationAddons.hs @@ -106,8 +106,8 @@ handleScreenCrossing w decoWin = withDisplay $ \d -> do {-- somewhat ugly hack to get proper ScreenRect, creates unwanted inter-dependencies TODO: get ScreenRects in a proper way --} - oldScreenRect' <- fmap ($ oldScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) - newScreenRect' <- fmap ($ newScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) + oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) + newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) wa <- io $ getWindowAttributes d decoWin modifyPosStore (\ps -> posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs index 7fe3b0a77a..7e12a12cff 100644 --- a/XMonad/Util/ExtensibleState.hs +++ b/XMonad/Util/ExtensibleState.hs @@ -21,6 +21,7 @@ module XMonad.Util.ExtensibleState ( , remove , get , gets + , modified ) where import Data.Typeable (typeOf,cast) @@ -115,3 +116,10 @@ gets = flip fmap get -- | Remove the value from the extensible state field that has the same type as the supplied argument remove :: ExtensionClass a => a -> X () remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) + +modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool +modified f = do + v <- get + case f v of + v' | v' == v -> return False + | otherwise -> put v' >> return True