twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Factor out direction types and put them in X.U.Types

Browse Source 
This patch factors out commonly used direction types like
data Direction = Prev | Next
and moves them to X.U.Types.
This commit is contained in:
Daniel Schoepe 2009-09-19 19:17:17 +00:00
parent 33046439d6
commit e2113acd35
14 changed files with 112 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
XMonad/Actions/CycleWS.hs
View File

@ -60,7 +60,7 @@ module XMonad.Actions.CycleWS (
-- * Moving between workspaces, take two! -- * Moving between workspaces, take two!
-- $taketwo -- $taketwo
, WSDirection(..) , Direction1D(..)
, WSType(..) , WSType(..)
, shiftTo , shiftTo
@ -80,6 +80,7 @@ import Data.Maybe ( isNothing, isJust )
import XMonad hiding (workspaces) import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter) import XMonad.StackSet hiding (filter)
import XMonad.Util.Types
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
-- $usage -- $usage
@ -211,9 +212,6 @@ the letter 'p' in its name. =)
-} -}
-- | Direction to cycle through the sort order.
data WSDirection = Next | Prev
-- | What type of workspaces should be included in the cycle? -- | What type of workspaces should be included in the cycle?
data WSType = EmptyWS -- ^ cycle through empty workspaces data WSType = EmptyWS -- ^ cycle through empty workspaces
| NonEmptyWS -- ^ cycle through non-empty workspaces | NonEmptyWS -- ^ cycle through non-empty workspaces
@ -238,12 +236,12 @@ wsTypeToPred (WSIs p) = p
-- | View the next workspace in the given direction that satisfies -- | View the next workspace in the given direction that satisfies
-- the given condition. -- the given condition.
moveTo :: WSDirection -> WSType -> X () moveTo :: Direction1D -> WSType -> X ()
moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
-- | Move the currently focused window to the next workspace in the -- | Move the currently focused window to the next workspace in the
-- given direction that satisfies the given condition. -- given direction that satisfies the given condition.
shiftTo :: WSDirection -> WSType -> X () shiftTo :: Direction1D -> WSType -> X ()
shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
-- | Given a function @s@ to sort workspaces, a direction @dir@, a -- | Given a function @s@ to sort workspaces, a direction @dir@, a
@ -259,7 +257,7 @@ shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
-- that 'moveTo' and 'shiftTo' are implemented by applying @(>>= -- that 'moveTo' and 'shiftTo' are implemented by applying @(>>=
-- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, -- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively,
-- to the output of 'findWorkspace'. -- to the output of 'findWorkspace'.
findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
where where
maybeNegate Next d = d maybeNegate Next d = d

15
XMonad/Actions/FloatSnap.hs
View File

@ -15,7 +15,7 @@
module XMonad.Actions.FloatSnap ( module XMonad.Actions.FloatSnap (
-- * Usage -- * Usage
-- $usage -- $usage
Direction(..), Direction2D(..),
snapMove, snapMove,
snapGrow, snapGrow,
snapShrink, snapShrink,
@ -29,7 +29,8 @@ import Data.List (sort)
import Data.Maybe (listToMaybe,fromJust,isNothing) import Data.Maybe (listToMaybe,fromJust,isNothing)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageDocks (Direction(..),calcGap) import XMonad.Hooks.ManageDocks (calcGap)
import XMonad.Util.Types (Direction2D(..))
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -102,7 +103,7 @@ snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDi
-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen.
snapMagicResize snapMagicResize
:: [Direction] -- ^ The edges to snap. :: [Direction2D] -- ^ The edges to snap.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
-> Window -- ^ The window to move and resize. -> Window -- ^ The window to move and resize.
@ -188,7 +189,7 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
-- | Move a window in the specified direction until it snaps against another window or the edge of the screen. -- | Move a window in the specified direction until it snaps against another window or the edge of the screen.
snapMove snapMove
:: Direction -- ^ What direction to move the window in. :: Direction2D -- ^ What direction to move the window in.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to move. -> Window -- ^ The window to move.
-> X () -> X ()
@ -223,7 +224,7 @@ doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen. -- | Grow the specified edge of a window until it snaps against another window or the edge of the screen.
snapGrow snapGrow
:: Direction -- ^ What edge of the window to grow. :: Direction2D -- ^ What edge of the window to grow.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to grow. -> Window -- ^ The window to grow.
-> X () -> X ()
@ -231,13 +232,13 @@ snapGrow = snapResize True
-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen. -- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen.
snapShrink snapShrink
:: Direction -- ^ What edge of the window to shrink. :: Direction2D -- ^ What edge of the window to shrink.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to shrink. -> Window -- ^ The window to shrink.
-> X () -> X ()
snapShrink = snapResize False snapShrink = snapResize False
snapResize :: Bool -> Direction -> Maybe Int -> Window -> X () snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w io $ raiseWindow d w
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w

16
XMonad/Actions/MouseGestures.hs
View File

@ -15,14 +15,14 @@
module XMonad.Actions.MouseGestures ( module XMonad.Actions.MouseGestures (
-- * Usage -- * Usage
-- $usage -- $usage
Direction(..), Direction2D(..),
mouseGestureH, mouseGestureH,
mouseGesture, mouseGesture,
mkCollect mkCollect
) where ) where
import XMonad import XMonad
import XMonad.Hooks.ManageDocks (Direction(..)) import XMonad.Util.Types (Direction2D(..))
import Data.IORef import Data.IORef
import qualified Data.Map as M import qualified Data.Map as M
@ -64,10 +64,10 @@ delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
where where
d a b = abs (a - b) d a b = abs (a - b)
dir :: Pos -> Pos -> Direction dir :: Pos -> Pos -> Direction2D
dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
where where
trans :: Double -> Direction trans :: Double -> Direction2D
trans x trans x
| rg (-3/4) (-1/4) x = D | rg (-3/4) (-1/4) x = D
| rg (-1/4) (1/4) x = R | rg (-1/4) (1/4) x = R
@ -75,7 +75,7 @@ dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromInt
| otherwise = L | otherwise = L
rg a z x = a <= x && x < z rg a z x = a <= x && x < z
gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X () gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
gauge hook op st nx ny = do gauge hook op st nx ny = do
let np = (nx, ny) let np = (nx, ny)
stx <- io $ readIORef st stx <- io $ readIORef st
@ -96,7 +96,7 @@ gauge hook op st nx ny = do
-- | @'mouseGestureH' moveHook endHook@ is a mouse button -- | @'mouseGestureH' moveHook endHook@ is a mouse button
-- event handler. It collects mouse movements, calling @moveHook@ for each -- event handler. It collects mouse movements, calling @moveHook@ for each
-- update; when the button is released, it calls @endHook@. -- update; when the button is released, it calls @endHook@.
mouseGestureH :: (Direction -> X ()) -> X () -> X () mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
mouseGestureH moveHook endHook = do mouseGestureH moveHook endHook = do
dpy <- asks display dpy <- asks display
root <- asks theRoot root <- asks theRoot
@ -108,7 +108,7 @@ mouseGestureH moveHook endHook = do
-- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to
-- look up the mouse gesture, then executes the corresponding action (if any). -- look up the mouse gesture, then executes the corresponding action (if any).
mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X () mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
mouseGesture tbl win = do mouseGesture tbl win = do
(mov, end) <- mkCollect (mov, end) <- mkCollect
mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest -> mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
@ -121,7 +121,7 @@ mouseGesture tbl win = do
-- collect mouse movements (and return the current gesture as a list); the end -- collect mouse movements (and return the current gesture as a list); the end
-- hook will return a list of the completed gesture, which you can access with -- hook will return a list of the completed gesture, which you can access with
-- 'Control.Monad.>>='. -- 'Control.Monad.>>='.
mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction]) mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
mkCollect = liftIO $ do mkCollect = liftIO $ do
acc <- newIORef [] acc <- newIORef []
let let

5
XMonad/Actions/SwapWorkspaces.hs
View File

@ -19,12 +19,13 @@ module XMonad.Actions.SwapWorkspaces (
swapWithCurrent, swapWithCurrent,
swapTo, swapTo,
swapWorkspaces, swapWorkspaces,
WSDirection(..) Direction1D(..)
) where ) where
import XMonad (windows, X()) import XMonad (windows, X())
import XMonad.StackSet import XMonad.StackSet
import XMonad.Actions.CycleWS import XMonad.Actions.CycleWS
import XMonad.Util.Types
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
@ -52,7 +53,7 @@ swapWithCurrent t s = swapWorkspaces t (currentTag s) s
-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace. -- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
-- This is an @X ()@ so can be hooked up to your keybindings directly. -- This is an @X ()@ so can be hooked up to your keybindings directly.
swapTo :: WSDirection -> X () swapTo :: Direction1D -> X ()
swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new

22
XMonad/Actions/WindowNavigation.hs
View File

@ -34,11 +34,11 @@ module XMonad.Actions.WindowNavigation (
withWindowNavigationKeys, withWindowNavigationKeys,
WNAction(..), WNAction(..),
go, swap, go, swap,
Direction(..) Direction2D(..)
) where ) where
import XMonad import XMonad
import XMonad.Hooks.ManageDocks (Direction(..)) import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
@ -104,7 +104,7 @@ withWindowNavigationKeys wnKeys conf = do
where fromWNAction posRef (WNGo dir) = go posRef dir where fromWNAction posRef (WNGo dir) = go posRef dir
fromWNAction posRef (WNSwap dir) = swap posRef dir fromWNAction posRef (WNSwap dir) = swap posRef dir
data WNAction = WNGo Direction | WNSwap Direction data WNAction = WNGo Direction2D | WNSwap Direction2D
type WNState = Map WorkspaceId Point type WNState = Map WorkspaceId Point
@ -113,10 +113,10 @@ type WNState = Map WorkspaceId Point
-- 2. get target windowrect -- 2. get target windowrect
-- 3. focus window -- 3. focus window
-- 4. set new position -- 4. set new position
go :: IORef WNState -> Direction -> X () go :: IORef WNState -> Direction2D -> X ()
go = withTargetWindow W.focusWindow go = withTargetWindow W.focusWindow
swap :: IORef WNState -> Direction -> X () swap :: IORef WNState -> Direction2D -> X ()
swap = withTargetWindow swapWithFocused swap = withTargetWindow swapWithFocused
where swapWithFocused targetWin winSet = where swapWithFocused targetWin winSet =
case W.peek winSet of case W.peek winSet of
@ -128,7 +128,7 @@ swap = withTargetWindow swapWithFocused
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X () withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
targets <- filter ((/= win) . fst) <$> navigableTargets pos dir targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
@ -175,12 +175,12 @@ Point x y `inside` Rectangle rx ry rw rh =
midPoint :: Position -> Dimension -> Position midPoint :: Position -> Dimension -> Position
midPoint pos dim = pos + fromIntegral dim `div` 2 midPoint pos dim = pos + fromIntegral dim `div` 2
navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets point dir = navigable dir point <$> windowRects navigableTargets point dir = navigable dir point <$> windowRects
-- Filters and sorts the windows in terms of what is closest from the Point in -- Filters and sorts the windows in terms of what is closest from the Point in
-- the Direction. -- the Direction2D.
navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable d pt = sortby d . filter (inr d pt . snd) navigable d pt = sortby d . filter (inr d pt . snd)
-- Produces a list of normal-state windows, on any screen. Rectangles are -- Produces a list of normal-state windows, on any screen. Rectangles are
@ -197,7 +197,7 @@ windowRect win = withDisplay $ \dpy -> do
-- Modified from droundy's implementation of WindowNavigation: -- Modified from droundy's implementation of WindowNavigation:
inr :: Direction -> Point -> Rectangle -> Bool inr :: Direction2D -> Point -> Rectangle -> Bool
inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
py < ry + fromIntegral h py < ry + fromIntegral h
inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
@ -207,7 +207,7 @@ inr R (Point px py) (Rectangle rx ry _ h) = px < rx &&
inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w && inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w &&
py >= ry && py < ry + fromIntegral h py >= ry && py < ry + fromIntegral h
sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby D = sortBy $ comparing (rect_y . snd) sortby D = sortBy $ comparing (rect_y . snd)
sortby R = sortBy $ comparing (rect_x . snd) sortby R = sortBy $ comparing (rect_x . snd)
sortby U = reverse . sortby D sortby U = reverse . sortby D

