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

{X.A.OnScreen,X.H.ScreenCorners}: Reformat

Browse Source
This commit is contained in:
Nils 2025-01-02 15:11:01 +01:00 committed by Tony Zorman
parent 195537e97e
commit 7f0f0ad498
2 changed files with 214 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

217
XMonad/Actions/OnScreen.hs
View File

@ -1,4 +1,3 @@
-----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Actions.OnScreen -- Module : XMonad.Actions.OnScreen
-- Description : Control workspaces on different screens (in xinerama mode). -- Description : Control workspaces on different screens (in xinerama mode).
@ -10,139 +9,173 @@
-- Portability : unportable -- Portability : unportable
-- --
-- Control workspaces on different screens (in xinerama mode). -- Control workspaces on different screens (in xinerama mode).
-- module XMonad.Actions.OnScreen
----------------------------------------------------------------------------- ( -- * Usage
module XMonad.Actions.OnScreen (
-- * Usage
-- $usage -- $usage
onScreen onScreen,
, onScreen' onScreen',
, Focus(..) Focus (..),
, viewOnScreen viewOnScreen,
, greedyViewOnScreen greedyViewOnScreen,
, onlyOnScreen onlyOnScreen,
, toggleOnScreen toggleOnScreen,
, toggleGreedyOnScreen toggleGreedyOnScreen,
) where )
where
import XMonad import XMonad
import XMonad.Prelude (fromMaybe, guard, empty) import XMonad.Prelude (empty, fromMaybe, guard)
import XMonad.StackSet hiding (new) import XMonad.StackSet hiding (new)
-- | Focus data definitions -- | Focus data definitions
data Focus = FocusNew -- ^ always focus the new screen data Focus
| FocusCurrent -- ^ always keep the focus on the current screen = -- | always focus the new screen
| FocusTag WorkspaceId -- ^ always focus tag i on the new stack FocusNew
| FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack | -- | 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 -- | 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 -- will also need to know which Screen to focus after the function has been
-- run. -- run.
onScreen :: (WindowSet -> WindowSet) -- ^ function to run onScreen ::
-> Focus -- ^ what to do with the focus -- | function to run
-> ScreenId -- ^ screen id (WindowSet -> WindowSet) ->
-> WindowSet -- ^ current stack -- | what to do with the focus
-> WindowSet Focus ->
-- | screen id
ScreenId ->
-- | current stack
WindowSet ->
WindowSet
onScreen f foc sc st = fromMaybe st $ do onScreen f foc sc st = fromMaybe st $ do
ws <- lookupWorkspace sc st ws <- lookupWorkspace sc st
let fStack = f $ view ws st let fStack = f $ view ws st
return $ setFocus foc st fStack
return $ setFocus foc st fStack
-- set focus for new stack -- set focus for new stack
setFocus :: Focus setFocus ::
-> WindowSet -- ^ old stack Focus ->
-> WindowSet -- ^ new stack -- | old stack
-> WindowSet WindowSet ->
setFocus FocusNew _ new = new -- | new stack
setFocus FocusCurrent old new = WindowSet ->
case lookupWorkspace (screen $ current old) new of WindowSet
Nothing -> new setFocus FocusNew _ new = new
Just i -> view i new setFocus FocusCurrent old new =
setFocus (FocusTag i) _ new = view i 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 = setFocus (FocusTagVisible i) old new =
if i `elem` map (tag . workspace) (visible old) if i `elem` map (tag . workspace) (visible old)
then setFocus (FocusTag i) old new then setFocus (FocusTag i) old new
else setFocus FocusCurrent old new else setFocus FocusCurrent old new
-- | A variation of @onScreen@ which will take any @X ()@ function and run it -- | A variation of @onScreen@ which will take any @X ()@ function and run it
-- on the given screen. -- on the given screen.
-- Warning: This function will change focus even if the function it's supposed -- Warning: This function will change focus even if the function it's supposed
-- to run doesn't succeed. -- to run doesn't succeed.
onScreen' :: X () -- ^ X function to run onScreen' ::
-> Focus -- ^ focus -- | X function to run
-> ScreenId -- ^ screen id X () ->
-> X () -- | focus
Focus ->
-- | screen id
ScreenId ->
X ()
onScreen' x foc sc = do onScreen' x foc sc = do
st <- gets windowset st <- gets windowset
case lookupWorkspace sc st of case lookupWorkspace sc st of
Nothing -> return () Nothing -> return ()
Just ws -> do Just ws -> do
windows $ view ws windows $ view ws
x x
windows $ setFocus foc st windows $ setFocus foc st
-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to
-- switch focus to the workspace @i@. -- switch focus to the workspace @i@.
viewOnScreen :: ScreenId -- ^ screen id viewOnScreen ::
-> WorkspaceId -- ^ index of the workspace -- | screen id
-> WindowSet -- ^ current stack ScreenId ->
-> WindowSet -- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
viewOnScreen sid i = 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@ -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@
-- to switch the current workspace with workspace @i@. -- to switch the current workspace with workspace @i@.
greedyViewOnScreen :: ScreenId -- ^ screen id greedyViewOnScreen ::
-> WorkspaceId -- ^ index of the workspace -- | screen id
-> WindowSet -- ^ current stack ScreenId ->
-> WindowSet -- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
greedyViewOnScreen sid i = 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. -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.
onlyOnScreen :: ScreenId -- ^ screen id onlyOnScreen ::
-> WorkspaceId -- ^ index of the workspace -- | screen id
-> WindowSet -- ^ current stack ScreenId ->
-> WindowSet -- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
onlyOnScreen sid i = onlyOnScreen sid i =
onScreen (view i) FocusCurrent sid onScreen (view i) FocusCurrent sid
-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
toggleOnScreen :: ScreenId -- ^ screen id toggleOnScreen ::
-> WorkspaceId -- ^ index of the workspace -- | screen id
-> WindowSet -- ^ current stack ScreenId ->
-> WindowSet -- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleOnScreen sid i = toggleOnScreen sid i =
onScreen (toggleOrView' view i) FocusCurrent sid onScreen (toggleOrView' view i) FocusCurrent sid
-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
toggleGreedyOnScreen :: ScreenId -- ^ screen id toggleGreedyOnScreen ::
-> WorkspaceId -- ^ index of the workspace -- | screen id
-> WindowSet -- ^ current stack ScreenId ->
-> WindowSet -- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleGreedyOnScreen sid i = toggleGreedyOnScreen sid i =
onScreen (toggleOrView' greedyView i) FocusCurrent sid onScreen (toggleOrView' greedyView i) FocusCurrent sid
-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip
toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run toggleOrView' ::
-> WorkspaceId -- ^ tag to look for -- | function to run
-> WindowSet -- ^ current stackset (WorkspaceId -> WindowSet -> WindowSet) ->
-> WindowSet -- | tag to look for
WorkspaceId ->
-- | current stackset
WindowSet ->
WindowSet
toggleOrView' f i st = fromMaybe (f i st) $ do toggleOrView' f i st = fromMaybe (f i st) $ do
let st' = hidden st let st' = hidden st
-- make sure we actually have to do something -- make sure we actually have to do something
guard $ i == (tag . workspace $ current st) guard $ i == (tag . workspace $ current st)
case st' of case st' of
[] -> empty [] -> empty
(h : _) -> return $ f (tag h) st -- finally, toggle! (h : _) -> return $ f (tag h) st -- finally, toggle!
-- $usage -- $usage
-- --

