mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-02 21:21:51 -07:00
.github
XMonad
Actions
Config
Doc
Hooks
Layout
Groups
MultiToggle
Accordion.hs
AutoMaster.hs
AvoidFloats.hs
BinaryColumn.hs
BinarySpacePartition.hs
BorderResize.hs
BoringWindows.hs
ButtonDecoration.hs
CenterMainFluid.hs
CenteredIfSingle.hs
CenteredMaster.hs
Circle.hs
Column.hs
Combo.hs
ComboP.hs
Cross.hs
Decoration.hs
DecorationAddons.hs
DecorationMadness.hs
Dishes.hs
DragPane.hs
DraggingVisualizer.hs
Drawer.hs
Dwindle.hs
DwmStyle.hs
FixedAspectRatio.hs
FixedColumn.hs
FocusTracking.hs
Fullscreen.hs
Gaps.hs
Grid.hs
GridVariants.hs
Groups.hs
Hidden.hs
HintedGrid.hs
HintedTile.hs
IM.hs
IfMax.hs
ImageButtonDecoration.hs
IndependentScreens.hs
LayoutBuilder.hs
LayoutCombinators.hs
LayoutHints.hs
LayoutModifier.hs
LayoutScreens.hs
LimitWindows.hs
MagicFocus.hs
Magnifier.hs
Master.hs
Maximize.hs
MessageControl.hs
Minimize.hs
Monitor.hs
Mosaic.hs
MosaicAlt.hs
MouseResizableTile.hs
MultiColumns.hs
MultiDishes.hs
MultiToggle.hs
Named.hs
NoBorders.hs
NoFrillsDecoration.hs
OnHost.hs
OneBig.hs
PerScreen.hs
PerWorkspace.hs
PositionStoreFloat.hs
Reflect.hs
Renamed.hs
ResizableThreeColumns.hs
ResizableTile.hs
ResizeScreen.hs
Roledex.hs
ShowWName.hs
SideBorderDecoration.hs
SimpleDecoration.hs
SimpleFloat.hs
Simplest.hs
SimplestFloat.hs
SortedLayout.hs
Spacing.hs
Spiral.hs
Square.hs
StackTile.hs
StateFull.hs
Stoppable.hs
SubLayouts.hs
TabBarDecoration.hs
Tabbed.hs
TallMastersCombo.hs
ThreeColumns.hs
ToggleLayouts.hs
TrackFloating.hs
TwoPane.hs
TwoPanePersistent.hs
VoidBorders.hs
WindowArranger.hs
WindowNavigation.hs
WindowSwitcherDecoration.hs
WorkspaceDir.hs
ZoomRow.hs
Prompt
Util
Doc.hs
Prelude.hs
Prompt.hs
scripts
tests
.gitignore
.hlint.yaml
.mailmap
CHANGES.md
CONTRIBUTING.md
LICENSE
NIX.md
README.md
Setup.lhs
cabal.haskell-ci
cabal.project
flake.nix
stack-master.yaml
stack.yaml
xmonad-contrib.cabal
51 lines
2.1 KiB
Haskell
51 lines
2.1 KiB
Haskell
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
|
|
----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.DraggingVisualizer
|
|
-- Description : Visualize the process of dragging a window.
|
|
-- 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 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
|