4
XMonad/Config/Droundy.hs
View File

@ -22,7 +22,7 @@ import XMonad.Layout.Combo ( combineTwo )
import XMonad.Layout.Named ( named ) import XMonad.Layout.Named ( named )
import XMonad.Layout.LayoutCombinators import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.Square ( Square(Square) )
import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L), import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
windowNavigation ) windowNavigation )
import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring, import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,
focusUp, focusDown ) focusUp, focusDown )
@ -40,7 +40,7 @@ import XMonad.Actions.CopyWindow ( kill1, copy )
import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
selectWorkspace, renameWorkspace, removeWorkspace ) selectWorkspace, renameWorkspace, removeWorkspace )
import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
WSDirection( Prev, Next) ) Direction1D( Prev, Next) )
import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook, import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,

26
XMonad/Hooks/ManageDocks.hs
View File

@ -18,7 +18,8 @@ module XMonad.Hooks.ManageDocks (
-- * Usage -- * Usage
-- $usage -- $usage
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
ToggleStruts(..), Direction(..), ToggleStruts(..),
module XMonad.Util.Types,
-- for XMonad.Actions.FloatSnap -- for XMonad.Actions.FloatSnap
calcGap calcGap
@ -30,6 +31,7 @@ import XMonad
import Foreign.C.Types (CLong) import Foreign.C.Types (CLong)
import Control.Monad import Control.Monad
import XMonad.Layout.LayoutModifier import XMonad.Layout.LayoutModifier
import XMonad.Util.Types
import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.WindowProperties (getProp32s)
import Data.List (delete) import Data.List (delete)
@ -83,18 +85,6 @@ import Data.List (delete)
-- "XMonad.Doc.Extending#Editing_key_bindings". -- "XMonad.Doc.Extending#Editing_key_bindings".
-- --
-- | An enumeration of the four cardinal directions\/sides of the
-- screen.
--
-- Ideally this would go in its own separate module in Util,
-- but ManageDocks is angling for inclusion into the xmonad core,
-- so keep the dependencies to a minimum.
data Direction = U -- ^ Up\/top
| D -- ^ Down\/bottom
| R -- ^ Right
| L -- ^ Left
deriving ( Read, Show, Eq, Ord, Enum, Bounded )
-- | Detects if the given window is of type DOCK and if so, reveals -- | Detects if the given window is of type DOCK and if so, reveals
-- it, but does not manage it. If the window has the STRUT property -- it, but does not manage it. If the window has the STRUT property
-- set, adjust the gap accordingly. -- set, adjust the gap accordingly.
@ -129,7 +119,7 @@ getStrut w = do
-- | Goes through the list of windows and find the gap so that all -- | Goes through the list of windows and find the gap so that all
-- STRUT settings are satisfied. -- STRUT settings are satisfied.
calcGap :: [Direction] -> X (Rectangle -> Rectangle) calcGap :: [Direction2D] -> X (Rectangle -> Rectangle)
calcGap ss = withDisplay $ \dpy -> do calcGap ss = withDisplay $ \dpy -> do
rootw <- asks theRoot rootw <- asks theRoot
-- We don't keep track of dock like windows, so we find all of them here -- We don't keep track of dock like windows, so we find all of them here
@ -153,17 +143,17 @@ avoidStruts = avoidStrutsOn [U,D,L,R]
-- etc. on the indicated sides of the screen. Valid sides are U -- etc. on the indicated sides of the screen. Valid sides are U
-- (top), D (bottom), R (right), or L (left). -- (top), D (bottom), R (right), or L (left).
avoidStrutsOn :: LayoutClass l a => avoidStrutsOn :: LayoutClass l a =>
[Direction] [Direction2D]
-> l a -> l a
-> ModifiedLayout AvoidStruts l a -> ModifiedLayout AvoidStruts l a
avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss) avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss)
data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show ) data AvoidStruts a = AvoidStruts [Direction2D] deriving ( Read, Show )
-- | Message type which can be sent to an 'AvoidStruts' layout -- | Message type which can be sent to an 'AvoidStruts' layout
-- modifier to alter its behavior. -- modifier to alter its behavior.
data ToggleStruts = ToggleStruts data ToggleStruts = ToggleStruts
| ToggleStrut Direction | ToggleStrut Direction2D
deriving (Read,Show,Typeable) deriving (Read,Show,Typeable)
instance Message ToggleStruts instance Message ToggleStruts
@ -185,7 +175,7 @@ instance LayoutModifier AvoidStruts a where
-- | (Direction, height\/width, initial pixel, final pixel). -- | (Direction, height\/width, initial pixel, final pixel).
type Strut = (Direction, CLong, CLong, CLong) type Strut = (Direction2D, CLong, CLong, CLong)
-- | (Initial x pixel, initial y pixel, -- | (Initial x pixel, initial y pixel,
-- final x pixel, final y pixel). -- final x pixel, final y pixel).

