diff options
Diffstat (limited to '')
-rw-r--r-- | XMonad/Layout/DraggingVisualizer.hs | 48 |
1 files changed, 48 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 |