mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-30 11:41:51 -07:00
XMonad
Actions
Config
Doc
Hooks
Layout
MultiToggle
Accordion.hs
AutoMaster.hs
BorderResize.hs
BoringWindows.hs
CenteredMaster.hs
Circle.hs
Column.hs
Combo.hs
ComboP.hs
Cross.hs
Decoration.hs
DecorationMadness.hs
Dishes.hs
DragPane.hs
DwmStyle.hs
FixedColumn.hs
Gaps.hs
Grid.hs
GridVariants.hs
HintedGrid.hs
HintedTile.hs
IM.hs
IndependentScreens.hs
LayoutBuilder.hs
LayoutCombinators.hs
LayoutHints.hs
LayoutModifier.hs
LayoutScreens.hs
LimitWindows.hs
MagicFocus.hs
Magnifier.hs
Master.hs
Maximize.hs
MessageControl.hs
Minimize.hs
Monitor.hs
Mosaic.hs
MosaicAlt.hs
MouseResizableTile.hs
MultiColumns.hs
MultiToggle.hs
Named.hs
NoBorders.hs
NoFrillsDecoration.hs
OneBig.hs
PerWorkspace.hs
Reflect.hs
ResizableTile.hs
ResizeScreen.hs
Roledex.hs
ShowWName.hs
SimpleDecoration.hs
SimpleFloat.hs
Simplest.hs
SimplestFloat.hs
Spacing.hs
Spiral.hs
Square.hs
StackTile.hs
SubLayouts.hs
TabBarDecoration.hs
Tabbed.hs
ThreeColumns.hs
ToggleLayouts.hs
TwoPane.hs
WindowArranger.hs
WindowNavigation.hs
WorkspaceDir.hs
Prompt
Util
Doc.hs
Prompt.hs
scripts
tests
LICENSE
README
Setup.lhs
xmonad-contrib.cabal
06a1322366
Despite myLayouts currently being more popular in examples, make them all myLayout as in man/xmonad.hs to avoid mixing them in the same module as was done a few places, leading to confusion for some users.
224 lines
11 KiB
Haskell
224 lines
11 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.WindowNavigation
|
|
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>
|
|
-- License : BSD3-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Devin Mullins <me@twifkak.com>
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- WindowNavigation is an extension to allow easy navigation of a workspace.
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.WindowNavigation (
|
|
-- * Usage
|
|
-- $usage
|
|
windowNavigation, configurableNavigation,
|
|
Navigate(..), Direction2D(..),
|
|
MoveWindowToWindow(..),
|
|
navigateColor, navigateBrightness,
|
|
noNavigateBorders, defaultWNConfig
|
|
) where
|
|
|
|
import Data.List ( nub, sortBy, (\\) )
|
|
import XMonad hiding (Point)
|
|
import qualified XMonad.StackSet as W
|
|
import XMonad.Layout.LayoutModifier
|
|
import XMonad.Util.Invisible
|
|
import XMonad.Util.Types (Direction2D(..))
|
|
import XMonad.Util.XUtils
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Layout.WindowNavigation
|
|
--
|
|
-- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier
|
|
-- to some layout:
|
|
--
|
|
-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
|
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
|
--
|
|
-- For more detailed instructions on editing the layoutHook see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
|
--
|
|
-- In keybindings:
|
|
--
|
|
-- > , ((modm, xK_Right), sendMessage $ Go R)
|
|
-- > , ((modm, xK_Left ), sendMessage $ Go L)
|
|
-- > , ((modm, xK_Up ), sendMessage $ Go U)
|
|
-- > , ((modm, xK_Down ), sendMessage $ Go D)
|
|
-- > , ((modm .|. controlMask, xK_Right), sendMessage $ Swap R)
|
|
-- > , ((modm .|. controlMask, xK_Left ), sendMessage $ Swap L)
|
|
-- > , ((modm .|. controlMask, xK_Up ), sendMessage $ Swap U)
|
|
-- > , ((modm .|. controlMask, xK_Down ), sendMessage $ Swap D)
|
|
--
|
|
-- For detailed instruction on editing the key binding see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
|
|
|
|
|
data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )
|
|
instance Typeable a => Message (MoveWindowToWindow a)
|
|
|
|
data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D
|
|
| Apply (Window -> X()) Direction2D -- ^ Apply action with destination window
|
|
deriving ( Typeable )
|
|
instance Message Navigate
|
|
|
|
data WNConfig =
|
|
WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color.
|
|
, upColor :: String
|
|
, downColor :: String
|
|
, leftColor :: String
|
|
, rightColor :: String
|
|
} deriving (Show, Read)
|
|
|
|
noNavigateBorders :: WNConfig
|
|
noNavigateBorders =
|
|
defaultWNConfig {brightness = Just 0}
|
|
|
|
navigateColor :: String -> WNConfig
|
|
navigateColor c =
|
|
WNC Nothing c c c c
|
|
|
|
navigateBrightness :: Double -> WNConfig
|
|
navigateBrightness f = defaultWNConfig { brightness = Just $ max 0 $ min 1 f }
|
|
|
|
defaultWNConfig :: WNConfig
|
|
defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
|
|
|
|
data NavigationState a = NS Point [(a,Rectangle)]
|
|
|
|
data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show )
|
|
|
|
windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a
|
|
windowNavigation = ModifiedLayout (WindowNavigation defaultWNConfig (I Nothing))
|
|
|
|
configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a
|
|
configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
|
|
|
|
instance LayoutModifier WindowNavigation Window where
|
|
redoLayout (WindowNavigation conf (I state)) rscr (Just s) origwrs =
|
|
do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask
|
|
[uc,dc,lc,rc] <-
|
|
case brightness conf of
|
|
Just frac -> do myc <- averagePixels fbc nbc frac
|
|
return [myc,myc,myc,myc]
|
|
Nothing -> mapM (stringToPixel dpy) [upColor conf, downColor conf,
|
|
leftColor conf, rightColor conf]
|
|
let dirc U = uc
|
|
dirc D = dc
|
|
dirc L = lc
|
|
dirc R = rc
|
|
let w = W.focus s
|
|
r = case filter ((==w).fst) origwrs of ((_,x):_) -> x
|
|
[] -> rscr
|
|
pt = case state of Just (NS ptold _) | ptold `inrect` r -> ptold
|
|
_ -> center r
|
|
existing_wins = W.integrate s
|
|
wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $
|
|
filter ((/=w) . fst) origwrs
|
|
wnavigable = nub $ concatMap
|
|
(\d -> take 1 $ navigable d pt wrs) [U,D,R,L]
|
|
wnavigablec = nub $ concatMap
|
|
(\d -> map (\(win,_) -> (win,dirc d)) $
|
|
take 1 $ navigable d pt wrs) [U,D,R,L]
|
|
wothers = case state of Just (NS _ wo) -> map fst wo
|
|
_ -> []
|
|
mapM_ (sc nbc) (wothers \\ map fst wnavigable)
|
|
mapM_ (\(win,c) -> sc c win) wnavigablec
|
|
return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
|
|
redoLayout _ _ _ origwrs = return (origwrs, Nothing)
|
|
|
|
handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
|
|
| Just (Go d) <- fromMessage m =
|
|
case navigable d pt wrs of
|
|
[] -> return Nothing
|
|
((w,r):_) -> do modify focusWindowHere
|
|
return $ Just $ Left $ WindowNavigation conf $ I $ Just $
|
|
NS (centerd d pt r) wrs
|
|
where focusWindowHere :: XState -> XState
|
|
focusWindowHere s
|
|
| Just w == W.peek (windowset s) = s
|
|
| has w $ W.stack $ W.workspace $ W.current $ windowset s =
|
|
s { windowset = until ((Just w ==) . W.peek)
|
|
W.focusUp $ windowset s }
|
|
| otherwise = s
|
|
has _ Nothing = False
|
|
has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)
|
|
|
|
| Just (Swap d) <- fromMessage m =
|
|
case navigable d pt wrs of
|
|
[] -> return Nothing
|
|
((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st
|
|
swapw y x | x == w = y
|
|
| x == y = w
|
|
| otherwise = x
|
|
unint f xs = case span (/= f) xs of
|
|
(u,_:dn) -> W.Stack { W.focus = f
|
|
, W.up = reverse u
|
|
, W.down = dn }
|
|
_ -> W.Stack { W.focus = f
|
|
, W.down = xs
|
|
, W.up = [] }
|
|
windows $ W.modify' swap
|
|
return Nothing
|
|
| Just (Move d) <- fromMessage m =
|
|
case navigable d pt wrs of
|
|
[] -> return Nothing
|
|
((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)
|
|
return $ do st <- mst
|
|
Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w
|
|
| Just (Apply f d) <- fromMessage m =
|
|
case navigable d pt wrs of
|
|
[] -> return Nothing
|
|
((w,_):_) -> f w >> return Nothing
|
|
| Just Hide <- fromMessage m =
|
|
do XConf { normalBorder = nbc } <- ask
|
|
mapM_ (sc nbc . fst) wrs
|
|
return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt []
|
|
| Just ReleaseResources <- fromMessage m =
|
|
handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
|
|
handleMessOrMaybeModifyIt _ _ = return Nothing
|
|
|
|
navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
|
|
navigable d pt = sortby d . filter (inr d pt . snd)
|
|
|
|
sc :: Pixel -> Window -> X ()
|
|
sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c
|
|
|
|
center :: Rectangle -> Point
|
|
center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2)
|
|
|
|
centerd :: Direction2D -> Point -> Rectangle -> Point
|
|
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 :: Direction2D -> Point -> Rectangle -> Bool
|
|
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 :: Point -> Rectangle -> Bool
|
|
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 :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
|
|
sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y)
|
|
sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y')
|
|
sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x')
|
|
sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x)
|
|
|
|
data Point = P Double Double
|