From 7f0f0ad498888d27eab5c2ebf0df368c82a80fb0 Mon Sep 17 00:00:00 2001
From: Nils <mail@nils.cc>
Date: Thu, 2 Jan 2025 15:11:01 +0100
Subject: [PATCH] {X.A.OnScreen,X.H.ScreenCorners}: Reformat
---
XMonad/Actions/OnScreen.hs | 217 ++++++++++++++++++++--------------
XMonad/Hooks/ScreenCorners.hs | 193 ++++++++++++++----------------
2 files changed, 214 insertions(+), 196 deletions(-)
diff --git a/XMonad/Actions/OnScreen.hs b/XMonad/Actions/OnScreen.hs
index f1e432f8..404dda13 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 74d3026d..a1d3323f 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
-
-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
- | 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)
- rootw <- rootWindow dpy (defaultScreen dpy)
+ let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
+ attrmask = cWOverrideRedirect
- 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
- 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
+ -- 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