diff options
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 7 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout.hs | 3 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout/Hole.hs | 44 |
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) |