diff options
Diffstat (limited to '')
| -rw-r--r-- | src/XMonad/Actions/FloatSnapSpaced.hs | 108 | ||||
| -rw-r--r-- | src/XMonad/Actions/PerConditionKeys.hs | 23 |
2 files changed, 131 insertions, 0 deletions
diff --git a/src/XMonad/Actions/FloatSnapSpaced.hs b/src/XMonad/Actions/FloatSnapSpaced.hs new file mode 100644 index 0000000..9a66643 --- /dev/null +++ b/src/XMonad/Actions/FloatSnapSpaced.hs @@ -0,0 +1,108 @@ +module XMonad.Actions.FloatSnapSpaced + ( snapSpacedMagicMove + ) where + +import Data.List +import Data.Maybe +import Data.Set (fromList) +import XMonad +import XMonad.Hooks.ManageDocks +import qualified XMonad.StackSet as S + +snapSpacedMagicMove :: Int -> Maybe Int -> Maybe Int -> Window -> X () +snapSpacedMagicMove spacing collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + + nx <- handleAxis True d wa + ny <- handleAxis False d wa + + io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) + float w + where + handleAxis horiz d wa = do + ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w + return $ if bs || fs + then wpos wa + else let b = case (mbl, mbr) of + (Just bl, Just br) -> if wpos wa - bl < br - wpos wa + then bl + spacing + else br + spacing + (Just bl, Nothing) -> bl + spacing + (Nothing, Just br) -> br + spacing + (Nothing, Nothing) -> wpos wa + spacing + + f = case (mfl, mfr) of + (Just fl, Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa + then fl - spacing + else fr - spacing + (Just fl, Nothing) -> fl - spacing + (Nothing, Just fr) -> fr - spacing + (Nothing, Nothing) -> wpos wa - spacing + + newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) + then b + else f - wdim wa + + in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist + then newpos + else wpos wa + where + (wpos, wdim, _, _) = constructors horiz + +getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool)) +getSnap horiz collidedist d w = do + wa <- io $ getWindowAttributes d w + screen <- S.current <$> gets windowset + let sr = screenRect $ S.screenDetail screen + wl = S.integrate' . S.stack $ S.workspace screen + gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound] + wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl) + + return ( neighbours (back wa sr gr wla) (wpos wa) + , neighbours (front wa sr gr wla) (wpos wa + wdim wa) + ) + where + wborder = fromIntegral.wa_border_width + + (wpos, wdim, rpos, rdim) = constructors horiz + (refwpos, refwdim, _, _) = constructors $ not horiz + + back wa sr gr wla = dropWhile (< rpos sr) + $ takeWhile (< rpos sr + rdim sr) + $ sort + $ rpos sr : + rpos gr : + (rpos gr + rdim gr) : + foldr (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as) [] wla + + front wa sr gr wla = dropWhile (<= rpos sr) + $ takeWhile (<= rpos sr + rdim sr) + $ sort + $ (rpos gr - 2 * wborder wa) : + (rpos gr + rdim gr - 2 * wborder wa) : + (rpos sr + rdim sr - 2 * wborder wa) : + foldr (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as) [] wla + + neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l + , listToMaybe $ dropWhile (<= v) l + , v `elem` l + ) + + collides wa oa = case collidedist of + Nothing -> True + Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist + && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa + + +constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) +constructors True = ( fromIntegral.wa_x + , fromIntegral.wa_width + , fromIntegral.rect_x + , fromIntegral.rect_width + ) +constructors False = ( fromIntegral.wa_y + , fromIntegral.wa_height + , fromIntegral.rect_y + , fromIntegral.rect_height + ) diff --git a/src/XMonad/Actions/PerConditionKeys.hs b/src/XMonad/Actions/PerConditionKeys.hs new file mode 100644 index 0000000..85469d6 --- /dev/null +++ b/src/XMonad/Actions/PerConditionKeys.hs @@ -0,0 +1,23 @@ +module XMonad.Actions.PerConditionKeys + ( XCond(..) + , chooseAction + , bindOn + ) where + +import Data.List +import XMonad +import qualified XMonad.StackSet as S + +data XCond = WS | LD + +chooseAction :: XCond -> (String -> X ()) -> X () +chooseAction WS f = withWindowSet (f . S.currentTag) +chooseAction LD f = withWindowSet (f . description . S.layout . S.workspace . S.current) + +bindOn :: XCond -> [(String, X ())] -> X () +bindOn xc bindings = chooseAction xc chooser + where chooser x = case find ((x ==) . fst) bindings of + Just (_, action) -> action + Nothing -> case find (("" ==) . fst) bindings of + Just (_, action) -> action + Nothing -> return () |