mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-27 18:21:52 -07:00
.github
XMonad
Actions
Config
Doc
Hooks
Layout
Groups
MultiToggle
Accordion.hs
AutoMaster.hs
AvoidFloats.hs
BinaryColumn.hs
BinarySpacePartition.hs
BorderResize.hs
BoringWindows.hs
ButtonDecoration.hs
CenteredIfSingle.hs
CenteredMaster.hs
Circle.hs
Column.hs
Combo.hs
ComboP.hs
Cross.hs
Decoration.hs
DecorationAddons.hs
DecorationMadness.hs
Dishes.hs
DragPane.hs
DraggingVisualizer.hs
Drawer.hs
Dwindle.hs
DwmStyle.hs
FixedAspectRatio.hs
FixedColumn.hs
Fullscreen.hs
Gaps.hs
Grid.hs
GridVariants.hs
Groups.hs
Hidden.hs
HintedGrid.hs
HintedTile.hs
IM.hs
IfMax.hs
ImageButtonDecoration.hs
IndependentScreens.hs
LayoutBuilder.hs
LayoutBuilderP.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
MultiDishes.hs
MultiToggle.hs
Named.hs
NoBorders.hs
NoFrillsDecoration.hs
OnHost.hs
OneBig.hs
PerScreen.hs
PerWorkspace.hs
PositionStoreFloat.hs
Reflect.hs
Renamed.hs
ResizableThreeColumns.hs
ResizableTile.hs
ResizeScreen.hs
Roledex.hs
ShowWName.hs
SideBorderDecoration.hs
SimpleDecoration.hs
SimpleFloat.hs
Simplest.hs
SimplestFloat.hs
SortedLayout.hs
Spacing.hs
Spiral.hs
Square.hs
StackTile.hs
StateFull.hs
Stoppable.hs
SubLayouts.hs
TabBarDecoration.hs
Tabbed.hs
TallMastersCombo.hs
ThreeColumns.hs
ToggleLayouts.hs
TrackFloating.hs
TwoPane.hs
TwoPanePersistent.hs
VoidBorders.hs
WindowArranger.hs
WindowNavigation.hs
WindowSwitcherDecoration.hs
WorkspaceDir.hs
ZoomRow.hs
Prompt
Util
Doc.hs
Prelude.hs
Prompt.hs
scripts
tests
.gitignore
.hlint.yaml
.mailmap
CHANGES.md
CONTRIBUTING.md
LICENSE
NIX.md
README.md
Setup.lhs
cabal.haskell-ci
cabal.project
flake.nix
stack-master.yaml
stack.yaml
xmonad-contrib.cabal
f5de0fc764
And rearrange the documentation slightly so it makes more sense. Also document the defaults, and clean up the existing markup a bit.
238 lines
12 KiB
Haskell
238 lines
12 KiB
Haskell
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.WindowNavigation
|
|
-- Description : A layout modifier to allow easy navigation of a workspace.
|
|
-- 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(..), WNConfig,
|
|
navigateColor, navigateBrightness,
|
|
noNavigateBorders, def,
|
|
WindowNavigation,
|
|
) where
|
|
|
|
import XMonad.Prelude ( 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 def { 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)
|
|
instance Typeable a => Message (MoveWindowToWindow a)
|
|
|
|
data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D
|
|
| Apply (Window -> X()) Direction2D -- ^ Apply action with destination window
|
|
instance Message Navigate
|
|
|
|
-- | Used with 'configurableNavigation' to specify how to show reachable windows'
|
|
-- borders. You cannot create 'WNConfig' values directly; use 'def' or one of the following
|
|
-- three functions to create one.
|
|
--
|
|
-- 'def', and 'windowNavigation', uses the focused border color at 40% brightness, as if
|
|
-- you had specified
|
|
--
|
|
-- > configurableNavigation (navigateBrightness 0.4)
|
|
data WNConfig =
|
|
WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color.
|
|
, upColor :: String
|
|
, downColor :: String
|
|
, leftColor :: String
|
|
, rightColor :: String
|
|
} deriving (Show, Read)
|
|
|
|
-- | Don't use window borders for navigation.
|
|
noNavigateBorders :: WNConfig
|
|
noNavigateBorders =
|
|
def {brightness = Just 0}
|
|
|
|
-- | Indicate reachable windows by drawing their borders in the specified color.
|
|
navigateColor :: String -> WNConfig
|
|
navigateColor c =
|
|
WNC Nothing c c c c
|
|
|
|
-- | Indicate reachable windows by drawing their borders in the active border color, with
|
|
-- the specified brightness.
|
|
navigateBrightness :: Double -> WNConfig
|
|
navigateBrightness f = def { brightness = Just $ max 0 $ min 1 f }
|
|
|
|
instance Default WNConfig where def = 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 def (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 st)) 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 st 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 st 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 -> do
|
|
colorName <- io (pixelToString dpy c)
|
|
setWindowBorderWithFallback dpy win colorName 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
|