aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--package.yaml1
-rw-r--r--src/Rahm/Desktop/Keys.hs5
-rw-r--r--src/Rahm/Desktop/Layout.hs17
-rw-r--r--src/Rahm/Desktop/Layout/ConsistentMosaic.hs69
-rw-r--r--src/Rahm/Desktop/Layout/Draw.hs2
5 files changed, 83 insertions, 11 deletions
diff --git a/package.yaml b/package.yaml
index 7e7244c..f4f5603 100644
--- a/package.yaml
+++ b/package.yaml
@@ -40,3 +40,4 @@ dependencies:
- monad-loops
- data-default
- linear
+ - bimap
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 622fd3a..f7aae3c 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -60,6 +60,7 @@ import Rahm.Desktop.Layout.Pop (togglePop)
import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
import Rahm.Desktop.Layout.Rotate (rotateLayout)
import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
+import Rahm.Desktop.Layout.ConsistentMosaic
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -362,7 +363,7 @@ keymap = runKeys $ do
shiftMod $
doc "For mosaic layout, shrink the size-share of the current window" $
- withFocused $ sendMessage . shrinkWindowAlt
+ sendMessage =<< shrinkPositionAlt
bind xK_m $ do
justMod $
@@ -389,7 +390,7 @@ keymap = runKeys $ do
shiftMod $
doc "For mosaic layout, increase the size-share of the current window." $
- withFocused $ sendMessage . expandWindowAlt
+ sendMessage =<< expandPositionAlt
bind xK_q $ do
shiftMod $
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index bd875d0..d8c3442 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -33,6 +33,7 @@ import Rahm.Desktop.Layout.Flip
import Rahm.Desktop.Layout.Rotate
import Rahm.Desktop.Layout.Redescribe
import Rahm.Desktop.Layout.Hole
+import Rahm.Desktop.Layout.ConsistentMosaic
import qualified Data.Map as M
import qualified XMonad.StackSet as W
@@ -50,7 +51,7 @@ mods =
myLayoutList =
layoutList $
mods (reinterpretIncMaster $ spiral (6/7)) |:
- mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+ mods (MosaicWrap $ modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
@@ -72,17 +73,17 @@ instance DoReinterpret "ForMosaic" where
-- IncMaster message
reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
- fmap (SomeMessage .
- (if n > 0
- then expandWindowAlt
- else shrinkWindowAlt)) <$> getFocusedWindow
+ Just . SomeMessage <$> (
+ if n > 0
+ then expandPositionAlt
+ else shrinkPositionAlt)
-- ResizeMaster message
reinterpretMessage _ (fromMessage -> Just m) = do
- fmap (SomeMessage .
+ Just . SomeMessage <$>
(case m of
- Expand -> expandWindowAlt
- Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+ Expand -> expandPositionAlt
+ Shrink -> shrinkPositionAlt)
-- Messages that don't match the above, just leave it unmodified.
reinterpretMessage _ m = return (Just m)
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
new file mode 100644
index 0000000..db1ce4e
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -0,0 +1,69 @@
+
+-- This module provides a wrapper around the Mosaic layout to create a more
+-- consistent experience where instead of the windows being the ones it works
+-- on, it instead works on the window places so things like window swapping
+-- still work as expected.
+module Rahm.Desktop.Layout.ConsistentMosaic where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (mapMaybe)
+
+import XMonad.Layout.MosaicAlt
+
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Logger
+
+
+newtype MosaicWrap l a = MosaicWrap (l a) deriving (Read, Show)
+
+doAlt :: (Window -> HandleWindowAlt) -> X HandleWindowAlt
+doAlt f = do
+ (W.StackSet (W.Screen (W.Workspace _ _ mStack) _ _) _ _ _)
+ <- windowset <$> get
+
+ return $
+ case mStack of
+ Nothing -> f 0
+ Just (W.Stack _ u _) -> f (fromIntegral $ length u + 100)
+
+expandPositionAlt :: X HandleWindowAlt
+expandPositionAlt = doAlt expandWindowAlt
+
+shrinkPositionAlt :: X HandleWindowAlt
+shrinkPositionAlt = doAlt shrinkWindowAlt
+
+
+instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicWrap l) a where
+
+ runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
+ let zs = zipStack [100..] s
+ s' = mapStack fst zs
+ m = Map.fromList (W.integrate zs)
+
+ (rects, maybeNewLayout) <- runLayout (W.Workspace t l (Just s')) rect
+ let rects' =
+ flip mapMaybe rects $ \(place, rect) ->
+ (,rect) <$> Map.lookup place m
+
+ return (rects', MosaicWrap <$> maybeNewLayout)
+
+ where
+ zipStack as (W.Stack b c d) =
+ let (cz, bz : dz) = splitAt (length c) as in
+ W.Stack (bz, b) (zip (reverse cz) c) (zip dz d)
+
+
+ runLayout (W.Workspace t (MosaicWrap l) a) rect = do
+ (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+ return (rects, MosaicWrap <$> maybeNewLayout)
+
+
+ -- By default just pass the message to the underlying layout.
+ handleMessage (MosaicWrap l) mess = do
+ maybeNewLayout <- handleMessage l mess
+ return (MosaicWrap <$> maybeNewLayout)
+
+ description _ = "ConsistentMosaic"
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index 8819e8f..aa4dba3 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -136,7 +136,7 @@ drawXpm (w, h) rects' shrinkAmt = execWriter $ do
forM_ zipRects $ \(char, (color, _)) -> do
tell $ printf "\"%c c %s\",\n" char color
- tell "\"% c None\"a,\n"
+ tell "\"% c None\",\n"
forM_ [0 .. h - 1] $ \y -> do
tell "\""
generated by cgit (git 2.34.1) at 2026-02-22 22:05:01 +0000