module XMonad.Actions.Plane
(
Direction (..)
, Limits (..)
, Lines (..)
, planeKeys
, planeShift
, planeMove
)
where
import Data.Map (Map, fromList)
import XMonad.Prelude hiding (fromList)
import XMonad
import XMonad.StackSet hiding (workspaces)
import XMonad.Util.Run
data Direction = ToLeft | ToUp | ToRight | ToDown deriving Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Direction -> Direction
succ :: Direction -> Direction
$cpred :: Direction -> Direction
pred :: Direction -> Direction
$ctoEnum :: Int -> Direction
toEnum :: Int -> Direction
$cfromEnum :: Direction -> Int
fromEnum :: Direction -> Int
$cenumFrom :: Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
Enum
data Limits
= Finite
| Circular
| Linear
deriving Limits -> Limits -> Bool
(Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool) -> Eq Limits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
/= :: Limits -> Limits -> Bool
Eq
data Lines
= GConf
| Lines Int
planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ())
planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, Window) (X ())
planeKeys KeyMask
modm Lines
ln Limits
limits =
[((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ()))
-> [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall a b. (a -> b) -> a -> b
$
[ ((KeyMask
keyMask, Window
keySym), Lines -> Limits -> Direction -> X ()
function Lines
ln Limits
limits Direction
direction)
| (Window
keySym, Direction
direction) <- [Window] -> [Direction] -> [(Window, Direction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window
xK_Left .. Window
xK_Down] ([Direction] -> [(Window, Direction)])
-> [Direction] -> [(Window, Direction)]
forall a b. (a -> b) -> a -> b
$ Direction -> [Direction]
forall a. Enum a => a -> [a]
enumFrom Direction
ToLeft
, (KeyMask
keyMask, Lines -> Limits -> Direction -> X ()
function) <- [(KeyMask
modm, Lines -> Limits -> Direction -> X ()
planeMove), (KeyMask
shiftMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
modm, Lines -> Limits -> Direction -> X ()
planeShift)]
]
planeShift :: Lines -> Limits -> Direction -> X ()
planeShift :: Lines -> Limits -> Direction -> X ()
planeShift = (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
forall s i a l sd.
(Eq s, Eq i, Ord a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift'
shift' ::
(Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd
shift' :: forall s i a l sd.
(Eq s, Eq i, Ord a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift' i
area = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView i
area (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift i
area
planeMove :: Lines -> Limits -> Direction -> X ()
planeMove :: Lines -> Limits -> Direction -> X ()
planeMove = (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView
plane ::
(WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
X ()
plane :: (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
function Lines
numberLines_ Limits
limits Direction
direction = do
XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
XConf
xconf <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
Int
numberLines <-
IO Int -> X Int
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$
case Lines
numberLines_ of
Lines Int
numberLines__ ->
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
numberLines__
Lines
GConf ->
do
WorkspaceId
numberLines__ <-
WorkspaceId -> [WorkspaceId] -> WorkspaceId -> IO WorkspaceId
forall (m :: * -> *).
MonadIO m =>
WorkspaceId -> [WorkspaceId] -> WorkspaceId -> m WorkspaceId
runProcessWithInput WorkspaceId
gconftool [WorkspaceId]
parameters WorkspaceId
""
case ReadS Int
forall a. Read a => ReadS a
reads WorkspaceId
numberLines__ of
[(Int
numberRead, WorkspaceId
_)] -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
numberRead
[(Int, WorkspaceId)]
_ ->
do
WorkspaceId -> IO ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace (WorkspaceId -> IO ()) -> WorkspaceId -> IO ()
forall a b. (a -> b) -> a -> b
$
WorkspaceId
"XMonad.Actions.Plane: Could not parse the output of " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
gconftool WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++
[WorkspaceId] -> WorkspaceId
unwords [WorkspaceId]
parameters WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
": " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
numberLines__ WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"; assuming 1."
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
let
notBorder :: Bool
notBorder :: Bool
notBorder = (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
2 (Int
circular_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currentWS) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
2 (Int
circular_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
currentWS)) [Bool] -> Int -> Bool
forall a. HasCallStack => [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction
circular_ :: Int
circular_ :: Int
circular_ = Int -> Int
circular Int
currentWS
circular :: Int -> Int
circular :: Int -> Int
circular =
[ (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
pred
, (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred
, (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
succ
, (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ
]
[Int -> Int] -> Int -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction
linear :: Int -> Int
linear :: Int -> Int
linear =
[ (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred
, (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
pred
, (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ
, (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
succ
]
[Int -> Int] -> Int -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction
onLine :: (Int -> Int) -> Int -> Int
onLine :: (Int -> Int) -> Int -> Int
onLine Int -> Int
f Int
currentWS_
| Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
areasLine = Int -> Int
mod_ Int
columns
| Bool
otherwise = Int -> Int
mod_ Int
areasColumn
where
line, column :: Int
(Int
line, Int
column) = Int -> (Int, Int)
split Int
currentWS_
mod_ :: Int -> Int
mod_ :: Int -> Int
mod_ Int
columns_ = Int -> Int -> Int
compose Int
line (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int -> Int
f Int
column) Int
columns_
onColumn :: (Int -> Int) -> Int -> Int
onColumn :: (Int -> Int) -> Int -> Int
onColumn Int -> Int
f Int
currentWS_
| Int
column Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
areasColumn Bool -> Bool -> Bool
|| Int
areasColumn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int
mod_ Int
numberLines
| Bool
otherwise = Int -> Int
mod_ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
numberLines
where
line, column :: Int
(Int
line, Int
column) = Int -> (Int, Int)
split Int
currentWS_
mod_ :: Int -> Int
mod_ :: Int -> Int
mod_ Int
lines_ = Int -> Int -> Int
compose (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int -> Int
f Int
line) Int
lines_) Int
column
compose :: Int -> Int -> Int
compose :: Int -> Int -> Int
compose Int
line Int
column = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
column
split :: Int -> (Int, Int)
split :: Int -> (Int, Int)
split Int
currentWS_ =
((Int -> Int -> Int) -> Int
operation Int -> Int -> Int
forall a. Integral a => a -> a -> a
div, (Int -> Int -> Int) -> Int
operation Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod)
where
operation :: (Int -> Int -> Int) -> Int
operation :: (Int -> Int -> Int) -> Int
operation Int -> Int -> Int
f = Int -> Int -> Int
f Int
currentWS_ Int
columns
areasLine :: Int
areasLine :: Int
areasLine = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
areas Int
columns
areasColumn :: Int
areasColumn :: Int
areasColumn = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
areas Int
columns
columns :: Int
columns :: Int
columns =
if Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
areas Int
numberLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
preColumns else Int
preColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
currentWS :: Int
currentWS :: Int
currentWS = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
mCurrentWS
preColumns :: Int
preColumns :: Int
preColumns = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
areas Int
numberLines
mCurrentWS :: Maybe Int
mCurrentWS :: Maybe Int
mCurrentWS = WorkspaceId -> [WorkspaceId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
currentTag (WindowSet -> WorkspaceId) -> WindowSet -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
st) [WorkspaceId]
areaNames
areas :: Int
areas :: Int
areas = [WorkspaceId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WorkspaceId]
areaNames
run :: (Int -> Int) -> X ()
run :: (Int -> Int) -> X ()
run Int -> Int
f = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
function (WorkspaceId -> WindowSet -> WindowSet)
-> WorkspaceId -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ [WorkspaceId]
areaNames [WorkspaceId] -> Int -> WorkspaceId
forall a. HasCallStack => [a] -> Int -> a
!! Int -> Int
f Int
currentWS
areaNames :: [String]
areaNames :: [WorkspaceId]
areaNames = XConfig Layout -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces (XConfig Layout -> [WorkspaceId])
-> XConfig Layout -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ XConf -> XConfig Layout
config XConf
xconf
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mCurrentWS) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
case Limits
limits of
Limits
Finite -> Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notBorder (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> X ()
run Int -> Int
circular
Limits
Circular -> (Int -> Int) -> X ()
run Int -> Int
circular
Limits
Linear -> if Bool
notBorder then (Int -> Int) -> X ()
run Int -> Int
circular else (Int -> Int) -> X ()
run Int -> Int
linear
gconftool :: String
gconftool :: WorkspaceId
gconftool = WorkspaceId
"gconftool-2"
parameters :: [String]
parameters :: [WorkspaceId]
parameters = [WorkspaceId
"--get", WorkspaceId
"/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]