mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-18 19:10:21 -07:00
{X.A.OnScreen,X.H.ScreenCorners}: Reformat
This commit is contained in:
Nils
Tony Zorman
parent
195537e97e
commit
7f0f0ad498
@ -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
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user