193
XMonad/Hooks/ScreenCorners.hs
View File

@ -1,5 +1,7 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} {-# LANGUAGE FlexibleInstances #-}
----------------------------------------------------------------------------- {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
-- | -- |
-- Module : XMonad.Hooks.ScreenCorners -- Module : XMonad.Hooks.ScreenCorners
-- Description : Run X () actions by touching the edge of your screen with your mouse. -- Description : Run X () actions by touching the edge of your screen with your mouse.
@ -11,42 +13,39 @@
-- Portability : unportable -- Portability : unportable
-- --
-- Run @X ()@ actions by touching the edge of your screen with your mouse. -- Run @X ()@ actions by touching the edge of your screen with your mouse.
--
-----------------------------------------------------------------------------
module XMonad.Hooks.ScreenCorners module XMonad.Hooks.ScreenCorners
( ( -- * Usage
-- * Usage
-- $usage -- $usage
-- * Adding screen corners -- * Adding screen corners
ScreenCorner (..) ScreenCorner (..),
, addScreenCorner addScreenCorner,
, addScreenCorners addScreenCorners,
-- * Event hook -- * Event hook
, screenCornerEventHook screenCornerEventHook,
-- * Layout hook -- * Layout hook
, screenCornerLayoutHook screenCornerLayoutHook,
) where )
where
import XMonad.Prelude
import XMonad
import XMonad.Layout.LayoutModifier
import qualified Data.Map as M import qualified Data.Map as M
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified XMonad.Util.ExtensibleState as XS import qualified XMonad.Util.ExtensibleState as XS
data ScreenCorner = SCUpperLeft data ScreenCorner
| SCUpperRight = SCUpperLeft
| SCLowerLeft | SCUpperRight
| SCLowerRight | SCLowerLeft
| SCTop | SCLowerRight
| SCBottom | SCTop
| SCLeft | SCBottom
| SCRight | SCLeft
deriving (Eq, Ord, Show) | SCRight
deriving (Eq, Ord, Show)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- ExtensibleState modifications -- ExtensibleState modifications
@ -55,25 +54,22 @@ data ScreenCorner = SCUpperLeft
newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
instance ExtensionClass ScreenCornerState where instance ExtensionClass ScreenCornerState where
initialValue = ScreenCornerState M.empty initialValue = ScreenCornerState M.empty
-- | Add one single @X ()@ action to a screen corner -- | Add one single @X ()@ action to a screen corner
addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner corner xF = do 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 XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m'
(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'
-- | Add a list of @(ScreenCorner, X ())@ tuples -- | Add a list of @(ScreenCorner, X ())@ tuples
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () addScreenCorners :: [(ScreenCorner, X ())] -> X ()
addScreenCorners = mapM_ (uncurry addScreenCorner) addScreenCorners = mapM_ (uncurry addScreenCorner)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Xlib functions -- Xlib functions
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -83,72 +79,64 @@ addScreenCorners = mapM_ (uncurry addScreenCorner)
createWindowAt :: ScreenCorner -> X Window createWindowAt :: ScreenCorner -> X Window
createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1 createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1
createWindowAt SCUpperRight = withDisplay $ \dpy -> createWindowAt SCUpperRight = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1 let w = displayWidth dpy (defaultScreen dpy) - 1
in createWindowAt' (fi w) 0 1 1 in createWindowAt' (fi w) 0 1 1
createWindowAt SCLowerLeft = withDisplay $ \dpy -> createWindowAt SCLowerLeft = withDisplay $ \dpy ->
let h = displayHeight dpy (defaultScreen dpy) - 1 let h = displayHeight dpy (defaultScreen dpy) - 1
in createWindowAt' 0 (fi h) 1 1 in createWindowAt' 0 (fi h) 1 1
createWindowAt SCLowerRight = withDisplay $ \dpy -> createWindowAt SCLowerRight = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1 let w = displayWidth dpy (defaultScreen dpy) - 1
h = displayHeight dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1
in createWindowAt' (fi w) (fi h) 1 1 in createWindowAt' (fi w) (fi h) 1 1
createWindowAt SCTop = withDisplay $ \dpy -> createWindowAt SCTop = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1 let w = displayWidth dpy (defaultScreen dpy) - 1
-- leave some gap so corner and edge can work nicely when they overlap -- leave some gap so corner and edge can work nicely when they overlap
threshold = 150 threshold = 150
in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1
createWindowAt SCBottom = withDisplay $ \dpy -> createWindowAt SCBottom = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1 let w = displayWidth dpy (defaultScreen dpy) - 1
h = displayHeight dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1
threshold = 150 threshold = 150
in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1 in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1
createWindowAt SCLeft = withDisplay $ \dpy -> createWindowAt SCLeft = withDisplay $ \dpy ->
let h = displayHeight dpy (defaultScreen dpy) - 1 let h = displayHeight dpy (defaultScreen dpy) - 1
threshold = 150 threshold = 150
in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2) in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2)
createWindowAt SCRight = withDisplay $ \dpy -> createWindowAt SCRight = withDisplay $ \dpy ->
let w = displayWidth dpy (defaultScreen dpy) - 1 let w = displayWidth dpy (defaultScreen dpy) - 1
h = displayHeight dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1
threshold = 150 threshold = 150
in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) 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. -- Create a new X window at a (x,y) Position, with given width and height.
createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' x y width height = withDisplay $ \dpy -> io $ do createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
rootw <- rootWindow dpy (defaultScreen dpy)
rootw <- rootWindow dpy (defaultScreen dpy) let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
attrmask = cWOverrideRedirect
let w <- allocaSetWindowAttributes $ \attributes -> do
visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy set_override_redirect attributes True
attrmask = cWOverrideRedirect 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
w <- allocaSetWindowAttributes $ \attributes -> do -- we only need mouse entry events
selectInput dpy w enterWindowMask
set_override_redirect attributes True mapWindow dpy w
createWindow dpy -- display sync dpy False
rootw -- parent window return w
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 -- Event hook
@ -156,37 +144,34 @@ createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
-- | Handle screen corner events -- | Handle screen corner events
screenCornerEventHook :: Event -> X All 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
case M.lookup win m of Nothing -> return ()
Just (_, xF) -> xF
Nothing -> return ()
return (All True)
return (All True)
screenCornerEventHook _ = return (All True) screenCornerEventHook _ = return (All True)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Layout hook -- Layout hook
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data ScreenCornerLayout a = ScreenCornerLayout data ScreenCornerLayout a = ScreenCornerLayout
deriving ( Read, Show ) deriving (Read, Show)
instance LayoutModifier ScreenCornerLayout a where instance LayoutModifier ScreenCornerLayout a where
hook ScreenCornerLayout = withDisplay $ \dpy -> do hook ScreenCornerLayout = withDisplay $ \dpy -> do
ScreenCornerState m <- XS.get ScreenCornerState m <- XS.get
io $ mapM_ (raiseWindow dpy) $ M.keys m io $ mapM_ (raiseWindow dpy) $ M.keys m
unhook = hook unhook = hook
screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- $usage -- $usage
-- --
-- This extension adds KDE-like screen corners and GNOME Hot Edge like -- This extension adds KDE-like screen corners and GNOME Hot Edge like