Decoration that allows to switch the position of windows by dragging them onto each other.

Ignore-this: 38aff0f3beb1a1eb304219c4f3e85593

darcs-hash:20091129003431-594c5-3d57fe54414de7e9cfd10192cc18aa561e2b77f2.gz

2 files changed, 153 insertions, 0 deletions

diff --git a/XMonad/Layout/DraggingVisualizer.hs b/XMonad/Layout/DraggingVisualizer.hs
new file mode 100644
index 0000000..157fef1
--- /dev/null
+++ b/XMonad/Layout/DraggingVisualizer.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DraggingVisualizer
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A helper module to visualize the process of dragging a window by
+-- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration"
+-- for a module that makes use of this.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DraggingVisualizer
+    ( draggingVisualizer,
+      DraggingVisualizerMsg (..)
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+
+data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )
+draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window
+draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing
+
+data DraggingVisualizerMsg = DraggingWindow Window Rectangle
+                                | DraggingStopped
+                                deriving ( Typeable, Eq )
+instance Message DraggingVisualizerMsg
+
+instance LayoutModifier DraggingVisualizer Window where
+    modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"
+    pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =
+            if draggedWin `elem` (map fst wrs)
+                then (dragged : rest, Nothing)
+                else (wrs, Just $ DraggingVisualizer Nothing)
+        where
+            rest = filter (\(w, _) -> w /= draggedWin) wrs
+    pureModifier _ _ _ wrs = (wrs, Nothing)
+
+    pureMess (DraggingVisualizer _) m = case fromMessage m of
+        Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)
+        Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing
+        _ -> Nothing
diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs
new file mode 100644
index 0000000..e38abd4
--- /dev/null
+++ b/XMonad/Layout/WindowSwitcherDecoration.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.WindowSwitcherDecoration
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A decoration that allows to switch the position of windows by dragging
+-- them onto each other.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.WindowSwitcherDecoration
+    ( -- * Usage:
+      -- $usage
+      windowSwitcherDecoration,
+      windowSwitcherDecorationWithButtons
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.DecorationAddons
+import XMonad.Layout.DraggingVisualizer
+import qualified XMonad.StackSet as S
+import Control.Monad
+import Foreign.C.Types(CInt)
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.WindowSwitcherDecoration
+-- > import XMonad.Layout.DraggingVisualizer
+--
+-- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to
+-- your layout:
+--
+-- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+-- There is also a version of the decoration that contains buttons like
+-- "XMonad.Layout.ButtonDecoration". To use that version, you will need to
+-- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@
+-- in the following way:
+--
+-- > import XMonad.Layout.DecorationAddons
+-- >
+-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+
+windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme
+           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
+windowSwitcherDecoration s c = decoration s c $ WSD False
+
+windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme
+           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
+windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True
+
+data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read)
+
+instance Eq a => DecorationStyle WindowSwitcherDecoration a where
+    describeDeco _ = "WindowSwitcherDeco"
+
+    decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons
+                                                                    then titleBarButtonHandler mainw dFL dFR
+                                                                    else return False
+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y
+    decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw
+                                                          hasCrossed <- handleScreenCrossing mainw decoWin
+                                                          unless hasCrossed $ do sendMessage $ DraggingStopped
+                                                                                 performWindowSwitching mainw
+
+handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
+handleTiledDraggingInProgress ex ey (mainw, r) x y = do
+    let rect = Rectangle (x - (fi ex - rect_x r))
+                         (y - (fi ey - rect_y r))
+                         (rect_width  r)
+                         (rect_height r)
+    sendMessage $ DraggingWindow mainw rect
+
+performWindowSwitching :: Window -> X ()
+performWindowSwitching win =
+    withDisplay $ \d -> do
+       root <- asks theRoot
+       (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root
+       ws <- gets windowset
+       let allWindows = S.index ws
+       -- do a little double check to be sure
+       if (win `elem` allWindows) && (selWin `elem` allWindows)
+            then do
+                let allWindowsSwitched = map (switchEntries win selWin) allWindows
+                let (ls, t:rs) = break (win ==) allWindowsSwitched
+                let newStack = S.Stack t (reverse ls) rs
+                windows $ S.modify' $ \_ -> newStack
+            else return ()
+    where
+        switchEntries a b x
+            | x == a    = b
+            | x == b    = a
+            | otherwise = x