PositionStoreFloat - a floating layout with support hooks

Ignore-this: 8b1d0fcef1465356d72cb5f1f32413b6

darcs-hash:20091115184833-594c5-9534e1ec9be959d18713bfdd1edbc1f5995cc4a8.gz

5 files changed, 197 insertions, 2 deletions

diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs
new file mode 100644
index 0000000..92ad0ae
--- /dev/null
+++ b/XMonad/Hooks/PositionStoreHooks.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE PatternSignatures #-}
+
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.PositionStoreHooks
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This module contains two hooks for the
+-- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and
+-- an EventHook.
+--
+-- The ManageHook can be used to fill the PositionStore with position and size
+-- information about new windows. The advantage of using this hook is, that the
+-- information is recorded independent of the currently active layout. So the
+-- floating shape of the window can later be restored even if it was opened in a
+-- tiled layout initially.
+--
+-- For windows, that do not request a particular position, a random position will
+-- be assigned. This prevents windows from piling up exactly on top of each other.
+--
+-- The EventHook makes sure that windows are deleted from the PositionStore
+-- when they are closed.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.PositionStoreHooks (
+    -- * Usage
+    -- $usage
+    positionStoreManageHook,
+    positionStoreEventHook
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.PositionStore
+
+import System.Random(randomRIO)
+import Control.Applicative((<$>))
+import Control.Monad(when)
+import Data.Maybe
+import Data.Monoid
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.PositionStoreHooks
+--
+-- and adding 'positionStoreManageHook' to your 'ManageHook' as well
+-- as 'positionStoreEventHook' to your event hooks:
+--
+-- > myManageHook = positionStoreManageHook <+> manageHook defaultConfig
+-- > myHandleEventHook = positionStoreEventHook
+-- >
+-- > main = xmonad defaultConfig { manageHook = myManageHook
+-- >                             , handleEventHook = myHandleEventHook
+-- >                             }
+--
+
+positionStoreManageHook :: ManageHook
+positionStoreManageHook = ask >>= liftX . positionStoreInit >> idHook
+
+positionStoreInit :: Window -> X ()
+positionStoreInit w = withDisplay $ \d -> do
+        wa <- io $ getWindowAttributes d w
+        ws <- gets windowset
+        arbitraryOffsetX <- randomIntOffset
+        arbitraryOffsetY <- randomIntOffset
+        if (wa_x wa == 0) && (wa_y wa == 0)
+            then do
+                let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws
+                modifyPosStore (\ps -> posStoreInsert ps w
+                                        (Rectangle (srX + fi arbitraryOffsetX)
+                                                   (srY + fi arbitraryOffsetY)
+                                                    (fi $ wa_width wa)
+                                                    (fi $ wa_height wa)) sr )
+            else do
+                sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
+                let sr = screenRect . W.screenDetail $ sc
+                modifyPosStore (\ps -> posStoreInsert ps w
+                                        (Rectangle (fi $ wa_x wa) (fi $ wa_y wa)
+                                            (fi $ wa_width wa) (fi $ wa_height wa)) sr )
+    where
+        fi :: (Integral a, Num b) => a -> b
+        fi = fromIntegral
+        randomIntOffset :: X (Int)
+        randomIntOffset = io $ randomRIO (42, 242)
+
+positionStoreEventHook :: Event -> X All
+positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
+    when (et == destroyNotify) $ do
+        modifyPosStore (\ps -> posStoreRemove ps w)
+    return (All True)
+positionStoreEventHook _ = return (All True)
diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs
index 56b6425..b1fc083 100644
--- a/XMonad/Layout/BorderResize.hs
+++ b/XMonad/Layout/BorderResize.hs
@@ -12,8 +12,10 @@
 -- This layout modifier will allow to resize windows by dragging their
 -- borders with the mouse. However, it only works in layouts or modified
 -- layouts that react to the 'SetGeometry' message.
--- "XMonad.Layout.WindowArranger" can be used to create such a setup.
--- BorderResize is probably most useful in floating layouts.
+-- "XMonad.Layout.WindowArranger" can be used to create such a setup,
+-- but it is probably must useful in a floating layout such as
+-- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested.
+-- See the documentation of PositionStoreFloat for a typical usage example.
 --
 -----------------------------------------------------------------------------
 
diff --git a/XMonad/Layout/PositionStoreFloat.hs b/XMonad/Layout/PositionStoreFloat.hs
new file mode 100644
index 0000000..4797932
--- /dev/null
+++ b/XMonad/Layout/PositionStoreFloat.hs
@@ -0,0 +1,92 @@
+{-# 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
+    ) 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 -> []
diff --git a/XMonad/Util/PositionStore.hs b/XMonad/Util/PositionStore.hs
index 3aef67c..4844039 100644
--- a/XMonad/Util/PositionStore.hs
+++ b/XMonad/Util/PositionStore.hs
@@ -11,6 +11,7 @@
 -- Portability :  not portable
 --
 -- A utility module to store information about position and size of a window.
+-- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.
 --
 -----------------------------------------------------------------------------
 
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 94674cc..a607387 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -125,6 +125,7 @@ library
                         XMonad.Hooks.ManageDocks
                         XMonad.Hooks.ManageHelpers
                         XMonad.Hooks.Place
+                        XMonad.Hooks.PositionStoreHooks
                         XMonad.Hooks.RestoreMinimized
                         XMonad.Hooks.Script
                         XMonad.Hooks.ServerMode
@@ -179,6 +180,7 @@ library
                         XMonad.Layout.NoFrillsDecoration
                         XMonad.Layout.OneBig
                         XMonad.Layout.PerWorkspace
+                        XMonad.Layout.PositionStoreFloat
                         XMonad.Layout.Reflect
                         XMonad.Layout.ResizableTile
                         XMonad.Layout.ResizeScreen