mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
bd5b969d9b
All hints are applied in one single commit, as a commit per hint would result in 80+ separate commits—tihs is really just too much noise. Related: https://github.com/xmonad/xmonad-contrib/issues/537
50 lines
2.0 KiB
Haskell
50 lines
2.0 KiB
Haskell
{-# 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 (..),
|
|
DraggingVisualizer,
|
|
) where
|
|
|
|
import XMonad
|
|
import XMonad.Layout.LayoutModifier
|
|
|
|
newtype 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
|