From c1a6ed7be8b090cea63a70fa86ee614d011d0f63 Mon Sep 17 00:00:00 2001 From: Daniel Schoepe Date: Sat, 19 Sep 2009 21:17:17 +0200 Subject: Factor out direction types and put them in X.U.Types Ignore-this: b2255ec2754fcdf797b1ce2c082642ba This patch factors out commonly used direction types like data Direction darcs-hash:20090919191717-7f603-09c283e51a0b886d260008676d71e3daf31f4394.gz --- XMonad/Actions/CycleWS.hs | 12 +++++------- XMonad/Actions/FloatSnap.hs | 15 ++++++++------- XMonad/Actions/MouseGestures.hs | 16 ++++++++-------- XMonad/Actions/SwapWorkspaces.hs | 5 +++-- XMonad/Actions/WindowNavigation.hs | 22 +++++++++++----------- XMonad/Config/Droundy.hs | 4 ++-- XMonad/Hooks/ManageDocks.hs | 26 ++++++++------------------ XMonad/Layout/Gaps.hs | 20 ++++++++++---------- XMonad/Layout/LayoutHints.hs | 16 ++++++++-------- XMonad/Layout/SubLayouts.hs | 7 ++++--- XMonad/Layout/WindowNavigation.hs | 17 ++++++++--------- XMonad/Prompt.hs | 13 ++++++------- XMonad/Util/Types.hs | 30 ++++++++++++++++++++++++++++++ 13 files changed, 111 insertions(+), 92 deletions(-) create mode 100644 XMonad/Util/Types.hs (limited to 'XMonad') diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs index 6cce784..f7c9fe4 100644 --- a/XMonad/Actions/CycleWS.hs +++ b/XMonad/Actions/CycleWS.hs @@ -60,7 +60,7 @@ module XMonad.Actions.CycleWS ( -- * Moving between workspaces, take two! -- $taketwo - , WSDirection(..) + , Direction1D(..) , WSType(..) , shiftTo @@ -80,6 +80,7 @@ import Data.Maybe ( isNothing, isJust ) import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter) +import XMonad.Util.Types import XMonad.Util.WorkspaceCompare -- $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? data WSType = EmptyWS -- ^ cycle through 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 -- the given condition. -moveTo :: WSDirection -> WSType -> X () +moveTo :: Direction1D -> WSType -> X () moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView -- | Move the currently focused window to the next workspace in the -- 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 -- | 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 @(>>= -- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, -- 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) where maybeNegate Next d = d diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index cc618cd..51281a4 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -15,7 +15,7 @@ module XMonad.Actions.FloatSnap ( -- * Usage -- $usage - Direction(..), + Direction2D(..), snapMove, snapGrow, snapShrink, @@ -29,7 +29,8 @@ import Data.List (sort) import Data.Maybe (listToMaybe,fromJust,isNothing) import qualified XMonad.StackSet as W -import XMonad.Hooks.ManageDocks (Direction(..),calcGap) +import XMonad.Hooks.ManageDocks (calcGap) +import XMonad.Util.Types (Direction2D(..)) -- $usage -- 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. 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 maximum distance to snap. Use Nothing to not impose any boundary. -> 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. 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. -> Window -- ^ The window to move. -> 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. 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. -> Window -- ^ The window to grow. -> 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. 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. -> Window -- ^ The window to shrink. -> X () 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 io $ raiseWindow d w wa <- io $ getWindowAttributes d w diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs index 647803a..49a7582 100644 --- a/XMonad/Actions/MouseGestures.hs +++ b/XMonad/Actions/MouseGestures.hs @@ -15,14 +15,14 @@ module XMonad.Actions.MouseGestures ( -- * Usage -- $usage - Direction(..), + Direction2D(..), mouseGestureH, mouseGesture, mkCollect ) where import XMonad -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) import Data.IORef import qualified Data.Map as M @@ -64,10 +64,10 @@ delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) where 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) where - trans :: Double -> Direction + trans :: Double -> Direction2D trans x | rg (-3/4) (-1/4) x = D | 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 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 let np = (nx, ny) stx <- io $ readIORef st @@ -96,7 +96,7 @@ gauge hook op st nx ny = do -- | @'mouseGestureH' moveHook endHook@ is a mouse button -- event handler. It collects mouse movements, calling @moveHook@ for each -- update; when the button is released, it calls @endHook@. -mouseGestureH :: (Direction -> X ()) -> X () -> X () +mouseGestureH :: (Direction2D -> X ()) -> X () -> X () mouseGestureH moveHook endHook = do dpy <- asks display 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 -- 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 (mov, end) <- mkCollect 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 -- hook will return a list of the completed gesture, which you can access with -- '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 acc <- newIORef [] let diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs index 9890ef2..895e7f8 100644 --- a/XMonad/Actions/SwapWorkspaces.hs +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -19,12 +19,13 @@ module XMonad.Actions.SwapWorkspaces ( swapWithCurrent, swapTo, swapWorkspaces, - WSDirection(..) + Direction1D(..) ) where import XMonad (windows, X()) import XMonad.StackSet import XMonad.Actions.CycleWS +import XMonad.Util.Types 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. -- 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 -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index 99b61b6..8289c27 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -34,11 +34,11 @@ module XMonad.Actions.WindowNavigation ( withWindowNavigationKeys, WNAction(..), go, swap, - Direction(..) + Direction2D(..) ) where import XMonad -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Applicative ((<$>)) @@ -104,7 +104,7 @@ withWindowNavigationKeys wnKeys conf = do where fromWNAction posRef (WNGo dir) = go 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 @@ -113,10 +113,10 @@ type WNState = Map WorkspaceId Point -- 2. get target windowrect -- 3. focus window -- 4. set new position -go :: IORef WNState -> Direction -> X () +go :: IORef WNState -> Direction2D -> X () go = withTargetWindow W.focusWindow -swap :: IORef WNState -> Direction -> X () +swap :: IORef WNState -> Direction2D -> X () swap = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = 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) 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 targets <- filter ((/= win) . fst) <$> navigableTargets pos dir whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do @@ -175,12 +175,12 @@ Point x y `inside` Rectangle rx ry rw rh = midPoint :: Position -> Dimension -> Position 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 -- Filters and sorts the windows in terms of what is closest from the Point in --- the Direction. -navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +-- the Direction2D. +navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) -- 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: -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 && py < ry + fromIntegral h 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 && 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 R = sortBy $ comparing (rect_x . snd) sortby U = reverse . sortby D diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 0f324c1..b5af291 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -22,7 +22,7 @@ import XMonad.Layout.Combo ( combineTwo ) import XMonad.Layout.Named ( named ) import XMonad.Layout.LayoutCombinators 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 ) import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring, focusUp, focusDown ) @@ -40,7 +40,7 @@ import XMonad.Actions.CopyWindow ( kill1, copy ) import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, selectWorkspace, renameWorkspace, removeWorkspace ) import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), - WSDirection( Prev, Next) ) + Direction1D( Prev, Next) ) import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook, diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 91e5ecd..24cf13e 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -18,7 +18,8 @@ module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, - ToggleStruts(..), Direction(..), + ToggleStruts(..), + module XMonad.Util.Types, -- for XMonad.Actions.FloatSnap calcGap @@ -30,6 +31,7 @@ import XMonad import Foreign.C.Types (CLong) import Control.Monad import XMonad.Layout.LayoutModifier +import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import Data.List (delete) @@ -83,18 +85,6 @@ import Data.List (delete) -- "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 -- it, but does not manage it. If the window has the STRUT property -- 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 -- STRUT settings are satisfied. -calcGap :: [Direction] -> X (Rectangle -> Rectangle) +calcGap :: [Direction2D] -> X (Rectangle -> Rectangle) calcGap ss = withDisplay $ \dpy -> do rootw <- asks theRoot -- 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 -- (top), D (bottom), R (right), or L (left). avoidStrutsOn :: LayoutClass l a => - [Direction] + [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a 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 -- modifier to alter its behavior. data ToggleStruts = ToggleStruts - | ToggleStrut Direction + | ToggleStrut Direction2D deriving (Read,Show,Typeable) instance Message ToggleStruts @@ -185,7 +175,7 @@ instance LayoutModifier AvoidStruts a where -- | (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, -- final x pixel, final y pixel). diff --git a/XMonad/Layout/Gaps.hs b/XMonad/Layout/Gaps.hs index 7164b65..9f7e057 100644 --- a/XMonad/Layout/Gaps.hs +++ b/XMonad/Layout/Gaps.hs @@ -28,7 +28,7 @@ module XMonad.Layout.Gaps ( -- * Usage -- $usage - Direction(..), + Direction2D(..), GapSpec, gaps, GapMessage(..) ) where @@ -36,8 +36,8 @@ module XMonad.Layout.Gaps ( import XMonad.Core import Graphics.X11 (Rectangle(..)) -import XMonad.Hooks.ManageDocks (Direction(..)) import XMonad.Layout.LayoutModifier +import XMonad.Util.Types (Direction2D(..)) import Data.List (delete) @@ -79,19 +79,19 @@ import Data.List (delete) -- | A manual gap configuration. Each side of the screen on which a -- 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 -- gaps are allowed, and their current size), the second is the gaps -- which are currently active. -data Gaps a = Gaps GapSpec [Direction] +data Gaps a = Gaps GapSpec [Direction2D] deriving (Show, Read) -- | Messages which can be sent to a gap modifier. data GapMessage = ToggleGaps -- ^ Toggle all gaps. - | ToggleGap !Direction -- ^ Toggle a single gap. - | IncGap !Int !Direction -- ^ Increase a gap by a certain number of pixels. - | DecGap !Int !Direction -- ^ Decrease a gap. + | ToggleGap !Direction2D -- ^ Toggle a single gap. + | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels. + | DecGap !Int !Direction2D -- ^ Decrease a gap. deriving (Typeable) instance Message GapMessage @@ -121,16 +121,16 @@ applyGaps gs r = foldr applyGap r (activeGaps gs) activeGaps :: Gaps a -> GapSpec activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf -toggleGaps :: GapSpec -> [Direction] -> [Direction] +toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D] toggleGaps conf [] = map fst conf toggleGaps _ _ = [] -toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction] +toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] toggleGap conf cur d | d `elem` cur = delete d cur | d `elem` (map fst conf) = d: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 fi :: (Num b, Integral a) => a -> b diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index 91a067f..29a7d3d 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -26,10 +26,10 @@ import XMonad(LayoutClass(runLayout), mkAdjust, Window, Dimension, Position, Rectangle(Rectangle),D) import qualified XMonad.StackSet as W -import XMonad.Hooks.ManageDocks(Direction(..)) import XMonad.Layout.Decoration(isInStack) import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(modifyLayout, redoLayout, modifierDescription)) +import XMonad.Util.Types(Direction2D(..)) import Control.Applicative((<$>)) import Control.Arrow(Arrow((***), first, second)) 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 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 | dirs <- flipDir <$> Set.toList (Set.intersection adj fds) , not $ any (uncurry opposite) $ cross dirs = @@ -161,20 +161,20 @@ growOther ds lrect fds r adj = adjacent lrect r 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 } - opposite :: Direction -> Direction -> Bool + opposite :: Direction2D -> Direction2D -> Bool opposite x y = flipDir x == y -- | 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 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 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)) $ 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]]] @@ -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: -- one direction for a common edge -- two directions for a common corner -adjacent :: Rectangle -> Rectangle -> Set Direction +adjacent :: Rectangle -> Rectangle -> Set Direction2D adjacent = comparingEdges (all . onClosedInterval) -- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y @@ -219,7 +219,7 @@ centerPlacement = centerPlacement' clamp 1 -> 1 _ -> 0 -freeDirs :: Rectangle -> Rectangle -> Set Direction +freeDirs :: Rectangle -> Rectangle -> Set Direction2D freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) . centerPlacement' signum root where diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index bb533f6..5d97bae 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -40,8 +40,9 @@ import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, import XMonad.Layout.Simplest(Simplest(..)) import XMonad.Layout.Tabbed(defaultTheme, shrinkText, TabbedDecoration, addTabs) -import XMonad.Layout.WindowNavigation(Direction, Navigate(Apply)) +import XMonad.Layout.WindowNavigation(Navigate(Apply)) import XMonad.Util.Invisible(Invisible(..)) +import XMonad.Util.Types(Direction2D(..)) import XMonad import Control.Applicative((<$>),(<*)) import Control.Arrow(Arrow(second, (&&&))) @@ -261,13 +262,13 @@ instance Typeable a => Message (GroupMsg a) -- -- @pushWindow@ and @pullWindow@ move individual windows between groups. They -- 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) pushGroup = mergeNav (\o c -> sendMessage $ Merge c o) pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) 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)) -- | Apply a function on the stack belonging to the currently focused group. It diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs index 0dd6d43..34660be 100644 --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -18,7 +18,7 @@ module XMonad.Layout.WindowNavigation ( -- * Usage -- $usage windowNavigation, configurableNavigation, - Navigate(..), Direction(..), + Navigate(..), Direction2D(..), MoveWindowToWindow(..), navigateColor, navigateBrightness, noNavigateBorders, defaultWNConfig @@ -29,10 +29,9 @@ 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 -import XMonad.Hooks.ManageDocks (Direction(..)) - -- $usage -- 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 ) instance Typeable a => Message (MoveWindowToWindow a) -data Navigate = Go Direction | Swap Direction | Move Direction - | Apply (Window -> X()) Direction -- ^ Apply action with destination window +data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D + | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window deriving ( Typeable ) instance Message Navigate @@ -188,7 +187,7 @@ instance LayoutModifier WindowNavigation Window where handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) 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) sc :: Pixel -> Window -> X () @@ -197,11 +196,11 @@ 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 :: 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) | 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 && y < fromIntegral yr + fromIntegral h 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 && 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 D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 3467693..2c51226 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -33,7 +33,7 @@ module XMonad.Prompt , pasteString, copyString , moveWord, killWord, deleteString , moveHistory, setSuccess, setDone - , Direction (..) + , Direction1D(..) , ComplFunction -- * X Utilities -- $xutils @@ -65,6 +65,7 @@ import Prelude hiding (catch) import XMonad hiding (config, io) import qualified XMonad.StackSet as W import XMonad.Util.Font +import XMonad.Util.Types import XMonad.Util.XSelection (getSelection, putSelection) import Control.Arrow ((&&&),first) @@ -374,8 +375,6 @@ tryAutoComplete = do -- KeyPresses -data Direction = Prev | Next deriving (Eq,Show,Read) - defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap = M.fromList $ map (first $ (,) controlMask) -- control + @@ -443,7 +442,7 @@ killAfter = modify $ \s -> setCommand (take (offset s) (command s)) s -- | Kill the next\/previous word -killWord :: Direction -> XP () +killWord :: Direction1D -> XP () killWord d = do o <- gets offset c <- gets command @@ -492,7 +491,7 @@ copyString :: XP () copyString = gets command >>= io . putSelection -- | Remove a character at the cursor position -deleteString :: Direction -> XP () +deleteString :: Direction1D -> XP () deleteString d = 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 @@ -504,13 +503,13 @@ deleteString d = where (f,ss) = splitAt oo oc -- | move the cursor one position -moveCursor :: Direction -> XP () +moveCursor :: Direction1D -> XP () moveCursor d = 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) -- | move the cursor one word -moveWord :: Direction -> XP () +moveWord :: Direction1D -> XP () moveWord d = do c <- gets command o <- gets offset diff --git a/XMonad/Util/Types.hs b/XMonad/Util/Types.hs new file mode 100644 index 0000000..48ffd54 --- /dev/null +++ b/XMonad/Util/Types.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Types +-- Copyright : (c) Daniel Schoepe (2009) +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Daniel Schoepe +-- 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) -- cgit v1.2.3