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

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

View File

@ -1,4 +1,3 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.OnScreen
-- Description : Control workspaces on different screens (in xinerama mode).
@ -10,42 +9,48 @@
-- 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
@ -53,12 +58,14 @@ onScreen f foc sc st = fromMaybe st $ do
return $ setFocus foc st fStack
-- set focus for new stack
setFocus :: Focus
-> WindowSet -- ^ old stack
-> WindowSet -- ^ new stack
-> WindowSet
setFocus ::
Focus ->
-- | old stack
WindowSet ->
-- | new stack
WindowSet ->
WindowSet
setFocus FocusNew _ new = new
setFocus FocusCurrent old new =
case lookupWorkspace (screen $ current old) new of
@ -74,10 +81,14 @@ setFocus (FocusTagVisible i) old new =
-- 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
@ -87,55 +98,77 @@ onScreen' x foc sc = do
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
-- | 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
-- | 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
-- | @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
-- | @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
-- 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

View File

@ -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,34 +13,31 @@
-- 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
import XMonad.Prelude
import XMonad
import XMonad.Layout.LayoutModifier
screenCornerLayoutHook,
)
where
import qualified Data.Map as M
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified XMonad.Util.ExtensibleState as XS
data ScreenCorner = SCUpperLeft
data ScreenCorner
= SCUpperLeft
| SCUpperRight
| SCLowerLeft
| SCLowerRight
@ -60,10 +59,8 @@ instance ExtensionClass ScreenCornerState where
-- | 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
@ -73,7 +70,6 @@ addScreenCorner corner xF = do
addScreenCorners :: [(ScreenCorner, X ())] -> X ()
addScreenCorners = mapM_ (uncurry addScreenCorner)
--------------------------------------------------------------------------------
-- Xlib functions
--------------------------------------------------------------------------------
@ -85,33 +81,27 @@ 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
createWindowAt SCLowerLeft = withDisplay $ \dpy ->
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
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
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
createWindowAt SCLeft = withDisplay $ \dpy ->
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
@ -121,17 +111,15 @@ createWindowAt SCRight = withDisplay $ \dpy ->
-- 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
let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
attrmask = cWOverrideRedirect
w <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
createWindow dpy -- display
createWindow
dpy -- display
rootw -- parent window
x -- x
y -- y
@ -157,7 +145,6 @@ createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
-- | Handle screen corner events
screenCornerEventHook :: Event -> X All
screenCornerEventHook CrossingEvent {ev_window = win} = do
ScreenCornerState m <- XS.get
case M.lookup win m of
@ -165,10 +152,8 @@ screenCornerEventHook CrossingEvent { ev_window = win } = do
Nothing -> return ()
return (All True)
screenCornerEventHook _ = return (All True)
--------------------------------------------------------------------------------
-- Layout hook
--------------------------------------------------------------------------------
@ -185,8 +170,8 @@ instance LayoutModifier ScreenCornerLayout a where
screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
--------------------------------------------------------------------------------
-- $usage
--
-- This extension adds KDE-like screen corners and GNOME Hot Edge like