twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-07-26 09:41:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'upstream/master'

Browse Source
This commit is contained in:
brandon s allbery kf8nh
2016-04-06 21:24:21 -04:00
parent 3796569268 01ea659a06
commit abe911a8d6
12 changed files with 156 additions and 56 deletions
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 (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)

14
XMonad/Actions/FocusNth.hs
View File

@@ -14,7 +14,8 @@
module XMonad.Actions.FocusNth (
-- * Usage
-- $usage
focusNth,focusNth') where
focusNth,focusNth',
swapNth,swapNth') where
import XMonad.StackSet
import XMonad
@@ -41,6 +42,17 @@ focusNth' :: Int -> Stack a -> Stack a
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
| otherwise = listToStack n (integrate s)
-- | Swap current window with nth. Focus stays in the same position
swapNth :: Int -> X ()
swapNth = windows . modify' . swapNth'
swapNth' :: Int -> Stack a -> Stack a
swapNth' n s@(Stack c l r)
| (n < 0) || (n > length l + length r) || (n == length l) = s
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
listToStack :: Int -> [a] -> Stack a
listToStack n l = Stack t ls rs
where

3
XMonad/Actions/GridSelect.hs
View File

@@ -653,7 +653,7 @@ gridselect gsconfig elements =
liftIO $ mapWindow dpy win
liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
font <- initXMF (gs_font gsconfig)
let screenWidth = toInteger $ rect_width scr
screenHeight = toInteger $ rect_height scr
@@ -682,6 +682,7 @@ gridselect gsconfig elements =
liftIO $ do
unmapWindow dpy win
destroyWindow dpy win
ungrabPointer dpy currentTime
sync dpy False
releaseXMF font
return selectedElement

5
XMonad/Hooks/DynamicBars.hs
View File

@@ -31,7 +31,7 @@ import Control.Monad.Writer (WriterT, execWriterT, tell)
import Data.Maybe
import Data.Monoid
import Data.Traversable (traverse)
import Data.Foldable (traverse_)
import Graphics.X11.Xinerama
import Graphics.X11.Xlib
@@ -118,10 +118,9 @@ multiPP' dynlStr focusPP unfocusPP handles = do
out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
when isFoc $ get >>= tell . Last . Just
return out
traverse put . getLast
traverse_ put . getLast
=<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
=<< mapM screenWorkspace (zipWith const [0 .. ] handles)
return ()
getScreens :: MonadIO m => m [ScreenId]
getScreens = liftIO $ do

122
XMonad/Hooks/ManageDocks.hs
View File

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

8
XMonad/Hooks/PositionStoreHooks.hs
View File

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

1
XMonad/Hooks/ScreenCorners.hs
View File

@@ -185,6 +185,7 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
-- > ]
--
-- Then add layout hook:
--
-- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where
-- > tiled = Tall nmaster delta ratio
-- > nmaster = 1

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) (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
XMonad/Layout/Groups/Wmii.hs
View File

@@ -114,7 +114,7 @@ zoomGroupReset = zoomColumnReset
-- | Toggle whether the currently focused group should be maximized
-- whenever it has focus.
toggleGroupFull :: X ()
toggleGroupFull = toggleGroupFull
toggleGroupFull = toggleColumnFull
-- | Rotate the layouts in the focused group.
groupToNextLayout :: X ()

30
XMonad/Layout/IfMax.hs
View File

@@ -14,7 +14,7 @@
--
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module XMonad.Layout.IfMax
( -- * Usage
@@ -23,6 +23,10 @@ module XMonad.Layout.IfMax
, ifMax
) where
import Control.Applicative((<$>))
import Control.Arrow
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import XMonad
@@ -47,22 +51,32 @@ import qualified XMonad.StackSet as W
data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w)
deriving (Read, Show)
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (IfMax l1 l2) a where
instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 l2) Window where
runLayout (W.Workspace _ (IfMax n l1 l2) s) rect = arrange (W.integrate' s)
runLayout (W.Workspace _ (IfMax n l1 l2) s) rect = withWindowSet $ \ws -> arrange (W.integrate' s) (M.keys . W.floating $ ws)
where
arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
return ([], Just $ IfMax n l1' l2')
arrange ws | length ws <= n = do
arrange [] _ = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
return ([], Just $ IfMax n l1' l2')
arrange ws fw | length (ws L.\\ fw) <= n = do
(wrs, ml1') <- runLayout (W.Workspace "" l1 s) rect
let l1' = fromMaybe l1 ml1'
return (wrs, Just $ IfMax n l1' l2)
| otherwise = do
| otherwise = do
(wrs, ml2') <- runLayout (W.Workspace "" l2 s) rect
let l2' = fromMaybe l2 ml2'
return (wrs, Just $ IfMax n l1 l2')
handleMessage (IfMax n l1 l2) m = do
(allWindows, floatingWindows) <- gets ((W.integrate' . W.stack . W.workspace . W.current &&& M.keys . W.floating) . windowset)
if length (allWindows L.\\ floatingWindows) <= n
then do
l1' <- handleMessage l1 m
return $ flip (IfMax n) l2 <$> l1'
else do
l2' <- handleMessage l2 m
return $ IfMax n l1 <$> l2'
description (IfMax n l1 l2) = "If number of windows is <= " ++ show n ++ ", then " ++
description l1 ++ ", else " ++ description l2

2
XMonad/Layout/Spacing.hs
View File

@@ -93,7 +93,7 @@ instance LayoutModifier SpacingWithEdge a where
modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p
shrinkRect :: Int -> Rectangle -> Rectangle
shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (w-2*fi p) (h-2*fi p)
shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)
-- | Surrounds all windows with blank space, except when the window is the only
-- visible window on the current workspace.

17
XMonad/Prompt.hs
View File

@@ -500,14 +500,15 @@ handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do
complKey <- gets $ completionKey . config
chgModeKey <- gets $ changeModeKey . config
c <- getCompletions
mCleaned <- cleanMask m
when (length c > 1) $ modify (\s -> s { showComplWin = True })
if complKey == (m,sym)
if complKey == (mCleaned,sym)
then completionHandle c ks e
else if (sym == chgModeKey) then
do
modify setNextMode
updateWindows
else when (t == keyPress) $ keyPressHandle m ks
else when (t == keyPress) $ keyPressHandle mCleaned ks
handle _ (ExposeEvent {ev_window = w}) = do
st <- get
when (win st == w) updateWindows
@@ -518,8 +519,9 @@ completionHandle :: [String] -> KeyStroke -> Event -> XP ()
completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do
complKey <- gets $ completionKey . config
alwaysHlight <- gets $ alwaysHighlight . config
mCleaned <- cleanMask m
case () of
() | t == keyPress && (m,sym) == complKey ->
() | t == keyPress && (mCleaned,sym) == complKey ->
do
st <- get
let updateState l = case alwaysHlight of
@@ -535,8 +537,8 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
[] -> updateWindows >> eventLoop handle
[x] -> updateState [x] >> getCompletions >>= updateWins
l -> updateState l >> updateWins l
| t == keyRelease && (m,sym) == complKey -> eventLoop (completionHandle c)
| otherwise -> keyPressHandle m ks -- some other key, handle it normally
| t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)
| otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally
-- some other event: go back to main loop
completionHandle _ k e = handle k e
@@ -674,12 +676,11 @@ emacsLikeXPKeymap' p = M.fromList $
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
keyPressHandle m (ks,str) = do
km <- gets (promptKeymap . config)
kmask <- cleanMask m -- mask is defined in ghc7
case M.lookup (kmask,ks) km of
case M.lookup (m,ks) km of
Just action -> action >> updateWindows
Nothing -> case str of
"" -> eventLoop handle
_ -> when (kmask .&. controlMask == 0) $ do
_ -> when (m .&. controlMask == 0) $ do
let str' = if isUTF8Encoded str
then decodeString str
else str