20
XMonad/Layout/Gaps.hs
View File

@ -28,7 +28,7 @@
module XMonad.Layout.Gaps ( module XMonad.Layout.Gaps (
-- * Usage -- * Usage
-- $usage -- $usage
Direction(..), Direction2D(..),
GapSpec, gaps, GapMessage(..) GapSpec, gaps, GapMessage(..)
) where ) where
@ -36,8 +36,8 @@ module XMonad.Layout.Gaps (
import XMonad.Core import XMonad.Core
import Graphics.X11 (Rectangle(..)) import Graphics.X11 (Rectangle(..))
import XMonad.Hooks.ManageDocks (Direction(..))
import XMonad.Layout.LayoutModifier import XMonad.Layout.LayoutModifier
import XMonad.Util.Types (Direction2D(..))
import Data.List (delete) import Data.List (delete)
@ -79,19 +79,19 @@ import Data.List (delete)
-- | A manual gap configuration. Each side of the screen on which a -- | A manual gap configuration. Each side of the screen on which a
-- gap is enabled is paired with a size in pixels. -- gap is enabled is paired with a size in pixels.
type GapSpec = [(Direction,Int)] type GapSpec = [(Direction2D,Int)]
-- | The gap state. The first component is the configuration (which -- | The gap state. The first component is the configuration (which
-- gaps are allowed, and their current size), the second is the gaps -- gaps are allowed, and their current size), the second is the gaps
-- which are currently active. -- which are currently active.
data Gaps a = Gaps GapSpec [Direction] data Gaps a = Gaps GapSpec [Direction2D]
deriving (Show, Read) deriving (Show, Read)
-- | Messages which can be sent to a gap modifier. -- | Messages which can be sent to a gap modifier.
data GapMessage = ToggleGaps -- ^ Toggle all gaps. data GapMessage = ToggleGaps -- ^ Toggle all gaps.
| ToggleGap !Direction -- ^ Toggle a single gap. | ToggleGap !Direction2D -- ^ Toggle a single gap.
| IncGap !Int !Direction -- ^ Increase a gap by a certain number of pixels. | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels.
| DecGap !Int !Direction -- ^ Decrease a gap. | DecGap !Int !Direction2D -- ^ Decrease a gap.
deriving (Typeable) deriving (Typeable)
instance Message GapMessage instance Message GapMessage
@ -121,16 +121,16 @@ applyGaps gs r = foldr applyGap r (activeGaps gs)
activeGaps :: Gaps a -> GapSpec activeGaps :: Gaps a -> GapSpec
activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf
toggleGaps :: GapSpec -> [Direction] -> [Direction] toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D]
toggleGaps conf [] = map fst conf toggleGaps conf [] = map fst conf
toggleGaps _ _ = [] toggleGaps _ _ = []
toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction] toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D]
toggleGap conf cur d | d `elem` cur = delete d cur toggleGap conf cur d | d `elem` cur = delete d cur
| d `elem` (map fst conf) = d:cur | d `elem` (map fst conf) = d:cur
| otherwise = cur | otherwise = cur
incGap :: GapSpec -> Direction -> Int -> GapSpec incGap :: GapSpec -> Direction2D -> Int -> GapSpec
incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
fi :: (Num b, Integral a) => a -> b fi :: (Num b, Integral a) => a -> b

