mirror of
https://github.com/elkowar/dots-of-war.git
synced 2024-12-24 13:22:23 +00:00
Add alt dragging
This commit is contained in:
parent
d2e71df8db
commit
3c68399280
2 changed files with 83 additions and 6 deletions
Binary file not shown.
|
@ -3,10 +3,10 @@
|
||||||
-- Imports -------------------------------------------------------- {{{
|
-- Imports -------------------------------------------------------- {{{
|
||||||
|
|
||||||
module Config (main) where
|
module Config (main) where
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception ( catch , SomeException)
|
import Control.Exception ( catch , SomeException)
|
||||||
import Control.Monad ( filterM )
|
import Control.Monad ( filterM, when )
|
||||||
import Control.Arrow ( (>>>) )
|
import Control.Arrow ( (>>>) )
|
||||||
import Data.List ( isPrefixOf , isSuffixOf)
|
import Data.List ( isPrefixOf , isSuffixOf)
|
||||||
import System.Exit (exitSuccess)
|
import System.Exit (exitSuccess)
|
||||||
|
@ -52,6 +52,7 @@ import XMonad.Layout.DecorationAddons
|
||||||
import XMonad.Util.EZConfig ( additionalKeysP
|
import XMonad.Util.EZConfig ( additionalKeysP
|
||||||
, removeKeysP
|
, removeKeysP
|
||||||
, checkKeymap
|
, checkKeymap
|
||||||
|
, additionalMouseBindings
|
||||||
)
|
)
|
||||||
import XMonad.Util.NamedScratchpad
|
import XMonad.Util.NamedScratchpad
|
||||||
import XMonad.Util.Run
|
import XMonad.Util.Run
|
||||||
|
@ -59,6 +60,10 @@ import XMonad.Util.SpawnOnce (spawnOnce)
|
||||||
import XMonad.Util.WorkspaceCompare ( getSortByXineramaPhysicalRule , getSortByIndex)
|
import XMonad.Util.WorkspaceCompare ( getSortByXineramaPhysicalRule , getSortByIndex)
|
||||||
|
|
||||||
import qualified Data.Monoid
|
import qualified Data.Monoid
|
||||||
|
import Data.Monoid ( All
|
||||||
|
, All(..)
|
||||||
|
)
|
||||||
|
import Data.Int ( Int32 )
|
||||||
import qualified System.IO as SysIO
|
import qualified System.IO as SysIO
|
||||||
import qualified XMonad.Actions.Navigation2D as Nav2d
|
import qualified XMonad.Actions.Navigation2D as Nav2d
|
||||||
import qualified XMonad.Config.Desktop as Desktop
|
import qualified XMonad.Config.Desktop as Desktop
|
||||||
|
@ -70,7 +75,9 @@ import qualified XMonad.Layout.MultiToggle.Instances as MTog
|
||||||
import qualified XMonad.Layout.ToggleLayouts as ToggleLayouts
|
import qualified XMonad.Layout.ToggleLayouts as ToggleLayouts
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified XMonad.Util.XSelection as XSel
|
import qualified XMonad.Util.XSelection as XSel
|
||||||
|
import XMonad.Util.XUtils ( fi )
|
||||||
import qualified XMonad.Layout.PerScreen as PerScreen
|
import qualified XMonad.Layout.PerScreen as PerScreen
|
||||||
|
import Foreign.C.Types ( CInt )
|
||||||
{-# ANN module "HLint: ignore Redundant $" #-}
|
{-# ANN module "HLint: ignore Redundant $" #-}
|
||||||
{-# ANN module "HLint: ignore Redundant bracket" #-}
|
{-# ANN module "HLint: ignore Redundant bracket" #-}
|
||||||
{-# ANN module "HLint: ignore Move brackets to avoid $" #-}
|
{-# ANN module "HLint: ignore Move brackets to avoid $" #-}
|
||||||
|
@ -143,7 +150,7 @@ myTabTheme = def -- defaultThemeWithButtons
|
||||||
}
|
}
|
||||||
|
|
||||||
data EmptyShrinker = EmptyShrinker deriving (Show, Read)
|
data EmptyShrinker = EmptyShrinker deriving (Show, Read)
|
||||||
instance Shrinker EmptyShrinker where
|
instance Shrinker EmptyShrinker where
|
||||||
shrinkIt _ _ = [] :: [String]
|
shrinkIt _ _ = [] :: [String]
|
||||||
|
|
||||||
myLayout = avoidStruts
|
myLayout = avoidStruts
|
||||||
|
@ -151,6 +158,7 @@ myLayout = avoidStruts
|
||||||
$ MTog.mkToggle1 MTog.FULL
|
$ MTog.mkToggle1 MTog.FULL
|
||||||
$ ToggleLayouts.toggleLayouts (rename "Tabbed" . makeTabbed . spacingAndGaps $ ResizableTall 1 (3/100) (1/2) [])
|
$ ToggleLayouts.toggleLayouts (rename "Tabbed" . makeTabbed . spacingAndGaps $ ResizableTall 1 (3/100) (1/2) [])
|
||||||
$ MTog.mkToggle1 WINDOWDECORATION
|
$ MTog.mkToggle1 WINDOWDECORATION
|
||||||
|
$ draggingVisualizer
|
||||||
$ layoutHintsToCenter
|
$ layoutHintsToCenter
|
||||||
$ layouts
|
$ layouts
|
||||||
where
|
where
|
||||||
|
@ -182,10 +190,11 @@ myLayout = avoidStruts
|
||||||
makeTabbed layout = BoringWindows.boringWindows . windowNavigation . addTabs shrinkText myTabTheme $ subLayout [] Simplest $ layout
|
makeTabbed layout = BoringWindows.boringWindows . windowNavigation . addTabs shrinkText myTabTheme $ subLayout [] Simplest $ layout
|
||||||
|
|
||||||
|
|
||||||
|
-- | window decoration layout modifier. this needs you to add `dragginVisualizer` yourself
|
||||||
data WINDOWDECORATION = WINDOWDECORATION deriving (Read, Show, Eq, Typeable)
|
data WINDOWDECORATION = WINDOWDECORATION deriving (Read, Show, Eq, Typeable)
|
||||||
instance MTog.Transformer WINDOWDECORATION Window where
|
instance MTog.Transformer WINDOWDECORATION Window where
|
||||||
transform WINDOWDECORATION x k = k
|
transform WINDOWDECORATION x k = k
|
||||||
(windowSwitcherDecoration shrinkText myTabTheme $ draggingVisualizer $ x)
|
(windowSwitcherDecoration shrinkText (myTabTheme { activeBorderColor = "#1d2021" }) $ x)
|
||||||
(const x)
|
(const x)
|
||||||
|
|
||||||
-- }}}
|
-- }}}
|
||||||
|
@ -429,10 +438,9 @@ main = do
|
||||||
, normalBorderColor = "#282828"
|
, normalBorderColor = "#282828"
|
||||||
, handleEventHook = handleEventHook Desktop.desktopConfig
|
, handleEventHook = handleEventHook Desktop.desktopConfig
|
||||||
--, handleEventHook = minimizeEventHook <+> handleEventHook def <+> hintsEventHook -- <+> Ewmh.fullscreenEventHook
|
--, handleEventHook = minimizeEventHook <+> handleEventHook def <+> hintsEventHook -- <+> Ewmh.fullscreenEventHook
|
||||||
|
, mouseBindings = myMouseBindings <+> mouseBindings def
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
xmonad
|
xmonad
|
||||||
$ Ewmh.ewmh
|
$ Ewmh.ewmh
|
||||||
$ Nav2d.withNavigation2DConfig def { Nav2d.defaultTiledNavigation = Nav2d.sideNavigation }
|
$ Nav2d.withNavigation2DConfig def { Nav2d.defaultTiledNavigation = Nav2d.sideNavigation }
|
||||||
|
@ -488,6 +496,75 @@ polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspace
|
||||||
|
|
||||||
-- }}}
|
-- }}}
|
||||||
|
|
||||||
|
|
||||||
|
-- Window dragging {{{
|
||||||
|
|
||||||
|
myMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
||||||
|
myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
|
||||||
|
[((modMask .|. shiftMask, button1), tiledDragging)]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
tiledDragging :: Window -> X ()
|
||||||
|
tiledDragging window = whenX (isClient window) $ withDisplay $ \disp -> do
|
||||||
|
focus window
|
||||||
|
windows $ W.sink window
|
||||||
|
(offsetX, offsetY) <- getPointerOffset window disp
|
||||||
|
(winX, winY, winWidth, winHeight) <- io $ getWindowPlacement disp window
|
||||||
|
|
||||||
|
mouseDrag
|
||||||
|
(\posX posY -> let rect = Rectangle (fromIntegral (fromIntegral winX + (posX - fromIntegral offsetX)))
|
||||||
|
(fromIntegral (fromIntegral winY + (posY - fromIntegral offsetY)))
|
||||||
|
(fromIntegral winWidth)
|
||||||
|
(fromIntegral winHeight)
|
||||||
|
in sendMessage $ DraggingWindow window rect)
|
||||||
|
(sendMessage DraggingStopped >> performWindowSwitching window)
|
||||||
|
|
||||||
|
|
||||||
|
-- | get the pointer offset relative to the given windows root coordinates
|
||||||
|
getPointerOffset :: Window -> Display -> X (Int, Int)
|
||||||
|
getPointerOffset win disp = do
|
||||||
|
(_, _, _, offsetX, offsetY, _, _, _) <- io $ queryPointer disp win
|
||||||
|
return (fromIntegral offsetX, fromIntegral offsetY)
|
||||||
|
|
||||||
|
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
|
||||||
|
getWindowPlacement :: Display -> Window -> IO (CInt, CInt, CInt, CInt)
|
||||||
|
getWindowPlacement disp window = do
|
||||||
|
windowAttributes <- getWindowAttributes disp window
|
||||||
|
return (wa_x windowAttributes, wa_y windowAttributes, wa_width windowAttributes, wa_height windowAttributes)
|
||||||
|
|
||||||
|
|
||||||
|
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 = W.index ws
|
||||||
|
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
|
||||||
|
let allWindowsSwitched = map (switchEntries win selWin) allWindows
|
||||||
|
let (ls, t:rs) = break (== win) allWindowsSwitched
|
||||||
|
let newStack = W.Stack t (reverse ls) rs
|
||||||
|
windows $ W.modify' $ const newStack
|
||||||
|
where
|
||||||
|
switchEntries a b x
|
||||||
|
| x == a = b
|
||||||
|
| x == b = a
|
||||||
|
| otherwise = x
|
||||||
|
|
||||||
|
|
||||||
|
--}}}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- Utilities --------------------------------------------------- {{{
|
-- Utilities --------------------------------------------------- {{{
|
||||||
|
|
||||||
(|>) :: a -> (a -> b) -> b
|
(|>) :: a -> (a -> b) -> b
|
||||||
|
|
Loading…
Reference in a new issue