diff options
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | src/Internal/Keys.hs | 3 | ||||
| -rw-r--r-- | src/Internal/Marking.hs | 17 | ||||
| -rw-r--r-- | src/Internal/SwapMaster.hs | 41 | ||||
| -rw-r--r-- | src/Internal/Windows.hs | 32 |
5 files changed, 77 insertions, 17 deletions
diff --git a/package.yaml b/package.yaml index e9e59d9..318a3af 100644 --- a/package.yaml +++ b/package.yaml @@ -20,3 +20,4 @@ dependencies: - X11 - split - mtl + - transformers diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 591861f..3b61dac 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,6 +1,7 @@ {-# LANGUAGE RankNTypes #-} module Internal.Keys where +import Internal.SwapMaster (swapMaster) import XMonad.Hooks.ManageDocks import XMonad.Layout.MosaicAlt import Graphics.X11.ExtraTypes.XorgDefault @@ -85,7 +86,7 @@ newKeys = , ((modm .|. shiftMask, xK_l), windows W.swapDown) , ((modm , xK_f), sendMessage FlipLayout) , ((modm .|. shiftMask, xK_f), sendMessage HFlipLayout) - , ((modm , xK_Return), windows W.swapMaster) + , ((modm , xK_Return), swapMaster) , ((modm, xK_j), sendMessage Shrink) , ((modm, xK_k), sendMessage Expand) , ((modm .|. shiftMask, xK_r), sendMessage DoRotate) diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs index 229ea02..fc1c082 100644 --- a/src/Internal/Marking.hs +++ b/src/Internal/Marking.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Internal.Marking where +import Internal.Windows (mapWindows) import XMonad import XMonad.StackSet hiding (focus) import Data.IORef @@ -57,22 +58,6 @@ jumpToMark mark = do saveLastMark focus w -mapWindows :: (Ord a, Ord b) => (a -> b) -> StackSet i l a s sd -> StackSet i l b s sd -mapWindows fn (StackSet cur vis hid float) = - StackSet - (mapWindowsScreen cur) - (map mapWindowsScreen vis) - (map mapWindowsWorkspace hid) - (Map.mapKeys fn float) - where - mapWindowsScreen (Screen work a b) = Screen (mapWindowsWorkspace work) a b - mapWindowsWorkspace (Workspace t l stack) = - Workspace t l (fmap (mapStack fn) stack) - --- | What genius decided to hide the instances for the Stack type!!??? -mapStack :: (a -> b) -> Stack a -> Stack b -mapStack fn (Stack focus up down) = Stack (fn focus) (map fn up) (map fn down) - setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd setFocusedWindow window diff --git a/src/Internal/SwapMaster.hs b/src/Internal/SwapMaster.hs new file mode 100644 index 0000000..c73cbd9 --- /dev/null +++ b/src/Internal/SwapMaster.hs @@ -0,0 +1,41 @@ +{- Swap window with the master, but save it. -} +module Internal.SwapMaster (swapMaster) where + +import qualified XMonad.StackSet as W + +import Internal.Windows (mapWindows, getMaster, swapWindows) +import Control.Monad.Trans.Maybe +import XMonad (Window, ExtensionClass(..), X(..), windows, windowset) +import Control.Monad (void) +import Control.Monad.Trans (lift) +import Data.Maybe (fromMaybe) +import Control.Monad.State (get) + +import qualified XMonad.Util.ExtensibleState as XS + +data LastWindow = LastWindow { + lastWindow :: (Maybe Window) + } deriving (Show, Read) + +instance ExtensionClass LastWindow where + initialValue = LastWindow Nothing + +hoist :: (Monad m) => Maybe a -> MaybeT m a +hoist = MaybeT . return + +swapMaster :: X () +swapMaster = void $ runMaybeT $ do + ss <- lift $ windowset <$> get + + focused <- hoist $ W.peek ss + master <- hoist $ getMaster ss + + if focused == master + then do + lw <- MaybeT $ lastWindow <$> XS.get + lift $ windows (swapWindows focused lw) + else lift $ windows (swapWindows focused master) + + lift $ do + XS.put (LastWindow $ Just master) + windows W.focusMaster diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs new file mode 100644 index 0000000..0f109b7 --- /dev/null +++ b/src/Internal/Windows.hs @@ -0,0 +1,32 @@ +module Internal.Windows where + +import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate) +import Data.Maybe (listToMaybe) +import qualified Data.Map as Map + +mapWindows :: (Ord a, Ord b) => (a -> b) -> StackSet i l a s sd -> StackSet i l b s sd +mapWindows fn (StackSet cur vis hid float) = + StackSet + (mapWindowsScreen cur) + (map mapWindowsScreen vis) + (map mapWindowsWorkspace hid) + (Map.mapKeys fn float) + where + mapWindowsScreen (Screen work a b) = Screen (mapWindowsWorkspace work) a b + mapWindowsWorkspace (Workspace t l stack) = + Workspace t l (fmap (mapStack fn) stack) + +-- | What genius decided to hide the instances for the Stack type!!??? +mapStack :: (a -> b) -> Stack a -> Stack b +mapStack fn (Stack focus up down) = Stack (fn focus) (map fn up) (map fn down) + +getMaster :: StackSet i l a s sd -> Maybe a +getMaster (StackSet (Screen (Workspace _ _ ss) _ _) _ _ _) = + head . integrate <$> ss + +swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d +swapWindows wa wb = mapWindows $ \w -> + case w of + _ | w == wa -> wb + _ | w == wb -> wa + _ -> w |