16
XMonad/Layout/LayoutHints.hs
View File

@ -26,10 +26,10 @@ import XMonad(LayoutClass(runLayout), mkAdjust, Window,
Dimension, Position, Rectangle(Rectangle),D) Dimension, Position, Rectangle(Rectangle),D)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageDocks(Direction(..))
import XMonad.Layout.Decoration(isInStack) import XMonad.Layout.Decoration(isInStack)
import XMonad.Layout.LayoutModifier(ModifiedLayout(..), import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(modifyLayout, redoLayout, modifierDescription)) LayoutModifier(modifyLayout, redoLayout, modifierDescription))
import XMonad.Util.Types(Direction2D(..))
import Control.Applicative((<$>)) import Control.Applicative((<$>))
import Control.Arrow(Arrow((***), first, second)) import Control.Arrow(Arrow((***), first, second))
import Control.Monad(Monad(return), mapM, join) import Control.Monad(Monad(return), mapM, join)
@ -151,7 +151,7 @@ applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) =
next = applyHints s root $ mapSnd growOther' xs next = applyHints s root $ mapSnd growOther' xs
in (w,redr):next in (w,redr):next
growOther :: (Position, Position) -> Rectangle -> Set Direction -> Rectangle -> Rectangle growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle
growOther ds lrect fds r growOther ds lrect fds r
| dirs <- flipDir <$> Set.toList (Set.intersection adj fds) | dirs <- flipDir <$> Set.toList (Set.intersection adj fds)
, not $ any (uncurry opposite) $ cross dirs = , not $ any (uncurry opposite) $ cross dirs =
@ -161,20 +161,20 @@ growOther ds lrect fds r
adj = adjacent lrect r adj = adjacent lrect r
cross xs = [ (a,b) | a <- xs, b <- xs ] cross xs = [ (a,b) | a <- xs, b <- xs ]
flipDir :: Direction -> Direction flipDir :: Direction2D -> Direction2D
flipDir d = case d of { L -> R; U -> D; R -> L; D -> U } flipDir d = case d of { L -> R; U -> D; R -> L; D -> U }
opposite :: Direction -> Direction -> Bool opposite :: Direction2D -> Direction2D -> Bool
opposite x y = flipDir x == y opposite x y = flipDir x == y
-- | Leave the opposite edges where they were -- | Leave the opposite edges where they were
grow :: Direction -> (Position,Position) -> Rectangle -> Rectangle grow :: Direction2D -> (Position,Position) -> Rectangle -> Rectangle
grow L (px,_ ) (Rectangle x y w h) = Rectangle (x-px) y (w+fromIntegral px) h grow L (px,_ ) (Rectangle x y w h) = Rectangle (x-px) y (w+fromIntegral px) h
grow U (_ ,py) (Rectangle x y w h) = Rectangle x (y-py) w (h+fromIntegral py) grow U (_ ,py) (Rectangle x y w h) = Rectangle x (y-py) w (h+fromIntegral py)
grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h
grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py) grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py)
comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D
comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $ comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $
any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]] any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]]
,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]] ,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]]
@ -190,7 +190,7 @@ comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (d
-- first is shrunk, assuming that the root window is fully covered: -- first is shrunk, assuming that the root window is fully covered:
-- one direction for a common edge -- one direction for a common edge
-- two directions for a common corner -- two directions for a common corner
adjacent :: Rectangle -> Rectangle -> Set Direction adjacent :: Rectangle -> Rectangle -> Set Direction2D
adjacent = comparingEdges (all . onClosedInterval) adjacent = comparingEdges (all . onClosedInterval)
-- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y -- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y
@ -219,7 +219,7 @@ centerPlacement = centerPlacement' clamp
1 -> 1 1 -> 1
_ -> 0 _ -> 0
freeDirs :: Rectangle -> Rectangle -> Set Direction freeDirs :: Rectangle -> Rectangle -> Set Direction2D
freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) freeDirs root = Set.fromList . uncurry (++) . (lr *** ud)
. centerPlacement' signum root . centerPlacement' signum root
where where

