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