aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Keys.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Keys.hs')
-rw-r--r--src/Rahm/Desktop/Keys.hs158
1 files changed, 56 insertions, 102 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index f84ccad..fe96338 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -276,6 +276,8 @@ mapWindows fn (W.StackSet cur vis hidden float) =
mapScreen fn (W.Screen ws s sd) = W.Screen (mapWorkspace fn ws) s sd
mapWorkspace fn (W.Workspace t l s) = W.Workspace t l (fmap (fmap fn) s)
+data ShiftType = JustShift | ShiftAndFollow | ShiftAndSwap
+
keymap :: XConfig l -> KeyBindings
keymap = runKeys $ do
config <- getConfig
@@ -608,21 +610,42 @@ keymap = runKeys $ do
sendMessage rotateLayout
bind xK_s $ do
- forM_ [(False, justMod), (True, shiftMod)] $ \(doView, f) ->
+ forM_ [(JustShift, justMod), (ShiftAndSwap, shiftMod), (ShiftAndFollow, controlMod)] $ \(shiftType, f) ->
f $
doc
- ( if doView
- then "Shift a windowset to a workspace and goto that workspace."
- else "Shift a windowset to a workspace"
+ ( case shiftType of
+ ShiftAndFollow ->
+ "Shift-and-follow: Like shift-and-swap with the implicit \
+ \third parameter being the current workspace (.)"
+ ShiftAndSwap ->
+ "Shift-and-swap: Shift a windowset to a workspace then swap \
+ \that workspace with another. Primary use case is to move a \
+ \that workspace to a different screen than the current screen. \
+ \Note that this command will only work with normal workspaces."
+ JustShift -> "Shift a windowset to a workspace"
)
- $ pushPendingBuffer (if doView then "S " else "s ") $
- runMaybeT_ $
+ $ pushPendingBuffer
+ ( case shiftType of
+ ShiftAndSwap -> "S "
+ JustShift -> "s "
+ ShiftAndFollow -> "^s "
+ )
+ $ runMaybeT_ $
do
stackset <- lift $ X.windowset <$> X.get
selection <- mapMaybe locationWindow <$> readNextLocationSet
withBorderColorM "#00ffff" selection $ do
+ lift $ addStringToPendingBuffer " "
ws <- readNextWorkspace
+ finalSwap <-
+ case shiftType of
+ ShiftAndSwap -> do
+ lift $ addStringToPendingBuffer " "
+ wsName <- MaybeT . return $ workspaceName ws
+ W.switchWorkspaces wsName <$> readNextWorkspaceName
+ _ -> return id
+
lift $ do
(Endo allMovements) <-
mconcat
@@ -639,15 +662,15 @@ keymap = runKeys $ do
(W.findTag win stackset)
windows $
- ( \ss ->
- case () of
- ()
- | doView,
- (w : _) <- selection,
- Just ws <- W.findTag w ss ->
- W.greedyView ws ss
- _ -> ss
- )
+ finalSwap
+ . ( \ss ->
+ case shiftType of
+ ShiftAndFollow
+ | (w : _) <- selection,
+ Just ws <- W.findTag w ss ->
+ W.greedyView ws ss
+ _ -> ss
+ )
. allMovements
altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
@@ -714,7 +737,7 @@ keymap = runKeys $ do
\have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
\the window is placed in the hidden workspace (which is '*')\n"
$ do
- addStringToPendingBuffer "g "
+ addStringToPendingBuffer " g "
runMaybeT_ $
do
mapNextString $ \_ str -> lift $
@@ -923,6 +946,13 @@ buttonBindingsToButtonMap bindings config = Map.mapWithKey bindingToX (bindings
)
window
+myMouseMoveWindow =
+ D.mouseMoveWindowAndThen X.focus $
+ mconcat
+ [ D.ifReleased button3 D.sinkOnRelease,
+ D.ifReleased' button13 $ \w _ -> X.killWindow w
+ ]
+
mouseMap :: forall l. XConfig l -> ButtonBindings
mouseMap = runButtons $ do
config <- getConfig
@@ -988,7 +1018,7 @@ mouseMap = runButtons $ do
bind button1 $
noMod $
doc "Swap a window with another window by dragging." $
- noWindow dragWindow
+ noWindow D.dragWindow
bind button13 $ do
noMod $
@@ -1028,17 +1058,8 @@ mouseMap = runButtons $ do
subMouse $ do
bind button1 $
noMod $
- doc "Start moving the window under the cursor" $
- noWindow $
- D.mouseMoveWindow $ \win button ->
- if (button == button3)
- then D.thenSink win button
- else refresh
-
- bind button14 $
- noMod $
- doc "Start moving the mouse under the cursor, but tile when completed." $
- noWindow D.mouseMoveWindowAndSink
+ doc "Move the mouse under the cursor (like how Mod+leftMouse works)" $
+ myMouseMoveWindow
bind button2 $
noMod $
@@ -1049,19 +1070,19 @@ mouseMap = runButtons $ do
noMod $
doc "Resize the window under the cursor" mouseResizeWindow
- let swapButtons =
+ let resizeButtons =
[ ( button4,
- "Swap the current window with the next one in the stack",
- noWindow $ windows W.swapDown
+ "Increase the size of the master region",
+ noWindow $ sendMessage Expand
),
( button5,
- "Swap the current window with the last one in the stack",
- noWindow $ windows W.swapUp
+ "Shrink the size of the master region",
+ noWindow $ sendMessage Shrink
)
]
continuous $
- forM_ swapButtons $ \(b, d, a) ->
+ forM_ resizeButtons $ \(b, d, a) ->
bind b $ noMod $ doc d a
bind button13 $
@@ -1099,7 +1120,7 @@ mouseMap = runButtons $ do
bind button1 $
noMod $
doc "'drag' a workspace to another screen" $
- noWindow dragWorkspace
+ noWindow D.dragWorkspace
let workspaceButtons =
[ ( button2,
@@ -1287,70 +1308,3 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
where
clip i | i < 0 = 0
clip i = i
-
-dragWorkspace :: X ()
-dragWorkspace = do
- (dpy, root) <- asks $ (,) <$> display <*> theRoot
- (_, _, _, fromIntegral -> ox, fromIntegral -> oy, _, _, _) <- io $ queryPointer dpy root
- mouseDrag (\_ _ -> return ()) $ do
- (_, _, _, fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
- runMaybeT_ $ do
- (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen ox oy
- (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ pointScreen nx ny
-
- lift $ windows $ W.switchWorkspaces ws1 ws2
-
-dragWindow :: X ()
-dragWindow = do
- (dpy, root) <- asks $ (,) <$> display <*> theRoot
- (_, _, w, _, _, _, _, _) <- io $ queryPointer dpy root
- if w == 0
- then dragWorkspace
- else do
- cleanup <- setBorderColor "#00ffff" [w]
-
- ref <- io $ newIORef (w, return ())
-
- mouseDrag
- ( \_ _ -> do
- (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
- (ow, ocleanup) <- io $ readIORef ref
- logs Debug "%s, %s, %s\n" (show w) (show w') (show ow)
- case () of
- () | ow /= w' -> do
- ocleanup
- cleanup' <-
- if w' == 0 || w' == w
- then return (return ())
- else setBorderColor "#80a0a0" [w']
- io $ writeIORef ref (w', cleanup')
- () -> return ()
-
- return ()
- )
- $ do
- (_, _, w', fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
- (_, iocleanup) <- io $ readIORef ref
- dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
- desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
- mbr <-
- if w' == 0
- then return Nothing
- else getProp32s "_NET_WM_WINDOW_TYPE" w'
-
- let isDock =
- maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr
- case w' of
- _ | w' == 0 || isDock ->
- runMaybeT_ $ do
- (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen nx ny
- lift $ do
- setAlternateWindows [w]
- windows $ W.sink w . W.shiftWin ws1 w
- _ -> do
- windows $ W.focusWindow w . W.swapWindows [(w, w')]
-
- setAlternateWindows [w, w']
-
- iocleanup
- cleanup
generated by cgit (git 2.34.1) at 2026-02-22 13:40:14 +0000