7
XMonad/Layout/SubLayouts.hs
View File

@ -40,8 +40,9 @@ import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,
import XMonad.Layout.Simplest(Simplest(..)) import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.Tabbed(defaultTheme, shrinkText, import XMonad.Layout.Tabbed(defaultTheme, shrinkText,
TabbedDecoration, addTabs) TabbedDecoration, addTabs)
import XMonad.Layout.WindowNavigation(Direction, Navigate(Apply)) import XMonad.Layout.WindowNavigation(Navigate(Apply))
import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Invisible(Invisible(..))
import XMonad.Util.Types(Direction2D(..))
import XMonad import XMonad
import Control.Applicative((<$>),(<*)) import Control.Applicative((<$>),(<*))
import Control.Arrow(Arrow(second, (&&&))) import Control.Arrow(Arrow(second, (&&&)))
@ -261,13 +262,13 @@ instance Typeable a => Message (GroupMsg a)
-- --
-- @pushWindow@ and @pullWindow@ move individual windows between groups. They -- @pushWindow@ and @pullWindow@ move individual windows between groups. They
-- are less effective at preserving window positions. -- are less effective at preserving window positions.
pullGroup,pushGroup,pullWindow,pushWindow :: Direction -> Navigate pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate
pullGroup = mergeNav (\o c -> sendMessage $ Merge o c) pullGroup = mergeNav (\o c -> sendMessage $ Merge o c)
pushGroup = mergeNav (\o c -> sendMessage $ Merge c o) pushGroup = mergeNav (\o c -> sendMessage $ Merge c o)
pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c)
pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o) pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o)
mergeNav :: (Window -> Window -> X ()) -> Direction -> Navigate mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav f = Apply (\o -> withFocused (f o)) mergeNav f = Apply (\o -> withFocused (f o))
-- | Apply a function on the stack belonging to the currently focused group. It -- | Apply a function on the stack belonging to the currently focused group. It

