aboutsummaryrefslogtreecommitdiffstats
path: root/WindowNavigation.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--WindowNavigation.hs86
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')