twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #80 from f1u77y/managedocks-global-cache

Browse Source 
Make strut cache global
This commit is contained in:
Brent Yorgey 2016-11-03 17:40:04 -04:00 committed by GitHub
commit ec5f9a9e59
12 changed files with 79 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
XMonad/Actions/FloatSnap.hs
View File

@ -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)

4
XMonad/Config/Bluetile.hs
View File

@ -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,

6
XMonad/Config/Desktop.hs
View File

@ -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 $

3
XMonad/Config/Dmwit.hs
View File

@ -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

5
XMonad/Config/Droundy.hs
View File

@ -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.

4
XMonad/Config/Sjanssen.hs
View File

@ -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
}

3
XMonad/Hooks/DynamicLog.hs
View File

@ -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

2
XMonad/Hooks/EwmhDesktops.hs
View File

@ -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.

162
XMonad/Hooks/ManageDocks.hs
View File

@ -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 })
modifyLayout (AvoidStruts ss) w r = do
srect <- fmap ($ r) (calcGap ss)
setWorkarea srect
runLayout w srect
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 }
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

2
XMonad/Hooks/PositionStoreHooks.hs
View File

@ -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

4
XMonad/Layout/DecorationAddons.hs
View File

@ -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)

8
XMonad/Util/ExtensibleState.hs
View File

@ -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