17
XMonad/Layout/WindowNavigation.hs
View File

@ -18,7 +18,7 @@ module XMonad.Layout.WindowNavigation (
-- * Usage -- * Usage
-- $usage -- $usage
windowNavigation, configurableNavigation, windowNavigation, configurableNavigation,
Navigate(..), Direction(..), Navigate(..), Direction2D(..),
MoveWindowToWindow(..), MoveWindowToWindow(..),
navigateColor, navigateBrightness, navigateColor, navigateBrightness,
noNavigateBorders, defaultWNConfig noNavigateBorders, defaultWNConfig
@ -29,10 +29,9 @@ import XMonad hiding (Point)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier import XMonad.Layout.LayoutModifier
import XMonad.Util.Invisible import XMonad.Util.Invisible
import XMonad.Util.Types (Direction2D(..))
import XMonad.Util.XUtils import XMonad.Util.XUtils
import XMonad.Hooks.ManageDocks (Direction(..))
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
-- --
@ -67,8 +66,8 @@ import XMonad.Hooks.ManageDocks (Direction(..))
data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable ) data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )
instance Typeable a => Message (MoveWindowToWindow a) instance Typeable a => Message (MoveWindowToWindow a)
data Navigate = Go Direction | Swap Direction | Move Direction data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D
| Apply (Window -> X()) Direction -- ^ Apply action with destination window | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window
deriving ( Typeable ) deriving ( Typeable )
instance Message Navigate instance Message Navigate
@ -188,7 +187,7 @@ instance LayoutModifier WindowNavigation Window where
handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
handleMessOrMaybeModifyIt _ _ = return Nothing handleMessOrMaybeModifyIt _ _ = return Nothing
navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable d pt = sortby d . filter (inr d pt . snd) navigable d pt = sortby d . filter (inr d pt . snd)
sc :: Pixel -> Window -> X () sc :: Pixel -> Window -> X ()
@ -197,11 +196,11 @@ sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c
center :: Rectangle -> Point center :: Rectangle -> Point
center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2)
centerd :: Direction -> Point -> Rectangle -> Point 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) 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 | otherwise = P (fromIntegral x + fromIntegral w/2) yy
inr :: Direction -> Point -> Rectangle -> Bool inr :: Direction2D -> Point -> Rectangle -> Bool
inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
y < fromIntegral yr + fromIntegral h y < fromIntegral yr + fromIntegral h
inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
@ -215,7 +214,7 @@ inrect :: Point -> Rectangle -> Bool
inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && 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 y > fromIntegral b && y < fromIntegral b + fromIntegral h
sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y)
sortby D = 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 R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x')

