From 2c4d858189f16201cea7fa11bbb0a523995e97c3 Mon Sep 17 00:00:00 2001
From: Jan Vornberger <jan.vornberger@informatik.uni-oldenburg.de>
Date: Wed, 30 Sep 2009 14:33:41 +0200
Subject: In a multi-head setup, move windows with a non-zero position upon
 creation to the right workspace.

Ignore-this: 4efdb9d64f33d70c48fb3797b635513e
Useful in a dual-head setup: Looks at the requested geometry of
new windows and moves them to the workspace of the non-focused
screen if necessary.

darcs-hash:20090930123341-594c5-efd2b02acd2310e0ab55c4fee482fc88cf0c79df.gz
---
 XMonad/Hooks/WorkspaceByPos.hs | 65 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 XMonad/Hooks/WorkspaceByPos.hs

(limited to 'XMonad/Hooks')

diff --git a/XMonad/Hooks/WorkspaceByPos.hs b/XMonad/Hooks/WorkspaceByPos.hs
new file mode 100644
index 0000000..779c948
--- /dev/null
+++ b/XMonad/Hooks/WorkspaceByPos.hs
@@ -0,0 +1,65 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.WorkspaceByPos
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Useful in a dual-head setup: Looks at the requested geometry of
+-- new windows and moves them to the workspace of the non-focused
+-- screen if necessary.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.WorkspaceByPos (
+    -- * Usage
+    -- $usage
+    workspaceByPos
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Data.Maybe
+import Control.Applicative((<$>))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.WorkspaceByPos
+-- >
+-- > myManageHook = workspaceByPos <+> manageHook defaultConfig
+-- >
+-- > main = xmonad defaultConfig { manageHook = myManageHook }
+
+workspaceByPos :: ManageHook
+workspaceByPos = ask >>= \w -> do
+                    b <- liftX $ needsMoving w
+                    case b of
+                        Nothing       -> idHook
+                        Just wkspc    -> doShift wkspc
+
+needsMoving :: Window -> X (Maybe WorkspaceId)
+needsMoving w = withDisplay $ \d -> do
+                    -- only relocate windows with non-zero position
+                    wa <- io $ getWindowAttributes d w
+                    if ((wa_x wa) == 0) && ((wa_y wa) == 0)
+                        then return Nothing
+                        else do
+                            ws <- gets windowset
+                            sc <- fromMaybe (W.current ws)
+                                    <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
+                            maybeWkspc <- screenWorkspace (W.screen sc)
+                            case maybeWkspc of
+                                Nothing -> return Nothing
+                                Just wkspc -> do
+                                    let currentWksp = W.currentTag ws
+                                    if currentWksp == wkspc
+                                        then return Nothing
+                                        else return (Just wkspc)
+
+fi ::  (Integral a, Num b) => a -> b
+fi = fromIntegral
-- 
cgit v1.2.3