{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.PositionStoreFloat
-- Copyright : (c) Jan Vornberger 2009
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de
-- Stability : unstable
-- Portability : not portable
--
-- A floating layout which has been designed with a dual-head setup
-- in mind. It makes use of "XMonad.Util.PositionStore" as well as
-- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way
-- to move or resize windows with the keyboard alone in this layout,
-- it is adviced to use it in combination with a decoration such as
-- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the
-- layout modifier "XMonad.Layout.BorderResize" (to resize windows).
--
-----------------------------------------------------------------------------
module XMonad.Layout.PositionStoreFloat
( -- * Usage
-- $usage
positionStoreFloat, PositionStoreFloat
) where
import XMonad
import XMonad.Util.PositionStore
import qualified XMonad.StackSet as S
import XMonad.Layout.WindowArranger
import Control.Monad(when)
import Data.Maybe(isJust)
import Data.List(nub)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.PositionStoreFloat
-- > import XMonad.Layout.NoFrillsDecoration
-- > import XMonad.Layout.BorderResize
--
-- Then edit your @layoutHook@ by adding the PositionStoreFloat layout.
-- Below is a suggestion which uses the mentioned NoFrillsDecoration and
-- BorderResize:
--
-- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc..
-- > where floatingDeco l = noFrillsDeco shrinkText defaultTheme l
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
--
-- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how
-- to add the support hooks.
positionStoreFloat :: PositionStoreFloat a
positionStoreFloat = PSF (Nothing, [])
data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read)
instance LayoutClass PositionStoreFloat Window where
description _ = "PSF"
doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do
posStore <- getPosStore
let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r)
let focused = case maybeChange of
Nothing -> (w, pSQ posStore w sr)
Just changedRect -> (w, changedRect)
let wrs' = focused : wrs
let paintOrder' = nub (w : paintOrder)
when (isJust maybeChange) $ do
updatePositionStore focused sr
return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))
where
pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of
Just rect -> rect
Nothing -> (Rectangle 50 50 200 200) -- should usually not happen
pureMessage (PSF (_, paintOrder)) m
| Just (SetGeometry rect) <- fromMessage m =
Just $ PSF (Just rect, paintOrder)
| otherwise = Nothing
updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()
updatePositionStore (w, rect) sr = modifyPosStore (\ps ->
posStoreInsert ps w rect sr)
reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
reorder wrs order =
let ordered = concat $ map (pickElem wrs) order
rest = filter (\(w, _) -> not (w `elem` order)) wrs
in ordered ++ rest
where
pickElem list e = case (lookup e list) of
Just result -> [(e, result)]
Nothing -> []