13
XMonad/Prompt.hs
View File

@ -33,7 +33,7 @@ module XMonad.Prompt
, pasteString, copyString , pasteString, copyString
, moveWord, killWord, deleteString , moveWord, killWord, deleteString
, moveHistory, setSuccess, setDone , moveHistory, setSuccess, setDone
, Direction (..) , Direction1D(..)
, ComplFunction , ComplFunction
-- * X Utilities -- * X Utilities
-- $xutils -- $xutils
@ -65,6 +65,7 @@ import Prelude hiding (catch)
import XMonad hiding (config, io) import XMonad hiding (config, io)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Util.Font import XMonad.Util.Font
import XMonad.Util.Types
import XMonad.Util.XSelection (getSelection, putSelection) import XMonad.Util.XSelection (getSelection, putSelection)
import Control.Arrow ((&&&),first) import Control.Arrow ((&&&),first)
@ -374,8 +375,6 @@ tryAutoComplete = do
-- KeyPresses -- KeyPresses
data Direction = Prev | Next deriving (Eq,Show,Read)
defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap = M.fromList $ defaultXPKeymap = M.fromList $
map (first $ (,) controlMask) -- control + <key> map (first $ (,) controlMask) -- control + <key>
@ -443,7 +442,7 @@ killAfter =
modify $ \s -> setCommand (take (offset s) (command s)) s modify $ \s -> setCommand (take (offset s) (command s)) s
-- | Kill the next\/previous word -- | Kill the next\/previous word
killWord :: Direction -> XP () killWord :: Direction1D -> XP ()
killWord d = do killWord d = do
o <- gets offset o <- gets offset
c <- gets command c <- gets command
@ -492,7 +491,7 @@ copyString :: XP ()
copyString = gets command >>= io . putSelection copyString = gets command >>= io . putSelection
-- | Remove a character at the cursor position -- | Remove a character at the cursor position
deleteString :: Direction -> XP () deleteString :: Direction1D -> XP ()
deleteString d = deleteString d =
modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)}
where o oo = if d == Prev then max 0 (oo - 1) else oo where o oo = if d == Prev then max 0 (oo - 1) else oo
@ -504,13 +503,13 @@ deleteString d =
where (f,ss) = splitAt oo oc where (f,ss) = splitAt oo oc
-- | move the cursor one position -- | move the cursor one position
moveCursor :: Direction -> XP () moveCursor :: Direction1D -> XP ()
moveCursor d = moveCursor d =
modify $ \s -> s { offset = o (offset s) (command s)} modify $ \s -> s { offset = o (offset s) (command s)}
where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1)
-- | move the cursor one word -- | move the cursor one word
moveWord :: Direction -> XP () moveWord :: Direction1D -> XP ()
moveWord d = do moveWord d = do
c <- gets command c <- gets command
o <- gets offset o <- gets offset

30
XMonad/Util/Types.hs Normal file
View File

@ -0,0 +1,30 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.Types
-- Copyright : (c) Daniel Schoepe (2009)
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Daniel Schoepe <daniel.schoepe@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- Miscellaneous commonly used types.
--
-----------------------------------------------------------------------------
module XMonad.Util.Types (Direction1D(..)
,Direction2D(..)
) where
import Data.Typeable (Typeable)
-- | One-dimensional directions:
data Direction1D = Next | Prev deriving (Eq,Read,Show,Typeable)
-- | Two-dimensional directions:
data Direction2D = U -- ^ Up
| D -- ^ Down
| R -- ^ Right
| L -- ^ Left
deriving (Eq,Read,Show,Ord,Bounded,Typeable)

1
xmonad-contrib.cabal
View File

@ -224,6 +224,7 @@ library
XMonad.Util.Scratchpad XMonad.Util.Scratchpad
XMonad.Util.Themes XMonad.Util.Themes
XMonad.Util.Timer XMonad.Util.Timer
XMonad.Util.Types
XMonad.Util.WindowProperties XMonad.Util.WindowProperties
XMonad.Util.WorkspaceCompare XMonad.Util.WorkspaceCompare
XMonad.Util.Paste XMonad.Util.Paste