diff --git a/XMonad/Actions/OnScreen.hs b/XMonad/Actions/OnScreen.hs index f1e432f88..404dda13b 100644 --- a/XMonad/Actions/OnScreen.hs +++ b/XMonad/Actions/OnScreen.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module : XMonad.Actions.OnScreen -- Description : Control workspaces on different screens (in xinerama mode). @@ -10,139 +9,173 @@ -- Portability : unportable -- -- Control workspaces on different screens (in xinerama mode). --- ------------------------------------------------------------------------------ - -module XMonad.Actions.OnScreen ( - -- * Usage +module XMonad.Actions.OnScreen + ( -- * Usage -- $usage - onScreen - , onScreen' - , Focus(..) - , viewOnScreen - , greedyViewOnScreen - , onlyOnScreen - , toggleOnScreen - , toggleGreedyOnScreen - ) where + onScreen, + onScreen', + Focus (..), + viewOnScreen, + greedyViewOnScreen, + onlyOnScreen, + toggleOnScreen, + toggleGreedyOnScreen, + ) +where import XMonad -import XMonad.Prelude (fromMaybe, guard, empty) +import XMonad.Prelude (empty, fromMaybe, guard) import XMonad.StackSet hiding (new) - -- | Focus data definitions -data Focus = FocusNew -- ^ always focus the new screen - | FocusCurrent -- ^ always keep the focus on the current screen - | FocusTag WorkspaceId -- ^ always focus tag i on the new stack - | FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack - +data Focus + = -- | always focus the new screen + FocusNew + | -- | always keep the focus on the current screen + FocusCurrent + | -- | always focus tag i on the new stack + FocusTag WorkspaceId + | -- | focus tag i only if workspace with tag i is visible on the old stack + FocusTagVisible WorkspaceId -- | Run any function that modifies the stack on a given screen. This function -- will also need to know which Screen to focus after the function has been -- run. -onScreen :: (WindowSet -> WindowSet) -- ^ function to run - -> Focus -- ^ what to do with the focus - -> ScreenId -- ^ screen id - -> WindowSet -- ^ current stack - -> WindowSet +onScreen :: + -- | function to run + (WindowSet -> WindowSet) -> + -- | what to do with the focus + Focus -> + -- | screen id + ScreenId -> + -- | current stack + WindowSet -> + WindowSet onScreen f foc sc st = fromMaybe st $ do - ws <- lookupWorkspace sc st + ws <- lookupWorkspace sc st - let fStack = f $ view ws st - - return $ setFocus foc st fStack + let fStack = f $ view ws st + return $ setFocus foc st fStack -- set focus for new stack -setFocus :: Focus - -> WindowSet -- ^ old stack - -> WindowSet -- ^ new stack - -> WindowSet -setFocus FocusNew _ new = new -setFocus FocusCurrent old new = - case lookupWorkspace (screen $ current old) new of - Nothing -> new - Just i -> view i new -setFocus (FocusTag i) _ new = view i new +setFocus :: + Focus -> + -- | old stack + WindowSet -> + -- | new stack + WindowSet -> + WindowSet +setFocus FocusNew _ new = new +setFocus FocusCurrent old new = + case lookupWorkspace (screen $ current old) new of + Nothing -> new + Just i -> view i new +setFocus (FocusTag i) _ new = view i new setFocus (FocusTagVisible i) old new = - if i `elem` map (tag . workspace) (visible old) - then setFocus (FocusTag i) old new - else setFocus FocusCurrent old new + if i `elem` map (tag . workspace) (visible old) + then setFocus (FocusTag i) old new + else setFocus FocusCurrent old new -- | A variation of @onScreen@ which will take any @X ()@ function and run it -- on the given screen. -- Warning: This function will change focus even if the function it's supposed -- to run doesn't succeed. -onScreen' :: X () -- ^ X function to run - -> Focus -- ^ focus - -> ScreenId -- ^ screen id - -> X () +onScreen' :: + -- | X function to run + X () -> + -- | focus + Focus -> + -- | screen id + ScreenId -> + X () onScreen' x foc sc = do - st <- gets windowset - case lookupWorkspace sc st of - Nothing -> return () - Just ws -> do - windows $ view ws - x - windows $ setFocus foc st - + st <- gets windowset + case lookupWorkspace sc st of + Nothing -> return () + Just ws -> do + windows $ view ws + x + windows $ setFocus foc st -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- switch focus to the workspace @i@. -viewOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +viewOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet viewOnScreen sid i = - onScreen (view i) (FocusTag i) sid + onScreen (view i) (FocusTag i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ -- to switch the current workspace with workspace @i@. -greedyViewOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +greedyViewOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet greedyViewOnScreen sid i = - onScreen (greedyView i) (FocusTagVisible i) sid + onScreen (greedyView i) (FocusTagVisible i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing. -onlyOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +onlyOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet onlyOnScreen sid i = - onScreen (view i) FocusCurrent sid + onScreen (view i) FocusCurrent sid -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view -toggleOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +toggleOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet toggleOnScreen sid i = - onScreen (toggleOrView' view i) FocusCurrent sid + onScreen (toggleOrView' view i) FocusCurrent sid -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView -toggleGreedyOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +toggleGreedyOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet toggleGreedyOnScreen sid i = - onScreen (toggleOrView' greedyView i) FocusCurrent sid - + onScreen (toggleOrView' greedyView i) FocusCurrent sid -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip -toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run - -> WorkspaceId -- ^ tag to look for - -> WindowSet -- ^ current stackset - -> WindowSet +toggleOrView' :: + -- | function to run + (WorkspaceId -> WindowSet -> WindowSet) -> + -- | tag to look for + WorkspaceId -> + -- | current stackset + WindowSet -> + WindowSet toggleOrView' f i st = fromMaybe (f i st) $ do - let st' = hidden st - -- make sure we actually have to do something - guard $ i == (tag . workspace $ current st) - case st' of - [] -> empty - (h : _) -> return $ f (tag h) st -- finally, toggle! + let st' = hidden st + -- make sure we actually have to do something + guard $ i == (tag . workspace $ current st) + case st' of + [] -> empty + (h : _) -> return $ f (tag h) st -- finally, toggle! -- $usage -- diff --git a/XMonad/Hooks/ScreenCorners.hs b/XMonad/Hooks/ScreenCorners.hs index 74d3026d5..a1d3323fb 100644 --- a/XMonad/Hooks/ScreenCorners.hs +++ b/XMonad/Hooks/ScreenCorners.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ------------------------------------------------------------------------------ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} + -- | -- Module : XMonad.Hooks.ScreenCorners -- Description : Run X () actions by touching the edge of your screen with your mouse. @@ -11,42 +13,39 @@ -- Portability : unportable -- -- Run @X ()@ actions by touching the edge of your screen with your mouse. --- ------------------------------------------------------------------------------ - module XMonad.Hooks.ScreenCorners - ( - -- * Usage + ( -- * Usage -- $usage -- * Adding screen corners - ScreenCorner (..) - , addScreenCorner - , addScreenCorners + ScreenCorner (..), + addScreenCorner, + addScreenCorners, -- * Event hook - , screenCornerEventHook + screenCornerEventHook, -- * Layout hook - , screenCornerLayoutHook - ) where + screenCornerLayoutHook, + ) +where -import XMonad.Prelude +import qualified Data.Map as M import XMonad import XMonad.Layout.LayoutModifier - -import qualified Data.Map as M +import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS -data ScreenCorner = SCUpperLeft - | SCUpperRight - | SCLowerLeft - | SCLowerRight - | SCTop - | SCBottom - | SCLeft - | SCRight - deriving (Eq, Ord, Show) +data ScreenCorner + = SCUpperLeft + | SCUpperRight + | SCLowerLeft + | SCLowerRight + | SCTop + | SCBottom + | SCLeft + | SCRight + deriving (Eq, Ord, Show) -------------------------------------------------------------------------------- -- ExtensibleState modifications @@ -55,25 +54,22 @@ data ScreenCorner = SCUpperLeft newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) instance ExtensionClass ScreenCornerState where - initialValue = ScreenCornerState M.empty + initialValue = ScreenCornerState M.empty -- | Add one single @X ()@ action to a screen corner addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner corner xF = do + ScreenCornerState m <- XS.get + (win, xFunc) <- case find (\(_, (sc, _)) -> sc == corner) (M.toList m) of + Just (w, (_, xF')) -> return (w, xF' >> xF) -- chain X actions + Nothing -> (,xF) <$> createWindowAt corner - ScreenCornerState m <- XS.get - (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of - - Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions - Nothing -> (, xF) <$> createWindowAt corner - - XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' + XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m' -- | Add a list of @(ScreenCorner, X ())@ tuples -addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () +addScreenCorners :: [(ScreenCorner, X ())] -> X () addScreenCorners = mapM_ (uncurry addScreenCorner) - -------------------------------------------------------------------------------- -- Xlib functions -------------------------------------------------------------------------------- @@ -83,72 +79,64 @@ addScreenCorners = mapM_ (uncurry addScreenCorner) createWindowAt :: ScreenCorner -> X Window createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1 createWindowAt SCUpperRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - in createWindowAt' (fi w) 0 1 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) 0 1 1 createWindowAt SCLowerLeft = withDisplay $ \dpy -> - let h = displayHeight dpy (defaultScreen dpy) - 1 - in createWindowAt' 0 (fi h) 1 1 - + let h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' 0 (fi h) 1 1 createWindowAt SCLowerRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - in createWindowAt' (fi w) (fi h) 1 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) (fi h) 1 1 createWindowAt SCTop = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - -- leave some gap so corner and edge can work nicely when they overlap - threshold = 150 - in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + -- leave some gap so corner and edge can work nicely when they overlap + threshold = 150 + in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 createWindowAt SCBottom = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1 createWindowAt SCLeft = withDisplay $ \dpy -> - let h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2) - + let h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2) createWindowAt SCRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) -- Create a new X window at a (x,y) Position, with given width and height. createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window createWindowAt' x y width height = withDisplay $ \dpy -> io $ do - - rootw <- rootWindow dpy (defaultScreen dpy) - - let - visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy - attrmask = cWOverrideRedirect - - w <- allocaSetWindowAttributes $ \attributes -> do - - set_override_redirect attributes True - createWindow dpy -- display - rootw -- parent window - x -- x - y -- y - width -- width - height -- height - 0 -- border width - 0 -- depth - inputOnly -- class - visual -- visual - attrmask -- valuemask - attributes -- attributes - - -- we only need mouse entry events - selectInput dpy w enterWindowMask - mapWindow dpy w - sync dpy False - return w + rootw <- rootWindow dpy (defaultScreen dpy) + + let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy + attrmask = cWOverrideRedirect + + w <- allocaSetWindowAttributes $ \attributes -> do + set_override_redirect attributes True + createWindow + dpy -- display + rootw -- parent window + x -- x + y -- y + width -- width + height -- height + 0 -- border width + 0 -- depth + inputOnly -- class + visual -- visual + attrmask -- valuemask + attributes -- attributes + + -- we only need mouse entry events + selectInput dpy w enterWindowMask + mapWindow dpy w + sync dpy False + return w -------------------------------------------------------------------------------- -- Event hook @@ -156,37 +144,34 @@ createWindowAt' x y width height = withDisplay $ \dpy -> io $ do -- | Handle screen corner events screenCornerEventHook :: Event -> X All -screenCornerEventHook CrossingEvent { ev_window = win } = do +screenCornerEventHook CrossingEvent {ev_window = win} = do + ScreenCornerState m <- XS.get - ScreenCornerState m <- XS.get - - case M.lookup win m of - Just (_, xF) -> xF - Nothing -> return () - - return (All True) + case M.lookup win m of + Just (_, xF) -> xF + Nothing -> return () + return (All True) screenCornerEventHook _ = return (All True) - -------------------------------------------------------------------------------- -- Layout hook -------------------------------------------------------------------------------- data ScreenCornerLayout a = ScreenCornerLayout - deriving ( Read, Show ) + deriving (Read, Show) instance LayoutModifier ScreenCornerLayout a where - hook ScreenCornerLayout = withDisplay $ \dpy -> do - ScreenCornerState m <- XS.get - io $ mapM_ (raiseWindow dpy) $ M.keys m - unhook = hook + hook ScreenCornerLayout = withDisplay $ \dpy -> do + ScreenCornerState m <- XS.get + io $ mapM_ (raiseWindow dpy) $ M.keys m + unhook = hook screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout - -------------------------------------------------------------------------------- + -- $usage -- -- This extension adds KDE-like screen corners and GNOME Hot Edge like