aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/Keys.hs7
-rw-r--r--src/Rahm/Desktop/Layout.hs3
-rw-r--r--src/Rahm/Desktop/Layout/Hole.hs44
3 files changed, 53 insertions, 1 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index e780fbf..0ff8da3 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu
import Rahm.Desktop.Logger
import Rahm.Desktop.RebindKeys
import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.Hole (toggleHole)
import Rahm.Desktop.Layout.Pop (PopMessage(..))
import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
import Rahm.Desktop.Layout.Rotate (rotateLayout)
@@ -188,6 +189,12 @@ keymap = runKeys $ do
doc "Print this documentation." $
logs (documentation (keymap config))
+ bind xK_F8 $
+
+ justMod $
+ doc "Print this documentation." $
+ sendMessage toggleHole
+
bind xK_F10 $ do
justMod playPauseDoc
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 6c9ac5a..906a7fc 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -32,11 +32,12 @@ import Rahm.Desktop.Layout.Pop
import Rahm.Desktop.Layout.Flip
import Rahm.Desktop.Layout.Rotate
import Rahm.Desktop.Layout.Redescribe
+import Rahm.Desktop.Layout.Hole
import qualified Data.Map as M
import qualified XMonad.StackSet as W
-mods = reinterpretResize . poppable . flippable . rotateable
+mods = reinterpretResize . poppable . flippable . rotateable . hole
myLayout =
fullscreenFull $
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
new file mode 100644
index 0000000..ee59726
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE UndecidableInstances, DeriveAnyClass #-}
+
+-- Delegates to a lower layout, but leaves a hole where the next window will go.
+module Rahm.Desktop.Layout.Hole (hole, toggleHole) where
+
+import qualified XMonad.StackSet as W
+import XMonad
+import Data.Maybe (mapMaybe)
+
+import Rahm.Desktop.Windows
+
+data Hole (l :: * -> *) (a :: *) = Hole Bool (l a)
+
+deriving instance Show (l a) => Show (Hole l a)
+deriving instance Read (l a) => Read (Hole l a)
+
+hole :: l a -> Hole l a
+hole = Hole False
+
+toggleHole :: ManageHole
+toggleHole = ManageHole $ \(Hole e l) -> Hole (not e) l
+
+data ManageHole where
+ ManageHole :: (forall l a. Hole l a -> Hole l a) -> ManageHole
+ deriving (Message)
+
+instance (LayoutClass l a, Eq a, Num a) => LayoutClass (Hole l) a where
+ runLayout (W.Workspace t (Hole enabled l) a) rect = do
+ (rects, maybeNewLayout) <- runLayout (app (-1) $ W.Workspace t l a) rect
+ return (filter ((/=(-1)) . fst) rects, fmap (Hole enabled) maybeNewLayout)
+ where
+ app x w | not enabled = w
+ app x (W.Workspace t l s) =
+ case s of
+ Nothing ->
+ W.Workspace t l (Just $ W.Stack x [] [])
+ Just (W.Stack h c e) ->
+ W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
+
+ handleMessage h (fromMessage -> Just (ManageHole f)) =
+ return $ Just $ f h
+ handleMessage (Hole e l) a = do
+ maybeNewLayout <- handleMessage l a
+ return (Hole e <$> maybeNewLayout)