control: tag -1 +moreinfo Hello,
On Sat, Aug 06, 2016 at 04:23:02PM +0200, Jonas Smedegaard wrote: > According to > https://wiki.haskell.org/Xmonad/Notable_changes_since_0.11#.2AURGENT.2A_Bug_in_0.12_ManageDocks > there is a bug in release 0.12 needing cherry-picking from git. I can't reproduce this bug locally. However, the attached patch is all of upstream's recent commits that look to concern ManageDocks. If anyone is seeing this bug, please apply this patch to the source package and let us know if it fixes the problem. To examine the individual commits I cherry-picked, see branch fix-managedocks of repo <https://git.spwhitton.name/xmonad-contrib>, from which I generated the patch. -- Sean Whitton
From 6646f5944d945284106cef1d8d811ca0496d434e Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhit...@spwhitton.name>
Date: Sun, 3 Jan 2016 12:37:16 +0300
Subject: [PATCH] fix xmonad/xmonad#21
The following commits, from various authors in the upstream git
repository, are squashed into this commit:
fix build with older ghc
never query all the tree in X.H.ManageHook
minor fixes in X.H.ManageDocks
fix X.H.PositionStoreHooks for new signature of calcGaps
add calcGapForAll for other modules
typo
add new dock if it hasn't strut properties
handle PropertyNotify events on docks
add docksStartupHook for handling docks when restarted
handle docks remove correctly
fix slowdown when removing docks
some minor fixes in X.H.ManageDocks
send all docks messages only from event hook
Update XMonad.Config.Desktop for 0.12 ManageDocks
---
XMonad/Actions/FloatSnap.hs | 4 +-
XMonad/Config/Desktop.hs | 5 +-
XMonad/Config/Gnome.hs | 3 +-
XMonad/Config/Kde.hs | 3 +-
XMonad/Config/Mate.hs | 3 +-
XMonad/Config/Xfce.hs | 3 +-
XMonad/Hooks/ManageDocks.hs | 122 +++++++++++++++++++++++++++++--------
XMonad/Hooks/PositionStoreHooks.hs | 8 ++-
XMonad/Layout/DecorationAddons.hs | 4 +-
9 files changed, 116 insertions(+), 39 deletions(-)
diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs
index baf511f..2d04fd3 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 (calcGap)
+import XMonad.Hooks.ManageDocks (calcGapForAll)
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) $ calcGap $ S.fromList [minBound .. maxBound]
+ gr <- fmap ($sr) $ calcGapForAll $ 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/Desktop.hs b/XMonad/Config/Desktop.hs
index add5548..088aef8 100644
--- a/XMonad/Config/Desktop.hs
+++ b/XMonad/Config/Desktop.hs
@@ -165,9 +165,10 @@ import qualified Data.Map as M
--
desktopConfig = ewmh def
- { startupHook = setDefaultCursor xC_left_ptr
+ { startupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook <+> startupHook def
, layoutHook = desktopLayoutModifiers $ layoutHook def
- , manageHook = manageHook def <+> manageDocks
+ , manageHook = manageDocks <+> manageHook def
+ , handleEventHook = docksEventHook <+> handleEventHook def
, keys = desktopKeys <+> keys def }
desktopKeys (XConfig {modMask = modm}) = M.fromList $
diff --git a/XMonad/Config/Gnome.hs b/XMonad/Config/Gnome.hs
index 3ab7270..aa506e1 100644
--- a/XMonad/Config/Gnome.hs
+++ b/XMonad/Config/Gnome.hs
@@ -18,7 +18,8 @@ module XMonad.Config.Gnome (
-- $usage
gnomeConfig,
gnomeRun,
- gnomeRegister
+ gnomeRegister,
+ desktopLayoutModifiers
) where
import XMonad
diff --git a/XMonad/Config/Kde.hs b/XMonad/Config/Kde.hs
index bda58a4..8046804 100644
--- a/XMonad/Config/Kde.hs
+++ b/XMonad/Config/Kde.hs
@@ -17,7 +17,8 @@ module XMonad.Config.Kde (
-- * Usage
-- $usage
kdeConfig,
- kde4Config
+ kde4Config,
+ desktopLayoutModifiers
) where
import XMonad
diff --git a/XMonad/Config/Mate.hs b/XMonad/Config/Mate.hs
index d54f03c..16b1cce 100644
--- a/XMonad/Config/Mate.hs
+++ b/XMonad/Config/Mate.hs
@@ -20,7 +20,8 @@ module XMonad.Config.Mate (
-- $usage
mateConfig,
mateRun,
- mateRegister
+ mateRegister,
+ desktopLayoutModifiers
) where
import XMonad
diff --git a/XMonad/Config/Xfce.hs b/XMonad/Config/Xfce.hs
index c6bca4c..713b975 100644
--- a/XMonad/Config/Xfce.hs
+++ b/XMonad/Config/Xfce.hs
@@ -16,7 +16,8 @@
module XMonad.Config.Xfce (
-- * Usage
-- $usage
- xfceConfig
+ xfceConfig,
+ desktopLayoutModifiers
) where
import XMonad
diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs
index a8acb96..93d131b 100644
--- a/XMonad/Hooks/ManageDocks.hs
+++ b/XMonad/Hooks/ManageDocks.hs
@@ -16,7 +16,7 @@ module XMonad.Hooks.ManageDocks (
-- * Usage
-- $usage
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
- docksEventHook,
+ docksEventHook, docksStartupHook,
ToggleStruts(..),
SetStruts(..),
module XMonad.Util.Types,
@@ -28,7 +28,7 @@ module XMonad.Hooks.ManageDocks (
#endif
-- for XMonad.Actions.FloatSnap
- calcGap
+ calcGap, calcGapForAll
) where
@@ -40,8 +40,12 @@ import XMonad.Util.Types
import XMonad.Util.WindowProperties (getProp32s)
import XMonad.Util.XUtils (fi)
import Data.Monoid (All(..), mempty)
+import Data.Functor((<$>))
import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe, catMaybes)
+import Control.Monad (when, forM_, filterM)
-- $usage
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -100,9 +104,10 @@ import qualified Data.Set as S
-- | Detects if the given window is of type DOCK and if so, reveals
-- it, but does not manage it.
manageDocks :: ManageHook
-manageDocks = checkDock --> (doIgnore <+> clearGapCache)
- where clearGapCache = do
- liftX (broadcastMessage ClearGapCache)
+manageDocks = checkDock --> (doIgnore <+> setDocksMask)
+ where setDocksMask = do
+ ask >>= \win -> liftX $ withDisplay $ \dpy -> do
+ io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
mempty
-- | Checks if a window is a DOCK or DESKTOP window
@@ -118,13 +123,52 @@ checkDock = ask >>= \w -> liftX $ do
-- | Whenever a new dock appears, refresh the layout immediately to avoid the
-- new dock.
docksEventHook :: Event -> X All
-docksEventHook (MapNotifyEvent {ev_window = w}) = do
- whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) $ do
- broadcastMessage ClearGapCache
- refresh
+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
+ return (All True)
+docksEventHook (PropertyEvent { ev_window = w
+ , ev_atom = a }) = do
+ whenX (runQuery checkDock w) $ do
+ 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
+ return (All True)
+docksEventHook (DestroyWindowEvent {ev_window = w}) = do
+ sendMessage (RemoveDock w)
+ broadcastMessage (RemoveDock w)
return (All True)
docksEventHook _ = return (All True)
+docksStartupHook :: X ()
+docksStartupHook = withDisplay $ \dpy -> do
+ rootw <- asks theRoot
+ (_,_,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
+
+
-- | Gets the STRUT config, if present, in xmonad gap order
getStrut :: Window -> X [Strut]
getStrut w = do
@@ -141,13 +185,17 @@ 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 :: S.Set Direction2D -> X (Rectangle -> Rectangle)
-calcGap ss = withDisplay $ \dpy -> do
+calcGap :: [Window] -> S.Set Direction2D -> X (Rectangle -> Rectangle)
+calcGap wins ss = 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 <- (filter careAbout . concat) `fmap` mapM getStrut wins
-- we grab the window attributes of the root window rather than checking
@@ -170,11 +218,12 @@ avoidStrutsOn :: LayoutClass l a =>
[Direction2D]
-> l a
-> ModifiedLayout AvoidStruts l a
-avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing
+avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing M.empty
data AvoidStruts a = AvoidStruts {
avoidStrutsDirection :: S.Set Direction2D,
- avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle )
+ avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle),
+ strutMap :: M.Map Window (Maybe (Either [CLong] [CLong]))
} deriving ( Read, Show )
-- | Message type which can be sent to an 'AvoidStruts' layout
@@ -188,9 +237,11 @@ 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 ClearGapCache = ClearGapCache
+data DockMessage = UpdateDock Window (Maybe (Either [CLong] [CLong]))
+ | RemoveDock Window
deriving (Read,Show,Typeable)
-instance Message ClearGapCache
+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
@@ -219,26 +270,45 @@ data SetStruts = SetStruts { addedStruts :: [Direction2D]
instance Message SetStruts
instance LayoutModifier AvoidStruts a where
- modifyLayoutWithUpdate as@(AvoidStruts ss cache) w r = do
- nr <- case cache of
- Just (ss', r', nr) | ss' == ss, r' == r -> return nr
+ modifyLayoutWithUpdate as@(AvoidStruts ss cache smap) w r = do
+ let dockWins = M.keys smap
+ nsmap <- getRawStruts dockWins
+ (nr, nsmap) <- case cache of
+ Just (ss', r', nr) | ss' == ss, r' == r -> do
+ nsmap <- getRawStruts dockWins
+ if nsmap /= smap
+ then do
+ nr <- fmap ($ r) (calcGap dockWins ss)
+ setWorkarea nr
+ return (nr, nsmap)
+ else do
+ return (nr, smap)
_ -> do
- nr <- fmap ($ r) (calcGap ss)
+ nsset <- getRawStruts dockWins
+ nr <- fmap ($ r) (calcGap dockWins ss)
setWorkarea nr
- return nr
+ return (nr, nsset)
arranged <- runLayout w nr
let newCache = Just (ss, r, nr)
- return (arranged, if newCache == cache
+ return (arranged, if newCache == cache && smap == nsmap
then Nothing
- else Just as{ avoidStrutsRectCache = newCache } )
+ else Just as { avoidStrutsRectCache = newCache
+ , strutMap = nsmap })
- pureMess as@(AvoidStruts { avoidStrutsDirection = ss }) m
+ 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 }
| 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 ClearGapCache <- fromMessage m = Just $ as { avoidStrutsRectCache = Nothing }
+ | 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
| 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 17ef59b..4e21caf 100644
--- a/XMonad/Hooks/PositionStoreHooks.hs
+++ b/XMonad/Hooks/PositionStoreHooks.hs
@@ -88,9 +88,11 @@ 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) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting
- -- a somewhat unfortunate inter-dependency
- -- with 'XMonad.Hooks.ManageDocks'
+ rootw <- asks theRoot
+ (_,_,wins) <- io $ queryTree d rootw
+ sr' <- fmap ($ sr) (calcGapForAll $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting
+ -- a somewhat unfortunate inter-dependency
+ -- with 'XMonad.Hooks.ManageDocks'
modifyPosStore (\ps -> posStoreInsert ps w
(Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
(fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs
index 0f4a799..9a7e23a 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) (calcGap $ S.fromList [minBound .. maxBound])
- newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound])
+ oldScreenRect' <- fmap ($ oldScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound])
+ newScreenRect' <- fmap ($ newScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound])
wa <- io $ getWindowAttributes d decoWin
modifyPosStore (\ps ->
posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa)
--
2.8.1
signature.asc
Description: PGP signature
_______________________________________________ Pkg-haskell-maintainers mailing list Pkg-haskell-maintainers@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-haskell-maintainers
