aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--XMonad/Actions/AfterDrag.hs71
-rw-r--r--XMonad/Actions/FloatSnap.hs26
-rw-r--r--XMonad/Layout/AvoidFloats.hs239
3 files changed, 328 insertions, 8 deletions
diff --git a/XMonad/Actions/AfterDrag.hs b/XMonad/Actions/AfterDrag.hs
new file mode 100644
index 0000000..261ea91
--- /dev/null
+++ b/XMonad/Actions/AfterDrag.hs
@@ -0,0 +1,71 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Actions.AfterDrag
+-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Anders Engstrom <ankaan@gmail.com>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Perform an action after the current mouse drag is completed.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.AfterDrag (
+ -- * Usage
+ -- $usage
+ afterDrag,
+ ifClick,
+ ifClick') where
+
+import XMonad
+import System.Time
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.AfterDrag
+--
+-- Then add appropriate mouse bindings, for example:
+--
+-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1)))
+--
+-- This will allow you to resize windows as usual, but if you instead of
+-- draging click the mouse button the window will be automatically resized to
+-- fill the whole screen.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+--
+-- More practical examples are available in "XMonad.Actions.FloatSnap".
+
+-- | Schedule a task to take place after the current dragging is completed.
+afterDrag
+ :: X () -- ^ The task to schedule.
+ -> X ()
+afterDrag task = do drag <- gets dragging
+ case drag of
+ Nothing -> return () -- Not dragging
+ Just (motion, cleanup) -> modify $ \s -> s { dragging = Just(motion, cleanup >> task) }
+
+-- | Take an action if the current dragging can be considered a click,
+-- supposing the drag just started before this function is called.
+-- A drag is considered a click if it is completed within 300 ms.
+ifClick
+ :: X () -- ^ The action to take if the dragging turned out to be a click.
+ -> X ()
+ifClick action = ifClick' 300 action (return ())
+
+-- | Take an action if the current dragging is completed within a certain time (in milliseconds.)
+ifClick'
+ :: Int -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)
+ -> X () -- ^ The action to take if the dragging turned out to be a click.
+ -> X () -- ^ The action to take if the dragging turned out to not be a click.
+ -> X ()
+ifClick' ms click drag = do
+ start <- io $ getClockTime
+ afterDrag $ do
+ stop <- io $ getClockTime
+ if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }
+ then click
+ else drag
diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs
index 3597254..baf511f 100644
--- a/XMonad/Actions/FloatSnap.hs
+++ b/XMonad/Actions/FloatSnap.hs
@@ -21,18 +21,21 @@ module XMonad.Actions.FloatSnap (
snapShrink,
snapMagicMove,
snapMagicResize,
- snapMagicMouseResize) where
+ snapMagicMouseResize,
+ afterDrag,
+ ifClick,
+ ifClick') where
import XMonad
import Control.Applicative((<$>))
import Data.List (sort)
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.Util.Types (Direction2D(..))
-
-import qualified Data.Set as S
+import XMonad.Actions.AfterDrag
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -53,17 +56,24 @@ import qualified Data.Set as S
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
--- And possibly add an appropriate mouse binding, for example:
+-- And possibly add appropriate mouse bindings, for example:
--
--- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
--- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
--- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
+-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w)))
+-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
+-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w)))
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
--
-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
--- Note that the order in which the commands are applied in the mouse bindings are important.
+-- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing
+-- functions, such as those from "XMonad.Actions.FlexibleResize"
+--
+-- An alternative set of mouse bindings that will always snap after the drag is:
+--
+-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w)))
+-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
+-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w)))
--
-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).
diff --git a/XMonad/Layout/AvoidFloats.hs b/XMonad/Layout/AvoidFloats.hs
new file mode 100644
index 0000000..2451580
--- /dev/null
+++ b/XMonad/Layout/AvoidFloats.hs
@@ -0,0 +1,239 @@
+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.AvoidFloats
+-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : (c) Anders Engstrom <ankaan@gmail.com>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Find a maximum empty rectangle around floating windows and use that area
+-- to display non-floating windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.AvoidFloats (
+ -- * Usage
+ -- $usage
+ avoidFloats,
+ avoidFloats',
+ AvoidFloatMsg(..),
+ AvoidFloatItemMsg(..),
+ ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+
+import Data.List
+import Data.Ord
+import Data.Maybe
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+-- $usage
+-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Layout.AvoidFloats
+--
+-- and modify the layouts to call avoidFloats on the layouts where you want the
+-- non-floating windows to not be behind floating windows.
+--
+-- > layoutHook = ... ||| avoidFloats True Full ||| ...
+--
+-- For more detailed instructions on editing the layoutHook see:
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- Then optionally add appropriate key bindings, for example:
+--
+-- > ,((modm .|. shiftMask, xK_b), sendMessage AvoidFloatToggle)
+-- > ,((modm .|. controlMask, xK_b), withFocused $ sendMessage . AvoidFloatToggleItem)
+-- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- Note that this module is incompatible with an old way of configuring
+-- "XMonad.Actions.FloatSnap". If you are having problems, please update your
+-- configuration.
+
+-- | Avoid floating windows unless the resulting area for windows would be too small.
+-- In that case, use the whole screen as if this layout modifier wasn't there.
+avoidFloats
+ :: Bool -- ^ If floating windows should be avoided by default.
+ -> l a -- ^ Layout to modify.
+ -> ModifiedLayout AvoidFloats l a
+avoidFloats act = avoidFloats' 100 100 act
+
+-- | Avoid floating windows unless the resulting area for windows would be too small.
+-- In that case, use the whole screen as if this layout modifier wasn't used.
+avoidFloats'
+ :: Int -- ^ Minimum width of the area used for non-floating windows.
+ -> Int -- ^ Minimum height of the area used for non-floating windows.
+ -> Bool -- ^ If floating windows should be avoided by default.
+ -> l a -- ^ Layout to modify.
+ -> ModifiedLayout AvoidFloats l a
+avoidFloats' w h act = ModifiedLayout (AvoidFloats Nothing S.empty w h act)
+
+data AvoidFloats a = AvoidFloats
+ { cache :: Maybe ((M.Map a W.RationalRect, Rectangle), Rectangle)
+ , chosen :: S.Set a
+ , minw :: Int
+ , minh :: Int
+ , avoidAll :: Bool
+ } deriving (Read, Show)
+
+-- | Change the state of the whole avoid float layout modifier.
+data AvoidFloatMsg
+ = AvoidFloatToggle -- ^ Toggle between avoiding all or only selected.
+ | AvoidFloatSet Bool -- ^ Set if all all floating windows should be avoided.
+ | AvoidFloatClearItems -- ^ Clear the set of windows to specifically avoid.
+ deriving (Typeable)
+
+
+-- | Change the state of the avoid float layout modifier conserning a specific window.
+data AvoidFloatItemMsg a
+ = AvoidFloatAddItem a -- ^ Add a window to always avoid.
+ | AvoidFloatRemoveItem a -- ^ Stop always avoiding selected window.
+ | AvoidFloatToggleItem a -- ^ Toggle between always avoiding selected window.
+ deriving (Typeable)
+
+instance Message AvoidFloatMsg
+instance Typeable a => Message (AvoidFloatItemMsg a)
+
+instance LayoutModifier AvoidFloats Window where
+ modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
+ floating <- gets $ W.floating . windowset
+ case cache lm of
+ Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer
+ _ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
+ let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
+ flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer
+ where
+ toRect :: WindowAttributes -> Rectangle
+ toRect wa = let b = fi $ wa_border_width wa
+ in Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa + 2*b) (fi $ wa_height wa + 2*b)
+
+ bigEnough :: Rectangle -> Bool
+ bigEnough rect = rect_width rect >= fi (minw lm) && rect_height rect >= fi (minh lm)
+
+ shouldAvoid a = avoidAll lm || a `S.member` chosen lm
+
+ pureMess lm m
+ | Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
+ | Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing }
+ | Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
+ | Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing }
+ | Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing }
+ | Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert
+ in Just $ lm { chosen = op a (chosen lm), cache = Nothing }
+ | otherwise = Nothing
+
+pruneWindows :: AvoidFloats Window -> AvoidFloats Window
+pruneWindows lm = case cache lm of
+ Nothing -> lm
+ Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) }
+
+-- | Find all maximum empty rectangles (MERs) that are axis aligned. This is
+-- done in O(n^2) time using a modified version of the algoprithm MERAlg 1
+-- described in \"On the maximum empty rectangle problem\" by A. Naamad, D.T.
+-- Lee and W.-L HSU. Published in Discrete Applied Mathematics 8 (1984.)
+maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
+maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge
+ where
+ upAndDownEdge = findGaps br rectangles
+ noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms
+ downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms
+ bottoms = sortBy (comparing bottom) $ splitContainers rectangles
+
+everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
+everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms
+ (boundLeft', boundRight', _) = shrinkBounds boundLeft boundRight boundRects r (top br)
+ in mkRect boundLeft' boundRight' (top br) (top r) ?: rs
+
+everyUpper
+ :: Rectangle -- ^ The current rectangle where the top edge is used.
+ -> Rectangle -- ^ The current rectangle where the bottom edge is used.
+ -> ([Rectangle],Int,Int,[Rectangle]) -- ^ List of MERs found so far, left bound, right bound and list of rectangles used for bounds.
+ -> ([Rectangle],Int,Int,[Rectangle])
+everyUpper lower upper (rs, boundLeft, boundRight, boundRects) = (r?:rs, boundLeft', boundRight', boundRects')
+ where
+ r = mkRect boundLeft' boundRight' (bottom upper) (top lower)
+ (boundLeft', boundRight', boundRects') = shrinkBounds boundLeft boundRight boundRects lower (bottom upper)
+
+shrinkBounds :: Int -> Int -> [Rectangle] -> Rectangle -> Int -> (Int, Int, [Rectangle])
+shrinkBounds boundLeft boundRight boundRects lower upperLimit = (boundLeft', boundRight', boundRects')
+ where
+ (shrinkers, boundRects') = span (\a -> bottom a > upperLimit) boundRects
+ (boundLeft', boundRight') = foldr (shrinkBounds' lower) (boundLeft, boundRight) $ filter (\a -> top a < top lower) shrinkers
+
+shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int)
+shrinkBounds' mr r (boundLeft, boundRight)
+ | right r < right mr = (max boundLeft $ right r, boundRight)
+ | left r > left mr = (boundLeft, min boundRight $ left r)
+ | otherwise = (right r, left r) -- r is horizontally covering all of mr; make sure the area of this rectangle will always be 0.
+
+bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
+bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms
+ boundLeft = maximum $ left br : (filter (< right r) $ map right rs)
+ boundRight = minimum $ right br : (filter (> left r) $ map left rs)
+ in if any (\a -> left a <= left r && right r <= right a) rs
+ then Nothing
+ else mkRect boundLeft boundRight (bottom r) (bottom br)
+
+-- | Split rectangles that horizontally fully contains another rectangle
+-- without sharing either the left or right side.
+splitContainers :: [Rectangle] -> [Rectangle]
+splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects
+ where
+ splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
+ splitContainers' res [] = res
+ splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs
+
+ doSplit :: Rectangle -> Rectangle -> [Rectangle]
+ doSplit guide r
+ | left guide <= left r || right r <= right guide = [r]
+ | otherwise = let w0 = fi (rect_x guide - rect_x r) + (rect_width guide `div` 2)
+ w1 = rect_width r - w0
+ in [ Rectangle (rect_x r) (rect_y r) w0 (rect_height r)
+ , Rectangle (rect_x r + fi w0) (rect_y r) w1 (rect_height r)
+ ]
+
+-- | Find all horizontal gaps that are left empty from top to bottom of screen.
+findGaps
+ :: Rectangle -- ^ Bounding rectangle.
+ -> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle.
+ -> [Rectangle]
+findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs
+ lastgap = mkRect end (right br) (top br) (bottom br)
+ in lastgap?:gaps
+ where
+ findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int)
+ findGaps' r (gaps, end) = let gap = mkRect end (left r) (top br) (bottom br)
+ in (gap?:gaps, max end (right r))
+
+ inBounds :: Rectangle -> Bool
+ inBounds r = left r < right br && left br < right r
+
+fi :: (Integral a, Num b) => a -> b
+fi x = fromIntegral x
+
+(?:) :: Maybe a -> [a] -> [a]
+Just x ?: xs = x:xs
+_ ?: xs = xs
+
+left, right, top, bottom, area :: Rectangle -> Int
+left r = fi (rect_x r)
+right r = fi (rect_x r) + fi (rect_width r)
+top r = fi (rect_y r)
+bottom r = fi (rect_y r) + fi (rect_height r)
+area r = fi (rect_width r * rect_height r)
+
+mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle
+mkRect l r t b = let rect = Rectangle (fi l) (fi t) (fi $ max 0 $ r-l) (fi $ max 0 $ b-t)
+ in if area rect > 0
+ then Just rect
+ else Nothing
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-15 12:41:53 +0000