aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm')
-rw-r--r--src/Rahm/Desktop/Dragging.hs27
-rw-r--r--src/Rahm/Desktop/Keys.hs60
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs4
-rw-r--r--src/Rahm/Desktop/Layout.hs7
-rw-r--r--src/Rahm/Desktop/Layout/PinWindow.hs149
-rw-r--r--src/Rahm/Desktop/StackSet.hs8
6 files changed, 232 insertions, 23 deletions
diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs
index 5252390..853cf43 100644
--- a/src/Rahm/Desktop/Dragging.hs
+++ b/src/Rahm/Desktop/Dragging.hs
@@ -5,8 +5,9 @@ import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
-import Rahm.Desktop.Common (runMaybeT_, setBorderColor, pointerWindow, pointerLocation)
+import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_, setBorderColor)
import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole)
+import Rahm.Desktop.Layout.PinWindow (isWindowPinned, pinWindow, unpinWindow)
import Rahm.Desktop.Logger
import Rahm.Desktop.Marking (setAlternateWindows)
import qualified Rahm.Desktop.StackSet as W
@@ -80,6 +81,26 @@ ifReleased but (AfterDragAction act) = AfterDragAction $ \win b -> do
ifReleased' :: X.Button -> (X.Window -> X.Button -> X ()) -> AfterDragAction
ifReleased' but act = ifReleased but (AfterDragAction act)
+mouseResizeWindowAndThen :: (X.Window -> X ()) ->
+ AfterDragAction -> X.Window -> X ()
+mouseResizeWindowAndThen 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.mouseResizeWindow window
+
+ afterDrag $ do
+ X.broadcastMessage $ removeHoleForWindow window
+ curev <- X.asks X.currentEvent
+ when windowPinned $
+ pinWindow window
+ releaseAction window (maybe 0 X.ev_button curev)
+ X.refresh
+
+
mouseMoveWindowAndThen ::
(X.Window -> X ()) ->
AfterDragAction ->
@@ -87,6 +108,8 @@ mouseMoveWindowAndThen ::
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
@@ -94,6 +117,8 @@ mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do
afterDrag $ do
X.broadcastMessage $ removeHoleForWindow window
curev <- X.asks X.currentEvent
+ when windowPinned $
+ pinWindow window
releaseAction window (maybe 0 X.ev_button curev)
X.refresh
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 76634b0..94308e5 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -42,6 +42,7 @@ import Graphics.X11.ExtraTypes.XF86
import Rahm.Desktop.Common
( Location (..),
click,
+ duplWindow,
focusLocation,
getCurrentWorkspace,
gotoWorkspace,
@@ -51,7 +52,7 @@ import Rahm.Desktop.Common
runMaybeT_,
setBorderColor,
withBorderColor,
- withBorderColorM, duplWindow,
+ withBorderColorM,
)
import Rahm.Desktop.DMenu (runDMenu)
import qualified Rahm.Desktop.Dragging as D
@@ -117,6 +118,7 @@ import Rahm.Desktop.Layout.List
toNextLayout,
toPreviousLayout,
)
+import Rahm.Desktop.Layout.PinWindow (pinWindow, toggleWindowPin, unpinWindow, withWindowsUnpinned)
import Rahm.Desktop.Layout.Pop (togglePop)
import Rahm.Desktop.Layout.Rotate (rotateLayout)
import Rahm.Desktop.Logger
@@ -307,7 +309,7 @@ keymap = runKeys $ do
justMod $
doc "Run the command which opened this window again." $
X.withFocused duplWindow
-
+
bind xK_w $ do
justMod $
doc "Swap windows with other windows" $
@@ -567,6 +569,22 @@ keymap = runKeys $ do
doc "Lock the screen" $
spawnX "xsecurelock"
+ bind xK_p $ do
+ justMod $
+ doc "Pin a windowset" $
+ pushPendingBuffer "p " $
+ runMaybeT_ $
+ do
+ windows <- mapMaybe locationWindow <$> readNextLocationSet
+ lift $ mapM_ pinWindow windows
+
+ shiftMod $
+ doc "Unpin a windowset" $
+ pushPendingBuffer "P " $
+ runMaybeT_ $ do
+ windows <- mapMaybe locationWindow <$> readNextLocationSet
+ lift $ mapM_ unpinWindow windows
+
bind xK_minus $ do
justMod $
doc
@@ -702,17 +720,18 @@ keymap = runKeys $ do
)
(W.findTag win stackset)
- windows $
- finalSwap
- . ( \ss ->
- case shiftType of
- ShiftAndFollow
- | (w : _) <- selection,
- Just ws <- W.findTag w ss ->
- W.greedyView ws ss
- _ -> ss
- )
- . allMovements
+ withWindowsUnpinned selection $
+ windows $
+ 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"
@@ -991,7 +1010,13 @@ myMouseMoveWindow =
D.mouseMoveWindowAndThen X.focus $
mconcat
[ D.ifReleased button3 D.sinkOnRelease,
- D.ifReleased' button13 $ \w _ -> X.killWindow w
+ D.ifReleased' button2 $ \w _ -> X.killWindow w
+ ]
+
+myMouseResizeAction =
+ D.mouseResizeWindowAndThen X.focus $
+ mconcat
+ [ D.ifReleased button1 D.sinkOnRelease
]
mouseMap :: forall l. XConfig l -> ButtonBindings
@@ -1028,8 +1053,9 @@ mouseMap = runButtons $ do
bind button3 $ do
justMod $
- doc "Float and resize a window" $
- \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
+ doc
+ "Float and resize a window"
+ myMouseResizeAction
bind button6 $
justMod $
@@ -1113,7 +1139,7 @@ mouseMap = runButtons $ do
bind button3 $
noMod $
- doc "Resize the window under the cursor" mouseResizeWindow
+ doc "Resize the window under the cursor" myMouseResizeAction
let resizeButtons =
[ ( button4,
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 0d0691f..6555312 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -88,6 +88,7 @@ import Rahm.Desktop.History
nextLocation,
-- pastHistory,
)
+import Rahm.Desktop.Layout.PinWindow (pinnedWindows)
import Rahm.Desktop.Logger (LogLevel (Info, Trace), logs)
import Rahm.Desktop.Marking
( farLeftWindow,
@@ -634,8 +635,7 @@ readNextLocationSet' =
(_, _, ".") -> (: []) <$> mt getCurrentLocation
-- The selected windows in the selection set.
(_, _, "#") ->
- fromMaybeTX $
- mapM windowLocation =<< MaybeT (Just <$> fromX getAndResetWindowSelection)
+ MaybeT . fromX $ Just . map (Location "*" . Just) <$> pinnedWindows
-- The window on the far-left of the screens.
(_, _, "^") -> (: []) <$> fromMaybeTX farLeftWindow
-- The windows on the far-right of the screens.
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index d71989f..4dfba25 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -18,6 +18,7 @@ import Rahm.Desktop.Layout.List
nil,
(|:),
)
+import Rahm.Desktop.Layout.PinWindow (PinWindowLayout (PinWindowLayout), pinnable)
import Rahm.Desktop.Layout.Pop (poppable)
import Rahm.Desktop.Layout.Redescribe (Describer (..), Redescribe (..))
import Rahm.Desktop.Layout.ReinterpretMessage (DoReinterpret (..), ReinterpretMessage (..))
@@ -41,13 +42,13 @@ import XMonad.Layout.Spiral (spiral)
myLayout =
fullscreenFull $
- hole $
- avoidStruts myLayoutList
+ hole $
+ avoidStruts myLayoutList
mySpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
mods =
- mySpacing . poppable . flippable . rotateable
+ pinnable . poppable . mySpacing . flippable . rotateable
myLayoutList =
layoutList $
diff --git a/src/Rahm/Desktop/Layout/PinWindow.hs b/src/Rahm/Desktop/Layout/PinWindow.hs
new file mode 100644
index 0000000..fe98afd
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/PinWindow.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE TypeOperators #-}
+
+module Rahm.Desktop.Layout.PinWindow where
+
+import Control.Arrow (Arrow (second))
+import Control.Exception (throw)
+import Control.Monad (unless, when)
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (MaybeT (..))
+import Data.Foldable (find)
+import Data.List (nubBy)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe, mapMaybe, maybe)
+import Data.Semigroup (Endo (..))
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Rahm.Desktop.Common (runMaybeT_)
+import Rahm.Desktop.Logger
+import qualified Rahm.Desktop.StackSet as W
+import XMonad
+import qualified XMonad.StackSet as W (filter)
+import qualified XMonad.Util.ExtensibleState as XS
+
+newtype PinWindowState = PinWindowState (Map ScreenId [(Window, W.RationalRect)])
+ deriving (Show, Read)
+
+instance Default PinWindowState where
+ def = PinWindowState mempty
+
+instance ExtensionClass PinWindowState where
+ initialValue = def
+ extensionType = PersistentExtension
+
+newtype PinWindowLayout (l :: * -> *) (a :: *) = PinWindowLayout (l a)
+ deriving (Show, Read)
+
+instance (LayoutClass l a, sid ~ ScreenId, a ~ Window) => LayoutClass (PinWindowLayout l) a where
+ runLayout (W.Workspace t (PinWindowLayout l) stack) rect = do
+ -- Clean up window id's thare should not be pinned anymore because the
+ -- windows were unmanaged.
+ (PinWindowState pinned') <- XS.get
+ ws <- gets windowset
+ XS.put $ PinWindowState (cleanupPinned pinned' ws)
+ (PinWindowState pinned) <- XS.get
+
+ let myScreen = find ((== t) . W.tag . W.workspace) (W.screens ws)
+ pinnedRects =
+ maybe
+ []
+ (map $ second (scaleRationalRect rect))
+ (((`Map.lookup` pinned) . W.screen) =<< myScreen)
+ allPinned = Set.fromList $ map fst $ concat $ Map.elems pinned
+ pinnedOnMyScreen = map fst pinnedRects
+
+ windowsToMove =
+ filter (\win -> W.findTag win ws /= Just t) pinnedOnMyScreen
+
+ modifyWindowSet $
+ appEndo . mconcat $
+ -- Move the windows that are supposed to now be on this workspace here
+ map (Endo . W.shiftWinNoFocus t) windowsToMove
+ ++
+ -- once again, sink the windows that are supposed to be here. Make
+ -- sure they don't float.
+ map (Endo . W.sink) (Set.toList allPinned)
+
+ (rects, maybeNewLayout) <-
+ runLayout
+ (W.Workspace t l (W.filter (not . (`Set.member` allPinned)) =<< stack))
+ rect
+
+ return (pinnedRects ++ rects, PinWindowLayout <$> maybeNewLayout)
+ where
+ cleanupPinned mp ss =
+ let aw = Set.fromList (W.allWindows ss)
+ in Map.map (filter ((`Set.member` aw) . fst)) mp
+
+ handleMessage (PinWindowLayout l) a = do
+ maybeNewLayout <- handleMessage l a
+ return (PinWindowLayout <$> maybeNewLayout)
+
+pinWindow :: Window -> X ()
+pinWindow win = runMaybeT_ $ do
+ lift $ logs Debug "Pinning window %d" win
+
+ ws@(W.StackSet cur vis _ flt) <- gets windowset
+ t <- hoist (W.findTag win ws)
+ scr <- hoist $ find ((== t) . (W.tag . W.workspace)) (cur : vis)
+ rect <- hoist $ Map.lookup win flt
+
+ lift $ do
+ XS.modify $ \(PinWindowState mp) ->
+ PinWindowState $
+ Map.alter
+ (Just . maybe [(win, rect)] ((win, rect) :))
+ (W.screen scr)
+ mp
+
+ -- Don't float the window anymore.
+ modifyWindowSet $ W.sink win
+ where
+ hoist = MaybeT . return
+
+unpinWindow :: Window -> X ()
+unpinWindow win = runMaybeT_ $ do
+ (PinWindowState mp) <- lift XS.get
+ (win, rect) <- hoist $ find ((== win) . fst) (concat $ Map.elems mp)
+
+ lift $ do
+ XS.put $
+ PinWindowState $
+ Map.map (filter ((/= win) . fst)) mp
+
+ -- refloat the window.
+ modifyWindowSet $ W.float win rect
+ where
+ hoist = MaybeT . return
+
+toggleWindowPin :: Window -> X ()
+toggleWindowPin win = do
+ isPinned <- isWindowPinned win
+ if isPinned
+ then unpinWindow win
+ else pinWindow win
+
+isWindowPinned :: Window -> X Bool
+isWindowPinned win = do
+ (PinWindowState mp) <- XS.get
+ return $ any (any $ (== win) . fst) (Map.elems mp)
+
+pinnedWindows :: X [Window]
+pinnedWindows = do
+ (PinWindowState s) <- XS.get
+ return $ map fst $ concat $ Map.elems s
+
+pinnable :: l a -> PinWindowLayout l a
+pinnable = PinWindowLayout
+
+-- Unpins the window, executes the action, then repins the window. Useful for
+-- window shifts and whatnot.
+withWindowsUnpinned :: [Window] -> X () -> X ()
+withWindowsUnpinned wins fn =
+ ( do
+ mapM_ unpinWindow wins
+ fn
+ mapM_ pinWindow wins
+ )
+ `catchX` mapM_ pinWindow wins
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 2dc8787..94c044e 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -1,6 +1,7 @@
module Rahm.Desktop.StackSet
( masterWindow,
allVisibleWindows,
+ shiftWinNoFocus,
differentiateWithFocus,
concatMapTiledWindows,
windowsOnWorkspace,
@@ -273,6 +274,13 @@ differentiateWithFocus thing lst =
getFocusedWindow :: StackSet i l a s sd -> Maybe a
getFocusedWindow (StackSet cur _ _ _) = W.focus <$> (W.stack . W.workspace) cur
+shiftWinNoFocus :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftWinNoFocus n w s = case findTag w s of
+ Just from | n `tagMember` s && n /= from -> go from s
+ _ -> s
+ where go from = onWorkspace n (focusDown . insertUp w) . onWorkspace from (delete' w)
+ onWorkspace n f s = view (currentTag s) . f . view n $ s
+
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
generated by cgit (git 2.34.1) at 2026-02-22 21:40:03 +0000