diff options
Diffstat (limited to '')
| -rw-r--r-- | WindowNavigation.hs | 86 |
1 files changed, 56 insertions, 30 deletions
diff --git a/WindowNavigation.hs b/WindowNavigation.hs index 9e44182..5f3e643 100644 --- a/WindowNavigation.hs +++ b/WindowNavigation.hs @@ -21,11 +21,11 @@ module XMonadContrib.WindowNavigation ( ) where import Graphics.X11.Xlib ( Rectangle(..), Window, setWindowBorder ) -import Control.Monad.Reader ( asks ) +import Control.Monad.Reader ( ask, asks ) import Data.List ( nub, sortBy, (\\) ) import XMonad import qualified StackSet as W -import Operations ( focus, initColor ) +import Operations ( focus, initColor, LayoutMessages(..) ) import XMonadContrib.LayoutModifier import XMonadContrib.Invisible @@ -64,44 +64,70 @@ data WindowNavigation a = WindowNavigation (Invisible Maybe (NavigationState a)) windowNavigation = ModifiedLayout (WindowNavigation (I Nothing)) instance LayoutModifier WindowNavigation Window where - redoLayout (WindowNavigation state) rscr s wrs = - do dpy <- asks display - --navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing - --otherColor <- io $ (Just `fmap` initColor dpy "#000000") `catch` \_ -> return Nothing - let sc mc win = case mc of - Just c -> io $ setWindowBorder dpy win c - Nothing -> return () - w = W.focus s + redoLayout (WindowNavigation (I state)) rscr s wrs = + do XConf { display = dpy, normalBorder = nbc } <- ask + navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing + --uc <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing + --dc <- io $ (Just `fmap` initColor dpy "#00FFFF") `catch` \_ -> return Nothing + --lc <- io $ (Just `fmap` initColor dpy "#FF0000") `catch` \_ -> return Nothing + --rc <- io $ (Just `fmap` initColor dpy "#FF00FF") `catch` \_ -> return Nothing + --let dirc U = uc + -- dirc D = dc + -- dirc L = lc + -- dirc R = rc + let w = W.focus s r = case filter ((==w).fst) wrs of ((_,x):_) -> x [] -> rscr - pt = case state of I (Just (NS ptold _)) | ptold `inrect` r -> ptold + pt = case state of Just (NS ptold _) | ptold `inrect` r -> ptold _ -> center r wrs' = filter ((/=w) . fst) wrs - wnavigable = nub $ map fst $ concatMap (\d -> filter (inr d pt . snd) wrs') [U,D,R,L] - wothers = map fst wrs' \\ wnavigable - --mapM_ (sc navigableColor) wnavigable - --mapM_ (sc otherColor) wothers - return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wrs') + wnavigable = nub $ concatMap + (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + --wnavigablec = nub $ concatMap + -- (\d -> map (\(w,_) -> (w,dirc d)) $ + -- truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + wothers = case state of Just (NS _ wo) -> map fst wo + _ -> [] + mapM_ (sc (Just nbc)) (wothers \\ map fst wnavigable) + mapM_ (sc navigableColor) $ map fst wnavigable + --mapM_ (\(w,c) -> sc c w) wnavigablec + return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wnavigable) + modifyModify (WindowNavigation (I (Just (NS pt wrs)))) m - | Just (Go d) <- fromMessage m = case sortby d $ filter (inr d pt . snd) wrs of - [] -> return Nothing - ((w,r):_) -> do focus w - return $ Just $ WindowNavigation $ I $ Just $ NS (centerd d pt r) [] + | Just (Go d) <- fromMessage m = + case sortby d $ filter (inr d pt . snd) wrs of + [] -> return Nothing + ((w,r):_) -> do focus w + return $ Just $ WindowNavigation $ I $ Just $ + NS (centerd d pt r) wrs + | Just Hide <- fromMessage m = + do XConf { display = dpy, normalBorder = nbc } <- ask + mapM_ (sc (Just nbc) . fst) wrs + return $ Just $ WindowNavigation $ I $ Just $ NS pt [] + | Just ReleaseResources <- fromMessage m = + modifyModify (WindowNavigation (I $ Just (NS pt wrs))) (SomeMessage Hide) modifyModify _ _ = return Nothing +truncHead (x:_) = [x] +truncHead [] = [] + +sc mc win = do dpy <- asks display + case mc of Just c -> io $ setWindowBorder dpy win c + Nothing -> return () + center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2) | otherwise = P (fromIntegral x + fromIntegral w/2) yy -inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y < fromIntegral yr + fromIntegral h -inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y > fromIntegral yr -inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a < fromIntegral b -inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a > fromIntegral b + fromIntegral c -inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && - y > fromIntegral b && y < fromIntegral b + fromIntegral h +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c +inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && + y > fromIntegral b && y < fromIntegral b + fromIntegral h sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') |