aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm')
-rw-r--r--src/Rahm/Desktop/Common.hs42
-rw-r--r--src/Rahm/Desktop/Dragging.hs101
-rw-r--r--src/Rahm/Desktop/Keys.hs47
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs6
-rw-r--r--src/Rahm/Desktop/Layout/Hole.hs49
-rw-r--r--src/Rahm/Desktop/Layout/PinWindow.hs1
-rw-r--r--src/Rahm/Desktop/Workspaces.hs7
7 files changed, 167 insertions, 86 deletions
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index ae4f531..6fe9364 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -19,14 +19,15 @@ module Rahm.Desktop.Common
pointerLocation,
pointerWindow,
getDisplayAndRoot,
+ floatAll,
Location (..),
- Xish(..),
+ Xish (..),
)
where
import Control.Applicative ((<*))
import Control.Exception (SomeException (SomeException), catch)
-import Control.Monad (forM_, void, when)
+import Control.Monad (forM_, guard, void, when)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (ExceptT (..), catchE, runExceptT, throwE)
import Control.Monad.Trans.Identity (IdentityT (..))
@@ -37,23 +38,13 @@ import Data.List (concatMap, isInfixOf, map, (++))
import Data.List.Safe (head, tail)
import Data.List.Split (splitOn)
import qualified Data.Map as Map (fromListWith)
-import Data.Maybe (Maybe (..), maybe)
+import Data.Maybe (Maybe (..), fromMaybe, maybe)
+import Data.Monoid (Endo (..))
import Data.Void (Void (..), absurd)
import Data.Word (Word32)
import Rahm.Desktop.DMenu (runDMenuPromptWithMap, runDMenuPromptWithMapMulti)
import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as S
- ( Screen (Screen, workspace),
- StackSet (StackSet, current),
- Workspace (Workspace, stack, tag),
- allWindows,
- focusWindow,
- greedyView,
- integrate',
- peek,
- shiftWin,
- workspaces,
- )
import Text.Printf (printf)
import XMonad
( ScreenId,
@@ -248,6 +239,29 @@ duplWindow = runQuery $ do
_ -> return ()
Left err -> logs Info "%s" (err :: String)
+floatAll :: [Window] -> X ()
+floatAll ws = do
+ -- (sc, rr) <- X.floatLocation w
+ locs <- mapM (\w -> (w,) <$> X.floatLocation w) ws
+
+ let (Endo endo) =
+ mconcat $
+ map
+ ( \(w, (sc, rr)) ->
+ Endo
+ ( \ws ->
+ S.float w rr . fromMaybe ws $ do
+ i <- S.findTag w ws
+ guard $ i `elem` map (S.tag . S.workspace) (S.screens ws)
+ f <- S.peek ws
+ sw <- S.lookupWorkspace sc ws
+ return (S.focusWindow f . S.shiftWin sw w $ ws)
+ )
+ )
+ locs
+
+ windows endo
+
class (Monad m) => Xish m where
liftFromX :: X a -> m a
diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs
index f07ea87..c95deff 100644
--- a/src/Rahm/Desktop/Dragging.hs
+++ b/src/Rahm/Desktop/Dragging.hs
@@ -1,12 +1,17 @@
module Rahm.Desktop.Dragging where
-import Control.Monad (filterM, when)
+import Control.Arrow ((&&&))
+import qualified Control.Exception as C
+import Control.Monad (filterM, forM_, when)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Data.Foldable as Foldable
import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.Maybe (fromMaybe, isJust)
-import Rahm.Desktop.BorderColors (setBorderColor, BorderColor (BorderColor))
-import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import qualified Data.Set as Set
+import Graphics.X11.Xlib.Extras
+import Rahm.Desktop.BorderColors (BorderColor (BorderColor), setBorderColor)
+import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_, floatAll)
import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole)
import Rahm.Desktop.Layout.PinWindow (isWindowPinned, pinWindow, unpinWindow)
import Rahm.Desktop.Logger
@@ -129,35 +134,77 @@ mouseResizeWindowAndThen beforeAction (AfterDragAction releaseAction) window = d
)
X.refresh
-mouseMoveWindowAndThen ::
- (X.Window -> X ()) ->
+mouseMoveWindowsAndThen ::
+ (Foldable f) =>
+ (f X.Window -> X ()) ->
AfterDragAction ->
- X.Window ->
+ f X.Window ->
X ()
-mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do
- beforeAction window
- windowPinned <- isWindowPinned window
- unpinWindow window
- tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
- mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition
- X.mouseMoveWindow window
+mouseMoveWindowsAndThen beforeAction (AfterDragAction releaseAction) windowsF = do
+ let windows = Foldable.toList windowsF
+
+ beforeAction windowsF
+
+ pinnedWindows <- Set.fromList <$> filterM isWindowPinned windows
+ mapM_ unpinWindow windows
+
+ tilePositions <- X.withWindowSet $
+ \ws -> return $ mapMaybe (\win -> (win,) <$> W.windowTilePosition win ws) windows
+
+ mapM_
+ ( \(win, pos) ->
+ X.broadcastMessage $ addHoleForWindow pos win
+ )
+ tilePositions
+
+ case windows of
+ [win] -> X.mouseMoveWindow win
+ _ -> X.withDisplay $ \d -> do
+ floatAll windows
+ was <-
+ io $
+ mapM
+ ( \w -> C.handle (\(C.SomeException _) -> return Nothing) $ do
+ wa <- X.getWindowAttributes d w
+ (_, _, _, fi -> ox, fi -> oy, _, _, _) <- io $ X.queryPointer d w
+ return (Just (w, wa, ox, oy))
+ )
+ windows
+ X.mouseDrag
+ ( \ex ey -> do
+ forM_ was $ \case
+ Just (w, wa, ox, oy) -> do
+ io $
+ X.moveWindow
+ d
+ w
+ (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
+ (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
+ Nothing -> return ()
+ )
+ (floatAll windows)
afterDrag $ do
- X.broadcastMessage $ removeHoleForWindow window
+ mapM_ pinWindow pinnedWindows
curev <- X.asks X.currentEvent
- when windowPinned $
- pinWindow window
- releaseAction
- window
- ( maybe
- 0
- ( \case
- X.ButtonEvent {X.ev_button = b} -> b
- _ -> 0
- )
- curev
- )
+
+ forM_ windows $ \window -> do
+ X.broadcastMessage $ removeHoleForWindow window
+
+ releaseAction
+ window
+ ( maybe
+ 0
+ ( \case
+ X.ButtonEvent {X.ev_button = b} -> b
+ _ -> 0
+ )
+ curev
+ )
+
X.refresh
+ where
+ fi = fromIntegral
dragWorkspace :: X ()
dragWorkspace = do
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index b8647d6..61e483a 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -6,6 +6,7 @@ import Control.Monad
unless,
when,
)
+import Control.Monad.Identity (Identity (Identity, runIdentity))
import Control.Monad.Trans.Maybe
( MaybeT (..),
runMaybeT,
@@ -142,7 +143,7 @@ import XMonad.Layout.Spacing
( Border (..),
SpacingModifier (..),
)
-import XMonad.Util.Run (safeSpawn, hPutStrLn, spawnPipe)
+import XMonad.Util.Run (hPutStrLn, safeSpawn, spawnPipe)
import XMonad.Util.WindowProperties
import Prelude hiding ((!!))
@@ -1009,10 +1010,14 @@ bindings = do
-- This allows me to make some pretty complex and powerful mappings with just
-- the mouse by using button press sequences to mean different things.
bind button1 $ do
- justMod $
- doc
+ justMod
+ $ doc
"Float and move a window"
- myMouseMoveWindow
+ $ \win -> do
+ winSels <- getAndResetWindowSelection
+ if null winSels
+ then myMouseMoveWindow win
+ else myMouseMoveWindows winSels
shiftMod $
doc
@@ -1216,14 +1221,15 @@ bindings = do
doc "Move all the windows to the workspace the pointer is on" $
noWindow $ do
wins <- getAndResetWindowSelection
- runMaybeT_ $ do
- ws <- MaybeT pointerWorkspace
- lift $
- let f =
- appEndo
- ( mconcat (map (Endo . W.shiftWin ws) wins)
- )
- in windows f >> escape
+ D.mouseMoveWindowsAndThen
+ (mapM_ X.focus)
+ ( mconcat
+ [ D.ifReleased button1 D.sinkOnRelease,
+ D.ifReleased' button2 $ \w _ -> pinWindow w
+ ]
+ )
+ wins
+ escape
forM_ [(button7, ",.", "right"), (button6, ";.", "left")] $
\(b, mot, d) -> do
@@ -1282,12 +1288,17 @@ bindings = do
--
-- permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
-myMouseMoveWindow =
- D.mouseMoveWindowAndThen X.focus $
- mconcat
- [ D.ifReleased button3 D.sinkOnRelease,
- D.ifReleased' button2 $ \w _ -> X.killWindow w
- ]
+myMouseMoveWindow = myMouseMoveWindows . Identity
+
+myMouseMoveWindows :: (Foldable f) => f Window -> X ()
+myMouseMoveWindows =
+ D.mouseMoveWindowsAndThen
+ (mapM_ X.focus)
+ ( mconcat
+ [ D.ifReleased button3 D.sinkOnRelease,
+ D.ifReleased' button2 $ \w _ -> pinWindow w
+ ]
+ )
myMouseResizeAction =
D.mouseResizeWindowAndThen X.focus $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 792ff74..78f02c0 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -21,6 +21,7 @@ module Rahm.Desktop.Keys.Wml
moveLocationToWorkspace,
moveWindowToWorkspaceFn,
getAndResetWindowSelection,
+ getWindowSelection,
gotoWorkspaceFn,
toggleWindowInSelection,
addWindowToSelection,
@@ -244,6 +245,11 @@ removeWindowFromSelection win = do
clearWindowSelection :: X ()
clearWindowSelection = void getAndResetWindowSelection
+getWindowSelection :: X [Window]
+getWindowSelection = do
+ (WindowSelect mp) <- XS.get
+ return (Map.keys mp)
+
getAndResetWindowSelection :: X [Window]
getAndResetWindowSelection = do
(WindowSelect mp) <- XS.get
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
index 4b7eefc..95cf4f4 100644
--- a/src/Rahm/Desktop/Layout/Hole.hs
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -32,9 +32,9 @@ import XMonad
data Hole (l :: * -> *) (a :: *)
= Hole (Map WorkspaceId [(W.TilePosition WorkspaceId, Maybe Window)]) (l a)
-deriving instance Show (l a) => Show (Hole l a)
+deriving instance (Show (l a)) => Show (Hole l a)
-deriving instance Read (l a) => Read (Hole l a)
+deriving instance (Read (l a)) => Read (Hole l a)
hole :: l a -> Hole l a
hole = Hole mempty
@@ -77,16 +77,16 @@ removeHoleForWindow win = ManageHole $ \(Hole m l) ->
dbgHole :: Hole l a -> X ()
dbgHole (Hole mp _) = do
- logs Trace "Hole:"
+ logs Debug "Hole:"
forM_ (Map.toList mp) $ \(wid, poses) ->
- logs Trace " wid[%s] - [%s]" wid $
+ logs Debug " wid[%s] - [%s]" wid $
intercalate
","
( map (\(TilePosition _ n, w) -> show w ++ "@" ++ show n) poses
)
--- toggleHole :: ManageHole
--- toggleHole = ManageHole $ \(Hole e l) -> Hole (not e) l
+maxWindow :: Window
+maxWindow = maxBound
data ManageHole where
ManageHole :: (forall l a. Hole l a -> Hole l a) -> ManageHole
@@ -105,29 +105,26 @@ instance (LayoutClass l a, a ~ Window) => LayoutClass (Hole l) a where
W.Workspace i1 l1 Window
app mp (W.Workspace t l (Just s))
| Just positions <- sortIt <$> Map.lookup t mp =
- let integrated = W.integrate s
- in W.Workspace t l $
- W.differentiateWithFocus (W.focus s) $
- reverse $
- addr integrated $
- foldl
- ( \((idx, pos, fakeid), ret) w ->
- case pos of
- ((TilePosition _ n, win) : tpos)
- | n == idx && maybe True (`notElem` integrated) win ->
- ((idx + 1, tpos, fakeid - 1), w : fakeid : ret)
- _ -> ((idx + 1, pos, fakeid), w : ret)
- )
- ((0, positions, 10000000), [])
- integrated
+ let positionToFakes =
+ zipWith
+ (\(TilePosition _ n, _) fid -> (n, fid))
+ positions
+ [maxWindow, maxWindow - 1 ..]
+ integrated = W.integrate s
+ in W.Workspace t l $
+ W.differentiateWithFocus (W.focus s) $
+ inflateWithFakes 0 integrated positionToFakes
app _ w = w
- sortIt = sortOn (\(TilePosition _ p, _) -> p)
+ inflateWithFakes :: Int -> [Window] -> [(Int, Window)] -> [Window]
+ inflateWithFakes idx wins ((n,fake):fakes) | idx == n =
+ fake : inflateWithFakes (idx + 1) wins fakes
+ inflateWithFakes idx (w:wins) fakes =
+ w : inflateWithFakes (idx + 1) wins fakes
+ inflateWithFakes _ wins [] = wins
+ inflateWithFakes _ [] fakes = map snd fakes
- addr integrated ((idx, pos, fakeid), ret) =
- case pos of
- ((TilePosition _ n, win) : _) | n == idx && maybe True (`notElem` integrated) win -> fakeid : ret
- _ -> ret
+ sortIt = sortOn (\(TilePosition _ p, _) -> p)
handleMessage h (fromMessage -> Just (ManageHole f)) =
return $ Just $ f h
diff --git a/src/Rahm/Desktop/Layout/PinWindow.hs b/src/Rahm/Desktop/Layout/PinWindow.hs
index 6ccf35a..36dbf27 100644
--- a/src/Rahm/Desktop/Layout/PinWindow.hs
+++ b/src/Rahm/Desktop/Layout/PinWindow.hs
@@ -87,6 +87,7 @@ instance (LayoutClass l a, sid ~ ScreenId, a ~ Window) => LayoutClass (PinWindow
pinWindow :: Window -> X ()
pinWindow win = runMaybeT_ $ do
lift $ logs Debug "Pinning window %d" win
+ lift $ float win
ws@(W.StackSet cur vis _ flt) <- gets windowset
t <- hoist (W.findTag win ws)
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 0c70591..49dcaae 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -24,7 +24,7 @@ where
import Control.Arrow (Arrow ((&&&)))
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
-import Data.Char (isUpper, toLower, toUpper)
+import Data.Char (isUpper, toLower, toUpper, chr, ord, isDigit)
import Data.List (find, sort, sortBy, sortOn, (\\))
import Data.List.Safe ((!!))
import Data.Maybe (fromMaybe, mapMaybe)
@@ -147,6 +147,11 @@ getScreensOnDifferentPlane ss =
yCenter < y + fromIntegral h && yCenter > y
accompaningWorkspace :: WorkspaceId -> WorkspaceId
+accompaningWorkspace [s]
+ | isDigit s = show (fl (ord s - ord '0'))
+ where
+ fl x | even x = x + 1
+ fl x = x - 1
accompaningWorkspace [s] =
return $
if isUpper s
generated by cgit (git 2.34.1) at 2026-02-22 11:31:36 +0000