aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Rahm/Desktop/Keys.hs57
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs22
-rw-r--r--src/Rahm/Desktop/Layout/Flip.hs4
-rw-r--r--src/Rahm/Desktop/StackSet.hs98
4 files changed, 111 insertions, 70 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 4bb87d6..29e0ef7 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -161,6 +161,7 @@ import XMonad.Layout.Spacing
SpacingModifier (..),
)
import XMonad.Util.Run (safeSpawn)
+import XMonad.Util.WindowProperties
import Prelude hiding ((!!))
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -1025,6 +1026,50 @@ mouseMap = runButtons $ do
noMod $
doc "Start moving the window under the cursor" mouseMoveWindow
+ bind button14 $
+ noMod $
+ doc "Start moving the mouse under the cursor, but tile when completed." $
+ noWindow $ do
+ click
+ mwindow <- withWindowSet (return . W.getFocusedWindow)
+ forM_ mwindow $ \window -> do
+ mouseMoveWindow window
+ X.modify $ \case
+ st@(XState {dragging = Just (fn, cleanup)}) ->
+ st
+ { dragging =
+ Just
+ ( fn,
+ do
+ cleanup
+ (dpy, root) <- asks $ (,) <$> display <*> theRoot
+ aw <- withWindowSet (return . W.allVisibleWindows)
+ let fi :: (Integral a, Integral b) => a -> b
+ fi = fromIntegral
+ (_, _, _, fi -> cx, fi -> cy, _, _, _) <- io $ queryPointer dpy root
+ match <-
+ filterM
+ ( \win -> do
+ (_, fi -> x, fi -> y, fi -> w, fi -> h, _, _) <- io $ X.getGeometry dpy win
+ return
+ ( cx > x
+ && cx < x + fi w
+ && cy > y
+ && cy < y + h
+ && win /= window
+ )
+ )
+ aw
+ logs Debug "Sink by %d %s" window (show match)
+ windows $
+ W.focusWindow window
+ . case match of
+ (w' : _) -> W.sinkBy window w'
+ _ -> W.sink window
+ )
+ }
+ s -> s
+
bind button2 $
noMod $
doc "Sink the window under the cursor into the tiling" $
@@ -1323,9 +1368,17 @@ dragWindow = do
$ 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
- 0 ->
+ _ | w' == 0 || isDock ->
runMaybeT_ $ do
(W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen nx ny
lift $ do
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 7a59cbd..6c46361 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -88,21 +88,6 @@ import Rahm.Desktop.Marking
windowLocation,
)
import qualified Rahm.Desktop.StackSet as W
- ( RationalRect (RationalRect),
- Screen (workspace),
- StackSet (current, floating),
- Workspace (stack, tag),
- allWindows,
- findWindow,
- float,
- focusWindow,
- getLocationWorkspace,
- greedyView,
- integrate',
- screens,
- shiftWin,
- sink,
- )
import Rahm.Desktop.Submap (mapNextStringWithKeysym)
import Rahm.Desktop.Workspaces
( accompaningWorkspace,
@@ -568,10 +553,7 @@ readNextLocationSet =
(_, _, "'") -> (: []) <$> MaybeT (fromX lastLocation)
-- All visible windows.
(_, _, "*") -> mt $ do
- wins <-
- withWindowSet $
- return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens
-
+ wins <- withWindowSet $ return . W.allVisibleWindows
catMaybes <$> mapM (runMaybeT . windowLocation) wins
-- The last referenced windows.
@@ -591,7 +573,7 @@ readNextLocationSet =
-- Windows in a workspace
(_, _, s)
| s == "\t" || s == "@" || s == "\n" ->
- (mt . windowsInWorkspace) =<< readNextWorkspaceName
+ (mt . windowsInWorkspace) =<< readNextWorkspaceName
-- The first window in the next window set.
(_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet)
-- The windows except the first in a window set.
diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs
index b3162c9..1863a28 100644
--- a/src/Rahm/Desktop/Layout/Flip.hs
+++ b/src/Rahm/Desktop/Layout/Flip.hs
@@ -43,11 +43,11 @@ data DoFlip where
-- DoFlip is a monoid.
instance Semigroup DoFlip where
- (<>) = mappend
+ (DoFlip a) <> (DoFlip b) = DoFlip (a . b)
instance Monoid DoFlip where
mempty = DoFlip id
- mappend (DoFlip a) (DoFlip b) = DoFlip (a . b)
+ mappend = (<>)
-- Makes a layout Flippable.
flippable :: l a -> ModifiedLayout Flip l a
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 9b027d6..36d41a4 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -1,5 +1,6 @@
module Rahm.Desktop.StackSet
( masterWindow,
+ allVisibleWindows,
windowsOnWorkspace,
findWorkspace,
dbgStackSet,
@@ -16,6 +17,9 @@ module Rahm.Desktop.StackSet
WindowLocation (..),
windowMemberOfWorkspace,
findWindow,
+ sinkBy,
+ modifyWorkspace,
+ getFocusedWindow,
module W,
)
where
@@ -32,52 +36,7 @@ import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Text.Printf (printf)
import XMonad (Rectangle (..), ScreenDetail (..), WindowSet)
-import XMonad.StackSet as W
- ( RationalRect (..),
- Screen (..),
- Stack (..),
- StackSet (..),
- Workspace (..),
- abort,
- allWindows,
- currentTag,
- delete,
- delete',
- differentiate,
- ensureTags,
- filter,
- findTag,
- float,
- focusDown,
- focusDown',
- focusMaster,
- focusUp,
- focusUp',
- focusWindow,
- index,
- insertUp,
- integrate,
- integrate',
- lookupWorkspace,
- mapLayout,
- mapWorkspace,
- member,
- modify,
- modify',
- new,
- peek,
- renameTag,
- screens,
- shift,
- shiftMaster,
- sink,
- swapDown,
- swapMaster,
- swapUp,
- tagMember,
- view,
- workspaces,
- )
+import XMonad.StackSet as W hiding (greedyView, shiftWin)
import qualified XMonad.StackSet (shiftWin)
import Prelude hiding (head)
@@ -91,6 +50,10 @@ getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
getLocationWorkspace (OnHiddenWorkspace w) = Just w
getLocationWorkspace _ = Nothing
+allVisibleWindows :: StackSet i l a s sd -> [a]
+allVisibleWindows =
+ concatMap (W.integrate' . W.stack . W.workspace) <$> W.screens
+
mapWindows :: (Ord a, Ord b) => (a -> b) -> StackSet i l a s sd -> StackSet i l b s sd
mapWindows fn (StackSet cur vis hid float) =
StackSet
@@ -251,3 +214,46 @@ findWindow (StackSet cur vis hid float) win =
windowMemberOfWorkspace :: (Eq a) => Workspace i l a -> a -> Bool
windowMemberOfWorkspace (Workspace _ _ s) w = w `elem` integrate' s
+
+modifyWorkspace :: (Eq i) => i -> (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
+modifyWorkspace tag fn =
+ mapWorkspace
+ ( \ws ->
+ if W.tag ws == tag
+ then fn ws
+ else ws
+ )
+
+getFocusedWindow :: StackSet i l a s sd -> Maybe a
+getFocusedWindow (StackSet cur _ _ _) = W.focus <$> (W.stack . W.workspace) cur
+
+sinkBy :: (Eq a, Eq i, Ord a) => a -> a -> StackSet i l a s sd -> StackSet i l a s sd
+sinkBy win toSinkBy ss =
+ case (findTag win ss, findTag toSinkBy ss) of
+ (Nothing, _) -> ss
+ (Just w1, Just w2)
+ | w1 == w2 ->
+ modifyWorkspace
+ w1
+ ( \(W.Workspace t l s) ->
+ W.Workspace t l (Just $ insertBy win toSinkBy s)
+ )
+ $ W.delete win ss
+ _ -> W.sink win ss
+ where
+ insertBy win to Nothing = W.Stack win [] []
+ insertBy win to (Just (W.Stack foc down up)) =
+ case () of
+ ()
+ | to `elem` down ->
+ W.Stack
+ foc
+ (concatMap (\e -> if e == to then [e, win] else [e]) down)
+ up
+ ()
+ | to `elem` up ->
+ W.Stack
+ foc
+ down
+ (concatMap (\e -> if e == to then [win, e] else [e]) up)
+ () -> W.Stack win (foc : down) up
generated by cgit (git 2.34.1) at 2026-02-22 15:44:12 +0000